blml.bas

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

Attribute VB_Name = "blml"
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
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 Type Hdir
        dirp(1 To 255) As String
        dconst As Integer
End Type
'最大路径长度和文件属性常量的定义
 Private Const MAX_PATH = 260
 Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
 Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 Private Const FILE_ATTRIBUTE_HIDDEN = &H2
 Private Const FILE_ATTRIBUTE_NORMAL = &H80
 Private Const FILE_ATTRIBUTE_READONLY = &H1
 Private Const FILE_ATTRIBUTE_SYSTEM = &H4
 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

'自定义数据类型FILETIME和WIN32_FIND_DATA的定义
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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 * MAX_PATH
    cAlternate As String * 14
End Type
Dim tmp As Hdir
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim xs As Boolean
Public tmp1asdq As String * 255
Public GSystemPath As String

Public Function fDelInvaildChr(str As String) As String
    On Error Resume Next
    For i = Len(str) To 1 Step -1
        If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
            fDelInvaildChr = left(str, i)
            Exit For
        End If
    Next
End Function


'遍历主函数
'参数说明:
' strPathName 要遍历的目录
' objList 使用VB的内部控件ListBox来存放遍历得到的路径，之所以
' 不使用字符串数组是因为数组大小不好定义
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub gDir(ByVal strPathName As String)
    Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
    Dim iIndex As Integer '子目录数组下标
    Dim i As Integer '用于循环子目录的查找
    
    Dim lHandle As Long 'FindFirstFileA 的句柄
    Dim tFindData As WIN32_FIND_DATA '
    Dim strFileName As String '文件名
    
    On Error Resume Next
    '初始化变量
    i = 1
    iIndex = 0
    tFindData.cFileName = "" '初始化定长字符串
    
    lHandle = FindFirstFile(strPathName & "\*.*", tFindData)
    If lHandle = 0 Then '查询结束或发生错误
    Exit Sub
    End If
    strFileName = fDelInvaildChr(tFindData.cFileName)
    If tFindData.dwFileAttributes = &H10 Then '目录
    If strFileName <> "." And strFileName <> ".." Then
    iIndex = iIndex + 1
    sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
    End If
    Else
    objList.AddItem strPathName & "\" & strFileName
    End If
    '循环查找下一个文件，直到结束
    Do While True
    tFindData.cFileName = ""
    If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
    FindClose (lHandle)
    Exit Do
    Else
    strFileName = StrConv(tFindData.cFileName, Unicode)
    If tFindData.dwFileAttributes = &H10 Then
    If strFileName <> "." And strFileName <> ".." Then
    iIndex = iIndex + 1
    tmp.dirp(iIndex) = strPathName & "\" & strFileName  '添加到目录数组
    tmp.dconst = iIndex
    End If
    Else
    'objList.AddItem strPathName & "\" & strFileName
    End If
    End If
    Loop
    '如果该目录下有目录，则根据目录数组递归遍历
    'If iIndex > 0 Then
    'For i = 1 To iIndex
    'sDirTraversal sSubDir(i), objList
    'objList.AddItem sSubDir(i)
    'Next
    'End If
End Sub

Public Sub sDirTraversal(ByVal strPathName As String)
    Dim sSubDir(200) As String '存放当前目录下的子目录,下标可根据需要调整
    Dim iIndex As Integer '子目录数组下标
    Dim i As Integer '用于循环子目录的查找
    
    Dim lHandle As Long 'FindFirstFileA 的句柄
    Dim tFindData As WIN32_FIND_DATA '
    Dim strFileName As String '文件名
    
    On Error Resume Next
    '初始化变量
    i = 1
    iIndex = 0
    tFindData.cFileName = "" '初始化定长字符串
    lHandle = FindFirstFile(strPathName & "\*.*", tFindData)
    If lHandle = 0 Then '查询结束或发生错误
    Exit Sub
    End If
    strFileName = StrConv(tFindData.cFileName, Unicode)
    If tFindData.dwFileAttributes = &H10 Then '目录
    If strFileName <> "." And strFileName <> ".." Then
    End If
    Else
    If p <> 0 Then gui.AddTextData strPathName & "\" & strFileName, 0
    End If
    '循环查找下一个文件，直到结束
    Do While True
    tFindData.cFileName = ""
    If FindNextFile(lHandle, tFindData) = 0 Then '查询结束或发生错误
    FindClose (lHandle)
    Exit Do
    Else
    strFileName = StrConv(tFindData.cFileName, Unicode)
    If tFindData.dwFileAttributes = &H10 Then
    If strFileName <> "." And strFileName <> ".." Then
    'iIndex = iIndex + 1
    'sSubDir(iIndex) = strPathName & "\" & strFileName '添加到目录数组
    End If
    Else
    p = InStr(strFileName, ".")
    List2.AddItem Asc(right(strFileName, 1))
    If Asc(right(strFileName, 1)) <> 46 Then
    If p <> 0 Then AddTextData strPathName & "\" & strFileName, 0
    End If
    End If
    End If
    Loop
    '如果该目录下有目录，则根据目录数组递归遍历
    'If iIndex > 0 Then
    'For i = 1 To iIndex
    'sDirTraversal sSubDir(i), objList
    'Next
    'End If
End Sub


Public Sub blsCanFile()
rootdisk = left(GSystemPath, 3)
gDir rootdisk & "Documents and Settings"
For i = 1 To tmp.dconst
sDirTraversal tmp.dirp(i) & "\「开始」菜单\程序\启动"
Next i
End Sub