（作者：chenhui530，论坛 http://chenhui530.com ）
前言
      经过去年和熊猫烧香、威金等病毒的“斗争”，我也累了，“程序之家病毒专杀工具”虽然可以轻松解决此类病毒问题，虽然“熊猫”已经成为历史了，但是我相信更多的“熊猫”会悄然而至，病毒制造者也会不断编写新的病毒，各种各样的病毒每天都会出现，反病毒只靠专业的杀软公司是远远不够得。大家想到过自己写专杀工具清除病毒呢？我相信大家都有过这样的想法，只是由于不知道怎么写而已。其实写一般的传统PE病毒专杀工具并不是大家想的那么复杂，本文将结合详细的注释讲解配合“Microsoft Visual Basic 6.0 中文版”手把手教你写一个属于自己的熊猫烧香病毒专杀程序(并不局限于熊猫烧香象威金也是可以的只要是类似感染方式得病毒都适用)。
准备工作：
    首先大家得安装好“Microsoft Visual Basic 6.0”，最好是安装企业版打上SP6补丁，然后再到我的论坛去下载我为大家提供得开发接口文件“GetVirusInfo.dll ” 地址为 http://chenhui530.com/forum/viewthread.php?tid=468&extra=page%3D1 。程序分为2个部分。一个是主程序（查杀部分）另一个是添加病毒特征码程序。（程序可以自己添加特征码，当变种出现只需要使用此工具添加即可。
主程序部分：
1．窗体设计和引用类库：
      大家把“Microsoft Visual Basic 6.0”打开然后在“新建工程”中选择“标准 EXE”项目。请看图（1）。选择菜单项得“工程(P)”然后选择“引用”然后在里面找到“Microsoft WMI Scripting V1.2 Library”把它选上（我的系统是XP，如果是2K请选上“Microsoft WMI Scripting V1.1 Library”，注意9X不支持WMI，如果需要支持的话可以安装。），主要是用于对进程得监视，见图(2)然后按“确定”。然后我们再把我给大家提供得开发接口引用到工程中，方法和添加“WMI”支持一样，所不同得是需要手动浏览到我提供得开发接口文件，见图(3)。然后为工程添加部件，因为默认“标准 EXE”工程是没有Listview的所以我们还需要再在“工程(P)”菜单里选择“部件”然后在里面找到“Microsoft Windows Common Controls 5.0 (SP2)”把它选上（为什么不选择6.0这里稍微说下因为6.0不支持XP风格所以我就舍弃了它选择了5.0），见图(4)然后按“确定”。
2．窗体布局：
      然后我们把“工程”名称命名为：“PandaVirusKiller”，窗体“Form1”命名为：“frmMain”，看图(5)。然后再在窗体上拖一个“PictureBox”命名为“picLogo”，然后再拖4个CommandButton分别命名为：“cmdKill”，“cmdExit”，“cmdAbout”，“cmdStop”，“cmdPath”然后分别指定其属性“Caption”为“杀毒(&K)”，“退出(&C)”，“关于(&A)”，“停止(&S)”,“浏览”然后再拖入一个ListView控件和StatusBar和一个TextBox分别命名为：“lstMsg”，“statusMsg”，“textPath”，textPath的Text值为“全盘扫描”，鼠标右键点击ListView在弹出菜单中选择属性，然后按图(6)的属性设置后按“确定”返回，然后分别调整窗体控件如口图(7)样式布局（当然你可以按自己得布局方式^_^）。
3．窗体编码：
      好现在窗体空间布局都准备好后我们就进入程序得编码。首先我们先添加一些程序需要得模块，见图(8)，下面需要添加得其他模块都这样子添加。把第一个添加得模块命名为：“modBrowsePath”(此模块得用处主要是调用系统目录选择窗体，好让用户在界面上可以选择杀毒得路径。)然后把下面代码添加进模块中。
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags  As Long
    lpfnCallback  As Long
    lParam  As Long
    iImage  As Long
End Type

'打开浏览目录对话框
Public Function GetFolderPath(ByVal Obj As TextBox, ByVal hWnd As Long)
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "请源路径:"
    With tBrowseInfo
        .hWndOwner = hWnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(256)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        If Len(sBuffer) > 0 Then Obj.Text = sBuffer
    End If
End Function

其中函数GetFolderPath主要是获取用户选择得目录得完整路径
Option Explicit
Option Base 0
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const INFINITE = &HFFFFFFFF
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ADJUST_DEFAULT = (&H80)
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const SE_DEBUG_NAME = "SeDebugPrivilege"

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long '获取当前进程句柄
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long

'这个函数得用处是把DLL注入到指定进程中，常常是病毒用到得手段，我们是写病毒专杀，所以并不需要此函数
'Public Function InjectDll(ByVal dwProcessId As Long, ByVal pszLibFile As String) As Boolean
'    Dim hProcess As Long, hThread As Long
'    Dim pszLibFileRemote As Long, exitCode As Long
'    On Error GoTo errhandle
'    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
'    If hProcess = 0 Then GoTo errhandle
'    Dim cch  As Long, cb As Long
'    cch = 1 + LenB(StrConv(pszLibFile, vbFromUnicode))
'    cb = cch
'    pszLibFileRemote = VirtualAllocEx(hProcess, ByVal 0&, cb, MEM_COMMIT, PAGE_READWRITE)
'    If pszLibFileRemote = 0 Then GoTo errhandle
'    If (WriteProcessMemory(hProcess, ByVal pszLibFileRemote, ByVal pszLibFile, cb, ByVal 0&) = 0) Then GoTo errhandle
'    Dim pfnThreadRtn  As Long
'    pfnThreadRtn = GetProcAddress(GetModuleHandle("Kernel32"), "LoadLibraryA")
'    If pfnThreadRtn = 0 Then GoTo errhandle
'    hThread = CreateRemoteThread(hProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal pszLibFileRemote, 0, 0&)
'    If (hThread = 0) Then GoTo errhandle
'    WaitForSingleObject hThread, INFINITE
'    GetExitCodeThread hThread, exitCode
'    InjectDll = CBool(exitCode)
'    Exit Function
'errhandle:
'    If pszLibFileRemote <> 0 Then
'        VirtualFreeEx hProcess, ByVal pszLibFileRemote, 0, MEM_RELEASE
'        InjectDll = False
'    End If
'    If hThread <> 0 Then
'        CloseHandle hThread
'        InjectDll = False
'    End If
'    If hProcess <> 0 Then
'        CloseHandle hProcess
'        InjectDll = False
'    End If
'End Function

'卸载病毒加载在指定进程中的DLL文件
Public Function UnloadDll(ByVal dwProcessId As Long, ByVal pszLibFile As String) As Boolean
    Dim hProcess As Long, hThread As Long
    Dim pszLibFileRemote As Long, exitCode As Long
    On Error GoTo errhandle
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, dwProcessId)
    If hProcess = 0 Then GoTo errhandle
    Dim cch  As Long, cb As Long
    cch = 1 + LenB(StrConv(pszLibFile, vbFromUnicode))
    cb = cch
    pszLibFileRemote = VirtualAllocEx(hProcess, ByVal 0&, cb, MEM_COMMIT, PAGE_READWRITE)
    If pszLibFileRemote = 0 Then GoTo errhandle
    If (WriteProcessMemory(hProcess, ByVal pszLibFileRemote, ByVal pszLibFile, cb, ByVal 0&) = 0) Then GoTo errhandle
    Dim pfnThreadRtn  As Long
    pfnThreadRtn = GetProcAddress(GetModuleHandle("Kernel32"), "GetModuleHandleA")
    If pfnThreadRtn = 0 Then GoTo errhandle
    hThread = CreateRemoteThread(hProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal pszLibFileRemote, 0, pszLibFileRemote)
    If (hThread = 0) Then GoTo errhandle
    WaitForSingleObject hThread, INFINITE
    GetExitCodeThread hThread, exitCode
    VirtualFreeEx hProcess, pszLibFileRemote, 0, MEM_RELEASE
    CloseHandle hThread
    pfnThreadRtn = GetProcAddress(GetModuleHandle("Kernel32"), "FreeLibrary")
    hThread = CreateRemoteThread(hProcess, ByVal 0&, 0&, ByVal pfnThreadRtn, ByVal exitCode, 0, pszLibFileRemote)
    WaitForSingleObject hThread, INFINITE
    GetExitCodeThread hThread, exitCode
    UnloadDll = CBool(exitCode)
    Exit Function
errhandle:
    If pszLibFileRemote <> 0 Then
        VirtualFreeEx hProcess, ByVal pszLibFileRemote, 0, MEM_RELEASE
        UnloadDll = False
        Exit Function
    End If
    If hThread <> 0 Then
        CloseHandle hThread
        UnloadDll = False
    End If
    If hProcess <> 0 Then
        CloseHandle hProcess
        UnloadDll = False
    End If
End Function

'提升进程权限为DEBUG权限
Public Function EnablePrivilege() As Boolean
    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
    Dim lp As Long
    hdlProcessHandle = GetCurrentProcess()
    lp = OpenProcessToken(hdlProcessHandle, TOKEN_ALL_ACCESS, hdlTokenHandle)
    lp = LookupPrivilegeValue(vbNullString, "SeDebugPrivilege", tmpLuid)
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    EnablePrivilege = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End Function

Public Function KillProcess(ByVal ProcessID As String) As Boolean '结束指定进程
    Dim lPHand As Long, TMBack As Long
    lPHand = OpenProcess(1&, True, CLng(ProcessID)) '获取进程句柄
    TMBack = TerminateProcess(lPHand, 0&) '关闭进程
    If TMBack <> 0 Then
        KillProcess = True
    Else
        KillProcess = False
    End If
    CloseHandle lPHand
End Function

其中函数“InjectDll”我已经把它注释掉了，这个函数得用处是把DLL注入到指定进程中，常常是病毒用到得手段，我们是写病毒专杀，所以并不需要此函数，而函数“UnloadDll”正好相反，此函数得着用是卸载病毒加载在指定进程中的DLL文件。函数“EnablePrivilege”是把进程提升至“DEBUG”权限（这样可以杀掉一些顽固病毒进程）。函数“KillProcess”是把指定进程结束掉。

现在我们再添加第三个模块，把它命名为：“modRegsiry”，然后把下面代码添加到此模块中。

Option Explicit
Option Compare Text
'---------------------------------------------------------------
'- 注册表 API 声明...
'---------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long          'Returns a valid LUID which is important when making security changes in NT.
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

'---------------------------------------------------------------
'- 注册表 Api 常数...
'---------------------------------------------------------------
' 注册表创建类型值...
Const REG_OPTION_NON_VOLATILE = 0        ' 当系统重新启动时，关键字被保留

' 注册表关键字安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                   
' 返回值...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0

' 有关导入/导出的常量
Const REG_FORCE_RESTORE As Long = 8&
Const TOKEN_QUERY As Long = &H8&
Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&
Const SE_PRIVILEGE_ENABLED As Long = &H2
Const SE_RESTORE_NAME = "SeRestorePrivilege"
Const SE_BACKUP_NAME = "SeBackupPrivilege"

'---------------------------------------------------------------
'- 注册表类型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges As LUID_AND_ATTRIBUTES
End Type

'---------------------------------------------------------------
'- 自定义枚举类型...
'---------------------------------------------------------------
' 注册表数据类型...
Public Enum ValueType
    REG_SZ = 1                        ' 字符串值
    REG_EXPAND_SZ = 2                  ' 可扩充字符串值
    REG_BINARY = 3                    ' 二进制值
    REG_DWORD = 4                      ' DWORD值
    REG_MULTI_SZ = 7                  ' 多字符串值
End Enum

' 注册表关键字根类型...
Public Enum keyRoot
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Private hKey As Long                  ' 注册表打开项的句柄
Private i As Long, j As Long          ' 循环变量
Private Success As Long                ' API函数的返回值, 判断函数调用是否成功

'-------------------------------------------------------------------------------------------------------------
'- 新建注册表关键字并设置注册表关键字的值...
'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键...
'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------
Public Function SetKeyValue(keyRoot As keyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As ValueType = REG_SZ) As Boolean
    Dim lpAttr As SECURITY_ATTRIBUTES                  ' 注册表安全类型
    lpAttr.nLength = 50                                ' 设置安全属性为缺省值...
    lpAttr.lpSecurityDescriptor = 0                    ' ...
    lpAttr.bInheritHandle = True                        ' ...
   
    ' 新建注册表关键字...
    Success = RegCreateKeyEx(keyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
   
    ' 设置注册表关键字的值...
    If IsMissing(ValueName) = False Then
        Select Case ValueType
            Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
            Case REG_DWORD
                If CDbl(Value) <= 4294967295# And CDbl(Value) >= 0 Then
                    Dim sValue As String
                    sValue = DoubleToHex(Value)
                    Dim dValue(3) As Byte
                    dValue(0) = Format("&h" & Mid(sValue, 7, 2))
                    dValue(1) = Format("&h" & Mid(sValue, 5, 2))
                    dValue(2) = Format("&h" & Mid(sValue, 3, 2))
                    dValue(3) = Format("&h" & Mid(sValue, 1, 2))
                    Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)
                Else
                    Success = ERROR_BADKEY
                End If
            Case REG_BINARY
                On Error Resume Next
                Success = 1                            ' 假设调用API不成功(成功返回0)
                ReDim tmpValue(UBound(Value)) As Byte
                For i = 0 To UBound(tmpValue)
                    tmpValue(i) = Value(i)
                Next i
                Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)
        End Select
    End If
    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function
   
    ' 关闭注册表关键字...
    RegCloseKey hKey
    SetKeyValue = True                                      ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 获得已存在的注册表关键字的值...
'- 如果 ValueName="" 则返回 KeyName 项的默认值...
'- 如果指定的注册表关键字不存在, 则返回空串...
'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型
'-------------------------------------------------------------------------------------------------------------
Public Function GetKeyValue(keyRoot As keyRoot, KeyName As String, ValueName As String, Optional ValueType As Long) As String
    Dim TempValue As String                            ' 注册表关键字的临时值
    Dim Value As String                                ' 注册表关键字的值
    Dim ValueSize As Long                              ' 注册表关键字的值的实际长度
    TempValue = Space(1024)                            ' 存储注册表关键字的临时值的缓冲区
    ValueSize = 1024                                    ' 设置注册表关键字的值的默认长度

' 打开一个已存在的注册表关键字...
    RegOpenKeyEx keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey
   
    ' 获得已打开的注册表关键字的值...
    RegQueryValueEx hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize
   
    ' 返回注册表关键字的的值...
    Select Case ValueType                                                        ' 通过判断关键字的类型, 进行处理
        Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ
            TempValue = Left$(TempValue, ValueSize - 1)                          ' 去掉TempValue尾部空格
            Value = TempValue
        Case REG_DWORD
            ReDim dValue(3) As Byte
            RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize
            For i = 3 To 0 Step -1
                Value = Value + String(2 - Len(Hex(dValue(i))), "0") + Hex(dValue(i))  ' 生成长度为8的十六进制字符串
            Next i
            If CDbl("&H" & Value) < 0 Then                                              ' 将十六进制的 Value 转换为十进制
                Value = 2 ^ 32 + CDbl("&H" & Value)
            Else
                Value = CDbl("&H" & Value)
            End If
        Case REG_BINARY
            If ValueSize > 0 Then
                ReDim bValue(ValueSize - 1) As Byte                                    ' 存储 REG_BINARY 值的临时数组
                RegQueryValueEx hKey, ValueName, 0, REG_BINARY, bValue(0), ValueSize
                For i = 0 To ValueSize - 1
                    Value = Value + String(2 - Len(Hex(bValue(i))), "0") + Hex(bValue(i)) + " "  ' 将数组转换成字符串
                Next i
            End If
    End Select
   
    ' 关闭注册表关键字...
    RegCloseKey hKey
    GetKeyValue = Trim(Value)                                                    ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 获得注册表关键字的一些信息...
'- SubKeyName()      注册表关键字的所有子项的名称(注意:最小下标为0)
'- ValueName()      注册表关键字的所有子键的名称(注意:最小下标为0)
'- ValueType()      注册表关键字的所有子键的类型(注意:最小下标为0)
'- CountKey          注册表关键字的子项数量
'- CountValue        注册表关键字的子键数量
'- MaxLenKey        注册表关键字的子项名称的最大长度
'- MaxLenValue      注册表关键字的子键名称的最大长度
'-------------------------------------------------------------------------------------------------------------
Public Function GetKeyInfo(keyRoot As keyRoot, KeyName As String, SubKeyName() As String, ValueName() As String, ValueType() As ValueType, Optional CountKey As Long, Optional CountValue As Long, Optional MaxLenKey As Long, Optional MaxLenValue As Long) As Boolean
    Dim f As FILETIME
    Dim l As Long, s As String, strTmp As String, intTmp As Long
   
    ' 打开一个已存在的注册表关键字...
    Success = RegOpenKeyEx(keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
    If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
   
    ' 获得一个已打开的注册表关键字的信息...
    Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)
   
    If Success <> ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function
   
    If CountKey <> 0 Then
        ReDim SubKeyName(CountKey - 1) As String            ' 重新定义数组, 使用数组大小与注册表关键字的子项数量匹配
        For i = 0 To CountKey - 1
            strTmp = String(255, vbNullChar) 'Space(255)
            l = 255
            RegEnumKeyEx hKey, i, ByVal strTmp, l, 0, vbNullString, ByVal 0&, f
            SubKeyName(i) = Left(strTmp, l)
            If InStr(SubKeyName(i), vbNullChar) - 1 <> -1 Then
                SubKeyName(i) = Left$(SubKeyName(i), InStr(SubKeyName(i), vbNullChar) - 1)
            End If
        Next i
       
        ' 下面的二重循环对字符串数组进行冒泡排序
        For i = 0 To UBound(SubKeyName)
            For j = i + 1 To UBound(SubKeyName)
                If SubKeyName(i) > SubKeyName(j) Then
                    s = SubKeyName(i)
                    SubKeyName(i) = SubKeyName(j)
                    SubKeyName(j) = s
                End If
            Next j
        Next i
    End If

If CountValue <> 0 Then
        ReDim ValueName(CountValue - 1) As String          ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
        ReDim ValueType(CountValue - 1) 'As Long            ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配
        For i = 0 To CountValue - 1
            strTmp = String(255, vbNullChar) 'Space(255)
           
            l = 255
            RegEnumValue hKey, i, ByVal strTmp, l, 0, intTmp, ByVal 0&, ByVal 0&
            ValueType(i) = intTmp
            ValueName(i) = Left(strTmp, l)
            If InStr(ValueName(i), vbNullChar) - 1 <> -1 Then
                ValueName(i) = Left$(ValueName(i), InStr(ValueName(i), vbNullChar) - 1)
            End If
        Next i
       
        ' 下面的二重循环对字符串数组进行冒泡排序
        For i = 0 To UBound(ValueName)
            For j = i + 1 To UBound(ValueName)
                If ValueName(i) > ValueName(j) Then
                    s = ValueName(i)
                    ValueName(i) = ValueName(j)
                    ValueName(j) = s
                End If
            Next j
        Next i
    End If
   
    ' 关闭注册表关键字...
    RegCloseKey hKey
    GetKeyInfo = True                                  ' 返回函数值
End Function

'-------------------------------------------------------------------------------------------------------------
'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零
'- 参数说明: Number--要转换的 Double 型数字
'-------------------------------------------------------------------------------------------------------------
Private Function DoubleToHex(ByVal Number As Double) As String
    Dim strHex As String
    strHex = Space(8)
    For i = 1 To 8
        Select Case Number - Int(Number / 16) * 16
            Case 10
                Mid(strHex, 9 - i, 1) = "A"
            Case 11
                Mid(strHex, 9 - i, 1) = "B"
            Case 12
                Mid(strHex, 9 - i, 1) = "C"
            Case 13
                Mid(strHex, 9 - i, 1) = "D"
            Case 14
                Mid(strHex, 9 - i, 1) = "E"
            Case 15
                Mid(strHex, 9 - i, 1) = "F"
            Case Else
                Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)
        End Select
        Number = Int(Number / 16)
    Next i
    DoubleToHex = strHex
End Function

Public Function RegDeleteSubkey(hKey As keyRoot, SubKey As String) As Boolean
    '删除目录
    'mhKey是指主键的名称，SubKey是指路径
    Dim ret As Long, Index As Long, hName As String
    Dim hSubkey As Long
    ret = RegOpenKey(hKey, SubKey, hSubkey)
    If ret <> 0 Then
        RegDeleteSubkey = False
        Exit Function
    End If
    ret = RegDeleteKey(hSubkey, "")
    If ret <> 0 Then '如果删除失败则认为是NT则用递归方法删除目录
        hName = String(256, Chr(0))
        While RegEnumKey(hSubkey, 0, hName, Len(hName)) = 0 And _
              RegDeleteSubkey(hSubkey, hName)
        Wend
        ret = RegDeleteKey(hSubkey, "")
    End If
    RegDeleteSubkey = (ret = 0)
    RegCloseKey hSubkey '删除打开的键值，释放内存
End Function

Public Function RegDeleteKeyName(mhKey As keyRoot, SubKey As String, hKeyName As String) As Boolean
    '删除子键数据
    'mhKey是指主键的名称，SubKey是指路径，hKeyName是指键名
    Dim hKey As Long, ret As Long
    ret = RegOpenKey(mhKey, SubKey, hKey)
    RegDeleteKeyName = False
    If ret = 0 Then
        If RegDeleteValue(hKey, hKeyName) = 0 Then RegDeleteKeyName = True
    End If
    RegCloseKey hKey '删除打开的键值，释放内存
End Function

此模块是网上一位高人写得，我只作了少许修改，此模块得着用主要是用于对注册表得操作。
现在我们再添加第四个模块，把它命名为：“modEnumProcesses”，然后把下面代码添加到此模块中。

Option Explicit

'******************************************************************************************************************************************************
'遍历进程需要得函数
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
'******************************************************************************************************************************************************
'遍历驱动器函数
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'******************************************************************************************************************************************************
'延时函数
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'******************************************************************************************************************************************************
'遍历进程需要得常数
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
'******************************************************************************************************************************************************

'***************************************************************************************************************************************************
'用于读写文件函数
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long '打开文件函数
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Type OFSTRUCT '用于打开文件
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName As String * 128
End Type
'***************************************************************************************************************************************************
'检查内存中是不存在病毒
Private isFind As Boolean
'检查是不是在杀毒
Public isRun As Boolean
'设置停止状态(因为如果是在遍历进程或者遍历文件得时候中按”停止“得时候可能造成一段时间得延时所以设置此标识让函数自动退出)
Public isStop As Boolean
Public strVirusArray() As String

Public Function GetProcessInfo() As Boolean
    Dim cb As Long
    Dim cbNeeded As Long
    Dim NumElements As Long
    Dim ProcessIDs() As Long
    Dim cbNeeded2 As Long
    Dim NumElements2 As Long
    Dim Modules(1 To 1024) As Long
    Dim lRet As Long
    Dim ModuleName As String, str As String
    Dim nSize As Long
    Dim hProcess As Long
    Dim i As Long, sChildModName As String
    Dim Restric() As String, longtmp As Long, cModules As Long
    cb = 8
    cbNeeded = 96

Do While cb <= cbNeeded
        cb = cb * 2
        ReDim ProcessIDs(cb / 4) As Long
        lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
    Loop
    NumElements = cbNeeded / 4
    For i = 1 To NumElements
        '当遇到退出标识马上退出函数
        If isStop Then
            Call ShowFinishMessage
            isStop = False
            Exit Function
        End If
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, ProcessIDs(i))
        If hProcess <> 0 And ProcessIDs(i) <> 4 Then
            lRet = EnumProcessModules(hProcess, Modules(1), 1024, cbNeeded2)
            lRet = EnumProcessModules(hProcess, Modules(1), cbNeeded2, cbNeeded2)
            If lRet <> 0 Then
                ModuleName = String(255, "*")
                nSize = 255
                lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, 255)
                ModuleName = Left(ModuleName, lRet)
            End If
           
            On Error Resume Next
            frmMain.statusMsg.Panels(1) = "正在检查：" & ModuleName & "..."
            '检查病毒
            Call CheckFileAndClearVirus(ModuleName, ProcessIDs(i))
        End If
        lRet = CloseHandle(hProcess)
    Next

If Not isFind Then
        GetProcessInfo = False
    Else
        GetProcessInfo = True
    End If
End Function

'删除文件函数
Public Function FileDelete(ByVal sFilePath As String) As Boolean
    On Error GoTo err
    If Dir(sFilePath, 1 Or 2 Or 4) <> "" Then
        SetFileAttr sFilePath
        DeleteFile sFilePath
    End If
    If Dir(sFilePath) = "" Then FileDelete = True
    Exit Function
err:
    FileDelete = False
End Function

'添加显示信息到LISTVIEW中
Public Sub AddToListView(ByVal columnText, ByVal item1 As String, ByVal item2 As String)
    Dim listItem As listItem
    Set listItem = frmMain.lstMsg.ListItems.Add(, , columnText)
    listItem.SubItems(1) = item1
    listItem.SubItems(2) = item2
End Sub

'全盘查杀函数
Public Sub CheckAllDrives()
    Dim ret As Long, strTmp As String, strArray() As String, i As Integer
    strTmp = String(256, Chr(0))
    ret = GetLogicalDriveStrings(256, strTmp)
    strArray = Split(strTmp, Chr(0))
    For i = 0 To UBound(strArray)
        If LCase(strArray(i)) <> "a:/" And LCase(strArray(i)) <> "b:/" Then
            If Dir(strArray(i) & "autorun.inf", 1 Or 2 Or 4) <> "" Then
                SetFileAttr strArray(i) & "autorun.inf"
                AddToListView "autorun.inf", strArray(i) & "autorun.inf", IIf(FileDelete(strArray(i) & "autorun.inf"), "删除成功", "删除失败")
            End If
            Call SearchDirs(strArray(i))
        End If
    Next
    MsgBox "此次杀毒操作中发现病毒：" & CStr(frmMain.lstMsg.ListItems.Count) & "项！！！", vbInformation, "提示"
    isRun = False
    frmMain.SetAppState True
End Sub

'清理注册表
Public Sub CleanReg()
    Dim strArr() As String, str1() As String, str2() As ValueType, i As Long, j As Long, m As Long, n As Long
    GetKeyInfo HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2", strArr, str1, str2, i, j, m, n
    Dim k As Integer, srfKey As String, srfAddKey As String
    On Error GoTo err
    '恢复双击硬盘功能
    For k = 0 To UBound(strArr)
        DoEvents
        If strArr(k) <> "" Then
            srfKey = GetKeyValue(HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/" & strArr(k) & "/Shell/Auto/command", "", 1)
            If srfKey <> "" And srfKey <> "^_*_*_^" Then
                RegDeleteSubkey HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/" & strArr(k) & "/Shell/Auto"
                RegDeleteSubkey HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/" & strArr(k) & "/Shell/AutoRun"
                AddToListView srfKey, "HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/" & strArr(k) & "/Shell", IIf(GetKeyValue(HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/" & strArr(k) & "/Shell/Auto/command", "", 1) = "", "已经删除", "删除失败")
            End If
        End If
    Next
err:
    '恢复显示隐藏文件得功能
    SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/Advanced/Folder/Hidden/SHOWALL", "CheckedValue", "1", REG_DWORD
End Sub

'显示结束信息
Public Sub ShowFinishMessage()
    If frmMain.lstMsg.ListItems.Count = 0 Then
        MsgBox "目前阶段没有发现病毒！！", vbInformation, "提示"
    Else
        MsgBox "目前阶段已经发现病毒：" & CStr(frmMain.lstMsg.ListItems.Count) & "项", vbQuestion, "提示"
    End If
    frmMain.SetAppState True
End Sub

'检查文件如果发现文件是病毒就清除病毒恢复感染文件
Public Function CheckFileAndClearVirus(ByVal strPath As String, ByVal strProcessId As String) As Boolean
    Dim i As Integer, hLen As Long, j As Integer
    Dim clsVirus As New clsPeInfo, strArray() As String, strLen As String, strStampNo As String, findStrAt As Integer
    With clsVirus
        .strFile = strPath
        hLen = FileLen(strPath)
        If IsArraryInitialize(strVirusArray) Then
            For i = 0 To UBound(strVirusArray)
                '对字符串进行格式化（因为默认是123344*XXX,XXX的形式）
                findStrAt = InStr(strVirusArray(i), "*")
                strLen = Left(strVirusArray(i), findStrAt - 1)
                strStampNo = Mid(strVirusArray(i), findStrAt + 1, Len(strVirusArray(i)) - findStrAt)
                If hLen = CLng(strLen) Then
                    If .IsPEFile Then
                        If InStr(strStampNo, ",") Then
                            strArray = Split(strStampNo, ",")
                            For j = 0 To UBound(strArray)
                                '确定为病毒原文件
                                If LCase(strArray(j)) = LCase(.GetVirusFileStampNo(CLng(strLen))) Then
                                    '删除病毒原文件
                                    If strProcessId <> "" Then
                                        KillProcess strProcessId
                                        Sleep 500
                                    End If
                                    CheckFileAndClearVirus = IIf(FileDelete(strPath), True, False)
                                    AddToListView ParseFileName(strPath), strPath, IIf(CheckFileAndClearVirus, "删除成功", "删除失败")
                                    Exit Function
                                End If
                            Next
                        Else
                            '确定为病毒原文件
                            If LCase(strStampNo) = LCase(.GetVirusFileStampNo(CLng(strLen))) Then
                                '删除病毒原文件
                                If strProcessId <> "" Then
                                    KillProcess strProcessId
                                    Sleep 500
                                End If
                                CheckFileAndClearVirus = IIf(FileDelete(strPath), True, False)
                                AddToListView ParseFileName(strPath), strPath, IIf(CheckFileAndClearVirus, "删除成功", "删除失败")
                                Exit Function
                            End If
                        End If
                    End If
                ElseIf hLen > CLng(strLen) Then
                    If .IsPEFile Then
                        '可能是感染文件
                        If .CheckFileIsPe(CLng(strLen)) Then
                            If InStr(strStampNo, ",") Then
                                strArray = Split(strStampNo, ",")
                                For j = 0 To UBound(strArray)
                                    '确定为感染文件
                                    If LCase(strArray(j)) = LCase(.GetVirusFileStampNo(CLng(strLen))) Then
                                        '恢复感染文件
                                        If strProcessId <> "" Then
                                            KillProcess strProcessId
                                            Sleep 500
                                        End If
                                        CheckFileAndClearVirus = IIf(RestoreFile(strPath, CLng(strLen)), True, False)
                                        AddToListView ParseFileName(strPath), strPath, IIf(CheckFileAndClearVirus, "恢复成功", "恢复失败")
                                        Exit Function
                                    End If
                                Next
                            Else
                                '确定为感染文件
                                If LCase(strStampNo) = LCase(.GetVirusFileStampNo(CLng(strLen))) Then
                                    '恢复感染文件
                                    If strProcessId <> "" Then
                                        KillProcess strProcessId
                                        Sleep 500
                                    End If
                                    CheckFileAndClearVirus = IIf(RestoreFile(strPath, CLng(strLen)), True, False)
                                    AddToListView ParseFileName(strPath), strPath, IIf(CheckFileAndClearVirus, "恢复成功", "恢复失败")
                                    Exit Function
                                End If
                            End If
                        End If
                    End If
                End If
            Next
        End If
    End With
End Function

'恢复感染文件
Public Function RestoreFile(ByVal strPath As String, ByVal lVirusLength As Long) As Boolean
    Dim restorfileSize As Long, hFile As Long, bytes() As Byte, hLen As Long, oF As OFSTRUCT, ret As Long, hWrite As Long, lngBytesWrite As Long
'    On Error GoTo err
    hLen = FileLen(strPath)
    restorfileSize = hLen - lVirusLength
    '当原始文件小于65536就直接读取文件不循环
'    MsgBox restorfileSize / (1024 * 1024): End
    If restorfileSize < 65536 Then
        ReDim bytes(restorfileSize - 1)
        hFile = OpenFile(strPath, oF, &H0)
        SetFilePointer hFile, lVirusLength, 0, 0
        ReadFile hFile, bytes(0), restorfileSize, ret, ByVal 0&
        CloseHandle hFile
        hFile = 0
        hFile = OpenFile(strPath & ".chh", oF, &H1 Or &H1000)
        WriteFile hFile, bytes(0), restorfileSize, ret, ByVal 0&
        CloseHandle hFile
    Else
        '当原始文件大于65536就进行循环读取文件写文件
        ReDim bytes(65535)
        hFile = OpenFile(strPath, oF, &H0)
        hWrite = OpenFile(strPath & ".chh", oF, &H1 Or &H1000)
        SetFilePointer hFile, lVirusLength, 0, 0
        Do
            DoEvents
            ReadFile hFile, bytes(0), 65535, ret, ByVal 0&
            WriteFile hWrite, bytes(0), ret, lngBytesWrite, ByVal 0&
        Loop While ret <> 0
        CloseHandle hFile
        CloseHandle hWrite
    End If
    RestoreFile = IIf(FileDelete(strPath), True, False)
    If RestoreFile Then
        Name strPath & ".chh" As strPath
    End If
    Exit Function
err:
    RestoreFile = False
End Function

'设置文件属性，如果有只读属性就把文件设置成正常模式
Public Sub SetFileAttr(ByVal strPath As String)
    If GetAttr(strPath) And vbReadOnly Then
        SetAttr strPath, vbNormal
    End If
End Sub

'获取随机标题
Public Function GetAppCaption() As String
    Dim myValue As Long
    Randomize
    myValue = Int((100000000 * Rnd) + 1)
    GetAppCaption = Hex(myValue)
End Function

现在我们再添加第五个模块，把它命名为：“modFileInfo”，然后把下面代码添加到此模块中。

Option Explicit

Private Const INVALID_HANDLE_VALUE = -1

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
                       
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

Public Declare Function copyfile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private WFD As WIN32_FIND_DATA

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Const MaxLFNPath = 260

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MaxLFNPath
    cShortFileName As String * 14
End Type

'获取程序运行路径
Public Function AppPath() As String
    If Right(App.Path, 1) <> "/" Then
        AppPath = App.Path & "/"
    Else
        AppPath = App.Path
    End If
End Function

'获取系统System32路径
Public Function GetSystemPath()
    Dim strFolder As String
    Dim lngResult As Long
    strFolder = String(MaxLFNPath, 0)
    lngResult = GetSystemDirectory(strFolder, MaxLFNPath)
    If lngResult <> 0 Then
        GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    Else
        GetSystemPath = ""
    End If
End Function

'获取XP下WINDOWS路径2K下WINNT路径
Public Function GetWinPath()
    Dim strFolder As String
    Dim lngResult As Long
    strFolder = String(MaxLFNPath, 0)
    lngResult = GetWindowsDirectory(strFolder, MaxLFNPath)
    If lngResult <> 0 Then
        GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    Else
        GetWinPath = ""
    End If
End Function

'获取系统根目录路径
Public Function GetSysDrivePath()
    Dim sysdrivepath As String
    sysdrivepath = Left(GetSystemPath, 3)
    GetSysDrivePath = sysdrivepath
End Function

'搜索指定路径并且包括子路径
Public Sub SearchDirs(ByVal strCurPath As String)
    If Right(strCurPath, 1) <> "/" Then strCurPath = strCurPath & "/"
    Dim dirs As Long, dirbuf() As String, i As Integer, hItem As Long, k As Long, strTmp As String
    hItem = FindFirstFile(strCurPath & "*.*", WFD)
    If hItem <> INVALID_HANDLE_VALUE Then
        Do
            DoEvents
            '检查是不是目录
            If (WFD.dwFileAttributes And vbDirectory) Then
                ' 检查是不是  "." or ".."
                If Asc(WFD.cFileName) <> 46 Then
                    If isStop Then
                        Exit Sub
                    End If
                    ReDim Preserve dirbuf(0 To dirs)
                    dirbuf(dirs) = Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    dirs = dirs + 1
                    strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    '显示搜索信息
                    frmMain.statusMsg.Panels(1).Text = "正在检查：" & strTmp
                End If
            Else
                On Error Resume Next
                DoEvents
                If isStop Then
                    Exit Sub
                End If
                strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                '显示搜索信息
                frmMain.statusMsg.Panels(1) = "正在检查：" & strTmp
                '检查病毒
                Call CheckFileAndClearVirus(strTmp, "")
            End If
        Loop While FindNextFile(hItem, WFD)
       
        Call FindClose(hItem)
    End If
   
    For i = 0 To dirs - 1
        SearchDirs strCurPath & dirbuf(i) & "/"
    Next i
End Sub

'此函数从字符串中分离出路径
Public Function ParsePath(ByVal sPathIn As String) As String
    Dim i As Integer
    For i = Len(sPathIn) To 1 Step -1
        If InStr(":/", Mid$(sPathIn, i, 1)) Then Exit For
    Next
    ParsePath = Left$(sPathIn, i)
End Function

'此函数从字符串中分离出文件名
Public Function ParseFileName(ByVal sFileIn As String) As String
    Dim i As Integer
    For i = Len(sFileIn) To 1 Step -1
        If InStr("/", Mid$(sFileIn, i, 1)) Then Exit For
    Next
    ParseFileName = Mid$(sFileIn, i + 1, Len(sFileIn) - i)
End Function

'此函数从字符串中分离出文件扩展名
Public Function GetFileExt(ByVal sFileName As String) As String
    Dim P As Integer
    For P = Len(sFileName) To 1 Step -1
        If InStr(".", Mid$(sFileName, P, 1)) Then Exit For
    Next
    GetFileExt = Right$(sFileName, Len(sFileName) - P)
End Function

现在我们再添加第六个模块，把它命名为：“modIni”，然后把下面代码添加到此模块中。
Option Explicit

Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
   
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'获取指定节下的某个字段的值
Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String
    Dim strTmp As String * 32767
    Call GetPrivateProfileString(lpKeyName, strName, "", strTmp, Len(strTmp), strIniFile)
    GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)
End Function

'遍历指定节下得所有字段和字段值，返回一个字符串数组
Public Function GetVirusConfigInfo(ByVal strSection As String, ByVal strIniFile As String) As String()
    Dim strReturn As String * 32767
    Dim strTmp As String
    Dim nStart As Integer, nEnd As Integer, i As Integer
    Dim sArray() As String
   
    Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)
    strTmp = strReturn 'Mid(strReturn, InStr(1, strReturn, "=") + 1, Len(strReturn))
    i = 0
    Do While strTmp <> "" And Len(strTmp) <> 32765
        nStart = nEnd + 1
        nEnd = InStr(nStart, strReturn, vbNullChar)
        strTmp = Mid$(strReturn, nStart, nEnd - nStart)
        If Len(strTmp) > 0 Then
            strTmp = Replace(strTmp, "=", "*")
            ReDim Preserve sArray(0 To i)
            sArray(i) = strTmp
            i = i + 1
        End If
    Loop
    GetVirusConfigInfo = sArray
End Function

'写INI数据函数
Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String, ByVal strIniFile As String) As Boolean
    On Error GoTo WriteIniStrErr
    WriteIniStr = True
   
    If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
        GoTo WriteIniStrErr
    Else
        If InStr(strIniFile, ":/") Then
            WritePrivateProfileString AppName, In_Key, In_Data, strIniFile
        Else
            WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "/" & strIniFile
        End If
    End If
    Exit Function
WriteIniStrErr:
    err.Clear
    WriteIniStr = False
End Function

'验证数组是否已经初始化了
Public Function IsArraryInitialize(strArray() As String) As Boolean
    On Error GoTo err
    Dim i As Long
    i = UBound(strArray)
    IsArraryInitialize = True
    Exit Function
err:
    IsArraryInitialize = False
End Function

最后我们添加主窗体程序源码,代码如下：
Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
'进程监视事件
Private WithEvents objSWbemSink As SWbemSink

Private Sub cmdPath_Click()
    '获取用户选择目录路径
    GetFolderPath textPath, Me.hWnd
End Sub

Private Sub Form_Initialize()
    '显示XP风格
    InitCommonControls
End Sub

Private Sub cmdAbout_Click()
    '显示关于信息
    MsgBox "欢迎你使用程序之家编写的“熊猫烧香”病毒专杀工具！如" & vbNewLine & "果你在使用中发现有什么问题请及时通过以下方式转告联" & Chr(13) & "系我。QQ号码： 285305530  附加消息：“熊猫烧香”" & "邮箱:" & vbNewLine & "Chenhui00530@163.com  论 http://www.chenhui530.com ", vbInformation, "关于"
End Sub

Private Sub cmdExit_Click()
    Unload Me: End
End Sub

Private Sub cmdKill_Click()
    Dim strArr() As String, i As Integer
    '检查是否已经添加了病毒特征码
    If Not IsArraryInitialize(strVirusArray) Then
        MsgBox "你还没有添加病毒特征码呢！！", vbInformation, "提示"
        Exit Sub
    End If
    '初始杀毒状态
    Me.lstMsg.ListItems.Clear
    isRun = True
    SetAppState False
    '扫描全盘
    If textPath.Text = "全盘扫描" Then
        '先扫描进程
        If Not GetProcessInfo Then
            If MsgBox("内存中没有发现病毒是否继续检查？", vbQuestion Or vbYesNo, "提示") = vbYes Then
                CleanReg
                Call CheckAllDrives
            End If
        Else
            CleanReg
            CheckAllDrives
        End If
    Else
        '如果不是全盘对路径进行分离（路径可以用“；”隔开）
        If InStr(textPath.Text, ";") > 0 Then
            strArr = Split(textPath.Text, ";")
            Call GetProcessInfo
            For i = 0 To UBound(strArr)
                If Dir(strArr(i), 1 Or 2 Or 4 Or vbDirectory) <> "" Then
                    isRun = True
                    isStop = False
                    SearchDirs strArr(i)
                End If
            Next
            ShowFinishMessage
        Else
            '如果是单路径先判断是目录还是文件
            If Dir(textPath.Text, 1 Or 2 Or 4 Or vbDirectory) <> "" Then
                isRun = True
                isStop = False
                Call GetProcessInfo
                SearchDirs textPath.Text
            Else
                Call GetProcessInfo
                Call CheckFileAndClearVirus(textPath.Text, "")
            End If
            ShowFinishMessage
        End If
    End If
End Sub

'控制主界面得显示状态
Public Sub SetAppState(ByVal state As Boolean)
    If state Then
        Me.cmdKill.Enabled = True
        Me.cmdExit.Enabled = True
        Me.cmdAbout.Enabled = True
        Me.cmdStop.Enabled = True
        Me.cmdExit.Cancel = True
        Me.cmdStop.Enabled = False
        Me.cmdStop.Cancel = False
        Me.cmdPath.Enabled = True
        Me.textPath.Enabled = True
        Me.cmdKill.SetFocus
        isStop = False
        isRun = False
    Else
        Me.cmdKill.Enabled = False
        Me.cmdExit.Enabled = False
        Me.cmdAbout.Enabled = False
        Me.cmdStop.Enabled = True
        Me.cmdExit.Cancel = False
        Me.cmdStop.Cancel = True
        Me.cmdPath.Enabled = False
        Me.textPath.Enabled = False
        Me.cmdStop.SetFocus
    End If
    Me.statusMsg.Panels.Item(1).Text = ""
End Sub

Private Sub cmdStop_Click()
    '如果程序正在杀毒得会提示用户选择
    If isRun Then
        If MsgBox("正在杀毒你确定要终止吗？", vbInformation Or vbOKCancel Or vbDefaultButton2, "提示") = vbOK Then
            isRun = False
            isStop = True
        End If
    End If
End Sub

Private Sub Form_Load()
    If Dir(AppPath & "Config.ini", 1 Or 2 Or 4) = "" Then
        MsgBox "配置文件不存在！！", vbCritical, "错误"
        Unload Me: End
    End If
    Dim objSWbemServices As SWbemServices
    '设置随机标题
    Me.Caption = GetAppCaption
    strVirusArray = GetVirusConfigInfo("VirusFilesInfo", AppPath & "Config.ini")
    '提升进程权限为DEBUG权限
    EnablePrivilege
    Set objSWbemSink = New SWbemSink
    Set objSWbemServices = GetObject("winmgmts://./root/cimv2")  '建立指定计算机、命名空间的WMI的SWbemServices 对象的引用
    '监视进程得创建
    objSWbemServices.ExecNotificationQueryAsync objSWbemSink, "SELECT * FROM __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '如果程序正在杀毒得会提示用户选择
    If isRun Then
        If MsgBox("正在杀毒你确定要退出吗？", vbInformation Or vbOKCancel Or vbDefaultButton2, "提示") = vbOK Then
            objSWbemSink.Cancel
            Unload Me: End
        End If
    Else
        objSWbemSink.Cancel
        Unload Me: End
    End If
End Sub

'进程创建事件
Private Sub objSWbemSink_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    Dim processFilePath As String, ProcessID As String
    On Error Resume Next
    ProcessID = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessId").Value
    processFilePath = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath").Value
    '对创建得新进程进行检查
    Call CheckFileAndClearVirus(processFilePath, ProcessID)
End Sub

Private Sub picLogo_Click()
    Shell "Explorer /s http://chenhui530.com ", vbNormalFocus
End Sub

[size=3][color=red]添加病毒特征码程序：
1．窗体设计和引用类库：
    大家把“Microsoft Visual Basic 6.0”打开然后在“新建工程”中选择“标准 EXE”项目。请看图。按上面得方法把我提供给大家的开发接口引用到工程中。工程名命名为：“PandaConfig”，窗体命名为：“frmMain”，在窗体上拖2个Lable控件，分别命名为：“lLen”，“lVirusNo”，分别设置其Caption属性值为：“病毒大小:”，“特征码:”，然后再拖2个TextBox分别命名为：“textVirusFileLen”，“textVirusNo”，把其Text属性值为空，然后在添加3个CommandButton分别命名为：“cmdBrowse”，“cmdAdd”，“cmdExit”,分别设置其值为：“浏览(&B)”，“添加(&A)”，“退出(&C)”，窗体(frmMain)的Caption属性值为：“熊猫烧香特征码添加程序”。
2．程序编码：
把下面代码复制到窗体代码区。
Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private clsVirusInfo As clsPeInfo
Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub cmdAdd_Click()
    '验证是不是空值
    If textVirusFileLen.Text = "" Or textVirusNo.Text = "" Then
        MsgBox "先获取病毒信息后再添加！！", vbInformation, "提示"
        RestoreSetting
        cmdBrowse.SetFocus
        Exit Sub
    End If

'虽然程序做了禁止输入，当却可以使用复制把数据粘贴在TEXTBOX中所以验证一下
    If Not IsNumeric(textVirusFileLen.Text) Then
        MsgBox "先获取病毒信息后再添加！！", vbInformation, "提示"
        RestoreSetting
        cmdBrowse.SetFocus
        Exit Sub
    End If
    Dim strTmp As String, strArray() As String
    '判断指定长度病毒文件是不是有添加过，因为存在多种病毒大小一样但是特征码不一样
    strTmp = GetiniValue("VirusFilesInfo", textVirusFileLen.Text, App.Path & "/Config.ini")
    If strTmp = "" Then
        '如果不存在就直接添加
        WriteIniStr "VirusFilesInfo", textVirusFileLen.Text, textVirusNo.Text, App.Path & "/Config.ini"
    Else
        strArray = Split(strTmp, ",")
        '当存在时先验证特征码是不是已经添加过了
        If DataIsFind(strArray, textVirusNo.Text) Then
            MsgBox "此病毒已经添加过了！！", vbInformation, "提示"
            RestoreSetting
            cmdBrowse.SetFocus
            Exit Sub
        End If
        '过滤字符串
        If Right(strTmp, 1) = "," Then
            WriteIniStr "VirusFilesInfo", textVirusFileLen.Text, strTmp & textVirusNo.Text, App.Path & "/Config.ini"
        Else
            WriteIniStr "VirusFilesInfo", textVirusFileLen.Text, strTmp & "," & textVirusNo.Text, App.Path & "/Config.ini"
        End If
    End If
    RestoreSetting
    MsgBox "添加特征码成功！！", vbInformation, "成功"
End Sub

'还原TEXTBOX
Private Sub RestoreSetting()
    textVirusFileLen.Text = ""
    textVirusNo.Text = ""
End Sub

'检查指定特征码是不是已经添加过了
Private Function DataIsFind(strArray() As String, ByVal findDate As String) As Boolean
    Dim i As Integer
    For i = 0 To UBound(strArray)
        If LCase(strArray(i)) = LCase(findDate) Then
            DataIsFind = True
            Exit Function
        End If
    Next

End Function

Private Sub cmdBrowse_Click()
    Dim strFile As String, virusFileLength As Long
    '打开浏览对话框
    strFile = ShowDialogFile(Me.hWnd, 1, "请选择病毒文件...", "", "病毒文件 (*.*)" & Chr(0) & "*.*", "", "")
    '当用户选择了某个文件后
    If strFile <> "" Then
        Set clsVirusInfo = New clsPeInfo
        With clsVirusInfo
            .strFile = strFile
            virusFileLength = .GetVirusFileLen
            '把病毒长度和特征码显示出来
            textVirusFileLen.Text = CStr(virusFileLength)
            textVirusNo.Text = .GetVirusFileStampNo(textVirusFileLen)
        End With
    End If
End Sub

Private Sub cmdExit_Click()
    '卸载窗体退出程序
    Unload Me
End Sub

'禁止输入

Private Sub textVirusFileLen_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

'禁止输入
Private Sub textVirusNo_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

然后为程序添加一模块命名为：“modBrowsePath”，然后把下面代码粘贴进去。
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_OVERWRITEPROMPT = &H2
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hWnd As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

'调用GetOpenFileName/GetSaveFileName函数打开浏览话框，当wMode值为1是打开浏览对话框当为其他值是保存文件对话框
Public Function ShowDialogFile(hWnd As Long, wMode As Integer, szDialogTitle As String, szFilename As String, szFilter As String, szDefDir As String, szDefExt As String) As String
    Dim x As Long, OFN As OPENFILENAME, szFile As String, szFileTitle As String 
    OFN.lStructSize = Len(OFN)
    OFN.hWnd = hWnd
    OFN.lpstrTitle = szDialogTitle
    OFN.lpstrFile = szFilename & String$(250 - Len(szFilename), 0)
    OFN.nMaxFile = 255
    OFN.lpstrFileTitle = String$(255, 0)
    OFN.nMaxFileTitle = 255
    OFN.lpstrFilter = szFilter
    OFN.nFilterIndex = 1
    OFN.lpstrInitialDir = szDefDir
    OFN.lpstrDefExt = szDefExt
    If wMode = 1 Then
        OFN.Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
        x = GetOpenFileName(OFN)
    Else
        OFN.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST
        x = GetSaveFileName(OFN)
    End If

If x <> 0 Then
        If InStr(OFN.lpstrFile, Chr$(0)) > 0 Then
            szFile = Left$(OFN.lpstrFile, InStr(OFN.lpstrFile, Chr$(0)) - 1)
        End If
        ShowDialogFile = szFile
    Else
        ShowDialogFile = ""
    End If
End Function

最后再为程序添加另一模块命名为：“modIni”，然后把下面代码粘贴进去。
Option Explicit
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'返回一个字符串

'获取指定节下的某个字段的值
Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String
    Dim strTmp As String * 32767
    Call GetPrivateProfileString(lpKeyName, strName, "", strTmp, Len(strTmp), strIniFile)
    GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)
End Function

'遍历指定节下得所有字段和字段值，返回一个字符串数组
Public Function GetVirusConfigInfo(ByVal strSection As String, ByVal strIniFile As String) As String()
    Dim strReturn As String * 32767
    Dim strTmp As String
    Dim nStart As Integer, nEnd As Integer, i As Integer
    Dim sArray() As String
    Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)
    strTmp = strReturn 'Mid(strReturn, InStr(1, strReturn, "=") + 1, Len(strReturn))
    i = 0
    Do While strTmp <> "" And Len(strTmp) <> 32765
        nStart = nEnd + 1
        nEnd = InStr(nStart, strReturn, vbNullChar)
        strTmp = Mid$(strReturn, nStart, nEnd - nStart)
        If Len(strTmp) > 0 Then
            strTmp = Replace(strTmp, "=", "*")
            ReDim Preserve sArray(0 To i)
            sArray(i) = strTmp
            i = i + 1
        End If
    Loop
    GetVirusConfigInfo = sArray
End Function

'写INI数据函数
Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String, ByVal strIniFile As String) As Boolean
    On Error GoTo WriteIniStrErr
    WriteIniStr = True
    If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
        GoTo WriteIniStrErr
    Else
        If InStr(strIniFile, ":/") Then
            WritePrivateProfileString AppName, In_Key, In_Data, strIniFile
        Else
            WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "/" & strIniFile
        End If
    End If
    Exit Function
WriteIniStrErr:
    err.Clear
    WriteIniStr = False
End Function

'验证数组是否已经初始化了
Public Function IsArraryInitialize(strArray() As String) As Boolean
    On Error GoTo err
    Dim i As Long
    i = UBound(strArray)
    IsArraryInitialize = True
    Exit Function
err:
    IsArraryInitialize = False
End Function

这样特征码添加程序也完成了。至此所有程序都完成了。分别编译出EXE文件即可正常使用了，使用时不要忘记了把生成得“PandaConfig.exe”，“PandaVirusKiller.exe”以及配置文件“Config.ini”放在同一目录中使用，如果在运行中提示缺少“Comctl32.ocx”控件的话就把此文件也一起打包，使用时放在同一目录即可。[/color][/size]

                                                  图(1)

                                                  图(2)

                                图(3)

                                          图(4)                                                                                        图(5)

                                            图(6)

                                              图(7)
                        图(8)

程序源码下载地址
[/size]
[size=4]开发接口文件下载地址
[/color]
[color=red]版权所有：程序之家 http://chenhui530.com )  如需转载，请注明出处  陈辉于2007年3月
本人能力有限，代码中可能有些地方写得不够好或者是不够完美，如果你有更好得方法，请与我联系，和大家一起分享。

程序之家系列教程之手把手教你写熊猫烧香病毒专杀工具相关推荐

1. 【CCS仿真系列教程】手把手教你纯软件仿真实现音频滤波

   [CCS仿真系列教程]手把手教你纯软件仿真实现音频滤波 事先说明 示例项目下载 示例使用说明 首先用Matlab生成加了噪声的音频 将我的项目弄你的CCS的WorkSpace中 把Matlab生成后的 ...

2. Vue3 Typescript + Axios 全栈开发教程：手把手教你写「待办清单」APP

   本文完整版:<Vue3 Typescript + Axios 全栈开发教程:手把手教你写「待办清单」APP> Vue3 Typescript + Axios 全栈开发教程 前端 Vue3 ...

3. 网易教程python_手把手教你写Python网络爬虫（1）：网易云音乐歌单

   摘要:从零开始写爬虫,初学者的速成指南! 需要免费获取本文章讲解的视频+源码,关注+转发此文然后私信我回复"音乐"即可领取资料,也欢迎大家和我一起交流学习Python,共同成长 封 ...

4. 程序员如何技术划水，手把手教你写Android项目文档，绝对干货

   安卓开发大军浩浩荡荡,经过近十年的发展,Android技术优化日异月新,如今Android 11.0 已经发布,Android系统性能也已经非常流畅,可以在体验上完全媲美iOS. 但是,到了各大厂商手 ...

5. 【2023-Pytorch-检测教程】手把手教你使用YOLOV5做麦穗计数

   小麦是世界上种植地域最广.面积最大及产量最多的粮食作物,2021年世界小麦使用量达到7.54亿吨.小麦产量的及时预估对作物生产.粮食价格及粮食安全产生重大影响,单位面积穗数是小麦产量预估研究中的难点及 ...

6. 新手做网站教程（手把手教你做网站）

   今天给各位分享新手做网站教程的知识,其中也会对手把手教你做网站进行解释,如果能碰巧解决你现在面临的问题,别忘了关注本站,现在开始吧! 本文目录一览: 1.怎么自己做网站 2.做网站的步骤 3.新手怎么 ...

7. php注册程序,[PHP初级]手把手教你写注册程序 1

   [PHP初级]手把手教你写注册程序 1 实例内容 在此教程,我们将通过写一个用户注册程序,学习以下内容: 数据的传输与获取 信息的验证 pdo方式操作数据库 事务处理 前台显示文件:index.php ...

8. 保姆级教程：手把手教你搭建个人网站

   保姆级教程:手把手教你搭建个人网站 前言 准备与搭建 1.Git管理工具的下载与安装 2.nodejs环境安装 3.hexo博客框架下载 npm换国内源 使用npm下载hexo博客框架 初始化mybl ...

9. 关于DevC++如何调试的问题，还不会调试的同学看这里---＞＞＞超级详细调试教程，手把手教你如何调试

   关于devc++调试问题,还不会调试的同学看这里!!!超级详细调试教程,手把手教你如何调试 DevC++该如何调试? 这篇是关于Devc该如何调试的. 刚接触c语言的同学可能还不会调试,所以我在这里就 ...

最新文章

1. 织梦缩略图php,dedecms怎么实现列表页缩略图随机调用
2. 3.3.2 函数参数不得不说的几件事
3. 当铅笔芯加上直流电压的时候
4. 推荐 7 个牛哄哄 Spring Cloud 实战项目
5. 九大技巧教你快速提升移动应用登陆转化率
6. module 'sign.views' has no attribute 'search_name'
7. python- 决策树分类器
8. 乐观锁和悲观锁_什么是悲观锁和乐观锁？
9. Vue、element-ui的resetFields()方法重置表单无效问题及解决办法
10. sht-11c语言程序,温湿度传感器SHT11数据手册(中文)版.pdf
11. Leetcode每日一题：842.split-array-into-fibonacci-sequenc（将数组拆分成斐波那契序列）
12. 【PAT】1002 写出这个数
13. ai文件图片连接丢失怎么处理_未来美学丨点亮你的AI技能点（一）
14. python视频网站源码_随便撸源码分享：教你如何用Python Flask 构建微电影视频网站视频教程...
15. Ubuntu中安装微信（wechat）
16. linux和嵌入式开发区别,嵌入式开发与普通编程开发的区别
17. 电大计算机教学自我测评,电大计算机自我鉴定.doc
18. css flex 布局 space-around 和 space-evenly 之间的区别css flex布局）
19. 联想便携式计算机720s使用什么硬盘盒,8代酷睿加持！联想720S轻薄本评测
20. JCameraView 仿微信拍照Android控件（点击拍照，长按录小视频）

热门文章

1. 前端vue图片批量下载，导出zip压缩文件
2. 使命召唤服务器显示测速中,《使命召唤16》错误提示等常见问题解决办法
3. 上海飞国内最远是哪里_6月15日起，宁波将首次开通飞新疆克拉玛依航线！
4. 游戏专项测试-弱网测试、客户端性能测试
5. 启动虚拟机加载页面出现EFI..Network将默认的UEFI格式设置为BIOS格式，更换固件类型即可。
6. wow 正在登陆服务器 就未响应,魔兽世界9.0画面卡住未响应解决办法
7. 架构活动复盘过程的六个环节
8. (附源码)计算机毕业设计SSM智慧党建信息系统
9. 无法获取下列许可solidworks standard解决方法
10. renesas ravb网卡驱动实现分析（linux uboot xvisor）