frmsmsdemo.frm

Code For Sending SMS from VB6

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmSMSDemo 
   Caption         =   "Form1"
   ClientHeight    =   7680
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10695
   BeginProperty Font 
      Name            =   "Trebuchet MS"
      Size            =   9.75
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   7680
   ScaleWidth      =   10695
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox List1 
      Height          =   3570
      Left            =   7080
      TabIndex        =   4
      Top             =   2040
      Width           =   2895
   End
   Begin VB.CommandButton cmdReadParticularSMS 
      Caption         =   "&Read Particular SMS"
      Height          =   735
      Left            =   4680
      TabIndex        =   2
      Top             =   960
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   855
      Left            =   360
      MaxLength       =   140
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   5040
      Width           =   3975
   End
   Begin VB.CommandButton cmdSendSMS 
      Caption         =   "Send SMS"
      Height          =   495
      Left            =   4800
      TabIndex        =   0
      Top             =   5400
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid MSF1 
      Height          =   2415
      Left            =   360
      TabIndex        =   3
      Top             =   2040
      Width           =   6375
      _ExtentX        =   11245
      _ExtentY        =   4260
      _Version        =   393216
      Cols            =   3
      Appearance      =   0
      FormatString    =   "Slno | From Number      | Message                                                    "
   End
   Begin MSCommLib.MSComm Comm1 
      Left            =   7080
      Top             =   480
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      ParityReplace   =   32
      RThreshold      =   1
      RTSEnable       =   -1  'True
      BaudRate        =   115200
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Events generated"
      Height          =   270
      Left            =   7080
      TabIndex        =   10
      Top             =   1680
      Width           =   1590
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "GSM Status :"
      Height          =   270
      Left            =   480
      TabIndex        =   9
      Top             =   480
      Width           =   1155
   End
   Begin VB.Label lblGSMStatus 
      AutoSize        =   -1  'True
      Caption         =   "Good"
      Height          =   270
      Left            =   1800
      TabIndex        =   8
      Top             =   480
      Width           =   465
   End
   Begin VB.Label lblErrors 
      AutoSize        =   -1  'True
      Caption         =   "Other Error && general Messages"
      Height          =   270
      Left            =   360
      TabIndex        =   7
      Top             =   6240
      Width           =   2910
   End
   Begin VB.Label lblToNumber 
      AutoSize        =   -1  'True
      Caption         =   "To"
      Height          =   270
      Left            =   360
      TabIndex        =   6
      Top             =   4680
      Width           =   225
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Incomming SMS :"
      Height          =   270
      Left            =   360
      TabIndex        =   5
      Top             =   1560
      Width           =   1560
   End
End
Attribute VB_Name = "frmSMSDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public OK As Boolean
Public Ring As Boolean
Public Error As Boolean
Public Greater_Sign As Boolean
Public Message_Store As Boolean
Public Message_Buffer As String
Public SMS_TelNumber As String
Public SMS_MsgNumber As String
Public SMS_Message As String
Dim SMS_Break() As String
Dim SMS_Header() As String
Dim I As Integer


Private Sub cmdSendSMS_Click()
Call Send_Message(lblToNumber.Caption, Text1.Text)
lblToNumber.Caption = "To"
Text1.Text = ""
End Sub

Private Sub Comm1_OnComm()
Static CEvent As String
Dim CChar As String * 1


Select Case Comm1.CommEvent

    Case comEvReceive
    
        Do
            CChar = Comm1.Input
            If Message_Store Then
                Message_Buffer = Message_Buffer & CChar
            End If
            Select Case CChar
                Case ">"
                     Greater_Sign = True
                     List1.AddItem CChar
                Case vbLf
                
                Case vbCr
                    If Len(CEvent) > 0 Then
                      Handle_Rec_Event CEvent
                      CEvent = ""
                    End If
                Case Else
                    CEvent = CEvent + CChar
            End Select
        
        Loop While Comm1.InBufferCount
End Select

End Sub

Private Sub cmdReadParticularSMS_Click()
Call Get_Message(InputBox("Msg No:"))
    MSF1.Row = MSF1.Rows - 1
    MSF1.Col = 0
    MSF1.Text = MSF1.Row
    MSF1.Col = 1
    MSF1.Text = SMS_TelNumber
    MSF1.Col = 2
    MSF1.Text = SMS_Message
    MSF1.Rows = MSF1.Rows + 1

End Sub

Private Sub Form_Load()
Message_Store = False
Call Initialise_Modem
    
Set SMS_Conn = New Shared_Connections
Set SMS_Server = SMS_Conn.GetHandle

    
    
    MSF1.Row = MSF1.Rows - 1
    MSF1.Col = 0
    MSF1.Text = MSF1.Row
    MSF1.Col = 1
    MSF1.Text = "9343400799"
    MSF1.Col = 2
    MSF1.Text = "Hello Bassu"
    MSF1.Rows = MSF1.Rows + 1
    
    MSF1.Row = MSF1.Rows - 1
    MSF1.Col = 0
    MSF1.Text = MSF1.Row
    MSF1.Col = 1
    MSF1.Text = "9845780359"
    MSF1.Col = 2
    MSF1.Text = "Hello Bassu"
    MSF1.Rows = MSF1.Rows + 1


End Sub

Private Sub Initialise_Modem()
On Error GoTo X
' small Suggestion , please check your own GSM settings
Comm1.CommPort = 1
Comm1.Settings = "115200,n,8,1"
Comm1.Handshaking = comNone
' Other wise it will make you MAD

If Comm1.PortOpen = False Then
    Comm1.PortOpen = True
    Comm1.DTREnable = True
    Comm1.RTSEnable = True
    Comm1.RThreshold = 1
    Comm1.InputLen = 1
    OK = False
    Error = False
    Comm1.Output = "AT" & vbCrLf
    Wait_For_Response
    If Not OK Then
        Comm1.PortOpen = False
        lblGSMStatus.Caption = "Modem is not responding, check the connection"
        Exit Sub
    End If
    Comm1.Output = "ATE0" & vbCrLf
    Wait_For_Response
    Else
        lblGSMStatus.Caption = "Port Already Open"
    End If
    lblGSMStatus.Caption = "Connected"
    Exit Sub
X:
    If Err.Number = 8005 Then
        lblGSMStatus.Caption = "Port is already opened by another programme, please check"
    ElseIf Err.Number = 8002 Then
        lblGSMStatus.Caption = "Invalid Port"
    Exit Sub
    End If
End Sub

Private Sub Wait_For_Response()
Dim Start

   Start = Timer
   Do While Timer < Start + 8
      DoEvents
      If OK Then
        Exit Sub
      End If
      If Error Then
        Exit Sub
      End If
   Loop
End Sub


Private Sub Handle_Rec_Event(CEvent As String)
Dim Temp As Variant
List1.AddItem CEvent
If Mid(CEvent, 1, 5) = "+CMTI" Then
    lblErrors.Caption = "SMS Received"
    Temp = Split(CEvent, ",")
    SMS_MsgNumber = Temp(1)
    Debug.Print Temp(1)
    SMS_TelNumber = ""
    SMS_Message = ""
    Message_Buffer = ""
    CEvent = ""
    Get_Message SMS_MsgNumber
    OK = False
    Error = False
    'Delete_Message SMS_MsgNumber
    'Store_Message_In_Database SMS_TelNumber, SMS_Message
    
    MSF1.Row = MSF1.Rows - 1
    MSF1.Col = 0
    MSF1.Text = SMS_MsgNumber
    MSF1.Col = 1
    MSF1.Text = SMS_TelNumber
    MSF1.Col = 2
    MSF1.Text = SMS_Message
    MSF1.Rows = MSF1.Rows + 1

    Exit Sub
End If
Select Case CEvent
    Case "OK"
        OK = True
    Case "ERROR"
        Error = True
    Case "RING"
        If Ring = False Then
            Ring = True
        End If
    Case Else
        ' catch the ERRORS
        ' like Memory errors
        '
End Select
End Sub


Private Sub Get_Message(ByVal MsgNo As String)
SMS_TelNumber = ""
SMS_Message = ""
Message_Buffer = ""
OK = False
Error = False
Comm1.Output = "AT+CMGR=" & MsgNo & vbCrLf
While Not OK Or Error
  Message_Store = True
  DoEvents
  Wait_For_Response
Wend
If OK Then
   Read_Message
   lblErrors.Caption = "SMS Read"
End If
If Error Then
   lblErrors.Caption = "Bad Format, could not read "
End If
End Sub

Private Sub Read_Message()
If Parse_SMS Then
   SMS_Break = Split(Message_Buffer, vbCrLf, , vbTextCompare)
   SMS_Header = Split(SMS_Break(0), ",", , vbTextCompare)
   SMS_TelNumber = Mid(Right(SMS_Header(1), 11), 1, 10)
   Message_Buffer = ""
   For I = 1 To UBound(SMS_Break(), 1)
       Message_Buffer = Message_Buffer & SMS_Break(I) & vbCrLf
   Next I
   SMS_Message = Message_Buffer
   lblErrors.Caption = "Decoding"
Else
   lblErrors.Caption = "Unable to decode Message"
End If
End Sub

Public Function Parse_SMS() As Boolean
Dim StartPoint As Long
Dim EndPoint As Long
Dim Buffer1 As String
Dim Buffer2 As String
Buffer1 = Message_Buffer
StartPoint = InStr(1, Buffer1, "+CMGR:", vbTextCompare)
EndPoint = InStr(1, Buffer1, vbCrLf & "OK", vbTextCompare)
If StartPoint <> 0 And EndPoint > StartPoint Then
   I = StartPoint
   While I < EndPoint
    Buffer2 = Buffer2 & Mid(Buffer1, I, 1)
    I = I + 1
   Wend
   Parse_SMS = True
   Message_Buffer = Buffer2
   Exit Function
End If
Parse_SMS = False
End Function

Private Sub Delete_Message(ByVal MsgNo As String)
Comm1.Output = "AT+CMGD=" & MsgNo & vbCrLf
  DoEvents
  Wait_For_Response

If Error Then
   lblErrors.Caption = "Could not delete"
ElseIf OK Then
   lblErrors.Caption = "Message Deleted"
End If

End Sub


Private Function Send_Message(ByVal MobNumber As String, ByVal MsgText As String) As Boolean
Greater_Sign = False
Comm1.Output = "AT+CMGS=" & Chr(34) & Trim(MobNumber) & Chr(34) & vbCrLf
While Not Greater_Sign
    DoEvents
    Wait_For_Response
Wend
If Greater_Sign Then
    Comm1.Output = Trim(MsgText) & Chr(26) & vbCrLf
    OK = False
    Error = False
    While Not OK Or Error
        DoEvents
        Wait_For_Response
    Wend
    If OK Then
        lblErrors.Caption = "Message Sent"
        Send_Message = True
    Else
        lblErrors.Caption = "Message Not Sent"
        Send_Message = False
    End If
Else
    lblErrors.Caption = "Message cannot be sent"
    Send_Message = False
End If

End Function

Private Sub MSF1_Click()
lblToNumber.Caption = MSF1.TextMatrix(MSF1.RowSel, 1)
End Sub


Public Sub Store_Message_In_Database(ByVal SMS_TelNumber As String, ByVal SMS_Message As String)

End Sub