CARA MEMBUAT ANTIVIRUS DENGAN VISUAL BASIC 6
1.Buka Program microsoft visual basic 6.0 -> Standard EXE -> OK Maka Akan Tampil bentuk baru Sesuai gambar di bawah DENGAN, desain bentuk Sesuai keinginan ANDA
Beri Nama bentuk tersebut: frmUtama 2.Setelah bentuk Selesai di rubah namanya Tambahkan komponen Mscomctl.Ocx DENGAN cara klik Project -> Komponen -> Microsoft Windows Kontrol umum 6,0 -> klik OK hari laluContoh seperti gambar di bawah
3.Setelah komponen sukses di Tambahkan Langkah Selanjutnya adalah menambah Command Button, Textbox, ListView, Gambar Kotak
disini Saya menggunakan desain Yang sangat Sederhana, desain Bisa ANDA SENDIRI rubah Sesuai kreatifitas ANDA ^ ^ - Tambahkan ListView kedalam bentuk murah beri Nama lvScan
disini Saya menggunakan desain Yang sangat Sederhana, desain Bisa ANDA SENDIRI rubah Sesuai kreatifitas ANDA ^ ^ - Tambahkan ListView kedalam bentuk murah beri Nama lvScan
Yang Saya lingkari merah adalah ListView Yang Telah di Tambahkan ke Dalam, bentuk. setelah pengaturan ITU DENGAN ListView cara klik di ListView -> Disebelah Kanan bawah ada kotak properti -> Custom hari lalu JAVANIC settingan seperti gambar di bawah PADA ini
Lalu PADA tab Kolom Header klik kolom masukkan
- Kolom 1 beri nama: Nama Virus
- Kolom 2 beri nama: Jalur
- Kolom 3 beri nama: Checksum Virus
- Kolom 4 beri nama: Status Virus
hari lalu klik Ok Tambahkan gambar buat gambar kotak kotak ITU sekecil Ujug murah beri Nama sIcon Pengaturan: Penampilan: Rata Auto Gambar ulang: Benar Gaya Perbatasan: Tidak Terlihat: Salah Tambahkan Textbox ke Dalam, bentuk DENGAN Nama txtPath Pengaturan: Penampilan: Flat Style Border: Tidak ada Command Button Tambahkan DENGAN Nama cmdBrowse di Samping Textbox Yang Telah di buat tadi Pengaturan: Keterangan: ...Masukan Kode ini ke Dalam, cmdBrowse
- Kolom 1 beri nama: Nama Virus
- Kolom 2 beri nama: Jalur
- Kolom 3 beri nama: Checksum Virus
- Kolom 4 beri nama: Status Virus
hari lalu klik Ok Tambahkan gambar buat gambar kotak kotak ITU sekecil Ujug murah beri Nama sIcon Pengaturan: Penampilan: Rata Auto Gambar ulang: Benar Gaya Perbatasan: Tidak Terlihat: Salah Tambahkan Textbox ke Dalam, bentuk DENGAN Nama txtPath Pengaturan: Penampilan: Flat Style Border: Tidak ada Command Button Tambahkan DENGAN Nama cmdBrowse di Samping Textbox Yang Telah di buat tadi Pengaturan: Keterangan: ...Masukan Kode ini ke Dalam, cmdBrowse
Spoiler :
Kode:
Dim As String Pathnya
Pathnya = ""
Pathnya = BrowseFolder ("Pilih folder Yang Akan di Pindai:", Me)
Jika Pathnya <> "" Lalu
txtPath.Text = Pathnya
End If
Dim As String Pathnya
Pathnya = ""
Pathnya = BrowseFolder ("Pilih folder Yang Akan di Pindai:", Me)
Jika Pathnya <> "" Lalu
txtPath.Text = Pathnya
End If
Kode di Atas berfungsi Membuka kotak dialog UNTUK Yang berisi path "Yang ada di Dalam, Komputer hari lalu mencetaknya ke textbox Dalam, Yang Bernama txtPath
Tambahkan label DENGAN Nama standar
Pengaturan:
Keterangan: Dir Scanned
Tambahkan label DENGAN Nama lblDirScan
Pengaturan:
Keterangan: 0
Tambahkan label DENGAN Nama standar
Pengaturan:
Keterangan: Terdeteksi
Tambahkan label DENGAN Nama lblFileDet
Pengaturan:
Keterangan: 0
Tambahkan label DENGAN Nama standar
Pengaturan:
Keterangan: File Scan
Tambahkan label DENGAN Nama lblFileScan
Pengaturan:
Keterangan: 0
Tambahkan Textbox DENGAN Nama txtFileScan
Pengaturan:
Multiline: Benar
Gulir Bar: 2-Vertikal
Tambahkan Command Button DENGAN Nama cmdScan
Pengaturan:
Keterangan: & Scan
Spoiler :
'Kode:
Jika cmdScan.Caption = "Pindai" Lalu
Pathnya = txtPath.Text
Jika Mid (Pathnya, 2, 1) <> ":" Atau Pathnya = "" Lalu
MsgBox "Direktori Tidak Ditemukan", vbCritical, "Error"
Exit Sub
Lain
lvScan.Enabled = False
cmdEnable False, False, False
clear_log
cmdScan.Caption = "Stop"
StopScan = False
FindFilesEx txtPath.Text, CBool (chkSubDir.Value)
MsgBox "Pindai selesai!" & VbNewLine & vbNewLine & "Total Dir discan =" & lblDirScan.Caption & _
"File total scan =" & vbNewLine & lblFileScan.Caption & vbNewLine & "File Terdeteksi Total =" & lblFileDet.Caption, vbInformation, "Finish"
Jika lblFileDet Caption <.> "0" Lalu
cmdEnable Benar, Benar, Benar
Lain
cmdEnable Salah, Salah, Benar
End If
lvScan.Enabled = True
cmdScan.Caption = "Scan"
End If
Lain
cmdScan.Caption = "Scan"
StopScan = True
End If
Jika cmdScan.Caption = "Pindai" Lalu
Pathnya = txtPath.Text
Jika Mid (Pathnya, 2, 1) <> ":" Atau Pathnya = "" Lalu
MsgBox "Direktori Tidak Ditemukan", vbCritical, "Error"
Exit Sub
Lain
lvScan.Enabled = False
cmdEnable False, False, False
clear_log
cmdScan.Caption = "Stop"
StopScan = False
FindFilesEx txtPath.Text, CBool (chkSubDir.Value)
MsgBox "Pindai selesai!" & VbNewLine & vbNewLine & "Total Dir discan =" & lblDirScan.Caption & _
"File total scan =" & vbNewLine & lblFileScan.Caption & vbNewLine & "File Terdeteksi Total =" & lblFileDet.Caption, vbInformation, "Finish"
Jika lblFileDet Caption <.> "0" Lalu
cmdEnable Benar, Benar, Benar
Lain
cmdEnable Salah, Salah, Benar
End If
lvScan.Enabled = True
cmdScan.Caption = "Scan"
End If
Lain
cmdScan.Caption = "Scan"
StopScan = True
End If
Fungsi Kode di Atas adalah UNTUK memulai memindai PADA antivirus
Tambahkan Command Button DENGAN Nama cmdAction
Pengaturan:
Keterangan: & Hapus
Tambahkan Command Button DENGAN Nama cmdAction
Pengaturan:
Keterangan: & Karantina
Tambahkan Command Button DENGAN Nama cmdViewQ
Pengaturan:
Keterangan: & Lihat Karantina Berkas
Tambahkan Command Button DENGAN Nama cmdAction
Pengaturan:
Keterangan: & Hapus
Tambahkan Kode ini di dalamnya
Spoiler :
'Kode:
Dim As String DftrFile
DftrFile = GetSelected (lvScan)
Jika DftrFile = "" Lalu
MsgBox "Tidak Ada File Terdeteksi (s) Terpilih", vbCritical, ""
Exit Sub
End If
Select Case Index
Case 0
bersih = Aksi (DftrFile, lvScan , "D")
MsgBox bersih & "File (s) telah dihapus"
Kasus 1
bersih = Aksi (DftrFile, lvScan, "Q")
MsgBox bersih & "File (s) telah dikarantina"
End Select
Dim As String DftrFile
DftrFile = GetSelected (lvScan)
Jika DftrFile = "" Lalu
MsgBox "Tidak Ada File Terdeteksi (s) Terpilih", vbCritical, ""
Exit Sub
End If
Select Case Index
Case 0
bersih = Aksi (DftrFile, lvScan , "D")
MsgBox bersih & "File (s) telah dihapus"
Kasus 1
bersih = Aksi (DftrFile, lvScan, "Q")
MsgBox bersih & "File (s) telah dikarantina"
End Select
Fungsi Fungsi adalah di Atas UNTUK Menghapus / mengkarantina file yang terdeteksi Yang
Tambahkan Command Button DENGAN Nama cmdAction
Pengaturan:
Keterangan: & Karantina
Tambahkan Command Button DENGAN Nama cmdViewQ
Pengaturan:
Keterangan: & Lihat Karantina Berkas
Lalu Masukan kode ini ke dalamnya
Spoiler :
Me.hide
frmquarantine.show
frmquarantine.show
Kode di Atas berfungsi UNTUK memunculkan bentuk karantina murah diaktifkan meng bentuk Utama nah Selesai UNTUK memasukan kontrol ke formnya Dalam, contoh bentuk Yang Telah Selesai.
PADA hari lalu klik Kanan bentuk Masukan Kode di bawah ini
Spoiler :
/ Kode:
Private Sub lvScan_ItemCheck (Item ByVal Sebagai MSComctlLib.ListItem)
hapuskan tanda lvScan, "Di Karantina"
hapuskan tanda lvScan, "Di Hapus"
End Sub Function Swasta cmdEnable (hapus Sebagai Boolean, Karantina Sebagai Boolean, openQuarantine Sebagai Boolean)cmdAction (0) Diaktifkan =. hapus cmdAction (1). Diaktifkan = Karantina cmdViewQ.Enabled = openQuarantine End Function Function clear_log Swasta () lblDirScan.Caption = 0 lblFileScan.Caption = 0 lblFileDet.Caption = 0 lvScan.ListItems.Clear jumlahDir = 0jumlahFile = 0 jumlahVirus = 0 End Function
Private Sub lvScan_ItemCheck (Item ByVal Sebagai MSComctlLib.ListItem)
hapuskan tanda lvScan, "Di Karantina"
hapuskan tanda lvScan, "Di Hapus"
End Sub Function Swasta cmdEnable (hapus Sebagai Boolean, Karantina Sebagai Boolean, openQuarantine Sebagai Boolean)cmdAction (0) Diaktifkan =. hapus cmdAction (1). Diaktifkan = Karantina cmdViewQ.Enabled = openQuarantine End Function Function clear_log Swasta () lblDirScan.Caption = 0 lblFileScan.Caption = 0 lblFileDet.Caption = 0 lvScan.ListItems.Clear jumlahDir = 0jumlahFile = 0 jumlahVirus = 0 End Function
hari lalu di Form_Load () Masukan Kode ini
Spoiler :
'Kode:
On Error Resume Next
mkdir "Karantina"
BuildDatabase
On Error Resume Next
mkdir "Karantina"
BuildDatabase
Lalu buatlah 1 modul DENGAN Nama modAPI
Lalu Tambahkan kode di bawah ini
Spoiler :
'Kode:
Public Declare Function Lib FindFirstFile "kernel32" Alias "FindFirstFileA" (ByVal As String lpFileName, lpFindFileData Sebagai WIN32_FIND_DATA) As Long
Public Declare Function Lib FindNextFile "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData Sebagai WIN32_FIND_DATA) Sebagai Panjang
Umum Declare Function Lib FindClose "kernel32" (ByVal hFindFile As Long) As Long
Declare Publik Fungsi PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Public Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal As String lpExistingFileName, lpNewFileName ByVal As String, ByVal As Long bFailIfExists) As Long
Declare Publik Fungsi MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal As String lpExistingFileName, lpNewFileName ByVal As String) As Long
Public Declare Fungsi DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Declare Publik PathFileExists Fungsi Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Public Declare Function Lib GetSystemDirectory "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal As Long nUkuran) As Long
Public Declare Function Lib GetWindowsDirectory "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal As Long nUkuran) As Long
Declare SHGetPathFromIDList Lib Publik Fungsi " shell32.dll "Alias" SHGetPathFromIDListA "(ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function Lib SHBrowseForFolder "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo Sebagai BROWSEINFO) As Long
Declare Function RealizePalette Pribadi Lib "gdi32" (ByVal hdc As Long) As Long
Declare Publik Fungsi CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal As String lpFileName, dwDesiredAccess ByVal As Long, ByVal As Long dwShareMode, lpSecurityAttributes Sebagai Any, ByVal As Long dwCreationDisposition, dwFlagsAndAttributes ByVal As Long, hTemplateFile ByVal As Long) As Long
Public Declare Function Lib CloseHandle "kernel32" (ByVal hObject As Long) As Long
Public Declare Function Lib GetFileSize "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Declare Function VirtualAlloc Lib "kernel32 "(lpAddress Seperti apapun, ByVal dwSize As Long, ByVal As Long flAllocationType, flProtect ByVal As Long) As Long
Public Declare Function Lib ReadFile "kernel32" (ByVal hFile As Long, lpBuffer Sebagai Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped Sebagai Setiap) As Long
Public Declare Function Lib WriteFile "kernel32" (ByVal hFile As Long, lpBuffer Sebagai Any, ByVal As Long nNumberOfBytesToWrite, lpNumberOfBytesWritten As Long, lpOverlapped Sebagai Setiap) As Long
Public Declare Function Lib SetFilePointer "kernel32" (ByVal hFile As Long, lDistanceToMove ByVal As Long, lpDistanceToMoveHigh As Long, dwMoveMethod ByVal As Long) As Long
Public Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long GENERIC_READ Const Publik = & H80000000 Public Const GENERIC_WRITE = & H40000000 Public Const FILE_SHARE_READ = & H1 Const Publik OPEN_EXISTING = 3 Public Const FILE_ATTRIBUTE_NORMAL = & H80 Public Const INVALID_HANDLE_VALUE = -1 Public Const FILE_END = 2 Public Const FILE_BEGIN = 0 Public Const FILE_CURRENT = 1 Const Publik LWA_COLORKEY = & H1 Public Const GWL_EXSTYLE = (-20) Const Publik WS_EX_LAYERED = & H80000Public const MAX_PATH = 260 Public Const SW_SHOWNORMAL = 1 Tipe FileTime Publik dwLowDateTime As Long As Long dwHighDateTimeAkhir Tipe Tipe WIN32_FIND_DATA Publik dwFileAttributes As LongftCreationTime Sebagai FileTime ftLastAccessTime Sebagai FileTimeftLastWriteTime Sebagai FileTime nFileSizeHigh As Long As Long nFileSizeLow dwReserved0 As Long As Long dwReserved1 cFileName As String * MAX_PATH cAlternate As String * 14 End Type Tipe BROWSEINFO hOwner As Long As Long pidlRoot pszDisplayName As String As String lpszTitle ulFlags As Long As Long lpfn lParam As Long As Long iImage End Type 'folder browsing UNTUK BrowseFolder Public Function (aTitle ByVal As String, ByVal aForm Sebagai Form) As String Dim bInfo BROWSEINFO & Dim RTN, pidl &, jalan $, pos% Dim BrowsePath As String = bInfo.hOwner aForm.hWndbInfo.lpszTitle = aTitle bInfo.ulFlags = & H1 pidl & = SHBrowseForFolder (bInfo) path = Ruang (512) t = SHGetPathFromIDList (ByVal pidl &, jalan ByVal) pos% = InStr (path $, Chr $ (0)) BrowseFolder = Left (path $, pos - 1) Jika Hak $ (People, 1) = "\ "Lalu BrowseFolder = BrowseFolder LainBrowseFolder = BrowseFolder + "\" End If Jika Kanan (BrowseFolder, 2) = "\ \" Lalu BrowseFolder = Kiri (BrowseFolder, Len (BrowseFolder) - 1) Jika BrowseFolder = "\ BrowseFolder" Lalu = "" End Function Public Function StripNulls (OriginalStr ByVal As String) As String Jika (InStr (OriginalStr, Chr $ (0))> 0) Kemudian OriginalStr = Left $ (OriginalStr, InStr (OriginalStr, Chr (0)) - 1) End If StripNulls = OriginalStr End Function'Fungsi UNTUK menentukan file script atau Bukan Publik Fungsi IsScript (Filename As String) Sebagai Boolean = False IsScriptext = split ("| vbs | VBE", "|") Untuk i = 1 Untuk UBound ( ext)Jika lcase (Kanan (Filename, 3)) = lcase (ext (i)) Kemudian IsScript = True Berikutnya End Function
Public Declare Function Lib FindFirstFile "kernel32" Alias "FindFirstFileA" (ByVal As String lpFileName, lpFindFileData Sebagai WIN32_FIND_DATA) As Long
Public Declare Function Lib FindNextFile "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData Sebagai WIN32_FIND_DATA) Sebagai Panjang
Umum Declare Function Lib FindClose "kernel32" (ByVal hFindFile As Long) As Long
Declare Publik Fungsi PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Public Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal As String lpExistingFileName, lpNewFileName ByVal As String, ByVal As Long bFailIfExists) As Long
Declare Publik Fungsi MoveFile Lib "kernel32.dll" Alias "MoveFileA" (ByVal As String lpExistingFileName, lpNewFileName ByVal As String) As Long
Public Declare Fungsi DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Declare Publik PathFileExists Fungsi Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Public Declare Function Lib GetSystemDirectory "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal As Long nUkuran) As Long
Public Declare Function Lib GetWindowsDirectory "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal As Long nUkuran) As Long
Declare SHGetPathFromIDList Lib Publik Fungsi " shell32.dll "Alias" SHGetPathFromIDListA "(ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function Lib SHBrowseForFolder "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo Sebagai BROWSEINFO) As Long
Declare Function RealizePalette Pribadi Lib "gdi32" (ByVal hdc As Long) As Long
Declare Publik Fungsi CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal As String lpFileName, dwDesiredAccess ByVal As Long, ByVal As Long dwShareMode, lpSecurityAttributes Sebagai Any, ByVal As Long dwCreationDisposition, dwFlagsAndAttributes ByVal As Long, hTemplateFile ByVal As Long) As Long
Public Declare Function Lib CloseHandle "kernel32" (ByVal hObject As Long) As Long
Public Declare Function Lib GetFileSize "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Declare Function VirtualAlloc Lib "kernel32 "(lpAddress Seperti apapun, ByVal dwSize As Long, ByVal As Long flAllocationType, flProtect ByVal As Long) As Long
Public Declare Function Lib ReadFile "kernel32" (ByVal hFile As Long, lpBuffer Sebagai Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped Sebagai Setiap) As Long
Public Declare Function Lib WriteFile "kernel32" (ByVal hFile As Long, lpBuffer Sebagai Any, ByVal As Long nNumberOfBytesToWrite, lpNumberOfBytesWritten As Long, lpOverlapped Sebagai Setiap) As Long
Public Declare Function Lib SetFilePointer "kernel32" (ByVal hFile As Long, lDistanceToMove ByVal As Long, lpDistanceToMoveHigh As Long, dwMoveMethod ByVal As Long) As Long
Public Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long GENERIC_READ Const Publik = & H80000000 Public Const GENERIC_WRITE = & H40000000 Public Const FILE_SHARE_READ = & H1 Const Publik OPEN_EXISTING = 3 Public Const FILE_ATTRIBUTE_NORMAL = & H80 Public Const INVALID_HANDLE_VALUE = -1 Public Const FILE_END = 2 Public Const FILE_BEGIN = 0 Public Const FILE_CURRENT = 1 Const Publik LWA_COLORKEY = & H1 Public Const GWL_EXSTYLE = (-20) Const Publik WS_EX_LAYERED = & H80000Public const MAX_PATH = 260 Public Const SW_SHOWNORMAL = 1 Tipe FileTime Publik dwLowDateTime As Long As Long dwHighDateTimeAkhir Tipe Tipe WIN32_FIND_DATA Publik dwFileAttributes As LongftCreationTime Sebagai FileTime ftLastAccessTime Sebagai FileTimeftLastWriteTime Sebagai FileTime nFileSizeHigh As Long As Long nFileSizeLow dwReserved0 As Long As Long dwReserved1 cFileName As String * MAX_PATH cAlternate As String * 14 End Type Tipe BROWSEINFO hOwner As Long As Long pidlRoot pszDisplayName As String As String lpszTitle ulFlags As Long As Long lpfn lParam As Long As Long iImage End Type 'folder browsing UNTUK BrowseFolder Public Function (aTitle ByVal As String, ByVal aForm Sebagai Form) As String Dim bInfo BROWSEINFO & Dim RTN, pidl &, jalan $, pos% Dim BrowsePath As String = bInfo.hOwner aForm.hWndbInfo.lpszTitle = aTitle bInfo.ulFlags = & H1 pidl & = SHBrowseForFolder (bInfo) path = Ruang (512) t = SHGetPathFromIDList (ByVal pidl &, jalan ByVal) pos% = InStr (path $, Chr $ (0)) BrowseFolder = Left (path $, pos - 1) Jika Hak $ (People, 1) = "\ "Lalu BrowseFolder = BrowseFolder LainBrowseFolder = BrowseFolder + "\" End If Jika Kanan (BrowseFolder, 2) = "\ \" Lalu BrowseFolder = Kiri (BrowseFolder, Len (BrowseFolder) - 1) Jika BrowseFolder = "\ BrowseFolder" Lalu = "" End Function Public Function StripNulls (OriginalStr ByVal As String) As String Jika (InStr (OriginalStr, Chr $ (0))> 0) Kemudian OriginalStr = Left $ (OriginalStr, InStr (OriginalStr, Chr (0)) - 1) End If StripNulls = OriginalStr End Function'Fungsi UNTUK menentukan file script atau Bukan Publik Fungsi IsScript (Filename As String) Sebagai Boolean = False IsScriptext = split ("| vbs | VBE", "|") Untuk i = 1 Untuk UBound ( ext)Jika lcase (Kanan (Filename, 3)) = lcase (ext (i)) Kemudian IsScript = True Berikutnya End Function
Kode di Atas Fungsi API adalah Yang di butuhkan UNTUK antivirus
Buat 1 modul DENGAN Nama modChecksum
Masukan kode di bawah ini.
Spoiler :
'Kode:
Fungsi GetChecksum Umum (FilePath As String) As String
Dim CheckSum (1 Untuk 2) As String
CheckSum (1) = CalcBinary (FilePath, 499, 4500)
CheckSum (2) = CalcBinary (FilePath, 499, 4000)
GetChecksum = CheckSum (1) & CheckSum (2)
End Function
Fungsi CalcBinary Publik (lpFileName ByVal As String, ByVal lpByteCount As Long, ByVal StartByte Opsional As Long = 0) As String
On Error GoTo err
Dim Bin () As Byte
Dim As Long ByteSum
Dim i As Long
ReDim Bin (lpByteCount) As Byte
lpFileName Terbuka Untuk Biner Sebagai # 1
Jika StartByte = 0 Then
Dapatkan # 1,, Bin
Lain
Dapatkan # 1, StartByte, Bin
End If
Close # 1
Untuk i = 0 Untuk lpByteCount
ByteSum = ByteSum + Bin (i) ^ 2
Next i
CalcBinary = Hex $ (ByteSum)
Fungsi Keluar
err:
CalcBinary = "00"
End Function
Fungsi GetChecksum Umum (FilePath As String) As String
Dim CheckSum (1 Untuk 2) As String
CheckSum (1) = CalcBinary (FilePath, 499, 4500)
CheckSum (2) = CalcBinary (FilePath, 499, 4000)
GetChecksum = CheckSum (1) & CheckSum (2)
End Function
Fungsi CalcBinary Publik (lpFileName ByVal As String, ByVal lpByteCount As Long, ByVal StartByte Opsional As Long = 0) As String
On Error GoTo err
Dim Bin () As Byte
Dim As Long ByteSum
Dim i As Long
ReDim Bin (lpByteCount) As Byte
lpFileName Terbuka Untuk Biner Sebagai # 1
Jika StartByte = 0 Then
Dapatkan # 1,, Bin
Lain
Dapatkan # 1, StartByte, Bin
End If
Close # 1
Untuk i = 0 Untuk lpByteCount
ByteSum = ByteSum + Bin (i) ^ 2
Next i
CalcBinary = Hex $ (ByteSum)
Fungsi Keluar
err:
CalcBinary = "00"
End Function
potongan kode di Atas di gunakan UNTUK meng kalkulasi checksum
buat 1 modul lagi DENGAN Nama modDatabase
Tambahkan kode di hari lalu bawah ini.
Spoiler :
'Kode:
Publik VirusDB (5), IconDB (48), Bahaya (5) As String
Sub BuildDatabase Publik ()
Panggil Checksum_DB
IconCompare_DB Panggilan
Panggilan Script_DB
End Sub
Private Sub Checksum_DB ()
VirusDB (1) = "Alman.A | 8911D290F723"
VirusDB (2) = "Malingsi.A | A6292EA60230"
VirusDB (3) = "Conficker.A | 9EC112ABB2F3"
VirusDB (4) = "N4B3.A | B5CCD36CDB98"
VirusDB (5) = "N4B3.B | A1FE6D6DBE07"
End Sub
Public Sub IconCompare_DB ()
On Error Resume Next
IconDB (1) = "20938B2"
IconDB (2) = "19F4ED6"
IconDB (3) = "133BE0B"
IconDB (4) = "18EDEAE"
IconDB (5) = "1EF89C2"
IconDB (6) = "1C915FF"
IconDB (7) = "24563C4"
IconDB (8) = "1B2DB74"
IconDB (9) = "208EA72"
IconDB (10) = "22A064D"
IconDB (11) = "19B64EE"
IconDB (12 ) = "1D4B7E1"
IconDB (13) = "2087762"
IconDB (14) = "29C7258"
IconDB (15) = "1B18705"
IconDB (16) = "1B5FCAB"
IconDB (17) = "126D4CF"
IconDB (18) = "1C58E5C"
IconDB (19) = "15D7730"
IconDB (20) = "1FB82B7"
IconDB (21) = "112763E"
IconDB (22) = "2165AF9"
IconDB (23) = "25F46BE"
IconDB (24) = "206556B "
IconDB (25) = "22A8D69"
IconDB (26) = "19237F8"
IconDB (27) = "15022B4"
IconDB (28) = "1D8B4EB"
IconDB (29) = "1DBC1EA"
IconDB (30) = "2333F5D"
IconDB (31) = "1F37C2F"
IconDB (32) = "1C9CCA4"
IconDB (33) = "1DFDFB4"
IconDB (34) = "1C1283E"
IconDB (35) = "1F6598C"
IconDB (36) = "27F4C1A"
IconDB (37 ) = "22F92E0"
IconDB (38) = "191DBDC"
IconDB (39) = "27BFE4A"
IconDB (40) = "20E0907"
IconDB (46) = "2FA4C88"
IconDB (47) = "25AA630"
IconDB (48) = "1DE28E2"
End Sub
Public Sub Script_DB ()
On Error Resume Next
Bahaya (1) = "Scripting.FileSystemObject | Wscript.ScriptFullName | WScript.Shell |. regwrite |. salin"
Bahaya (2) = "Wscript.ScriptFullName | CreateObject | strreverse |. regwrite "
Bahaya (3) = "CreateObject | Wscript.ScriptFullName | regwrite |. [autorun]"
Bahaya (4) = "CreateObject | Wscript.ScriptFullName | specialfolder |. regwrite"
Bahaya (5) = "chr (asc (pertengahan (| CreateObject | Wscript.ScriptFullName |. GetFolder |. RegWrite "
End Sub
Publik VirusDB (5), IconDB (48), Bahaya (5) As String
Sub BuildDatabase Publik ()
Panggil Checksum_DB
IconCompare_DB Panggilan
Panggilan Script_DB
End Sub
Private Sub Checksum_DB ()
VirusDB (1) = "Alman.A | 8911D290F723"
VirusDB (2) = "Malingsi.A | A6292EA60230"
VirusDB (3) = "Conficker.A | 9EC112ABB2F3"
VirusDB (4) = "N4B3.A | B5CCD36CDB98"
VirusDB (5) = "N4B3.B | A1FE6D6DBE07"
End Sub
Public Sub IconCompare_DB ()
On Error Resume Next
IconDB (1) = "20938B2"
IconDB (2) = "19F4ED6"
IconDB (3) = "133BE0B"
IconDB (4) = "18EDEAE"
IconDB (5) = "1EF89C2"
IconDB (6) = "1C915FF"
IconDB (7) = "24563C4"
IconDB (8) = "1B2DB74"
IconDB (9) = "208EA72"
IconDB (10) = "22A064D"
IconDB (11) = "19B64EE"
IconDB (12 ) = "1D4B7E1"
IconDB (13) = "2087762"
IconDB (14) = "29C7258"
IconDB (15) = "1B18705"
IconDB (16) = "1B5FCAB"
IconDB (17) = "126D4CF"
IconDB (18) = "1C58E5C"
IconDB (19) = "15D7730"
IconDB (20) = "1FB82B7"
IconDB (21) = "112763E"
IconDB (22) = "2165AF9"
IconDB (23) = "25F46BE"
IconDB (24) = "206556B "
IconDB (25) = "22A8D69"
IconDB (26) = "19237F8"
IconDB (27) = "15022B4"
IconDB (28) = "1D8B4EB"
IconDB (29) = "1DBC1EA"
IconDB (30) = "2333F5D"
IconDB (31) = "1F37C2F"
IconDB (32) = "1C9CCA4"
IconDB (33) = "1DFDFB4"
IconDB (34) = "1C1283E"
IconDB (35) = "1F6598C"
IconDB (36) = "27F4C1A"
IconDB (37 ) = "22F92E0"
IconDB (38) = "191DBDC"
IconDB (39) = "27BFE4A"
IconDB (40) = "20E0907"
IconDB (46) = "2FA4C88"
IconDB (47) = "25AA630"
IconDB (48) = "1DE28E2"
End Sub
Public Sub Script_DB ()
On Error Resume Next
Bahaya (1) = "Scripting.FileSystemObject | Wscript.ScriptFullName | WScript.Shell |. regwrite |. salin"
Bahaya (2) = "Wscript.ScriptFullName | CreateObject | strreverse |. regwrite "
Bahaya (3) = "CreateObject | Wscript.ScriptFullName | regwrite |. [autorun]"
Bahaya (4) = "CreateObject | Wscript.ScriptFullName | specialfolder |. regwrite"
Bahaya (5) = "chr (asc (pertengahan (| CreateObject | Wscript.ScriptFullName |. GetFolder |. RegWrite "
End Sub
potongan kode di Atas adalah database yang PADA antivirusnya
buat lagi 1 buah modul DENGAN Nama modQuar
Masukan kode di bawah Yang ada ini
Spoiler :
Kode:
Option Explicit
Public Function EncodeFile (SourceFile As String, DestFile As String)
Dim ByteArray () As Byte, Filenr As Integer
= FreeFile Filenr
Buka SourceFile Untuk Biner Sebagai # Filenr
ReDim ByteArray (0 Untuk LOF (Filenr) - 1)
Dapatkan # Filenr,, ByteArray ()
Close # Filenr
Panggil Coder (ByteArray ())
Jika (PathFileExists (DestFile)) <> 0 Then DeleteFile DestFile
Terbuka Untuk Biner Sebagai DestFile # Filenr
Masukan # Filenr,, ByteArray ()
Close # Filenr
End Function
Public Fungsi DecodeFile (SourceFile As String, DestFile As String)
Dim ByteArray () As Byte, Filenr As Integer
= FreeFile Filenr
SourceFile Terbuka Untuk Biner Sebagai # Filenr
ReDim ByteArray (0 Untuk LOF (Filenr) - 1)
Dapatkan # Filenr,, ByteArray ( )
Tutup # Filenr
Panggil Decoder (ByteArray ())
Jika (PathFileExists (DestFile)) <> 0 Then DeleteFile DestFile Terbuka Untuk Biner Sebagai DestFile # Filenr
Masukan # Filenr,, ByteArray ()
Close # Filenr
End Function
Private Sub Coder (ByteArray ( ) As Byte)
Dim x As Long
Dim Nilai As Integer
Nilai = 0
Untuk x = 0 Untuk UBound (ByteArray)
Nilai = Nilai + ByteArray (x)
Jika Nilai> 255 Kemudian Nilai = Nilai - 256
ByteArray (x) = Nilai
Berikutnya
Akhir Sub
Private Sub Decoder (ByteArray () As Byte)
Dim x As Long
Dim Nilai As Integer
Dim As Integer newValue
newValue = 0
Untuk x = 0 Untuk UBound (ByteArray)
Nilai = newValue
newValue = ByteArray (x)
Nilai = ByteArray (x) - Nilai
Jika Value <0 Then Nilai = Nilai + 256 ByteArray (x) = Nilai End Sub Selanjutnya
Kode di Atas adalah kode UNTUK enkripsi / dekripsi PADA Virus Yang Akan di Karantina
Buat lagi 1 modul DENGAN Nama modHeuristic
Masukan kode hari lalu di bawah ini
Spoiler :
'Kode:
Swasta Declare Function Lib ExtractIconEx "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, ByRef phiconLarge As Long, ByRef phiconSmall As Long, ByVal As Long nIcons) As Long
Declare Function Swasta DestroyIcon Lib "user32.dll" (ByVal hicon As Long) As Long
Declare Function Pribadi DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal As Long xLeft, ByVal yTop As Long, ByVal As Long hicon, cxWidth ByVal As Long, ByVal Sebagai cyWidth panjang, istepIfAniCur ByVal As Long, ByVal hbrFlickerFreeDraw As Long, ByVal As Long diFlags) Sebagai Boolean
Swasta Declare Function Lib ExtractIcon "shell32.dll" Alias "ExtractIconA" (ByVal As Long hInst, lpszExefileName ByVal As String, ByVal nIconIndex As Long) Sebagai Panjang
DI_MASK Const Pribadi = & H1
Pribadi Const DI_IMAGE = & H2
Pribadi Const DI_NORMAL = & H3
Pribadi Const DI_COMPAT = & H4
Pribadi Const DI_DEFAULTSIZE = & H8
Pribadi Const SHGFI_DISPLAYNAME = & H200
Pribadi Const SHGFI_EXETYPE = & H2000
Const Pribadi SHGFI_SYSICONINDEX = & H4000
Pribadi Const SHGFI_LARGEICON = & H0
Pribadi Const SHGFI_SMALLICON = & H1
Swasta Const ILD_TRANSPARENT = & H1
Pribadi Const SHGFI_SHELLICONSIZE = & H4
Pribadi Const SHGFI_TYPENAME = & H400
BASIC_SHGFI_FLAGS Const Pribadi = SHGFI_TYPENAME Atau SHGFI_SHELLICONSIZE Atau SHGFI_SYSICONINDEX Atau SHGFI_DISPLAYNAME Atau SHGFI_EXETYPE
SIconInfo Swasta Seperti SHFILEINFO
SectionHeaders Swasta () Sebagai IMAGE_SECTION_HEADER
Dim i As Integer
j Dim As Integer
CekHeuristic Public Function (Filename As String)
CekHeuristic = ""
On Error GoTo hError
Dim hFile As Long, BRW As Long
Dim DOSheader IMAGE_DOS_HEADER
NTHeaders Dim IMAGE_NT_HEADERS
As String Dim Filedata
DOS_HEADER_INFO = ""
NT_HEADERS_INFO = ""
hFile = CreateFile (Filename, ByVal (GENERIC_READ Atau GENERIC_WRITE), FILE_SHARE_READ, ByVal 0 &, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0)
ReadFile hFile, DOSheader, Len (DOSheader), BRW, ByVal 0 &
SetFilePointer hFile, DOSheader.e_lfanew, 0, 0
ReadFile hFile, NTHeaders, Len (NTHeaders), BRW, ByVal 0 &
Jika NTHeaders.Signature <> IMAGE_NT_SIGNATURE Kemudian
Jika IsScript (Filename) = Benar Kemudian
Filename Terbuka Untuk Biner Sebagai # 1
Filedata = Ruang $ (LOF (1))
Dapatkan # 1,, Filedata
Close # 1
CekHeuristic = CekHeur ( Filedata)
End If
Keluar Fungsi
End If
CekHeuristic = CekIconBinary (Filename)
hError:
End Function
Fungsi CekHeur Swasta (Data As String)
Dim HSL, dpl As Integer
strasli = lcase (Ganti (Data, vbNewLine, "$"))
Untuk i = 1 Untuk UBound (Bahaya)
HSL = 0
strData = Split (Bahaya (i), "|")
dpl = 0
Untuk k = 0 Untuk UBound (strData)
xxx = lcase (strData (k))
Jika InStr (strasli, xxx) > 0 Then HSL HSL + 1 =
dpl = dpl + 1
Berikutnya
Jika HSL = dpl Kemudian
CekHeur = "berbahaya-Script"
Keluar Fungsi
End If
Berikutnya
CekHeur = ""
End Function
Fungsi CekIconBinary Swasta (PathFile As String)
Dim q As Integer
Dim IconIDNow As String
CekIconBinary = ""
IconIDNow = CalcIcon (PathFile)
Jika IconIDNow = "" Kemudian Keluar Fungsi
Untuk q = 1 Untuk UBound (IconDB)
Jika IconDB (q) = IconIDNow Kemudian
CekIconBinary = "berbahaya Icon"
Keluar Fungsi
End If
Berikutnya q
End Function
Fungsi Swasta CalcBinary (lpFileName ByVal As String, ByVal lpByteCount As Long, ByVal StartByte Opsional As Long = 0) As String
Dim Bin () As Byte
Dim As Long ByteSum
Dim i As Long
ReDim Bin (lpByteCount) As Byte
lpFileName Terbuka Untuk Biner Sebagai # 1
Jika StartByte = 0 Then
Dapatkan # 1,, Bin
Lain
Dapatkan # 1, StartByte, Bin
End If
Close # 1
Untuk i = 0 Untuk lpByteCount
ByteSum = ByteSum + Bin (i) ^ 2
Next i
CalcBinary = Hex $ (ByteSum)
End Function
Fungsi CalcIcon Swasta (lpFileName ByVal As String) As String
PicPath Dim As String
ByteSum Dim As String
IconExist Dim As Long
hicon Dim As Long
IconExist = ExtractIconEx (lpFileName, 0, ByVal 0 &, hicon, 1)
Jika IconExist <= 0 Then IconExist = ExtractIconEx (lpFileName, 0, hicon, ByVal 0 &, 1) Jika IconExist <= 0 Kemudian Keluar End Function Jika frmUtama.sIcon.BackColor = vbWhite DrawIconEx frmUtama.sIcon.hDC, 0, 0, hicon, 0 , 0, 0, 0, DI_NORMAL DestroyIcon hicon PicPath = Lingkungan $ ("windir") & "\ tmp.tmp" SavePicture frmUtama.sIcon.Image, PicPath ByteSum = CalcBinary (PicPath, FileLen (PicPath)) DeleteFile PicPath CalcIcon = ByteSum End Function
Swasta Declare Function Lib ExtractIconEx "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, ByRef phiconLarge As Long, ByRef phiconSmall As Long, ByVal As Long nIcons) As Long
Declare Function Swasta DestroyIcon Lib "user32.dll" (ByVal hicon As Long) As Long
Declare Function Pribadi DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal As Long xLeft, ByVal yTop As Long, ByVal As Long hicon, cxWidth ByVal As Long, ByVal Sebagai cyWidth panjang, istepIfAniCur ByVal As Long, ByVal hbrFlickerFreeDraw As Long, ByVal As Long diFlags) Sebagai Boolean
Swasta Declare Function Lib ExtractIcon "shell32.dll" Alias "ExtractIconA" (ByVal As Long hInst, lpszExefileName ByVal As String, ByVal nIconIndex As Long) Sebagai Panjang
DI_MASK Const Pribadi = & H1
Pribadi Const DI_IMAGE = & H2
Pribadi Const DI_NORMAL = & H3
Pribadi Const DI_COMPAT = & H4
Pribadi Const DI_DEFAULTSIZE = & H8
Pribadi Const SHGFI_DISPLAYNAME = & H200
Pribadi Const SHGFI_EXETYPE = & H2000
Const Pribadi SHGFI_SYSICONINDEX = & H4000
Pribadi Const SHGFI_LARGEICON = & H0
Pribadi Const SHGFI_SMALLICON = & H1
Swasta Const ILD_TRANSPARENT = & H1
Pribadi Const SHGFI_SHELLICONSIZE = & H4
Pribadi Const SHGFI_TYPENAME = & H400
BASIC_SHGFI_FLAGS Const Pribadi = SHGFI_TYPENAME Atau SHGFI_SHELLICONSIZE Atau SHGFI_SYSICONINDEX Atau SHGFI_DISPLAYNAME Atau SHGFI_EXETYPE
SIconInfo Swasta Seperti SHFILEINFO
SectionHeaders Swasta () Sebagai IMAGE_SECTION_HEADER
Dim i As Integer
j Dim As Integer
CekHeuristic Public Function (Filename As String)
CekHeuristic = ""
On Error GoTo hError
Dim hFile As Long, BRW As Long
Dim DOSheader IMAGE_DOS_HEADER
NTHeaders Dim IMAGE_NT_HEADERS
As String Dim Filedata
DOS_HEADER_INFO = ""
NT_HEADERS_INFO = ""
hFile = CreateFile (Filename, ByVal (GENERIC_READ Atau GENERIC_WRITE), FILE_SHARE_READ, ByVal 0 &, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0)
ReadFile hFile, DOSheader, Len (DOSheader), BRW, ByVal 0 &
SetFilePointer hFile, DOSheader.e_lfanew, 0, 0
ReadFile hFile, NTHeaders, Len (NTHeaders), BRW, ByVal 0 &
Jika NTHeaders.Signature <> IMAGE_NT_SIGNATURE Kemudian
Jika IsScript (Filename) = Benar Kemudian
Filename Terbuka Untuk Biner Sebagai # 1
Filedata = Ruang $ (LOF (1))
Dapatkan # 1,, Filedata
Close # 1
CekHeuristic = CekHeur ( Filedata)
End If
Keluar Fungsi
End If
CekHeuristic = CekIconBinary (Filename)
hError:
End Function
Fungsi CekHeur Swasta (Data As String)
Dim HSL, dpl As Integer
strasli = lcase (Ganti (Data, vbNewLine, "$"))
Untuk i = 1 Untuk UBound (Bahaya)
HSL = 0
strData = Split (Bahaya (i), "|")
dpl = 0
Untuk k = 0 Untuk UBound (strData)
xxx = lcase (strData (k))
Jika InStr (strasli, xxx) > 0 Then HSL HSL + 1 =
dpl = dpl + 1
Berikutnya
Jika HSL = dpl Kemudian
CekHeur = "berbahaya-Script"
Keluar Fungsi
End If
Berikutnya
CekHeur = ""
End Function
Fungsi CekIconBinary Swasta (PathFile As String)
Dim q As Integer
Dim IconIDNow As String
CekIconBinary = ""
IconIDNow = CalcIcon (PathFile)
Jika IconIDNow = "" Kemudian Keluar Fungsi
Untuk q = 1 Untuk UBound (IconDB)
Jika IconDB (q) = IconIDNow Kemudian
CekIconBinary = "berbahaya Icon"
Keluar Fungsi
End If
Berikutnya q
End Function
Fungsi Swasta CalcBinary (lpFileName ByVal As String, ByVal lpByteCount As Long, ByVal StartByte Opsional As Long = 0) As String
Dim Bin () As Byte
Dim As Long ByteSum
Dim i As Long
ReDim Bin (lpByteCount) As Byte
lpFileName Terbuka Untuk Biner Sebagai # 1
Jika StartByte = 0 Then
Dapatkan # 1,, Bin
Lain
Dapatkan # 1, StartByte, Bin
End If
Close # 1
Untuk i = 0 Untuk lpByteCount
ByteSum = ByteSum + Bin (i) ^ 2
Next i
CalcBinary = Hex $ (ByteSum)
End Function
Fungsi CalcIcon Swasta (lpFileName ByVal As String) As String
PicPath Dim As String
ByteSum Dim As String
IconExist Dim As Long
hicon Dim As Long
IconExist = ExtractIconEx (lpFileName, 0, ByVal 0 &, hicon, 1)
Jika IconExist <= 0 Then IconExist = ExtractIconEx (lpFileName, 0, hicon, ByVal 0 &, 1) Jika IconExist <= 0 Kemudian Keluar End Function Jika frmUtama.sIcon.BackColor = vbWhite DrawIconEx frmUtama.sIcon.hDC, 0, 0, hicon, 0 , 0, 0, 0, DI_NORMAL DestroyIcon hicon PicPath = Lingkungan $ ("windir") & "\ tmp.tmp" SavePicture frmUtama.sIcon.Image, PicPath ByteSum = CalcBinary (PicPath, FileLen (PicPath)) DeleteFile PicPath CalcIcon = ByteSum End Function
Fungsi di Atas Fungsi adalah suatu file yang mengecek UNTUK DENGAN METODE heuristik ikon + heuristik virus VBS UNTUK
Buat 1 modul DENGAN Nama modIconCompare
Masukan kode hari lalu di bawah ini
Spoiler :
'Kode:
Option Explicit
Swasta Const SHGFI_DISPLAYNAME = & H200, SHGFI_EXETYPE = & H2000, SHGFI_SYSICONINDEX = & H4000, SHGFI_LARGEICON = & H0, SHGFI_SMALLICON = & H1, SHGFI_SHELLICONSIZE = & H4, SHGFI_TYPENAME = & H400, ILD_TRANSPARENT = & H1, BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Atau SHGFI_SHELLICONSIZE Atau SHGFI_SYSICONINDEX Atau SHGFI_DISPLAYNAME Atau SHGFI_EXETYPE
Tipe Publik SHFILEINFO
hicon As Long: iIcon As Long: dwAttributes As Long: szDisplayName As String * MAX_PATH: szTypeName As String * 80
End Type
Declare Function Pribadi SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi Sebagai SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal As Long uFlags) As Long
Declare Function Pribadi ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal As Long hdcDest, ByVal x As Long, ByVal y As Long, ByVal flag As Long) As Long
shinfo Swasta Seperti SHFILEINFO, sshinfo Sebagai SHFILEINFO
Pribadi Declare Function Lib DrawIconEx "user32.dll" (ByVal hdc As Long, ByVal As Long xLeft, yTop ByVal As Long, ByVal As Long hicon , ByVal cxWidth As Long, ByVal As Long cyWidth, istepIfAniCur ByVal As Long, ByVal hbrFlickerFreeDraw As Long, ByVal As Long diFlags) As Long
SIconInfo Swasta Seperti SHFILEINFO Publik Enum IconRetrievericnLarge = 32 ricnSmall = 16 End Enum Public Sub RetrieveIcon (fname As String , DC Sebagai PictureBox, icnSize Sebagai IconRetrieve) Dim hImgSmall, hImgLarge As Long Debug.Print fnameKasus Pilih icnSize Kasus ricnSmall hImgSmall = SHGetFileInfo (fname $, 0 &, shinfo, Len (shinfo), BASIC_SHGFI_FLAGS Atau SHGFI_SMALLICON) Panggil ImageList_Draw (hImgSmall, shinfo iIcon,. DC.hDC, 0, 0, ILD_TRANSPARENT) Kasus ricnLarge hImgLarge & = SHGetFileInfo (fname $, 0 &, shinfo, Len (shinfo), BASIC_SHGFI_FLAGS Atau SHGFI_LARGEICON) Panggil ImageList_Draw (hImgLarge, shinfo.iIcon, DC.hDC, 0, 0, ILD_TRANSPARENT) End Select End Sub Public Function ExtractIcon (Filename As String, AddtoImageList Sebagai Imagelist, PictureBox Sebagai PictureBox, PixelsXY Sebagai IconRetrieve, o IKEY As String) As Long As Long Dim SmallIcon NewImage Dim ListImage IconIndex Dim As Integer On Error GoTo Load_New_Icon Jika o IKEY <> "Aplikasi" Dan o IKEY <> "Shortcut" Lalu ExtractIcon = AddtoImageList.ListImages (* o IKEY) Indeks. Keluar Fungsi End If Load_New_Icon: On Error GoTo Reset_Key RetrieveIcon Filename, PictureBox, PixelsXY IconIndex = AddtoImageList.ListImages.Count + 1 Set NewImage = AddtoImageList.ListImages.Add (IconIndex, o IKEY, PictureBox.Image) ExtractIcon = IconIndex Keluar FungsiReset_Key: o IKEY = "" Lanjutkan End Function Public Sub GetLargeIcon (icPath $, pDisp Sebagai PictureBox) Dim hImgLrg &: hImgLrg = SHGetFileInfo (icPath $, 0 &, SIconInfo, Len (SIconInfo), BASIC_SHGFI_FLAGS Atau SHGFI_LARGEICON)ImageList_Draw hImgLrg, SIconInfo.iIcon, pDisp.hDC, 0, 0, ILD_TRANSPARENT End Sub
Option Explicit
Swasta Const SHGFI_DISPLAYNAME = & H200, SHGFI_EXETYPE = & H2000, SHGFI_SYSICONINDEX = & H4000, SHGFI_LARGEICON = & H0, SHGFI_SMALLICON = & H1, SHGFI_SHELLICONSIZE = & H4, SHGFI_TYPENAME = & H400, ILD_TRANSPARENT = & H1, BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Atau SHGFI_SHELLICONSIZE Atau SHGFI_SYSICONINDEX Atau SHGFI_DISPLAYNAME Atau SHGFI_EXETYPE
Tipe Publik SHFILEINFO
hicon As Long: iIcon As Long: dwAttributes As Long: szDisplayName As String * MAX_PATH: szTypeName As String * 80
End Type
Declare Function Pribadi SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi Sebagai SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal As Long uFlags) As Long
Declare Function Pribadi ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal As Long hdcDest, ByVal x As Long, ByVal y As Long, ByVal flag As Long) As Long
shinfo Swasta Seperti SHFILEINFO, sshinfo Sebagai SHFILEINFO
Pribadi Declare Function Lib DrawIconEx "user32.dll" (ByVal hdc As Long, ByVal As Long xLeft, yTop ByVal As Long, ByVal As Long hicon , ByVal cxWidth As Long, ByVal As Long cyWidth, istepIfAniCur ByVal As Long, ByVal hbrFlickerFreeDraw As Long, ByVal As Long diFlags) As Long
SIconInfo Swasta Seperti SHFILEINFO Publik Enum IconRetrievericnLarge = 32 ricnSmall = 16 End Enum Public Sub RetrieveIcon (fname As String , DC Sebagai PictureBox, icnSize Sebagai IconRetrieve) Dim hImgSmall, hImgLarge As Long Debug.Print fnameKasus Pilih icnSize Kasus ricnSmall hImgSmall = SHGetFileInfo (fname $, 0 &, shinfo, Len (shinfo), BASIC_SHGFI_FLAGS Atau SHGFI_SMALLICON) Panggil ImageList_Draw (hImgSmall, shinfo iIcon,. DC.hDC, 0, 0, ILD_TRANSPARENT) Kasus ricnLarge hImgLarge & = SHGetFileInfo (fname $, 0 &, shinfo, Len (shinfo), BASIC_SHGFI_FLAGS Atau SHGFI_LARGEICON) Panggil ImageList_Draw (hImgLarge, shinfo.iIcon, DC.hDC, 0, 0, ILD_TRANSPARENT) End Select End Sub Public Function ExtractIcon (Filename As String, AddtoImageList Sebagai Imagelist, PictureBox Sebagai PictureBox, PixelsXY Sebagai IconRetrieve, o IKEY As String) As Long As Long Dim SmallIcon NewImage Dim ListImage IconIndex Dim As Integer On Error GoTo Load_New_Icon Jika o IKEY <> "Aplikasi" Dan o IKEY <> "Shortcut" Lalu ExtractIcon = AddtoImageList.ListImages (* o IKEY) Indeks. Keluar Fungsi End If Load_New_Icon: On Error GoTo Reset_Key RetrieveIcon Filename, PictureBox, PixelsXY IconIndex = AddtoImageList.ListImages.Count + 1 Set NewImage = AddtoImageList.ListImages.Add (IconIndex, o IKEY, PictureBox.Image) ExtractIcon = IconIndex Keluar FungsiReset_Key: o IKEY = "" Lanjutkan End Function Public Sub GetLargeIcon (icPath $, pDisp Sebagai PictureBox) Dim hImgLrg &: hImgLrg = SHGetFileInfo (icPath $, 0 &, SIconInfo, Len (SIconInfo), BASIC_SHGFI_FLAGS Atau SHGFI_LARGEICON)ImageList_Draw hImgLrg, SIconInfo.iIcon, pDisp.hDC, 0, 0, ILD_TRANSPARENT End Sub
Kode di Atas di butuhkan UNTUK METODE heuristik antivirus PADA ikon
Buat 1 modul DENGAN Nama modLV
Masukan kode hari lalu di bawah ini
Spoiler :
'Kode:
GetSelected Public Function (TheLV Sebagai ListView)
Dim Sel As String
Untuk i = 1 Untuk TheLV.ListItems.Count
Jika TheLV.ListItems.Item (i) Checked = Benar Kemudian.
Sel = Sel & "|" & TheLV.ListItems Item (i).. subitems (1)
End If
Berikutnya
GetSelected = Sel
End Function Public Function SelectedAll (TheLV Sebagai ListView)Untuk i = 1 Untuk TheLV.ListItems.Count TheLV.ListItems.Item (i) Benar Checked. = Berikutnya Akhir Fungsi Fungsi Publik SelectedNone (TheLV Sebagai ListView) Untuk i = 1 Untuk TheLV.ListItems.Count TheLV.ListItems.Item (i) Checked = False.Berikutnya End Function Public Function GetIndex (TheLV Sebagai ListView, data As String) As Integer For i = 1 Untuk TheLV.ListItems.Count Jika TheLV.ListItems.Item (i) subitems (1). = data Kemudian GetIndex = i End If Berikutnya End FunctionPublic Function batalkan (TheLV Sebagai ListView, data As String)Untuk i = 1 Untuk TheLV.ListItems.Count Jika TheLV.ListItems.Item (i) subitems (3). = data Kemudian TheLV.ListItems.Item (i) = Checked. False End If Berikutnya End Function Public Function AddDetect (TheLV Sebagai ListView, FilePath As String , VirData As String) Dengan TheLV Jika Kiri (VirData, 9) <> "berbahaya" Lalu Set lvItm =. ListItems.Add (,, Split (VirData, "|")( 0),, frmUtama.ImgSmall.ListImages (1 ). Index) lvItm.SubItems (1) = FilePath lvItm.SubItems (2) = Split (VirData, "|")( 1)lvItm.SubItems (3) = "File Virus" Lain Set lvItm =. ListItems.Add ( ,, VirData,, frmUtama.ImgSmall.ListImages (1). Index)lvItm.SubItems (1) = FilePath lvItm.SubItems (2) = GetChecksum (FilePath) lvItm.SubItems (3) = "Virus File" End If End With End Function
GetSelected Public Function (TheLV Sebagai ListView)
Dim Sel As String
Untuk i = 1 Untuk TheLV.ListItems.Count
Jika TheLV.ListItems.Item (i) Checked = Benar Kemudian.
Sel = Sel & "|" & TheLV.ListItems Item (i).. subitems (1)
End If
Berikutnya
GetSelected = Sel
End Function Public Function SelectedAll (TheLV Sebagai ListView)Untuk i = 1 Untuk TheLV.ListItems.Count TheLV.ListItems.Item (i) Benar Checked. = Berikutnya Akhir Fungsi Fungsi Publik SelectedNone (TheLV Sebagai ListView) Untuk i = 1 Untuk TheLV.ListItems.Count TheLV.ListItems.Item (i) Checked = False.Berikutnya End Function Public Function GetIndex (TheLV Sebagai ListView, data As String) As Integer For i = 1 Untuk TheLV.ListItems.Count Jika TheLV.ListItems.Item (i) subitems (1). = data Kemudian GetIndex = i End If Berikutnya End FunctionPublic Function batalkan (TheLV Sebagai ListView, data As String)Untuk i = 1 Untuk TheLV.ListItems.Count Jika TheLV.ListItems.Item (i) subitems (3). = data Kemudian TheLV.ListItems.Item (i) = Checked. False End If Berikutnya End Function Public Function AddDetect (TheLV Sebagai ListView, FilePath As String , VirData As String) Dengan TheLV Jika Kiri (VirData, 9) <> "berbahaya" Lalu Set lvItm =. ListItems.Add (,, Split (VirData, "|")( 0),, frmUtama.ImgSmall.ListImages (1 ). Index) lvItm.SubItems (1) = FilePath lvItm.SubItems (2) = Split (VirData, "|")( 1)lvItm.SubItems (3) = "File Virus" Lain Set lvItm =. ListItems.Add ( ,, VirData,, frmUtama.ImgSmall.ListImages (1). Index)lvItm.SubItems (1) = FilePath lvItm.SubItems (2) = GetChecksum (FilePath) lvItm.SubItems (3) = "Virus File" End If End With End Function
Kode di Atas Berguna UNTUK dengatur PADA SAAT ListView virus terdeteksi
Buat 1 modul DENGAN Nama modPE
Masukan kode hari lalu di bawah ini
Spoiler :
'Kode:
Ketik IMAGE_DOS_HEADER Publik
e_magic As Integer
e_cblp As Integer
e_cp As Integer
e_crlc As Integer
e_cparhdr As Integer
e_minalloc As Integer
e_maxalloc As Integer
e_ss As Integer
e_sp As Integer
e_csum As Integer
e_ip As Integer
e_cs As Integer
e_lfarlc As Integer
e_ovno As Integer
e_res ( 1 Untuk 4) As Integer
e_oemid As Integer
e_oeminfo As Integer
e_res2 (1 To 10) As Integer
e_lfanew As Long
End Type Public Type IMAGE_SECTION_HEADER nameSec As String * 6PhisicalAddress As Integer VirtualSize As Long As Long VirtualAddress SizeOfRawData As Long As Long PointerToRawDataPointerToRelocations Sebagai Panjang PointerToLinenumbers As LongAs Integer NumberOfRelocations NumberOfLinenumbers As IntegerKarakteristik As Long End Type Public Type IMAGE_DATA_DIRECTORYVirtualAddress As Long As Long ukuran Akhir Tipe Tipe Publik IMAGE_OPTIONAL_HEADER Sihir As Integer MajorLinkerVersion As ByteMinorLinkerVersion As Byte SizeOfCode As Long As Long SizeOfInitializedData SizeOfUninitializedData As Long As Long AddressOfEntryPoint BaseOfCode As Long As Long BaseOfDataImageBase As Long As Long SectionAlignment FileAlignment As LongAs Integer MajorOperatingSystemVersionMinorOperatingSystemVersion As Integer MajorImageVersion As Integer MinorImageVersion As Integer MajorSubsystemVersion As Integer MinorSubsystemVersion As Integer Win32VersionValue As Long As Long SizeOfImage SizeOfHeaders As Long As Long CheckSumSubsystem As Integer DllCharacteristics Sebagai IntegerSizeOfStackReserve As Long As Long SizeOfStackCommitSizeOfHeapReserve As Long As Long SizeOfHeapCommit LoaderFlags As Long As Long NumberOfRvaAndSizes DataDirectory (0 Untuk 15) Sebagai IMAGE_DATA_DIRECTORY Akhir Tipe Tipe Publik IMAGE_FILE_HEADER Mesin As Integer NumberOfSections As IntegerTimeDateStamp As Long As Long PointerToSymbolTableNumberOfSymbols As Long As Integer SizeOfOptionalHeaderKarakteristik As Integer Tipe Akhir Tipe Publik IMAGE_NT_HEADERSTanda tangan As Long FileHeader Sebagai IMAGE_FILE_HEADEROptionalHeader Sebagai IMAGE_OPTIONAL_HEADER Tipe AkhirIMAGE_EXPORT_DIRECTORY Tipe Publik Karakteristik As Long As Long TimeDateStamp MajorVersion As Integer MinorVersion As IntegerNama As Long As Long Basis NumberOfFunctions As Long As Long NumberOfNames AddressOfFunctions As Long AddressOfNames As LongAddressOfNameOrdinals As Long End Type Tipe Publik IMAGE_IMPORT_DESCRIPTOR OriginalFirstThunk As Long TimeDateStamp As Long ForwarderChain As Long Nama As Long FirstThunk As LongEnd Type Tipe Publik IMAGE_IMPORT_BY_NAME Petunjuk As IntegerNama As String * 255 End Type Public Const IMAGE_SIZEOF_SECTION_HEADER = 40 Public Const IMAGE_DOS_SIGNATURE = & H5A4D Public Const IMAGE_NT_SIGNATURE = & H4550 Public Const IMAGE_ORDINAL_FLAG = & H80000000 Public Enum SECTION_CHARACTERISTICS IMAGE_SCN_LNK_NRELOC_OVFL = & H1000000 'Bagian berisi relokasi diperpanjang. IMAGE_SCN_MEM_DISCARDABLE = & H2000000 'Bagian dapat dibuang. IMAGE_SCN_MEM_NOT_CACHED = & H4000000 'Bagian tidak cachable. IMAGE_SCN_MEM_NOT_PAGED = & H8000000 'Bagian tidak pageable. IMAGE_SCN_MEM_SHARED = & H10000000 'Bagian yang dapat dibagikan. IMAGE_SCN_MEM_EXECUTE = & H20000000 'Bagian dijalankan. IMAGE_SCN_MEM_READ = & H40000000 'Bagian dapat dibaca. IMAGE_SCN_MEM_WRITE = & H80000000 'Bagian yang ditulisi. Akhir Enum Public Enum IMAGE_DIRECTORYIMAGE_DIRECTORY_ENTRY_EXPORT = 0 'Ekspor DirektoriIMAGE_DIRECTORY_ENTRY_IMPORT = 1 'Impor DirektoriIMAGE_DIRECTORY_ENTRY_RESOURCE = 2 'Sumber Daya DirektoriIMAGE_DIRECTORY_ENTRY_EXCEPTION = 3 'Eksepsi DirektoriIMAGE_DIRECTORY_ENTRY_SECURITY = 4 'Keamanan DirektoriIMAGE_DIRECTORY_ENTRY_BASERELOC = 5 'Basis Relokasi TabelIMAGE_DIRECTORY_ENTRY_DEBUG = 6 'Direktori DebugIMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7 'Arsitektur Tertentu dataIMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8 'RVA GPIMAGE_DIRECTORY_ENTRY_TLS = 9 'TLS DirektoriIMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10 'Load Konfigurasi Direktori IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11 'Direktori Impor Bound di header IMAGE_DIRECTORY_ENTRY_IAT = 12 'Impor Alamat Tabel IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13 'Penundaan Beban Impor Deskriptor IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR COM = 14 'Runtime deskriptor End Enum
Ketik IMAGE_DOS_HEADER Publik
e_magic As Integer
e_cblp As Integer
e_cp As Integer
e_crlc As Integer
e_cparhdr As Integer
e_minalloc As Integer
e_maxalloc As Integer
e_ss As Integer
e_sp As Integer
e_csum As Integer
e_ip As Integer
e_cs As Integer
e_lfarlc As Integer
e_ovno As Integer
e_res ( 1 Untuk 4) As Integer
e_oemid As Integer
e_oeminfo As Integer
e_res2 (1 To 10) As Integer
e_lfanew As Long
End Type Public Type IMAGE_SECTION_HEADER nameSec As String * 6PhisicalAddress As Integer VirtualSize As Long As Long VirtualAddress SizeOfRawData As Long As Long PointerToRawDataPointerToRelocations Sebagai Panjang PointerToLinenumbers As LongAs Integer NumberOfRelocations NumberOfLinenumbers As IntegerKarakteristik As Long End Type Public Type IMAGE_DATA_DIRECTORYVirtualAddress As Long As Long ukuran Akhir Tipe Tipe Publik IMAGE_OPTIONAL_HEADER Sihir As Integer MajorLinkerVersion As ByteMinorLinkerVersion As Byte SizeOfCode As Long As Long SizeOfInitializedData SizeOfUninitializedData As Long As Long AddressOfEntryPoint BaseOfCode As Long As Long BaseOfDataImageBase As Long As Long SectionAlignment FileAlignment As LongAs Integer MajorOperatingSystemVersionMinorOperatingSystemVersion As Integer MajorImageVersion As Integer MinorImageVersion As Integer MajorSubsystemVersion As Integer MinorSubsystemVersion As Integer Win32VersionValue As Long As Long SizeOfImage SizeOfHeaders As Long As Long CheckSumSubsystem As Integer DllCharacteristics Sebagai IntegerSizeOfStackReserve As Long As Long SizeOfStackCommitSizeOfHeapReserve As Long As Long SizeOfHeapCommit LoaderFlags As Long As Long NumberOfRvaAndSizes DataDirectory (0 Untuk 15) Sebagai IMAGE_DATA_DIRECTORY Akhir Tipe Tipe Publik IMAGE_FILE_HEADER Mesin As Integer NumberOfSections As IntegerTimeDateStamp As Long As Long PointerToSymbolTableNumberOfSymbols As Long As Integer SizeOfOptionalHeaderKarakteristik As Integer Tipe Akhir Tipe Publik IMAGE_NT_HEADERSTanda tangan As Long FileHeader Sebagai IMAGE_FILE_HEADEROptionalHeader Sebagai IMAGE_OPTIONAL_HEADER Tipe AkhirIMAGE_EXPORT_DIRECTORY Tipe Publik Karakteristik As Long As Long TimeDateStamp MajorVersion As Integer MinorVersion As IntegerNama As Long As Long Basis NumberOfFunctions As Long As Long NumberOfNames AddressOfFunctions As Long AddressOfNames As LongAddressOfNameOrdinals As Long End Type Tipe Publik IMAGE_IMPORT_DESCRIPTOR OriginalFirstThunk As Long TimeDateStamp As Long ForwarderChain As Long Nama As Long FirstThunk As LongEnd Type Tipe Publik IMAGE_IMPORT_BY_NAME Petunjuk As IntegerNama As String * 255 End Type Public Const IMAGE_SIZEOF_SECTION_HEADER = 40 Public Const IMAGE_DOS_SIGNATURE = & H5A4D Public Const IMAGE_NT_SIGNATURE = & H4550 Public Const IMAGE_ORDINAL_FLAG = & H80000000 Public Enum SECTION_CHARACTERISTICS IMAGE_SCN_LNK_NRELOC_OVFL = & H1000000 'Bagian berisi relokasi diperpanjang. IMAGE_SCN_MEM_DISCARDABLE = & H2000000 'Bagian dapat dibuang. IMAGE_SCN_MEM_NOT_CACHED = & H4000000 'Bagian tidak cachable. IMAGE_SCN_MEM_NOT_PAGED = & H8000000 'Bagian tidak pageable. IMAGE_SCN_MEM_SHARED = & H10000000 'Bagian yang dapat dibagikan. IMAGE_SCN_MEM_EXECUTE = & H20000000 'Bagian dijalankan. IMAGE_SCN_MEM_READ = & H40000000 'Bagian dapat dibaca. IMAGE_SCN_MEM_WRITE = & H80000000 'Bagian yang ditulisi. Akhir Enum Public Enum IMAGE_DIRECTORYIMAGE_DIRECTORY_ENTRY_EXPORT = 0 'Ekspor DirektoriIMAGE_DIRECTORY_ENTRY_IMPORT = 1 'Impor DirektoriIMAGE_DIRECTORY_ENTRY_RESOURCE = 2 'Sumber Daya DirektoriIMAGE_DIRECTORY_ENTRY_EXCEPTION = 3 'Eksepsi DirektoriIMAGE_DIRECTORY_ENTRY_SECURITY = 4 'Keamanan DirektoriIMAGE_DIRECTORY_ENTRY_BASERELOC = 5 'Basis Relokasi TabelIMAGE_DIRECTORY_ENTRY_DEBUG = 6 'Direktori DebugIMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7 'Arsitektur Tertentu dataIMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8 'RVA GPIMAGE_DIRECTORY_ENTRY_TLS = 9 'TLS DirektoriIMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10 'Load Konfigurasi Direktori IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11 'Direktori Impor Bound di header IMAGE_DIRECTORY_ENTRY_IAT = 12 'Impor Alamat Tabel IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13 'Penundaan Beban Impor Deskriptor IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR COM = 14 'Runtime deskriptor End Enum
Kode di Atas berfungsi PE HEADER UNTUK pengecekan
buat 1 modul DENGAN Nama modScanning
Tambahkan kode di hari lalu bawah ini
Spoiler :
'Kode:
jumlahDir Publik As Long, jumlahFile As Long, jumlahVirus As Long
StopScan Publik Sebagai Boolean Public Function CekVirus (FilePath As String) As String CekVirus = "" Untuk i = 1 Untuk UBound (VirusDB) GetChecksum Jika Split (FilePath) = ( VirusDB (i), "|")( 1) Kemudian CekVirus = VirusDB (i) Keluar Fungsi End If Berikutnya Jika FileLen (FilePath) / 1024 <= 512 Kemudian CekVirus = CekHeuristic (FilePath) End If End Sub Public Function FindFilesEx (ByVal lpFolderName As String, ByVal subdirs Sebagai Boolean) Dim i Sebagai hSearch Dim Panjang As Long, WFD Sebagai Hasil As Long Dim WIN32_FIND_DATA, CurItem As String Dim tempDir () As String, dirCount Sebagai realpath Long As String Dim, GetViri As String GetViri = " "dirCount = -1 ScanInfo =" File Scan "Jika Benar $ (lpFolderName, 1) =" \ "Lalu realpath = lpFolderName Lain realpath = lpFolderName &" \ "End If hSearch = FindFirstFile (realpath &" * ", WFD) Jika Tidak hSearch = INVALID_HANDLE_VALUE Lalu Result = True Apakah Sementara DoEvents Hasil Jika StopScan = Benar Kemudian Keluar Apakah CurItem = StripNulls (WFD.cFileName) Jika Tidak CurItem = "." Dan Tidak CurItem = ".." Kemudian Jika PathIsDirectory (realpath & CurItem) <> 0 Then jumlahDir = jumlahDir + 1 frmUtama.lblDirScan.Caption = jumlahDir Jika subdirs = Benar Kemudian dirCount = dirCount + 1ReDim Preserve tempDir (dirCount) As String tempDir (dirCount) = realpath & CurItem End If Lain jumlahFile = jumlahFile + 1frmUtama.lblFileScan.Caption = jumlahFilefrmUtama.txtFileScan.Text = realpath & CurItemfrmUtama.txtFileScan.SelStart = Len (frmUtama.txtFileScan.Text)Jika WFD.nFileSizeLow> 5120 Atau WFD.nFileSizeHigh> 5120 KemudianGetViri = CekVirus (realpath & CurItem) Jika GetViri <> "" LaluAddDetect frmUtama.lvScan, realpath & CurItem, GetVirijumlahVirus = jumlahVirus + 1 frmUtama.lblFileDet.Caption = jumlahVirus End If End If End If End If Hasil = FindNextFile ( hSearch, WFD) loop FindClose hSearch Jika subdirs = Benar Kemudian Jika dirCount <> -1 Then Untuk i = 0 Untuk dirCountFindFilesEx tempDir (i), True Next i End If End If End If End Sub
jumlahDir Publik As Long, jumlahFile As Long, jumlahVirus As Long
StopScan Publik Sebagai Boolean Public Function CekVirus (FilePath As String) As String CekVirus = "" Untuk i = 1 Untuk UBound (VirusDB) GetChecksum Jika Split (FilePath) = ( VirusDB (i), "|")( 1) Kemudian CekVirus = VirusDB (i) Keluar Fungsi End If Berikutnya Jika FileLen (FilePath) / 1024 <= 512 Kemudian CekVirus = CekHeuristic (FilePath) End If End Sub Public Function FindFilesEx (ByVal lpFolderName As String, ByVal subdirs Sebagai Boolean) Dim i Sebagai hSearch Dim Panjang As Long, WFD Sebagai Hasil As Long Dim WIN32_FIND_DATA, CurItem As String Dim tempDir () As String, dirCount Sebagai realpath Long As String Dim, GetViri As String GetViri = " "dirCount = -1 ScanInfo =" File Scan "Jika Benar $ (lpFolderName, 1) =" \ "Lalu realpath = lpFolderName Lain realpath = lpFolderName &" \ "End If hSearch = FindFirstFile (realpath &" * ", WFD) Jika Tidak hSearch = INVALID_HANDLE_VALUE Lalu Result = True Apakah Sementara DoEvents Hasil Jika StopScan = Benar Kemudian Keluar Apakah CurItem = StripNulls (WFD.cFileName) Jika Tidak CurItem = "." Dan Tidak CurItem = ".." Kemudian Jika PathIsDirectory (realpath & CurItem) <> 0 Then jumlahDir = jumlahDir + 1 frmUtama.lblDirScan.Caption = jumlahDir Jika subdirs = Benar Kemudian dirCount = dirCount + 1ReDim Preserve tempDir (dirCount) As String tempDir (dirCount) = realpath & CurItem End If Lain jumlahFile = jumlahFile + 1frmUtama.lblFileScan.Caption = jumlahFilefrmUtama.txtFileScan.Text = realpath & CurItemfrmUtama.txtFileScan.SelStart = Len (frmUtama.txtFileScan.Text)Jika WFD.nFileSizeLow> 5120 Atau WFD.nFileSizeHigh> 5120 KemudianGetViri = CekVirus (realpath & CurItem) Jika GetViri <> "" LaluAddDetect frmUtama.lvScan, realpath & CurItem, GetVirijumlahVirus = jumlahVirus + 1 frmUtama.lblFileDet.Caption = jumlahVirus End If End If End If End If Hasil = FindNextFile ( hSearch, WFD) loop FindClose hSearch Jika subdirs = Benar Kemudian Jika dirCount <> -1 Then Untuk i = 0 Untuk dirCountFindFilesEx tempDir (i), True Next i End If End If End If End Sub
Kode di Atas adalah kode UNTUK memindai file & folder PADA antivirus
buat 1 modul DENGAN Nama modEtc
Masukan kode di bawah ini
Spoiler :
'Kode:
Fungsi Aksi Masyarakat (Data As String, TheLV Sebagai ListView, Mode As String)
Dim Filedata () As String
Dim fname, tmp, Status As String
Dim y As Integer
= Filedata split (Data, "|")
Untuk i = 1 Untuk UBound (Filedata)
a = a + 1
Jika Mode = "Q" Lalu
fname = GetFileName (Filedata (i))
EncodeFile Filedata (i), AppPath & "\ Karantina" & Left $ (fname, Len (fname) - len (GetExt (Filedata (i)))) & "avq."
AddQList TheLV, Filedata (i), Kiri $ (fname, Len (fname) - Len (GetExt (Filedata (i)))) & ". avq"
DeleteFile Filedata (i)
Status = "Di Karantina"
ElseIf Mode = "D" Lalu
DeleteFile Filedata (i)
Status = "Di Hapus"
End If
y = GetIndex (TheLV, Filedata (i))
Dengan TheLV.ListItems.Item (y )
. subitems (3) = Status
Checked =. Salah
. SmallIcon = frmUtama.ImgSmall.ListImages (2). Indeks
Akhir Dengan
Berikutnya
Action = a
End Function Fungsi Umum AddQList (TheLV Sebagai ListView, FilePath As String, Source As String) Dim Dat As String = Dat AppPath & "Karantina \ HN.dat" Jika PathFileExists (Dat) <> 0 Then Dat Terbuka Untuk Input Seperti # 1 input # 1, isi Tutup # 1DeleteFile Dat Lain isi = "" End If namavir = TheLV ListItems (GetIndex (TheLV, FilePath)). Jika InStrRev (isi, Source,, vbTextCompare) = 0 Kemudian Dat Terbuka Untuk Output Seperti # 2Print # 2, isi & "|" "?" & namavir & & FilePath & "?" & SumberTutup # 2 Lain Dat Terbuka Untuk Output Sebagai # 3 Print # 3, isi Tutup # 3 End If End Function Function GetFileName Publik (PathFile As String) As String Dim i As Long Dim As Long DirString Untuk i = 1 Untuk Len ( PathFile) Jika Mid $ (PathFile, i, 1) = "\" Lalu DirString = i Next i GetFileName = Kanan $ (PathFile, Len (PathFile) - DirString) End Function Fungsi GetExt Publik (lpFileName ByVal As String) Dim Stemp String Dim i As Long Stemp = GetFileName (lpFileName) Jika InStr (lpFileName, ".") Lalu Untuk i = 0 Untuk Len (Stemp) - 1 Jika Mid $ (Stemp, Len (Stemp) - i, 1) = ". " Kemudian GetExt = Mid $ (Stemp, Len (Stemp) - i, i) Keluar Fungsi End If Next i End If End Function
Fungsi Aksi Masyarakat (Data As String, TheLV Sebagai ListView, Mode As String)
Dim Filedata () As String
Dim fname, tmp, Status As String
Dim y As Integer
= Filedata split (Data, "|")
Untuk i = 1 Untuk UBound (Filedata)
a = a + 1
Jika Mode = "Q" Lalu
fname = GetFileName (Filedata (i))
EncodeFile Filedata (i), AppPath & "\ Karantina" & Left $ (fname, Len (fname) - len (GetExt (Filedata (i)))) & "avq."
AddQList TheLV, Filedata (i), Kiri $ (fname, Len (fname) - Len (GetExt (Filedata (i)))) & ". avq"
DeleteFile Filedata (i)
Status = "Di Karantina"
ElseIf Mode = "D" Lalu
DeleteFile Filedata (i)
Status = "Di Hapus"
End If
y = GetIndex (TheLV, Filedata (i))
Dengan TheLV.ListItems.Item (y )
. subitems (3) = Status
Checked =. Salah
. SmallIcon = frmUtama.ImgSmall.ListImages (2). Indeks
Akhir Dengan
Berikutnya
Action = a
End Function Fungsi Umum AddQList (TheLV Sebagai ListView, FilePath As String, Source As String) Dim Dat As String = Dat AppPath & "Karantina \ HN.dat" Jika PathFileExists (Dat) <> 0 Then Dat Terbuka Untuk Input Seperti # 1 input # 1, isi Tutup # 1DeleteFile Dat Lain isi = "" End If namavir = TheLV ListItems (GetIndex (TheLV, FilePath)). Jika InStrRev (isi, Source,, vbTextCompare) = 0 Kemudian Dat Terbuka Untuk Output Seperti # 2Print # 2, isi & "|" "?" & namavir & & FilePath & "?" & SumberTutup # 2 Lain Dat Terbuka Untuk Output Sebagai # 3 Print # 3, isi Tutup # 3 End If End Function Function GetFileName Publik (PathFile As String) As String Dim i As Long Dim As Long DirString Untuk i = 1 Untuk Len ( PathFile) Jika Mid $ (PathFile, i, 1) = "\" Lalu DirString = i Next i GetFileName = Kanan $ (PathFile, Len (PathFile) - DirString) End Function Fungsi GetExt Publik (lpFileName ByVal As String) Dim Stemp String Dim i As Long Stemp = GetFileName (lpFileName) Jika InStr (lpFileName, ".") Lalu Untuk i = 0 Untuk Len (Stemp) - 1 Jika Mid $ (Stemp, Len (Stemp) - i, 1) = ". " Kemudian GetExt = Mid $ (Stemp, Len (Stemp) - i, i) Keluar Fungsi End If Next i End If End Function
Kode di Atas adalah kumpulan Fungsi dll UNTUK pemindaian, Karantina, menghapus
Ini adalah antivirus Tampilan setelah di berikan modul
SEKARANG Tinggal cara mem buat bentuk quarantinenya,
caranya adalah sebagai berikut PADA gambar berikut
![](https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEh8kazhvqSz8UzFhr6a430yJCyh3EkNi-51jW5ey-XQJ96VrlG7sBffS2O9nKo-2rE825AVYgHY0mIYTqCf3E9Y-yxRf0AY5_Cbo8FHzU5dQaA8uPvUuLofGQlhW2eNv9GAib_pLc8RTyUZ/s400/from2.bmp)
setelah bentuk baru Sudah di buat, hari lalu rubah menjadi frmQuarantine Nama formnya
Tambah 1 buah ListView DENGAN LVQ Nama
pengaturan hari lalu ListView tersebut Sesuai gambar di bawah DENGAN ini, cara setting ListView Sudah tertera diatas.
Tambahkan 3 buah tombol Command DENGAN Nama
- cmdDelete
- cmdRestore
- cmdRestore (1)
Tambahkan kode di bawah ini ke Dalam, Komando [cmdDelete]
Spoiler :
'Kode:
Jika lvQ.ListItems.Count = 0 Then Exit Sub
Dim data () As String
Jika PathFileExists (Dat) <> 0 Then
Dat Terbuka Untuk Input Seperti # 1
input # 1, isi
Tutup # 1
DeleteFile Dat
Lain
isi = " "
End If
data = Split (isi, "|")
Untuk i = 1 Untuk UBound (Data)
namafile = lvQ.SelectedItem.SubItems (2)
Jika namafile <> split (Data (i), "?")( 1) Kemudian
NYU = NYU & "|" & Data (i)
End If
Berikutnya
DeleteFile AppPath & "Karantina \" & lvQ.SelectedItem.SubItems (1)
Buka Dat Untuk Output Seperti # 2
Print # 2, NYU
Tutup # 2
MsgBox "Sukses Menghapus Berkas !!!", vbInformation, ""
UpdateQ
Jika lvQ.ListItems.Count = 0 Then Exit Sub
Dim data () As String
Jika PathFileExists (Dat) <> 0 Then
Dat Terbuka Untuk Input Seperti # 1
input # 1, isi
Tutup # 1
DeleteFile Dat
Lain
isi = " "
End If
data = Split (isi, "|")
Untuk i = 1 Untuk UBound (Data)
namafile = lvQ.SelectedItem.SubItems (2)
Jika namafile <> split (Data (i), "?")( 1) Kemudian
NYU = NYU & "|" & Data (i)
End If
Berikutnya
DeleteFile AppPath & "Karantina \" & lvQ.SelectedItem.SubItems (1)
Buka Dat Untuk Output Seperti # 2
Print # 2, NYU
Tutup # 2
MsgBox "Sukses Menghapus Berkas !!!", vbInformation, ""
UpdateQ
Kode di Atas Menghapus file yang berfungsi UNTUK Yang Telah di Karantina
Masukan kode di bawah ini ke Komando [cmdRestore]
Spoiler :
'Kode:
Jika lvQ.ListItems.Count = 0 Then Exit Sub
Indeks Kasus Pilih
Kasus 0
DecodeFile AppPath & "Karantina \" & lvQ.SelectedItem.SubItems (1), lvQ.SelectedItem.SubItems (2)
MsgBox "File Dikembalikan ke" & Chr (34) & lvQ.SelectedItem.SubItems (2) & Chr (34) & "vbInformation !!!",," "
Kasus 1
sTitle = "jalan Pilih:" & vbNewLine & "Pilih jalur untuk mengembalikan file."
ThePath = BrowseFolder (sTitle, Me)
Jika ThePath <> "" Lalu
DecodeFile AppPath & "\ Karantina" & lvQ.SelectedItem.SubItems (1), ThePath & GetFileName (lvQ.SelectedItem.SubItems (2))
MsgBox "File Dikembalikan ke "& Chr (34) & ThePath & GetFileName (lvQ.SelectedItem.SubItems (2)) & Chr (34) &" vbInformation !!!",, ""
End If
End Select
Jika lvQ.ListItems.Count = 0 Then Exit Sub
Indeks Kasus Pilih
Kasus 0
DecodeFile AppPath & "Karantina \" & lvQ.SelectedItem.SubItems (1), lvQ.SelectedItem.SubItems (2)
MsgBox "File Dikembalikan ke" & Chr (34) & lvQ.SelectedItem.SubItems (2) & Chr (34) & "vbInformation !!!",," "
Kasus 1
sTitle = "jalan Pilih:" & vbNewLine & "Pilih jalur untuk mengembalikan file."
ThePath = BrowseFolder (sTitle, Me)
Jika ThePath <> "" Lalu
DecodeFile AppPath & "\ Karantina" & lvQ.SelectedItem.SubItems (1), ThePath & GetFileName (lvQ.SelectedItem.SubItems (2))
MsgBox "File Dikembalikan ke "& Chr (34) & ThePath & GetFileName (lvQ.SelectedItem.SubItems (2)) & Chr (34) &" vbInformation !!!",, ""
End If
End Select
Fungsi kode di Atas Berguna UNTUK saya mengembalikan file Kembali Ke asalnya.
PADA hari lalu Form_Load () Tambahkan kode di bawah ini.
Spoiler :
'Kode:
frmUtama.Enabled = False
Dat = AppPath & "Karantina \ HN.dat"
UpdateQ
frmUtama.Enabled = False
Dat = AppPath & "Karantina \ HN.dat"
UpdateQ
Masukan kode di bawah ini ke Dalam, Yang Telah frmQuarantine ANDA buat tadi.
Spoiler :
'Kode:
Dat Dim As String
Private Sub UpdateQ ()
lvQ.ListItems.Clear
Dim data () As String
Jika PathFileExists (Dat) = 0 Kemudian Keluar Sub
Dat Terbuka Untuk Input Seperti # 1
input # 1, isi
Tutup # 1
data = split (isi, "|")
Untuk i = 1 Untuk UBound (Data)
Dengan lvQ.ListItems.Add (,, Split (Data (i), "?")( 0))
. subitems (1) = Split (data (i), "?")( 2)
subitems. (2) = split (Data (i), "?")( 1)
Akhir Dengan
Berikutnya
Me.Caption = "Karantina (" & lvQ.ListItems.Count & " ) "
End Sub
Dat Dim As String
Private Sub UpdateQ ()
lvQ.ListItems.Clear
Dim data () As String
Jika PathFileExists (Dat) = 0 Kemudian Keluar Sub
Dat Terbuka Untuk Input Seperti # 1
input # 1, isi
Tutup # 1
data = split (isi, "|")
Untuk i = 1 Untuk UBound (Data)
Dengan lvQ.ListItems.Add (,, Split (Data (i), "?")( 0))
. subitems (1) = Split (data (i), "?")( 2)
subitems. (2) = split (Data (i), "?")( 1)
Akhir Dengan
Berikutnya
Me.Caption = "Karantina (" & lvQ.ListItems.Count & " ) "
End Sub
Berfungsi UNTUK memanggil data yang ada di folder Yang Karantina.
Hanya ilmu ITU Yang Bisa Saya Bagikan. Kita Bukan Hanya SEKARANG sebagai Pemakai atau pengguna sekrang Kita Sudah Bisa mmembuat antivirus.
murah ini adalah antivirus Screenshot Yang Kita buat tadi SAAT melakukan pemindaian.
Catatan:. Jika ANDA DENGAN Mencoba membaca murah murah teliti seksama ANDA pasti berhasil Orang Yang berhasil adalah Orang Yang BANYAK mecoba.
Masalah UNTUK ANDA Bisa kode sumber meminta Kepada Saya trus DENGAN Satu syarat, yaitu ANDA Harus menyertakan Bukti bahwa ANDA Telah Mencoba entah ITU Dalam, Bentuk screenshot atau Yang lainnya.
Yang belum punya UNTUK Visual Basic 6.0 Bisa men-download disini