c0d3

Public objConstants As AXmsCtrl.SmsConstants
Public objMessage As AXmsCtrl.SmsMessage
Public objGsm As AXmsCtrl.SmsProtocolGsm
Public objStatus As AXmsCtrl.SmsDeliveryStatus
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260
Dim ShowReference As Boolean
Dim DB As ADODB.Connection
Dim RS As ADODB.Recordset

Sub Kirim()
'==================
'kirim=============
'============================================================
Dim MessageType As Long
Dim strReference As String
Textresult.Text = "Sending message, Please wait..."
Textresult.Refresh
' Set Device
objGsm.Device = ComboDevice.Text
' Set LogFile
objGsm.LogFile = TextLogfile.Text
' Set Speed
If comboSpeed.ListIndex = 0 Then
objGsm.DeviceSpeed = 0 ' use default speed
Else
objGsm.DeviceSpeed = comboSpeed.List(comboSpeed.ListIndex)
End If
' Create Message Object
Set objMessage = CreateObject("ActiveXperts.SmsMessage")

' Set Message Format
objMessage.Format = objConstants.asMESSAGEFORMAT_TEXT
objMessage.Format = objConstants.asMESSAGEFORMAT_TEXT_MULTIPART
' Set recipient
objMessage.Recipient = TextRecipient.Text
' Set Message parameters
objMessage.Data = TextMessage.Text
' Send the message
strReference = objGsm.Send(objMessage)
Text2.Text = "OK"
End Sub

Private Sub buttonReceive_Click()
Kirim
End Sub

Private Sub Form_Load()
Text1.Text = Format(Date, "dd,mmmm,yyyy")
Dim lDeviceCount As Long
Dim i As Long
Set DB = New ADODB.Connection
Set RS = New ADODB.Recordset
DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\database.mdb" & ";Persist Security Info=False"
DB.Open "", , ""
a = "select * from tbl_monitor"
RS.Open a, DB, adOpenDynamic, adLockOptimistic, adCmdText
RS.Requery
TextLogfile.Text = App.Path & "\" & "log.txt"
ShowReference = False
Set objGsm = CreateObject("ActiveXperts.SmsProtocolGsm")
Set objConstants = CreateObject("ActiveXperts.SmsConstants")
lDeviceCount = objGsm.GetDeviceCount() ' Get number of devices
For i = 0 To lDeviceCount - 1
ComboDevice.AddItem (objGsm.GetDevice(i)) ' Add devices to list box
Next
ComboDevice.ListIndex = 0
cbinbox.AddItem ("All messages")
cbinbox.AddItem ("SM - SIM Memory")
cbinbox.AddItem ("ME - Device Memory")
cbinbox.AddItem ("MT - SIM & Device Memory")
cbinbox.ListIndex = 0
comboSpeed.AddItem ("Default") ' Setup devicespeed combo
comboSpeed.AddItem ("1200")
comboSpeed.AddItem ("2400")
comboSpeed.AddItem ("9600")
comboSpeed.AddItem ("19200")
comboSpeed.AddItem ("38400")
comboSpeed.AddItem ("57600")
comboSpeed.AddItem ("115200")
comboSpeed.ListIndex = 0
End Sub
Public Function GetResult() As Long
Dim lResult As Long
lResult = objGsm.LastError
Textresult.Text = "ERROR " & lResult & " : " & objGsm.GetErrorDescription(lResult) ' Set Result
GetResult = lResult
End Function

Private Sub Timer1_Timer()
mulai
End Sub

Private Sub XPButton2_Click()
Shell "notepad " + TextLogfile.Text, vbNormalFocus
End Sub

Sub ambil()
For a = 1 To 10
Next a
End Sub

Sub pouse(angka)
Dim pos As Integer
Dim tim As Timer
wkt = Timer
Do
If Timer - wkt >= angka Then Exit Sub
pos% = DoEvents()
Loop
End Sub

Private Sub mulai()
Dim Wk, Pg, Dt, St As String
'On Error Resume Next
h = "select * from tbl_monitor"
Set RS = DB.Execute(h, , adCmdText)
If Not RS.EOF Then
Do While Not RS.EOF
Wk = RS!waktu
Pg = RS!pengirim
Dt = RS!Data
St = RS!tatus

If RS!tatus = "Blm dibalas" Then
If Mid(RS!Data, 1, 1) = "3" Then
krm = "Sudah dibalas"
Text7.Text = RS!waktu
Text8.Text = RS!pengirim
Text9.Text = RS!Data
Text10.Text = RS!tatus
TextRecipient.Text = RS!pengirim
TextMessage.Text = ""
TextMessage.Text = "Batas waktu expire 1 jam sebelum penerbangan"
pouse 0.05
Kirim
pouse 0.05
Set RS = DB.Execute("update tbl_monitor " & _
"set tatus ='" & krm & "'" & _
"where waktu='" & Wk & "'")

If RS!Data = "info" Or RS!Data = "Info" Or RS!Data = "INFO" Then
krm = "Sudah dibalas"
TextRecipient.Text = RS!pengirim
TextMessage.Text = ""
TextMessage.Text = "1.Jadwal penerbangan 2.Harga Tiket 3.Pemesanan tiket (ketikan point diikuti nama "
pouse 0.5
Kirim
pouse 0.5

Set RS = DB.Execute("update tbl_monitor " & _
"set tatus ='" & krm & "'" & _
"where waktu='" & Wk & "'")
Exit Do
End If

If RS!Data = "1" Then
krm = "Sudah dibalas"
TextRecipient.Text = RS!pengirim
TextMessage.Text = ""
TextMessage.Text = "Jayapura-Timika Jayapura-Wamena Jayapura-Sorong"
pouse 0.05
Kirim
pouse 0.05

Set RS = DB.Execute("update tbl_monitor " & _
"set tatus ='" & krm & "'" & _
"where waktu='" & Wk & "'")
Exit Do
End If

If RS!Data = "2" Then
krm = "Sudah dibalas"
TextRecipient.Text = RS!pengirim
TextMessage.Text = ""
TextMessage.Text = "Jayapura-Timika:100.000,350.000,500.000 Jayapura-Wamena:100.000,350.000,500.000 Jayapura-Sorong:200.000,450.000,600.000"
pouse 0.05
Kirim
pouse 0.05

Set RS = DB.Execute("update tbl_monitor " & _
"set tatus ='" & krm & "'" & _
"where waktu='" & Wk & "'")
Exit Do
End If
'kk = "Ok"
'xrt = "insert into tbl_pesan" & _
'"(waktu,pengirim,data,status)" & _
'" Values('" & Text7.Text & "','" & Text8.Text & "','" & Text9.Text & "','" & kk & "')"
'DB.Execute xrt, , adCmdText
'RS.Requery
'Adodc1.Refresh
Exit Do
End If

Else
End If

RS.MoveNext
If RS.EOF Then
Exit Do
End If
pouse 5
Loop
Else
End If
End Sub
'==================================================================

c0d3

Kamis, 10 Maret 2011

1 komentar: