SMS Msg using VB Application

[gurup83]

Pls. send me if any one is having an application developed in VB to send and receive SMS MSG using GSM Modems using AT Commands with source code.
I've developed one, need to compare the working with already working application

[nikazlan]

what are the tools and software needed to enable to send and receive sms using AT Command ? ...... what phone's model you are using ?

thanks

[skippa44]

I have developed a simple application in VB v6.0, it is a little bit buggy but it seems to work 99% of the time, you may need to change the SMSC number, it is currently set for Telstra Australia SMSC - uses the TAP protocol (Telocator Alphanumeric Protocol)
Here is the code:

Public intComport As Integer
Public intTimer As Integer
Private Function TransBlock(strNumber, strMessage As String) As String
'THIS FUNCTION BUILDS/ENCODES THE TRANSMISSION BLOCK FOR SENDING
Dim TBlock, nstart, nend As String
Dim Sum, TBSTRLEN, I, J, K, numlen, counter As Integer
numlen = Len(strNumber)
'strip 0 from number
strNumber = Mid(strNumber, 2, numlen - 1)
'add country code
strNumber = "61" & strNumber

'remove spaces from number
strNumber = Trim(strNumber)
For counter = 1 To Len(strNumber) Step 1
If Mid(strNumber, counter, 1) = " " Then
nstart = Mid(strNumber, 1, counter - 1) 'get every char before space
nend = Mid(strNumber, counter + 1, Len(strNumber)) 'get every char after space
strNumber = nstart & nend 'put them together
End If
Next counter

'truncate message to 160 chars
If Len(strMessage) > 160 Then
strMessage = Mid(strMessage, 1, 160)
End If

'construct transmission block
TBlock = Chr(2) & strNumber & vbCr & strMessage & vbCr & Chr(3)

TBSTRLEN = Len(TBlock)
'create checksum
Sum = 0
For I = 1 To TBSTRLEN Step 1
Sum = Sum + Asc(Mid(TBlock, I, 1))
Next I

For J = 1 To 3 Step 1
K = (Sum Mod 16) + 48
chksum = Chr(K) & chksum
Sum = Sum \ 16
Next J

'construct packet for transmission by adding checksum
TransBlock = TBlock & chksum & vbCr

End Function
Private Sub cmdClose_Click()
If MSComm1.PortOpen Then
MSComm1.PortOpen = False
End If
End Sub
Private Function fSMSSend(CommPort, strNumber, strMessage As String, TimeOut As Long) As Integer
Dim Buffer, TxBlock, Check As String
Dim IdRequest, LoginOk, Login As String
Dim vbACK, vbNAK, vbRS, vbESC, vbEOT As String
Dim counter As Integer
'set constants vars
vbACK = Chr(6)
vbNAK = Chr(21)
vbRS = Chr(30)
vbESC = Chr(27)
vbEOT = Chr(4)

TimeOut = 30 '30 second timeout
intTimer = 0 'start at 0 seconds

'setup timer
ctlTimer.Enabled = True 'enable timer
ctlTimer.Interval = 1000 'set to 1 second interval


'make comm strings
IdRequest = "ID=" & vbCr
LoginOk = vbCr & vbACK & vbCr & vbCr & vbESC & "[p" & vbCr
Login = vbESC & "PG1mnmail" & vbCr

'setup & open port
MSComm1.CommPort = intComport
MSComm1.Settings = "2400,E,7,1"
MSComm1.Handshaking = comXOnXoff
MSComm1.PortOpen = True
'setup modem for CCITT
MSComm1.Output = "ATB0" & vbCr
'counter = 0
Do 'wait for ok
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
'Sleep (1)
'counter = counter + 1

If intTimer > TimeOut Then
fSMSSend = 1
Exit Function
End If

Loop Until InStr(1, Check, "OK", vbTextCompare) <> 0

intTimer = 0

'setup modem for carrier detect
MSComm1.Output = "AT&C1" & vbCr

Buffer = ""
Check = ""
'counter = 0
Do 'wait for ok
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
' Sleep (1)
' counter = counter + 1
If intTimer > TimeOut Then
fSMSSend = 1
Exit Function
End If
Loop Until InStr(1, Check, "OK", vbTextCompare) <> 0

intTimer = 0
'dial SMSC number
MSComm1.Output = "ATDT 018018767" & vbCr

Buffer = ""
Check = ""
'counter = 0
Do 'wait for connection
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
' Sleep (1)
' counter = counter + 1
If intTimer > TimeOut Then
fSMSSend = 2
Exit Function
End If
Loop Until InStr(1, Check, "CONNECT 2400" & vbCr, vbTextCompare) <> 0

intTimer = 0
Do While intTimer < 2
DoEvents
Loop

'Call Sleep(2000)

'wakeup sequence
MSComm1.Output = vbCr

Buffer = ""
Check = ""
intTimer = 0
Do 'wait for IdRequest
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
'Sleep (1)
'counter = counter + 1
If intTimer > TimeOut Then
fSMSSend = 3
Exit Function
End If
Loop Until InStr(1, Check, IdRequest, vbTextCompare) <> 0

'login to SMSC
MSComm1.Output = Login

Buffer = ""
Check = ""
intTimer = 0
Do 'wait for LOGINOK
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
'Sleep (1)
'counter = counter + 1
If intTimer > TimeOut Then
fSMSSend = 4
Exit Function
End If
Loop Until InStr(1, Check, vbCr & vbESC & "[p" & vbCr, vbTextCompare) <> 0

'SEND MESSAGE

MSComm1.Output = TransBlock(strNumber, strMessage)

Buffer = ""
Check = ""
intTimer = 0
Do
DoEvents
Buffer = Buffer & MSComm1.Input
Check = StrConv(Buffer, vbUnicode)
If InStr(1, Check, vbNAK, vbTextCompare) <> 0 Then
fSMSSend = 5
Exit Function
End If
If InStr(1, Check, vbRS, vbTextCompare) <> 0 Then
fSMSSend = 6
Exit Function
End If
'Sleep (1)
'counter = counter + 1
If intTimer > TimeOut Then
fSMSSend = 7
Exit Function
End If
Loop Until InStr(1, Check, vbCr & vbESC & vbEOT & vbCr, vbTextCompare) <> 0

fSMSSend = 0
'close port
MSComm1.PortOpen = False

End Function
Private Sub cmdExit_Click()
Close
End Sub
Private Sub cmdSMSSend_Click()
Dim result As Integer
Dim strResult As String
Dim strPrompt As String

result = fSMSSend(intComport, txtNumber, txtMessage, 25)
Select Case result
Case 0
strResult = "SMS Sent Successfully"
Case 1
strResult = "Modem Error"
strPrompt = "Error"
Case 2
strResult = "Connection Error"
strPrompt = "Error"
Case 3
strResult = "ID Request time out"
strPrompt = "Error"
Case 4
strResult = "Login Timeout"
strPrompt = "Error"
Case 5
strResult = "Checksum Error"
strPrompt = "Error"
Case 6
strResult = "Message Response time out"
strPrompt = "Timeout"
End Select

MsgBox strResult, vbExclamation, strPrompt
End Sub

Private Sub ctlTimer_Timer()
intTimer = intTimer + 1
Debug.Print intTimer
End Sub

Private Sub Form_Activate()
On Error Resume Next
intComport = Val(GetSetting(App.Title, "Settings", "COMPORT", "&quot)
If intComport = 0 Or intComport = Null Then
intComport = 1
End If
End Sub
Private Sub mComport_Click(Index As Integer)
COMPortDlg.Show
End Sub
Private Sub MSComm1_OnComm()
Dim strPrompt As String
Dim bError As Boolean

bError = False

Select Case MSComm1.CommEvent
Case 1001
strPrompt = "Break"
bError = True
Case 1002
strPrompt = "CTSTO"
bError = True
Case 1003
strPrompt = "DSRTO"
bError = True
Case 1004
strPrompt = "Frame"
bError = True
Case 1006
strPrompt = "Overrun"
bError = True
Case 1007
strPrompt = "CDTO"
bError = True
Case 1008
strPrompt = "RxOver"
bError = True
Case 1009
strPrompt = "RxParity"
bError = True
Case 1010
strPrompt = "TxFull"
bError = True
Case 1011
strPrompt = "DCB"
bError = True
Case Default
strPrompt = "General Error"
bError = True
End Select
If bError Then MsgBox strPrompt, vbCritical, "CommError"
End Sub

Hope this helps.

If you cannot get it to work, email me skippa@iprimus.com.au and ill zip up the whole VB project and email it to you

cheers