At last I got time to write one of important topic here.
After long time, I finally got chance to provide download link to demo project which is below
The downloaded file is rar compressed. In case you don't have software to extract it, just download wrar320 or higher version free of cost from the internet via Google etc.
Download SMS Demo project Setup without code 2.67mb
After long time, I finally got chance to provide download link to demo project which is below
The downloaded file is rar compressed. In case you don't have software to extract it, just download wrar320 or higher version free of cost from the internet via Google etc.
Below is a sample which I used in my project
Private Sub cmdSMSTest_Click()
'validate information
'Message(max 160 Chars)
Me.MousePointer = 11 'Hourglass
Call SendMySMS(myMob, myMsg, True, Trim(Me.txtSMSDeveloperAPI), Trim(Me.txtSMSMobileText), Trim(Me.txtSMSMsgText))
Me.MousePointer = 0 'Default
End Sub
Public Function SendMySMS(ByVal myMob As String, ByVal myMsg As String, Optional ByVal IsTest As Boolean = False, Optional ByVal UserDeveloperAPI As String = "", Optional ByVal MobText As String = "", Optional ByVal MsgText As String = "", Optional ByVal AskToSend As Boolean = True, Optional ByVal ShowStatus As Boolean = True) As Boolean
'Here you write your code
Following is the sample code to test it--- but of course you need Developer API to use the code
Private Sub cmdSMSTest_Click()
'validate information
'Message(max 160 Chars)
If Me.chkSMSActivateService.Value = 0 Or Len(Me.txtSMSDeveloperAPI) < 1 Or Len(Me.txtSMSMobileText) < 1 Or Len(Me.txtSMSMessageText) < 1 Then
MsgBox "Please enter all setting values"
Me.txtSMSDeveloperAPI.SetFocus
Exit Sub
End If
Dim s As String
Dim myMob As String
Dim myMsg As String
s = "Enter Mobile nos separated by , then put @ now write your msg not more than 160 chars"
s = s & vbCrLf & "e.g 9971745868,9811994797@Hi this is test sms by ABM Infotech"
s = InputBox(s, , "9971745868,9811360935@Hi this is test sms by ABM Infotech")
myMsg = Mid(s, InStr(1, s, "@", vbTextCompare) + 1)
If Len(myMsg) > 155 Then
myMsg = Left$(myMsg, 155)
End If
myMob = Mid(s, 1, InStr(1, s, "@", vbTextCompare) - 1)
Me.MousePointer = 11 'Hourglass
Call SendMySMS(myMob, myMsg, True, Trim(Me.txtSMSDeveloperAPI), Trim(Me.txtSMSMobileText), Trim(Me.txtSMSMessageText))
Me.MousePointer = 0 'Default
End Sub
Public Sub SendMySMS(ByVal myMob As String, ByVal myMsg As String, Optional ByVal IsTest As Boolean
= False, Optional ByVal UserDeveloperAPI As String = "", Optional ByVal
MobText As String = "", Optional ByVal MsgText As String = "", Optional
ByVal AskToSend As Boolean = True, Optional ByVal ShowStatus As Boolean
= True)
'myMob,myMsg, Optional IsTest,UserDeveloperAPI , MobText, MsgText,AskToSend ,ShowStatus As Boolean = True
On Error GoTo ArunKakkarErr
Dim sMobText1 As String
Dim sMobText2() As String
Dim sMobText3() As String
Dim sResult As String, strURL As String
strURL = ""
If IsTest Then
Else 'retrieve settings from db
'''SMS_IsActivate 1,0 SMS_DeveloperAPI SMS_MobileText SMS_MessageText
If UserPreferencesGetValue("SMS_IsActivate", "0") = "0" Then Exit Sub
UserDeveloperAPI = UserPreferencesGetValue("SMS_DeveloperAPI")
MobText = UserPreferencesGetValue("SMS_MobileText")
MsgText = UserPreferencesGetValue("SMS_MessageText")
End If
'To put 91 etc for more than one mobile nos
sMobText2 = Split(MobText, "=")
sMobText1 = ""
If UBound(sMobText2) > 0 Then
sMobText1 = sMobText2(1) '2nd element
End If
If Len(sMobText1) > 0 Then
sMobText3 = Split(myMob, ",")
If UBound(sMobText3) > 0 Then
myMob = ""
For i = LBound(sMobText3) To UBound(sMobText3)
If myMob = "" Then
myMob = sMobText3(i) '1st Mobile No
Else
myMob = myMob & "," & sMobText1 & sMobText3(i) '2nd, 3rd, 4th Mob No
End If
Next i
End If
End If
strURL = UserDeveloperAPI & "&" & MobText & myMob & "&" & MsgText & myMsg
If AskToSend Then
If MsgBox("Do you want to send SMS?", vbYesNo + vbDefaultButton1) = vbNo Then
Exit Sub
End If
End If
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Msxml2.XMLHTTP")
'strURL = "http://bulksms.mysmsmantra.com:8080/WebSMS/SMSAPI.jsp?username=demouser&password=399501089&sendername=DM&mobileno=919999999999&message=Hello"
'Replace the Message & MobileNo with the no to whom you want to send SMS
With WinHttpReq
.Open "GET", strURL, False
.Send
sResult = .responseText
End With
If ShowStatus Then MsgBox "Status of Sent SMS is=" & sResult
Exit Sub
ArunKakkarErr:
MsgBox ("Sorry there is some error while sending sms" & vbCrLf & Err.Description)
End Sub
Public Function UserPreferencesGetValue(ByVal SettingName As String, Optional ByVal DefaultValue As String = "", Optional ByVal myTable As String = "UserPreferences", Optional ByVal NameCol As String = "SettingName", Optional ByVal ValueCol As String = "SettingValue")
Dim s As String
s = ""
Dim rptRs As New ADODB.Recordset
If rptRs.State Then rptRs.Close
rptRs.Open "select * from " & myTable & " where " & NameCol & "='" & SettingName & "'", Scon, adOpenStatic, adLockReadOnly
If rptRs.EOF = False Then ' if already present then return
s = IIf(IsNull(rptRs!SettingValue) = False, rptRs!SettingValue, DefaultValue)
Else ' if not present then return default
s = DefaultValue
End If
UserPreferencesGetValue = s
End Function
Public Sub UserPreferencesSetValue(ByVal SettingName As String, ByVal SettingValue As String, Optional ByVal myTable As String = "UserPreferences", Optional ByVal NameCol As String = "SettingName", Optional ByVal ValueCol As String = "SettingValue")
Dim rptRs As New ADODB.Recordset
If rptRs.State Then rptRs.Close
rptRs.Open "select * from " & myTable & " where " & NameCol & "='" & SettingName & "'", Scon, adOpenStatic, adLockReadOnly
If rptRs.EOF = False Then ' if already present then update
Scon.Execute "Update " & myTable & " set " & ValueCol & " = '" & SettingValue & "' where " & NameCol & " = '" & SettingName & "'"
Else ' if not present then insert
Scon.Execute "Insert into " & myTable & " (" & NameCol & "," & ValueCol & ") values ('" & SettingName & "','" & SettingValue & "')"
End If
End Sub
Public Sub AKakkar_Error(Optional ByVal Source As String = "")
Dim s As String
s = "Sorry for the inconvinence, There is some error"
s = s & vbCrLf & "ABM Source=" & Source
s = s & vbCrLf & "Error No=" & Err.Number
s = s & vbCrLf & "Error Description=" & Err.Description
s = s & vbCrLf & "Error Source=" & Err.Source
MsgBox s, vbCritical
End Sub
Now after learning it you can explore it in details to get more powerful options for your programs.
Best of Luck for Programming.
How to send SMS from VB6.0 via Internet
When I got this work to implement in our project, first I got very
excited but when I tried to search this topic on Internet via Google
etc, I had to struggle a lot to find the correct method.
Well We can send SMS from VB6.0 by two ways
- By using Internet (this method is explained Here )
- By Using Mobile Phone (Not explained here)
After long time, I finally got chance to provide download link to demo project which is below
The downloaded file is rar compressed. In case you don't have software to extract it, just download wrar320 or higher version free of cost from the internet via Google etc.
Please note: You need some valid Developer API.
Please either contact company or create an demo account to get developer API from the site, I had mentioned Below.
Download SMS Demo project Setup without code 2.67mb
Here I would try to explain HOW TO SEND SMS FROM VB via INTERNET
- The very first thing is that U need to contact to any SMS Providers (e.g. in India some are
- http://www.mysmsmantra.com/
- http://www.smscountry.com/ (click on Register now button at top)
- http://www.freesmsapi.com/ (click on Sign Up button at top)
- http://mirchsms.com/bulk_sms.html (please contact at no. provided at top or email at bottom to request to get trial sms api ). I also tested it very well, you may also refer my name to them.)
- Now get the Developer API from these SMS Providers either by purchasing account or if you want to test before purchasing then you can ask these SMS Providers to provide you a free trial account so that you can test their service)
- Below is one of the example of Developer API
- 'http://bulksms.mysmsmantra.com:8080/WebSMS/SMSAPI.jsp?username=demouser&password=399501089&sendername=DM&mobileno=919999999999&message=Hello"
- Now just use the following code in your VB program to send SMS
- Dim WinHttpReq As Object
- Dim sResult As String, strURL As String
- Set WinHttpReq = CreateObject("Msxml2.XMLHTTP")
- strURL="http://bulksms.mysmsmantra.com:8080/WebSMS/SMSAPI.jsp?username=demouser&password=399501089&sendername=DM&mobileno=919999999999&message=Hello"
- 'Replace the Message & MobileNo with the no to whom you want to send SMS
- With WinHttpReq
- .Open "GET", strURL, False
- .Send
- sResult = .responseText
- End With
- MsgBox "Status of Sent SMS is=" & sResult
- Some Important notes We should keep in mind while Sending SMS
- Check the Maximum Message Length that you can send as allowed by your SMS Service Providers
- Check whether you have to make your Message encode according to WWW standards, confirm it from your SMS Providers
- While sending data over internet/network, some letters can not be sent as it is, they need to be converted to send them to internet. e.g " &" can not be send as it, it needs to be converted to send it over internet.
- URL encoding converts characters into a format that can be transmitted over the Internet.
- For more information see following link
- Always Allow the access of your program to get connected with Internet which would be asked by the Firewall of your OS or Antivirus program else you could not send SMS
- As sending SMS may take time, you should do appropriate changes in your program to show user that your program is busy in sending SMS like change Mouse Pointer Shape from normal to HourGlass & after sending make it normal.
After long time, I finally got chance to provide download link to demo project which is below
The downloaded file is rar compressed. In case you don't have software to extract it, just download wrar320 or higher version free of cost from the internet via Google etc.
Please note: You need some valid Developer API.
Please either contact company or create an demo account to get developer API from the site, I had mentioned above.
Below is a sample which I used in my project
Private Sub cmdSMSTest_Click()
'validate information
'Message(max 160 Chars)
Me.MousePointer = 11 'Hourglass
Call SendMySMS(myMob, myMsg, True, Trim(Me.txtSMSDeveloperAPI), Trim(Me.txtSMSMobileText), Trim(Me.txtSMSMsgText))
Me.MousePointer = 0 'Default
End Sub
Public Function SendMySMS(ByVal myMob As String, ByVal myMsg As String, Optional ByVal IsTest As Boolean = False, Optional ByVal UserDeveloperAPI As String = "", Optional ByVal MobText As String = "", Optional ByVal MsgText As String = "", Optional ByVal AskToSend As Boolean = True, Optional ByVal ShowStatus As Boolean = True) As Boolean
'Here you write your code
Following is the sample code to test it--- but of course you need Developer API to use the code
Private Sub cmdSMSTest_Click()
'validate information
'Message(max 160 Chars)
If Me.chkSMSActivateService.Value = 0 Or Len(Me.txtSMSDeveloperAPI) < 1 Or Len(Me.txtSMSMobileText) < 1 Or Len(Me.txtSMSMessageText) < 1 Then
MsgBox "Please enter all setting values"
Me.txtSMSDeveloperAPI.SetFocus
Exit Sub
End If
Dim s As String
Dim myMob As String
Dim myMsg As String
s = "Enter Mobile nos separated by , then put @ now write your msg not more than 160 chars"
s = s & vbCrLf & "e.g 9971745868,9811994797@Hi this is test sms by ABM Infotech"
s = InputBox(s, , "9971745868,9811360935@Hi this is test sms by ABM Infotech")
myMsg = Mid(s, InStr(1, s, "@", vbTextCompare) + 1)
If Len(myMsg) > 155 Then
myMsg = Left$(myMsg, 155)
End If
myMob = Mid(s, 1, InStr(1, s, "@", vbTextCompare) - 1)
Me.MousePointer = 11 'Hourglass
Call SendMySMS(myMob, myMsg, True, Trim(Me.txtSMSDeveloperAPI), Trim(Me.txtSMSMobileText), Trim(Me.txtSMSMessageText))
Me.MousePointer = 0 'Default
End Sub
'myMob,myMsg, Optional IsTest,UserDeveloperAPI , MobText, MsgText,AskToSend ,ShowStatus As Boolean = True
On Error GoTo ArunKakkarErr
Dim sMobText1 As String
Dim sMobText2() As String
Dim sMobText3() As String
Dim sResult As String, strURL As String
strURL = ""
If IsTest Then
Else 'retrieve settings from db
'''SMS_IsActivate 1,0 SMS_DeveloperAPI SMS_MobileText SMS_MessageText
If UserPreferencesGetValue("SMS_IsActivate", "0") = "0" Then Exit Sub
UserDeveloperAPI = UserPreferencesGetValue("SMS_DeveloperAPI")
MobText = UserPreferencesGetValue("SMS_MobileText")
MsgText = UserPreferencesGetValue("SMS_MessageText")
End If
'To put 91 etc for more than one mobile nos
sMobText2 = Split(MobText, "=")
sMobText1 = ""
If UBound(sMobText2) > 0 Then
sMobText1 = sMobText2(1) '2nd element
End If
If Len(sMobText1) > 0 Then
sMobText3 = Split(myMob, ",")
If UBound(sMobText3) > 0 Then
myMob = ""
For i = LBound(sMobText3) To UBound(sMobText3)
If myMob = "" Then
myMob = sMobText3(i) '1st Mobile No
Else
myMob = myMob & "," & sMobText1 & sMobText3(i) '2nd, 3rd, 4th Mob No
End If
Next i
End If
End If
strURL = UserDeveloperAPI & "&" & MobText & myMob & "&" & MsgText & myMsg
If AskToSend Then
If MsgBox("Do you want to send SMS?", vbYesNo + vbDefaultButton1) = vbNo Then
Exit Sub
End If
End If
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Msxml2.XMLHTTP")
'strURL = "http://bulksms.mysmsmantra.com:8080/WebSMS/SMSAPI.jsp?username=demouser&password=399501089&sendername=DM&mobileno=919999999999&message=Hello"
'Replace the Message & MobileNo with the no to whom you want to send SMS
With WinHttpReq
.Open "GET", strURL, False
.Send
sResult = .responseText
End With
If ShowStatus Then MsgBox "Status of Sent SMS is=" & sResult
Exit Sub
ArunKakkarErr:
MsgBox ("Sorry there is some error while sending sms" & vbCrLf & Err.Description)
End Sub
Public Function UserPreferencesGetValue(ByVal SettingName As String, Optional ByVal DefaultValue As String = "", Optional ByVal myTable As String = "UserPreferences", Optional ByVal NameCol As String = "SettingName", Optional ByVal ValueCol As String = "SettingValue")
Dim s As String
s = ""
Dim rptRs As New ADODB.Recordset
If rptRs.State Then rptRs.Close
rptRs.Open "select * from " & myTable & " where " & NameCol & "='" & SettingName & "'", Scon, adOpenStatic, adLockReadOnly
If rptRs.EOF = False Then ' if already present then return
s = IIf(IsNull(rptRs!SettingValue) = False, rptRs!SettingValue, DefaultValue)
Else ' if not present then return default
s = DefaultValue
End If
UserPreferencesGetValue = s
End Function
Public Sub UserPreferencesSetValue(ByVal SettingName As String, ByVal SettingValue As String, Optional ByVal myTable As String = "UserPreferences", Optional ByVal NameCol As String = "SettingName", Optional ByVal ValueCol As String = "SettingValue")
Dim rptRs As New ADODB.Recordset
If rptRs.State Then rptRs.Close
rptRs.Open "select * from " & myTable & " where " & NameCol & "='" & SettingName & "'", Scon, adOpenStatic, adLockReadOnly
If rptRs.EOF = False Then ' if already present then update
Scon.Execute "Update " & myTable & " set " & ValueCol & " = '" & SettingValue & "' where " & NameCol & " = '" & SettingName & "'"
Else ' if not present then insert
Scon.Execute "Insert into " & myTable & " (" & NameCol & "," & ValueCol & ") values ('" & SettingName & "','" & SettingValue & "')"
End If
End Sub
Public Sub AKakkar_Error(Optional ByVal Source As String = "")
Dim s As String
s = "Sorry for the inconvinence, There is some error"
s = s & vbCrLf & "ABM Source=" & Source
s = s & vbCrLf & "Error No=" & Err.Number
s = s & vbCrLf & "Error Description=" & Err.Description
s = s & vbCrLf & "Error Source=" & Err.Source
MsgBox s, vbCritical
End Sub
Note:::>>>> If someone need sample program, just mail me, I would like to help you.
Now after learning it you can explore it in details to get more powerful options for your programs.
Best of Luck for Programming.