威尼斯人线上娱乐

次第之家系列教程之手把手教你写猛氏兽烧香病毒专杀工具,把符串中的一子串替换为另一子串

16 11月 , 2019  


威尼斯人线上娱乐 1Function replace(ByVal sstr As String, ByVal stag As String, ByVal srep As String) As String
威尼斯人线上娱乐 2    Dim l1, l2, l3, x, i As Long
威尼斯人线上娱乐 3    Dim st As String
威尼斯人线上娱乐 4    x = InStr(sstr, stag)
威尼斯人线上娱乐 5    If x < 1 Then
威尼斯人线上娱乐 6        replace = sstr
威尼斯人线上娱乐 7        Exit Function
威尼斯人线上娱乐 8    End If
威尼斯人线上娱乐 9    st = sstr
威尼斯人线上娱乐 10    l1 = Len(sstr)
威尼斯人线上娱乐 11    l2 = Len(stag)
威尼斯人线上娱乐 12    l3 = Len(srep)
威尼斯人线上娱乐 13    For i = 0 To l1
威尼斯人线上娱乐 14        st = Left(st, x – 1) & srep & Right(st, Len(st) – x – l2 + 1)
威尼斯人线上娱乐 15        x = InStr(x + l3, st, stag)
威尼斯人线上娱乐 16        If x < 1 Then Exit For
威尼斯人线上娱乐 17    Next
威尼斯人线上娱乐 18    replace = st
威尼斯人线上娱乐 19End Function
威尼斯人线上娱乐 20

关于vb读取文件中带有[ ]的标题并摇身生龙活虎变树形结构 35C
文件的大器晚成都部队分
[Comments]
Lines=13
Line1=EDS file for Delta ASDA-A2 Servo Drive within CANopen Slave
Line2=
Line3=
Line4=
Line5=
Line6=
Line7=
Line8=
Line9=
Line10=
Line11=
Line12=
Line13=

(作者:chenhui530,论坛http://chenhui530.com)
前言
     
经过2018年和大峨曲烧香、威金等病毒的“不问不闻争”,小编也累了,“程序之家病毒专杀工具”纵然能够轻易消除此类病毒难点,即使“猛豹”已经改为历史了,可是笔者深信不疑越来越多的“大浣熊”会悄不过至,病毒创制者也会不停编写新的病毒,多姿多彩的病毒每日都会并发,反病毒只靠专门的学问的杀软公司是远远不足得。我们悟出过自己写专杀工具撤消病毒呢?笔者深信我们都有过如此的主见,只是由于不晓得怎么写而已。其实写平时的金钱观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”,“cmd帕特h”然后分别钦命其属性“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

 

威尼斯人线上娱乐 21Function split(ByVal sstr As String, ByVal spstr As String) As Variant
威尼斯人线上娱乐 22Dim star, lenstr, lensp, cur As Integer
威尼斯人线上娱乐 23Dim backstr() As String
威尼斯人线上娱乐 24Dim i As Integer
威尼斯人线上娱乐 25ReDim backstr(0)
威尼斯人线上娱乐 26lenstr = Len(sstr)
威尼斯人线上娱乐 27lensp = Len(spstr)
威尼斯人线上娱乐 28star = InStr(sstr, spstr)
威尼斯人线上娱乐 29If star < 1 Then
威尼斯人线上娱乐 30    backstr(0) = sstr
威尼斯人线上娱乐 31    split = backstr()
威尼斯人线上娱乐 32    Exit Function
威尼斯人线上娱乐 33End If
威尼斯人线上娱乐 34backstr(0) = Left(sstr, star – 1)
威尼斯人线上娱乐 35cur = star + lensp
威尼斯人线上娱乐 36For i = star + lensp To lenstr
威尼斯人线上娱乐 37    star = InStr(star + lensp, sstr, spstr)
威尼斯人线上娱乐 38    If star > 0 Then
威尼斯人线上娱乐 39        ReDim Preserve backstr(UBound(backstr) + 1)
威尼斯人线上娱乐 40        backstr(UBound(backstr)) = Mid(sstr, cur, star – cur)
威尼斯人线上娱乐 41        cur = star + lensp
威尼斯人线上娱乐 42    Else
威尼斯人线上娱乐 43        Exit For
威尼斯人线上娱乐 44    End If
威尼斯人线上娱乐 45Next
威尼斯人线上娱乐 46ReDim Preserve backstr(UBound(backstr) + 1)
威尼斯人线上娱乐 47backstr(UBound(backstr)) = Mid(sstr, cur, lenstr – cur + 1)
威尼斯人线上娱乐 48split = backstr()
威尼斯人线上娱乐 49End Function 
威尼斯人线上娱乐 50

[FileInfo]
FileName=E:\ASDA-A2_v06.eds
FileVersion=1
FileRevision=1
EDSVersion=4.0
Description=EDS file for Delta ASDA-A2 Servo Drive within CANopen
Slave
CreationTime=10:06AM
CreationDate=05-04-2009
CreatedBy=ASD.TN.Brian
ModificationTime=06:25PM
ModificationDate=05-04-2009
ModifiedBy=ASD.TN.Brian

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

方法一:

AC97でそれらしい関数を作ってみました。
【関数例】

[DeviceInfo]
Vendorname=Delta Electronics,INC.
VendorNumber=0x000001DD
ProductName=ASDA-A2 Drive
ProductNumber=0x00006000
RevisionNumber=0x02000001
OrderCode=ASDA-A2
BaudRate_10=0
BaudRate_20=0
BaudRate_50=0
BaudRate_125=1
BaudRate_250=1
BaudRate_500=1
BaudRate_800=0
BaudRate_1000=1
SimpleBootUpMaster=0
SimpleBootUpSlave=1
Granularity=5
DynamicChannelsSupported=0
GroupMessaging=0
NrOfRXPDO=4
NrOfTXPDO=4
LSS_Supported=0
CompactPDO=0x00

‘展开浏览目录对话框
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

Public Function
FastReplace(SSrch$, SFind$, SRepl$) As String

威尼斯人线上娱乐 51Public Function Replace97(varStrings As Variant, varBeforeChr As Variant, varAfterChr As Variant) As Variant
威尼斯人线上娱乐 52‘—-( 変数宣言 )———————————————-
威尼斯人线上娱乐 53Dim lngX1    As Long
威尼斯人线上娱乐 54‘—-( 开始时代設定 )———————————————-
威尼斯人线上娱乐 55Replace97 = varStrings
威尼斯人线上娱乐 56‘—-( 置換処理 )———————————————-
威尼斯人线上娱乐 57If IsNull(varStrings) Or varStrings = “” Then
威尼斯人线上娱乐 58Else
威尼斯人线上娱乐 59  If IsNull(varBeforeChr) Or varBeforeChr = “” Then
威尼斯人线上娱乐 60  Else
威尼斯人线上娱乐 61    Replace97 = “”
威尼斯人线上娱乐 62    For lngX1 = 1 To Len(varStrings)
威尼斯人线上娱乐 63      If Mid(varStrings, lngX1, Len(varBeforeChr)) = varBeforeChr Then
威尼斯人线上娱乐 64        Replace97 = Replace97 & varAfterChr
威尼斯人线上娱乐 65        lngX1 = lngX1 + Len(varBeforeChr) – 1
威尼斯人线上娱乐 66      Else
威尼斯人线上娱乐 67        Replace97 = Replace97 & Mid(varStrings, lngX1, 1)
威尼斯人线上娱乐 68      End If
威尼斯人线上娱乐 69    Next lngX1
威尼斯人线上娱乐 70  End If
威尼斯人线上娱乐 71End If
威尼斯人线上娱乐 72End Function

[DummyUsage]
Dummy0001=0
Dummy0002=0
Dummy0003=0
Dummy0004=0
Dummy0005=0
Dummy0006=0
Dummy0007=0

在那之中等学园函授数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”

 

※置換開始地方や置換回数などのパラメータは、考慮していません。
【確認】

[MandatoryObjects]
SupportedObjects=3
1=0x1000
2=0x1001
3=0x1018

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

Dim Src() As
Byte, Dst() As Byte, R() As Byte, F() As Byte

威尼斯人线上娱乐 73Public Function TEST()
威尼斯人线上娱乐 74MsgBox Replace97(“ABC”, “BC”, “”)      → A
威尼斯人线上娱乐 75MsgBox Replace97(“ABCD”, “BC”, “”)     → AD
威尼斯人线上娱乐 76MsgBox Replace97(“ABCDABCDBC”, “BC”, “”)  → ADAD
威尼斯人线上娱乐 77MsgBox Replace97(“ABCDABCDBC”, “BC”, “XY”) → AXYDAXYDXY 
威尼斯人线上娱乐 78End Function

[1000]
ParameterName=Device Type
ObjectType=0x7
DataType=0x0007
LowLimit=
HighLimit=
AccessType=ro
DefaultValue=0x04020192
PDOMapping=0
ObjFlags=0x0

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Dim LenF&, LenR&,
LenDst&, i&, j&, OutPos&

[1001]
ParameterName=Error Register
ObjectType=0x7
DataType=0x0005
LowLimit=
HighLimit=
AccessType=ro
DefaultValue=0
PDOMapping=1
ObjFlags=0x0
总体版是在那处下载的

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

 

自个儿要做多个威尼斯人线上娱乐 79如此的树形结构,供给是用文件中含[
]的一些产生布局

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

Const ChunkSize&
= 4096

自身在英特网搜到了意气风发段程序是这么写的
Option Explicit

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

 

Public Sub LoadTree(TreePath As String)
Dim i As Long, j As Long, s() As String
s = Split(GetTxt, vbCrLf)
ReDim n(0 To UBound As Long
For i = 0 To UBound
For j = 1 To Len
If Asc, j, 1)) <> 32 Then Exit For
Next
n = j
s = Mid
Next
For i = 0 To UBound
If n = 1 Then CreateRoot n, s, 2, TreeView1.Nodes.Add(, , , s.Index, i +
1
Next
End Sub

‘卸载病毒加载在钦定进度中的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

If SSrch = “” Or
SFind = “” Then Exit Function

Private Sub CreateRoot As Long, s() As String, Root As Long, R As Long,
T As Long)
Dim i As Long
For i = T To UBound
If n = Root Then
CreateRoot n, s, Root + 1, TreeView1.Nodes.Add(R, 4, , s.Index, i + 1
ElseIf n < Root Then
Exit For
End If
Next
End Sub

‘提高进度权限为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 GetTxt(TxtPath As String) As String
Dim F As Long: F = FreeFile
Open TxtPath For Input As #F
GetTxt = StrConv(InputB, F), vbUnicode)
Close #F
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

Src = SSrch: F =
SFind: R = SRepl

Private Sub Form_Load()
TreeView1.LineStyle = tvwRootLines
TreeView1.LabelEdit = tvwManual
LoadTree “F:\VB标准\试验库\MyTree\tree.txt”
End Sub

此中等学园函授数“InjectDll”笔者曾经把它注释掉了,这么些函数得用场是把DLL注入到钦点进度中,平时是病毒用到得一手,大家是写病毒专杀,所以并不必要此函数,而函数“UnloadDll”恰好相反,此函数得着用是卸载病毒加载在钦命进程中的DLL文件。函数“EnablePrivilege”是把经过升高至“DEBUG”权限(这样可以杀死一些固执己见病毒进度卡塔尔。函数“KillProcess”是把钦点进程停止掉。

LenF = UBound(F):
LenR = UBound(R)

运作下来是那般的威尼斯人线上娱乐 80

今昔大家再增多第多个模块,把它命名字为:“modRegsiry”,然后把上面代码增添到此模块中。

LenDst =
ChunkSize: ReDim Dst(0 To LenDst – 1)

试问各位这些程序须求张开什么改进?感谢!

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

For i = 0 To
UBound(Src) Step 2

‘—————————————————————
‘- 注册表 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

For j = 0 To LenF
Step 2

‘ 有关导入/导出的常量
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”

If Src(i + j)
<> F(j) Then Exit For

‘—————————————————————
‘- 注册表类型…
‘—————————————————————
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Next j

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

 

Private Type LUID
    lowpart As Long
    highpart As Long
End Type

If j > LenF
Then Found

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

For j = 0 To LenR
Step 2

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

If OutPos >=
LenDst Then

‘ 注册表关键字根类型…
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

LenDst = LenDst +
ChunkSize

Private hKey As Long                  ‘ 注册表打开项的句柄
Private i As Long, j As Long          ‘ 循环变量
Private Success As Long                ‘ API函数的重临值,
决断函数调用是或不是成功

ReDim Preserve
Dst(0 To LenDst)

‘————————————————————————————————————-
‘- 新建注册表关键字并设置注册表关键字的值…
‘- 倘诺 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_ATT奥德赛IBUTES                  ‘
注册表安全项目
    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

End If

‘————————————————————————————————————-
‘- 获得已存在的注册表关键字的值…
‘- 即便 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                                    ‘
设置注册表关键字的值的暗中认可长度

Dst(OutPos) =
R(j): OutPos = OutPos + 2

    ‘ 打开八个已存在的注册表关键字…
    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_BINAHavalY 值的暂且数组
                RegQueryValueEx hKey, ValueName, 0, REG_BINARY,
bValue(0), ValueSize
                For i = 0 To ValueSize – 1
                    Value = Value + String(2 – Len(Hex(bValue(i))), “0”)

Next j

  • Hex(bValue(i)) + ” ”  ‘ 将数组调换到字符串
                    Next i
                End If
        End Select
       
        ‘ 关闭注册表关键字…
        RegCloseKey hKey
        GetKeyValue = Trim(Value)                                           
            ‘ 再次回到函数值
    End Function

 

‘————————————————————————————————————-
‘- 拿到注册表关键字的风姿浪漫部分消息…
‘- SubKeyName()      注册表关键字的具有子项的名目(注意:最小下标为0)
‘- ValueName()      注册表关键字的富有子键的称谓(注意:最小下标为0)
‘- ValueType()      注册表关键字的有着子键的类型(注意:最小下标为0)
‘- CountKey          注册表关键字的子项数量
‘- CountValue        注册表关键字的子键数量
‘- 马克斯LenKey        注册表关键字的子项名称的最大尺寸
‘- 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

i = i + LenF –
1

    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

Else

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

If OutPos >=
LenDst Then

此模块是网络一位哲人写得,作者只作了简单改造,此模块得着用首如若用以对登记表得操作。
前日大家再加多第2个模块,把它定名称叫:“modEnumProcesses”,然后把下部代码加多到此模块中。

LenDst = LenDst +
ChunkSize

Option Explicit

ReDim Preserve
Dst(0 To LenDst)

‘******************************************************************************************************************************************************
‘遍历进度供给得函数
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
‘******************************************************************************************************************************************************

End If

‘***************************************************************************************************************************************************
‘用于读写文件函数
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

Dst(OutPos) =
Src(i): OutPos = OutPos + 2

    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

End If

‘删除文件函数
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

Next i

‘增添突显音讯到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(i) &
“autorun.inf”, IIf(FileDelete(strArray(i) & “autorun.inf”), “删除成功”,
“删除退步”)
            End If
            Call SearchDirs(strArray(i))
        End If
    Next
    Msg博克斯 “此番杀毒操作中发觉病毒:” &
CStr(frmMain.lstMsg.ListItems.Count) & “项!!!”, vbInformation,
“提醒”
    isRun = False
    frmMain.SetAppState True
End Sub

ReDim Preserve
Dst(0 To OutPos – 2): SSrch = Dst

‘清理注册表
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_USEENCORE,
“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

FastReplace =
SSrch$

‘检查文件假如开掘文件是病毒就打消病毒苏醒感染文件
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(str帕特h),
str帕特h, 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

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”,然后把下部代码增多到此模块中。

SearchLine is
input, SearchFor is what to search for, ReplaceWith is the
replacement

Option Explicit

 

Private Const INVALID_HANDLE_VALUE = -1

Function
sReplace(SearchLine As String, SearchFor As String, ReplaceWith As
String)

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

Dim vSearchLine
As String, found As Integer

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

found =
InStr(SearchLine, SearchFor): vSearchLine = SearchLine

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

If found <>
0 Then

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

vSearchLine =
“”

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

If found > 1
Then vSearchLine = Left(SearchLine, found – 1)

Private WFD As WIN32_FIND_DATA

vSearchLine =
vSearchLine + ReplaceWith

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Function FastReplace(SSrch$,
SFind$, SRepl$) As String Dim Src() As Byte, Dst() As Byte, R() As Byte,
F() As Byte Dim LenF, LenR, LenDst, i, j, OutPos Const Chu…

Private Const MaxLFNPath = 260

相关随笔

有关搜索:

今日看什么

寻觅本事库

重回首页

  • C++中的内部存款和储蓄器管理,内部存款和储蓄器管理
  • C语言中的undefined
    behavior,undefinedbehavior
  • jQuery画廊插件-GalleryView,jquery-galleryview
  • WebGL中的OpenGL着色器语言,webglopengl
  • Windows10-加快在小卖部中的布署
  • 解决Linux下Qt程序报『QString::arg: Argument
    missi

连锁频道:
Java编程  C#教程  C语言  C++教程  VC教程  Delphi教程  VB教程  工具软件  

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
        ‘若是不是一心对路径举办抽离(路线能够用“;”隔离卡塔 尔(英语:State of Qatar)
        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”) 
‘建构钦命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 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]

威尼斯人线上娱乐 81
                                                  图(1)
威尼斯人线上娱乐 82
                                                  图(2)
威尼斯人线上娱乐 83
                                图(3)
威尼斯人线上娱乐 84威尼斯人线上娱乐 85
                                          图(4)                         
                                                              图(5)
威尼斯人线上娱乐 86
                                            图(6)
威尼斯人线上娱乐 87
                                              图(7)
威尼斯人线上娱乐 88                       
图(8)

次第源码下载地址
[/size]
[size=4]支付接口文件下载地址
[/color]
[color=red]版权全体:程序之家http://chenhui530.com)  如需转发,请申明出处  陈辉于二零零七年5月
自个儿技巧轻便,代码中只怕有些地点写得非常不足好恐怕是缺乏康健,假若您有越来越好得办法,请与本身联系,和我们协同享受。

 


相关文章

发表评论

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

网站地图xml地图