Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/desaware/demo32/vs5demo/vervrfy.bas

BASIC Source File | 1996-10-24 | 17.8 KB | 451 lines

Attribute VB_Name = "VerVrfy"
Option Explicit

'contains version info for reference files that a conflict was found for
Type VerConflictType
    ReferenceFile As String     'name of reference file that a conflict was detected on
    ReferenceVersion As String  'reference file version
    ReferenceDate As String     'reference file date
    ReferenceSize As String     'reference file size
    ReferenceFlags As Long      'reference file flags
    'contains index to the ConflictListType array, there can
    'be more than one ConflictListType for each VerConflictType
    ConflictListIndex As Integer

End Type

' This structure holds information on the conflicting files, it is like
' a linked list, the VerConflictType contains an index to the first conflict,
' the last conflict contains a -1 in the index.
' Only the first conflict file is an actual conflict, the remaining files
' just indicates where else on the computer can the reference file be found.
Type ConflictListType
    ConflictFile As String      'string containing path of file found with same name
                                'as the reference file, blank if file not found
    ConflictVersion As String   'version of first conflict file
    ConflictDate As String      'date of first conflict file
    ConflictSize As String      'size of first conflict file
    ConflictFlags As Long       'conflict flags of first conflict file
    ConflictFXFlags As Long     'fixed file info flags of first conflict file
    ConflictNext As Integer     'next file in the conflict list, -1 if this is last one
End Type

Global VerConflictList() As VerConflictType
Global ConflictList() As ConflictListType

Global ConflictFilesFound%      'files found during scan that are in conflict with embedded files
Global FileToCheck$             'specifies the name of file to verify for
Global EmbedInfoFound%          'indicates whether we found other files during scan (we use this to
                                'determine whether the file contains embedded information or not)
Global ConflictFormCaption$     'Caption for the conflict report form, if string is empty, then will default to form's caption.
'Version Information constants
Global Const VC_GETALL = -1
Global Const VC_REFERENCEFILE = 1

'Version Conflict constants
Global Const CF_OLDERFILE = &H1
Global Const CF_NEWERFILE = &H2
Global Const CF_OLDERVERSION = &H4
Global Const CF_NEWERVERSION = &H8
Global Const CF_SPECIALVERSION = &H10
Global Const CF_ALWAYSWARN = &H20
Global Const CF_FILEINMEMORY = &H40
Global Const CF_FILENOTFOUND = &H80
Global Const CF_NOVERSIONINFO = &H100
Global Const CF_FILESIZELARGER = &H200
Global Const CF_FILESIZESMALLER = &H400
Global Const CF_NOTINREGISTRY = &H800

'The following are duplicates of the VS_FF_* constants from Verinfo.bas
Global Const VS_FF_DEBUG = &H1&
Global Const VS_FF_PRERELEASE = &H2&
Global Const VS_FF_PATCHED = &H4&
Global Const VS_FF_PRIVATEBUILD = &H8&
Global Const VS_FF_INFOINFERRED = &H10&
Global Const VS_FF_SPECIALBUILD = &H20&

'Text formatting constants
Global NL As String 'new line
Global TB As String 'tab

'Tab Stop messages
#If Win32 Then
    Global Const EM_SETTABSTOPS = &HB0 + 27
    Global Const EM_SETREADONLY = &HB0 + 31
    Global Const LB_SETTABSTOPS = &H180 + 19
#Else
    Global Const EM_SETTABSTOPS = &H400 + 27
    Global Const EM_SETREADONLY = &H400 + 31
    Global Const LB_SETTABSTOPS = &H400 + 19
#End If

'File Open & Save Common Dialog constants
Global Const OFN_READONLY = &H1&
Global Const OFN_OVERWRITEPROMPT = &H2&
Global Const OFN_HIDEREADONLY = &H4&
Global Const OFN_NOCHANGEDIR = &H8&
Global Const OFN_SHOWHELP = &H10&
Global Const OFN_NOVALIDATE = &H100&
Global Const OFN_ALLOWMULTISELECT = &H200&
Global Const OFN_EXTENSIONDIFFERENT = &H400&
Global Const OFN_PATHMUSTEXIST = &H800&
Global Const OFN_FILEMUSTEXIST = &H1000&
Global Const OFN_CREATEPROMPT = &H2000&
Global Const OFN_SHAREAWARE = &H4000&
Global Const OFN_NOREADONLYRETURN = &H8000&
Global Const OFN_NOTESTFILECREATE = &H10000

Global Const TECHNOLOGY = 2 '  Device classification
Global Const HORZSIZE = 4   '  Horizontal size in millimeters
Global Const VERTSIZE = 6   '  Vertical size in millimeters
Global Const HORZRES = 8    '  Horizontal width in pixels
Global Const VERTRES = 10   '  Vertical width in pixels
Global Const BITSPIXEL = 12 '  Number of bits per pixel
Global Const PLANES = 14    '  Number of planes

' 32-Bit API Functions
#If Win32 Then
    Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function SendMessageByNum Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function WinHelpBynum Lib "User32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
#Else
    ' 16-Bit API Functions
    Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
    Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
    Declare Function SendMessageByNum Lib "User" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Long
    Declare Function WinHelpBynum Lib "User" Alias "WinHelp" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, ByVal dwData As Long) As Integer
#End If
Sub FillConflictFileListBox(ByVal append2ctl%, lbox As Control)
Dim cfidx%, listidx%

    If Not append2ctl% Then lbox.Clear

    ' ConflictFilesFound contains the number of conflicting files that were found.
    If ConflictFilesFound% > 0 Then
        cfidx% = UBound(VerConflictList)
        ' Get list of conflicting file names and place them in the list box.
        For listidx% = 1 To cfidx% Step 1
            lbox.AddItem VerConflictList(listidx%).ReferenceFile
        Next
    Else
        ' If no conflicts were found, check to see whether it was
        ' because the target file did not contain any embedded info.
        If EmbedInfoFound% Then
            lbox.AddItem NOCONFLICT
        Else
            lbox.AddItem NOEMBEDDED
        End If
    End If

End Sub

'
' Determine the number of colors supported by the current device
'
Function GetColorCount&(f As Form)
    Dim pl&, bp&
    pl& = GetDeviceCaps(f.hDC, PLANES)
    bp& = GetDeviceCaps(f.hDC, BITSPIXEL)
    If (pl& * bp&) > 24 Then
        GetColorCount& = 2 ^ 24
    Else
        GetColorCount& = 2 ^ (pl& * bp&)
    End If
End Function

Function GetConflictInfo(ByVal ctype%, ByVal Index%, ByVal delim$) As String
Dim tstr$
Dim vclist%, vcount%

    If ctype% = VC_REFERENCEFILE Then
        If Index% = VC_GETALL Then
            vclist% = UBound(VerConflictList)
            For vcount% = 1 To vclist% Step 1
                tstr$ = tstr$ & VerConflictList(vcount%).ReferenceFile & delim$
            Next
        Else
            tstr$ = tstr$ & VerConflictList(ctype%).ReferenceFile & delim$
        End If
    End If

    GetConflictInfo = tstr$
End Function

Function GetDetailConflictInfo(ByVal vcidx%) As String
Dim clistindex%
Dim eflags&
Dim tstr$

    If vcidx% > UBound(VerConflictList) Then Exit Function

    'get index to conflict array list
    clistindex% = VerConflictList(vcidx%).ConflictListIndex

    tstr$ = CONFLICT_REFFILEDATE & TB & VerConflictList(vcidx%).ReferenceDate & NL
    tstr$ = tstr$ & CONFLICT_REFFILESIZE & TB & VerConflictList(vcidx%).ReferenceSize & NL
    tstr$ = tstr$ & CONFLICT_REFFILEVER & TB & VerConflictList(vcidx%).ReferenceVersion & NL & NL

    tstr$ = tstr$ & CONFLICT_FILEFOUND & TB

    'get conflict information, conflict information is currently found for
    'only the first conflict file
    tstr$ = tstr$ & ConflictList(clistindex%).ConflictFile & NL
    eflags& = ConflictList(clistindex%).ConflictFlags

    ' Display the necessary version information based on conflict found.
    ' We can filter out certain messages depending on the error found.
    ' For example:

    'If (eflags& And &H3) Then
        'date conflict, get date string
    '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictDate & TB
    'End If

    ' For now, we'll always display date and size
    tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
    tstr$ = tstr$ & CONFLICT_FILESIZE & TB & ConflictList(clistindex%).ConflictSize & NL

    'If (eflags& And &HC) Then
        'version conflict, get version string
    '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictVersion & TB
    'End If

    ' For now, we'll always display version
    tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL

    tstr$ = tstr$ & NL & GetWarnings(eflags&, NL, ConflictList(clistindex%).ConflictFXFlags)
    clistindex% = ConflictList(clistindex%).ConflictNext

    If clistindex% < 0 Then
        GetDetailConflictInfo = tstr$
        Exit Function
    End If

    ' If more than one file was found on the system, list their date, version,
    ' and conflict information.  This will allow you to see whether a good
    ' version exist on the target system.
    tstr$ = tstr$ & NL & CONFLICT_FILEINOTHERDIR & NL

    While clistindex% > 0
        tstr$ = tstr$ & NL & ConflictList(clistindex%).ConflictFile & NL
        ' For now, we'll always display date
        tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
        ' For now, we'll always display size
        tstr$ = tstr$ & CONFLICT_FILESIZE & TB & ConflictList(clistindex%).ConflictSize & NL
        ' For now, we'll always display version
        tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL

        clistindex% = ConflictList(clistindex%).ConflictNext
    Wend

    GetDetailConflictInfo = tstr$
End Function

' This function returns strings describing the fixed file info flags.
Function GetFileFlagDesc(ByVal Flags&) As String
    Dim ret$, comma$

    comma$ = ", "
    If Flags& And VS_FF_DEBUG Then
        ret$ = ret$ & FF_DEBUG & comma$
    End If
    If Flags& And VS_FF_INFOINFERRED Then
        ret$ = ret$ & FF_INFOINFERRED & comma$
    End If
    If Flags& And VS_FF_PATCHED Then
        ret$ = ret$ & FF_PATCHED & comma$
    End If
    If Flags& And VS_FF_PRERELEASE Then
        ret$ = ret$ & FF_PRERELEASE & comma$
    End If
    If Flags& And VS_FF_PRIVATEBUILD Then
        ret$ = ret$ & FF_PRIVATEBUILD & comma$
    End If
    If Flags& And VS_FF_SPECIALBUILD Then
        ret$ = ret$ & FF_SPECIALBUILD & comma$
    End If
    If ret$ <> "" Then
        GetFileFlagDesc = Left$(ret$, Len(ret$) - 2)
    End If
End Function

'
' Returns a string listing the warning messages for the specified error flag.
' The error flag is the Flags parameter from the FileConflict event of the VersionStamper.
'
Function GetWarnings$(ByVal eflags As Long, ByVal delim As String, ByVal fxflags As Long)
    Dim tstr$
    Dim fbit&
    Dim bitcount%

    If (eflags = 0) Then Exit Function

    For bitcount% = 0 To 12 Step 1
        fbit& = 2 ^ bitcount%
        If (fbit& And eflags) Then
            Select Case bitcount%
                Case 0: 'Older file was found
                    tstr$ = tstr$ & CONFLICT_OLDERFILE & delim
                Case 1: 'Newer file was found
                    tstr$ = tstr$ & CONFLICT_NEWERFILE & delim
                Case 2: 'Older version was found
                    tstr$ = tstr$ & CONFLICT_OLDERVERSION & delim
                Case 3: 'Newer file was found
                    tstr$ = tstr$ & CONFLICT_NEWERVERSION & delim
                Case 4: 'Special version was found
                    tstr$ = tstr$ & CONFLICT_SPECIALVERSION & GetFileFlagDesc(fxflags) & delim
                Case 5: 'Always warn was set
                    tstr$ = tstr$ & CONFLICT_ALWAYSWARN & delim
                Case 6: 'File was found in memory
                    tstr$ = tstr$ & CONFLICT_FILEINMEMORY & delim
                Case 7: 'No matching file was found
                    tstr$ = tstr$ & CONFLICT_FILENOTFOUND & delim
                Case 8: 'No version information detected in this file
                    tstr$ = tstr$ & CONFLICT_VERINFONOTFOUND & delim
                Case 9: 'No version information detected in this file
                    tstr$ = tstr$ & CONFLICT_FILESIZELARGER & delim
                Case 10: 'No version information detected in this file
                    tstr$ = tstr$ & CONFLICT_FILESIZESMALLER & delim
                Case 11: 'No version information detected in this file
                    tstr$ = tstr$ & CONFLICT_NOTINREGISTRY & delim
            End Select
        End If
    Next

    GetWarnings = tstr$

End Function

Sub LoadConflictStruct(vc As VerConflictType, ByVal filename$, ByVal FoundFile$, ByVal eflags&, vsctl As VersionStampDemo)
'
' Loads the VerConflictType with all of the available information
' for an embedded file descriptor.  This function can only be called during
' the FileConflict event for vsctl, since it uses the control's properties
' to obtain the description information.
'
Dim newsize%, listcount%, curindex%, startindex%, endindex%, otherindex%

    ' Set filename
    vc.ReferenceFile = filename$
    vc.ReferenceVersion = vsctl.RefVersion
    vc.ReferenceDate = vsctl.RefDateString
    vc.ReferenceSize = vsctl.RefSize
    vc.ReferenceFlags = vsctl.RefFlags
    listcount% = UBound(ConflictList)
    startindex% = listcount% + 1
    vc.ConflictListIndex = startindex%

    'if vsctl.OtherCount = 0, file was not found
    If vsctl.OtherCount > 0 Then
        endindex% = startindex% + vsctl.OtherCount - 1
    Else
        endindex% = startindex%
    End If

    'allocate for new items
    ReDim Preserve ConflictList(endindex%)

    otherindex% = 0
    For curindex% = startindex% To endindex% Step 1
        If vsctl.OtherCount > 0 Then
            ConflictList(curindex%).ConflictFile = vsctl.OtherFile(otherindex%)
            ConflictList(curindex%).ConflictVersion = vsctl.OtherVersion(otherindex%)
            ConflictList(curindex%).ConflictDate = vsctl.OtherDateString(otherindex%)
            ConflictList(curindex%).ConflictSize = vsctl.OtherSize(otherindex%)
            ConflictList(curindex%).ConflictFXFlags = vsctl.OtherFlags(otherindex%)
        Else
            If (FoundFile <> "") Then
                ConflictList(curindex%).ConflictFile = FoundFile
                ConflictList(curindex%).ConflictVersion = vsctl.FoundVersion
                ConflictList(curindex%).ConflictDate = vsctl.FoundDateString
                ConflictList(curindex%).ConflictSize = vsctl.FoundSize
                ConflictList(curindex%).ConflictFXFlags = vsctl.FoundFlags
            End If
        End If

        ConflictList(curindex%).ConflictFlags = eflags
        ' If more than one other files were found, create a linked list for them
        If (curindex% <> endindex%) Then
            ConflictList(curindex%).ConflictNext = curindex% + 1
        Else
            ConflictList(curindex%).ConflictNext = -1
        End If
        otherindex% = otherindex% + 1
    Next

End Sub

Sub LogEnumComplete(vsctl As VersionStampDemo)
Static scanningfiles%
    'reset mousepointer
    Screen.MousePointer = 0
    If vsctl.VerifyMode = 4 Then Exit Sub   'scanning for a single object file

    If Not scanningfiles% Then
        'checking file conflicts
        If ConflictFilesFound% > 0 Then Exit Sub

        ' If no file conflicts were found, make sure this EXE contains
        ' embedded information, scan it to find out.
        scanningfiles% = True
        EmbedInfoFound% = False

        'double check to make sure we scanned a file with embedded information
        If vsctl.VerifyMode = 2 Then
            vsctl.VerifyMode = 3
        Else
            vsctl.ScanFile = FileToCheck$
        End If
    Else
        ' This ends our scanning check.
        scanningfiles% = False
    End If

End Sub

Sub LogFileConflict(ReferenceFile As String, FoundFile As String, Flags As Long, StopVerify As Integer, vsctl As VersionStampDemo)
    Dim newidx%
    ' Keep count of number of conflicts found.
    ConflictFilesFound% = ConflictFilesFound% + 1
    ' At each one, we add an entry to the global VerScanList
    ' list of information.
    newidx% = UBound(VerConflictList) + 1
    ReDim Preserve VerConflictList(newidx%)

    ' We save here the information that we will need.
    ' Save information for EVERY file that caused a conflict.
    LoadConflictStruct VerConflictList(newidx%), ReferenceFile, FoundFile, Flags, vsctl

End Sub

Sub StartVerify(vsctl As VersionStampDemo)
    'clears global lists and other variables first
    ReDim VerConflictList(0)
    ReDim ConflictList(0)

    ConflictFilesFound% = 0

    'The file verify may take a while, so bring up hourglass.
    Screen.MousePointer = 11
    'Are we checking this Exe or some other file
    If FileToCheck$ <> "" Then
        ' This method of verifying leaves the VerifyMode property at 0
        vsctl.VerifyFile = FileToCheck$
    Else
        vsctl.VerifyMode = 2
    End If

End Sub

Sub StopFileScan(ReferenceFile As String, VerifyFlags As Long, StopScan As Integer)
    'This is used to check and make sure the target executable file has
    'embedded information.
    EmbedInfoFound% = True
    'Since all we need to do is make sure at least one file was found
    '(which tells us this EXE has embedded information), we can halt the scan.
    StopScan = True

End Sub