I used the Visual Studio 2005 Beta 1 (it was one year ago) because Visual
Studio 2005 has a SerialPort-component. You just have to connect with that
serial port to your modem/handphone, and read all the messages.
I made a project that reads messages from a database and sends them, and
inserts the received messages in another table. There was also support for
hours between the sms could be send etc, error-support. Also PDU-support
('special' characters) etc: I used a good site for that info (it's kind of
difficulet stuff, hehe), the link is in the code...
The whole code of my SMS-classes (sorry if it isn't always, clear, hehe,
feel free to ask more questions):
Option Explicit On
Imports System.Data
Imports System.Data.Sql Client
Public Class clsSMSServer
#Region "Variabel Declarations"
Private WithEvents SmsModem As New clsSMSModem
'timers...
Private WithEvents tmrProcessNext As New Timers.Timer
Private WithEvents tmrDelete As New Timers.Timer
Private WithEvents tmrTimeOutProce ssLoop As New Timers.Timer
Private WithEvents tmrNotSend As New Timers.Timer
Private WithEvents tmrNotReceived As New Timers.Timer
'SMS
Private intSMSID As Integer = 0
Private strNumber As String = ""
Private strMessage As String = ""
Private clsOutSMS As clsPDUEncode
'HashTable with the SMS-Index that we received....
Private htbIndex As New Hashtable
'sSortedList with the SendNext
Private lstSendNext As New SortedList
'booleans to indicate if an sms has been send or not...
Private blnReceived As Boolean = False
Private blnSendErrorMai l As Boolean = False
Private m_intMessagesFa iled As Integer = 0
#End Region
#Region "Event Declarations"
#End Region
#Region "Constants"
Private cstSqlFrom As String = "SELECT TOP 1 tblSms.* FROM tblSms WITH
(XLOCK) LEFT JOIN tblHours ON (tblSms.Campaig n = tblHours.Campai gn AND
DayWeek = DATEPART(dw,GET DATE())) "
Private cstSqlWhere As String = " WHERE ((MemoDate IS NULL) OR
(GETDATE() > MemoDate)) " & _
" AND (SendDate IS NULL) " & _
"AND (" & _
"(((CONVERT(CHA R(5),GETDATE(), 108) > CONVERT(CHAR(5) ,Begin1,108)) AND
(CONVERT(CHAR(5 ),GETDATE(),108 ) < CONVERT(CHAR(5) ,End1,108))) OR ((Begin1 IS
NULL) AND (End1 IS NULL))) " & _
"OR " & _
"(((CONVERT(CHA R(5),GETDATE(), 108) > CONVERT(CHAR(5) ,Begin2,108)) AND
(CONVERT(CHAR(5 ),GETDATE(),108 ) < CONVERT(CHAR(5) ,End2,108)))) " & _
")"
'Private cstSqlFrom As String = "SET DATEFIRST 1 " & vbCrLf & _
'"SELECT TOP 1 tblSms.* FROM tblSms LEFT JOIN tblHours ON
(tblSms.Campaig n = tblHours.Campai gn AND DayWeek = DATEPART(dw,GET DATE())) "
'Private cstSqlWhere As String = " WHERE ((MemoDate IS NULL) OR
(GETDATE() > MemoDate)) " & _
'" AND (SendDate IS NULL) " & _
'"AND (" & _
'"(((CONVERT(CH AR(5),GETDATE() ,108) > CONVERT(CHAR(5) ,Begin1,108)) AND
(CONVERT(CHAR(5 ),GETDATE(),108 ) < CONVERT(CHAR(5) ,End1,108))) OR ((Begin1 IS
NULL) AND (End1 IS NULL))) " & _
'"OR " & _
'"(((CONVERT(CH AR(5),GETDATE() ,108) > CONVERT(CHAR(5) ,Begin2,108)) AND
(CONVERT(CHAR(5 ),GETDATE(),108 ) < CONVERT(CHAR(5) ,End2,108)))) " & _
'")"
Private cstSqlOrderBy As String = " ORDER BY Priority DESC, SMSID ASC "
#End Region
#Region "Enumeratio ns"
#End Region
#Region "Propertys"
Private Property pryMessagesFail ed() As Integer
Get
pryMessagesFail ed = m_intMessagesFa iled
End Get
Set(ByVal value As Integer)
m_intMessagesFa iled = value
End Set
End Property
#End Region
#Region "Public Methods"
Public Sub StartServer()
MessageSilent(" Starting SMS Server...", "StartServe r")
tmrNotSend.Stop ()
tmrNotSend.Inte rval = watchedSettings ("TimeOutNotSen dMinutes") * 60
* 1000
tmrNotSend.Star t()
tmrNotReceived. Stop()
tmrNotReceived. Interval =
watchedSettings ("TimeOutNotRec eivedMinutes") * 60 * 1000
tmrNotReceived. Start()
tmrTimeOutProce ssLoop.Stop()
tmrTimeOutProce ssLoop.Interval =
watchedSettings ("TimeOutProces sLoopSeconds") * 1000
tmrTimeOutProce ssLoop.Start()
SmsModem = New clsSMSModem
Dim strPortName As String
strPortName = watchedSettings ("PortName")
If Not SmsModem.IsPort Available(strPo rtName) Then
MessageSilent(" Port " & strPortName & " not available!",
"StartServe r")
MessageMail("Po rt " & strPortName & " not available!", "SMS
SERVER ERROR: Port not available!")
Else
MessageSilent(" Port " & strPortName & " available...",
"StartServe r")
'open the port...
If SmsModem.OpenCo mPort(strPortNa me, _
CInt(watchedSet tings("BaudRate ")), _
CInt(watchedSet tings("DataBits ")), _
watchedSettings ("Parity"), _
watchedSettings ("StopBits") , _
watchedSettings ("HandShake" )) Then
MessageSilent(" Port " & strPortName & " opened...",
"StartServe r")
MessageMail("Po rt " & strPortName & " opened...", "SMS
SERVER NOTIFICATION: SMS Server started...")
Else
MessageSilent(" Port " & strPortName & " did not open!",
"StartServe r")
MessageMail("Po rt " & strPortName & " not available!", "SMS
SERVER ERROR: Port not available!")
End If
'reset the modem!
tmrProcessNext. Stop()
SmsModem.ResetM odem()
'wait for the event until it is resetted...
End If
'delete all the old error-files
'86400000 'elke dag!
tmrDelete.Inter val = watchedSettings ("KeepAliveMinu tes") * 60 * 1000
'in minuten!
tmrDelete.Start ()
DeleteErrorFile s()
End Sub
Public Sub StopServer()
Try
MessageSilent(" Stopping SMS Server...", "StopServer ")
MessageMail("SM S Server stopped... ", "SMS SERVER NOTIFICATION:
SMS Server stopped...")
tmrProcessNext. Stop()
tmrDelete.Stop( )
tmrTimeOutProce ssLoop.Stop()
SmsModem.CloseC omPort()
SmsModem = Nothing
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "StopServer ")
End Try
End Sub
#End Region
#Region "Private Methods"
Public Sub New()
Dim currentDomain As AppDomain = AppDomain.Curre ntDomain
AddHandler currentDomain.U nhandledExcepti on, AddressOf MyHandler
AddHandler System.Windows. Forms.Applicati on.ThreadExcept ion,
AddressOf GlobalErrorHand ler
End Sub
Private Sub SmsModem_Charac terSetChanged(B yVal strSet As String) Handles
SmsModem.Charac terSetChanged
If strSet = "GSM" Then
'set it to UCS2-CharSet
SmsModem.SetToU CS2()
'wait for event...
Else
'everything is ready!!
'first sms can be send!
ProcessNextCycl e()
End If
End Sub
Private Sub SmsModem_ComPor tNotAvailable() Handles
SmsModem.ComPor tNotAvailable
MessageSilent(" Port not available!", "SmsModem_ComPo rtNotAvailable" )
StartServer()
End Sub
Private Sub SmsModem_Modem_ Resetted() Handles SmsModem.Modem_ Resetted
'the modem has been resetted: add now the pin-code
SmsModem.PinIns ert(watchedSett ings("Pin"))
'wait for the event until it is entered...
End Sub
Private Sub SmsModem_Modem_ TestSucceed() Handles
SmsModem.Modem_ TestSucceed
MessageSilent(" Testing Modem succeed..",
"SmsModem_Modem _TestSucceed")
'start het boelke...
End Sub
Private Sub SmsModem_Pin_No tRight() Handles SmsModem.Pin_No tRight
MessageSilent(" Pin not right!", "SmsModem_Pin_N otRight")
tmrProcessNext. Stop()
SmsModem.ResetM odem()
End Sub
Private Sub SmsModem_Pin_Ri ght() Handles SmsModem.Pin_Ri ght
'set it to text-mode!
'SmsModem.SetTo TextMode()
'wait for event...
'get the first sms!!
'ProcessNextCyc le()
'wait 10 seconds untill the pin modem is readdy after setting the
pin!
tmrProcessNext. Stop()
tmrProcessNext. Interval = (10 * 1000)
tmrProcessNext. Start()
End Sub
Private Sub SmsModem_Pin_Wa itingForInput() Handles
SmsModem.Pin_Wa itingForInput
'the modem has been resetted: add now the pin-code
SmsModem.PinIns ert(watchedSett ings("Pin"))
'wait for the event until it is entered...
End Sub
Private Sub SmsModem_Sms_De leted() Handles SmsModem.Sms_De leted
'remove from the HashTable
RemoveFromHashT ableStack()
End Sub
Private Sub SmsModem_Sms_De letingError() Handles
SmsModem.Sms_De letingError
MessageSilent(" Error deleting index: " & htbIndex(htbInd ex.Count -
1) & " - Stack Number = " & (htbIndex.Count - 1),
"SmsModem_Sms_D eletingError")
'remove from the HashTable
RemoveFromHashT ableStack()
End Sub
Private Sub RemoveFromHashT ableStack()
Dim intX As Integer
intX = htbIndex.Count - 1
htbIndex.Remove (intX)
'remove the next one..
RemoveSmsIndex( )
End Sub
Private Sub SmsModem_Sms_Me ssageError() Handles
SmsModem.Sms_Me ssageError
MessageSilent(" Error sending message: " & strNumber & " - SMSID: " &
intSMSID, "SmsModem_Sms_M essageError")
'INSERT the SMS to be send later!!!
'+ update sendtimes...
UpdateTblSMS(in tSMSID, True, "MessageErr or")
If Not MaxMessageFailu re() Then
'check for received sms...
ProcessReceived Sms()
End If
End Sub
Private Sub SmsModem_Sms_Me ssageSend() Handles SmsModem.Sms_Me ssageSend
'update tblSMS: SMS has been send!
UpdateTblSMS(in tSMSID, False)
tmrNotSend.Stop ()
tmrNotSend.Inte rval = watchedSettings ("TimeOutNotSen dMinutes") * 60
* 1000
tmrNotSend.Star t()
pryMessagesFail ed = 0
'check for received sms...
ProcessReceived Sms()
End Sub
Private Sub SmsModem_Sms_Nu mberError() Handles SmsModem.Sms_Nu mberError
MessageSilent(" Error sending number: " & strNumber & " - SMSID: " &
intSMSID, "SmsModem_Sms_N umberError")
'INSERT the SMS to be send later!!!
'+ update sendtimes...
UpdateTblSMS(in tSMSID, True, "NumberErro r")
If Not MaxMessageFailu re() Then
'check for received sms...
ProcessReceived Sms()
End If
End Sub
Private Sub SmsModem_Sms_Re ad(ByVal dtblSMS As System.Data.Dat aTable)
Handles SmsModem.Sms_Re ad
'handle the sms's that have been read....
tmrNotReceived. Stop()
tmrNotReceived. Interval =
watchedSettings ("TimeOutNotRec eivedMinutes") * 60 * 1000
tmrNotReceived. Start()
If dtblSMS.Rows.Co unt > 0 Then
blnReceived = True
'There are some sms in the memory..
Dim intX As Integer
htbIndex.Clear( )
For intX = 0 To (dtblSMS.Rows.C ount - 1)
'handle all the sms...
If
InsertReceivedS MS(dtblSMS.Rows (intX).Item("Nu mber").ToString ,
dtblSMS.Rows(in tX).Item("Messa ge"), dtblSMS.Rows(in tX).Item("Date" )) Then
'only when the SMS has been inserted!
'add the index to the hashtable
htbIndex.Add(in tX, dtblSMS.Rows(in tX).Item("Index "))
End If
Next
'start the deleting of the sms-indexes in the hashtable...
RemoveSmsIndex( )
Else
'no sms received...
blnReceived = False
'start the timer to do the next loop...
'tmrProcessNext .Interval =
watchedSettings ("SendIntervalS econds") * 1000
'tmrProcessNext .Start()
ProcessNextCycl e()
End If
End Sub
Private Function InsertReceivedS MS(ByVal strNr As String, ByVal strMess
As String, ByVal dtDate As Date) As Boolean
Dim strSql, strSql2 As String
Dim strValues As String
'strSql = "INSERT INTO tblReceived (Number, Message, ReceivedDate)
VALUES ('" & _
'strNr & "', '" & strMess & "', '" & Format(dtDate,
"yyyy-MM-ddTHH:mm:ss") & "')"
strSql = "INSERT INTO tblReceived (Number, Message, ReceivedDate"
strValues = "'" & strNr & "', '" & Replace(strMess , "'", "''") & "',
'" & Format(dtDate, "yyyy-MM-ddTHH:mm:ss") & "'"
'TRY TO LINK THE RECEIVED SMS TO A SEND SMS BY NUMBER!!!
Dim con As New SqlConnection
Dim cmdSql As SqlCommand
con.ConnectionS tring = watchedSettings ("ConnectionStr ing")
strSql2 = "SELECT * FROM " & _
"(SELECT TOP 1 tblSMS.*, tblCampaigns.Ma il FROM tblSMS " & _
" LEFT JOIN tblCampaigns ON (tblSms.Campaig n =
tblCampaigns.Ca mpaign) " & _
"WHERE (Number = '" & strNr & "') OR (Number = '0" & Right(strNr,
Len(strNr) - 3) & "') " & _
"ORDER BY SendDate DESC) X " & vbCrLf & _
" UNION " & vbCrLf & _
"SELECT DISTINCT tblSMS.*, tblCampaigns.Ma il FROM tblSMS " & _
" LEFT JOIN tblCampaigns ON (tblSms.Campaig n =
tblCampaigns.Ca mpaign) " & _
"WHERE ((Number = '" & strNr & "') OR (Number = '0" & Right(strNr,
Len(strNr) - 3) & "')) " & _
" AND (SendDate > DATEADD(hh, -" &
watchedSettings ("ReplyValidity Hours") & " ,GETDATE() )) "
'+32486913315 and 0486913315
Dim dtrSql As SqlDataReader
Dim strSqlI As String
Dim strValuesI As String
Try
con.Open()
MessageDebug(st rSql2, "INSERT RECEIVED SMS SQL")
cmdSql = New SqlCommand(strS ql2, con)
dtrSql = cmdSql.ExecuteR eader(CommandBe havior.CloseCon nection)
If dtrSql.HasRows Then
While dtrSql.Read
'EMAIL IT
Try
If Len(dtrSql("Mai l").ToString ) > 0 Then
Dim clsEMail As New
clsMail(watched Settings("From" ), watchedSettings ("FriendlyFrom" ),
watchedSettings ("SmtpServer "))
Dim strSubject As String = ""
Dim strMessage As String = ""
strSubject = "SMS RECEIVED FROM " & strNr & " ("
& dtrSql("tdprNFo y").ToString & dtrSql("tdprNCC D").ToString & " - " &
dtrSql("tdprNSo cFin").ToString & ")"
strMessage = "You received an SMS:" & vbCrLf & _
"GSM NUMBER:" & vbTab & strNr & vbCrLf & _
"FROM:" & vbTab & vbTab & vbTab &
dtrSql("tdprNFo y").ToString & dtrSql("tdprNCC D").ToString & " - " &
dtrSql("tdprNSo cFin").ToString & vbCrLf & _
"DATE:" & vbTab & vbTab & vbTab & Format(dtDate,
"dd/MM/yyyy HH:mm:ss") & vbCrLf & _
"MESSAGE:" & vbTab & vbTab & strMess & vbCrLf &
_
vbCrLf & _
vbTab & "This message was a reply on your SMS:"
& vbCrLf & _
vbTab & "DATE:" & vbTab & vbTab & vbTab & vbTab
& Format(dtrSql(" SendDate"), "dd/MM/yyyy HH:mm:ss") & vbCrLf & _
vbTab & "MESSAGE:" & vbTab & vbTab & vbTab &
dtrSql("Message ").ToString & vbCrLf & _
vbTab & "CAMPAIGN:" & vbTab & vbTab &
dtrSql("Campaig n").ToString & vbCrLf & _
vbTab & "INTERNAL CODE:" & vbTab &
dtrSql("Interna lCode").ToStrin g
If Not
clsEMail.SendMa il2(dtrSql("Mai l").ToString , strSubject, strMessage) Then
InsertReceivedS MS = False
Exit Function
End If
End If
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "Mail Received")
InsertReceivedS MS = False
Exit Function
End Try
strSqlI = strSql & ", Campaign, InternalCode, tdprNFoy,
tdprNCCD, tdprNSocFin"
strValuesI = strValues & ", '" &
dtrSql("Campaig n").ToString & "', '" & dtrSql("Interna lCode").ToStrin g & "',
'" & dtrSql("tdprNFo y").ToString & "', '" & dtrSql("tdprNCC D").ToString &
"', '" & dtrSql("tdprNSo cFin").ToString & "' "
strSqlI = strSqlI & ") VALUES (" & strValuesI & ")"
'INSERT IT
If InsertSMS(strSq lI) Then
InsertReceivedS MS = True
Else
InsertReceivedS MS = False
Exit Function
End If
End While
Else
'geen Send SMS gevonden die er bij hoort: gewoon inserteren!
strSqlI = strSql & ") VALUES (" & strValues & ")"
'INSERT IT
InsertReceivedS MS = InsertSMS(strSq lI)
End If
Catch ex As Exception
ErrorMessageSil ent(Me, ex)
InsertReceivedS MS = False
Finally
If con.State <> ConnectionState .Closed Then
con.Close()
End If
End Try
End Function
Private Function InsertSMS(ByVal strSql As String) As Boolean
'INSERT IT
Dim con As New SqlConnection
Dim cmdSql As SqlCommand
con.ConnectionS tring = watchedSettings ("ConnectionStr ing")
Try
con.Open()
cmdSql = New SqlCommand(strS ql, con)
cmdSql.ExecuteN onQuery()
InsertSMS = True
Catch ex As Exception
ErrorMessageSil ent(Me, ex, strSql)
InsertSMS = False
Finally
If Not con.State = ConnectionState .Closed Then
con.Close()
End If
End Try
End Function
Private Sub RemoveSmsIndex( )
If htbIndex.Count > 0 Then
'delete the last one on the hashtable-stack...
SmsModem.SmsDel ete(htbIndex(ht bIndex.Count - 1))
Else
'you can go on with the next sms...
'start the timer to do the next loop...
'tmrProcessNext .Interval =
watchedSettings ("SendIntervalS econds") * 1000
'tmrProcessNext .Start()
ProcessNextCycl e()
End If
End Sub
Private Sub SmsModem_Sms_Re adingError() Handles
SmsModem.Sms_Re adingError
'error reading sms...
MessageSilent(" Error reading SMS from Modem...",
"SmsModem_Sms_R eadingError")
blnReceived = False
If Not MaxMessageFailu re() Then
'check for received sms...
'ProcessNextCyc le()
'check if pin is good!! (in case connection with modem has been
lost)
SmsModem.PinTes t()
End If
End Sub
Private Sub SmsModem_Sms_Wa itingForMessage () Handles
SmsModem.Sms_Wa itingForMessage
'send the sms..
SmsModem.SmsSen dMessage(clsOut SMS.PDU)
'wait for the event...
End Sub
Private Sub SmsModem_TextMo deChanged(ByVal intTextMode As Integer)
Handles SmsModem.TextMo deChanged
If intTextMode = 0 Then
'set it to text-mode!
SmsModem.SetToT extMode()
'wait for event...
Else
''change CharacterSet
'SmsModem.SetTo UCS2()
'get the first sms!!
ProcessNextCycl e()
End If
End Sub
Private Sub ProcessNextCycl e()
'geen sms verzonden en geen ontvangen...
If (intSMSID = 0) And (Not blnReceived) And (lstSendNext.Co unt <= 0)
Then
'timer- 5 seconden wachten...
'start the timer to do the next loop...
tmrProcessNext. Stop()
tmrProcessNext. Interval =
(CInt(watchedSe ttings("SendInt ervalSeconds")) * 1000)
tmrProcessNext. Start()
Else
'direct volgende pakken!
ProcessSendingS ms()
End If
End Sub
Private Function GetSendNextWher e() As String
If lstSendNext.Cou nt <= 0 Then
GetSendNextWher e = ""
Exit Function
End If
'there are elements in the SendNext
Dim strWhere As String = ""
Dim intX As Integer
For intX = 0 To (lstSendNext.Co unt - 1)
If lstSendNext.Get ByIndex(intX) > Now Then
'not yet allowed to take one of them
If strWhere.Length > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & "(tblSMS.Campai gn <> '" &
lstSendNext.Get Key(intX) & "')"
Else
'you passed the time: you can delete it!
lstSendNext.Rem ove(lstSendNext .GetKey(intX))
End If
Next
If strWhere.Length > 0 Then
strWhere = " AND ((" & strWhere & ") OR (tblSMS.Campaig n IS
NULL)) "
End If
GetSendNextWher e = strWhere
End Function
Private Sub ProcessSendingS ms()
tmrTimeOutProce ssLoop.Stop()
'RefreshXmldSet tings()
tmrTimeOutProce ssLoop.Interval =
watchedSettings ("TimeOutProces sLoopSeconds") * 1000
tmrTimeOutProce ssLoop.Start()
Dim strSql As String
strSql = cstSqlFrom & _
cstSqlWhere & _
" AND ((SendTry < " & watchedSettings ("SendTry") & ") OR (SendTry IS
NULL)) " & _
GetSendNextWher e() & _
" AND ((Modem IS NULL) OR (Modem = '" &
watchedSettings ("FriendlyFrom" ) & "'))" & _
cstSqlOrderBy
'strSql = "BEGIN TRANSACTION " & vbCrLf & _
'"SET DATEFIRST 1 " & _
'vbCrLf & _
'strSql & vbCrLf & _
'vbCrLf & _
'"UPDATE tblSms WITH (XLOCK) SET Modem = '" &
watchedSettings ("FriendlyFrom" ) & "' " & _
'"WHERE SmsID IN (" & Replace(strSql, "SELECT TOP 1 tblSms.* FROM
tblSms WITH (XLOCK)", "SELECT TOP 1 tblSms.SmsID FROM tblSms WITH (XLOCK)")
& _
'")" & vbCrLf & _
'vbCrLf & _
'"COMMIT TRANSACTION"
strSql = "BEGIN TRANSACTION " & vbCrLf & _
"SET DATEFIRST 1 " & _
vbCrLf & _
strSql & vbCrLf & _
vbCrLf & _
"UPDATE tblSms SET Modem = '" & watchedSettings ("FriendlyFrom" ) & "'
" & _
"WHERE SmsID IN (" & Replace(strSql, "SELECT TOP 1 tblSms.* FROM
tblSms WITH (XLOCK)", "SELECT TOP 1 tblSms.SmsID FROM tblSms ") & _
")" & vbCrLf & _
vbCrLf & _
"COMMIT TRANSACTION"
'SELECT TOP 1 tblSms.* FROM tblSms WITH (XLOCK)
Dim con As New SqlConnection
con.ConnectionS tring = watchedSettings ("ConnectionStr ing")
Dim dtrSql As SqlDataReader
Dim cmdSql As SqlCommand
Dim strSendNext As String = ""
Dim strCampaign As String = ""
Try
con.Open()
MessageDebug(st rSql, "SELECT PROCESS SENDING SMS SQL")
cmdSql = New SqlCommand(strS ql, con)
dtrSql = cmdSql.ExecuteR eader(CommandBe havior.SingleRo w)
Try
If Not dtrSql.HasRows Then
'no SMS to send:
'no current sms:
intSMSID = 0
'timer terug aan en af zetten!
tmrNotSend.Stop ()
tmrNotSend.Inte rval =
watchedSettings ("TimeOutNotSen dMinutes") * 60 * 1000
tmrNotSend.Star t()
'check for received sms...
ProcessReceived Sms()
Else
'there is an sms to send...
dtrSql.Read()
'id of current sms
intSMSID = dtrSql.Item("SM SID")
'set the number as you want it to receive...
strNumber = MakeValidNumber (dtrSql.Item("N umber"))
'max 160 characters!! (see configfile for max)
strMessage = Left(dtrSql.Ite m("Message"),
CInt(watchedSet tings("MaxSmsLe n")))
clsOutSMS = New clsPDUEncode
clsOutSMS.Encod eOutgoingSMS(st rNumber, strMessage,
clsPDUEncode.en umDestination.I nternationalNum ber)
strSendNext = dtrSql.Item("Se ndNext").ToStri ng
If IsNumeric(strSe ndNext) Then
strCampaign = dtrSql.Item("Ca mpaign").ToStri ng
If (strCampaign.Le ngth > 0) And (CInt(strSendNe xt) >
0) Then
'add the SendNext to the SortedList!
lstSendNext.Add (strCampaign,
DateAdd(DateInt erval.Second, CInt(strSendNex t), Now))
End If
End If
SmsModem.SmsSen dNumber(clsOutS MS.PDU_Len)
'waiting for event from the modem...
End If
Catch ex As Exception
ErrorMessageSil ent(Me, ex)
Finally
dtrSql.Close()
End Try
Catch ex As Exception
ErrorMessageSil ent(Me, ex)
Finally
If Not con.State = ConnectionState .Closed Then
con.Close()
End If
End Try
'wachen op event...
End Sub
Private Sub UpdateTblSMS(By Val intID As Integer, ByVal blnFailed As
Boolean, Optional ByVal strError As String = "")
Dim strSql As String
strSql = "UPDATE tblSMS SET SendTry = COALESCE(SendTr y + 1, 1) "
'If blnFailed Then
' 'Add x minutes to MemoDate
' strSql = strSql & ", MemoDate = '" & _
' Format(DateAdd( DateInterval.Se cond,
CInt(watchedSet tings("ResendSe conds")), Now), "yyyy-MM-ddTHH:mm:ss") & "' "
'Else
' strSql = strSql & ", SendDate = '" & Format(Now,
"yyyy-MM-ddTHH:mm:ss") & "' "
'End If
If blnFailed Then
'Add x minutes to MemoDate
strSql = strSql & ", MemoDate = " & _
"DATEADD(ss , " & watchedSettings ("ResendSeconds ") & "
,GETDATE() ) "
Else
strSql = strSql & ", SendDate = GETDATE() "
End If
If strError.Length > 0 Then
strSql = strSql & ", Error = '" & strError & "' "
End If
strSql = strSql & " WHERE SMSID = " & intID
Dim con As New SqlConnection
con.ConnectionS tring = watchedSettings ("ConnectionStr ing")
Dim cmdSql As SqlCommand
Try
con.Open()
cmdSql = New SqlCommand(strS ql, con)
cmdSql.ExecuteN onQuery()
Catch ex As Exception
ErrorMessageSil ent(Me, ex)
Finally
If Not con.State = ConnectionState .Closed Then
con.Close()
End If
End Try
End Sub
Private Sub ProcessReceived Sms()
'ask the modem the received sms...
blnReceived = False
SmsModem.SmsRea dAll()
'wait for event...
End Sub
Private Sub SmsModem_TimeOu tWaitingForAnsw er() Handles
SmsModem.TimeOu tWaitingForAnsw er
SmsModem.ResetM odem()
End Sub
Private Sub SmsModem_TimeOu tWaitingForVali dAnswer() Handles
SmsModem.TimeOu tWaitingForVali dAnswer
ProcessNextCycl e()
End Sub
Private Sub SmsModem_UnKnow nRead(ByVal strReceived As String, ByVal
mstModemStatus As clsSMSModem.enu mModemStatus) Handles SmsModem.UnKnow nRead
MessageSilent(" Unknown Read from Modem: " & strReceived & " -
ModemStatus = " & mstModemStatus, "SmsModem_UnKno wnRead")
End Sub
Private Sub DeleteErrorFile s()
MessageSilent(" Deleting Old Logfiles...")
Dim colF As New Collection
Dim clsF As New clsFile
Dim intX As Integer
colF = clsF.GetAllFile sInDirOlder(App lication.Startu pPath, "*.err",
DateAdd(DateInt erval.Day, -CDbl(watchedSet tings("DeleteLo gFilesDays")),
Now))
For intX = 1 To colF.Count
MessageSilent(" Deleting File " & colF(intX))
Try
clsF.FileDelete (colF.Item(intX ))
Catch ex As Exception
End Try
Next
End Sub
Private Sub tmrProcessNext_ Elapsed(ByVal sender As Object, ByVal e As
System.Timers.E lapsedEventArgs ) Handles tmrProcessNext. Elapsed
tmrProcessNext. Stop()
'get the next sms in the database...
ProcessSendingS ms()
End Sub
Private Sub tmrDelete_Elaps ed(ByVal sender As Object, ByVal e As
System.Timers.E lapsedEventArgs ) Handles tmrDelete.Elaps ed
MessageMail("SM S Server still working...", "SMS SERVER NOTIFICATION:
Keep alive message...")
DeleteErrorFile s()
End Sub
Private Sub tmrTimeOutProce ssLoop_Elapsed( ByVal sender As Object, ByVal
e As System.Timers.E lapsedEventArgs ) Handles tmrTimeOutProce ssLoop.Elapsed
'alreaddy a given time not searched for an sms....
tmrTimeOutProce ssLoop.Stop()
ProcessSendingS ms()
End Sub
Private Function MaxMessageFailu re() As Boolean
pryMessagesFail ed = pryMessagesFail ed + 1
If pryMessagesFail ed > 0 Then
MessageSilent(" MessageFailed = " & m_intMessagesFa iled,
"MaxMessageFail ure")
If m_intMessagesFa iled >=
CInt(watchedSet tings("MaxMessa geFailure")) Then
MessageSilent(" MaxMessageFailu re has been reached!
(MaxMessageFail ure = " & watchedSettings ("MaxMessageFai lure") & ")",
"MaxMessageFail ure")
m_intMessagesFa iled = 0
MaxMessageFailu re = True
SmsModem.ResetM odem()
Else
'go on with process: get next process
MaxMessageFailu re = False
End If
Else
MaxMessageFailu re = False
End If
End Function
Private Sub tmrNotSend_Elap sed(ByVal sender As Object, ByVal e As
System.Timers.E lapsedEventArgs ) Handles tmrNotSend.Elap sed
MessageSilent(" Didn't receive a valid notification from SMS Modem
(Sending SMS)", "tmrNotSend_Ela psed")
MessageMail("tm rNotSend_Elapse d" & vbTab & "Restarting Server...",
"SMS SERVER ERROR: tmrNotSend_Elap sed!")
StopServer()
StartServer()
End Sub
Private Sub tmrNotReceived_ Elapsed(ByVal sender As Object, ByVal e As
System.Timers.E lapsedEventArgs ) Handles tmrNotReceived. Elapsed
MessageSilent(" Didn't receive a valid notification from SMS Modem
(Receiving SMS)", "tmrNotReceived _Elapsed")
MessageMail("tm rNotReceived_El apsed" & vbTab & "Restarting
Server...", "SMS SERVER ERROR: tmrNotReceived_ Elapsed!")
StopServer()
StartServer()
End Sub
#End Region
End Class
Option Explicit On
Imports System.IO.Ports
Imports System.Data
Imports System.Data.Sql Client
Public Class clsSMSModem
#Region "Variabel Declarations"
Public WithEvents SerialPort1 As New SerialPort
Private WithEvents tmrWaitForValid Answer As New Timers.Timer
Private m_ModemStatus As enumModemStatus
Private WithEvents tmrReadComPort As New Timer
Private strBigMessage As String = ""
Private blnReceivedAnsw er As Boolean = False
#End Region
#Region "Event Declarations"
'OnComm-event: the normal ReceivedData-event
Public Event OnComm(ByVal strReceived As String, ByVal mstModemStatus As
enumModemStatus )
Public Event ComPortNotAvail able()
Public Event TimeOutWaitingF orAnswer()
Public Event TimeOutWaitingF orValidAnswer()
'Modem-Status-Changed
Public Event Modem_StatusCha nged(ByVal OldStatus As enumModemStatus ,
ByVal NewStatus As enumModemStatus )
'Modem Resetted
Public Event Modem_Resetted( )
'PIN-events
Public Event Pin_WaitingForI nput()
Public Event Pin_NotRight()
Public Event Pin_Right()
'TextMode
Public Event TextModeChanged (ByVal intTextMode As Integer)
'Character Set
Public Event CharacterSetCha nged(ByVal strSet As String)
'Test Modem
Public Event Modem_TestSucce ed()
'SMS-events
Public Event Sms_NumberError ()
Public Event Sms_WaitingForM essage()
Public Event Sms_MessageErro r()
Public Event Sms_MessageSend ()
'SMS-reading events
Public Event Sms_Read(ByVal dtblSMS As DataTable)
Public Event Sms_ReadingErro r()
Public Event Sms_Deleted()
Public Event Sms_DeletingErr or()
'unknow-event
Public Event UnKnownRead(ByV al strReceived As String, ByVal
mstModemStatus As enumModemStatus )
#End Region
#Region "Constants "
Public Const cstCR As String = vbCr '= Chr(13)
Public Const cstLF As String = vbLf
#End Region
#Region "Enumeratio ns"
Public Enum enumModemStatus
Unknown = 0
Ready = 1
WritingMessage = 2
ReadMessage = 3
Resetting = 10
Resetted = 11
PinWaiting = 20
PinValidation = 21
PinValidated = 22
TestModem = 25
TestFailed = 26
TestSucces = 27
SmsNumberSendin g = 30
SmsNumberError = 31
SmsWaitingForMe ssage = 32
SmsMessageSendi ng = 33
SmsMessageError = 34
SmsMessageSend = 35
SmsMessageReadi ng = 40
SmsMessageHasRe ad = 41
SmsMessageReadi ngError = 42
SmsMessageDelet ing = 43
SmsMessageDelet ingError = 44
SmsMessageDelet ed = 45
TextModeValidat ion = 50
TextModeValidat ed = 51
TextMode1 = 52
TextMode0 = 53
CharacterSetVal idation = 60
CharacterSetVal idated = 61
CharacterSetGSM = 62
CharacterSetUCS 2 = 63
End Enum
#End Region
#Region "Propertys"
Private Property ModemStatus() As enumModemStatus
Get
ModemStatus = m_ModemStatus
End Get
Set(ByVal value As enumModemStatus )
'raise event that the status of the modem has changed...
RaiseEvent Modem_StatusCha nged(m_ModemSta tus, value)
m_ModemStatus = value
End Set
End Property
#End Region
#Region "Public Methods"
Public Function IsPortAvailable (ByVal strPortName As String) As Boolean
' This function attempts to open the passed Comm Port. If it is
' available, it returns True, else it returns False. To determine
' availability a Try-Catch block is used.
Try
SerialPort1.Por tName = strPortName
SerialPort1.Ope n()
' If it makes it to here, then the Comm Port is available.
SerialPort1.Clo se()
Return True
Catch ex As Exception
' If it gets here, then the attempt to open the Comm Port
' was unsuccessful.
Return False
End Try
End Function
Public Function OpenComPort(ByV al strPortName As String, ByVal
intBaudRate As Integer, ByVal intDataBits As Integer, ByVal parParity As
Parity, ByVal stbStopBits As StopBits, ByVal hskHandShake As Handshake) As
Boolean
'MessageBox.Sho w(IsPortAvailab le("COM1"))
Try
SerialPort1.Por tName = strPortName '"COM1"
SerialPort1.Bau dRate = intBaudRate '9600
SerialPort1.Dat aBits = intDataBits '8
SerialPort1.Par ity = parParity 'Parity.None
SerialPort1.Sto pBits = stbStopBits 'StopBits.One
SerialPort1.Han dshake = hskHandShake 'Handshake.None
SerialPort1.Ope n()
'SerialPort1.En coding = System.Text.Enc oding.GetEncodi ng(28591)
OpenComPort = True
Catch ex As Exception
OpenComPort = False
End Try
End Function
Public Function CloseComPort() As Boolean
'MessageBox.Sho w(IsPortAvailab le("COM1"))
Try
tmrWaitForValid Answer.Stop()
SerialPort1.Clo se()
CloseComPort = True
Catch ex As Exception
CloseComPort = False
End Try
End Function
Public Function WriteToComPort( ByVal strMessage As String) As Boolean
' do not write other stuff when the modem is resetting (due to an
error or something like this)
If Not ModemStatus = enumModemStatus .Resetting Then
Try
MessageDebug("W RITE: " & strMessage)
SerialPort1.Wri te(strMessage)
blnReceivedAnsw er = False
WriteToComPort = True
tmrWaitForValid Answer.Interval =
watchedSettings ("TimeOutValidA nswerSeconds") * 1000
tmrWaitForValid Answer.Stop()
tmrWaitForValid Answer.Start()
Catch ex As Exception
WriteToComPort = False
RaiseEvent ComPortNotAvail able()
End Try
End If
End Function
Public Sub TestModem()
ModemStatus = enumModemStatus .TestModem
WriteToComPort( "AT" & cstCR)
'tmrReadComPort .Interval = 1000
'tmrReadComPort .Start()
End Sub
Public Sub ResetModem()
ModemStatus = enumModemStatus .Ready
tmrWaitForValid Answer.Stop()
tmrReadComPort. Stop()
WriteToComPort( "AT#RESET" & cstCR)
MessageSilent(" Resetting the Modem...")
ModemStatus = enumModemStatus .Resetting
'tmrReadComPort .Interval = 30000 'getest: 20 à 25, 30 voor 't
zekerste
'tmrReadComPort .Start()
End Sub
Public Sub PinTest()
ModemStatus = enumModemStatus .PinValidation
WriteToComPort( "AT+CPIN?" & cstCR)
'tmrReadComPort .Interval = 2000
'tmrReadComPort .Start()
End Sub
Public Sub PinInsert(ByVal strPin As String)
ModemStatus = enumModemStatus .PinValidation
WriteToComPort( "AT+CPIN=" & strPin & cstCR)
MessageSilent(" Inserting the Pin...")
'tmrReadComPort .Interval = 4000 'getest '2 à 3
'tmrReadComPort .Start()
End Sub
Public Sub SetToTextMode()
ModemStatus = enumModemStatus .TextModeValida tion
WriteToComPort( "AT+CMGF=1" & cstCR)
MessageSilent(" Setting to TextMode...")
'tmrReadComPort .Interval = 1000 'getest: minder dan halve seconde
'tmrReadComPort .Start()
End Sub
Public Sub SetToUCS2()
ModemStatus = enumModemStatus .CharacterSetVa lidation
WriteToComPort( "AT+CSCS=" & Chr(34) & "UCS2" & Chr(34) & cstCR)
MessageSilent(" Setting to UCS2 Character Set...")
End Sub
Public Sub SmsSendNumber(B yVal strNumber As String)
ModemStatus = enumModemStatus .SmsNumberSendi ng
WriteToComPort( "AT+CMGS=" & strNumber & cstCR)
End Sub
Public Sub SmsSendMessage( ByVal strMessage As String)
ModemStatus = enumModemStatus .SmsMessageSend ing
WriteToComPort( strMessage & Chr(26))
'tmrReadComPort .Interval = 6000 'getest: 5,5 seconden
'tmrReadComPort .Start()
End Sub
Public Sub SmsReadAll()
ModemStatus = enumModemStatus .SmsMessageRead ing
'WriteToComPort ("AT+CMGL=AL L" & cstCR) 'text-mode
WriteToComPort( "AT+CMGL=4" & cstCR) 'pdu-mode
'tmrReadComPort .Interval = 2000 '0,1 à 0,2 s per smsje... '1500
was niet genoeg
'tmrReadComPort .Start()
End Sub
Public Sub SmsDelete(ByVal intIndex As Integer)
ModemStatus = enumModemStatus .SmsMessageDele ting
If watchedSettings ("DeleteReceive dSMS") Then
WriteToComPort( "AT+CMGD=" & intIndex & cstCR)
Else
'in test-mode niet deleten!:
'doen alsof het gedelete is!
ModemStatus = enumModemStatus .SmsMessageDele ted
RaiseEvent Sms_Deleted()
End If
End Sub
#End Region
#Region "Private Methods"
Public Sub New()
Dim currentDomain As AppDomain = AppDomain.Curre ntDomain
AddHandler currentDomain.U nhandledExcepti on, AddressOf MyHandler
AddHandler System.Windows. Forms.Applicati on.ThreadExcept ion,
AddressOf GlobalErrorHand ler
End Sub
Private Function ReadSerialPort( ) As String
Dim strMessage As String = ""
Dim intX As Integer
Try
intX = SerialPort1.Byt esToRead
Do
strMessage = strMessage & Chr(SerialPort1 .ReadChar)
If SerialPort1.Byt esToRead <= 0 Then
Exit Do
End If
Loop
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "ReadSerial Port Exception: ",
"ReadSerialPort ")
Finally
ReadSerialPort = strMessage
MessageDebug("R EAD: " & strMessage)
End Try
End Function
Private Sub SerialPort1_Err orEvent(ByVal sender As Object, ByVal e As
System.IO.Ports .SerialErrorEve ntArgs) Handles SerialPort1.Err orEvent
MessageSilent(" Modem Error", "SerialPort1_Er rorEvent")
End Sub
Private Sub SerialPort1_Rec eivedEvent(ByVa l sender As Object, ByVal e As
System.IO.Ports .SerialReceived EventArgs) Handles SerialPort1.Rec eivedEvent
Dim strMessage As String = ""
strMessage = ReadSerialPort( )
blnReceivedAnsw er = True
'OnComm-event works always...
RaiseEvent OnComm(strMessa ge, ModemStatus)
strBigMessage = strBigMessage & strMessage
EvaluateReceive dText2(strBigMe ssage)
End Sub
Private Sub ReceivedManual( )
Dim strMessage As String = ""
strMessage = ReadSerialPort( )
'OnComm-event works always...
RaiseEvent OnComm(strMessa ge, ModemStatus)
EvaluateReceive dText(strMessag e)
End Sub
Private Sub EvaluateReceive dText2(ByVal strMessage As String)
Try
If (Right(strMessa ge, 18) = ("SIM PIN REQUIRED" & cstCR &
cstLF)) Then
'MODEM HAS BEEN RESET!
ModemStatus = enumModemStatus .Resetted
HadValidAnswer( )
MessageSilent(" Modem Resetted...")
RaiseEvent Modem_Resetted( )
'exit this sub...
Exit Sub
End If
Select Case ModemStatus
Case enumModemStatus .TestModem
If (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF)) Then
ModemStatus = enumModemStatus .TestSucces
HadValidAnswer( )
MessageSilent(" Modem Tested...")
RaiseEvent Modem_TestSucce ed()
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .Resetting
'first OK, after 20-30 seconds: "SIM PIN REQUIRED"
'SIM PI
'N REQUIR
'ED
If (Right(strMessa ge, 18) = ("SIM PIN REQUIRED" & cstCR
& cstLF)) Then
'If InStr(strMessag e, "SIM PIN REQUIRED") > 0 Then
'If InStr(strMessag e, "N REQUIR") > 0 Then
ModemStatus = enumModemStatus .Resetted
HadValidAnswer( )
MessageSilent(" Modem Resetted...")
RaiseEvent Modem_Resetted( )
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .PinValidation
If (Right(strMessa ge, 7) = ("ERROR" & cstCR & cstLF))
Then
'no the right pin!
ModemStatus = enumModemStatus .PinWaiting
HadValidAnswer( )
MessageSilent(" Pin Error!")
RaiseEvent Pin_NotRight()
ElseIf Right(strMessag e, 15) = ("SIM PIN" & cstCR &
cstLF & cstCR & cstLF & "OK" & cstCR & cstLF) Then
'+CPIN: SIM PIN = Waiting for the PIN-number!(after
a AT+CPIN?)
ModemStatus = enumModemStatus .PinWaiting
HadValidAnswer( )
MessageSilent(" Pin Waiting...")
RaiseEvent Pin_WaitingForI nput()
ElseIf Right(strMessag e, 12) = ("READY" & cstCR & cstCR
& cstLF & "OK" & cstCR & cstLF) Then
ModemStatus = enumModemStatus .PinValidated
HadValidAnswer( )
MessageSilent(" Pin Ready...")
RaiseEvent Pin_Right()
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
ModemStatus = enumModemStatus .PinValidated
HadValidAnswer( )
MessageSilent(" Pin OK...")
RaiseEvent Pin_Right()
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .TextModeValida tion
If (Right(strMessa ge, 8) = ("1" & cstCR & cstCR & cstLF
& "OK" & cstCR & cstLF)) Then
'+CMGF: 1 after a AT+CMGF?
'AT+CMGF=1 -> after a AT+CMGF=1
'OK()
'
ModemStatus = enumModemStatus .TextMode1
HadValidAnswer( )
MessageSilent(" TextMode changed = 1...")
RaiseEvent TextModeChanged (1)
ElseIf (Right(strMessa ge, 8) = ("0" & cstCR & cstCR &
cstLF & "OK" & cstCR & cstLF)) Then
'+CMGF: 0 after a AT+CMGF?
'AT+CMGF=0 -> after a AT+CMGF=0
'OK()
'
ModemStatus = enumModemStatus .TextMode0
HadValidAnswer( )
MessageSilent(" TextMode changed = 0...")
RaiseEvent TextModeChanged (0)
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
'OK after a AT+CMGF=0 or AT+CMGF=1
ModemStatus = enumModemStatus .TextModeValida ted
HadValidAnswer( )
MessageSilent(" TextMode changed = ?...")
RaiseEvent TextModeChanged (-1)
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .CharacterSetVa lidation
If (Right(strMessa ge, 12) = ("UCS2" & Chr(34) & cstCR &
cstCR & cstLF & "OK" & cstCR & cstLF)) Then
'"AT+CSCS="UCS2 "
'
'OK
'"
ModemStatus = enumModemStatus .CharacterSetUC S2
HadValidAnswer( )
MessageSilent(" Character Set changed = UCS2...")
RaiseEvent CharacterSetCha nged("UCS2")
ElseIf (Right(strMessa ge, 11) = ("GSM" & Chr(34) & cstCR
& cstCR & cstLF & "OK" & cstCR & cstLF)) Then
'"AT+CSCS="G SM"
'
'OK
'"
ModemStatus = enumModemStatus .CharacterSetGS M
HadValidAnswer( )
MessageSilent(" Character Set changed = GSM...")
RaiseEvent CharacterSetCha nged("GSM")
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
'OK
ModemStatus = enumModemStatus .CharacterSetVa lidated
HadValidAnswer( )
MessageSilent(" Character Set changed = ?...")
RaiseEvent CharacterSetCha nged("?")
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .SmsNumberSendi ng
If (Right(strMessa ge, 7) = ("ERROR" & cstCR & cstLF))
Then
'ERROR
ModemStatus = enumModemStatus .SmsNumberError
'pryMessagesFai led = pryMessagesFail ed + 1
HadValidAnswer( )
RaiseEvent Sms_NumberError ()
ElseIf (Right(strMessa ge, 5) = cstCR & cstCR & cstLF &
"> ") Then
'"AT+CMGS="+324 86913315"
'
'> "
ModemStatus = enumModemStatus .SmsWaitingForM essage
HadValidAnswer( )
RaiseEvent Sms_WaitingForM essage()
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .SmsMessageSend ing
If (InStr(Right(st rMessage, 18), "+CMGS: ") > 0) And
(Right(strMessa ge, 4) = ("OK" & cstCR & cstLF)) Then
'+CMGS: 9 OK '9 = number that counts
ModemStatus = enumModemStatus .SmsMessageSend
'pryMessagesFai led = 0
HadValidAnswer( )
RaiseEvent Sms_MessageSend ()
ElseIf (Right(strMessa ge, 9) = (cstCR & cstLF & "ERROR"
& cstCR & cstLF)) Then
'"ERROR"
ModemStatus = enumModemStatus .SmsMessageErro r
'pryMessagesFai led = pryMessagesFail ed + 1
HadValidAnswer( )
RaiseEvent Sms_MessageErro r()
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
'no CMGS in it: not right...
ModemStatus = enumModemStatus .SmsMessageErro r
'pryMessagesFai led = pryMessagesFail ed + 1
HadValidAnswer( )
RaiseEvent Sms_MessageErro r()
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .SmsMessageRead ing
If (Right(strMessa ge, 7) = ("ERROR" & cstCR & cstLF))
Then
'"ERROR"
ModemStatus = enumModemStatus .SmsMessageRead ingError
HadValidAnswer( )
RaiseEvent Sms_ReadingErro r()
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
'+CMGL: 2,"REC
READ","+3247999 0284",,"04/06/30,12:46:33+08"
'de 2e test naar mezelf
'+CMGL: 3,"REC
READ","+3249527 5242",,"04/06/29,18:57:47+08"
'Proficiat van ons en van de fam boschkes
'OK
ModemStatus = ModemStatus.Sms MessageHasRead
HadValidAnswer( )
'put the received SMS in the DataTable...
RaiseEvent
Sms_Read(AddRea dSmsToTablePDU( strMessage))
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case enumModemStatus .SmsMessageDele ting
If (Right(strMessa ge, 7) = ("ERROR" & cstCR & cstLF))
Then
'"ERROR"
ModemStatus =
enumModemStatus .SmsMessageDele tingError
HadValidAnswer( )
RaiseEvent Sms_DeletingErr or()
ElseIf (Right(strMessa ge, 4) = ("OK" & cstCR & cstLF))
Then
'OK
ModemStatus = ModemStatus.Sms MessageDeleted
HadValidAnswer( )
RaiseEvent Sms_Deleted()
Else
'RaiseEvent UnKnownRead(str Message, ModemStatus)
'wait...
End If
Case Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End Select
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "SerialPort1_Re ceivedEvent Exception:
", "SerialPort1_Re ceivedEvent")
End Try
End Sub
Private Sub HadValidAnswer( )
tmrWaitForValid Answer.Stop()
DebugEvaluate(s trBigMessage)
strBigMessage = ""
End Sub
Private Sub EvaluateReceive dText(ByVal strMessage As String)
Try
Select Case ModemStatus
Case enumModemStatus .TestModem
If InStr(strMessag e, "OK") > 0 Then
ModemStatus = enumModemStatus .TestSucces
HadValidAnswer( )
MessageSilent(" Modem Tested...")
RaiseEvent Modem_TestSucce ed()
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .Resetting
'first OK, after 20-30 seconds: "SIM PIN REQUIRED"
'SIM PI
'N REQUIR
'ED
If Right(strMessag e, 18) = ("SIM PIN REQUIRED" & cstLF &
cstCR) Then
'If InStr(strMessag e, "N REQUIR") > 0 Then
ModemStatus = enumModemStatus .Resetted
HadValidAnswer( )
MessageSilent(" Modem Resetted...")
RaiseEvent Modem_Resetted( )
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .PinValidation
If InStr(strMessag e, "ERROR") > 0 Then
'no the right pin!
ModemStatus = enumModemStatus .PinWaiting
HadValidAnswer( )
MessageSilent(" Pin Error!")
RaiseEvent Pin_NotRight()
ElseIf InStr(strMessag e, "SIM PIN") > 0 Then
'+CPIN: SIM PIN = Waiting for the PIN-number!(after
a AT+CPIN?)
ModemStatus = enumModemStatus .PinWaiting
HadValidAnswer( )
MessageSilent(" Pin Waiting...")
RaiseEvent Pin_WaitingForI nput()
ElseIf InStr(strMessag e, "READY") > 0 Then
ModemStatus = enumModemStatus .PinValidated
HadValidAnswer( )
MessageSilent(" Pin Ready...")
RaiseEvent Pin_Right()
ElseIf InStr(strMessag e, "OK") > 0 Then
ModemStatus = enumModemStatus .PinValidated
HadValidAnswer( )
MessageSilent(" Pin OK...")
RaiseEvent Pin_Right()
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .TextModeValida tion
If InStr(strMessag e, "1") > 0 Then
'+CMGF: 1 after a AT+CMGF?
ModemStatus = enumModemStatus .TextMode1
HadValidAnswer( )
MessageSilent(" TextMode changed = 1...")
RaiseEvent TextModeChanged (1)
ElseIf InStr(strMessag e, "0") > 0 Then
'+CMGF: 0 after a AT+CMGF?
ModemStatus = enumModemStatus .TextMode0
HadValidAnswer( )
MessageSilent(" TextMode changed = 0...")
RaiseEvent TextModeChanged (0)
ElseIf InStr(strMessag e, "OK") > 0 Then
'OK after a AT+CMGF=0 or AT+CMGF=1
ModemStatus = enumModemStatus .TextModeValida ted
HadValidAnswer( )
MessageSilent(" TextMode changed = ?...")
RaiseEvent TextModeChanged (-1)
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .SmsNumberSendi ng
If InStr(strMessag e, "ERROR") > 0 Then
'ERROR
ModemStatus = enumModemStatus .SmsNumberError
HadValidAnswer( )
'pryMessagesFai led = pryMessagesFail ed + 1
RaiseEvent Sms_NumberError ()
ElseIf InStr(strMessag e, ">") > 0 Then
'>
ModemStatus = enumModemStatus .SmsWaitingForM essage
HadValidAnswer( )
RaiseEvent Sms_WaitingForM essage()
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .SmsMessageSend ing
If InStr(strMessag e, "ERROR") > 0 Then
'"ERROR"
ModemStatus = enumModemStatus .SmsMessageErro r
HadValidAnswer( )
'pryMessagesFai led = pryMessagesFail ed + 1
RaiseEvent Sms_MessageErro r()
ElseIf (InStr(strMessa ge, "+CMGS: ") > 0) And
(InStr(Right(st rMessage, 10), "OK") > 0) Then
'+CMGS: 9 OK '9 = number that counts
ModemStatus = enumModemStatus .SmsMessageSend
HadValidAnswer( )
'pryMessagesFai led = 0
RaiseEvent Sms_MessageSend ()
ElseIf InStr(strMessag e, "OK") > 0 Then
'no CMGS in it: not right...
ModemStatus = enumModemStatus .SmsMessageErro r
HadValidAnswer( )
'pryMessagesFai led = pryMessagesFail ed + 1
RaiseEvent Sms_MessageErro r()
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .SmsMessageRead ing
If InStr(strMessag e, "ERROR") > 0 Then
'"ERROR"
ModemStatus = enumModemStatus .SmsMessageRead ingError
HadValidAnswer( )
RaiseEvent Sms_ReadingErro r()
ElseIf InStr(Right(str Message, 8), "OK") > 0 Then
'+CMGL: 2,"REC
READ","+3247999 0284",,"04/06/30,12:46:33+08"
'de 2e test naar mezelf
'+CMGL: 3,"REC
READ","+3249527 5242",,"04/06/29,18:57:47+08"
'Proficiat van ons en van de fam boschkes
'OK
ModemStatus = ModemStatus.Sms MessageHasRead
HadValidAnswer( )
'put the received SMS in the DataTable...
RaiseEvent
Sms_Read(AddRea dSmsToTablePDU( strMessage))
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case enumModemStatus .SmsMessageDele ting
If InStr(strMessag e, "ERROR") > 0 Then
'"ERROR"
ModemStatus =
enumModemStatus .SmsMessageDele tingError
HadValidAnswer( )
RaiseEvent Sms_DeletingErr or()
ElseIf InStr(strMessag e, "OK") > 0 Then
'OK
ModemStatus = ModemStatus.Sms MessageDeleted
HadValidAnswer( )
RaiseEvent Sms_Deleted()
Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End If
Case Else
RaiseEvent UnKnownRead(str Message, ModemStatus)
End Select
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "SerialPort1_Re ceivedEvent Exception:
", "SerialPort1_Re ceivedEvent")
End Try
End Sub
Public Function AddReadSmsToTab le(ByVal strMessages As String) As
DataTable
Dim dtbl As New DataTable
dtbl = MakeSmsReceived Table()
Dim drowRow As DataRow
Dim strColSMS As String() 'contains all the SMS...
strColSMS = Split(strMessag es, "+CMGL:")
Dim strSMS As String() 'contains 1 SMS
Dim strData As String() 'contains the Data of 1 SMS
Dim intAantal As Integer
Dim dtDate As Date
intAantal = strColSMS.GetUp perBound(0)
Dim intX As Integer
'1, niet 0, want de eerste strColSMS is ne lege...
If intAantal > 0 Then
For intX = 1 To intAantal
Try
'split by Chr(13)
'voor 't zekerste!!! indien de lijnen egscheiden zouden
zijn door vbCrLf ipv Chr(13)
strColSMS(intX) = Replace(strColS MS(intX), vbCrLf,
Chr(13))
strSMS = Split(strColSMS (intX), Chr(13))
strData = Split(strSMS(0) , ",")
drowRow = dtbl.NewRow
drowRow.Item("I ndex") = Trim(strData(0) )
drowRow.Item("S tatus") = Replace(Trim(st rData(1)), """",
"")
drowRow.Item("N umber") = Replace(Trim(st rData(2)), """",
"")
'"04/06/30,12:46:33+08"
dtDate = Mid(strData(4), 8, 2) & Mid(strData(4), 4, 4) &
Mid(strData(4), 2, 2) & " " & Mid(strData(5), 1, 8) & "." & Mid(strData(5),
10, 2)
drowRow.Item("D ate") = dtDate
drowRow.Item("M essage") = strSMS(1)
dtbl.Rows.Add(d rowRow)
Catch ex As Exception
ErrorMessageSil ent(Me, ex)
End Try
Next
End If
AddReadSmsToTab le = dtbl
End Function
Public Function AddReadSmsToTab lePDU(ByVal strMessages As String) As
DataTable
Dim dtbl As New DataTable
dtbl = MakeSmsReceived Table()
Dim drowRow As DataRow
Dim strColSMS As String() 'contains all the SMS...
strColSMS = Split(strMessag es, "+CMGL:")
Dim strSMS As String() 'contains 1 SMS
Dim strData As String() 'contains the Data of 1 SMS
Dim intAantal As Integer
Dim dtDate As Date
Dim strType As String = ""
Dim strNumber As String = ""
Dim strMessage As String = ""
intAantal = strColSMS.GetUp perBound(0)
Dim intX As Integer
'1, niet 0, want de eerste strColSMS is ne lege...
If intAantal > 0 Then
For intX = 1 To intAantal
Try
'split by Chr(13)
'voor 't zekerste!!! indien de lijnen gescheiden zouden
zijn door vbCrLf ipv Chr(13)
Try
strColSMS(intX) = Replace(strColS MS(intX), vbCrLf,
Chr(13))
strSMS = Split(strColSMS (intX), Chr(13))
strData = Split(strSMS(0) , ",")
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "|" & strMessages & "|" &
intAantal, "PDUCode = strSMS(1)")
End Try
Dim s As Object
Dim PDUCode As String = ""
Try
PDUCode = strSMS(1)
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "|" & strMessages & "|" &
intAantal, "PDUCode = strSMS(1)")
End Try
Dim T As clsPDUDecode.SM SType =
clsPDUDecode.Ge tSMSType(PDUCod e)
strType = T.ToString
Try
Select Case T
Case clsPDUDecode.SM SType.EMS_RECEI VED
s = New EMS_RECEIVED(PD UCode)
strNumber = s.SrcAddressVal ue
dtDate = s.TP_SCTS
'txtResult.Text += "From:" +
s.SrcAddressVal ue + " Time:" + s.TP_SCTS + vbCrLf + vbCrLf
Case clsPDUDecode.SM SType.SMS_RECEI VED
s = New SMS_RECEIVED(PD UCode)
strNumber = s.SrcAddressVal ue
dtDate = s.TP_SCTS
'txtResult.Text += "From:" +
s.SrcAddressVal ue + " Time:" + s.TP_SCTS + vbCrLf + vbCrLf
Case clsPDUDecode.SM SType.EMS_SUBMI T
s = New EMS_SUBMIT(PDUC ode)
strNumber = s.SrcAddressVal ue
dtDate = Now
'txtResult.Text += "Send to:" +
s.DesAddressVal ue + vbCrLf + vbCrLf
Case clsPDUDecode.SM SType.SMS_SUBMI T
s = New SMS_SUBMIT(PDUC ode)
strNumber = s.SrcAddressVal ue
dtDate = Now
'txtResult.Text += "Send to:" +
s.DesAddressVal ue + vbCrLf + vbCrLf
Case clsPDUDecode.SM SType.SMS_STATU S_REPORT
s = New SMS_STATUS_REPO RT(PDUCode)
strNumber = s.SrcAddressVal ue
dtDate = s.TP_DP
'txtResult.Text += "Send time:" + s.TP_SCTS
+ " Receive time:" + s.TP_DP + " ״̬:" + s.status + vbCrLf + vbCrLf
Case Else
'"Sorry, maybe it is a wrong PDU Code"
End Select
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "|" & strMessages & "|" &
intAantal & vbCrLf & T.ToString, "Select Case SMSType")
End Try
If s.tp_DCS = 0 Then
'txtResult.Text += s.decode7bit(s. tp_ud) + vbCrLf
strMessage = s.decode7bit(s. tp_ud, s.tp_udl)
Else
'txtResult.Text = txtResult.Text +
s.DecodeUnicode (s.TP_UD) + vbCrLf
strMessage = ""
End If
drowRow = dtbl.NewRow
'If (T = clsPDUDecode.SM SType.SMS_RECEI VED) Or (T =
clsPDUDecode.SM SType.EMS_RECEI VED) Then
'eentje ontvangen: zet het in de database!!
Try
drowRow.Item("I ndex") = Trim(strData(0) )
drowRow.Item("S tatus") = Replace(Trim(st rData(1)),
"""", "")
drowRow.Item("N umber") = MakeValidNumber (strNumber)
drowRow.Item("D ate") = dtDate
drowRow.Item("M essage") = strMessage
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "|" & strMessages & "|" &
intAantal & vbCrLf & strSMS(0), "Add SMS to Table")
Finally
dtbl.Rows.Add(d rowRow)
End Try
'End If
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "|" & strMessages & "|" &
intAantal & vbCrLf & strColSMS(intX) , "AddReadSmsToTa blePDU")
End Try
Next
End If
AddReadSmsToTab lePDU = dtbl
End Function
Private Function MakeSmsReceived Table() As DataTable
Dim dtbl As New DataTable
Dim dcolCol As DataColumn
dcolCol = New DataColumn("Ind ex")
dcolCol.DataTyp e = System.Type.Get Type("System.In t16")
dtbl.Columns.Ad d(dcolCol)
dcolCol = New DataColumn("Num ber")
dcolCol.DataTyp e = System.Type.Get Type("System.St ring")
dtbl.Columns.Ad d(dcolCol)
dcolCol = New DataColumn("Dat e")
dcolCol.DataTyp e = System.Type.Get Type("System.Da teTime")
dtbl.Columns.Ad d(dcolCol)
dcolCol = New DataColumn("Mes sage")
dcolCol.DataTyp e = System.Type.Get Type("System.St ring")
dtbl.Columns.Ad d(dcolCol)
dcolCol = New DataColumn("Sta tus")
dcolCol.DataTyp e = System.Type.Get Type("System.St ring")
dtbl.Columns.Ad d(dcolCol)
MakeSmsReceived Table = dtbl
End Function
Private Sub tmrReadComPort_ Tick(ByVal sender As Object, ByVal e As
System.EventArg s) Handles tmrReadComPort. Tick
tmrReadComPort. Stop()
ReceivedManual( )
End Sub
Private Sub DebugEvaluate(B yVal strB As String)
MessageDebug("E VALUATED: " & strB)
End Sub
Private Sub tmrWaitForValid Answer_Elapsed( ByVal sender As Object, ByVal
e As System.Timers.E lapsedEventArgs ) Handles tmrWaitForValid Answer.Elapsed
tmrWaitForValid Answer.Stop()
'didn't get any answer from the modem after x minutes...
If blnReceivedAnsw er Then
MessageSilent(" Didn't get a valid answer from the modem!", "No
valid answer from Modem")
'reset the modem!
'ResetModem()
RaiseEvent TimeOutWaitingF orValidAnswer()
Else
MessageSilent(" Didn't get any answer from the modem!", "No
answer from Modem")
'reset the modem!
'ResetModem()
RaiseEvent TimeOutWaitingF orAnswer()
End If
End Sub
#End Region
End Class
Option Explicit On
Imports System.Collecti ons
Public Class clsPDUEncode
#Region "Variabel Declarations"
Private m_PDU As String
Private m_PDU_Len As Integer
Private cls7Bit As New cls7BitAinsi
#End Region
#Region "Event Declarations"
#End Region
#Region "Constants"
'Public Const A1C As Integer = 1 'these are used to construct
appropriate PDU for each modem
'Public Const M1C As Integer = 2
#End Region
#Region "Structures "
#End Region
#Region "Enumeratio ns"
'Public Enum enumPduType
' PduTypeA1C = 1
' PduTypeM1C = 2
'End Enum
Public Enum enumDestination
Unknown = 0
InternationalNu mber = 1
National = 2
NetworkSpecific = 3
End Enum
#End Region
#Region "Propertys"
Public Property PDU() As String
Get
PDU = m_PDU
End Get
Set(ByVal value As String)
m_PDU = value
End Set
End Property
Public Property PDU_Len() As Integer
Get
PDU_Len = m_PDU_Len
End Get
Set(ByVal value As Integer)
m_PDU_Len = value
End Set
End Property
#End Region
#Region "Public Methods"
Public Sub EncodeOutgoingS MS(ByVal Number As String, ByVal Message As
String, ByVal Destination As enumDestination )
Dim strPDU As String
Dim strNumber As String
strNumber = Number
If Left(strNumber, 1) = "+" Then
strNumber = Mid(strNumber, 2)
Destination = enumDestination .InternationalN umber
End If
strPDU = "00" 'Length of the SMSC information
strPDU = strPDU & "0" 'no validity period!
strPDU = strPDU & "1" 'SMS-SUBMIT
'If PDUType = A1C Then EncodeOutgoingS MS = EncodeOutgoingS MS &
ASCIIHex(&H0) 'TP-MTI etc
'If PDUType = M1C Then EncodeOutgoingS MS = EncodeOutgoingS MS &
ASCIIHex(&H1) 'PDU type
'If PDUType = A1C Then EncodeOutgoingS MS = EncodeOutgoingS MS &
ASCIIHex(&H11) 'PDU type
strPDU = strPDU & ASCIIHex(&H0) 'increment each time TP-MR
message reference, the M1 does this for you
strPDU = strPDU & ASCIIHex(Len(st rNumber)) 'length of
destination address
'Type-Of-Adress
Select Case Destination
Case enumDestination .InternationalN umber
strPDU = strPDU & "91"
Case enumDestination .National
strPDU = strPDU & "A1"
Case enumDestination .NetworkSpecifi c
strPDU = strPDU & "B1"
Case Else
strPDU = strPDU & "81" 'unknown
End Select
'if number is odd: add an "F"
If Len(strNumber) / 2 <> Int(Len(strNumb er) / 2) Then
strNumber = strNumber & "F"
End If
'add the number in semi-octets...
Dim i As Integer
For i = 1 To Len(strNumber) / 2
strPDU = strPDU & Mid(strNumber, i * 2, 1) & Mid(strNumber, i *
2 - 1, 1)
Next i
'protocol identifier
strPDU = strPDU & ASCIIHex(&H0) ' TP-PID
'data-coding-scheme
strPDU = strPDU & ASCIIHex(&H0) 'TP-DCS
'validity-period of sms... optional and not used here!!
'If PDUType = A1C Then strPDU = strPDU & ASCIIHex(&HAA) 'TP-VDF
Dim intLen As Integer = 0
intLen = Len(Message)
Dim strB As String
strB = Encode7Bit(Mess age, intLen)
strPDU = strPDU & ASCIIHex(intLen )
'strPDU = strPDU & MessageEncode(M essage)
strPDU = strPDU & strB
PDU = strPDU
PDU_Len = (Len(strPDU) / 2) - 1
End Sub
#End Region
#Region "Private Methods"
Private Function Encode7Bit(ByVa l Content As String, ByRef Length As
Integer) As String
'Prepare
Dim CharArray As Char() = Content.ToCharA rray
Dim c As Char
Dim t As String = ""
For Each c In CharArray
't = CharTo7Bits(cls 7Bit.Get7BitFro mAinsi(c)) + t
t = StringTo7Bits(c ls7Bit.Get7BitF romAinsi(c)) + t
Next
'Dim intX As Integer
't = ""
'For intX = 64 To 127
' t = Chr(27) & Chr(intX) & t
'Next
't = StringTo7Bits(t )
'Add "0"
Length = t.Length \ 7
Dim i As Integer
If (t.Length Mod 8) <> 0 Then
For i = 1 To 8 - (t.Length Mod 8)
t = "0" + t
Next
End If
'Split into 8bits
Dim result As String
result = ""
For i = t.Length - 8 To 0 Step -8
result = result + BitsToHex(Mid(t , i + 1, 8))
Next
Return result
End Function
Private Function BitsToHex(ByVal Bits As String) As String
'Convert 8Bits to Hex String
Dim i, v As Integer
For i = 0 To Bits.Length - 1
v = v + Val(Mid(Bits, i + 1, 1)) * 2 ^ (7 - i)
Next
Dim result As String
result = Format(v, "X")
If result.Length = 1 Then
result = "0" + result
End If
Return result
End Function
Private Function CharTo7Bits(ByV al c As Char) As String
Dim Result As String
Result = ""
Dim i As Integer
For i = 0 To 6
If (Asc(c) And 2 ^ i) > 0 Then
Result = "1" + Result
Else
Result = "0" + Result
End If
Next
Return Result
End Function
Private Function StringTo7Bits(B yVal content As String) As String
Dim Result As String
Result = ""
Dim CharArray As Char() = content.ToCharA rray
Dim c As Char
Dim i As Integer
For Each c In CharArray
For i = 0 To 6
If (Asc(c) And 2 ^ i) > 0 Then
Result = "1" + Result
Else
Result = "0" + Result
End If
Next
Next c
Return Result
End Function
Private Function EncodeUCS2(ByVa l Content As String) As String
Dim i, j, v As Integer
Dim Result, t As String
Result = ""
For i = 1 To Content.Length Step 4
v = AscW(Mid(Conten t, i, 4))
t = Format(v, "X")
For j = 1 To 4 - t.Length
t = "0" & t
Next
Result += t
Next
Return Result
End Function
Private Function MessageEncode(B yVal InMsg As String) As String
Dim i As Integer, Byterev As Integer, Bits As Integer, Eightbit As
Integer
Dim Msg As String = ""
For i = 1 To Len(InMsg)
Byterev = Byterev * 128 'shift left 7 bits
Byterev = Byterev + Rev(Asc(Mid(InM sg, i, 1)), 7)
Bits = Bits + 7
While Bits >= 8
Eightbit = Int(Byterev / 2 ^ (Bits - 8))
Byterev = Byterev - Eightbit * 2 ^ (Bits - 8)
Bits = Bits - 8
Msg = Msg & ASCIIHex(Rev(Ei ghtbit, 8))
End While
Next i
If Bits > 0 Then
Byterev = Byterev * 128 'shift left 7 bits
Bits = Bits + 7
Eightbit = Int(Byterev / 2 ^ (Bits - 8))
Msg = Msg & ASCIIHex(Rev(Ei ghtbit, 8))
End If
MessageEncode = Msg
End Function
Function Rev(ByVal Byted As Integer, ByVal B As Integer) As Integer
Dim j As Integer, Value As Integer
For j = 0 To B - 1
If Byted And 2 ^ j Then Value = Value + 2 ^ (B - 1 - j)
Next j
Rev = Value
End Function
Private Function ASCIIHex(ByVal Value As String) As String
ASCIIHex = Microsoft.Visua lBasic.Right("0 " & Hex$(Value), 2)
End Function
#End Region
End Class
'============== =============== =============== ==============
' SMS,EMS Decoder
' 2004-9-24
'1.Description
' This class decode a SMS or EMS PDU code to a certain
'class. You can use it in your software to read SMSs and
'EMSs. All of this is done under GSM 03.40. I tested it
'on my SIEMENS M55 and NOKIA 8xxx and it works well.
'2.Useage
' If you know what type of PDU code, you can create a
'new instance of class like DIM s as SMS(myPDUCode)
'When instance is created, you read its public variable
'to get what you want.
' When TP_DCS=0, PDU code is coded from 7bit
'charactor (see GSM 03.38), use shared function
'Deocde7Bit to decode it.
' When TP_DCS=8, PDU code is coded from Unicode
'charactor (see GSM 03.38), use shared funtion
'DecodeUnicode to decode it.
'3.Bugs
' So far in my tests I found none.
'4.When you use it
' You can freely use it or modify it in your program,
'but when you find bugs or improved it please publish it
'or send one copy to me. Thanks
'5.About me
' I am writting a program which can list folders and
'files in SIEMENS M55 mobile phone. It can also read
'and send SMS,EMS. Some documents are hard to find on
'internet, but I keep on my mind to study it and finally
'I found it is full of interests.
' I like freedom, so'I exchange my ideas with all of
'the world. It is so happy that you can use my classes!
' In the end, sorry for my poor english.
'6.Contact me
' Email:he******@ mail.sc.cninfo. net
' QQ:38288890
' MSN:he******@ma il.sc.cninfo.ne t
' Homepage:
http://hesicong2004.vip.myrice.com (Chinese)
' Thanks for using it!
' ----By HESICONG
'Last edited 2004-9-24
Public MustInherit Class clsPDUDecode
'Note all of following various with TP_ can be found in GSM 03.40
Public SCAddressLength As Byte 'Service Center Address length
Public SCAddressType As Byte 'Service Center Type[See GSM 03.40]
Public SCAddressValue As String 'Service Center nuber
Public FirstOctet As Byte 'See GSM 03.40
Public TP_PID As Byte
Public TP_DCS As Byte
Public TP_UDL As Byte
Public TP_UD As String
Public Text As String
Public Type As SMSType
Public UserData As String
Public Enum SMSType
SMS_RECEIVED = 0
SMS_STATUS_REPO RT = 2
SMS_SUBMIT = 1
EMS_RECEIVED = 64 'It is "Reserved" on my phone??
EMS_SUBMIT = 65
End Enum
Public MustOverride Sub GetOrignalData( ByVal PDUCode As String)
'Get a byte from PDU string
Shared Function GetByte(ByRef PDUCode As String) As Byte
Dim r As Byte = Val("&H" + Mid(PDUCode, 1, 2))
PDUCode = Mid(PDUCode, 3)
Return r
End Function
'Get a string of certain length
Shared Function GetString(ByRef PDUCode As String, ByVal Length As
Integer) As String
Dim r As String = Mid(PDUCode, 1, Length)
PDUCode = Mid(PDUCode, Length + 1)
Return r
End Function
'Get date from SCTS format
Shared Function GetDate(ByRef SCTS As String) As Date
Dim year, month, day, hour, minute, second, timezone As Integer
year = Val(Swap(GetStr ing(SCTS, 2))) + 2000
month = Val(Swap(GetStr ing(SCTS, 2)))
day = Val(Swap(GetStr ing(SCTS, 2)))
hour = Val(Swap(GetStr ing(SCTS, 2)))
minute = Val(Swap(GetStr ing(SCTS, 2)))
second = Val(Swap(GetStr ing(SCTS, 2)))
timezone = Val(Swap(GetStr ing(SCTS, 2)))
Dim result As New Date(year, month, day, hour, minute, second)
Return result
End Function
'Swap two bit
Shared Function Swap(ByRef TwoBitStr As String) As String
Dim c() As Char = TwoBitStr.ToCha rArray
Dim t As Char
t = c(0)
c(0) = c(1)
c(1) = t
Return (c(0) + c(1)).ToString
End Function
'Get phone address
Shared Function GetAddress(ByRe f Address As String) As String
Dim tmpChar As Char() = Address.ToCharA rray
Dim i As Integer, result As String
result = ""
For i = 0 To tmpChar.GetUppe rBound(0) Step 2
result += Swap(tmpChar(i) + tmpChar(i + 1))
Next
If InStr(result, "F") Then result = Mid(result, 1, result.Length -
1)
Return result
End Function
Shared Function GetSMSType(ByVa l PDUCode As String) As
clsPDUDecode.SM SType
'Get first october
Dim FirstOctet As Byte
Dim L As Integer = clsPDUDecode.Ge tByte(PDUCode)
clsPDUDecode.Ge tByte(PDUCode)
clsPDUDecode.Ge tString(PDUCode , (L - 1) * 2)
FirstOctet = clsPDUDecode.Ge tByte(PDUCode)
'[Chinese]È¡µÃÌØÕ÷Âë
'[Chinese]È¡µÃ»ù±¾Âë ×îºóÁ½¸öbit + ÊÇ·ñÓÐheader×÷Î ª±ê¼Ç
'Get base code. Use last 2 bit and whether there's a header as
remark
Dim t1 As Integer = FirstOctet And 3 '00000011
Dim t2 As Integer = FirstOctet And 64 '01000000
'[Chinese]Ìرð´¦Àí
If t1 = 3 And t2 = 64 Then Return clsPDUDecode.SM SType.EMS_SUBMI T
Return t1 + t2
End Function
'Deoce a unicode string
Shared Function DecodeUnicode(B yVal strUnicode As String) As String
Dim Code As String = ""
Dim j As Integer
Dim c() As String 'temp
ReDim c(strUnicode.Le ngth / 4) '2 Byte a Unicode char
For j = 0 To strUnicode.Leng th \ 4 - 1
Dim d() As Char = strUnicode.ToCh arArray(j * 4, 4)
c(j) = "&H" & CType(d, String)
c(j) = ChrW(Val(c(j)))
Code += c(j)
Next
Return Code
End Function
'Deocde 7Bit to english
Shared Function Decode7Bit(ByVa l str7BitCode As String, ByVal intLen As
Integer) As String
Dim blnExtendedChar As Boolean = False
Dim intAsc As Integer = 0
Dim cls7Bit As New cls7BitAinsi
Dim i, j As Integer
If Len(str7BitCode ) Mod 2 > 0 Then
'intLen moet normaal paar zijn, maar soms toch onpaar!!
'intLen = intLen + 1
str7BitCode = str7BitCode + "F"
End If
Dim Result As String = ""
Dim tmpChar As Char() = str7BitCode.ToC harArray
Dim Dec, CharAscii, Reminder As Integer
Try
Do Until j > tmpChar.GetUppe rBound(0)
Try
i = i Mod 7
Dec = Val("&H" & tmpChar(j) & tmpChar(j + 1))
CharAscii = (Dec And (2 ^ (7 - i) - 1)) * 2 ^ i +
Reminder
Reminder = Dec \ 2 ^ (7 - i)
intAsc = cls7Bit.GetAins iCodeFrom7BitCo de(CharAscii,
blnExtendedChar )
If intAsc = 27 Then '27 = escape code!!! use extended
List!
blnExtendedChar = True
Else
blnExtendedChar = False
Result += Chr(intAsc)
End If
Catch ex As Exception
ErrorMessageSil ent(ex, "reminder", "Decode7Bit ")
End Try
'If i = 6 Then 'oude
'zelf aangepast want er bleek probleempje te zijn als die
reminder 0 was ofzo of op't einde!
'dus die reminder nemen we ni meer mee als hij 0 is en we
hierna neits meer doen!
'And (j <= (tmpChar.GetUpp erBound(0) - 1))
'And (Reminder <> 0)
Try
If (i = 6) And (Len(Result) < intLen) Then
intAsc = cls7Bit.GetAins iCodeFrom7BitCo de(Reminder,
blnExtendedChar )
If intAsc = 27 Then '27 = escape code!!! use
extended List!
blnExtendedChar = True
Else
blnExtendedChar = False
Result += Chr(intAsc)
End If
Reminder = 0
End If
Catch ex As Exception
ErrorMessageSil ent(ex, "reminder", "Decode7Bit ")
End Try
i += 1
j += 2
Loop
Catch ex As Exception
ErrorMessageSil ent(ex, "Decode7Bit ", "Decode7Bit ")
End Try
Return (Result)
End Function
End Class
Public Class SMS_RECEIVED
Inherits clsPDUDecode
Public SrcAddressLengt h As Byte
Public SrcAddressType As Byte
Public SrcAddressValue As String
Public TP_SCTS As Date
Sub New(ByVal PDUCode As String)
Try
Type = clsPDUDecode.SM SType.SMS_RECEI VED
GetOrignalData( PDUCode)
Catch ex As Exception
ErrorMessageSil ent(Me, ex, "clsPDUDeco de - SMS_RECEIVED - Sub
New", "clsPDUDeco de - SMS_RECEIVED - Sub New")
End Try
End Sub
Public Overrides Sub GetOrignalData( ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode )
SCAddressType = GetByte(PDUCode )
SCAddressValue = GetAddress((Get String(PDUCode, (SCAddressLengt h -
1) * 2)))
FirstOctet = GetByte(PDUCode )
SrcAddressLengt h = GetByte(PDUCode )
SrcAddressType = GetByte(PDUCode )
SrcAddressLengt h += SrcAddressLengt h Mod 2
SrcAddressValue = GetAddress((Get String(PDUCode, SrcAddressLengt h)))
TP_PID = GetByte(PDUCode )
TP_DCS = GetByte(PDUCode )
TP_SCTS = GetDate(GetStri ng(PDUCode, 14))
TP_UDL = GetByte(PDUCode )
TP_UD = GetString(PDUCo de, TP_UDL * 2)
End Sub
End Class
Public Class SMS_SUBMIT
Inherits clsPDUDecode
Public TP_MR As Byte
Public DesAddressLengt h As Byte
Public DesAddressType As Byte
Public DesAddressValue As String
Public TP_VP As Byte
Sub New(ByVal PDUCode As String)
Type = clsPDUDecode.SM SType.SMS_SUBMI T
GetOrignalData( PDUCode)
End Sub
Public Overrides Sub GetOrignalData( ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode )
SCAddressType = GetByte(PDUCode )
SCAddressValue = GetAddress((Get String(PDUCode, (SCAddressLengt h -
1) * 2)))
FirstOctet = GetByte(PDUCode )
TP_MR = GetByte(PDUCode )
DesAddressLengt h = GetByte(PDUCode )
DesAddressType = GetByte(PDUCode )
DesAddressLengt h += DesAddressLengt h Mod 2
DesAddressValue = GetAddress((Get String(PDUCode, DesAddressLengt h)))
TP_PID = GetByte(PDUCode )
TP_DCS = GetByte(PDUCode )
TP_VP = GetByte(PDUCode )
TP_UDL = GetByte(PDUCode )
TP_UD = GetString(PDUCo de, TP_UDL * 2)
End Sub
End Class
Public Class EMS_RECEIVED
Inherits SMS_RECEIVED
Public Structure InfoElem 'See document "How to create EMS"
Public Identifier As Byte
Public Length As Byte
Public Data As String
End Structure
Public TP_UDHL As Byte
Public IE() As InfoElem
Sub New(ByVal PDUCode As String)
MyBase.New(PDUC ode)
End Sub
Public Overrides Sub GetOrignalData( ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode )
SCAddressType = GetByte(PDUCode )
SCAddressValue = GetAddress(GetS tring(PDUCode, (SCAddressLengt h - 1)
* 2))
FirstOctet = GetByte(PDUCode )
SrcAddressLengt h = GetByte(PDUCode )
SrcAddressType = GetByte(PDUCode )
SrcAddressLengt h += SrcAddressLengt h Mod 2
SrcAddressValue = GetAddress((Get String(PDUCode, SrcAddressLengt h)))
TP_PID = GetByte(PDUCode )
TP_DCS = GetByte(PDUCode )
TP_SCTS = GetDate(GetStri ng(PDUCode, 14))
TP_UDL = GetByte(PDUCode )
TP_UDHL = GetByte(PDUCode )
IE = GetIE(GetString (PDUCode, TP_UDHL * 2))
TP_UD = GetString(PDUCo de, TP_UDL)
End Sub
'Get Informat Elements
Shared Function GetIE(ByVal IECode As String) As InfoElem()
Dim tmp As String = IECode, t As Integer = 0
Dim result() As InfoElem
Do Until IECode = ""
ReDim Preserve result(t)
With result(t)
.Identifier = GetByte(IECode)
.Length = GetByte(IECode)
.Data = GetString(IECod e, .Length * 2)
End With
t += 1
Loop
Return result
End Function
End Class
Public Class EMS_SUBMIT
Inherits SMS_SUBMIT
Sub New(ByVal PDUCode As String)
MyBase.New(PDUC ode)
Type = clsPDUDecode.SM SType.EMS_SUBMI T
End Sub
Public TP_UDHL As Byte
Public IE() As EMS_RECEIVED.In foElem
Public Overrides Sub GetOrignalData( ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode )
SCAddressType = GetByte(PDUCode )
SCAddressValue = GetAddress(GetS tring(PDUCode, (SCAddressLengt h - 1)
* 2))
FirstOctet = GetByte(PDUCode )
TP_MR = GetByte(PDUCode )
DesAddressLengt h = GetByte(PDUCode )
DesAddressType = GetByte(PDUCode )
DesAddressLengt h += DesAddressLengt h Mod 2
DesAddressValue = GetAddress(GetS tring(PDUCode, DesAddressLengt h))
TP_PID = GetByte(PDUCode )
TP_DCS = GetByte(PDUCode )
TP_VP = GetByte(PDUCode )
TP_UDL = GetByte(PDUCode )
TP_UDHL = GetByte(PDUCode )
IE = EMS_RECEIVED.Ge tIE(GetString(P DUCode, TP_UDHL * 2))
TP_UD = GetString(PDUCo de, TP_UDL * 2)
End Sub
End Class
Public Class SMS_STATUS_REPO RT
Inherits SMS_RECEIVED
Public TP_MR As Byte
Public TP_DP As Date
Public Status As Byte
Sub New(ByVal PDUCode As String)
MyBase.New(PDUC ode)
Type = clsPDUDecode.SM SType.SMS_STATU S_REPORT
End Sub
Public Overrides Sub GetOrignalData( ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode )
SCAddressType = GetByte(PDUCode )
SCAddressValue = GetAddress(GetS tring(PDUCode, (SCAddressLengt h - 1)
* 2))
FirstOctet = GetByte(PDUCode )
TP_MR = GetByte(PDUCode )
SrcAddressLengt h = GetByte(PDUCode )
SrcAddressType = GetByte(PDUCode )
SrcAddressLengt h += SrcAddressLengt h Mod 2
SrcAddressValue = GetAddress(GetS tring(PDUCode, SrcAddressLengt h))
TP_SCTS = GetDate(GetStri ng(PDUCode, 14))
'hier kreeg ik soms een probleempje: de waarde leek gelijk
05/02/03,15:43:23+00" ,"00/00/00,00:00:00+00" te zijn?
'Dus die 00/00/00 etc kwam in de 2e datum te staan?
Try
TP_DP = GetDate(GetStri ng(PDUCode, 14))
Catch ex As Exception
TP_DP = TP_SCTS
End Try
Status = GetByte(PDUCode )
'Status report do not have content so I set it a zero length string
TP_UD = ""
End Sub
End Class
Option Explicit On
Public Class cls7BitAinsi
Dim listChar As New SortedList
Dim listReplaceChar As New SortedList
Dim listReplaceByCh ar2 As New SortedList
Dim listExtendedCha r As New SortedList
Public Sub New()
'asc(ansi) -> 'according dec of gsm-binary)
listChar.Add(36 , 2) '$
listChar.Add(64 , 0) '@
listExtendedCha r.Add(91, 60) '[
listExtendedCha r.Add(92, 47) '\
listExtendedCha r.Add(93, 62) ']
listExtendedCha r.Add(94, 20) '^
listChar.Add(95 , 17) '_
listReplaceChar .Add(96, 39) ''
listExtendedCha r.Add(123, 40) '{
listExtendedCha r.Add(124, 64) '|
listExtendedCha r.Add(125, 41) '}
listExtendedCha r.Add(126, 61) '~
listReplaceChar .Add(127, 63) 'DEL 63 = ?
listExtendedCha r.Add(128, 101) '? = e
listReplaceByCh ar2.Add(140, "OE") 'Franse OE
listReplaceChar .Add(145, 39) ''
listReplaceChar .Add(146, 39) ''
listReplaceChar .Add(147, 34) '"
listReplaceChar .Add(148, 34) '"
listExtendedCha r.Add(152, 61) '~
listReplaceByCh ar2.Add(156, "oe")
listChar.Add(16 1, 64) 'omgekeerd uitroepteken
listChar.Add(16 3, 1) '£
listChar.Add(16 4, 36) 'intl. monetary symbol
listChar.Add(16 5, 3) 'yen
listChar.Add(16 7, 95) 'paragraph
listReplaceChar .Add(168, 34) '¨ => "
listReplaceChar .Add(180, 39) ''
listReplaceChar .Add(181, 117) 'µ => u
listChar.Add(19 1, 96) 'spanish inverted question mark
listReplaceChar .Add(192, 14) 'À => A ring
listReplaceChar .Add(193, 14) 'Á => A ring
listReplaceChar .Add(194, 14) 'Â => A ring
listReplaceChar .Add(195, 14) 'Ã => A ring
listChar.Add(19 6, 91) 'Ä
listChar.Add(19 7, 14) 'A ring
listChar.Add(19 8, 28) 'AE ligature
listReplaceChar .Add(199, 67) 'grote ç = C => C
listReplaceChar .Add(200, 69) 'È => E
listChar.Add(20 1, 31) 'É
listReplaceChar .Add(202, 69) 'Ê => E
listReplaceChar .Add(203, 69) 'Ë => E
listReplaceChar .Add(204, 73) 'Ì => I
listReplaceChar .Add(205, 73) 'Í => I
listReplaceChar .Add(206, 73) 'Î => I
listReplaceChar .Add(207, 73) 'Ï => I
listChar.Add(20 9, 93) 'Ñ
listReplaceChar .Add(210, 79) 'Ò => O
listReplaceChar .Add(211, 79) 'Ó => O
listReplaceChar .Add(212, 79) 'Ô => O
listReplaceChar .Add(213, 79) 'Õ => O
listChar.Add(21 4, 92) 'Ö
listReplaceChar .Add(215, 120) 'x (vermenigvuldig en) => x (letter
x)
listChar.Add(21 6, 11) 'O met streepje door
listReplaceChar .Add(217, 85) 'Ù => U
listReplaceChar .Add(218, 85) 'Ú => U
listReplaceChar .Add(219, 85) 'Û => U
listChar.Add(22 0, 94) 'Ü
listReplaceChar .Add(221, 89) 'Ý => Y
listChar.Add(22 3, 30) 'german B
listChar.Add(22 4, 127) 'à
listReplaceChar .Add(225, 15) 'á => a ring
listReplaceChar .Add(226, 15) 'â => a ring
listReplaceChar .Add(227, 15) 'ã => a ring
listChar.Add(22 8, 123) 'ä
listChar.Add(22 9, 15) 'a ring
listChar.Add(23 0, 29) 'ae
listChar.Add(23 1, 9) 'ç
listChar.Add(23 2, 4) 'è
listChar.Add(23 3, 5) 'é
listReplaceChar .Add(234, 101) 'ê => e
listReplaceChar .Add(235, 101) 'ë => e
listChar.Add(23 6, 7) 'ì
listReplaceChar .Add(237, 105) 'í => i
listReplaceChar .Add(238, 105) 'î => i
listReplaceChar .Add(239, 105) 'ï => i
listChar.Add(24 1, 125) 'ñ
listChar.Add(24 2, 8) 'ò
listReplaceChar .Add(243, 111) 'ó => o
listReplaceChar .Add(244, 111) 'ô => o
listReplaceChar .Add(245, 111) 'õ => o
listChar.Add(24 6, 124) 'ö
listReplaceChar .Add(247, 47) '- divide symbol => /
listChar.Add(24 8, 12) 'o met streepje door
listChar.Add(24 9, 6) 'ù
listReplaceChar .Add(250, 117) 'ú => u
listReplaceChar .Add(251, 117) 'û => u
listChar.Add(25 2, 126) 'ü
listReplaceChar .Add(253, 121) 'ý => y
listReplaceChar .Add(255, 121) 'ÿ => y
End Sub
Public Function Get7BitFromAins i(ByVal strC As Char) As String
'if this char is in the lsit, then change it...
If listChar.Contai nsKey(Asc(strC) ) Then
Get7BitFromAins i = Chr(listChar.It em(Asc(strC)))
ElseIf listReplaceChar .ContainsKey(As c(strC)) Then
Get7BitFromAins i = Chr(listReplace Char.Item(Asc(s trC)))
ElseIf listReplaceByCh ar2.ContainsKey (Asc(strC)) Then
Get7BitFromAins i = listReplaceByCh ar2.Item(Asc(st rC))
ElseIf listExtendedCha r.ContainsKey(A sc(strC)) Then
Get7BitFromAins i = Chr(27) +
Chr(listExtende dChar.Item(Asc( strC))) 'chr(27) = escape character!
Else
Get7BitFromAins i = strC
End If
End Function
Public Function GetAinsiCodeFro m7BitCode(ByVal int7BitCode As Integer,
ByVal blnExtendedChar As Boolean) As Integer
'if this char is in the liss, then change it...
Dim intIndex As Integer
If blnExtendedChar Then
If listExtendedCha r.ContainsValue (int7BitCode) Then
intIndex = listExtendedCha r.IndexOfValue( int7BitCode)
GetAinsiCodeFro m7BitCode = listExtendedCha r.GetKey(intInd ex)
Else
GetAinsiCodeFro m7BitCode = int7BitCode
End If
ElseIf listChar.Contai nsValue(int7Bit Code) Then
intIndex = listChar.IndexO fValue(int7BitC ode)
GetAinsiCodeFro m7BitCode = listChar.GetKey (intIndex)
Else
GetAinsiCodeFro m7BitCode = int7BitCode
End If
End Function
End Class
"ransoma22" <al********@gma il.com> wrote in message
news:11******** **************@ g49g2000cwa.goo glegroups.com.. .
hi,
thanks for replying.
May i know which component are u using to read your message ?
or any sample code?
thanks~
