tusereg.bas

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

ret = RegOpenKey(mainkey, subkey, hKey)
If ret <> 0 Then Exit Function
While ret = 0
lenName = 256
ret = RegEnumValueAsAny2(hKey, idx, bName(0), lenName, ByVal 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
GoTo jkqq:
End If
name = String(lenName + 1, Chr(0))
lenName = Len(name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hKey, idx, name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = left(S, InStr(S, Chr(0)) - 1)
Call gui.AddTextData(IIf(lenName = 0, "(预设值)", left(name, InStr(name, Chr(0)) - 1)) & " :" & S, 0)

ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = left(S2, InStr(S2, Chr(0)) - 1)
Call gui.AddTextData(left(name, InStr(name, Chr(0)) - 1) & " :" & S & vbCrLf, 0)
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
gui.AddTextData left(name, InStr(name, Chr(0)) - 1) & "(" & j & ") : " & SArr(j) & vbCrLf, 0

Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim l As Long
RegEnumValueAsAny hKey, idx, name, lenName, ByVal 0, typeData, l, lenData
gui.AddTextData left(name, InStr(name, Chr(0)) - 1) & " : " & l & vbCrLf, 0

Case REG_BINARY
ReDim bArr(0 To lenData - 1) As Byte
RegEnumValueAsAny hKey, idx, name, lenName, ByVal 0, typeData, bArr(0), lenData
gui.AddTextData left(name, InStr(name, Chr(0)) - 1) & " : " & S, 0

For j = 0 To UBound(bArr)
gui.AddTextData Hex(bArr(j)) & " ", 0
Next
End Select
idx = idx + 1
Wend
RegCloseKey hKey
jkqq:

End Function

Public Function pRegKeyEumn(mainkey As Long, subkey As String)
Dim name As String * 256
Dim namep As String
RegOpenKey mainkey, subkey, retl
Dim idx As Integer
Do Until ret <> 0
ret = RegEnumKey(retl, idx, name, Len(name))
'MsgBox ret & " | " & idx
If ret <> 0 Then Exit Do:
If ret = 0 Then
namep = StrConv(name, Unicode)
prkeyEumn(idx) = namep
End If
idx = idx + 1
Loop
pckeyEumn = idx
RegCloseKey retl
End Function

Public Function pRegEumnM(mainkey As Long, subkey As String, valname As String) As String
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim name As String
Dim lenName As Long
Dim idx As Integer, j As Integer
Dim bName(256) As Byte
ret = RegOpenKey(mainkey, subkey, hKey)
If ret <> 0 Then Exit Function
While ret = 0
lenName = 256
ret = RegEnumValueAsAny2(hKey, idx, bName(0), lenName, ByVal 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
GoTo jkqq:
End If
name = String(lenName + 1, Chr(0))
lenName = Len(name)
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegEnumValueAsAny hKey, idx, name, lenName, ByVal 0, typeData, ByVal S, lenData
If typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
tmpn = left(name, InStr(name, Chr(0)) - 1) & "(" & j & ")"
If tmpn = valname Then pRegEumnM = SArr(j)
Next
End If
End Select
idx = idx + 1
Wend
RegCloseKey hKey
jkqq:

End Function

Public Function scaniebho()
pRegKeyEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects"
For f = 0 To pckeyEumn - 1
    bhoN = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\" & prkeyEumn(f), "")
    bhofn = ReadValue(HKEY_CLASSES_ROOT, "CLSID\" & prkeyEumn(f) & "\InProcServer32", "")
    If Scanfile(bhofn) = False Then bhofn = "[文件丢失]"
    gui.AddTextData prkeyEumn(f) & ": " & bhoN & ": " & bhofn, 0
Next f
End Function

Public Function scaniecj()
Dim name As String * 256
Dim namep As String
Dim iscj As Boolean
pRegKeyEumn HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer\Extensions"
For f = 0 To pckeyEumn - 1
    cjn = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer\Extensions\" & prkeyEumn(f), "ButtonText")
    If LCase(ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer\Extensions\" & prkeyEumn(f), "CLSID")) = LCase("{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}") Then
    iscj = True
    End If
If iscj = True Then
    filep = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer\Extensions\" & prkeyEumn(f), "Exec")
    If filep = "" Then
       tmpj = ReadValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Internet Explorer\Extensions\" & prkeyEumn(f), "ClsidExtension")
       filep = ReadValue(HKEY_CLASSES_ROOT, "CLSID\" & tmpj & "\InprocServer32", "")
       Else
    End If
    kl = Len(StrConv(prkeyEumn(f), Unicode))
    '-----------
    'ReadValue(HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Ext\Stats\" & prkeyEumn(f)
    '-----------
    If cjn <> "" And kl > 30 Then
    gui.AddTextData dqtext(cjn, 300) & " : " & filep, 0
    End If
End If
Next f
'gui.AddTextData cjn, 0

End Function

'---------------获得系统服务
Function isSysSer(ByVal pid As Long) As Boolean
Dim sp1, sp2 As String
sp1 = GetPname(pid)
sp2 = GetRemoteParam(pid)
If isSysSerST(sp1) = True Or isSysSerST(sp2) = True Then isSysSer = True
If isSysSerST(sp1) = False And isSysSerST(sp2) = False Then isSysSer = False
End Function
Function isSysSerST(ByVal ppath As String) As Boolean
If ppath = "" Then isSysSerST = False: Exit Function
'------------
h = InStr(ppath, "\??\")
If h <> 0 Then
ppath = right(ppath, Len(ppath) - 4)
End If
h = InStr(LCase(ppath), LCase("\systemroot\")) <> 0
If h <> 0 Then
ppath = right(ppath, Len(ppath) - 12)
ppath = "C:\WINDOWS\" & ppath
End If
'------------
pRegKeyEumn HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Services"
For j = 0 To pckeyEumn - 1
    m = prkeyEumn(j)
    rett = ReadValue(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Services\" & m, "ImagePath")
    'If rett <> "" And InStr(rett, ".exe") <> 0 Then
    Dim tmps2 As String
    tmps2 = Space(255)
    ExpandEnvironmentStrings rett, tmps2, 255
    Dim lstr As String
    lstr = StrConv(tmps2, Unicode)
    If LCase(lstr) = LCase(ppath) Then
    isSysSerST = True
    Exit Function
    Else
    isSysSerST = False
    End If
    'Else
    'isSysSerST = False
    'End If
Next j
End Function