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.SqlClient
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 tmrTimeOutProcessLoop 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 blnSendErrorMail As Boolean = False
Private m_intMessagesFailed 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.Campaign = tblHours.Campaign AND
DayWeek = DATEPART(dw,GETDATE())) "
Private cstSqlWhere As String = " WHERE ((MemoDate IS NULL) OR
(GETDATE() > MemoDate)) " & _
" AND (SendDate IS NULL) " & _
"AND (" & _
"(((CONVERT(CHAR(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(CHAR(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.Campaign = tblHours.Campaign AND DayWeek = DATEPART(dw,GETDATE())) "
'Private cstSqlWhere As String = " WHERE ((MemoDate IS NULL) OR
(GETDATE() > MemoDate)) " & _
'" AND (SendDate IS NULL) " & _
'"AND (" & _
'"(((CONVERT(CHAR(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(CHAR(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 "Enumerations"
#End Region
#Region "Propertys"
Private Property pryMessagesFailed() As Integer
Get
pryMessagesFailed = m_intMessagesFailed
End Get
Set(ByVal value As Integer)
m_intMessagesFailed = value
End Set
End Property
#End Region
#Region "Public Methods"
Public Sub StartServer()
MessageSilent("Starting SMS Server...", "StartServer")
tmrNotSend.Stop()
tmrNotSend.Interval = watchedSettings("TimeOutNotSendMinutes") * 60
* 1000
tmrNotSend.Start()
tmrNotReceived.Stop()
tmrNotReceived.Interval =
watchedSettings("TimeOutNotReceivedMinutes") * 60 * 1000
tmrNotReceived.Start()
tmrTimeOutProcessLoop.Stop()
tmrTimeOutProcessLoop.Interval =
watchedSettings("TimeOutProcessLoopSeconds") * 1000
tmrTimeOutProcessLoop.Start()
SmsModem = New clsSMSModem
Dim strPortName As String
strPortName = watchedSettings("PortName")
If Not SmsModem.IsPortAvailable(strPortName) Then
MessageSilent("Port " & strPortName & " not available!",
"StartServer")
MessageMail("Port " & strPortName & " not available!", "SMS
SERVER ERROR: Port not available!")
Else
MessageSilent("Port " & strPortName & " available...",
"StartServer")
'open the port...
If SmsModem.OpenComPort(strPortName, _
CInt(watchedSettings("BaudRate")), _
CInt(watchedSettings("DataBits")), _
watchedSettings("Parity"), _
watchedSettings("StopBits"), _
watchedSettings("HandShake")) Then
MessageSilent("Port " & strPortName & " opened...",
"StartServer")
MessageMail("Port " & strPortName & " opened...", "SMS
SERVER NOTIFICATION: SMS Server started...")
Else
MessageSilent("Port " & strPortName & " did not open!",
"StartServer")
MessageMail("Port " & strPortName & " not available!", "SMS
SERVER ERROR: Port not available!")
End If
'reset the modem!
tmrProcessNext.Stop()
SmsModem.ResetModem()
'wait for the event until it is resetted...
End If
'delete all the old error-files
'86400000 'elke dag!
tmrDelete.Interval = watchedSettings("KeepAliveMinutes") * 60 * 1000
'in minuten!
tmrDelete.Start()
DeleteErrorFiles()
End Sub
Public Sub StopServer()
Try
MessageSilent("Stopping SMS Server...", "StopServer")
MessageMail("SMS Server stopped... ", "SMS SERVER NOTIFICATION:
SMS Server stopped...")
tmrProcessNext.Stop()
tmrDelete.Stop()
tmrTimeOutProcessLoop.Stop()
SmsModem.CloseComPort()
SmsModem = Nothing
Catch ex As Exception
ErrorMessageSilent(Me, ex, "StopServer")
End Try
End Sub
#End Region
#Region "Private Methods"
Public Sub New()
Dim currentDomain As AppDomain = AppDomain.CurrentDomain
AddHandler currentDomain.UnhandledException, AddressOf MyHandler
AddHandler System.Windows.Forms.Application.ThreadException,
AddressOf GlobalErrorHandler
End Sub
Private Sub SmsModem_CharacterSetChanged(ByVal strSet As String) Handles
SmsModem.CharacterSetChanged
If strSet = "GSM" Then
'set it to UCS2-CharSet
SmsModem.SetToUCS2()
'wait for event...
Else
'everything is ready!!
'first sms can be send!
ProcessNextCycle()
End If
End Sub
Private Sub SmsModem_ComPortNotAvailable() Handles
SmsModem.ComPortNotAvailable
MessageSilent("Port not available!", "SmsModem_ComPortNotAvailable")
StartServer()
End Sub
Private Sub SmsModem_Modem_Resetted() Handles SmsModem.Modem_Resetted
'the modem has been resetted: add now the pin-code
SmsModem.PinInsert(watchedSettings("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_NotRight() Handles SmsModem.Pin_NotRight
MessageSilent("Pin not right!", "SmsModem_Pin_NotRight")
tmrProcessNext.Stop()
SmsModem.ResetModem()
End Sub
Private Sub SmsModem_Pin_Right() Handles SmsModem.Pin_Right
'set it to text-mode!
'SmsModem.SetToTextMode()
'wait for event...
'get the first sms!!
'ProcessNextCycle()
'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_WaitingForInput() Handles
SmsModem.Pin_WaitingForInput
'the modem has been resetted: add now the pin-code
SmsModem.PinInsert(watchedSettings("Pin"))
'wait for the event until it is entered...
End Sub
Private Sub SmsModem_Sms_Deleted() Handles SmsModem.Sms_Deleted
'remove from the HashTable
RemoveFromHashTableStack()
End Sub
Private Sub SmsModem_Sms_DeletingError() Handles
SmsModem.Sms_DeletingError
MessageSilent("Error deleting index: " & htbIndex(htbIndex.Count -
1) & " - Stack Number = " & (htbIndex.Count - 1),
"SmsModem_Sms_DeletingError")
'remove from the HashTable
RemoveFromHashTableStack()
End Sub
Private Sub RemoveFromHashTableStack()
Dim intX As Integer
intX = htbIndex.Count - 1
htbIndex.Remove(intX)
'remove the next one..
RemoveSmsIndex()
End Sub
Private Sub SmsModem_Sms_MessageError() Handles
SmsModem.Sms_MessageError
MessageSilent("Error sending message: " & strNumber & " - SMSID: " &
intSMSID, "SmsModem_Sms_MessageError")
'INSERT the SMS to be send later!!!
'+ update sendtimes...
UpdateTblSMS(intSMSID, True, "MessageError")
If Not MaxMessageFailure() Then
'check for received sms...
ProcessReceivedSms()
End If
End Sub
Private Sub SmsModem_Sms_MessageSend() Handles SmsModem.Sms_MessageSend
'update tblSMS: SMS has been send!
UpdateTblSMS(intSMSID, False)
tmrNotSend.Stop()
tmrNotSend.Interval = watchedSettings("TimeOutNotSendMinutes") * 60
* 1000
tmrNotSend.Start()
pryMessagesFailed = 0
'check for received sms...
ProcessReceivedSms()
End Sub
Private Sub SmsModem_Sms_NumberError() Handles SmsModem.Sms_NumberError
MessageSilent("Error sending number: " & strNumber & " - SMSID: " &
intSMSID, "SmsModem_Sms_NumberError")
'INSERT the SMS to be send later!!!
'+ update sendtimes...
UpdateTblSMS(intSMSID, True, "NumberError")
If Not MaxMessageFailure() Then
'check for received sms...
ProcessReceivedSms()
End If
End Sub
Private Sub SmsModem_Sms_Read(ByVal dtblSMS As System.Data.DataTable)
Handles SmsModem.Sms_Read
'handle the sms's that have been read....
tmrNotReceived.Stop()
tmrNotReceived.Interval =
watchedSettings("TimeOutNotReceivedMinutes") * 60 * 1000
tmrNotReceived.Start()
If dtblSMS.Rows.Count > 0 Then
blnReceived = True
'There are some sms in the memory..
Dim intX As Integer
htbIndex.Clear()
For intX = 0 To (dtblSMS.Rows.Count - 1)
'handle all the sms...
If
InsertReceivedSMS(dtblSMS.Rows(intX).Item("Number" ).ToString,
dtblSMS.Rows(intX).Item("Message"), dtblSMS.Rows(intX).Item("Date")) Then
'only when the SMS has been inserted!
'add the index to the hashtable
htbIndex.Add(intX, dtblSMS.Rows(intX).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("SendIntervalSeconds") * 1000
'tmrProcessNext.Start()
ProcessNextCycle()
End If
End Sub
Private Function InsertReceivedSMS(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.ConnectionString = watchedSettings("ConnectionString")
strSql2 = "SELECT * FROM " & _
"(SELECT TOP 1 tblSMS.*, tblCampaigns.Mail FROM tblSMS " & _
" LEFT JOIN tblCampaigns ON (tblSms.Campaign =
tblCampaigns.Campaign) " & _
"WHERE (Number = '" & strNr & "') OR (Number = '0" & Right(strNr,
Len(strNr) - 3) & "') " & _
"ORDER BY SendDate DESC) X " & vbCrLf & _
" UNION " & vbCrLf & _
"SELECT DISTINCT tblSMS.*, tblCampaigns.Mail FROM tblSMS " & _
" LEFT JOIN tblCampaigns ON (tblSms.Campaign =
tblCampaigns.Campaign) " & _
"WHERE ((Number = '" & strNr & "') OR (Number = '0" & Right(strNr,
Len(strNr) - 3) & "')) " & _
" AND (SendDate > DATEADD(hh, -" &
watchedSettings("ReplyValidityHours") & " ,GETDATE() )) "
'+32486913315 and 0486913315
Dim dtrSql As SqlDataReader
Dim strSqlI As String
Dim strValuesI As String
Try
con.Open()
MessageDebug(strSql2, "INSERT RECEIVED SMS SQL")
cmdSql = New SqlCommand(strSql2, con)
dtrSql = cmdSql.ExecuteReader(CommandBehavior.CloseConnecti on)
If dtrSql.HasRows Then
While dtrSql.Read
'EMAIL IT
Try
If Len(dtrSql("Mail").ToString) > 0 Then
Dim clsEMail As New
clsMail(watchedSettings("From"), watchedSettings("FriendlyFrom"),
watchedSettings("SmtpServer"))
Dim strSubject As String = ""
Dim strMessage As String = ""
strSubject = "SMS RECEIVED FROM " & strNr & " ("
& dtrSql("tdprNFoy").ToString & dtrSql("tdprNCCD").ToString & " - " &
dtrSql("tdprNSocFin").ToString & ")"
strMessage = "You received an SMS:" & vbCrLf & _
"GSM NUMBER:" & vbTab & strNr & vbCrLf & _
"FROM:" & vbTab & vbTab & vbTab &
dtrSql("tdprNFoy").ToString & dtrSql("tdprNCCD").ToString & " - " &
dtrSql("tdprNSocFin").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("Campaign").ToString & vbCrLf & _
vbTab & "INTERNAL CODE:" & vbTab &
dtrSql("InternalCode").ToString
If Not
clsEMail.SendMail2(dtrSql("Mail").ToString, strSubject, strMessage) Then
InsertReceivedSMS = False
Exit Function
End If
End If
Catch ex As Exception
ErrorMessageSilent(Me, ex, "Mail Received")
InsertReceivedSMS = False
Exit Function
End Try
strSqlI = strSql & ", Campaign, InternalCode, tdprNFoy,
tdprNCCD, tdprNSocFin"
strValuesI = strValues & ", '" &
dtrSql("Campaign").ToString & "', '" & dtrSql("InternalCode").ToString & "',
'" & dtrSql("tdprNFoy").ToString & "', '" & dtrSql("tdprNCCD").ToString &
"', '" & dtrSql("tdprNSocFin").ToString & "' "
strSqlI = strSqlI & ") VALUES (" & strValuesI & ")"
'INSERT IT
If InsertSMS(strSqlI) Then
InsertReceivedSMS = True
Else
InsertReceivedSMS = False
Exit Function
End If
End While
Else
'geen Send SMS gevonden die er bij hoort: gewoon inserteren!
strSqlI = strSql & ") VALUES (" & strValues & ")"
'INSERT IT
InsertReceivedSMS = InsertSMS(strSqlI)
End If
Catch ex As Exception
ErrorMessageSilent(Me, ex)
InsertReceivedSMS = 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.ConnectionString = watchedSettings("ConnectionString")
Try
con.Open()
cmdSql = New SqlCommand(strSql, con)
cmdSql.ExecuteNonQuery()
InsertSMS = True
Catch ex As Exception
ErrorMessageSilent(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.SmsDelete(htbIndex(htbIndex.Count - 1))
Else
'you can go on with the next sms...
'start the timer to do the next loop...
'tmrProcessNext.Interval =
watchedSettings("SendIntervalSeconds") * 1000
'tmrProcessNext.Start()
ProcessNextCycle()
End If
End Sub
Private Sub SmsModem_Sms_ReadingError() Handles
SmsModem.Sms_ReadingError
'error reading sms...
MessageSilent("Error reading SMS from Modem...",
"SmsModem_Sms_ReadingError")
blnReceived = False
If Not MaxMessageFailure() Then
'check for received sms...
'ProcessNextCycle()
'check if pin is good!! (in case connection with modem has been
lost)
SmsModem.PinTest()
End If
End Sub
Private Sub SmsModem_Sms_WaitingForMessage() Handles
SmsModem.Sms_WaitingForMessage
'send the sms..
SmsModem.SmsSendMessage(clsOutSMS.PDU)
'wait for the event...
End Sub
Private Sub SmsModem_TextModeChanged(ByVal intTextMode As Integer)
Handles SmsModem.TextModeChanged
If intTextMode = 0 Then
'set it to text-mode!
SmsModem.SetToTextMode()
'wait for event...
Else
''change CharacterSet
'SmsModem.SetToUCS2()
'get the first sms!!
ProcessNextCycle()
End If
End Sub
Private Sub ProcessNextCycle()
'geen sms verzonden en geen ontvangen...
If (intSMSID = 0) And (Not blnReceived) And (lstSendNext.Count <= 0)
Then
'timer- 5 seconden wachten...
'start the timer to do the next loop...
tmrProcessNext.Stop()
tmrProcessNext.Interval =
(CInt(watchedSettings("SendIntervalSeconds")) * 1000)
tmrProcessNext.Start()
Else
'direct volgende pakken!
ProcessSendingSms()
End If
End Sub
Private Function GetSendNextWhere() As String
If lstSendNext.Count <= 0 Then
GetSendNextWhere = ""
Exit Function
End If
'there are elements in the SendNext
Dim strWhere As String = ""
Dim intX As Integer
For intX = 0 To (lstSendNext.Count - 1)
If lstSendNext.GetByIndex(intX) > Now Then
'not yet allowed to take one of them
If strWhere.Length > 0 Then
strWhere = strWhere & " AND "
End If
strWhere = strWhere & "(tblSMS.Campaign <> '" &
lstSendNext.GetKey(intX) & "')"
Else
'you passed the time: you can delete it!
lstSendNext.Remove(lstSendNext.GetKey(intX))
End If
Next
If strWhere.Length > 0 Then
strWhere = " AND ((" & strWhere & ") OR (tblSMS.Campaign IS
NULL)) "
End If
GetSendNextWhere = strWhere
End Function
Private Sub ProcessSendingSms()
tmrTimeOutProcessLoop.Stop()
'RefreshXmldSettings()
tmrTimeOutProcessLoop.Interval =
watchedSettings("TimeOutProcessLoopSeconds") * 1000
tmrTimeOutProcessLoop.Start()
Dim strSql As String
strSql = cstSqlFrom & _
cstSqlWhere & _
" AND ((SendTry < " & watchedSettings("SendTry") & ") OR (SendTry IS
NULL)) " & _
GetSendNextWhere() & _
" 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.ConnectionString = watchedSettings("ConnectionString")
Dim dtrSql As SqlDataReader
Dim cmdSql As SqlCommand
Dim strSendNext As String = ""
Dim strCampaign As String = ""
Try
con.Open()
MessageDebug(strSql, "SELECT PROCESS SENDING SMS SQL")
cmdSql = New SqlCommand(strSql, con)
dtrSql = cmdSql.ExecuteReader(CommandBehavior.SingleRow)
Try
If Not dtrSql.HasRows Then
'no SMS to send:
'no current sms:
intSMSID = 0
'timer terug aan en af zetten!
tmrNotSend.Stop()
tmrNotSend.Interval =
watchedSettings("TimeOutNotSendMinutes") * 60 * 1000
tmrNotSend.Start()
'check for received sms...
ProcessReceivedSms()
Else
'there is an sms to send...
dtrSql.Read()
'id of current sms
intSMSID = dtrSql.Item("SMSID")
'set the number as you want it to receive...
strNumber = MakeValidNumber(dtrSql.Item("Number"))
'max 160 characters!! (see configfile for max)
strMessage = Left(dtrSql.Item("Message"),
CInt(watchedSettings("MaxSmsLen")))
clsOutSMS = New clsPDUEncode
clsOutSMS.EncodeOutgoingSMS(strNumber, strMessage,
clsPDUEncode.enumDestination.InternationalNumber)
strSendNext = dtrSql.Item("SendNext").ToString
If IsNumeric(strSendNext) Then
strCampaign = dtrSql.Item("Campaign").ToString
If (strCampaign.Length > 0) And (CInt(strSendNext) >
0) Then
'add the SendNext to the SortedList!
lstSendNext.Add(strCampaign,
DateAdd(DateInterval.Second, CInt(strSendNext), Now))
End If
End If
SmsModem.SmsSendNumber(clsOutSMS.PDU_Len)
'waiting for event from the modem...
End If
Catch ex As Exception
ErrorMessageSilent(Me, ex)
Finally
dtrSql.Close()
End Try
Catch ex As Exception
ErrorMessageSilent(Me, ex)
Finally
If Not con.State = ConnectionState.Closed Then
con.Close()
End If
End Try
'wachen op event...
End Sub
Private Sub UpdateTblSMS(ByVal intID As Integer, ByVal blnFailed As
Boolean, Optional ByVal strError As String = "")
Dim strSql As String
strSql = "UPDATE tblSMS SET SendTry = COALESCE(SendTry + 1, 1) "
'If blnFailed Then
' 'Add x minutes to MemoDate
' strSql = strSql & ", MemoDate = '" & _
' Format(DateAdd(DateInterval.Second,
CInt(watchedSettings("ResendSeconds")), 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.ConnectionString = watchedSettings("ConnectionString")
Dim cmdSql As SqlCommand
Try
con.Open()
cmdSql = New SqlCommand(strSql, con)
cmdSql.ExecuteNonQuery()
Catch ex As Exception
ErrorMessageSilent(Me, ex)
Finally
If Not con.State = ConnectionState.Closed Then
con.Close()
End If
End Try
End Sub
Private Sub ProcessReceivedSms()
'ask the modem the received sms...
blnReceived = False
SmsModem.SmsReadAll()
'wait for event...
End Sub
Private Sub SmsModem_TimeOutWaitingForAnswer() Handles
SmsModem.TimeOutWaitingForAnswer
SmsModem.ResetModem()
End Sub
Private Sub SmsModem_TimeOutWaitingForValidAnswer() Handles
SmsModem.TimeOutWaitingForValidAnswer
ProcessNextCycle()
End Sub
Private Sub SmsModem_UnKnownRead(ByVal strReceived As String, ByVal
mstModemStatus As clsSMSModem.enumModemStatus) Handles SmsModem.UnKnownRead
MessageSilent("Unknown Read from Modem: " & strReceived & " -
ModemStatus = " & mstModemStatus, "SmsModem_UnKnownRead")
End Sub
Private Sub DeleteErrorFiles()
MessageSilent("Deleting Old Logfiles...")
Dim colF As New Collection
Dim clsF As New clsFile
Dim intX As Integer
colF = clsF.GetAllFilesInDirOlder(Application.StartupPath , "*.err",
DateAdd(DateInterval.Day, -CDbl(watchedSettings("DeleteLogFilesDays")),
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.ElapsedEventArgs) Handles tmrProcessNext.Elapsed
tmrProcessNext.Stop()
'get the next sms in the database...
ProcessSendingSms()
End Sub
Private Sub tmrDelete_Elapsed(ByVal sender As Object, ByVal e As
System.Timers.ElapsedEventArgs) Handles tmrDelete.Elapsed
MessageMail("SMS Server still working...", "SMS SERVER NOTIFICATION:
Keep alive message...")
DeleteErrorFiles()
End Sub
Private Sub tmrTimeOutProcessLoop_Elapsed(ByVal sender As Object, ByVal
e As System.Timers.ElapsedEventArgs) Handles tmrTimeOutProcessLoop.Elapsed
'alreaddy a given time not searched for an sms....
tmrTimeOutProcessLoop.Stop()
ProcessSendingSms()
End Sub
Private Function MaxMessageFailure() As Boolean
pryMessagesFailed = pryMessagesFailed + 1
If pryMessagesFailed > 0 Then
MessageSilent("MessageFailed = " & m_intMessagesFailed,
"MaxMessageFailure")
If m_intMessagesFailed >=
CInt(watchedSettings("MaxMessageFailure")) Then
MessageSilent("MaxMessageFailure has been reached!
(MaxMessageFailure = " & watchedSettings("MaxMessageFailure") & ")",
"MaxMessageFailure")
m_intMessagesFailed = 0
MaxMessageFailure = True
SmsModem.ResetModem()
Else
'go on with process: get next process
MaxMessageFailure = False
End If
Else
MaxMessageFailure = False
End If
End Function
Private Sub tmrNotSend_Elapsed(ByVal sender As Object, ByVal e As
System.Timers.ElapsedEventArgs) Handles tmrNotSend.Elapsed
MessageSilent("Didn't receive a valid notification from SMS Modem
(Sending SMS)", "tmrNotSend_Elapsed")
MessageMail("tmrNotSend_Elapsed" & vbTab & "Restarting Server...",
"SMS SERVER ERROR: tmrNotSend_Elapsed!")
StopServer()
StartServer()
End Sub
Private Sub tmrNotReceived_Elapsed(ByVal sender As Object, ByVal e As
System.Timers.ElapsedEventArgs) Handles tmrNotReceived.Elapsed
MessageSilent("Didn't receive a valid notification from SMS Modem
(Receiving SMS)", "tmrNotReceived_Elapsed")
MessageMail("tmrNotReceived_Elapsed" & 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.SqlClient
Public Class clsSMSModem
#Region "Variabel Declarations"
Public WithEvents SerialPort1 As New SerialPort
Private WithEvents tmrWaitForValidAnswer As New Timers.Timer
Private m_ModemStatus As enumModemStatus
Private WithEvents tmrReadComPort As New Timer
Private strBigMessage As String = ""
Private blnReceivedAnswer 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 ComPortNotAvailable()
Public Event TimeOutWaitingForAnswer()
Public Event TimeOutWaitingForValidAnswer()
'Modem-Status-Changed
Public Event Modem_StatusChanged(ByVal OldStatus As enumModemStatus,
ByVal NewStatus As enumModemStatus)
'Modem Resetted
Public Event Modem_Resetted()
'PIN-events
Public Event Pin_WaitingForInput()
Public Event Pin_NotRight()
Public Event Pin_Right()
'TextMode
Public Event TextModeChanged(ByVal intTextMode As Integer)
'Character Set
Public Event CharacterSetChanged(ByVal strSet As String)
'Test Modem
Public Event Modem_TestSucceed()
'SMS-events
Public Event Sms_NumberError()
Public Event Sms_WaitingForMessage()
Public Event Sms_MessageError()
Public Event Sms_MessageSend()
'SMS-reading events
Public Event Sms_Read(ByVal dtblSMS As DataTable)
Public Event Sms_ReadingError()
Public Event Sms_Deleted()
Public Event Sms_DeletingError()
'unknow-event
Public Event UnKnownRead(ByVal 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 "Enumerations"
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
SmsNumberSending = 30
SmsNumberError = 31
SmsWaitingForMessage = 32
SmsMessageSending = 33
SmsMessageError = 34
SmsMessageSend = 35
SmsMessageReading = 40
SmsMessageHasRead = 41
SmsMessageReadingError = 42
SmsMessageDeleting = 43
SmsMessageDeletingError = 44
SmsMessageDeleted = 45
TextModeValidation = 50
TextModeValidated = 51
TextMode1 = 52
TextMode0 = 53
CharacterSetValidation = 60
CharacterSetValidated = 61
CharacterSetGSM = 62
CharacterSetUCS2 = 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_StatusChanged(m_ModemStatus, 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.PortName = strPortName
SerialPort1.Open()
' If it makes it to here, then the Comm Port is available.
SerialPort1.Close()
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(ByVal 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.Show(IsPortAvailable("COM1"))
Try
SerialPort1.PortName = strPortName '"COM1"
SerialPort1.BaudRate = intBaudRate '9600
SerialPort1.DataBits = intDataBits '8
SerialPort1.Parity = parParity 'Parity.None
SerialPort1.StopBits = stbStopBits 'StopBits.One
SerialPort1.Handshake = hskHandShake 'Handshake.None
SerialPort1.Open()
'SerialPort1.Encoding = System.Text.Encoding.GetEncoding(28591)
OpenComPort = True
Catch ex As Exception
OpenComPort = False
End Try
End Function
Public Function CloseComPort() As Boolean
'MessageBox.Show(IsPortAvailable("COM1"))
Try
tmrWaitForValidAnswer.Stop()
SerialPort1.Close()
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("WRITE: " & strMessage)
SerialPort1.Write(strMessage)
blnReceivedAnswer = False
WriteToComPort = True
tmrWaitForValidAnswer.Interval =
watchedSettings("TimeOutValidAnswerSeconds") * 1000
tmrWaitForValidAnswer.Stop()
tmrWaitForValidAnswer.Start()
Catch ex As Exception
WriteToComPort = False
RaiseEvent ComPortNotAvailable()
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
tmrWaitForValidAnswer.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.TextModeValidation
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.CharacterSetValidation
WriteToComPort("AT+CSCS=" & Chr(34) & "UCS2" & Chr(34) & cstCR)
MessageSilent("Setting to UCS2 Character Set...")
End Sub
Public Sub SmsSendNumber(ByVal strNumber As String)
ModemStatus = enumModemStatus.SmsNumberSending
WriteToComPort("AT+CMGS=" & strNumber & cstCR)
End Sub
Public Sub SmsSendMessage(ByVal strMessage As String)
ModemStatus = enumModemStatus.SmsMessageSending
WriteToComPort(strMessage & Chr(26))
'tmrReadComPort.Interval = 6000 'getest: 5,5 seconden
'tmrReadComPort.Start()
End Sub
Public Sub SmsReadAll()
ModemStatus = enumModemStatus.SmsMessageReading
'WriteToComPort("AT+CMGL=ALL" & 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.SmsMessageDeleting
If watchedSettings("DeleteReceivedSMS") Then
WriteToComPort("AT+CMGD=" & intIndex & cstCR)
Else
'in test-mode niet deleten!:
'doen alsof het gedelete is!
ModemStatus = enumModemStatus.SmsMessageDeleted
RaiseEvent Sms_Deleted()
End If
End Sub
#End Region
#Region "Private Methods"
Public Sub New()
Dim currentDomain As AppDomain = AppDomain.CurrentDomain
AddHandler currentDomain.UnhandledException, AddressOf MyHandler
AddHandler System.Windows.Forms.Application.ThreadException,
AddressOf GlobalErrorHandler
End Sub
Private Function ReadSerialPort() As String
Dim strMessage As String = ""
Dim intX As Integer
Try
intX = SerialPort1.BytesToRead
Do
strMessage = strMessage & Chr(SerialPort1.ReadChar)
If SerialPort1.BytesToRead <= 0 Then
Exit Do
End If
Loop
Catch ex As Exception
ErrorMessageSilent(Me, ex, "ReadSerialPort Exception: ",
"ReadSerialPort")
Finally
ReadSerialPort = strMessage
MessageDebug("READ: " & strMessage)
End Try
End Function
Private Sub SerialPort1_ErrorEvent(ByVal sender As Object, ByVal e As
System.IO.Ports.SerialErrorEventArgs) Handles SerialPort1.ErrorEvent
MessageSilent("Modem Error", "SerialPort1_ErrorEvent")
End Sub
Private Sub SerialPort1_ReceivedEvent(ByVal sender As Object, ByVal e As
System.IO.Ports.SerialReceivedEventArgs) Handles SerialPort1.ReceivedEvent
Dim strMessage As String = ""
strMessage = ReadSerialPort()
blnReceivedAnswer = True
'OnComm-event works always...
RaiseEvent OnComm(strMessage, ModemStatus)
strBigMessage = strBigMessage & strMessage
EvaluateReceivedText2(strBigMessage)
End Sub
Private Sub ReceivedManual()
Dim strMessage As String = ""
strMessage = ReadSerialPort()
'OnComm-event works always...
RaiseEvent OnComm(strMessage, ModemStatus)
EvaluateReceivedText(strMessage)
End Sub
Private Sub EvaluateReceivedText2(ByVal strMessage As String)
Try
If (Right(strMessage, 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(strMessage, 4) = ("OK" & cstCR & cstLF)) Then
ModemStatus = enumModemStatus.TestSucces
HadValidAnswer()
MessageSilent("Modem Tested...")
RaiseEvent Modem_TestSucceed()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.Resetting
'first OK, after 20-30 seconds: "SIM PIN REQUIRED"
'SIM PI
'N REQUIR
'ED
If (Right(strMessage, 18) = ("SIM PIN REQUIRED" & cstCR
& cstLF)) Then
'If InStr(strMessage, "SIM PIN REQUIRED") > 0 Then
'If InStr(strMessage, "N REQUIR") > 0 Then
ModemStatus = enumModemStatus.Resetted
HadValidAnswer()
MessageSilent("Modem Resetted...")
RaiseEvent Modem_Resetted()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.PinValidation
If (Right(strMessage, 7) = ("ERROR" & cstCR & cstLF))
Then
'no the right pin!
ModemStatus = enumModemStatus.PinWaiting
HadValidAnswer()
MessageSilent("Pin Error!")
RaiseEvent Pin_NotRight()
ElseIf Right(strMessage, 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_WaitingForInput()
ElseIf Right(strMessage, 12) = ("READY" & cstCR & cstCR
& cstLF & "OK" & cstCR & cstLF) Then
ModemStatus = enumModemStatus.PinValidated
HadValidAnswer()
MessageSilent("Pin Ready...")
RaiseEvent Pin_Right()
ElseIf (Right(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
ModemStatus = enumModemStatus.PinValidated
HadValidAnswer()
MessageSilent("Pin OK...")
RaiseEvent Pin_Right()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.TextModeValidation
If (Right(strMessage, 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(strMessage, 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(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
'OK after a AT+CMGF=0 or AT+CMGF=1
ModemStatus = enumModemStatus.TextModeValidated
HadValidAnswer()
MessageSilent("TextMode changed = ?...")
RaiseEvent TextModeChanged(-1)
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.CharacterSetValidation
If (Right(strMessage, 12) = ("UCS2" & Chr(34) & cstCR &
cstCR & cstLF & "OK" & cstCR & cstLF)) Then
'"AT+CSCS="UCS2"
'
'OK
'"
ModemStatus = enumModemStatus.CharacterSetUCS2
HadValidAnswer()
MessageSilent("Character Set changed = UCS2...")
RaiseEvent CharacterSetChanged("UCS2")
ElseIf (Right(strMessage, 11) = ("GSM" & Chr(34) & cstCR
& cstCR & cstLF & "OK" & cstCR & cstLF)) Then
'"AT+CSCS="GSM"
'
'OK
'"
ModemStatus = enumModemStatus.CharacterSetGSM
HadValidAnswer()
MessageSilent("Character Set changed = GSM...")
RaiseEvent CharacterSetChanged("GSM")
ElseIf (Right(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
'OK
ModemStatus = enumModemStatus.CharacterSetValidated
HadValidAnswer()
MessageSilent("Character Set changed = ?...")
RaiseEvent CharacterSetChanged("?")
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.SmsNumberSending
If (Right(strMessage, 7) = ("ERROR" & cstCR & cstLF))
Then
'ERROR
ModemStatus = enumModemStatus.SmsNumberError
'pryMessagesFailed = pryMessagesFailed + 1
HadValidAnswer()
RaiseEvent Sms_NumberError()
ElseIf (Right(strMessage, 5) = cstCR & cstCR & cstLF &
"> ") Then
'"AT+CMGS="+32486913315"
'
'> "
ModemStatus = enumModemStatus.SmsWaitingForMessage
HadValidAnswer()
RaiseEvent Sms_WaitingForMessage()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.SmsMessageSending
If (InStr(Right(strMessage, 18), "+CMGS: ") > 0) And
(Right(strMessage, 4) = ("OK" & cstCR & cstLF)) Then
'+CMGS: 9 OK '9 = number that counts
ModemStatus = enumModemStatus.SmsMessageSend
'pryMessagesFailed = 0
HadValidAnswer()
RaiseEvent Sms_MessageSend()
ElseIf (Right(strMessage, 9) = (cstCR & cstLF & "ERROR"
& cstCR & cstLF)) Then
'"ERROR"
ModemStatus = enumModemStatus.SmsMessageError
'pryMessagesFailed = pryMessagesFailed + 1
HadValidAnswer()
RaiseEvent Sms_MessageError()
ElseIf (Right(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
'no CMGS in it: not right...
ModemStatus = enumModemStatus.SmsMessageError
'pryMessagesFailed = pryMessagesFailed + 1
HadValidAnswer()
RaiseEvent Sms_MessageError()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.SmsMessageReading
If (Right(strMessage, 7) = ("ERROR" & cstCR & cstLF))
Then
'"ERROR"
ModemStatus = enumModemStatus.SmsMessageReadingError
HadValidAnswer()
RaiseEvent Sms_ReadingError()
ElseIf (Right(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
'+CMGL: 2,"REC
READ","+32479990284",,"04/06/30,12:46:33+08"
'de 2e test naar mezelf
'+CMGL: 3,"REC
READ","+32495275242",,"04/06/29,18:57:47+08"
'Proficiat van ons en van de fam boschkes
'OK
ModemStatus = ModemStatus.SmsMessageHasRead
HadValidAnswer()
'put the received SMS in the DataTable...
RaiseEvent
Sms_Read(AddReadSmsToTablePDU(strMessage))
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case enumModemStatus.SmsMessageDeleting
If (Right(strMessage, 7) = ("ERROR" & cstCR & cstLF))
Then
'"ERROR"
ModemStatus =
enumModemStatus.SmsMessageDeletingError
HadValidAnswer()
RaiseEvent Sms_DeletingError()
ElseIf (Right(strMessage, 4) = ("OK" & cstCR & cstLF))
Then
'OK
ModemStatus = ModemStatus.SmsMessageDeleted
HadValidAnswer()
RaiseEvent Sms_Deleted()
Else
'RaiseEvent UnKnownRead(strMessage, ModemStatus)
'wait...
End If
Case Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End Select
Catch ex As Exception
ErrorMessageSilent(Me, ex, "SerialPort1_ReceivedEvent Exception:
", "SerialPort1_ReceivedEvent")
End Try
End Sub
Private Sub HadValidAnswer()
tmrWaitForValidAnswer.Stop()
DebugEvaluate(strBigMessage)
strBigMessage = ""
End Sub
Private Sub EvaluateReceivedText(ByVal strMessage As String)
Try
Select Case ModemStatus
Case enumModemStatus.TestModem
If InStr(strMessage, "OK") > 0 Then
ModemStatus = enumModemStatus.TestSucces
HadValidAnswer()
MessageSilent("Modem Tested...")
RaiseEvent Modem_TestSucceed()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.Resetting
'first OK, after 20-30 seconds: "SIM PIN REQUIRED"
'SIM PI
'N REQUIR
'ED
If Right(strMessage, 18) = ("SIM PIN REQUIRED" & cstLF &
cstCR) Then
'If InStr(strMessage, "N REQUIR") > 0 Then
ModemStatus = enumModemStatus.Resetted
HadValidAnswer()
MessageSilent("Modem Resetted...")
RaiseEvent Modem_Resetted()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.PinValidation
If InStr(strMessage, "ERROR") > 0 Then
'no the right pin!
ModemStatus = enumModemStatus.PinWaiting
HadValidAnswer()
MessageSilent("Pin Error!")
RaiseEvent Pin_NotRight()
ElseIf InStr(strMessage, "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_WaitingForInput()
ElseIf InStr(strMessage, "READY") > 0 Then
ModemStatus = enumModemStatus.PinValidated
HadValidAnswer()
MessageSilent("Pin Ready...")
RaiseEvent Pin_Right()
ElseIf InStr(strMessage, "OK") > 0 Then
ModemStatus = enumModemStatus.PinValidated
HadValidAnswer()
MessageSilent("Pin OK...")
RaiseEvent Pin_Right()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.TextModeValidation
If InStr(strMessage, "1") > 0 Then
'+CMGF: 1 after a AT+CMGF?
ModemStatus = enumModemStatus.TextMode1
HadValidAnswer()
MessageSilent("TextMode changed = 1...")
RaiseEvent TextModeChanged(1)
ElseIf InStr(strMessage, "0") > 0 Then
'+CMGF: 0 after a AT+CMGF?
ModemStatus = enumModemStatus.TextMode0
HadValidAnswer()
MessageSilent("TextMode changed = 0...")
RaiseEvent TextModeChanged(0)
ElseIf InStr(strMessage, "OK") > 0 Then
'OK after a AT+CMGF=0 or AT+CMGF=1
ModemStatus = enumModemStatus.TextModeValidated
HadValidAnswer()
MessageSilent("TextMode changed = ?...")
RaiseEvent TextModeChanged(-1)
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.SmsNumberSending
If InStr(strMessage, "ERROR") > 0 Then
'ERROR
ModemStatus = enumModemStatus.SmsNumberError
HadValidAnswer()
'pryMessagesFailed = pryMessagesFailed + 1
RaiseEvent Sms_NumberError()
ElseIf InStr(strMessage, ">") > 0 Then
'>
ModemStatus = enumModemStatus.SmsWaitingForMessage
HadValidAnswer()
RaiseEvent Sms_WaitingForMessage()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.SmsMessageSending
If InStr(strMessage, "ERROR") > 0 Then
'"ERROR"
ModemStatus = enumModemStatus.SmsMessageError
HadValidAnswer()
'pryMessagesFailed = pryMessagesFailed + 1
RaiseEvent Sms_MessageError()
ElseIf (InStr(strMessage, "+CMGS: ") > 0) And
(InStr(Right(strMessage, 10), "OK") > 0) Then
'+CMGS: 9 OK '9 = number that counts
ModemStatus = enumModemStatus.SmsMessageSend
HadValidAnswer()
'pryMessagesFailed = 0
RaiseEvent Sms_MessageSend()
ElseIf InStr(strMessage, "OK") > 0 Then
'no CMGS in it: not right...
ModemStatus = enumModemStatus.SmsMessageError
HadValidAnswer()
'pryMessagesFailed = pryMessagesFailed + 1
RaiseEvent Sms_MessageError()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.SmsMessageReading
If InStr(strMessage, "ERROR") > 0 Then
'"ERROR"
ModemStatus = enumModemStatus.SmsMessageReadingError
HadValidAnswer()
RaiseEvent Sms_ReadingError()
ElseIf InStr(Right(strMessage, 8), "OK") > 0 Then
'+CMGL: 2,"REC
READ","+32479990284",,"04/06/30,12:46:33+08"
'de 2e test naar mezelf
'+CMGL: 3,"REC
READ","+32495275242",,"04/06/29,18:57:47+08"
'Proficiat van ons en van de fam boschkes
'OK
ModemStatus = ModemStatus.SmsMessageHasRead
HadValidAnswer()
'put the received SMS in the DataTable...
RaiseEvent
Sms_Read(AddReadSmsToTablePDU(strMessage))
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case enumModemStatus.SmsMessageDeleting
If InStr(strMessage, "ERROR") > 0 Then
'"ERROR"
ModemStatus =
enumModemStatus.SmsMessageDeletingError
HadValidAnswer()
RaiseEvent Sms_DeletingError()
ElseIf InStr(strMessage, "OK") > 0 Then
'OK
ModemStatus = ModemStatus.SmsMessageDeleted
HadValidAnswer()
RaiseEvent Sms_Deleted()
Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End If
Case Else
RaiseEvent UnKnownRead(strMessage, ModemStatus)
End Select
Catch ex As Exception
ErrorMessageSilent(Me, ex, "SerialPort1_ReceivedEvent Exception:
", "SerialPort1_ReceivedEvent")
End Try
End Sub
Public Function AddReadSmsToTable(ByVal strMessages As String) As
DataTable
Dim dtbl As New DataTable
dtbl = MakeSmsReceivedTable()
Dim drowRow As DataRow
Dim strColSMS As String() 'contains all the SMS...
strColSMS = Split(strMessages, "+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.GetUpperBound(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(strColSMS(intX), vbCrLf,
Chr(13))
strSMS = Split(strColSMS(intX), Chr(13))
strData = Split(strSMS(0), ",")
drowRow = dtbl.NewRow
drowRow.Item("Index") = Trim(strData(0))
drowRow.Item("Status") = Replace(Trim(strData(1)), """",
"")
drowRow.Item("Number") = Replace(Trim(strData(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("Date") = dtDate
drowRow.Item("Message") = strSMS(1)
dtbl.Rows.Add(drowRow)
Catch ex As Exception
ErrorMessageSilent(Me, ex)
End Try
Next
End If
AddReadSmsToTable = dtbl
End Function
Public Function AddReadSmsToTablePDU(ByVal strMessages As String) As
DataTable
Dim dtbl As New DataTable
dtbl = MakeSmsReceivedTable()
Dim drowRow As DataRow
Dim strColSMS As String() 'contains all the SMS...
strColSMS = Split(strMessages, "+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.GetUpperBound(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(strColSMS(intX), vbCrLf,
Chr(13))
strSMS = Split(strColSMS(intX), Chr(13))
strData = Split(strSMS(0), ",")
Catch ex As Exception
ErrorMessageSilent(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
ErrorMessageSilent(Me, ex, "|" & strMessages & "|" &
intAantal, "PDUCode = strSMS(1)")
End Try
Dim T As clsPDUDecode.SMSType =
clsPDUDecode.GetSMSType(PDUCode)
strType = T.ToString
Try
Select Case T
Case clsPDUDecode.SMSType.EMS_RECEIVED
s = New EMS_RECEIVED(PDUCode)
strNumber = s.SrcAddressValue
dtDate = s.TP_SCTS
'txtResult.Text += "From:" +
s.SrcAddressValue + " Time:" + s.TP_SCTS + vbCrLf + vbCrLf
Case clsPDUDecode.SMSType.SMS_RECEIVED
s = New SMS_RECEIVED(PDUCode)
strNumber = s.SrcAddressValue
dtDate = s.TP_SCTS
'txtResult.Text += "From:" +
s.SrcAddressValue + " Time:" + s.TP_SCTS + vbCrLf + vbCrLf
Case clsPDUDecode.SMSType.EMS_SUBMIT
s = New EMS_SUBMIT(PDUCode)
strNumber = s.SrcAddressValue
dtDate = Now
'txtResult.Text += "Send to:" +
s.DesAddressValue + vbCrLf + vbCrLf
Case clsPDUDecode.SMSType.SMS_SUBMIT
s = New SMS_SUBMIT(PDUCode)
strNumber = s.SrcAddressValue
dtDate = Now
'txtResult.Text += "Send to:" +
s.DesAddressValue + vbCrLf + vbCrLf
Case clsPDUDecode.SMSType.SMS_STATUS_REPORT
s = New SMS_STATUS_REPORT(PDUCode)
strNumber = s.SrcAddressValue
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
ErrorMessageSilent(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.SMSType.SMS_RECEIVED) Or (T =
clsPDUDecode.SMSType.EMS_RECEIVED) Then
'eentje ontvangen: zet het in de database!!
Try
drowRow.Item("Index") = Trim(strData(0))
drowRow.Item("Status") = Replace(Trim(strData(1)),
"""", "")
drowRow.Item("Number") = MakeValidNumber(strNumber)
drowRow.Item("Date") = dtDate
drowRow.Item("Message") = strMessage
Catch ex As Exception
ErrorMessageSilent(Me, ex, "|" & strMessages & "|" &
intAantal & vbCrLf & strSMS(0), "Add SMS to Table")
Finally
dtbl.Rows.Add(drowRow)
End Try
'End If
Catch ex As Exception
ErrorMessageSilent(Me, ex, "|" & strMessages & "|" &
intAantal & vbCrLf & strColSMS(intX), "AddReadSmsToTablePDU")
End Try
Next
End If
AddReadSmsToTablePDU = dtbl
End Function
Private Function MakeSmsReceivedTable() As DataTable
Dim dtbl As New DataTable
Dim dcolCol As DataColumn
dcolCol = New DataColumn("Index")
dcolCol.DataType = System.Type.GetType("System.Int16")
dtbl.Columns.Add(dcolCol)
dcolCol = New DataColumn("Number")
dcolCol.DataType = System.Type.GetType("System.String")
dtbl.Columns.Add(dcolCol)
dcolCol = New DataColumn("Date")
dcolCol.DataType = System.Type.GetType("System.DateTime")
dtbl.Columns.Add(dcolCol)
dcolCol = New DataColumn("Message")
dcolCol.DataType = System.Type.GetType("System.String")
dtbl.Columns.Add(dcolCol)
dcolCol = New DataColumn("Status")
dcolCol.DataType = System.Type.GetType("System.String")
dtbl.Columns.Add(dcolCol)
MakeSmsReceivedTable = dtbl
End Function
Private Sub tmrReadComPort_Tick(ByVal sender As Object, ByVal e As
System.EventArgs) Handles tmrReadComPort.Tick
tmrReadComPort.Stop()
ReceivedManual()
End Sub
Private Sub DebugEvaluate(ByVal strB As String)
MessageDebug("EVALUATED: " & strB)
End Sub
Private Sub tmrWaitForValidAnswer_Elapsed(ByVal sender As Object, ByVal
e As System.Timers.ElapsedEventArgs) Handles tmrWaitForValidAnswer.Elapsed
tmrWaitForValidAnswer.Stop()
'didn't get any answer from the modem after x minutes...
If blnReceivedAnswer Then
MessageSilent("Didn't get a valid answer from the modem!", "No
valid answer from Modem")
'reset the modem!
'ResetModem()
RaiseEvent TimeOutWaitingForValidAnswer()
Else
MessageSilent("Didn't get any answer from the modem!", "No
answer from Modem")
'reset the modem!
'ResetModem()
RaiseEvent TimeOutWaitingForAnswer()
End If
End Sub
#End Region
End Class
Option Explicit On
Imports System.Collections
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 "Enumerations"
'Public Enum enumPduType
' PduTypeA1C = 1
' PduTypeM1C = 2
'End Enum
Public Enum enumDestination
Unknown = 0
InternationalNumber = 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 EncodeOutgoingSMS(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.InternationalNumber
End If
strPDU = "00" 'Length of the SMSC information
strPDU = strPDU & "0" 'no validity period!
strPDU = strPDU & "1" 'SMS-SUBMIT
'If PDUType = A1C Then EncodeOutgoingSMS = EncodeOutgoingSMS &
ASCIIHex(&H0) 'TP-MTI etc
'If PDUType = M1C Then EncodeOutgoingSMS = EncodeOutgoingSMS &
ASCIIHex(&H1) 'PDU type
'If PDUType = A1C Then EncodeOutgoingSMS = EncodeOutgoingSMS &
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(strNumber)) 'length of
destination address
'Type-Of-Adress
Select Case Destination
Case enumDestination.InternationalNumber
strPDU = strPDU & "91"
Case enumDestination.National
strPDU = strPDU & "A1"
Case enumDestination.NetworkSpecific
strPDU = strPDU & "B1"
Case Else
strPDU = strPDU & "81" 'unknown
End Select
'if number is odd: add an "F"
If Len(strNumber) / 2 <> Int(Len(strNumber) / 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(Message, intLen)
strPDU = strPDU & ASCIIHex(intLen)
'strPDU = strPDU & MessageEncode(Message)
strPDU = strPDU & strB
PDU = strPDU
PDU_Len = (Len(strPDU) / 2) - 1
End Sub
#End Region
#Region "Private Methods"
Private Function Encode7Bit(ByVal Content As String, ByRef Length As
Integer) As String
'Prepare
Dim CharArray As Char() = Content.ToCharArray
Dim c As Char
Dim t As String = ""
For Each c In CharArray
't = CharTo7Bits(cls7Bit.Get7BitFromAinsi(c)) + t
t = StringTo7Bits(cls7Bit.Get7BitFromAinsi(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(ByVal 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(ByVal content As String) As String
Dim Result As String
Result = ""
Dim CharArray As Char() = content.ToCharArray
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(ByVal 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(Content, 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(ByVal 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(InMsg, 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(Eightbit, 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(Eightbit, 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.VisualBasic.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******@mail.sc.cninfo.net
' 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_REPORT = 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(GetString(SCTS, 2))) + 2000
month = Val(Swap(GetString(SCTS, 2)))
day = Val(Swap(GetString(SCTS, 2)))
hour = Val(Swap(GetString(SCTS, 2)))
minute = Val(Swap(GetString(SCTS, 2)))
second = Val(Swap(GetString(SCTS, 2)))
timezone = Val(Swap(GetString(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.ToCharArray
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(ByRef Address As String) As String
Dim tmpChar As Char() = Address.ToCharArray
Dim i As Integer, result As String
result = ""
For i = 0 To tmpChar.GetUpperBound(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(ByVal PDUCode As String) As
clsPDUDecode.SMSType
'Get first october
Dim FirstOctet As Byte
Dim L As Integer = clsPDUDecode.GetByte(PDUCode)
clsPDUDecode.GetByte(PDUCode)
clsPDUDecode.GetString(PDUCode, (L - 1) * 2)
FirstOctet = clsPDUDecode.GetByte(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.SMSType.EMS_SUBMIT
Return t1 + t2
End Function
'Deoce a unicode string
Shared Function DecodeUnicode(ByVal strUnicode As String) As String
Dim Code As String = ""
Dim j As Integer
Dim c() As String 'temp
ReDim c(strUnicode.Length / 4) '2 Byte a Unicode char
For j = 0 To strUnicode.Length \ 4 - 1
Dim d() As Char = strUnicode.ToCharArray(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(ByVal 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.ToCharArray
Dim Dec, CharAscii, Reminder As Integer
Try
Do Until j > tmpChar.GetUpperBound(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.GetAinsiCodeFrom7BitCode(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
ErrorMessageSilent(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.GetUpperBound(0) - 1))
'And (Reminder <> 0)
Try
If (i = 6) And (Len(Result) < intLen) Then
intAsc = cls7Bit.GetAinsiCodeFrom7BitCode(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
ErrorMessageSilent(ex, "reminder", "Decode7Bit")
End Try
i += 1
j += 2
Loop
Catch ex As Exception
ErrorMessageSilent(ex, "Decode7Bit", "Decode7Bit")
End Try
Return (Result)
End Function
End Class
Public Class SMS_RECEIVED
Inherits clsPDUDecode
Public SrcAddressLength As Byte
Public SrcAddressType As Byte
Public SrcAddressValue As String
Public TP_SCTS As Date
Sub New(ByVal PDUCode As String)
Try
Type = clsPDUDecode.SMSType.SMS_RECEIVED
GetOrignalData(PDUCode)
Catch ex As Exception
ErrorMessageSilent(Me, ex, "clsPDUDecode - SMS_RECEIVED - Sub
New", "clsPDUDecode - SMS_RECEIVED - Sub New")
End Try
End Sub
Public Overrides Sub GetOrignalData(ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode)
SCAddressType = GetByte(PDUCode)
SCAddressValue = GetAddress((GetString(PDUCode, (SCAddressLength -
1) * 2)))
FirstOctet = GetByte(PDUCode)
SrcAddressLength = GetByte(PDUCode)
SrcAddressType = GetByte(PDUCode)
SrcAddressLength += SrcAddressLength Mod 2
SrcAddressValue = GetAddress((GetString(PDUCode, SrcAddressLength)))
TP_PID = GetByte(PDUCode)
TP_DCS = GetByte(PDUCode)
TP_SCTS = GetDate(GetString(PDUCode, 14))
TP_UDL = GetByte(PDUCode)
TP_UD = GetString(PDUCode, TP_UDL * 2)
End Sub
End Class
Public Class SMS_SUBMIT
Inherits clsPDUDecode
Public TP_MR As Byte
Public DesAddressLength As Byte
Public DesAddressType As Byte
Public DesAddressValue As String
Public TP_VP As Byte
Sub New(ByVal PDUCode As String)
Type = clsPDUDecode.SMSType.SMS_SUBMIT
GetOrignalData(PDUCode)
End Sub
Public Overrides Sub GetOrignalData(ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode)
SCAddressType = GetByte(PDUCode)
SCAddressValue = GetAddress((GetString(PDUCode, (SCAddressLength -
1) * 2)))
FirstOctet = GetByte(PDUCode)
TP_MR = GetByte(PDUCode)
DesAddressLength = GetByte(PDUCode)
DesAddressType = GetByte(PDUCode)
DesAddressLength += DesAddressLength Mod 2
DesAddressValue = GetAddress((GetString(PDUCode, DesAddressLength)))
TP_PID = GetByte(PDUCode)
TP_DCS = GetByte(PDUCode)
TP_VP = GetByte(PDUCode)
TP_UDL = GetByte(PDUCode)
TP_UD = GetString(PDUCode, 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(PDUCode)
End Sub
Public Overrides Sub GetOrignalData(ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode)
SCAddressType = GetByte(PDUCode)
SCAddressValue = GetAddress(GetString(PDUCode, (SCAddressLength - 1)
* 2))
FirstOctet = GetByte(PDUCode)
SrcAddressLength = GetByte(PDUCode)
SrcAddressType = GetByte(PDUCode)
SrcAddressLength += SrcAddressLength Mod 2
SrcAddressValue = GetAddress((GetString(PDUCode, SrcAddressLength)))
TP_PID = GetByte(PDUCode)
TP_DCS = GetByte(PDUCode)
TP_SCTS = GetDate(GetString(PDUCode, 14))
TP_UDL = GetByte(PDUCode)
TP_UDHL = GetByte(PDUCode)
IE = GetIE(GetString(PDUCode, TP_UDHL * 2))
TP_UD = GetString(PDUCode, 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(IECode, .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(PDUCode)
Type = clsPDUDecode.SMSType.EMS_SUBMIT
End Sub
Public TP_UDHL As Byte
Public IE() As EMS_RECEIVED.InfoElem
Public Overrides Sub GetOrignalData(ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode)
SCAddressType = GetByte(PDUCode)
SCAddressValue = GetAddress(GetString(PDUCode, (SCAddressLength - 1)
* 2))
FirstOctet = GetByte(PDUCode)
TP_MR = GetByte(PDUCode)
DesAddressLength = GetByte(PDUCode)
DesAddressType = GetByte(PDUCode)
DesAddressLength += DesAddressLength Mod 2
DesAddressValue = GetAddress(GetString(PDUCode, DesAddressLength))
TP_PID = GetByte(PDUCode)
TP_DCS = GetByte(PDUCode)
TP_VP = GetByte(PDUCode)
TP_UDL = GetByte(PDUCode)
TP_UDHL = GetByte(PDUCode)
IE = EMS_RECEIVED.GetIE(GetString(PDUCode, TP_UDHL * 2))
TP_UD = GetString(PDUCode, TP_UDL * 2)
End Sub
End Class
Public Class SMS_STATUS_REPORT
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(PDUCode)
Type = clsPDUDecode.SMSType.SMS_STATUS_REPORT
End Sub
Public Overrides Sub GetOrignalData(ByVal PDUCode As String)
SCAddressLength = GetByte(PDUCode)
SCAddressType = GetByte(PDUCode)
SCAddressValue = GetAddress(GetString(PDUCode, (SCAddressLength - 1)
* 2))
FirstOctet = GetByte(PDUCode)
TP_MR = GetByte(PDUCode)
SrcAddressLength = GetByte(PDUCode)
SrcAddressType = GetByte(PDUCode)
SrcAddressLength += SrcAddressLength Mod 2
SrcAddressValue = GetAddress(GetString(PDUCode, SrcAddressLength))
TP_SCTS = GetDate(GetString(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(GetString(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 listReplaceByChar2 As New SortedList
Dim listExtendedChar As New SortedList
Public Sub New()
'asc(ansi) -> 'according dec of gsm-binary)
listChar.Add(36, 2) '$
listChar.Add(64, 0) '@
listExtendedChar.Add(91, 60) '[
listExtendedChar.Add(92, 47) '\
listExtendedChar.Add(93, 62) ']
listExtendedChar.Add(94, 20) '^
listChar.Add(95, 17) '_
listReplaceChar.Add(96, 39) ''
listExtendedChar.Add(123, 40) '{
listExtendedChar.Add(124, 64) '|
listExtendedChar.Add(125, 41) '}
listExtendedChar.Add(126, 61) '~
listReplaceChar.Add(127, 63) 'DEL 63 = ?
listExtendedChar.Add(128, 101) '? = e
listReplaceByChar2.Add(140, "OE") 'Franse OE
listReplaceChar.Add(145, 39) ''
listReplaceChar.Add(146, 39) ''
listReplaceChar.Add(147, 34) '"
listReplaceChar.Add(148, 34) '"
listExtendedChar.Add(152, 61) '~
listReplaceByChar2.Add(156, "oe")
listChar.Add(161, 64) 'omgekeerd uitroepteken
listChar.Add(163, 1) '£
listChar.Add(164, 36) 'intl. monetary symbol
listChar.Add(165, 3) 'yen
listChar.Add(167, 95) 'paragraph
listReplaceChar.Add(168, 34) '¨ => "
listReplaceChar.Add(180, 39) ''
listReplaceChar.Add(181, 117) 'µ => u
listChar.Add(191, 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(196, 91) 'Ä
listChar.Add(197, 14) 'A ring
listChar.Add(198, 28) 'AE ligature
listReplaceChar.Add(199, 67) 'grote ç = C => C
listReplaceChar.Add(200, 69) 'È => E
listChar.Add(201, 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(209, 93) 'Ñ
listReplaceChar.Add(210, 79) 'Ò => O
listReplaceChar.Add(211, 79) 'Ó => O
listReplaceChar.Add(212, 79) 'Ô => O
listReplaceChar.Add(213, 79) 'Õ => O
listChar.Add(214, 92) 'Ö
listReplaceChar.Add(215, 120) 'x (vermenigvuldigen) => x (letter
x)
listChar.Add(216, 11) 'O met streepje door
listReplaceChar.Add(217, 85) 'Ù => U
listReplaceChar.Add(218, 85) 'Ú => U
listReplaceChar.Add(219, 85) 'Û => U
listChar.Add(220, 94) 'Ü
listReplaceChar.Add(221, 89) 'Ý => Y
listChar.Add(223, 30) 'german B
listChar.Add(224, 127) 'à
listReplaceChar.Add(225, 15) 'á => a ring
listReplaceChar.Add(226, 15) 'â => a ring
listReplaceChar.Add(227, 15) 'ã => a ring
listChar.Add(228, 123) 'ä
listChar.Add(229, 15) 'a ring
listChar.Add(230, 29) 'ae
listChar.Add(231, 9) 'ç
listChar.Add(232, 4) 'è
listChar.Add(233, 5) 'é
listReplaceChar.Add(234, 101) 'ê => e
listReplaceChar.Add(235, 101) 'ë => e
listChar.Add(236, 7) 'ì
listReplaceChar.Add(237, 105) 'í => i
listReplaceChar.Add(238, 105) 'î => i
listReplaceChar.Add(239, 105) 'ï => i
listChar.Add(241, 125) 'ñ
listChar.Add(242, 8) 'ò
listReplaceChar.Add(243, 111) 'ó => o
listReplaceChar.Add(244, 111) 'ô => o
listReplaceChar.Add(245, 111) 'õ => o
listChar.Add(246, 124) 'ö
listReplaceChar.Add(247, 47) '- divide symbol => /
listChar.Add(248, 12) 'o met streepje door
listChar.Add(249, 6) 'ù
listReplaceChar.Add(250, 117) 'ú => u
listReplaceChar.Add(251, 117) 'û => u
listChar.Add(252, 126) 'ü
listReplaceChar.Add(253, 121) 'ý => y
listReplaceChar.Add(255, 121) 'ÿ => y
End Sub
Public Function Get7BitFromAinsi(ByVal strC As Char) As String
'if this char is in the lsit, then change it...
If listChar.ContainsKey(Asc(strC)) Then
Get7BitFromAinsi = Chr(listChar.Item(Asc(strC)))
ElseIf listReplaceChar.ContainsKey(Asc(strC)) Then
Get7BitFromAinsi = Chr(listReplaceChar.Item(Asc(strC)))
ElseIf listReplaceByChar2.ContainsKey(Asc(strC)) Then
Get7BitFromAinsi = listReplaceByChar2.Item(Asc(strC))
ElseIf listExtendedChar.ContainsKey(Asc(strC)) Then
Get7BitFromAinsi = Chr(27) +
Chr(listExtendedChar.Item(Asc(strC))) 'chr(27) = escape character!
Else
Get7BitFromAinsi = strC
End If
End Function
Public Function GetAinsiCodeFrom7BitCode(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 listExtendedChar.ContainsValue(int7BitCode) Then
intIndex = listExtendedChar.IndexOfValue(int7BitCode)
GetAinsiCodeFrom7BitCode = listExtendedChar.GetKey(intIndex)
Else
GetAinsiCodeFrom7BitCode = int7BitCode
End If
ElseIf listChar.ContainsValue(int7BitCode) Then
intIndex = listChar.IndexOfValue(int7BitCode)
GetAinsiCodeFrom7BitCode = listChar.GetKey(intIndex)
Else
GetAinsiCodeFrom7BitCode = int7BitCode
End If
End Function
End Class
"ransoma22" <al********@gmail.com> wrote in message
news:11**********************@g49g2000cwa.googlegr oups.com...
hi,
thanks for replying.
May i know which component are u using to read your message ?
or any sample code?
thanks~
