http://diyusof-av.blogspot.com/

http://www.softpedia.com/get/Antivirus/Diyusof-Antivirus.shtml

http://diyusof-forum.8241.n6.nabble.com/

Kode:
Dim As String Pathnya
Pathnya = ""
Pathnya = BrowseFolder ("Pilih folder Yang Akan di Pindai:", Me)
Jika Pathnya <> "" Lalu
txtPath.Text = Pathnya
End If

'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

'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

Me.hide
frmquarantine.show

/ 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

'Kode:
On Error Resume Next
mkdir "Karantina"
BuildDatabase

'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

'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

'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

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:
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

'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

'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

'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

'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

'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

'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

'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

'Kode:
frmUtama.Enabled = False
Dat = AppPath & "Karantina \ HN.dat"
UpdateQ

'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