home *** CD-ROM | disk | FTP | other *** search
/ 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 / articles / vbbultn / source / vervrfy.bas < prev    next >
Encoding:
BASIC Source File  |  1996-02-17  |  14.9 KB  |  408 lines
  1. Option Explicit
  2.  
  3. 'contains version info for reference files that a conflict was found for
  4. Type VerConflictType
  5.     ReferenceFile As String     'name of reference file that a conflict was detected on
  6.     ReferenceVersion As String  'reference file version
  7.     ReferenceDate As String     'reference file date
  8.     ReferenceFlags As Long      'reference file flags
  9.     'contains index to the ConflictListType array, there can
  10.     'be more than one ConflictListType for each VerConflictType
  11.     ConflictListIndex As Integer
  12.                                     
  13. End Type
  14.  
  15. ' This structure holds information on the conflicting files, it is like
  16. ' a linked list, the VerConflictType contains an index to the first conflict,
  17. ' the last conflict contains a -1 in the index.
  18. ' Only the first conflict file is an actual conflict, the remaining files
  19. ' just indicates where else on the computer can the reference file be found.
  20. Type ConflictListType
  21.     ConflictFile As String      'string containing path of file found with same name
  22.                                 'as the reference file, blank if file not found
  23.     ConflictVersion As String   'version of first conflict file
  24.     ConflictDate As String      'date of first conflict file
  25.     ConflictFlags As Long       'conflict flags of first conflict file
  26.     ConflictFXFlags As Long     'fixed file info flags of first conflict file
  27.     ConflictNext As Integer     'next file in the conflict list, -1 if this is last one
  28. End Type
  29.  
  30. Global VerConflictList() As VerConflictType
  31. Global ConflictList() As ConflictListType
  32.  
  33. Global ConflictFilesFound%      'files found during scan that are in conflict with embedded files
  34. Global FileToCheck$             'specifies the name of file to verify for
  35. Global EmbedInfoFound%          'indicates whether we found other files during scan (we use this to
  36.                                 'determine whether the file contains embedded information or not)
  37.  
  38. 'Version Information constants
  39. Global Const VC_GETALL = -1
  40. Global Const VC_REFERENCEFILE = 1
  41.  
  42. 'Version Conflict constants
  43. Global Const CF_OLDERFILE = &H1
  44. Global Const CF_NEWERFILE = &H2
  45. Global Const CF_OLDERVERSION = &H4
  46. Global Const CF_NEWERVERSION = &H8
  47. Global Const CF_SPECIALVERSION = &H10
  48. Global Const CF_ALWAYSWARN = &H20
  49. Global Const CF_FILEINMEMORY = &H40
  50. Global Const CF_FILENOTFOUND = &H80
  51. Global Const CF_NOVERSIONINFO = &H100
  52.  
  53. 'The following are duplicates of the VS_FF_* constants from Verinfo.bas
  54. Global Const VS_FF_DEBUG = &H1&
  55. Global Const VS_FF_PRERELEASE = &H2&
  56. Global Const VS_FF_PATCHED = &H4&
  57. Global Const VS_FF_PRIVATEBUILD = &H8&
  58. Global Const VS_FF_INFOINFERRED = &H10&
  59. Global Const VS_FF_SPECIALBUILD = &H20&
  60.  
  61. 'Text formatting constants
  62. Global NL As String 'new line
  63. Global TB As String 'tab
  64.  
  65. 'Tab Stop messages
  66. Global Const EM_SETTABSTOPS = &H400 + 27
  67. Global Const LB_SETTABSTOPS = (&H400 + 19)
  68.  
  69. 'File Open & Save Common Dialog constants
  70. Global Const OFN_READONLY = &H1&
  71. Global Const OFN_OVERWRITEPROMPT = &H2&
  72. Global Const OFN_HIDEREADONLY = &H4&
  73. Global Const OFN_NOCHANGEDIR = &H8&
  74. Global Const OFN_SHOWHELP = &H10&
  75. Global Const OFN_NOVALIDATE = &H100&
  76. Global Const OFN_ALLOWMULTISELECT = &H200&
  77. Global Const OFN_EXTENSIONDIFFERENT = &H400&
  78. Global Const OFN_PATHMUSTEXIST = &H800&
  79. Global Const OFN_FILEMUSTEXIST = &H1000&
  80. Global Const OFN_CREATEPROMPT = &H2000&
  81. Global Const OFN_SHAREAWARE = &H4000&
  82. Global Const OFN_NOREADONLYRETURN = &H8000&
  83. Global Const OFN_NOTESTFILECREATE = &H10000
  84.  
  85. Global Const TECHNOLOGY = 2 '  Device classification
  86. Global Const HORZSIZE = 4   '  Horizontal size in millimeters
  87. Global Const VERTSIZE = 6   '  Vertical size in millimeters
  88. Global Const HORZRES = 8    '  Horizontal width in pixels
  89. Global Const VERTRES = 10   '  Vertical width in pixels
  90. Global Const BITSPIXEL = 12 '  Number of bits per pixel
  91. Global Const PLANES = 14    '  Number of planes
  92.  
  93. Declare Function GetDeviceCaps% Lib "GDI" (ByVal hDC%, ByVal nIndex%)
  94. Declare Function SendMessage& Lib "User" (ByVal hwnd%, ByVal wMsg%, ByVal wParam%, lparam As Any)
  95.  
  96. Sub FillConflictFileListBox (ByVal append2ctl%, lbox As Control)
  97. Dim cfidx%, listidx%
  98.  
  99.     If Not append2ctl% Then lbox.Clear
  100.     
  101.     ' ConflictFilesFound contains the number of conflicting files that were found.
  102.     If ConflictFilesFound% > 0 Then
  103.         cfidx% = UBound(VerConflictList)
  104.         ' Get list of conflicting file names and place them in the list box.
  105.         For listidx% = 1 To cfidx% Step 1
  106.             lbox.AddItem VerConflictList(listidx%).ReferenceFile
  107.         Next
  108.     Else
  109.         ' If no conflicts were found, check to see whether it was
  110.         ' because the target file did not contain any embedded info.
  111.         If EmbedInfoFound% Then
  112.             lbox.AddItem NOCONFLICT
  113.         Else
  114.             lbox.AddItem NOEMBEDDED
  115.         End If
  116.     End If
  117.     
  118. End Sub
  119.  
  120. '
  121. ' Determine the number of colors supported by the current device
  122. '
  123. Function GetColorCount& (f As Form)
  124.     Dim pl%, bp%
  125.     pl% = GetDeviceCaps(f.hDC, PLANES)
  126.     bp% = GetDeviceCaps%(f.hDC, BITSPIXEL)
  127.     GetColorCount& = 2 ^ (pl% * bp%)
  128. End Function
  129.  
  130. Function GetConflictInfo (ByVal ctype%, ByVal index%, ByVal delim$) As String
  131. Dim tstr$
  132. Dim vclist%, vcount%
  133.  
  134.     If ctype% = VC_REFERENCEFILE Then
  135.         If index% = VC_GETALL Then
  136.             vclist% = UBound(VerConflictList)
  137.             For vcount% = 1 To vclist% Step 1
  138.                 tstr$ = tstr$ & VerConflictList(vcount%).ReferenceFile & delim$
  139.             Next
  140.         Else
  141.             tstr$ = tstr$ & VerConflictList(ctype%).ReferenceFile & delim$
  142.         End If
  143.     End If
  144.  
  145.     GetConflictInfo = tstr$
  146. End Function
  147.  
  148. Function GetDetailConflictInfo (ByVal vcidx%) As String
  149. Dim clistindex%
  150. Dim eflags&
  151. Dim tstr$
  152.     
  153.     If vcidx% > UBound(VerConflictList) Then Exit Function
  154.  
  155.     'get index to conflict array list
  156.     clistindex% = VerConflictList(vcidx%).ConflictListIndex
  157.  
  158.     tstr$ = CONFLICT_REFFILEDATE & TB & VerConflictList(vcidx%).ReferenceDate & NL
  159.     tstr$ = tstr$ & CONFLICT_REFFILEVER & TB & VerConflictList(vcidx%).ReferenceVersion & NL & NL
  160.     
  161.     tstr$ = tstr$ & CONFLICT_FILEFOUND & TB
  162.     
  163.     'get conflict information, conflict information is currently found for
  164.     'only the first conflict file
  165.     tstr$ = tstr$ & ConflictList(clistindex%).ConflictFile & NL
  166.     eflags& = ConflictList(clistindex%).ConflictFlags
  167.  
  168.     ' Display the necessary version information based on conflict found.
  169.     ' We can filter out certain messages depending on the error found.
  170.     ' For example:
  171.  
  172.     'If (eflags& And &H3) Then
  173.         'date conflict, get date string
  174.     '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictDate & TB
  175.     'End If
  176.  
  177.     ' For now, we'll always display date
  178.     tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
  179.  
  180.     'If (eflags& And &HC) Then
  181.         'version conflict, get version string
  182.     '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictVersion & TB
  183.     'End If
  184.  
  185.     ' For now, we'll always display version
  186.     tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL
  187.  
  188.     tstr$ = tstr$ & NL & GetWarnings(eflags&, NL, ConflictList(clistindex%).ConflictFXFlags)
  189.     clistindex% = ConflictList(clistindex%).ConflictNext
  190.  
  191.     If clistindex% < 0 Then
  192.         GetDetailConflictInfo = tstr$
  193.         Exit Function
  194.     End If
  195.  
  196.     ' If more than one file was found on the system, list their date, version,
  197.     ' and conflict information.  This will allow you to see whether a good
  198.     ' version exist on the target system.
  199.     tstr$ = tstr$ & NL & CONFLICT_FILEINOTHERDIR & NL
  200.  
  201.     While clistindex% > 0
  202.         tstr$ = tstr$ & NL & ConflictList(clistindex%).ConflictFile & NL
  203.         ' For now, we'll always display date
  204.         tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
  205.         ' For now, we'll always display version
  206.         tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL
  207.  
  208.         clistindex% = ConflictList(clistindex%).ConflictNext
  209.     Wend
  210.  
  211.     GetDetailConflictInfo = tstr$
  212. End Function
  213.  
  214. ' This function returns strings describing the fixed file info flags.
  215. Function GetFileFlagDesc (ByVal flags&) As String
  216.     Dim ret$, comma$
  217.     
  218.     comma$ = ", "
  219.     If flags& And VS_FF_DEBUG Then
  220.         ret$ = ret$ & FF_DEBUG & comma$
  221.     End If
  222.     If flags& And VS_FF_INFOINFERRED Then
  223.         ret$ = ret$ & FF_INFOINFERRED & comma$
  224.     End If
  225.     If flags& And VS_FF_PATCHED Then
  226.         ret$ = ret$ & FF_PATCHED & comma$
  227.     End If
  228.     If flags& And VS_FF_PRERELEASE Then
  229.         ret$ = ret$ & FF_PRERELEASE & comma$
  230.     End If
  231.     If flags& And VS_FF_PRIVATEBUILD Then
  232.         ret$ = ret$ & FF_PRIVATEBUILD & comma$
  233.     End If
  234.     If flags& And VS_FF_SPECIALBUILD Then
  235.         ret$ = ret$ & FF_SPECIALBUILD & comma$
  236.     End If
  237.     If ret$ <> "" Then
  238.         GetFileFlagDesc = Left$(ret$, Len(ret$) - 2)
  239.     End If
  240. End Function
  241.  
  242. '
  243. ' Returns a string listing the warning messages for the specified error flag.
  244. ' The error flag is the Flags parameter from the FileConflict event of the VersionStamper.
  245. '
  246. Function GetWarnings$ (ByVal eflags As Long, ByVal delim As String, ByVal fxflags As Long)
  247.     Dim tstr$
  248.     Dim fbit&
  249.     Dim bitcount%
  250.  
  251.     If (eflags = 0) Then Exit Function
  252.  
  253.     For bitcount% = 0 To 8 Step 1
  254.         fbit& = 2 ^ bitcount%
  255.         If (fbit& And eflags) Then
  256.             Select Case bitcount%
  257.                 Case 0: 'Older file was found
  258.                     tstr$ = tstr$ & CONFLICT_OLDERFILE & delim
  259.                 Case 1: 'Newer file was found
  260.                     tstr$ = tstr$ & CONFLICT_NEWERFILE & delim
  261.                 Case 2: 'Older version was found
  262.                     tstr$ = tstr$ & CONFLICT_OLDERVERSION & delim
  263.                 Case 3: 'Newer file was found
  264.                     tstr$ = tstr$ & CONFLICT_NEWERVERSION & delim
  265.                 Case 4: 'Special version was found
  266.                     tstr$ = tstr$ & CONFLICT_SPECIALVERSION & GetFileFlagDesc(fxflags) & delim
  267.                 Case 5: 'Always warn was set
  268.                     tstr$ = tstr$ & CONFLICT_ALWAYSWARN & delim
  269.                 Case 6: 'File was found in memory
  270.                     tstr$ = tstr$ & CONFLICT_FILEINMEMORY & delim
  271.                 Case 7: 'No matching file was found
  272.                     tstr$ = tstr$ & CONFLICT_FILENOTFOUND & delim
  273.                 Case 8: 'No version information detected in this file
  274.                     tstr$ = tstr$ & CONFLICT_VERINFONOTFOUND & delim
  275.             End Select
  276.         End If
  277.     Next
  278.  
  279.     GetWarnings = tstr$
  280.     
  281. End Function
  282.  
  283. Sub LoadConflictStruct (vc As VerConflictType, ByVal filename$, ByVal FoundFile$, ByVal eflags&, vsctl As VersionStamp)
  284. '
  285. ' Loads the VerConflictType with all of the available information
  286. ' for an embedded file descriptor.  This function can only be called during
  287. ' the FileConflict event for vsctl, since it uses the control's properties
  288. ' to obtain the description information.
  289. '
  290. Dim newsize%, listcount%, curindex%, startindex%, endindex%, otherindex%
  291.     
  292.     ' Set filename
  293.     vc.ReferenceFile = filename$
  294.     vc.ReferenceVersion = vsctl.RefVersion
  295.     vc.ReferenceDate = vsctl.RefDateString
  296.     vc.ReferenceFlags = vsctl.RefFlags
  297.     listcount% = UBound(ConflictList)
  298.     startindex% = listcount% + 1
  299.     vc.ConflictListIndex = startindex%
  300.     
  301.     'if vsctl.OtherCount = 0, file was not found
  302.     If vsctl.OtherCount > 0 Then
  303.         endindex% = startindex% + vsctl.OtherCount - 1
  304.     Else
  305.         endindex% = startindex%
  306.     End If
  307.  
  308.     'allocate for new items
  309.     ReDim Preserve ConflictList(endindex%)
  310.  
  311.     otherindex% = 0
  312.     For curindex% = startindex% To endindex% Step 1
  313.         If vsctl.OtherCount > 0 Then
  314.             ConflictList(curindex%).ConflictFile = vsctl.OtherFile(otherindex%)
  315.             ConflictList(curindex%).ConflictVersion = vsctl.OtherVersion(otherindex%)
  316.             ConflictList(curindex%).ConflictDate = vsctl.OtherDateString(otherindex%)
  317.             ConflictList(curindex%).ConflictFXFlags = vsctl.OtherFlags(otherindex%)
  318.         End If
  319.  
  320.         ConflictList(curindex%).ConflictFlags = eflags
  321.         ' If more than one other files were found, create a linked list for them
  322.         If (curindex% <> endindex%) Then
  323.             ConflictList(curindex%).ConflictNext = curindex% + 1
  324.         Else
  325.             ConflictList(curindex%).ConflictNext = -1
  326.         End If
  327.         otherindex% = otherindex% + 1
  328.     Next
  329.  
  330. End Sub
  331.  
  332. Sub LogEnumComplete (vsctl As VersionStamp)
  333. Static scanningfiles%
  334.     'reset mousepointer
  335.     Screen.MousePointer = 0
  336.     
  337.     If Not scanningfiles% Then
  338.         'checking file conflicts
  339.         If ConflictFilesFound% > 0 Then Exit Sub
  340.  
  341.         ' If no file conflicts were found, make sure this EXE contains
  342.         ' embedded information, scan it to find out.
  343.         scanningfiles% = True
  344.         EmbedInfoFound% = False
  345.  
  346.         'double check to make sure we scanned a file with embedded information
  347.         If vsctl.VerifyMode = 2 Then
  348.             vsctl.VerifyMode = 3
  349.         Else
  350.             vsctl.ScanFile = FileToCheck$
  351.         End If
  352.     Else
  353.         ' This ends our scanning check.
  354.         scanningfiles% = False
  355.     End If
  356.  
  357. End Sub
  358.  
  359. Sub LogFileConflict (ReferenceFile As String, FoundFile As String, flags As Long, StopVerify As Integer, vsctl As VersionStamp)
  360.     Dim newidx%
  361.     ' Keep count of number of conflicts found.
  362.     ConflictFilesFound% = ConflictFilesFound% + 1
  363.     ' At each one, we add an entry to the global VerScanList
  364.     ' list of information.
  365.     newidx% = UBound(VerConflictList) + 1
  366.     ReDim Preserve VerConflictList(newidx%)
  367.  
  368.     ' We save here the information that we will need.
  369.     ' Save information for EVERY file that caused a conflict.
  370.     LoadConflictStruct VerConflictList(newidx%), ReferenceFile, FoundFile, flags, vsctl
  371.  
  372. End Sub
  373.  
  374. Sub StartVerify (vsctl As VersionStamp)
  375.     'clears global lists and other variables first
  376.     ReDim VerConflictList(0)
  377.     ReDim ConflictList(0)
  378.  
  379.     ConflictFilesFound% = 0
  380.  
  381.     'The file verify may take a while, so bring up hourglass.
  382.     Screen.MousePointer = 11
  383.     'Are we checking this Exe or some other file
  384.     If FileToCheck$ <> "" Then
  385.         If Right$(app.Path, 1) <> "\" Then
  386.             FileToCheck$ = app.Path & "\" & FileToCheck$
  387.         Else
  388.             FileToCheck$ = app.Path & FileToCheck$
  389.         End If
  390.         ' This method of verifying leaves the VerifyMode property at 0
  391.         vsctl.VerifyFile = FileToCheck$
  392.     Else
  393.         vsctl.VerifyMode = 2
  394.     End If
  395.  
  396. End Sub
  397.  
  398. Sub StopFileScan (ReferenceFile As String, VerifyFlags As Long, StopScan As Integer)
  399.     'This is used to check and make sure the target executable file has
  400.     'embedded information.
  401.     EmbedInfoFound% = True
  402.     'Since all we need to do is make sure at least one file was found
  403.     '(which tells us this EXE has embedded information), we can halt the scan.
  404.     StopScan = True
  405.  
  406. End Sub
  407.  
  408.