mdlfile.bas

支持监控包括传输控制协议和 UDP 的所有的互联网传输协议。同时程序具有实时文件防修改监控功能

Attribute VB_Name = "mdlFile"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/09/20
'描    述：界面清爽VB版高级专业防火墙 Ver 2.0.3
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Private counter   As Long
Public Function GetFileDescription(ByVal strFile As String) As String
Dim fileText   As String
Dim nextText   As String
Dim pnStart    As Long
Dim fileLength As Long
Dim i          As Long
Dim FileInfo   As String
Dim tempFile   As String
Dim pos        As Long
Dim StartPos   As Long
Dim EndPos     As Long
    On Error Resume Next
    fileText = "FileDescription"
    nextText = "FileVersion"
    Open strFile For Binary As #1
    tempFile = Space$(LOF(1))
    Get #1, , tempFile
    Close #1
    pos = InStr(tempFile, NullPad("StringFileInfo"))
    If pos = 0 Then
        pos = InStr(tempFile, "StringFileInfo")
        If pos = 0 Then
            pos = 1
        End If
        pnStart = InStr(pos, tempFile, fileText)
        fileLength = 16
    Else
        pnStart = InStr(pos, tempFile, NullPad(fileText))
        nextText = NullPad(nextText)
        fileLength = 34
    End If
    If pnStart > 0 Then
        StartPos = pnStart + fileLength
        EndPos = InStr(StartPos, tempFile, String$(3, vbNullChar))
        If InStr(Mid$(tempFile, StartPos, EndPos - StartPos), nextText) <> 0 Then
            For i = 1 To 255
                If CInt(Asc(Mid$(tempFile, StartPos + i, 1))) <= 31 Then
                    EndPos = StartPos + i
                    Exit For
                End If
            Next i
            counter = counter + 1
        End If
        FileInfo = Mid$(tempFile, StartPos, EndPos - StartPos)
        GetFileDescription = ReplaceIt(FileInfo, vbNullChar, vbNullString)
    End If
    On Error GoTo 0
End Function
Public Function GetFileVersion(ByVal strFile As String) As String
Dim fileText   As String
Dim nextText   As String
Dim pnStart    As Long
Dim fileLength As Long
Dim i          As Long
Dim FileInfo   As String
Dim tempFile   As String
Dim pos        As Long
Dim StartPos   As Long
Dim EndPos     As Long
    On Error Resume Next
    fileText = "FileVersion"
    nextText = "InternalName"
    Open strFile For Binary As #1
    tempFile = Space$(LOF(1))
    Get #1, , tempFile
    Close #1
    pos = InStr(tempFile, NullPad("StringFileInfo"))
    If pos = 0 Then
        pos = InStr(tempFile, "StringFileInfo")
        If pos = 0 Then
            pos = 1
        End If
        pnStart = InStr(pos, tempFile, fileText)
        fileLength = 12
    Else
        pnStart = InStr(pos, tempFile, NullPad(fileText))
        fileLength = 26
    End If
    If pnStart > 0 Then
        StartPos = pnStart + fileLength
        EndPos = InStr(StartPos, tempFile, String$(3, vbNullChar))
        If InStr(Mid$(tempFile, StartPos, EndPos - StartPos), nextText) <> 0 Then
            For i = 1 To 255
                If CInt(Asc(Mid$(tempFile, StartPos + i, 1))) <= 31 Then
                    EndPos = StartPos + (i - 1)
                    Exit For
                End If
            Next i
            counter = counter + 1
        End If
        FileInfo = Mid$(tempFile, StartPos, EndPos - StartPos)
        GetFileVersion = ReplaceIt(FileInfo, vbNullChar, vbNullString)
    End If
    On Error GoTo 0
End Function
Public Function NullPad(ByVal strdata As String) As String
Dim i       As Long
Dim tempStr As String
'THIS IS NOT MY CODE
'I GOT IT OFF PSCODE
'LINK IS http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=8364&lngWId=1
'By Ryan Duval
'Special Thx to him
'Dim lenData As Long
    If Not LenB(strdata) = 0 Then
        For i = 1 To Len(strdata)
            tempStr = tempStr & vbNullChar & Mid$(strdata, i, 1)
        Next i
        NullPad = Chr$(1) & tempStr
    End If
End Function
Public Function ReplaceIt(Original As Variant, _
                          ByVal Item As String, _
                          ByVal strReplace As String) As String
Dim nStage As String
Dim lSide  As String
Dim rSide  As String
    If InStr(Original, Item) = False Then
        ReplaceIt = Original
    Else
        nStage = Original
        Do Until InStr(nStage, Item) = 0
            lSide = Left$(nStage, InStr(nStage, Item) - 1)
            rSide = Right$(nStage, (Len(nStage) - Len(lSide) - Len(Item)))
            nStage = lSide & strReplace & rSide
            DoEvents
        Loop
        ReplaceIt = nStage
    End If
End Function