receivesms.txt

Code for receiving SMS from a GSM modem

Dim myRS As DAO.Recordset
Dim myDB As DAO.Database
Dim AddNewRecord As Boolean


Private Sub Form_Load()
    MSComm1.CommPort = 6
    MSComm1.Settings = "115200,n,8,1"
    MSComm1.PortOpen = True
    MSComm1.InputLen = 0
    MSComm1.Handshaking = comRTS
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = True
    MSComm1.RThreshold = 1
  
  AppFolder = App.Path
  Set myDB = OpenDatabase(AppFolder & "\db9.mdb")
  
  Set myRS = myDB.OpenRecordset("Select * from Table1 ORDER BY ID")
  
End Sub



Private Sub MSComm1_OnComm()
    Dim blDimensioned As Boolean
    Dim buffer() As String
    Dim R1, R2, R3, R4, i As Integer
    Dim R, R5, mess As String
    Dim Criteria As String
    Dim lngPos As Long
    
    
    If (MSComm1.CommEvent = comEvReceive) Then    'Message received from GSM modem
        R = MSComm1.Input
        R1 = 0
        R1 = InStr(R, "+CMTI:") 'modify
       If R1 > 0 Then 'modify
          
          R = Mid(R, R1, Len(R) - R1 + 1) 'Remove the "Enter" character at the beginning of line
          R1 = 0
          R1 = InStr(R, Chr(13)) 'Find the character "Enter" at the end of line +CMTI:"SM",x
          Do While R1 = 0
             R = R & MSComm1.Input
             R1 = InStr(R, Chr(13))
          Loop
          
          R2 = InStr(R, ",")
          num_message = Mid(R, R2 + 1, Len(R) - 2 - R2)
          
          MSComm1.Output = "AT+CMGR=" & num_message & Chr$(13)    'send command to read the message
                       
       Else
          R1 = 0
          R1 = InStr(R, "+CMGR:")
          If R1 > 0 Then
            R1 = 0
            R1 = InStr(R, "OK")
            Do While R1 = 0
               R = R & MSComm1.Input
               R1 = InStr(R, "OK")
            Loop
             

            'get phone number

        R2 = 0
            R2 = InStr(R, ",")
            R3 = InStr(R, ",,")
            num = Mid(R, R2 + 2, R3 - R2 - 3)


          
            'get message

        R2 = 0
        R2 = InStr(R, "+CMGR")
            R = Mid(R, R2, Len(R) - R2)
            
            R2 = 0
            R2 = InStr(R, Chr(13))
            Do While R2 = 0
             R = R & MSComm1.Input
             R2 = InStr(R, Chr(13))
            Loop
            mess = Mid(R, R2 + 2, Len(R) - R2 - 8)
                        
            R = Mid(mess, 3)   'eliminate letter C in the beginning of mess
            i = 0

'''''''''''''''categorize mess'''''''''''''

'if controlling mess
          
       If Left(mess, 1) = "C" Then
           
        Do While (i >= 0)
             R4 = InStr(R, " ")	  	'find blank character within R 
            If R4 <> 0 Then		'this is SMS for checking many devices
              
                R5 = Left(R, R4 - 1)  	'take first device's name in mess
           
                              
                'Has the array been dimensioned?
                
		If blDimensioned = True Then
                  
                    'Yes, so extend the array one element large than its current upper bound.
                    'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing
                    ReDim Preserve buffer(0 To UBound(buffer) + 1) As String
                      
                Else
                  
                    'No, so dimension it and flag it as dimensioned.
                    ReDim buffer(0 To 0) As String
                    blDimensioned = True
                      
                End If
                
		'Add the device name to the last element in the array
    
                buffer(UBound(buffer)) = R5
                 
               
                R = Mid(R, R4 + 1)	'redefine R to be next devices' name

           
	   Else	'this is for 1 device as well as for the last device in SMS
                
                'Has the array been dimensioned?
                    If blDimensioned = True Then
                  
            'Yes, so extend the array one element large than its current upper bound.
            'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing
            
	    ReDim Preserve buffer(0 To UBound(buffer) + 1) As String
                      
                    Else
                  
            'No, so dimension it and flag it as dimensioned.
            ReDim buffer(0 To 0) As String
            blDimensioned = True
                      
                    End If
       
            'Add the device name to the last element in the array.

                buffer(UBound(buffer)) = R
            Exit Do
            
	End If
        
	Loop
                    
      
        For lngPos = LBound(buffer) To UBound(buffer)
          
                Criteria = "Device='" & buffer(lngPos) & "'"    'get each device name in array
                myRS.FindFirst (Criteria)     'search for record with same name in message
                        
            'send reply to user
                MSComm1.Output = "AT+CMGS=" & num & Chr(13) & buffer(lngPos) & " " & "is" & " " & myRS.Fields("Status") & Chr(26)
          
        Next lngPos

       
        End If
       End If
    End If
  End If
End Sub