Send and Receive SMS using VB6 No Third Party Software Required
How to Use.
1. Connect your broadband device to your PC that support sending and receiving SMS or your phone.
2. Install driver for your device.
3. Then stop all programs associated with your device like device dashboard. If you will not stop your device dashboard, you can send SMS but you cannot received SMS directly from your program.
4. Run this program and choose your device listed on the combo box(cbo). If your device is not on the list. click refresh device list(cmdrefresh).
5. Click Test Connection(cmdconnect).
6. You may start sending SMS.
7. Tick Receive Message(chk)
Components
1. Microsoft Comm Control 6.0
Module Code
Public GSMPort As String
Public GSMDescription As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public OK As Boolean
Public Error As Boolean
Function gsmConnect(xMSComm As MSComm, xPort As String) As String
On Error Resume Next
With xMSComm
.CommPort = xPort
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
If Err.Number = 0 Then
gsmConnect = "Connection Successful"
Else
gsmConnect = "Cannot connect to" & GSMDescription & "." & Err.Description
GSMCom = ""
GSMDescription = ""
End If
End Function
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
Form Code
Private Sub chk_Click()
Screen.MousePointer = vbDefault
If chk.Value = 0 Then
If MSComm1.PortOpen = True Then
Timer1.Enabled = False
MSComm1.PortOpen = False
'StatusBar1.Panels(1).Text = "Auto responder is inactive..."
End If
ElseIf chk.Value = 1 Then
' StatusBar1.Panels(1).Text = "Waiting for incoming messages..."
getComPorts
Connect_Now
Timer1_Timer
Timer1.Enabled = True
'received2
End If
End Sub
Private Sub cmdclose_Click()
Unload Me
End Sub
Private Sub cmdconnect_Click()
If Len(Trim(cbo.Text)) = 0 Then
MsgBox "Please choose device to connect.", vbwarning, "Alert!"
cbo.SetFocus
Exit Sub
End If
On Error Resume Next
Screen.MousePointer = vbHourglass
MSComm1.PortOpen = False
getComPorts
MsgBox gsmConnect(MSComm1, GSMPort)
Screen.MousePointer = vbDefault
MSComm1.PortOpen = False
End Sub
Private Sub cmdrefresh_Click()
'On Error Resume Next
cbo.Clear
Set WMIObjectSet = GetObject("winmgmts:\\.\root\CIMV2").ExecQuery("select * from Win32_PnPEntity")
For Each wmiobject In WMIObjectSet
If InStr(wmiobject.Name, "COM") Then
If InStr(wmiobject.Name, "COM ") Then GoTo nope
cbo.AddItem wmiobject.Name
nope: End If
Next
Set WMIObjectSet = Nothing
End Sub
Private Sub getComPorts()
On Error Resume Next
If Mid(cbo.Text, Len(Trim(cbo.Text)) - 2, 1) = "M" Then
GSMPort = Mid(cbo.Text, Len(Trim(cbo.Text)) - 1, 1)
Else
GSMPort = Mid(cbo.Text, Len(Trim(cbo.Text)) - 2, 2)
End If
GSMDescription = cbo.Text
End Sub
Private Sub Connect_Now()
On Error GoTo errmali
If Len(Trim(GSMPort)) = 0 Then
MsgBox "Please check your connection to the device."
Else
With MSComm1
.CommPort = GSMPort
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End If
Exit Sub
errmali:
MsgBox "Please check your connection to the device."
End Sub
Private Sub cmdsend_Click()
On Error Resume Next
MSComm1.PortOpen = False
Connect_Now
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF = 1" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGS = " & Chr(34) & txtcontact.Text & Chr(34) & vbCrLf
Sleep 1000
MSComm1.Output = txtsms.Text & Chr(26)
Sleep 2000
End Sub
Public Sub received2()
On Error Resume Next
Dim rawmsg, msgno, msgdate, mobile, msgreceived As String
'StatusBar1.Panels(1).Text = "new message received..."
MSComm1.Output = "AT+CMEE = 1" & Chr$(13)
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
buffer$ = ""
StatusBar1.Panels(1).Text = "processing new message..."
MSComm1.Output = "AT+CMGF = 1" & Chr$(13)
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
'List All Messages
buffer$ = ""
MSComm1.Output = "AT+CMGL = " & Chr(34) & "ALL" & Chr(34) & vbCrLf
Do
DoEvents
buffer$ = MSComm1.Input
If InStr(buffer$, "+CMGL:") Then
'List2.AddItem Replace(Split(buffer$, ",")(2), Chr(34), "") & "-" & Replace(Split(buffer$, ",")(1), "REC", "") & "-" & Replace(Split(buffer$, ",")(4), Chr(34), "") & "-" & Replace(Split(buffer$, Chr(13))(2), Chr(10), "")
rawmsg = Replace(Split(buffer$, ",")(2), Chr(34), "") & "-" & Replace(Split(buffer$, ",")(1), "REC", "") & "-" & Replace(Split(buffer$, ",")(4), Chr(34), "") & "-" & Replace(Split(buffer$, Chr(13))(2), Chr(10), "")
msgno = Val(Replace(Split(buffer$, ",")(0), "+CMGL:", "")) 'Split(rawmsg, "-")(0) & vbCrLf
msgno = Trim(msgno)
msgdate = Split(rawmsg, "-")(2) & vbCrLf
msgdate = Replace(Replace(msgdate, Chr(10), ""), Chr(13), "")
mobile = Split(rawmsg, "-")(0) & vbCrLf
mobile = Replace(Replace(Replace(mobile, "+63", ""), Chr(10), ""), Chr(13), "")
msgreceived = Split(rawmsg, "-")(3) & vbCrLf
msgreceived = Replace(Replace(Trim(msgreceived), Chr(10), ""), Chr(13), "")
' display received message in a listbox name List2
'List2.AddItem "Msg. No : " & msgno & " Date: " & msgdate & " Mobile No. :" & mobile & " SMS : " & msgreceived
'KEYWORD is for auto reply, remove the block of code if you do not want to create an auto reply of received message
If UCase(msgreceived) = "KEYWORD" Then
'Process received message here
Screen.MousePointer = vbHourglass
MSComm1.Output = "AT" & vbCrLf
Wait_For_Response
MSComm1.Output = "AT+CMGF = 1" & vbCrLf
'This line can be removed if your modem will always be in Text Mode...
Wait_For_Response
MSComm1.Output = "AT+CMGS = " & Chr(34) & "+63" & mobile & Chr(34) & vbCrLf
'Replace this with your mobile Phone 's No.
Wait_For_Response
MSComm1.Output = "HI from SMS" & Chr(26)
'Sleep 2000
Wait_For_Response
Screen.MousePointer = vbDefault
End If
'end of KEYWORD block of code
List2.AddItem "Msg. No : " & msgno & " Date: " & msgdate & " Mobile No. : +63" & mobile & " SMS : " & msgreceived
'Delete SMS after reading
cmd = "AT+CMGD = " & msgno
MSComm1.Output = cmd & vbCrLf
Wait_For_Response
End If
Loop Until InStr(buffer$, "OK")
buffer$ = ""
End Sub
Private Sub Timer1_Timer()
received2
'Timer1.Enabled = false
' StatusBar1.Panels(1).Text = "Waiting for incoming messages..."
MSComm1.PortOpen = False
MSComm1.PortOpen = True
End Sub
How to Use.
1. Connect your broadband device to your PC that support sending and receiving SMS or your phone.
2. Install driver for your device.
3. Then stop all programs associated with your device like device dashboard. If you will not stop your device dashboard, you can send SMS but you cannot received SMS directly from your program.
4. Run this program and choose your device listed on the combo box(cbo). If your device is not on the list. click refresh device list(cmdrefresh).
5. Click Test Connection(cmdconnect).
6. You may start sending SMS.
7. Tick Receive Message(chk)
Components
1. Microsoft Comm Control 6.0
Module Code
Public GSMPort As String
Public GSMDescription As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public OK As Boolean
Public Error As Boolean
Function gsmConnect(xMSComm As MSComm, xPort As String) As String
On Error Resume Next
With xMSComm
.CommPort = xPort
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
If Err.Number = 0 Then
gsmConnect = "Connection Successful"
Else
gsmConnect = "Cannot connect to" & GSMDescription & "." & Err.Description
GSMCom = ""
GSMDescription = ""
End If
End Function
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
Form Code
Private Sub chk_Click()
Screen.MousePointer = vbDefault
If chk.Value = 0 Then
If MSComm1.PortOpen = True Then
Timer1.Enabled = False
MSComm1.PortOpen = False
'StatusBar1.Panels(1).Text = "Auto responder is inactive..."
End If
ElseIf chk.Value = 1 Then
' StatusBar1.Panels(1).Text = "Waiting for incoming messages..."
getComPorts
Connect_Now
Timer1_Timer
Timer1.Enabled = True
'received2
End If
End Sub
Private Sub cmdclose_Click()
Unload Me
End Sub
Private Sub cmdconnect_Click()
If Len(Trim(cbo.Text)) = 0 Then
MsgBox "Please choose device to connect.", vbwarning, "Alert!"
cbo.SetFocus
Exit Sub
End If
On Error Resume Next
Screen.MousePointer = vbHourglass
MSComm1.PortOpen = False
getComPorts
MsgBox gsmConnect(MSComm1, GSMPort)
Screen.MousePointer = vbDefault
MSComm1.PortOpen = False
End Sub
Private Sub cmdrefresh_Click()
'On Error Resume Next
cbo.Clear
Set WMIObjectSet = GetObject("winmgmts:\\.\root\CIMV2").ExecQuery("select * from Win32_PnPEntity")
For Each wmiobject In WMIObjectSet
If InStr(wmiobject.Name, "COM") Then
If InStr(wmiobject.Name, "COM ") Then GoTo nope
cbo.AddItem wmiobject.Name
nope: End If
Next
Set WMIObjectSet = Nothing
End Sub
Private Sub getComPorts()
On Error Resume Next
If Mid(cbo.Text, Len(Trim(cbo.Text)) - 2, 1) = "M" Then
GSMPort = Mid(cbo.Text, Len(Trim(cbo.Text)) - 1, 1)
Else
GSMPort = Mid(cbo.Text, Len(Trim(cbo.Text)) - 2, 2)
End If
GSMDescription = cbo.Text
End Sub
Private Sub Connect_Now()
On Error GoTo errmali
If Len(Trim(GSMPort)) = 0 Then
MsgBox "Please check your connection to the device."
Else
With MSComm1
.CommPort = GSMPort
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True
End With
End If
Exit Sub
errmali:
MsgBox "Please check your connection to the device."
End Sub
Private Sub cmdsend_Click()
On Error Resume Next
MSComm1.PortOpen = False
Connect_Now
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF = 1" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGS = " & Chr(34) & txtcontact.Text & Chr(34) & vbCrLf
Sleep 1000
MSComm1.Output = txtsms.Text & Chr(26)
Sleep 2000
End Sub
Public Sub received2()
On Error Resume Next
Dim rawmsg, msgno, msgdate, mobile, msgreceived As String
'StatusBar1.Panels(1).Text = "new message received..."
MSComm1.Output = "AT+CMEE = 1" & Chr$(13)
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
buffer$ = ""
StatusBar1.Panels(1).Text = "processing new message..."
MSComm1.Output = "AT+CMGF = 1" & Chr$(13)
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
'List All Messages
buffer$ = ""
MSComm1.Output = "AT+CMGL = " & Chr(34) & "ALL" & Chr(34) & vbCrLf
Do
DoEvents
buffer$ = MSComm1.Input
If InStr(buffer$, "+CMGL:") Then
'List2.AddItem Replace(Split(buffer$, ",")(2), Chr(34), "") & "-" & Replace(Split(buffer$, ",")(1), "REC", "") & "-" & Replace(Split(buffer$, ",")(4), Chr(34), "") & "-" & Replace(Split(buffer$, Chr(13))(2), Chr(10), "")
rawmsg = Replace(Split(buffer$, ",")(2), Chr(34), "") & "-" & Replace(Split(buffer$, ",")(1), "REC", "") & "-" & Replace(Split(buffer$, ",")(4), Chr(34), "") & "-" & Replace(Split(buffer$, Chr(13))(2), Chr(10), "")
msgno = Val(Replace(Split(buffer$, ",")(0), "+CMGL:", "")) 'Split(rawmsg, "-")(0) & vbCrLf
msgno = Trim(msgno)
msgdate = Split(rawmsg, "-")(2) & vbCrLf
msgdate = Replace(Replace(msgdate, Chr(10), ""), Chr(13), "")
mobile = Split(rawmsg, "-")(0) & vbCrLf
mobile = Replace(Replace(Replace(mobile, "+63", ""), Chr(10), ""), Chr(13), "")
msgreceived = Split(rawmsg, "-")(3) & vbCrLf
msgreceived = Replace(Replace(Trim(msgreceived), Chr(10), ""), Chr(13), "")
' display received message in a listbox name List2
'List2.AddItem "Msg. No : " & msgno & " Date: " & msgdate & " Mobile No. :" & mobile & " SMS : " & msgreceived
'KEYWORD is for auto reply, remove the block of code if you do not want to create an auto reply of received message
If UCase(msgreceived) = "KEYWORD" Then
'Process received message here
Screen.MousePointer = vbHourglass
MSComm1.Output = "AT" & vbCrLf
Wait_For_Response
MSComm1.Output = "AT+CMGF = 1" & vbCrLf
'This line can be removed if your modem will always be in Text Mode...
Wait_For_Response
MSComm1.Output = "AT+CMGS = " & Chr(34) & "+63" & mobile & Chr(34) & vbCrLf
'Replace this with your mobile Phone 's No.
Wait_For_Response
MSComm1.Output = "HI from SMS" & Chr(26)
'Sleep 2000
Wait_For_Response
Screen.MousePointer = vbDefault
End If
'end of KEYWORD block of code
List2.AddItem "Msg. No : " & msgno & " Date: " & msgdate & " Mobile No. : +63" & mobile & " SMS : " & msgreceived
'Delete SMS after reading
cmd = "AT+CMGD = " & msgno
MSComm1.Output = cmd & vbCrLf
Wait_For_Response
End If
Loop Until InStr(buffer$, "OK")
buffer$ = ""
End Sub
Private Sub Timer1_Timer()
received2
'Timer1.Enabled = false
' StatusBar1.Panels(1).Text = "Waiting for incoming messages..."
MSComm1.PortOpen = False
MSComm1.PortOpen = True
End Sub
0 comments:
Post a Comment