Langkah-langkah pengcodingan:
Nah sekarang buka
Program Microsoft Visual Basic Anda dan ikuti langkah berikut ini:
1. Buka aplikasi VB 6
anda dan pilih standard exe lalu open
2. Tambahkan 1 modul
dengan cara klik menu project - add module lalu tambahkan koding dibawah ini :
Option Explicit
Public Function
RemoveInternationalDiallingCode _
(ByVal tTelNumber As
String) As String
RemoveInternationalDiallingCode
= "0" & Mid(tTelNumber, 4)
End Function
Public Function
GetSMSNum(ByVal tSMSNotification As String) As String
Dim lCRPos As Long
lCRPos =
InStrRev(tSMSNotification, vbCr)
If lCRPos > 0 Then
GetSMSNum = Mid(tSMSNotification, lCRPos - 2, 2)
If Left(GetSMSNum, 1)
= "," Then GetSMSNum = Right(GetSMSNum, 1)
End Function
Public Function
ReadSMS(comms As MSComm, _
ByVal tSMSNum As
String, tMessage As String, _
tSender As String,
tDate As String, _
tTime As String,
bRead As Boolean) As Boolean
Dim tChar As String *
1
Dim i As Long
Dim tRead As String
Dim lQuoteNum As Long
Dim tDateTime As
String
Dim tData As String
Const TIMEOUT =
10000
On Error GoTo
ErrHandler
tData =
"AT+CMGR=" & tSMSNum & vbCr
comms.InBufferCount =
0
comms.Output = tData
tData = ""
i = timeGetTime
Do While timeGetTime
- i <= TIMEOUT And InStr(tData, "OK" & vbCrLf) = 0 And
InStr(tData, "ERROR" & vbCrLf) = 0
DoEvents
If
comms.InBufferCount > 0 Then
tChar = comms.Input
tData = tData &
tChar
End If
Loop
If InStr(tData,
"ERROR") = 0 And tData <> "" Then
For i = 1 To
Len(tData)
tChar = Mid(tData, i,
1)
If tChar =
"""" Then lQuoteNum = lQuoteNum + 1
If lQuoteNum = 1 And
tChar <> """" Then tRead = tRead & tChar
If lQuoteNum = 3 And
tChar <> """" Then tSender = tSender & tChar
If lQuoteNum = 5 And
tChar <> """" Then tDateTime = tDateTime & tChar
If lQuoteNum = 6 And
tChar <> """" Then tMessage = tMessage & tChar
Next i
bRead = (tRead =
"REC READ")
tDate =
Left(tDateTime, 8)
tTime =
Mid(tDateTime, 10, 8)
tMessage =
Mid(tMessage, 3)
tMessage =
Mid(tMessage, 1, InStr(tMessage, vbCr) - 1)
ReadSMS = True
End If
Exit Function
ErrHandler:
ReadSMS = False
End Function
Public Function
DeleteAllSMSes(comms As MSComm) As Boolean
Dim i As Long
For i = 1 To 15
DeleteAllSMSes =
InStr(TransmitAndReceiveData(comms, "AT+CMGD=" & i & vbCr),
"OK")
Next i
End Function
Public Function
DeleteSMS(comms As MSComm, ByVal lSMSNum As Long) As Boolean
DeleteSMS =
InStr(TransmitAndReceiveData(comms, "AT+CMGD=" & lSMSNum &
vbCr), "OK")
End Function
Public Function
SendSMS(comms As MSComm, ByVal tSMSNum As String, ByVal tMessage As String) As
Boolean
SendSMS =
InStr(TransmitAndReceiveData(comms, "AT+CMGS=" &
"""" & tSMSNum & """" &
vbCr & tMessage & Chr(26)), "OK")
End Function
Public Function
TestModem(comms As MSComm) As String
TestModem =
TransmitAndReceiveData(comms, "AT")
End Function
Public Function
ManufacturerInfo(comms As MSComm) As String
ManufacturerInfo =
TransmitAndReceiveData(comms, "AT+CGMI")
End Function
Public Function
ModelInfo(comms As MSComm) As String
ModelInfo =
TransmitAndReceiveData(comms, "AT+CGMM")
End Function
Public Function
FirmwareInfo(comms As MSComm) As String
FirmwareInfo =
TransmitAndReceiveData(comms, "AT+CGMR")
End Function
Public Function
IMEIInfo(comms As MSComm) As String
IMEIInfo =
TransmitAndReceiveData(comms, "AT+CGSN")
End Function
Public Function
IMSIInfo(comms As MSComm) As String
IMSIInfo =
TransmitAndReceiveData(comms, "AT+CIMI")
End Function
Public Function
EF_CCIDInfo(comms As MSComm) As String
EF_CCIDInfo =
TransmitAndReceiveData(comms, "AT+CCID")
End Function
Public Function
NetworkRegStatus(comms As MSComm) As String
NetworkRegStatus =
TransmitAndReceiveData(comms, "AT+CREG?")
End Function
Public Function
AvailablePLMNs(comms As MSComm) As String
AvailablePLMNs =
TransmitAndReceiveData(comms, "AT+COPS?")
End Function
Public Function
NetworkFieldStrength(comms As MSComm) As String
NetworkFieldStrength
= TransmitAndReceiveData(comms, "AT+CSQ")
End Function
Public Function
MainCellMainParams(comms As MSComm) As String
MainCellMainParams =
TransmitAndReceiveData(comms, "AT+CCED=0")
End Function
Public Function
TransmitAndReceiveData(comms As MSComm, ByVal tData As String) As String
Dim lTime As Long
Const TIMEOUT =
10000
tData = tData &
vbCr
With comms
.InBufferCount = 0
.Output = tData
tData = ""
lTime = timeGetTime
tData = ""
Do While timeGetTime
- lTime <= TIMEOUT And InStr(tData, "OK") = 0 And InStr(tData,
"ERROR" & vbCrLf) = 0
DoEvents
If .InBufferCount
> 0 Then tData = tData & .Input
Loop
End With
TransmitAndReceiveData
= tData
End Function
4. Tambahkan komponen
mscomm punyanya microsoft
5. Set boudrate dan
lainnya sesuai dengan setingan HP atau modem anda lalu pada form load isikan
perintah inisialisasi modem/hp.
6. Silahkan test send
sms dengan menggunakan fungsi SendSMS dan silahkan coba-coba fungsi lainnya.
7. Selamat mencoba.
Tidak ada komentar:
Posting Komentar