->>>>>DASAR MENGGUNAKAN VISUAL BASIC 6.0<<<<<-

    Apa itu Visual Basic? Kata “Visual” menun-
jukkan cara yang digunakan untuk membuat Graphical-
User Interface (GUI). Dengan cara ini Anda tidak-
lagi menuliskan instruksi pemrograman dalam kode-
kode baris, tetapi secara mudah Anda dapat melaku-
kan drag dan drop objek-objek yang akan Anda gunakan.

Kata “Basic” merupakan bagian bahasa BASIC-
(Beginners All Purpose Symbolic Instruction Code),-
yaitu sebuah bahasa pemrograman yang dalam sejarah-
nya sudah banyak digunakan oleh para programmer-
untuk menyusun aplikasi. Visual Basic dikembangkan
dari bahasa pemrograman BASIC.


1.1 Memulai Visual Basic 6.0
Setelah Anda menginstal program Visual Basic 6.0, Anda dapat
memulai dengan tombol Start yang ada pada task bar pada
Windows. Berikut langkah-langkahnya secara lengkap.
1. Tekan tombol Start dari Task bar pada Windows.
2. Pilih All Programs, dan arahkan ke pilihan Microsoft Visual
Studio 6.0 dan klik pada pilihan Microsoft Visual Basic 6.0.

Gambar 1.1 Membuka Program Visual Basic 6.0
3. Setelah Anda berhasil menjalankan Visual Basic untuk yang
pertama kalinya, Anda akan melihat tampilan logo Visual Basic
6.0 dan tak lama kemudian akan muncul kotak dialog berikut.

Gambar 1.2 Kotak Dialog New Project
4. Kotak dialog tersebut meminta konfirmasi kepada Anda untuk
memilih tipe proyek yang ingin Anda buat. Dalam hal ini, pilih
tipe proyek VB Enterprise Edition Constrols. Tekan tombol Open
untuk melanjutkan.

Gambar 1.3 Kotak Dialog Pemilihan Tipe Proyek
5. Dengan pemilihan tipe VB Enterprise Edition Controls di atas,
seorang pengguna tidak perlu lagi capek-capek menambahkan
komponen-komponen yang diperlukan. Hal itu karena pada tipe
proyek tersebut sudah menyediakan komponen-komponen secara
lengkap. Tekan tombol Open untuk melanjutkan.
6. Setelah menekan tombol Open, akan muncul sebuah layar
program Visual Basic dengan disertai komponen-komponen
lengkap yang ada pada bagian General atau Toolbox.

Gambar 1.4 Tampilan Interface Visual Basic
7. Tampilan di atas dapat disebut dengan lingkungan Integrated
Development Environment (IDE). Pada lingkungan tersebut,
Anda dapat melakukan berbagai aktivitas seperti proses editing,
compiling, dan debugging.


1.2 Mengenal Elemen Visual Basic 6.0
Setelah Anda berhasil membuka Visual Basic pada layar, Anda akan
menemukan interface program Visual Basic seperti Gambar 1.4.
Terlihat bahwa interface tersebut terdiri atas beberapa elemen.

1.2.1 Menu Bar
Menu Bar akan menampilkan perintah-perintah yang dapat Anda
gunakan saat Anda bekerja pada Visual Basic. Secara default, menu
bar ini memiliki pilihan File, Edit, View, Window, Query, Diagram,
Tools, Add-Ins, dan Help. Disamping itu, sehubungan dengan
pemrograman, terdapat menu yang bisa diakses, misalnya Project,
Format, Debug, atau Run.

Gambar 1.5 Tampilan Menu Bar
Jika masing-masing menu bar tersebut diklik, Visual Basic akan
menampilkan daftar pilihan dari menu bar yang Anda klik tadi.

1.2.2 Context Menu
Context Menu berisi shortcut yang suatu saat bisa Anda gunakan
untuk membuka sebuah context menu suatu objek. Untuk membuka
Context Menu ini, Anda dapat mengklik kanan objek yang akan
Anda buka Context Menu-nya. Berikut tampilan gambarnya.


Gambar 1.6 Tampilan Context Menu
Context Menu di atas, kami ambilkan dari Designer Form, yaitu
dengan cara mengklik kanan Form Designer.

1.2.3 Toolbar
Fasilitas ini dapat mempercepat pengaksesan perintah-perintah yang
ada dalam pemrograman. Anda dapat mengklik tombol-tombol
dalam toolbar ini untuk melakukan aksi tertentu. Secara standar,
toolbar jenis Standard yang akan ditampilkan saat Anda memulai
Visual Basic.
Jika Anda ingin mengatur tampilan toolbar yang lain, Anda dapat
menggunakan pilihan Toolbar pada menu bar View.

Gambar 1.7 Tampilan Toolbar

1.2.4 Toolbox
Sebuah window yang berisi tombol-tombol control yang akan Anda
gunakan untuk mendesain atau “Membangun” sebuah form atau
report. Selain tombol control di bawah, Anda juga dapat mendefinisikan
atau menambah sendiri tombol control yang lain.

Gambar 1.8 Tampilan Toolbox Tipe Standard

Gambar 1.9 Tampilan Toolbox Tipe VB Enterprise Edition Controls
Tampil tidaknya window ini dapat Anda atur dari pilihan Toolbox
yang ada pada menu bar View - Toolbox.

1.2.5 Window Project Explorer
Window Project Explorer ini menampilkan daftar form, modul, serta
objek lain yang ada dalam project yang aktif. Sebuah Project merupakan
sekumpulan file yang Anda gunakan untuk membangun
sebuah aplikasi. Berikut tampilan gambarnya.

Gambar 1.10 Tampilan Window Project Explorer

1.2.6 Window Properties
Window Properties ini dapat Anda gunakan untuk mengatur propertie
sebuah objek atau control yang Anda pilih. Sebuah property merupakan
karakteristik objek, seperti size, caption, text, atau color.

Gambar 1.11 Tampilan Window Properties

1.2.7 Objek Browser
Objek Browser ini merupakan daftar objek yang ada dalam project
yang aktif. Anda dapat menggunakan Object Browser untuk menampilkan
objek yang ada dalam Visual Basic dan aplikasi lain.
Untuk menampilkan objek ini Anda dapat menggunakan cara View
- Object Browser. Berikut tampilan gambarnya.

Gambar 1.12 Tampilan Object Browser

1.2.8 Form Designer
Form Designer adalah sebuah window yang dapat Anda gunakan
untuk mengatur tampilan aplikasi yang Anda susun, atau dengan
kata lain sebagai tempat untuk mendesain sebuah form. Dalam form
ini Anda dapat menambahkan control, grafik, dan gambar ke dalam
form pada posisi yang Anda inginkan. Setiap form memiliki window
designer form sendiri-sendiri. Berikut tampilan gambarnya.

Gambar 1.13 Tampilan Form Designer

1.2.9 Window Code Editor
Window Code Editor merupakan sebuah tampilan window yang
digunakan untuk memasukkan kode aplikasi. Window Code Editor
ini digunakan untuk mendefinisikan kode-kode form atau kode
modul dalam sebuah aplikasi. Berikut tampilan gambarnya.

Gambar 1.14 Tampilan Window Code Editor

1.2.10 Window Form Layout
Window Form Layout dapat digunakan untuk mengontrol posisi form
pada aplikasi Anda menggunakan sistem grafik dalam sebuah layar.
Dengan fasilitas ini, Anda dapat melihat dan mengetahui posisi form
yang baru Anda desain. Berikut tampilan gambarnya.

Gambar 1.15 Tampilan Window Form Layout

1.2.11 Window Immmediate, Local, dan Watch
Window-window ini merupakan window tambahan yang digunakan
untuk proses debug aplikasi Anda. Window-window ini hanya dapat
Anda gunakan jika Anda menjalankan aplikasi dengan interface
Visual Basic. Untuk menampilkan window-window ini, Anda dapat
melakukannya dengan cara View - Name Window.

Gambar 1.16 Tampilan Window Immediate

Gambar 1.17 Tampilan Window Locals

Gambar 1.18 Tampilan Window Watches

Rabu, 27 Februari 2008

ANTIVIRUS VSAR

Source code dibawah ini adalah program antivirus VSAR
silahkan anda pelajari lebih dalam
1. Bukalah 1 project(name=SimpleVirusRemover)
2. Tambahkan 1 Form(name=frmRemoval), Tambahkan:
a. CheckBox(name=chkBackup,caption=Make Backup)
b. 4 Commandbutton dengan Commandbutton1(name=cmdBrowse,cap=Browse)
Commandbutton2(name=cmdRepair,cap=Repai),Commandbutton3(name=cmdscan,cap=scan)
Commandbutton4(name=cmdStop,cap=stop)
c. 3 Label dengan Label1(name=lblStatus)
d. 1 ListBox(name=lstFound)
e. 1 TextBox(name=txtPath)
3. Tambahkan 4 Module dengan module1(name=mdlBrowseFolder),
module2(name=mdlFindFile),module3(name=mdlGetName)
module4(name=mdlWinExit)

Copy coding dibawah ini dan paste di Editor Form:

'VSar Removal by Achmad Darmal
'Tarakan, Kalimantan Timur - Indonesia
Option Explicit

Private Declare Function SleepEx Lib "Kernel32" (ByVal _
dwMilliseconds As Long, ByVal bAlertable As Long) As Long

Private Sub Form_Load()
On Error Resume Next
Dim Spawn As String
Spawn = GetStringValue("HKEY_CLASSES_ROOT\exefile\sh" & _
"ell\open\command", "")
If LCase(Left(Spawn, 11)) = "loadexe.exe" Then
Call Reconfig
End If
lblStatus.Caption = "#VSar Removal Ready# Waiti" & _
"ng for instruction..."
End Sub

Private Sub Reconfig()
SetStringValue "HKEY_CLASSES_ROOT\exefile\shell\open\c" & _
"ommand", "", Chr(34) & Chr(37) & Chr(49) & Chr(34) & " " & _
Chr(37) & Chr(42)
SetDWORDValue "HKEY_CURRENT_USER\Software\Micro" & _
"soft\Windows\CurrentVersion\Policies\System", "DisableRe" & _
"gistryTools", 0
MsgBox "VSar found on your system, its recommended to scan " & _
"all your drive", vbExclamation
End Sub

Private Sub cmdBrowse_Click()
Dim brwVal As String
brwVal = BrowseForFolder("Select Drive And Directory:")
If Len(brwVal) > 0 Then
txtPath.Text = brwVal
End If
End Sub

Private Sub cmdRepair_Click()
On Error Resume Next
Dim i As Integer
If lstFound.SelCount = 0 Then
MsgBox "No file selected", vbCritical
Else
Do Until lstFound.SelCount = 0
For i = 0 To lstFound.ListCount
If lstFound.Selected(i) = True Then
SetAttr lstFound.List(i), vbNormal
RepairFile lstFound.List(i), 11264, 4, chkBackup.value
lstFound.RemoveItem (i)
End If
Next
Loop
End If
UpdateStatus
End Sub

Private Sub cmdStop_Click()
StopIt = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
StopIt = False
End
End Sub

Private Sub lstFound_Click()
lblStatus.Caption = lstFound.Text
End Sub

Private Sub lstFound_DblClick()
On Error Resume Next
cmdRepair_Click
End Sub

Private Sub UpdateStatus()
lblStatus.Caption = "Total virus found: " & lstFound.ListCount
End Sub

Private Sub cmdScan_Click()
On Error Resume Next
Dim xmount As String
Dim MyCaption As String
MyCaption = Me.Caption
cmdScan.Enabled = False
lstFound.Enabled = False
If Mid(txtPath.Text, 2, 2) <> ":\" Then
MsgBox "Path file not found", vbCritical
GoTo ProcError
End If
lstFound.Clear
StopIt = False
Me.Caption = MyCaption & " - Please Wait..."
SleepEx 1, False
FindFiles txtPath.Text, "*.exe", "VSAR", 1311268, lstFound, _
lblStatus
If lstFound.ListCount > 1 Then
xmount = " files."
Else
xmount = " file."
End If
MsgBox "Scan progress finished, found " & lstFound.ListCount & _
xmount, vbInformation
UpdateStatus
lstFound.Enabled = True
ProcError:
cmdScan.Enabled = True
Me.Caption = MyCaption
End Sub

Private Function RepairFile(MyPath As String, VirSize As Long, _
SignSize As Integer, Backup As Boolean)
Dim all_host As String
Dim buff_hd As String
Dim buff_host As String
Dim hostsize As String
Dim Old As String
WinExit GetFileName(MyPath, True)
SleepEx 1, False
Old = Mid(MyPath, 1, (Len(MyPath) - 4)) & ".bak"
Name MyPath As Old
Open Old For Binary Access Read As #1
hostsize = (LOF(1) - Int(VirSize))
buff_hd = Space(VirSize)
buff_host = Space(hostsize - SignSize)
Get #1, , buff_hd
Get #1, , buff_host
Close #1
Open MyPath For Binary As #2
Put #2, , buff_host
Close #2
If Backup = False Then
Kill Old
End If
End Function

Copy coding dibawah ini dan paste di Editor Module:

Option Explicit

Private Type BrowseInfo
lngHwnd As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem _
As Long)
Private Declare Function lstrcat Lib "Kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi _
As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(ByVal strPrompt As String) As _
String
On Error GoTo ehBrowseForFolder
Dim intNull As Integer
Dim lngIDList As Long, lngResult As Long
Dim strPath As String
Dim udtBI As BrowseInfo
With udtBI
.lngHwnd = 0
.lpszTitle = lstrcat(strPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lngIDList = SHBrowseForFolder(udtBI)
If lngIDList <> 0 Then
strPath = String(MAX_PATH, 0)
lngResult = SHGetPathFromIDList(lngIDList, strPath)
Call CoTaskMemFree(lngIDList)
intNull = InStr(strPath, vbNullChar)
If intNull > 0 Then
strPath = Left(strPath, intNull - 1)
End If
End If
BrowseForFolder = strPath
Exit Function
ehBrowseForFolder:
BrowseForFolder = Empty
End Function

Copy coding dibawah ini dan paste di Editor Module mdlFindFile:

Option Explicit
Global StopIt As Boolean

Public Function FindFiles(MyPath As String, MyWild As String, _
Signature As String, SizeLimit As Long, MyList As ListBox, _
MyLabel As Label)
Dim filename As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
On Error GoTo FileERR
If StopIt = True Then GoTo FileERR
If Len(MyPath) = 0 Then Exit Function
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(MyPath, vbDirectory Or vbHidden)
Do While Len(DirName) > 0
If (DirName <> ".") And (DirName <> "..") Then
If GetAttr(MyPath & DirName) = vbDirectory Or vbHidden Or _
vbReadOnly Or vbSystem Then
dirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
DirName = Dir()
Loop
filename = Dir(MyPath & MyWild, vbNormal Or vbHidden Or _
vbReadOnly)
Do While Len(filename) <> 0
FindFiles = FindFiles + FileLen(MyPath & filename)
MyLabel.Caption = MyPath & filename
DoEvents
If FileLen(MyPath & filename) > SizeLimit Then GoTo limitz
If CheckSign(MyPath & filename, Signature) = _
True Then
MyList.AddItem MyPath & filename
End If
limitz:
filename = Dir()
Loop
If nDir > 0 Then
For i = 0 To nDir - 1
FindFiles = FindFiles + FindFiles(MyPath & dirNames(i) & "\", _
MyWild, Signature, SizeLimit, MyList, MyLabel)
Next i
End If
FileERR:
End Function

Function CheckSign(MyPath As String, StrText As String) As _
Boolean
On Error Resume Next
Dim filedata As String
Open MyPath For Binary Access Read As #2
filedata = Space(FileLen(MyPath))
Get #2, , filedata
If Right(filedata, 4) = StrText Then
CheckSign = True
Else
CheckSign = False
End If
Close #2
End Function

Copy coding dibawah ini dan paste di Editor Module mdlGetName:

Option Explicit

Private Function getRight(Key As String, length As Long) As String
Dim NumChar As Long, i As Long
NumChar = Len(Key)
For i = 1 To length
NumChar = InStrRev(Key, "\", NumChar - 1)
If NumChar = 0 Then Exit For
Next i
getRight = Right$(Key, Len(Key) - NumChar)
End Function

Private Function StrCount(stSource As String, ByVal subST1 As _
String) As Long
Dim pos As Long
Dim iCount As Long
pos = 1
Do
pos = pos + Len(subST1)
pos = InStr(pos, stSource, subST1)
If pos > 0 Then
iCount = iCount + 1
End If
Loop While pos > 0
StrCount = iCount
End Function

Public Function GetFileName(Path As String, Extension As _
Boolean) As String
Dim NumChar As Long
GetFileName = getRight(Path, 1)
If Not Extension Then
NumChar = InStrRev(GetFileName, ".")
If NumChar <> 0 Then
GetFileName = Left(GetFileName, NumChar - 1)
End If
End If
End Function

Copy coding dibawah ini dan paste di Editor Module mdlRegistyAPI:

Type FILETIME
lLowDateTime As Long
lHighDateTime As Long
End Type

Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName _
As String) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _
String, ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As _
Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias _
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
"RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal lpReserved As Long, lpType As _
Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal _
hKey As Long, ByVal lpValueName As String, ByVal _
lpReserved As Long, lpType As Long, ByRef lpData As Long, _
lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal Reserved As Long, ByVal dwType As Long, _
ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal _
hKey As Long, ByVal lpValueName As String, ByVal Reserved _
As Long, ByVal dwType As Long, ByRef lpData As Long, _
ByVal cbData As Long) As Long
Declare Function RegSetValueExB Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal Reserved As Long, ByVal dwType As Long, _
ByRef lpData As Byte, ByVal cbData As Long) As Long
Public Declare Function RegReplaceKey Lib "advapi32.dll" Alias _
"RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, ByVal lpNewFile As String, ByVal lpOldFile As String) _
As Long

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Const ERROR_NO_MORE_ITEMS = 259&
Const ERROR_MORE_DATA = 234&

Const REG_NONE = 0&
Const REG_SZ = 1&
Const REG_EXPAND_SZ = 2&
Const REG_BINARY = 3&
Const REG_DWORD = 4&
Const REG_DWORD_LITTLE_ENDIAN = 4&
Const REG_DWORD_BIG_ENDIAN = 5&
Const REG_LINK = 6&
Const REG_MULTI_SZ = 7&
Const REG_RESOURCE_LIST = 8&
Const REG_FULL_RESOURCE_DESCRIPTOR = 9&
Const REG_RESOURCE_REQUIREMENTS_LIST = 10&

Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS _
Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Const KEY_EXECUTE = KEY_READ

Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Dim lDataSize As Long
Dim ByteArray() As Byte

Const DisplayErrorMsg = False

Function SetDWORDValue(SubKey As String, Entry As String, value As Long)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, _
hKey)
If rtn = ERROR_SUCCESS Then
rtn = RegSetValueExA(hKey, Entry, 0, REG_DWORD, value, 4)
If Not rtn = ERROR_SUCCESS Then
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
rtn = RegCloseKey(hKey)
Else
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Public Function DeleteKeyValue(ByVal sKeyName As String, _
ByVal sValueName As String)
DeleteKeyValue = False
Dim hKey As Long
Call ParseKey(sKeyName, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, sKeyName, 0, _
KEY_WRITE, hKey)
If (rtn = ERROR_SUCCESS) Then
rtn = RegDeleteValue(hKey, sValueName)
If (rtn <> ERROR_SUCCESS) Then
Else
DeleteKeyValue = True
End If
rtn = RegCloseKey(hKey)
End If
End If
End Function

Function GetDWORDValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, _
hKey)
If rtn = ERROR_SUCCESS Then
rtn = RegQueryValueExA(hKey, Entry, 0, REG_DWORD, lBuffer, 4)
If rtn = ERROR_SUCCESS Then
rtn = RegCloseKey(hKey)
GetDWORDValue = lBuffer
Else
GetDWORDValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
Else
GetDWORDValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Function SetBinaryValue(SubKey As String, Entry As String, value _
As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, _
hKey)
If rtn = ERROR_SUCCESS Then
lDataSize = Len(value)
ReDim ByteArray(lDataSize)
For i = 1 To lDataSize
ByteArray(i) = Asc(Mid$(value, i, 1))
Next
rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, _
ByteArray(1), lDataSize)
If Not rtn = ERROR_SUCCESS Then
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
rtn = RegCloseKey(hKey)
Else
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Function GetBinaryValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, _
hKey)
If rtn = ERROR_SUCCESS Then
lBufferSize = 1
rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, 0, _
lBufferSize)
sBuffer = Space(lBufferSize)
rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, sBuffer, _
lBufferSize)
If rtn = ERROR_SUCCESS Then
rtn = RegCloseKey(hKey)
GetBinaryValue = sBuffer
Else
GetBinaryValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
Else
GetBinaryValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Function DeleteKey(Keyname As String)
Call ParseKey(Keyname, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, Keyname, 0, _
KEY_WRITE, hKey)
If rtn = ERROR_SUCCESS Then
rtn = RegDeleteKey(hKey, Keyname)
rtn = RegCloseKey(hKey)
End If
End If
End Function

Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Select Case MainKeyName
Case "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
Case "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
Case "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
Case "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
End Select
End Function

Function ErrorMsg(lErrorCode As Long) As String
Select Case lErrorCode
Case 1009, 1015
GetErrorMsg = "The Registry Database is corrupt!"
Case 2, 1010
GetErrorMsg = "Bad Key Name"
Case 1011
GetErrorMsg = "Can't Open Key"
Case 4, 1012
GetErrorMsg = "Can't Read Key"
Case 5
GetErrorMsg = "Access to this key is denied"
Case 1013
GetErrorMsg = "Can't Write Key"
Case 8, 14
GetErrorMsg = "Out of memory"
Case 87
GetErrorMsg = "Invalid Parameter"
Case 234
GetErrorMsg = "There is more data than the buffer has been " & _
"allocated to hold."
Case Else
GetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)
End Select
End Function

Function GetStringValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, _
hKey)
If rtn = ERROR_SUCCESS Then
sBuffer = Space(255)
lBufferSize = Len(sBuffer)
rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, _
lBufferSize)
If rtn = ERROR_SUCCESS Then
rtn = RegCloseKey(hKey)
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1)
Else
GetStringValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
Else
GetStringValue = "Error"
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Private Sub ParseKey(Keyname As String, Keyhandle As Long)
rtn = InStr(Keyname, "\")
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then
MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname
Exit Sub
ElseIf rtn = 0 Then
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = ""
Else
Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1))
Keyname = Right(Keyname, Len(Keyname) - rtn)
End If
End Sub

Function CreateKey(SubKey As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegCreateKey(MainKeyHandle, SubKey, hKey)
If rtn = ERROR_SUCCESS Then
rtn = RegCloseKey(hKey)
End If
End If
End Function

Function SetStringValue(SubKey As String, Entry As String, value _
As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then
rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, _
hKey)
If rtn = ERROR_SUCCESS Then
rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal value, _
Len(value))
If Not rtn = ERROR_SUCCESS Then
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
rtn = RegCloseKey(hKey)
Else
If DisplayErrorMsg = True Then
MsgBox ErrorMsg(rtn)
End If
End If
End If
End Function

Public Function hex2ascii(ByVal hextext As String) As String
On Error Resume Next
Dim Y As Integer
Dim num As String
Dim value As String
For Y = 1 To Len(hextext)
num = Mid(hextext, Y, 2)
value = value & Chr(Val("&h" & num))
Y = Y + 1
Next Y
hex2ascii = value
End Function

Function SetHexValue(SubKey As String, Entry As String, _
value As String)
SetBinaryValue SubKey, Entry, hex2ascii(value)
End Function

Copy coding dibawah ini dan paste di Editor Module mdlWinExit:

Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" _
(ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal _
hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal _
hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "Kernel32" (ByVal _
hProcess As Long, ByVal uExitCode As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Public Function WinExit(sExeNam As String)
Dim lLng As Long, lA As Long, lExCode As Long
Dim procObj As PROCESSENTRY32
Dim hSnap As Long
Dim lRet As Long
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
procObj.dwSize = Len(procObj)
lRet = Process32First(hSnap, procObj)
Do While Process32Next(hSnap, procObj)
If InStr(1, LCase(procObj.szExeFile), LCase(sExeNam$)) > 0 Then
lLng = OpenProcess(&H1, ByVal 0&, procObj.th32ProcessID)
lA = TerminateProcess(lLng, lExCode)
Exit Do
End If
Loop
End Function

2 komentar:

Faizol Akbar mengatakan...

Om
itu kan disuruh membuat 4 module tapi kode nya itu kok ada 5 mana yang harus dirubah ?

Anonymous mengatakan...

Visit Juga ya Gan ^_^

www.adjiecheaterhacker.blogspot.com