×

Discussion Board

Results 1 to 3 of 3
  1. #1
    Registered User
    Join Date
    Mar 2003
    Posts
    1

    SMS Msg using VB Application

    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

  2. #2
    Registered User
    Join Date
    Mar 2003
    Posts
    3

    RE: SMS Msg using VB Application

    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

  3. #3
    Registered User
    Join Date
    Mar 2003
    Posts
    2

    RE: SMS Msg using VB Application

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
×