VB6 SMS Gateway: Menambahkan Fitur Auto Reply

Mengenai cara membalas SMS secara otomatis melalui aplikasi VB6 - Sebelumnya kita telah membahas mengenai cara menerima SMS baru klik disini, nah sekarang kita akan menambahkan fitur auto reply melalui AT Commands dengan aplikasi VB6 yang kita buat sendiri. Adapun contoh kode VB6 membalas SMS otomatis adalah seperti di bawah ini:

Option Explicit

Dim strBuffer As String
Dim blnFirstLoad As Boolean

Private Sub Command1_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .PortOpen = True
        .Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
        .Output = TxtMessage.Text & Chr(26)
    End With
End Sub

Private Sub Form_Load()
    With MSComm1
        .CommPort = 7 'port disesuaikan atau beri kode auto detect port modem
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .NullDiscard = True
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
    Do
        strBuffer = strBuffer & MSComm1.Input
    Loop While MSComm1.InBufferCount
    If InStr(1, strBuffer, "+CMGR") Then
        If InStr(1, strBuffer, "OK") Then
            Text1.Text = strBuffer
        End If
    End If
    If InStr(1, strBuffer, "+CMTI") > 0 Then
        If Right(strBuffer, 1) = vbLf Then
            Dim s() As String
            s = Split(strBuffer, ",")
            Debug.Print s(UBound(s))
             ReadSMSByIndex Trim$(s(UBound(s)))
             Delay 1
             Command1_Click 'Auto reply
            strBuffer = ""
        End If
    End If
    End Select
End Sub

Private Sub ReadSMSByIndex(Index As Integer)
    strBuffer = ""
    MSComm1.Output = "AT+CMGR=" & Index & vbCrLf 'baca SMS yang berada di index ke-1
End Sub

Private Sub Delay(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikian contoh kode VB6 untuk membalas SMS baru secara otomatis, Anda dapat memodifikasi kodenya untuk disesuaikan dengan kebutuhan.

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

Mengirim SMS Disertai Verifikasi Terkirim - VB Source Code

Mengenai mengirim SMS menggunakan modem wavecom melalui aplikasi yang dibuat menggunakan VB6 - Ini merupakan kelanjutan dari project sebelumnya, pada kesempatan kali, kita akan menambahkan fitur verifikasi, apakah SMS telah terkirim atau gagal terkirim. Nah, bagaimanakah kode untuk mengirim SMS menggunakan modem wavecom melalui aplikasi VB6 yang disertai pesan verifikasi? berikut adalah kodenya:

Option Explicit

Dim strBuffer As String

Private Sub Command1_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .CommPort = 7
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
    MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
    Delay 1
    MSComm1.Output = TxtMessage.Text & Chr(26)
    If WaitForSuccess Then
        MsgBox "SMS telah terkirim", vbInformation + vbOKOnly
    Else
        MsgBox "SMS gagal terkirim", vbCritical, "SMS Gagal"
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
    End Select
    Debug.Print strBuffer
End Sub

Private Function WaitForSuccess() As Boolean
    Dim i As Integer
    Dim strInput As String
    Dim strPart As String
    Dim c As String, b As String
    For i = 1 To 5
        Do
            Delay 1
            c = strBuffer
            strBuffer = ""
            If c = "" Then Exit Do
            b = strInput & c
        Loop
        strPart = b
        strInput = strInput & strPart
        If InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0 Then Exit For
        If strPart = "" Then
            Delay 1
        End If
    Next
    WaitForSuccess = InStr(1, strInput, vbCrLf & "OK" & vbCrLf) > 0
End Function

Private Sub Delay(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikian mengenai cara mengirim SMS menggunakan modem wavecom melalui aplikasi VB6 yang ditambahkan fitur verifikasi, semoga bermanfaat.

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

VB6 SMS Gateway: AT Command Tester Sederhana

Option Explicit 

Dim strBuffer As String 

Private Sub cmdSend_Click()
    txtResult.Text = ""
    txtProcess.Text = ""
    strBuffer = ""
    If UCase$(Left$(txtATCommand.Text, 2)) <> "AT" Then
        MSComm1.Output = txtATCommand.Text & Chr(26)
    Else
        MSComm1.Output = txtATCommand.Text & vbCrLf
    End If
End Sub

Private Sub Form_Load()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .CommPort = 7
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
    End Select
    txtProcess.Text = strBuffer
    txtProcess.SelStart = Len(txtProcess.Text)
    Do
        strBuffer = strBuffer & MSComm1.Input
    Loop While MSComm1.InBufferCount
    If InStr(1, strBuffer, "OK") > 0 Then
        txtResult.Text = strBuffer
        txtResult.SelStart = Len(txtResult.Text)
    ElseIf InStr(1, strBuffer, "ERROR") Then
        txtResult.Text = strBuffer
        strBuffer = ""
    End If
End Sub

Source : http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

Mengirim SMS Menggunakan Modem Wavecom - VB6 Code

Mengenai cara mengirim SMS menggunakan aplikasi yang dibuat dengan VB6 menggunakan modem GSM Wavecom - Adapun cara mengirim SMS menggunakan aplikasi VB6 secara sederhana kodenya adalah sebagai berikut:

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    With MSComm1
        .CommPort = 7 'Port disesuaikan terhadap modem Wavecom yang terdeteksi
        .Settings = "115200,n,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
    MSComm1.Output = "AT+CMGS=" & Chr(34) & TxtNumber.Text & Chr(34) & vbCrLf
    Sleep 1000
    MSComm1.Output = TxtMessage.Text & Chr(26)
End Sub

Caranya:

1. Buatlah 2 TextBox masing-masing diberi nama TxtNumber dan TxtMessage
2. Tambahkan OCX Microsoft Comm Control 6.0 (MSComm)
3. Tambahkan satu CommandButton dengan nama default. 

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

VB6 SMS Gateway: Menerima dan Menampilkan SMS Baru

Mengenai cara menerima dan menampilkan SMS yang masuk menggunakan AT Command melalui aplikasi VB6 - Setelah kita dapat mengirim SMS melalui AT Command dengan menggunakan kode VB6 yang ini dan yang yang ini, membicarakan fungsi sleep dalam posting yang ini yang ini dan yang ini (Hai, terlalu banyak kata "yang ini"!), dan contoh kode untuk mendeteksi modem yang ada disana, dan mengirim kode ussd melalui AT Command yang ada disana. Sekarang tiba saatnya untuk membicarakan cara menerima SMS disini.

Maka tanpa kata berpanjang lebar menunggu cacing berbulu, di bawah ini adalah kode VB6 yang mewakili tindakan dengan judul di atas:

Option Explicit

Dim strBuffer As String

Private Sub Form_Load()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    With MSComm1
        .CommPort = 3
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
            Do
                strBuffer = strBuffer & MSComm1.Input
            Loop While MSComm1.InBufferCount
            If InStr(1, strBuffer, "+CMTI") > 0 Then
                If Right(strBuffer, 1) = vbLf Then
                    Text1.Text = strBuffer
                End If
            End If
    End Select
End Sub

Sampai dengan kode di atas, apabila ada SMS baru, maka modem akan memberitahukan kepada kita dengan diawali "+CMTI" misalnya: +CMTI: "SM",11. SM artinya memory yang digunakan adalah SIM card, sedangkan angka 11 mewakili indeks dari SMS tersebut, jadi apabila kita ingin mengakses/membaca SMS tersebut harus menggunakan 11 sebagai indeksnya. Gantilah kode yang terdapat dalam event MSComm1_OnComm() diatas dengan kode dibawah ini, apabila Anda berkeinginan membaca isi SMS baru tersebut.

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
            Do
                strBuffer = strBuffer & MSComm1.Input
            Loop While MSComm1.InBufferCount
            If InStr(1, strBuffer, "OK") > 0 Then
                Text1.Text = strBuffer
                Dim d() As String
                d = Split(strBuffer, vbCrLf)
                strBuffer = ""
            End If
            If InStr(1, strBuffer, "+CMTI") > 0 Then
                Do
                    strBuffer = strBuffer & MSComm1.Input
                Loop While MSComm1.InBufferCount
                If Right(strBuffer, 1) = vbLf Then
                    Text1.Text = strBuffer
                    Dim s() As String
                    s = Split(strBuffer, ",")
                    ReadSMSByIndex Trim$(s(UBound(s)))
                End If
            End If
    End Select
End Sub

Private Sub ReadSMSByIndex(Index As Integer)
    strBuffer = ""
    MSComm1.Output = "AT+CMGR=" & Index & vbCrLf 'baca SMS yang berada di index ke-1
End Sub

Setelah kita modifikasi, maka akan menghasilkan:

+CMGR: "REC UNREAD","+6281315673456",,"12/06/26,01:43:51+28"
Test SMS. Test SMS.

OK

Lakukan parse (urai, pisah, memilih dan memilah) jika Anda terganggu dan tidak nyaman dengan perolehan response data yang selalu diawali dengan "+CMGR: "REC UNREAD" kemudian koma dan diakhiri dengan kata "OK". Terutama jika Anda bermaksud memasukan data tersebut ke dalam objek ListView atau MSHFlexgrid, dan lain-lain, demikian pula jika bermaksud menghubungkannya dengan database Access, SQLite, MySQL, atau database apa saja tergantung selera Anda, tidak ada paksaan dalam hal ini.

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

Fungsi Wait Sleep Tanpa Windows API - VB6 Code

Mengenai fungsi wait atau sleep tanpa menggunakan fungsi API - Melanjutkan posting sebelumnya klik disini, sekarang kita akan membuat fungsi sleep atau wait tanpa bantuan API hanya menggunakan kode VB6 murni. Perbedaan fungsi sleep kali ini dengan fungsi sleep sebelumnya adalah:
Fungsi sleep menggunakan Sleep Kernel32.dll:

• Mem-freeze GUI (membekukan tampilan)
• Hitungan dalam millisecond

Fungsi sleep kali ini (lebih tepatnya delay time):

• Tidak mem-freeze GUI
• Hitungan dalam second

Adapun fungsi sleep atau wait tanpa fungsi API adalah sebagai berikut:

Private Sub Sleep(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Jika Anda mau bereksperimen maka buatlah kodenya seperti di bawah ini kemudian bandingkan antara fungsi sleep Kernel32.dll dengan fungsi sleep tanpa API.

Option Explicit

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    Label1.Caption = "Mulai menjalankan fungsi sleep atau wait"
    Label1.Refresh
    Sleep 5 'sleep/wait/hentikan eksekusi kode ke baris berikutnya selama 5 detik
    Label1.Caption = "Terhenti selama 5 detik"
End Sub

Private Sub Command2_Click()
    Dim frm As New Form1
    frm.Show
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    Caption = i
    i = i + 1
End Sub

Private Sub Sleep(ByVal HowLong As Date)
    Dim endDate As Date
    endDate = DateAdd("s", HowLong, Now)
    While endDate > Now
        DoEvents
    Wend
End Sub

Demikianlah seputar fungsi sleep atau wait, menggunakan API dan tanpa menggunakan API.

Option Explicit

Private Function Sleep(mSecs As Long) As Double
    Dim Duration!
    Duration! = Timer + mSecs
    Do Until Timer > Duration!
        DoEvents
    Loop
End Function

Private Sub Command1_Click()
    Sleep 0.9
    MsgBox "Test"
End Sub

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

VB6 Code - Fungsi Sleep Atau Wait Yang Diperbaiki

Mengenai fungsi sleep atau wait dalam VB6 yang telah diperbaiki - Fungsi sleep disini berbeda dengan fungsi sleep sebelumnya yang menggunakaan salah satu API kernel32 klik disini atau tanpa API klik disini. Keunggulan dari fungsi sleep kali ini adalah:

• Tidak memfreeze GUI (jadi jika ada objek visual, maka ia akan terefresh dengan baik)
• Hitungan dalam millisecond.

Adapun fungsi sleep yang telah diperbaiki dengan menggunakan VB6 adalah sebagai berikut:

Option Explicit

Private mCancel As Boolean

Type MSG
   hwnd As Long
   message As Long
   wParam As Long
   lParam As Long
   time As Long
   ptX As Long
   ptY As Long
End Type

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Sub TimerProc()
    mCancel = True
End Sub

Public Sub Wait(frm As Form, mSecs As Long)
    Dim MyMsg As MSG
    Dim TimerID As Long
    
    TimerID = SetTimer(frm.hwnd, ObjPtr(frm), mSecs, AddressOf TimerProc)
    mCancel = False

    Do While Not mCancel
        GetMessage MyMsg, 0, 0, 0
        TranslateMessage MyMsg
        DispatchMessage MyMsg
    Loop

    KillTimer frm.hwnd, TimerID
End Sub

Demikian fungsi sleep dalam VB6 dengan menggunakan timer API. Semoga bermanfaat.

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

VB6 SMS Gateway: Mendeteksi Port Modem Secara Otomatis

Mengenai cara mendeteksi port modem secara otomatis menggunakan VB6 - Pada project sebelumnya klik disini dan disini. Kita telah berhasil mengirimkan SMS menggunakan modem GSM secara sederhana. Akan tetapi karena sederhana kedua project tersebut tidak diperlengkapi dengan deteksi port modem secara otomatis, sehingga untuk mengetahui port modem Anda lakukan langkah di bawah ini:

1. Klik tombol start (sebelah kiri bawah)
2. Selanjutnya klik Settings >> Control Panel >> System
3. Klik tab Hardware Klik tombol Device Manager
4. Klik Node Ports (COM & LPT)
5. Carilah di sana akan ada port modem Wavecom Anda.

Sungguh merepotkan sekali, setiap kali port modemnya berubah kita harus selalu mengulangi dan mengulangi langkah-langkah di atas. Mulai saat ini, tinggalkan cara di atas, dan beralihlah pada deteksi port modem secara otomatis. Adapun kode untuk mendeteksi port modem secara otomatis menggunakan VB6 adalah sebagai berikut:

Option Explicit

Dim strBuffer As String
Dim intPortNumber As String

Private Sub Command2_Click()
    On Error Resume Next
    Dim i As Integer
    For i = 1 To 20
    If MSComm1.PortOpen Then MSComm1.PortOpen = False
        intPortNumber = i
        MSComm1.CommPort = i
        MSComm1.PortOpen = True
        MSComm1.Output = "AT" & vbCrLf
        Wait Me, 50
    Next
End Sub

Private Sub Form_Load()
    With MSComm1
        .Settings = "115200,n,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    End
End Sub

Private Sub MSComm1_OnComm()
    Select Case MSComm1.CommEvent
        Case comEvReceive
            strBuffer = strBuffer & MSComm1.Input
    End Select
    Do
        strBuffer = strBuffer & MSComm1.Input
    Loop While MSComm1.InBufferCount
    If InStr(1, strBuffer, "OK") > 0 Then
        Caption = "COM" & intPortNumber
        Text1.Text = intPortNumber
    End If
End Sub

Demikian cara mendeteksi port modem secara otomatis menggunakan VB6, jika modemnya lebih dari 1, misalnya 2, 3, 8, 15 sampai tak terhingga, Anda hanya perlu sedikit memodifikasi kodenya. Semoga bermanfaat.

Source :  http://vb6-sourcecode-insert.blogspot.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

VB6 SMS Gateway: Contoh Mengirim Kode USSD

Mengenai cara mengirim kode USSD dari aplikasi yang dibuat menggunakan bahasa pemrograman VB6 - USSD merupakan singkatan dari Unstructured Supplementary Service Data. USSD biasanya diawali dengan tanda bintang (*) dan diakhiri dengan tanda pagar (#). Contoh USSD:

• *888#
• *101#
• *109*72348937857623#

Dibawah ini merupakan contoh mengirim kode USSD, yang digunakan untuk mengecek pulsa Simpati:

Option Explicit

Dim strBuffer As String

Private Sub Command1_Click()
    Text1.Text = ""
    strBuffer = ""
    If MSComm1.PortOpen = True Then MSComm1.PbortOpen = False
    With MSComm1
        .CommPort = 3
        .Settings = "115200,N,8,1"
        .Handshaking = comRTS
        .RTSEnable = True
        .DTREnable = True
        .RThreshold = 1
        .SThreshold = 1
        .InputMode = comInputModeText
        .InputLen = 0
        .PortOpen = True
        .Output = "AT+CUSD=1," & Chr(34) & "*888#" & Chr(34) & ",15" & vbCrLf
    End With
End Sub

Private Sub MSComm1_OnComm()
    strBuffer = strBuffer & MSComm1.Input
    Dim x As String
    If InStr(1, strBuffer, ",15") Then
        Dim s() As String
        s = Split(strBuffer, vbCrLf)
        Dim i As Integer
        For i = 0 To UBound(s)
            If InStr(1, s(i), "+CUSD") Then
                x = s(i)
            End If
        Next
    End If
    If x <> "" Then
       s = Split(x, ",")
       Text1.Text = Mid$(s(1), 2, Len(s(1)) - 2)
    End If
End Sub

Maka hasilnya adalah seperti gambar di bawah ini:

Contoh USSD Cek pulsa Simpati  

 

 

 

 

 

 

 

 

 

 

 

 

 

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.

Membuat sms gateway itu gampang, jangan dipersulit !!!

Apa yang harus di persiapkan, pertama kita rancang dulu databasenya dan berhubung artikel saya yang membahas tentang database SQLite masih hangat jadi untuk databasenya kita menggunakan SQLite saja.

SQLite adalah database standalone yang kecil, mungil dan gratis. Bagaimana cara membuat database di SQLite sudah saya bahas disini kemudian bagaimana mengaksesnya dari aplikasi juga sudah saya bahasa disini.
Berikut adalah rancangan sederhana database sms yang akan kita buat :

Ada banyak cara untuk membaca sms masuk dan membalasanya, salah satunya adalah menggunakan perintah AT COMMAND dan Microsoft sendiri sudah menyediakan komponen yang bisa mengeksekusi perintah-perintah tersebut.
Tentunya cara ini (menggunakan AT COMMAND) bukan cara yang favorit dikalangan programmer instan seperti Anda dan Saya , jadi diartikel ini saya menggunakan komponen pihak ketiga.

Ingat komponen ini adalah shareware, segala resiko (kemudahan dalam membuat aplikasi sms gateway) ditanggung sendiri , saya disini hanya share dan tidak terikat kerja sama dengan pihak ketiga tersebut.

Halah pernyataan ngawur
Berikut adalah cuplikan source code untuk membaca dan mengirim sms menggunakan komponen ActiveXpert SMS
1. Membaca SMS Masuk

01	Private Sub cmdBacaSMS_Click()

02	Dim objGsmIn        As ASmsCtrl.GsmIn

03

04	Set objGsmIn = New ASmsCtrl.GsmIn

05	With objGsmIn

06	.Activate "XXX-XXXX-XXXX-XXXXX"  'diisi serial number yg Anda dapatkan secara ilegal

07	.Device = "COM1" 'disesuaikan dengan port COM yang digunakan

08	.DeviceSpeed = 19200 'default = 0

09

10	.Storage = 2 '0=sim 1=device 2=any

11	.DeleteAfterReceive = True

12

.Receive

13

14	If .LastError = 0 Or .LastError = 23140 Then ' Success

15	.GetFirstMessage

16

17	While .LastError = 0

18	Debug.Print "Pengirim : " & .MessageSender

19	Debug.Print "Isi SMS : " & .MessageData

20

21	'TODO : INSERT KE TABEL SMS_IN

22

23	.GetNextMessage

24

Wend

25

End If

26

End With

27	Set objGsmIn = Nothing

28

End Sub

2. Mengirim sms

01	Private Sub cmdKirimSMS_Click()

02	Dim objGsmOut       As ASmsCtrl.GsmOut

03	Dim objConstants    As ASmsCtrl.Constants

04

05	Set objGsmOut = New ASmsCtrl.GsmOut

06	Set objConstants = New ASmsCtrl.Constants

07

08	With objGsmOut

09	.Activate "XXX-XXXX-XXXX-XXXXX"  'diisi serial number yg Anda dapatkan secara ilegal

10	.Device = "COM1" 'disesuaikan dengan port COM yang digunakan

11	.DeviceSpeed = 19200 'default = 0

12	.RequestStatusReport = False

13

14	.MessageType = objConstants.asMESSAGETYPE_TEXT 'mengirim pesan maksimal 160 karakter

15	'.MessageType = objConstants.asMESSAGETYPE_TEXT_MULTIPART 'jika lebih dari 160 karakter gunakan opsi ini

16

17	.MessageRecipient = "nomor tujuan" 'biasanya menggunakan prefix +62

18	.MessageData = "isi pesan"

19	.Send 'kirim

20

End With

21

22	Set objConstants = Nothing

23	Set objGsmOut = Nothing

24

End Sub

Jadi cukup dengan bermodalkan 2 cuplikan kode diatas kita akan menyelesaikan aplikasi yg dibahas pada artikel kali ini.
Adapun untuk keyword yang akan digunakan sebagai berikut :
1. Request nilai tugas
keyword : tgs#nis
contoh :
tgs#9941224165
balasan :
Nilai tugas (NAMA SISWA) : BI=95, IPA=75, IPS=80, MTK=85
2. Request nilai ulangan harian
keyword : uh#nis
contoh :
uh#9941224165
balasan :
Nilai ulangan (NAMA SISWA) : BI=95, IPA=75, IPS=80, MTK=85
Berikut penjelasan ringkas beberapa cuplikan source code yang digunakan dalam pembuatan aplikasi sms gateway ini.

01	Private Function connectToDevice(ByVal device As String) As Boolean

02	Dim objGsm      As ASmsCtrl.GsmOut

03	Dim manufaktur  As String

04

05	On Error GoTo errHandle

06

07	Set objGsm = New ASmsCtrl.GsmOut

08	With objGsm

09	.Activate SERIAL_NUMBER

10	.device = device

11

12	manufaktur = .SendCommand("AT+CGMI", 500)  'menampilkan informasi manufactur

13	manufaktur = Replace$(manufaktur, vbCrLf, "")

14	manufaktur = Replace$(manufaktur, "OK", "")

15	manufaktur = Replace$(manufaktur, "ERROR", "")

16	manufaktur = Replace$(manufaktur, "AT+CGMI", "")

17

End With

18	Set objGsm = Nothing

19

20	If Len(manufaktur) > 0 Then

21	txtModem.Text = manufaktur

22	connectToDevice = True

23

End If

24

25	Exit Function

26	errHandle:

27	connectToDevice = False

28	End Function

Sesuai namanya fungsi connectToDevice digunakan untuk mengecek status modem sms yang terpasang, salah satu caranya adalah dengan mengirimkan AT COMMAND “AT+CGM”, AT COMMAND ini berfungsi untuk mendapatkan informasi manufaktur.
Sebagai contoh jika modem sms yg digunakan adalah hp siemens maka nilai yg dihasilkan dari perintah ini adalah “SIEMENS” dan tentunya hp yg bersangkutan juga harus mendukung AT COMMAND.

01	Private Sub readSMS()

02	Dim objGsmIn        As ASmsCtrl.GsmIn

03	Dim objConstants    As ASmsCtrl.Constants

04	Dim cmd             As cCommand

05

06	Dim keyword         As String

07	Dim phoneNumber     As String

08	Dim i               As Integer

09

10	On Error GoTo errHandle

11

12	Screen.MousePointer = vbHourglass

13	cmdStop.Enabled = False

14	tmrReceiveSms.Enabled = False

15

16

DoEvents

17

18	Set objGsmIn = New ASmsCtrl.GsmIn

19	Set objConstants = New ASmsCtrl.Constants

20

21	With objGsmIn

22	.Activate SERIAL_NUMBER

23	.device = cmbPORT.Text

24	.DeviceSpeed = 0

25

26	.Storage = cmbStorage.ItemData(cmbStorage.ListIndex)

27	.DeleteAfterReceive = True 'hapus sms jika sudah dibaca

28

.Receive

29

30	If .LastError = 0 Or .LastError = 23140 Then 'baca sms sukses

31	.GetFirstMessage

32

33	strSql = "INSERT INTO sms_in (phone_number, sms_keyword, date_in, time_in) VALUES (?, ?, ?, ?)"

34	Set cmd = conn.CreateCommand(strSql)

35	conn.BeginTrans

36

37

i = 1

38	While .LastError = 0

39	phoneNumber = rep0to62(.MessageSender)

40	keyword = .MessageData

41

42	cmd.SetText 1, phoneNumber

43	cmd.SetText 2, keyword

44	cmd.SetDate 3, Format(Now, "yyyy/MM/dd")

45	cmd.SetTime 4, Format(Now, "hh:mm:ss")

46

47	cmd.Execute

48

49	If i Mod 10 = 0 Then

50	conn.CommitTrans

51

DoEvents

52

53	conn.BeginTrans

54

End If

55

56

i = i + 1

57

58	.GetNextMessage

59

Wend

60

61	conn.CommitTrans

62	Set cmd = Nothing

63

64

End If

65

End With

66	Set objGsmIn = Nothing

67

68	If cekSMSIn Then

69	Call sendSMS

70

Else

71	Call Wait(5000)

72

End If

73

74	cmdStop.Enabled = True

75	Screen.MousePointer = vbDefault

76

77	tmrReceiveSms.Enabled = True

78

79

Exit Sub

80	errHandle:

81	tmrReceiveSms.Enabled = True

82

End Sub

Prosedur readSMS digunakan untuk membaca sms masuk dan menyimpannya ke tabel sms_in, berhubung komponen ActiveXpert SMS tidak mempunyai event yg menandai adanya sms masuk maka sebagai gantinya kita menggunakan timer untuk memanggil prosedur readSMS.
Salah satu properties penting yang dimiliki oleh ActiveXpert SMS adalah DeleteAfterReceive, jika nilainya diset true maka sms yg masuk akan otomatis dihapus dan tentunya setelah smsnya dibaca.

1	Private Function cekSMSIn() As Boolean

2	Dim ret As Integer

3

4	strSql = "SELECT COUNT(*) FROM sms_in WHERE status = 0" 'jika status = 0 berarti sms masuk belum di proses

5	ret = CInt(dbGetValue(strSql, 0))

6	If ret > 0 Then 'ada sms yg belum diproses

7	cekSMSIn = True

8

End If

9	End Function

Prosedur cekSMSIn dibutuhkan oleh prosedur readSMS, jadi dengan adanya prosedur cekSMSIn ini program akan mengetahui kapan waktu yg tepat untuk memanggil prosedur sendSMS.

01	Private Sub sendSMS()

02	Dim rsSend          As cRecordset

03	Dim cmd             As cCommand

04

05	Dim objGsmOut       As ASmsCtrl.GsmOut

06	Dim objConstants    As ASmsCtrl.Constants

07

08	Dim phoneNumber     As String

09	Dim keyword         As String

10	Dim smsBalasan      As String

11

12	On Error GoTo errHandle

13

14	'cek sms yang belum di proses, ditandai dg status = 0

15	strSql = "SELECT id, phone_number, sms_keyword " & _

16	"FROM sms_in " & _

17	"WHERE status = 0 " & _

18	"ORDER BY id"

19	Set rsSend = conn.OpenRecordset(strSql)

20	If Not rsSend.EOF Then

21	Set objGsmOut = New ASmsCtrl.GsmOut

22	Set objConstants = New ASmsCtrl.Constants

23

24	objGsmOut.Activate SERIAL_NUMBER

25	objGsmOut.device = cmbPORT.Text

26	objGsmOut.DeviceSpeed = 0

27	objGsmOut.RequestStatusReport = False

28	objGsmOut.MessageType = objConstants.asMESSAGETYPE_TEXT_MULTIPART

29

30	Do While Not rsSend.EOF

31	'ganti prefix nomor hp 0 -> +62

32	phoneNumber = rep0to62("" & rsSend("phone_number").Value)

33	keyword = rsSend("sms_keyword").Value

34

35	smsBalasan = getBalasanSms(keyword, phoneNumber)

36

37	objGsmOut.MessageRecipient = phoneNumber

38	objGsmOut.MessageData = smsBalasan

39	objGsmOut.Send

40

41	If objGsmOut.LastError = 0 Or objGsmOut.LastError = 23140 Then 'sms sukses dikirim

42	'update status sms -> 1

43	strSql = "UPDATE sms_in SET status = ?, no_ref = ? " & _

44	"WHERE id = ?"

45	Set cmd = conn.CreateCommand(strSql)

46

With cmd

47	.SetInt32 1, 1

48	.SetInt32 2, objGsmOut.MessageReference

49	.SetInt32 3, rsSend("id").Value

50

51

.Execute

52

End With

53	Set cmd = Nothing

54

55	'insert ke tabel sms_out, untuk histori sms keluar

56	strSql = "INSERT INTO sms_out (phone_number, replay_msg, date_out, time_out) VALUES (?, ?, ?, ?)"

57	Set cmd = conn.CreateCommand(strSql)

58

With cmd

59	.SetText 1, phoneNumber

60	.SetText 2, smsBalasan

61	.SetDate 3, Format(Now, "yyyy/MM/dd")

62	.SetTime 4, Format(Now, "hh:mm:ss")

63

64

.Execute

65

End With

66	Set cmd = Nothing

67

68	Else 'sms gagal dikirim

69	'update status sms -> 1

70

71	'ini masih bisa dikembangkan lagi dengan menambah kolom max_jumlah_kirim di tabel sms_in

72	'jadi bisa diberi aturan sms yg gagal dikirim > 3x baru status smsnya diupdate menjadi 1

73	strSql = "UPDATE sms_in SET status = ?, no_ref = ? " & _

74	"WHERE id = ?"

75	Set cmd = conn.CreateCommand(strSql)

76

With cmd

77	.SetInt32 1, 1

78	.SetInt32 2, objGsmOut.MessageReference

79	.SetInt32 3, rsSend("id").Value

80

81

.Execute

82

End With

83	Set cmd = Nothing

84

End If

85

86	Call Wait(5000)

87

88	rsSend.MoveNext

89

Loop

90	Set objConstants = Nothing

91	Set objGsmOut = Nothing

92

End If

93

94

Exit Sub

95	errHandle:

96	Resume Next

97

End Sub

Prosedur sendSMS akan mengolah sms masuk yg belum di proses (ditandai dengan status = 0), mengupdate statusnya menjadi 1 jika berhasil mengirimkan sms, kemudian menyimpannya ke tabel sms_out sebagai histori pengiriman sms.

1	Public Function rep0to62(ByVal phoneNumber As String) As String

2	'fungsi untuk mengganti prefix 0 -> +62

3

4	rep0to62 = phoneNumber

5	If Left(phoneNumber, 1) = "0" Then rep0to62 = "+62" & Right(phoneNumber, Len(phoneNumber) - 1)

6	End Function

Sesuai namanya fungsi ini berguna untuk mengganti prefix nomor hp 0 menjadi +62 (kode indonesia).
Terakhir fungsi untuk memproses keyword sms yang masuk dan sekaligus sebagai balasan untuk sms keluar.

001	Public Function getBalasanSms(ByVal keywordSms As String, ByVal phoneNumber As String) As String

002	Dim rs              As cRecordset

003	Dim param1          As String

004	Dim arrKeyword()    As String

005

006	Dim prefix          As String

007	Dim nilai           As String

008	Dim nama            As String

009

010	Dim tha             As String

011	Dim semester        As String

012

013	If Len(keywordSms) > 0 Then

014	If InStr(1, keywordSms, "#") > 0 Then 'karakter # -> separator keyword

015	arrKeyword = Split(keywordSms, "#")

016	If Not (Len(arrKeyword(0)) > 0) Then

017	getBalasanSms = "Keyword sms salah"

018	Exit Function

019

020

Else

021	'do nothing

022

End If

023

024

Else

025	ReDim arrKeyword(0)

026	arrKeyword(0) = keywordSms

027

End If

028

029

Else

030	getBalasanSms = "Keyword sms salah"

031	Exit Function

032

End If

033

034	prefix = arrKeyword(0)

035	prefix = UCase$(prefix)

036

037	If UBound(arrKeyword) > 0 Then param1 = arrKeyword(1) 'untuk contoh disini param1 bernilai nomor induk siswa

038

039	'untuk pengembangan lebih lanjut tahun ajaran dan semester dibuat settingan tersendiri

040	tha = "2009/2010"

041	semester = 2

042

043	Select Case prefix

044	Case "TGS"

045	'validasi nis siswa

046	If Not isValidNIS(param1) Then getBalasanSms = Replace(NIS_SALAH, "<nis>", param1): Exit Function

047

048	'validasi no hp siswa

049	'nama sekolah sebaiknya disimpan didalam variabel

050	If Not isValidHPSiswa(param1, phoneNumber) Then

051	getBalasanSms = Replace(HP_UNREG, "<nama_sekolah>", "SMA Negeri Yogyakarta")

052	getBalasanSms = Replace(getBalasanSms, "<no_hp>", phoneNumber): Exit Function

053

End If

054

055	strSql = "SELECT UPPER(nama) FROM siswa WHERE nis = '" & param1 & "'"

056	nama = CStr(dbGetValue(strSql, ""))

057

058	'mulai proses pencarian nilai

059	strSql = "SELECT matapelajaran_kode, nilai " & _

060	"FROM nilai_tugas " & _

061	"WHERE siswa_nis = '" & param1 & "' AND tahun_ajaran = '" & tha & "' AND semester = " & semester & " " & _

062	"ORDER BY matapelajaran_kode"

063	Set rs = conn.OpenRecordset(strSql)

064	If Not rs.EOF Then

065	Do While Not rs.EOF

066	nilai = nilai & rs("matapelajaran_kode").Value & "=" & rs("nilai").Value & ", "

067	rs.MoveNext

068

Loop

069

End If

070

071	If Len(nilai) > 0 Then

072	nilai = Left(nilai, Len(nilai) - 2)

073	getBalasanSms = "Nilai tugas (" & nama & ") : " & nilai

074

075

Else

076	getBalasanSms = "Nilai tugas (" & nama & ") sedang dalam proses pendataan"

077

End If

078

079

Case "UH"

080	'validasi nis siswa

081	If Not isValidNIS(param1) Then getBalasanSms = Replace(NIS_SALAH, "<nis>", param1): Exit Function

082

083	'validasi no hp siswa

084	'nama sekolah sebaiknya disimpan didalam variabel

085	If Not isValidHPSiswa(param1, phoneNumber) Then

086	getBalasanSms = Replace(HP_UNREG, "<nama_sekolah>", "SMA Negeri Yogyakarta")

087	getBalasanSms = Replace(getBalasanSms, "<no_hp>", phoneNumber): Exit Function

088

End If

089

090	strSql = "SELECT UPPER(nama) FROM siswa WHERE nis = '" & param1 & "'"

091	nama = CStr(dbGetValue(strSql, ""))

092

093	'mulai proses pencarian nilai

094	strSql = "SELECT matapelajaran_kode, nilai " & _

095	"FROM nilai_ulangan " & _

096	"WHERE siswa_nis = '" & param1 & "' AND tahun_ajaran = '" & tha & "' AND semester = " & semester & " " & _

097	"ORDER BY matapelajaran_kode"

098	Set rs = conn.OpenRecordset(strSql)

099	If Not rs.EOF Then

100	Do While Not rs.EOF

101	nilai = nilai & rs("matapelajaran_kode").Value & "=" & rs("nilai").Value & ", "

102	rs.MoveNext

103

Loop

104

End If

105

106	If Len(nilai) > 0 Then

107	nilai = Left(nilai, Len(nilai) - 2)

108	getBalasanSms = "Nilai ulangan (" & nama & ") : " & nilai

109

110

Else

111	getBalasanSms = "Nilai ulangan (" & nama & ") sedang dalam proses pendataan"

112

End If

113

114

Case Else

115	getBalasanSms = "Keyword sms salah"

116	End Select

117	End Function

Untuk mengetahui daftar hp/modem apa saja yang didukung, jangan sungkan dan malu-malu untuk mengklik link ini.

Source : http://coding4ever.wordpress.com/

HOT INFO

Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Source Code SMS Gateway di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.