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
'==================================================================

ni sampel anti virus sederhana vb6, tolong dikembangkan.....
(ni hasil googling jg.... :) )

Private Sub Command1_Click()
On Error Resume Next
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer

List1.Clear
'Label1.Caption = ""

st = "Cari"

Label1.Caption = "0"
'If Mid(Dir1.path, 2, 2) = ":\\" Then
'AmbilPt = Mid(Dir1.path, 1, 3)
'Else
'End If
SearchPath = Dir1.path & "\"
FindStr = "*.*"
FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
End Sub

Private Sub Command2_Click()
st = "Stop"
End Sub
Sub pouse(angka)
Dim pos As Integer
Dim tm As Timer
tm1 = Timer
Do
If Timer - tm1 >= angka Then
Exit Sub
Else
pos% = DoEvents()
End If
Loop
End Sub

Private Sub Command3_Click()
On Error Resume Next
Dim NumPath As String
Dim Temp As String
Set fl = New FileSystemObject
Set pt = New FileSystemObject
Set fldr = New FileSystemObject
Set ver = New FileSystemObject
Set Temp12 = New FileSystemObject
cm.ShowOpen
NumPath = cm.FileName

lblname.Caption = ver.GetFileName(cm.FileName)
lblversion.Caption = ver.GetFileVersion(cm.FileName)
lblinternal.Caption = ver.GetBaseName(cm.FileName)
lbllanguage.Caption = ver.GetTempName '(cm.FileName)
lblori.Caption = ver.GetDriveName(cm.FileName)
lblproduct.Text = ver.GetFile(cm.FileName)

End Sub

Private Sub Command4_Click()
On Error Resume Next
Set fldel1 = New FileSystemObject
Set fldel2 = New FileSystemObject

Dim jum As Integer
For jum = 0 To List1.ListCount
Text4.Text = List1.List(jum)
List1.SetFocus
List1.Selected(jum) = True

'fldel1.DeleteFile (List1.List(jum))
Kill (List1.List(jum))
pouse 0.05
Next jum
MsgBox "Data telah terhapus!", vbInformation, "Pesan"
End Sub

Private Sub Drive1_Change()
On Error GoTo rr
Dir1.path = Drive1.Drive

rr:
If Err.Number = 68 Then
MsgBox "Peralatan tidak ditemukan!", vbInformation, "Pesan"
Else
End If
End Sub

c0d3

Minggu, 13 Maret 2011

Tahap I

Kamis, 10 Maret 2011

Sabtu, 03 Juli 2010

Jumat, 25 Juni 2010

Anti virus sederhana

Sampel Aplikasi

Rabu, 23 Juni 2010

Perangkat Lunak