澳门新葡亰平台官网最新开发的消费平台开发过程 持续更新(二)

by admin on 2020年1月31日

‘**********************************************关机,重启,注销的兑现*************************************
‘资料搜罗:清劲风工作室RedIce
‘**********************************************API函数证明************************************************
  Public Declare GetCurrentProcess Lib “kernel32” () As Long
  Public Declare OpenProcessToken Lib “advapi32” (ByVal ProcessHandle As
Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
  Public Declare LookupPrivilege Lib “advapi32” Alias “LookupPrivilegeA”
(ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID)
As Long
  Public Declare AdjustTokenPrivileges Lib “advapi32” (ByVal TokenHandle
As Long, ByVal DisableAllPrivileges As Long, NewState As
TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As
TOKEN_PRIVILEGES, ReturnLength As Long) As Long
  Public Declare ExitWindowsEx Lib “user32” (ByVal uFlags As Long, ByVal
dwReserved As Long) As Long
  Public Declare GetVersionEx Lib “kernel32” Alias “GetVersionExA”
(ByRef lpVersionInformation As OSVERSIONINFO) As Long
‘*********************************************************************************************************
‘**********************************************常量评释************************************************

(作者: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
(SP2State of Qatar”把它选上(为啥不采用6.0那边微微说下因为6.0不帮忙XP风格就此笔者就扬弃了它选用了5.0),见图(4State of Qatar然后按“鲜明”。
2.窗体结构:
     
然后大家把“工程”名称命名称叫:“PandaVirusKiller”,窗体“Form1”命名称为:“frmMain”,看图(5卡塔尔(قطر‎。然后再在窗体上拖三个“PictureBox”命名叫“picLogo”,然后再拖4个CommandButton分别命名称为:“cmdKill”,“cmdExit”,“cmdAbout”,“cmdStop”,“cmdPath”然后分别钦点其本性“Caption”为“杀毒(&K卡塔尔”,“退出(&C卡塔尔”,“关于(&AState of Qatar”,“结束(&S卡塔尔(قطر‎”,“浏览”然后再拖入三个ListView控件和StatusBar和八个TextBox分别命名称为:“lstMsg”,“statusMsg”,“textPath”,textPath的Text值为“全盘扫描”,鼠标右键点击ListView在弹出菜单中选取属性,然后按图(6State of Qatar的性质设置后按“明确”重回,然后分别调解窗体控件如口图(7State of Qatar样式构造(当然你能够按本身得构造方式^_^)。
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

VB 模块部分代码

  Public Const EWX_LOGOFF = 0
  Public Const EWX_SHUTDOWN = 1
  Public Const EWX_REBOOT = 2
  Public Const EWX_FORCE = 4
  Public Const EWX_POWEROFF = 8
  Public Const TOKEN_ADJUST_PRIVILEGES = &H20
  Public Const TOKEN_QUERY = &H8
  Public Const SE_PRIVILEGE_ENABLED = &H2
  Public Const ANYSIZE_ARRAY = 1
  Public Const VER_PLATFORM_WIN32_NT = 2
‘*********************************************************************************************************
‘************************************************自定义类型************************************************

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

 

  Type OSVERSIONINFO
          dwOSVersionInfoSize   As Long
          dwMajorVersion   As Long
          dwMinorVersion   As Long
          dwBuildNumber   As Long
          dwPlatformId   As Long
          szCSDVersion   As String * 128
  End Type
  Type LUID
          LowPart   As Long
          HighPart   As Long
  End Type
  Type LUID_AND_ATTRIBUTES
          pLuid   As LUID
          Attributes   As Long
  End Type
  Type TOKEN_PRIVILEGES
          PrivilegeCount   As Long
          Privileges(ANYSIZE_ARRAY)   As LUID_AND_ATTRIBUTES
  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

‘API函数申明
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Const ERROR_SUCCESS = 0&
Declare Function RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA”
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
Long
Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA”
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
Long
Declare Function RegCloseKey Lib “advapi32.dll” (ByVal hKey As Long) As
Long
‘读取有个别Key的钦点名称的值
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
Declare Function RegSetValueExA Lib “advapi32.dll” (ByVal hKey As Long,
ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As
Long, ByRef lpData As Long, ByVal cbData As Long) As Long

 
‘*******************************************自定义函数****************************************************

其间函数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 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 GetVolumeInformation& Lib “kernel32” _
    Alias “GetVolumeInformationA” (ByVal lpRootPathName _
    As String, ByVal pVolumeNameBuffer As String, ByVal _
    nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, lpFileSystemFlags As _
    Long, ByVal lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As Long)
    Const MAX_FILENAME_LEN = 256
Sub Main()
‘设置IE8模式
Dim ret As Long, hKey As Long, hKey2 As Long, lenData As Long, typeData
As Long
Dim filename As String
Dim strErr As String

 
  ‘判定操作系统类型
  Public IsWinNT() As Boolean
          Dim myOS     As OSVERSIONINFO
          myOS.dwOSVersionInfoSize = Len(myOS)
          GetVersionEx myOS
       &

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

filename = App.EXEName & “.exe”

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

ret = RegOpenKey(HKEY_LOCAL_MACHINE, “SOFTWAREMicrosoftInternet
ExplorerMAINFeatureControlFEATURE_BROWSER_EMULATION”, hKey)
If ret <> 0 Then
ret = RegCreateKey(HKEY_LOCAL_MACHINE, “SOFTWAREMicrosoftInternet
ExplorerMAINFeatureControlFEATURE_BROWSER_EMULATION”, hKey)
End If

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

 ret = RegQueryValueEx(hKey, filename, 0, typeData, ByVal 0, lenData)
  If ret <> 0 Then
   If RegSetValueExA(hKey, filename, 0, &H4, 8, 4) <>
ERROR_SUCCESS Then
    strErr = “设置注册表时出错”
   End If
 End If

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

If strErr <> “” Then
MsgBox strErr
End If

‘那几个函数得用项是把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

RegCloseKey hKey
   
  ‘启动form
  MainWin.Show
  ‘Logo.Show
 
  End Sub
Public Function SerNum(Drive$State of Qatar As Long ‘获取硬盘种类号
    Dim No&, s As String * MAX_FILENAME_LEN
    Call GetVolumeInformation(Drive + “:”, s, MAX_FILENAME_LEN, _
    No, 0&, 0&, s, MAX_FILENAME_LEN)
    SerNum = No
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 StringState of Qatar As Boolean
‘甘休内定进度
    Dim lPHand As Long, TMBack As Long
    lPHand = OpenProcess(1&, True, CLng(ProcessID卡塔尔(قطر‎State of Qatar ‘获取进度句柄
    TMBack = TerminateProcess(lPHand, 0&State of Qatar ‘关闭进度
    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_BINA昂科拉Y = 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_ATTMuranoIBUTES                  ‘
注册表安全项目
    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(1024State of Qatar                            ‘
存款和储蓄注册表关键字的不时值的缓冲区
    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” & ValueState of Qatar < 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_BINAPAJEROY 值的不时数组
                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(ValueState of Qatar                                           
            ‘ 重返函数值
    End Function

‘————————————————————————————————————-
‘- 获得注册表关键字的部分音信…
‘- SubKeyName(卡塔尔(قطر‎      注册表关键字的具有子项的称号(注意:最小下标为0State of Qatar
‘- ValueName(卡塔尔国      注册表关键字的有所子键的名号(注意:最小下标为0卡塔尔(قطر‎
‘- ValueType(卡塔尔      注册表关键字的具备子键的类型(注意:最小下标为0State of Qatar
‘- 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 – 1State of Qatar ‘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

‘增多突显消息到LIS电视机IEW中
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(iState of Qatar &
“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_USE福特Explorer,
“Software/Microsoft/Windows/CurrentVersion/Explorer/MountPoints2/” &
strArr(kState of Qatar & “/Shell/Auto/command”, “”, 1卡塔尔 = “”, “已经去除”,
“删除失利”State of Qatar
            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.CountState of Qatar & “项”, 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(strPathState of Qatar, 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(strPathState of Qatar,
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 Msg博克斯(“内部存款和储蓄器中未有意识病毒是不是继续检查?”, 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 objSWbem瑟维斯s = GetObject(“winmgmts://./root/cimv2″卡塔尔(قطر‎ 
‘创设内定Computer、命名空间的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 Msg博克斯(“正在杀毒你明确要抽离吗?”, 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”,分别设置其值为:“浏览(&BState of Qatar”,“加多(&A卡塔尔国”,“退出(&C卡塔尔”,窗体(frmMainState of Qatar的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
        Msg博克斯 “先拿走病毒消息后再增加!!”, 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
                                                  图(1)
澳门新葡亰平台官网 2
                                                  图(2)
澳门新葡亰平台官网 3
                                图(3)
澳门新葡亰平台官网 4澳门新葡亰平台官网 5
                                          图(4)                         
                                                              图(5)
澳门新葡亰平台官网 6
                                            图(6)
澳门新葡亰平台官网 7
                                              图(7)
澳门新葡亰平台官网 8                       
图(8)

次第源码下载地址
[/size]
[size=4]支付接口文件下载地址
[/color]
[color=red]版权全部:程序之家http://chenhui530.com卡塔尔  如需转发,请评释出处  陈辉于2005年七月
本人技艺轻巧,代码中可能有一点地点写得相当不足好依旧是远远不足完美,假如你有更加好得办法,请与自己关系,和贵胄后生可畏道享用。

 

发表评论

电子邮件地址不会被公开。 必填项已用*标注

网站地图xml地图