Wednesday, December 7, 2011

Module Aplikasi SMS


Attribute VB_Name = "Module1"
Public kOnEkSi As New ADODB.Connection
Public rEk As New ADODB.Recordset
Public SmS As New Cls
Public pUlS As Boolean
Public sH As Boolean
Public bTr As Byte
Dim i As Integer


Public Sub cOnNeCt()
If kOnEkSi.State Then kOnEkSi.Close
kOnEkSi.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\data_sms.mdb"
End Sub

Public Sub bAtErAi()
Dim bAtt As Byte
bAtt = Val(SmS.cEk_bAtTeRy)
frm.S1.Visible = False
frm.S2.Visible = False
frm.S3.Visible = False
frm.S4.Visible = False
frm.S5.Visible = False
If bAtt >= 20 Then frm.S5.Visible = True
If bAtt >= 40 Then frm.S4.Visible = True
If bAtt >= 60 Then frm.S3.Visible = True
If bAtt >= 80 Then frm.S2.Visible = True
If bAtt = 100 Then frm.S1.Visible = True
End Sub

Public Sub bAcAsMs()
Dim peSanSMS As String
Dim iRv(3) As String
Dim q As Byte
frm.Label2.Caption = "Read . . . "

q = SmS.jUmLaH_sMs

If q <> 0 And q <> 50 Then
For i = 0 To q - 1
peSanSMS = SmS.iSi_sMs(i)
peSanSMS = Right(peSanSMS, Len(peSanSMS) - InStr(1, peSanSMS, "-"))
iRv(2) = Left(peSanSMS, InStr(1, peSanSMS, "-") - 1) 'nomor
peSanSMS = Right(peSanSMS, Len(peSanSMS) - InStr(1, peSanSMS, "-"))
iRv(0) = Left(peSanSMS, InStr(1, peSanSMS, "-") - 1) 'tanggal
peSanSMS = Right(peSanSMS, Len(peSanSMS) - InStr(1, peSanSMS, "-"))
iRv(1) = Left(peSanSMS, InStr(1, peSanSMS, "-") - 1) 'jam
peSanSMS = Right(peSanSMS, Len(peSanSMS) - InStr(1, peSanSMS, "-"))
iRv(3) = Left(peSanSMS, Len(peSanSMS)) 'pesan
frm.Label1.Caption = Val(frm.Label1.Caption) + 1
'irv(0)-tanggal # irv(2)-nomor # irv(3)-pesan
iRv(0) = Now
sImPan_sMs iRv(0), iRv(2), iRv(3)
bTr = bTr + 1
Next i
ElseIf q = 50 Then
frm.Label2.Caption = "Repeat . . . "
SmS.pAuSe (1)
uLaNgIbAcA
End If

SmS.pAuSe (0.5)
kIrImSmS
End Sub

Private Sub uLaNgIbAcA()
bAcAsMs
End Sub


Function sImPan_sMs(ByVal tGl As Date, ByVal nMr As String, ByVal fRmT As String)
Dim xc, q
fRmT = UCase(fRmT)
fRmT = LTrim(fRmT)
fRmT = RTrim(fRmT)
Set rEk = Nothing
rEk.Open "select * from acara", kOnEkSi, adOpenKeyset
B = False
For q = 0 To rEk.RecordCount - 1
xc = "TVRI" & " " & rEk.Fields(1).Value
If fRmT = xc Then
kOnEkSi.Execute "insert into INBOX (TANGGAL,PENGIRIM,PESAN,STATUS) values(#" & tGl & "#,'" & nMr & "','" & fRmT & "','1')"
kOnEkSi.Execute "insert into OUTBOX (TANGGAL,PENGIRIM,PESAN,STATUS,KIRIM) values(#" & tGl & "#,'" & nMr & "','" & frm.TxtPESAN & "','0','0')"
B = True
Exit For
Else
B = False
End If
rEk.MoveNext
Next
If B = False Then kOnEkSi.Execute "insert into OUTBOX (TANGGAL,PENGIRIM,PESAN,STATUS,KIRIM) values(#" & tGl & "#,'" & nMr & "','" & "Format Yang Dikirim Salah" & "','0','0')"
End Function



Public Sub kIrImSmS()
Dim kIrIm As Boolean
Dim x2 As Boolean
Set rEk = Nothing
If rEk.State Then rEk.Close

rEk.Open "select * from OUTBOX where STATUS=0 order by id", kOnEkSi
If rEk.BOF = True And rEk.EOF = True Then
rEk.Close
Else
frm.Label2.Caption = "Sending . . ."
kIrIm = SmS.kIrIm_SmS(frm.TxtPROVIDER.Text, rEk.Fields(2), rEk.Fields(3))
If kIrIm = True Then
frm.Label2.Caption = "Send . . ."
frm.Label3.Caption = Val(frm.Label3.Caption) + 1
frm.LblPULSA.Caption = Val(frm.LblPULSA.Caption) - 350
If Val(frm.LblPULSA.Caption) < 10000 And sH = False Then pUlS = True If Val(frm.LblPULSA.Caption) < 1000 Then pUlS = True kOnEkSi.Execute "update OUTBOX set STATUS=1 where id=" & rEk.Fields(0) & "" kOnEkSi.Execute "update OUTBOX set KIRIM=1 where id=" & rEk.Fields(0) & "" x2 = False ElseIf kIrIm = False Then If x2 = True Then kOnEkSi.Execute "update OUTBOX set STATUS=1 where id=" & rEk.Fields(0) & "" x2 = True End If rEk.Close End If End Sub

0 comments:

Post a Comment

sabar ya, komentar anda akan kami moderasi terlebih dahulu. laporkan kepada kami apabila ada post yang masih berbentuk kiri ke kanan. nuhun