ada seorang penghianat dari kantorq yang dulu
dari ga bisa apa2 sampai jadi seorang ahli diajarin oleh pemilik perusahaan
saat dia udah bisa di lari dari perusahaan tampa bicara sepatah kata pun
sekarang dengan kesombongannya dia sering pake orang pintar dalam perusahaan itu tampa sepengetahuan orang lain apakah pantas orang seperti itu disebut manusia,atau disebu anjiiiiiiiiiiiiiiiii((*&&&***))) kalian yang menilai q yang ketawaaa kekayaan bukan segalanya kepintaran bukan kehidupan
chat di ym dengan habisi virus
Monday, August 9, 2010
source code vb sms gateway Fbus
'==================================================================================
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim Red, Green, Blue As Integer
Dim Jam As String
Dim vButir As ListItem
Private Sub cmbSMS_Click()
'On Error GoTo Salah
If cmbSMS.Text <> "" Then
If FBus.Connected = True Then
If cmbSMS.Text = "Inbox" Then
DaftarInboxSMSHP
If LvInbox.ListItems.Count = 0 Then
MsgBox " Data Laporan SMS Masuk Kosong..", vbInformation
LvInbox.Enabled = False
Exit Sub
End If
Else
DaftarOutboxSMSHP
If LvInbox.ListItems.Count = 0 Then
MsgBox " Data Laporan SMS Keluar Kosong..", vbInformation
LvInbox.Enabled = False
Exit Sub
End If
End If
Else
MsgBox " Belum ada koneksi ke HP.." & vbCrLf & _
"Coba Periksa Kembali Koneksi HP..", vbInformation
PicKonfigurasi.Visible = True
End If
End If
End Sub
Private Sub cmdAlarm_Click()
Bar1.Panels(2).Text = "Tunggu...."
frmAlarm.Show vbModal, Me
Bar1.Panels(2).Text = "Alarm...."
End Sub
Private Sub cmdAuto_Click()
Me.MousePointer = 11
Bar1.Panels(2).Text = "Tunggu..."
frmAuto.Show vbModal, Me
Bar1.Panels(2).Text = "Auto Respo SMS"
Me.MousePointer = 1
End Sub
Private Sub cmdBatal_Click()
txtNomor.Text = "": txtNama.Text = ""
txtMessage.Text = ""
End Sub
Private Sub cmdConnect_Click()
tm_Koneksi.Enabled = True
fr_Koneksi.Enabled = False
End Sub
Private Sub cmdDisconnect_Click()
If FBus.Connected = True Then
Bar1.Panels(1).Text = "Status: Disable Connect to port/com..."
FBus.Disconnect
End If
For i = 1 To 10
cmbPort.AddItem "COM" & i
Next i
Lv1.ListItems.Clear
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Not Connect"
cmdDisconnect.Enabled = False
cmdRestart.Enabled = False
cmdConnect.Enabled = True
txtProvider.Text = "": txtNegara.Text = ""
txtKey.Text = "": txtSignal.Text = ""
txtBatterai.Text = "": fr_Koneksi.Enabled = True
txtTanggal.Text = ""
cmbPort.ListIndex = 0
'Bar1.Panels(3).Text = IIf(FBus.AlarmEnabled, "Alarm On", "Alarm Off")
End Sub
Private Sub cmdFind_Click()
Me.MousePointer = 11
Bar1.Panels(2).Text = "Proses Loading..."
frmBuku.Show vbModal, Me
Bar1.Panels(2).Text = "Buku Telp..."
Me.MousePointer = 1
End Sub
Private Sub cmdHapusSMS_Click()
On Error GoTo salah
If MsgBox(" Anda Yakin akan menghapus SMS ini..", vbInformation + vbYesNo) = vbYes Then
Kata = MsgBox("Anda Benar-benar yakin untuk menghapus SMS ini..", vbInformation + vbOKCancel, "Informasi ")
If Kata = vbOK Then
Me.MousePointer = 11
DataSMS.BeginTrans
DataSMS.Execute "Delete Form Terkirim where [No Telp]='" & txtNoHPTerkirim.Text & "' And [Tgl kirim]='" & txtTglTerkirim.Text & "'"
DataSMS.CommitTrans
DaftarTerkirim
Me.MousePointer = 1
MsgBox "SMS Terkirim sudah di hapus dari database...", vbInformation
txtNoHPTerkirim = "": txtTglTerkirim = ""
txtSMSTerkirim.Text = ""
Exit Sub
End If
End If
Exit Sub
salah:
MsgBox " Data SMS Terkirim tidak dapat di hapus...", vbInformation
End Sub
Private Sub cmdInbox_Click()
PicTerkirim.Visible = False
PicMasuk.Visible = True
PicPesan.Visible = False
PicKonfigurasi.Visible = False
LblStatus.Caption = "Laporan Pesan"
Bar1.Panels(2).Text = "Laporan Pesan"
End Sub
Private Sub cmdKirim_Click()
Dim a As Boolean
'On Error GoTo Salah
Me.MousePointer = 11
If FBus.Connected = True Then
If FBus.RfLevel > 0 Then
If txtNomor.Text <> "" And txtMessage.Text <> "" Then
a = FBus.SMS.SendMessage(txtNomor.Text, txtMessage.Text)
If a = True Then
Me.MousePointer = 1
MsgBox "Pesan telah terkirim ke No Tujuan: " & txtNomor.Text & " "
Set vButir = Lv2.ListItems.Add(, , Lv2.ListItems.Count + 1 & ".")
vButir.SubItems(1) = txtNomor.Text
vButir.SubItems(2) = txtNama.Text
vButir.SubItems(3) = txtMessage.Text
vButir.SubItems(4) = "Terkirim"
vButir.SubItems(5) = FBus.DateTime
cmdBatal.Enabled = True
cmdSimpan.Enabled = True
aSMS = True
cmdBatal_Click
Else
MsgBox " Pesan Tidak Terkirim ke No Tujuan : " & txtNomor.Text & ""
Set vButir = Lv2.ListItems.Add(, , Lv2.ListItems.Count + 1 & ".")
vButir.SubItems(1) = txtNomor.Text
vButir.SubItems(2) = txtNama.Text
vButir.SubItems(3) = txtMessage.Text
vButir.SubItems(4) = "tdk Terkirim"
vButir.SubItems(5) = FBus.DateTime
cmdSimpan.Enabled = True
cmdBatal_Click
aSMS = True
End If
Else
Me.MousePointer = 1
If txtNomor.Text = "" Then
MsgBox " Silahkan isi No Tujuan..", vbInformation
txtNomor.SetFocus
Exit Sub
ElseIf txtMessage.Text = "" Then
MsgBox "Pesan teks yang akan di kirim masih kosong...", vbInformation
txtMessage.SetFocus
Exit Sub
End If
End If
Else
Me.MousePointer = 1
MsgBox "No Tujuan: " & txtNomor.Text & " berada di luar jangkauan sistem..", vbInformation
End If
Else
Me.MousePointer = 1
MsgBox "Pesan tidak dapat di kirim, coba Perisa koneksi port/com...", vbCritical
End If
End Sub
Private Sub cmdKOnfigurasi_Click()
PicTerkirim.Visible = False
Bar1.Panels(2).Text = "Konfigurasi"
PicPesan.Visible = False
PicMasuk.Visible = False
LblStatus.Caption = "Konfigurasi"
PicKonfigurasi.Visible = True
End Sub
Private Sub cmdOutbox_Click()
PicMasuk.Visible = False
PicTerkirim.Visible = True
PicPesan.Visible = False
PicKonfigurasi.Visible = False
LblStatus.Caption = "Berita Terkirim"
Bar1.Panels(2).Text = "Berita Terkirim"
Me.MousePointer = 11
DaftarTerkirim
If LvTerkirim.ListItems.Count = 0 Then
cmdHapusSMS.Enabled = False
Else
cmdHapusSMS.Enabled = True
End If
Me.MousePointer = 1
End Sub
Private Sub cmdPesan_Click()
Bar1.Panels(2).Text = "Meesage"
PicTerkirim.Visible = False
LblStatus.Caption = "Message"
PicPesan.Visible = True
PicMasuk.Visible = False
PicKonfigurasi.Visible = False
End Sub
Private Sub cmdRestart_Click()
Bar1.Panels(1).Text = "Status: Restart Connect to port/com..."
tm_Koneksi.Enabled = True
End Sub
Private Sub cmdSimpan_Click()
Me.MousePointer = 11
SimpanSMS
Me.MousePointer = 1
aSMS = False
cmdSimpan.Enabled = False
End Sub
Private Sub FBus_IncomingCall(ByVal sIncomingNumber As String)
MsgBox "Ada panggilan masuk " & sIncomingNumber & "", vbInformation, "Panggilan"
End Sub
Private Sub Form_Activate()
CheckSoftware frmSMS_Manager
End Sub
Private Sub Form_Load()
xp.InitSubClassing
tm_Koneksi.Enabled = True
For i = 1 To 10
cmbPort.AddItem "COM" & i
Next i
cmbPort.Text = "COM1"
Bar1.Panels(2).Text = "Konfigurasi"
LblStatus.Caption = "Konfigurasi"
End Sub
Private Sub Form_Unload(Cancel As Integer)
If FBus.Connected = True Then
FBus.Disconnect
End If
If Not aSMS Then
Tutup
Else
Kata = MsgBox(" Data SMS yang di kirm belum di simpan..." & Chr(13) & _
" Apakah Data SMS mau di simpan..", vbInformation + vbYesNo, "Informasi SMS")
If Kata = vbYes Then
cmdSimpan.Enabled = True
cmdSimpan_Click
Tutup
Else
Tutup
End If
End If
End Sub
Private Sub Lv1_Click()
cmdRestart.Enabled = True
End Sub
Private Sub LvInbox_Click()
If LvInbox.ListItems.Count <> 0 Then
txtNo.Text = LvInbox.SelectedItem.SubItems(1)
txtTgl.Text = LvInbox.SelectedItem.SubItems(3)
txtPesan.Text = LvInbox.SelectedItem.SubItems(2)
Exit Sub
End If
End Sub
Private Sub LvInbox_ItemClick(ByVal Item As MSComctlLib.ListItem)
LvInbox_Click
End Sub
Private Sub LvTerkirim_Click()
If LvTerkirim.ListItems.Count <> 0 Then
txtNoHPTerkirim.Text = LvTerkirim.SelectedItem.SubItems(1)
txtTglTerkirim.Text = LvTerkirim.SelectedItem.SubItems(5)
txtSMSTerkirim.Text = LvTerkirim.SelectedItem.SubItems(3)
End If
End Sub
Private Sub LvTerkirim_ItemClick(ByVal Item As MSComctlLib.ListItem)
LvTerkirim_Click
End Sub
Private Sub OsenXPButton5_Click()
If FBus.Connected = True Then
FBus.Disconnect
End If
Unload Me
End Sub
Private Sub T_Timer()
If L1.Top <= -1000 Then L1.Top = 3480
If L2.Top <= -1000 Then L2.Top = 3480
If L3.Top <= -1000 Then L3.Top = 3480
If L4.Top <= -1000 Then L4.Top = 3480
If L5.Top <= -1000 Then L5.Top = 3480
If L6.Top <= -1000 Then L6.Top = 3480
If L7.Top <= -1000 Then L7.Top = 3480
If L8.Top <= -1000 Then L8.Top = 3480
L1.Top = L1.Top - 15
L2.Top = L2.Top - 15
L3.Top = L3.Top - 15
L4.Top = L4.Top - 15
L5.Top = L5.Top - 15
L6.Top = L6.Top - 15
L7.Top = L7.Top - 15
L8.Top = L8.Top - 15
End Sub
Private Sub Timer1_Timer()
If Blue <= 255 Then
Blue = Blue + 50
Else
Blue = 0
Green = Green + 50
End If
If Green >= 255 Then
Green = 0
Red = Red + 50
End If
If Red >= 255 Then
Red = 0
End If
L1.ForeColor = Int(RGB(Red, Green, Blue))
L1.Refresh
L2.ForeColor = Int(RGB(Blue, Red, Blue))
L2.Refresh
L3.ForeColor = Int(RGB(Red, Blue, Green))
L3.Refresh
L4.ForeColor = Int(RGB(Green, Blue, Red))
L4.Refresh
L5.ForeColor = Int(RGB(Blue, Red, Green))
L5.Refresh
L6.ForeColor = Int(RGB(Red, Green, Blue))
L6.Refresh
L7.ForeColor = Int(RGB(Blue, Red, Green))
L7.Refresh
L8.ForeColor = Int(RGB(Green, Red, Blue))
L8.Refresh
End Sub
Private Sub tm_Koneksi_Timer()
On Error GoTo salah
Me.MousePointer = 11
Bar1.Panels(1).Text = "Silahkan Tunggu..."
DoEvents
FBus.Connect cmbPort.Text
If FBus.Connected = True Then
txtNegara.Text = FBus.ProviderCountry
txtProvider.Text = FBus.ProviderName
txtTanggal.Text = FBus.DateTime
DoEvents
Bar1.Panels(1).Text = "Connecting to phone ..."
Bar1.Panels(3).Text = IIf(FBus.AlarmEnabled, "Alarm On", "Alarm Off")
If FBus.KeyboardLocked Then
txtKey.Text = "Aktif"
Else
txtKey.Text = "Not Aktif"
End If
DoEvents
txtSignal.Text = FBus.RfLevel
txtBatterai.Text = (FBus.BatteryLevel / 4) * 100 & "%"
FBus.EnableNetMonitorEngineering
Me.MousePointer = 1
DoEvents
Bar1.Panels(1).Text = "Status: Connect to port/com..."
MsgBox "SMS Manager 1.0 Terhubung ke Hp/Port"
Lv1.ListItems.Clear
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Connect"
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
fr_Koneksi.Enabled = False
tm_Koneksi.Enabled = False
Else
Bar1.Panels(1).Text = "Status: Not Connect to port/com..."
Me.MousePointer = 1
tm_Koneksi.Enabled = True
MsgBox "SMS Manager 1.0 tidak terhubung ke HP/Port ....", vbInformation
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Not Connect"
fr_Koneksi.Enabled = True
End If
salah:
Me.MousePointer = 1
If Err <> 0 Then
Bar1.Panels(1).Text = "Status: Error to open to port/com..."
MsgBox "Port/Hp tidak dapat di akses oleh Sistem...", vbInformation
tm_Koneksi.Enabled = False
fr_Koneksi.Enabled = True
Exit Sub
End If
End Sub
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
txtMessage.SelText = Button.Key & " "
End Sub
Private Sub Toolbar2_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
On Error Resume Next
txtMessage.SelText = ButtonMenu.Text & " "
End Sub
Private Sub txtMessage_Change()
On Error Resume Next
Dim h As Long
h = Int(Len(txtMessage) / (MaxMsg))
If (Len(txtMessage) Mod MaxMsg) <> 0 Then h = h + 1
lblCount = "Count: " & h & ", " & _
"Char Length: " & Len(txtMessage) & " Char Left: " & ((MaxMsg) * h) - Len(txtMessage)
End Sub
Sub DaftarInboxSMSHP()
Me.MousePointer = 11
If FBus.Connected = True Then
FBus.SMS.Refresh
LvInbox.ListItems.Clear
For i = 1 To Me.FBus.SMS.Inbox.Count
Set vButir = Me.LvInbox.ListItems.Add(, , LvInbox.ListItems.Count + 1 & ".")
vButir.SubItems(1) = FBus.SMS.Inbox(i).Sender
vButir.SubItems(2) = FBus.SMS.Inbox(i).Text
vButir.SubItems(3) = FBus.SMS.Inbox(i).DateTime
Next
End If
'Prog.Visible = False
Me.MousePointer = 1
End Sub
Sub DaftarOutboxSMSHP()
Me.MousePointer = 11
If FBus.Connected = True Then
FBus.SMS.Refresh
LvInbox.ListItems.Clear
For i = 1 To Me.FBus.SMS.Outbox.Count
Set vButir = Me.LvInbox.ListItems.Add(, , LvInbox.ListItems.Count + 1 & ".")
vButir.SubItems(1) = FBus.SMS.Outbox(i).Sender
vButir.SubItems(2) = FBus.SMS.Outbox(i).Text
vButir.SubItems(3) = FBus.SMS.Outbox(i).DateTime
Next
End If
Me.MousePointer = 1
End Sub
Sub SimpanSMS()
On Error GoTo salah
DataSMS.BeginTrans
For i = 1 To Lv2.ListItems.Count
DataSMS.Execute "Insert Into Terkirim Values ('" & Lv2.ListItems(i).SubItems(1) & "'," & _
"'" & Lv2.ListItems(i).SubItems(2) & "','" & Lv2.ListItems(i).SubItems(3) & "'," & _
"'" & Lv2.ListItems(i).SubItems(4) & "','" & Lv2.ListItems(i).SubItems(5) & "')"
DataSMS.CommitTrans
Next i
MsgBox " DAta SMS telah tersimpan ke dalam database SMS Manager...", vbInformation
Lv2.ListItems.Clear
aSMS = False
txtNomor.SetFocus
Exit Sub
salah:
MsgBox " Data SMS tidak dapat di simpan..", vbInformation
End Sub
Sub DaftarTerkirim()
' On Error GoTo Salah
Me.MousePointer = 11
Kata = "Select * From Terkirim Order By [No telp]"
Set TSMS = New ADODB.Recordset
TSMS.Open Kata, DataSMS, adOpenStatic, adLockReadOnly
LvTerkirim.ListItems.Clear
If Not TSMS.EOF Then
TSMS.MoveFirst
i = 1
While Not TSMS.EOF
Set vButir = LvTerkirim.ListItems.Add(, , i & ".")
vButir.SubItems(1) = TSMS![No telp]
vButir.SubItems(2) = TSMS![Nama]
vButir.SubItems(3) = TSMS![Pesan]
vButir.SubItems(4) = TSMS![Status]
vButir.SubItems(5) = TSMS![Tgl Kirim]
TSMS.MoveNext
i = i + 1
Wend
End If
TSMS.Close
Set TSMS = Nothing
Me.MousePointer = 1
End Sub
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim Red, Green, Blue As Integer
Dim Jam As String
Dim vButir As ListItem
Private Sub cmbSMS_Click()
'On Error GoTo Salah
If cmbSMS.Text <> "" Then
If FBus.Connected = True Then
If cmbSMS.Text = "Inbox" Then
DaftarInboxSMSHP
If LvInbox.ListItems.Count = 0 Then
MsgBox " Data Laporan SMS Masuk Kosong..", vbInformation
LvInbox.Enabled = False
Exit Sub
End If
Else
DaftarOutboxSMSHP
If LvInbox.ListItems.Count = 0 Then
MsgBox " Data Laporan SMS Keluar Kosong..", vbInformation
LvInbox.Enabled = False
Exit Sub
End If
End If
Else
MsgBox " Belum ada koneksi ke HP.." & vbCrLf & _
"Coba Periksa Kembali Koneksi HP..", vbInformation
PicKonfigurasi.Visible = True
End If
End If
End Sub
Private Sub cmdAlarm_Click()
Bar1.Panels(2).Text = "Tunggu...."
frmAlarm.Show vbModal, Me
Bar1.Panels(2).Text = "Alarm...."
End Sub
Private Sub cmdAuto_Click()
Me.MousePointer = 11
Bar1.Panels(2).Text = "Tunggu..."
frmAuto.Show vbModal, Me
Bar1.Panels(2).Text = "Auto Respo SMS"
Me.MousePointer = 1
End Sub
Private Sub cmdBatal_Click()
txtNomor.Text = "": txtNama.Text = ""
txtMessage.Text = ""
End Sub
Private Sub cmdConnect_Click()
tm_Koneksi.Enabled = True
fr_Koneksi.Enabled = False
End Sub
Private Sub cmdDisconnect_Click()
If FBus.Connected = True Then
Bar1.Panels(1).Text = "Status: Disable Connect to port/com..."
FBus.Disconnect
End If
For i = 1 To 10
cmbPort.AddItem "COM" & i
Next i
Lv1.ListItems.Clear
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Not Connect"
cmdDisconnect.Enabled = False
cmdRestart.Enabled = False
cmdConnect.Enabled = True
txtProvider.Text = "": txtNegara.Text = ""
txtKey.Text = "": txtSignal.Text = ""
txtBatterai.Text = "": fr_Koneksi.Enabled = True
txtTanggal.Text = ""
cmbPort.ListIndex = 0
'Bar1.Panels(3).Text = IIf(FBus.AlarmEnabled, "Alarm On", "Alarm Off")
End Sub
Private Sub cmdFind_Click()
Me.MousePointer = 11
Bar1.Panels(2).Text = "Proses Loading..."
frmBuku.Show vbModal, Me
Bar1.Panels(2).Text = "Buku Telp..."
Me.MousePointer = 1
End Sub
Private Sub cmdHapusSMS_Click()
On Error GoTo salah
If MsgBox(" Anda Yakin akan menghapus SMS ini..", vbInformation + vbYesNo) = vbYes Then
Kata = MsgBox("Anda Benar-benar yakin untuk menghapus SMS ini..", vbInformation + vbOKCancel, "Informasi ")
If Kata = vbOK Then
Me.MousePointer = 11
DataSMS.BeginTrans
DataSMS.Execute "Delete Form Terkirim where [No Telp]='" & txtNoHPTerkirim.Text & "' And [Tgl kirim]='" & txtTglTerkirim.Text & "'"
DataSMS.CommitTrans
DaftarTerkirim
Me.MousePointer = 1
MsgBox "SMS Terkirim sudah di hapus dari database...", vbInformation
txtNoHPTerkirim = "": txtTglTerkirim = ""
txtSMSTerkirim.Text = ""
Exit Sub
End If
End If
Exit Sub
salah:
MsgBox " Data SMS Terkirim tidak dapat di hapus...", vbInformation
End Sub
Private Sub cmdInbox_Click()
PicTerkirim.Visible = False
PicMasuk.Visible = True
PicPesan.Visible = False
PicKonfigurasi.Visible = False
LblStatus.Caption = "Laporan Pesan"
Bar1.Panels(2).Text = "Laporan Pesan"
End Sub
Private Sub cmdKirim_Click()
Dim a As Boolean
'On Error GoTo Salah
Me.MousePointer = 11
If FBus.Connected = True Then
If FBus.RfLevel > 0 Then
If txtNomor.Text <> "" And txtMessage.Text <> "" Then
a = FBus.SMS.SendMessage(txtNomor.Text, txtMessage.Text)
If a = True Then
Me.MousePointer = 1
MsgBox "Pesan telah terkirim ke No Tujuan: " & txtNomor.Text & " "
Set vButir = Lv2.ListItems.Add(, , Lv2.ListItems.Count + 1 & ".")
vButir.SubItems(1) = txtNomor.Text
vButir.SubItems(2) = txtNama.Text
vButir.SubItems(3) = txtMessage.Text
vButir.SubItems(4) = "Terkirim"
vButir.SubItems(5) = FBus.DateTime
cmdBatal.Enabled = True
cmdSimpan.Enabled = True
aSMS = True
cmdBatal_Click
Else
MsgBox " Pesan Tidak Terkirim ke No Tujuan : " & txtNomor.Text & ""
Set vButir = Lv2.ListItems.Add(, , Lv2.ListItems.Count + 1 & ".")
vButir.SubItems(1) = txtNomor.Text
vButir.SubItems(2) = txtNama.Text
vButir.SubItems(3) = txtMessage.Text
vButir.SubItems(4) = "tdk Terkirim"
vButir.SubItems(5) = FBus.DateTime
cmdSimpan.Enabled = True
cmdBatal_Click
aSMS = True
End If
Else
Me.MousePointer = 1
If txtNomor.Text = "" Then
MsgBox " Silahkan isi No Tujuan..", vbInformation
txtNomor.SetFocus
Exit Sub
ElseIf txtMessage.Text = "" Then
MsgBox "Pesan teks yang akan di kirim masih kosong...", vbInformation
txtMessage.SetFocus
Exit Sub
End If
End If
Else
Me.MousePointer = 1
MsgBox "No Tujuan: " & txtNomor.Text & " berada di luar jangkauan sistem..", vbInformation
End If
Else
Me.MousePointer = 1
MsgBox "Pesan tidak dapat di kirim, coba Perisa koneksi port/com...", vbCritical
End If
End Sub
Private Sub cmdKOnfigurasi_Click()
PicTerkirim.Visible = False
Bar1.Panels(2).Text = "Konfigurasi"
PicPesan.Visible = False
PicMasuk.Visible = False
LblStatus.Caption = "Konfigurasi"
PicKonfigurasi.Visible = True
End Sub
Private Sub cmdOutbox_Click()
PicMasuk.Visible = False
PicTerkirim.Visible = True
PicPesan.Visible = False
PicKonfigurasi.Visible = False
LblStatus.Caption = "Berita Terkirim"
Bar1.Panels(2).Text = "Berita Terkirim"
Me.MousePointer = 11
DaftarTerkirim
If LvTerkirim.ListItems.Count = 0 Then
cmdHapusSMS.Enabled = False
Else
cmdHapusSMS.Enabled = True
End If
Me.MousePointer = 1
End Sub
Private Sub cmdPesan_Click()
Bar1.Panels(2).Text = "Meesage"
PicTerkirim.Visible = False
LblStatus.Caption = "Message"
PicPesan.Visible = True
PicMasuk.Visible = False
PicKonfigurasi.Visible = False
End Sub
Private Sub cmdRestart_Click()
Bar1.Panels(1).Text = "Status: Restart Connect to port/com..."
tm_Koneksi.Enabled = True
End Sub
Private Sub cmdSimpan_Click()
Me.MousePointer = 11
SimpanSMS
Me.MousePointer = 1
aSMS = False
cmdSimpan.Enabled = False
End Sub
Private Sub FBus_IncomingCall(ByVal sIncomingNumber As String)
MsgBox "Ada panggilan masuk " & sIncomingNumber & "", vbInformation, "Panggilan"
End Sub
Private Sub Form_Activate()
CheckSoftware frmSMS_Manager
End Sub
Private Sub Form_Load()
xp.InitSubClassing
tm_Koneksi.Enabled = True
For i = 1 To 10
cmbPort.AddItem "COM" & i
Next i
cmbPort.Text = "COM1"
Bar1.Panels(2).Text = "Konfigurasi"
LblStatus.Caption = "Konfigurasi"
End Sub
Private Sub Form_Unload(Cancel As Integer)
If FBus.Connected = True Then
FBus.Disconnect
End If
If Not aSMS Then
Tutup
Else
Kata = MsgBox(" Data SMS yang di kirm belum di simpan..." & Chr(13) & _
" Apakah Data SMS mau di simpan..", vbInformation + vbYesNo, "Informasi SMS")
If Kata = vbYes Then
cmdSimpan.Enabled = True
cmdSimpan_Click
Tutup
Else
Tutup
End If
End If
End Sub
Private Sub Lv1_Click()
cmdRestart.Enabled = True
End Sub
Private Sub LvInbox_Click()
If LvInbox.ListItems.Count <> 0 Then
txtNo.Text = LvInbox.SelectedItem.SubItems(1)
txtTgl.Text = LvInbox.SelectedItem.SubItems(3)
txtPesan.Text = LvInbox.SelectedItem.SubItems(2)
Exit Sub
End If
End Sub
Private Sub LvInbox_ItemClick(ByVal Item As MSComctlLib.ListItem)
LvInbox_Click
End Sub
Private Sub LvTerkirim_Click()
If LvTerkirim.ListItems.Count <> 0 Then
txtNoHPTerkirim.Text = LvTerkirim.SelectedItem.SubItems(1)
txtTglTerkirim.Text = LvTerkirim.SelectedItem.SubItems(5)
txtSMSTerkirim.Text = LvTerkirim.SelectedItem.SubItems(3)
End If
End Sub
Private Sub LvTerkirim_ItemClick(ByVal Item As MSComctlLib.ListItem)
LvTerkirim_Click
End Sub
Private Sub OsenXPButton5_Click()
If FBus.Connected = True Then
FBus.Disconnect
End If
Unload Me
End Sub
Private Sub T_Timer()
If L1.Top <= -1000 Then L1.Top = 3480
If L2.Top <= -1000 Then L2.Top = 3480
If L3.Top <= -1000 Then L3.Top = 3480
If L4.Top <= -1000 Then L4.Top = 3480
If L5.Top <= -1000 Then L5.Top = 3480
If L6.Top <= -1000 Then L6.Top = 3480
If L7.Top <= -1000 Then L7.Top = 3480
If L8.Top <= -1000 Then L8.Top = 3480
L1.Top = L1.Top - 15
L2.Top = L2.Top - 15
L3.Top = L3.Top - 15
L4.Top = L4.Top - 15
L5.Top = L5.Top - 15
L6.Top = L6.Top - 15
L7.Top = L7.Top - 15
L8.Top = L8.Top - 15
End Sub
Private Sub Timer1_Timer()
If Blue <= 255 Then
Blue = Blue + 50
Else
Blue = 0
Green = Green + 50
End If
If Green >= 255 Then
Green = 0
Red = Red + 50
End If
If Red >= 255 Then
Red = 0
End If
L1.ForeColor = Int(RGB(Red, Green, Blue))
L1.Refresh
L2.ForeColor = Int(RGB(Blue, Red, Blue))
L2.Refresh
L3.ForeColor = Int(RGB(Red, Blue, Green))
L3.Refresh
L4.ForeColor = Int(RGB(Green, Blue, Red))
L4.Refresh
L5.ForeColor = Int(RGB(Blue, Red, Green))
L5.Refresh
L6.ForeColor = Int(RGB(Red, Green, Blue))
L6.Refresh
L7.ForeColor = Int(RGB(Blue, Red, Green))
L7.Refresh
L8.ForeColor = Int(RGB(Green, Red, Blue))
L8.Refresh
End Sub
Private Sub tm_Koneksi_Timer()
On Error GoTo salah
Me.MousePointer = 11
Bar1.Panels(1).Text = "Silahkan Tunggu..."
DoEvents
FBus.Connect cmbPort.Text
If FBus.Connected = True Then
txtNegara.Text = FBus.ProviderCountry
txtProvider.Text = FBus.ProviderName
txtTanggal.Text = FBus.DateTime
DoEvents
Bar1.Panels(1).Text = "Connecting to phone ..."
Bar1.Panels(3).Text = IIf(FBus.AlarmEnabled, "Alarm On", "Alarm Off")
If FBus.KeyboardLocked Then
txtKey.Text = "Aktif"
Else
txtKey.Text = "Not Aktif"
End If
DoEvents
txtSignal.Text = FBus.RfLevel
txtBatterai.Text = (FBus.BatteryLevel / 4) * 100 & "%"
FBus.EnableNetMonitorEngineering
Me.MousePointer = 1
DoEvents
Bar1.Panels(1).Text = "Status: Connect to port/com..."
MsgBox "SMS Manager 1.0 Terhubung ke Hp/Port"
Lv1.ListItems.Clear
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Connect"
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
fr_Koneksi.Enabled = False
tm_Koneksi.Enabled = False
Else
Bar1.Panels(1).Text = "Status: Not Connect to port/com..."
Me.MousePointer = 1
tm_Koneksi.Enabled = True
MsgBox "SMS Manager 1.0 tidak terhubung ke HP/Port ....", vbInformation
Set vButir = Lv1.ListItems.Add(, , Lv1.ListItems.Count + 1 & ".")
vButir.SubItems(1) = cmbPort.Text
vButir.SubItems(2) = "Not Connect"
fr_Koneksi.Enabled = True
End If
salah:
Me.MousePointer = 1
If Err <> 0 Then
Bar1.Panels(1).Text = "Status: Error to open to port/com..."
MsgBox "Port/Hp tidak dapat di akses oleh Sistem...", vbInformation
tm_Koneksi.Enabled = False
fr_Koneksi.Enabled = True
Exit Sub
End If
End Sub
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
txtMessage.SelText = Button.Key & " "
End Sub
Private Sub Toolbar2_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
On Error Resume Next
txtMessage.SelText = ButtonMenu.Text & " "
End Sub
Private Sub txtMessage_Change()
On Error Resume Next
Dim h As Long
h = Int(Len(txtMessage) / (MaxMsg))
If (Len(txtMessage) Mod MaxMsg) <> 0 Then h = h + 1
lblCount = "Count: " & h & ", " & _
"Char Length: " & Len(txtMessage) & " Char Left: " & ((MaxMsg) * h) - Len(txtMessage)
End Sub
Sub DaftarInboxSMSHP()
Me.MousePointer = 11
If FBus.Connected = True Then
FBus.SMS.Refresh
LvInbox.ListItems.Clear
For i = 1 To Me.FBus.SMS.Inbox.Count
Set vButir = Me.LvInbox.ListItems.Add(, , LvInbox.ListItems.Count + 1 & ".")
vButir.SubItems(1) = FBus.SMS.Inbox(i).Sender
vButir.SubItems(2) = FBus.SMS.Inbox(i).Text
vButir.SubItems(3) = FBus.SMS.Inbox(i).DateTime
Next
End If
'Prog.Visible = False
Me.MousePointer = 1
End Sub
Sub DaftarOutboxSMSHP()
Me.MousePointer = 11
If FBus.Connected = True Then
FBus.SMS.Refresh
LvInbox.ListItems.Clear
For i = 1 To Me.FBus.SMS.Outbox.Count
Set vButir = Me.LvInbox.ListItems.Add(, , LvInbox.ListItems.Count + 1 & ".")
vButir.SubItems(1) = FBus.SMS.Outbox(i).Sender
vButir.SubItems(2) = FBus.SMS.Outbox(i).Text
vButir.SubItems(3) = FBus.SMS.Outbox(i).DateTime
Next
End If
Me.MousePointer = 1
End Sub
Sub SimpanSMS()
On Error GoTo salah
DataSMS.BeginTrans
For i = 1 To Lv2.ListItems.Count
DataSMS.Execute "Insert Into Terkirim Values ('" & Lv2.ListItems(i).SubItems(1) & "'," & _
"'" & Lv2.ListItems(i).SubItems(2) & "','" & Lv2.ListItems(i).SubItems(3) & "'," & _
"'" & Lv2.ListItems(i).SubItems(4) & "','" & Lv2.ListItems(i).SubItems(5) & "')"
DataSMS.CommitTrans
Next i
MsgBox " DAta SMS telah tersimpan ke dalam database SMS Manager...", vbInformation
Lv2.ListItems.Clear
aSMS = False
txtNomor.SetFocus
Exit Sub
salah:
MsgBox " Data SMS tidak dapat di simpan..", vbInformation
End Sub
Sub DaftarTerkirim()
' On Error GoTo Salah
Me.MousePointer = 11
Kata = "Select * From Terkirim Order By [No telp]"
Set TSMS = New ADODB.Recordset
TSMS.Open Kata, DataSMS, adOpenStatic, adLockReadOnly
LvTerkirim.ListItems.Clear
If Not TSMS.EOF Then
TSMS.MoveFirst
i = 1
While Not TSMS.EOF
Set vButir = LvTerkirim.ListItems.Add(, , i & ".")
vButir.SubItems(1) = TSMS![No telp]
vButir.SubItems(2) = TSMS![Nama]
vButir.SubItems(3) = TSMS![Pesan]
vButir.SubItems(4) = TSMS![Status]
vButir.SubItems(5) = TSMS![Tgl Kirim]
TSMS.MoveNext
i = i + 1
Wend
End If
TSMS.Close
Set TSMS = Nothing
Me.MousePointer = 1
End Sub
send sms pake pc
Dim mOK
Dim mErr
Dim mResult
Dim doit As Boolean
Dim sdata As String
Private Sub cmdSend_Click()
Dim n
' Setup PictureBox for Scale
List1.Clear
List1.AddItem "Starting..."
' Fire Rx Event Every Byte
MSComm1.RThreshold = 1
' When Inputting Data, Input All Bytes
MSComm1.InputLen = 0
' 19200 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "19200,N,8,1"
' Make sure DTR line is low to prevent Stamp reset
MSComm1.DTREnable = True
MSComm1.InBufferSize = 32
MSComm1.OutBufferSize = 0
' Open COM1
MSComm1.CommPort = 5
MSComm1.RTSEnable = True
'Me.MSComm1.Handshaking = 2 - comRTS
MSComm1.PortOpen = True
List1.AddItem "Port Opened"
Dim what As Boolean
what = sendIt("AT+CMGF=1", "OK", "ERROR")
If what = True Then
what = sendIt("AT+CMGS=" & Chr(34) & Me.txtMNo & Chr(34), ">", "ERROR")
If what = True Then
n = Now
Me.txtMToSend = Me.txtMsg & n
'MSComm1.Output = Me.txtMsg & n & Chr(26) & Chr(13)
what = sendIt(Me.txtMToSend & Chr(26), "OK", "ERROR")
End If
End If
Me.MSComm1.PortOpen = False
List1.AddItem "Done..."
End Sub
Function sendIt(ByVal s, ByVal ok, ByVal eror, Optional ByVal TOut = 5) As Boolean
mOK = ok
mErr = eror
List1.AddItem "Sending.." & s
MSComm1.Output = s & Chr(13)
Dim p
p = 0.0001 * TOut
doit = False
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
sendIt = False
Exit Function
End If
DoEvents
Wend
sendIt = True
End Function
Sub wait()
Dim p
p = 0.0005
doit = False
Me.List1.AddItem "Waiting..."
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
End If
DoEvents
Wend
End Sub
Private Sub MSComm1_OnComm()
List1.AddItem "In OnComm"
Dim sdata1
If MSComm1.CommEvent = comEvReceive Then
sdata1 = MSComm1.Input
sdata = sdata & sdata1
If InStr(sdata, mOK) > 0 Then
doit = True
mResult = "OK"
List1.AddItem "--> " & sdata
ElseIf InStr(sdata, "ERROR") > 0 Then
doit = True
List1.AddItem "Err--->" & sdata
mResult = "ERR"
ElseIf InStr(sdata, ">") > 0 Then
doit = True
List1.AddItem ">>---> " & sdata
mResult = sdata
Else
List1.AddItem "?---> " & sdata
mResult = sdata
End If
End If
End Sub
Dim mErr
Dim mResult
Dim doit As Boolean
Dim sdata As String
Private Sub cmdSend_Click()
Dim n
' Setup PictureBox for Scale
List1.Clear
List1.AddItem "Starting..."
' Fire Rx Event Every Byte
MSComm1.RThreshold = 1
' When Inputting Data, Input All Bytes
MSComm1.InputLen = 0
' 19200 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "19200,N,8,1"
' Make sure DTR line is low to prevent Stamp reset
MSComm1.DTREnable = True
MSComm1.InBufferSize = 32
MSComm1.OutBufferSize = 0
' Open COM1
MSComm1.CommPort = 5
MSComm1.RTSEnable = True
'Me.MSComm1.Handshaking = 2 - comRTS
MSComm1.PortOpen = True
List1.AddItem "Port Opened"
Dim what As Boolean
what = sendIt("AT+CMGF=1", "OK", "ERROR")
If what = True Then
what = sendIt("AT+CMGS=" & Chr(34) & Me.txtMNo & Chr(34), ">", "ERROR")
If what = True Then
n = Now
Me.txtMToSend = Me.txtMsg & n
'MSComm1.Output = Me.txtMsg & n & Chr(26) & Chr(13)
what = sendIt(Me.txtMToSend & Chr(26), "OK", "ERROR")
End If
End If
Me.MSComm1.PortOpen = False
List1.AddItem "Done..."
End Sub
Function sendIt(ByVal s, ByVal ok, ByVal eror, Optional ByVal TOut = 5) As Boolean
mOK = ok
mErr = eror
List1.AddItem "Sending.." & s
MSComm1.Output = s & Chr(13)
Dim p
p = 0.0001 * TOut
doit = False
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
sendIt = False
Exit Function
End If
DoEvents
Wend
sendIt = True
End Function
Sub wait()
Dim p
p = 0.0005
doit = False
Me.List1.AddItem "Waiting..."
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
End If
DoEvents
Wend
End Sub
Private Sub MSComm1_OnComm()
List1.AddItem "In OnComm"
Dim sdata1
If MSComm1.CommEvent = comEvReceive Then
sdata1 = MSComm1.Input
sdata = sdata & sdata1
If InStr(sdata, mOK) > 0 Then
doit = True
mResult = "OK"
List1.AddItem "--> " & sdata
ElseIf InStr(sdata, "ERROR") > 0 Then
doit = True
List1.AddItem "Err--->" & sdata
mResult = "ERR"
ElseIf InStr(sdata, ">") > 0 Then
doit = True
List1.AddItem ">>---> " & sdata
mResult = sdata
Else
List1.AddItem "?---> " & sdata
mResult = sdata
End If
End If
End Sub
Subscribe to:
Posts (Atom)