home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / verdll / verinfo1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-10-15  |  6.9 KB  |  244 lines
  1. VERSION 2.00
  2. Begin Form verinfo1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "VerInfo Demo"
  5.    Height          =   4980
  6.    Icon            =   VERINFO1.FRX:0000
  7.    Left            =   2280
  8.    LinkMode        =   1  'Source
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   17.875
  11.    ScaleMode       =   4  'Character
  12.    ScaleWidth      =   32.125
  13.    Top             =   1815
  14.    Width           =   3975
  15.    Begin DriveListBox Drive1 
  16.       Height          =   288
  17.       Left            =   1836
  18.       TabIndex        =   7
  19.       Top             =   3792
  20.       Width           =   1908
  21.    End
  22.    Begin DirListBox Dir1 
  23.       Height          =   1884
  24.       Left            =   1830
  25.       TabIndex        =   5
  26.       Top             =   1428
  27.       Width           =   1896
  28.    End
  29.    Begin FileListBox File1 
  30.       Height          =   2955
  31.       Left            =   120
  32.       TabIndex        =   3
  33.       Top             =   984
  34.       Width           =   1575
  35.    End
  36.    Begin TextBox Text1 
  37.       Height          =   288
  38.       Left            =   1092
  39.       TabIndex        =   1
  40.       Text            =   "*.*"
  41.       Top             =   204
  42.       Width           =   2544
  43.    End
  44.    Begin Label Label1 
  45.       Caption         =   "Dri&ves:"
  46.       Height          =   216
  47.       Index           =   4
  48.       Left            =   1830
  49.       TabIndex        =   6
  50.       Top             =   3480
  51.       Width           =   660
  52.    End
  53.    Begin Label Label1 
  54.       Caption         =   "&Directories:"
  55.       Height          =   192
  56.       Index           =   3
  57.       Left            =   1830
  58.       TabIndex        =   4
  59.       Top             =   1104
  60.       Width           =   1236
  61.    End
  62.    Begin Label Label1 
  63.       Caption         =   "c:\"
  64.       Height          =   204
  65.       Index           =   2
  66.       Left            =   1830
  67.       TabIndex        =   8
  68.       Top             =   648
  69.       Width           =   1884
  70.    End
  71.    Begin Label Label1 
  72.       Caption         =   "&Files:"
  73.       Height          =   204
  74.       Index           =   0
  75.       Left            =   120
  76.       TabIndex        =   2
  77.       Top             =   648
  78.       Width           =   612
  79.    End
  80.    Begin Label Label1 
  81.       Caption         =   "File&Name:"
  82.       Height          =   204
  83.       Index           =   1
  84.       Left            =   120
  85.       TabIndex        =   0
  86.       Top             =   252
  87.       Width           =   936
  88.    End
  89.    Begin Menu AboutBox 
  90.       Caption         =   "&About"
  91.    End
  92.    Begin Menu EndProgram 
  93.       Caption         =   "&End"
  94.    End
  95. Sub AboutBox_Click ()
  96.     About2.Show
  97. End Sub
  98. Sub Dir1_Change ()
  99. File1.Path = Dir1.Path
  100. Label1(2).Caption = File1.Path
  101. End Sub
  102. Sub DisplayVerInfo ()
  103. Dim X As VS_VERSION
  104. '*** Get Version Info ****
  105. FileVer$ = "": ProdVer$ = "": FileFlags$ = ""
  106. FileOS$ = "": FileType$ = "": FileSubType$ = ""
  107. FileName$ = File1.List(File1.ListIndex)
  108. Directory$ = Label1(2).Caption
  109. FullFileName$ = Label1(2).Caption + "\" + FileName$
  110. BufSize& = GetFileVersionInfoSize(FullFileName$, dwHandle&)
  111. If BufSize& = 0 Then
  112. MsgBox "No Version Info available!"
  113. Exit Sub
  114. End If
  115. lpvData$ = Space$(BufSize&)
  116. r% = GetFileVersionInfo(FullFileName$, dwHandle&, BufSize&, lpvData$)
  117. hmemcpy X, ByVal lpvData$, Len(X)
  118. '**** Determine File Version number ****
  119. FileVer$ = LTrim$(Str$(HIWORD(X.dwFileVersionMS))) + "."
  120. FileVer$ = FileVer$ + LTrim$(Str$(LOWORD(X.dwFileVersionMS)))
  121. '**** Determine Product Version number ****
  122. ProdVer$ = LTrim$(Str$(HIWORD(X.dwFileVersionMS))) + "."
  123. ProdVer$ = ProdVer$ + LTrim$(Str$(LOWORD(X.dwProductVersionMS)))
  124. '**** Determine Boolean attributes of File ****
  125. If X.dwFileFlags And VS_FF_DEBUG Then FileFlags$ = "DeBug"
  126. If X.dwFileFlags And VS_FF_PRERELEASE Then FileFlags$ = FileFlags$ + "PreRel"
  127. If X.dwFileFlags And VS_FF_PATCHED Then FileFlags$ = FileFlags$ + "Patched"
  128. If X.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags$ = FileFlags$ + "Private"
  129. If X.dwFileFlags And VS_FF_INFOINFERRED Then FileFlags$ = FileFlags$ + "Info"
  130. If X.dwFileFlags And VS_FF_DEBUG Then FileFlags$ = FileFlags$ + "Special"
  131. If X.dwFileFlags And &HFFFFFF00 Then FileFlags$ = FileFlags$ + "Unknown"
  132. '**** Determine OS for which file was designed ****
  133. Select Case X.dwFileOS
  134.     Case VOS_DOS_WINDOWS16
  135.         FileOS$ = "DOS-Win16"
  136.     Case VOS_DOS_WINDOWS32
  137.         FileOS$ = "DO =Win32"
  138.     Case VOS_OS216_PM16
  139.         FileOS$ = "OS/2-16 PM-16"
  140.     Case VOS_OS232_PM32
  141.         FileOS$ = "OS/2-32 PM-32"
  142.     Case VOS_NT_WINDOWS32
  143.         FileOS$ = "NT-Win32"
  144.     Case Else
  145.         FileOS$ = "Unknown"
  146. End Select
  147. '**** Determine Type and SubType of File ****
  148. Select Case X.dwFileType
  149.     Case VFT_APP
  150.         FileType$ = "App"
  151.     Case VFT_DLL
  152.         FileType$ = "DLL"
  153.     Case VFT_DRV
  154.         FileType$ = "Driver"
  155.         Select Case X.dwFileSubType
  156.             Case VFT2_DRV_PRINTER
  157.                 FileSubType$ = "Printer drv"
  158.             Case VFT2_DRV_KEYBOARD
  159.                 FileSubType$ = "Keyboard drv"
  160.             Case VFT2_DRV_LANGUAGE
  161.                 FileSubType$ = "Language drv"
  162.             Case VFT2_DRV_DISPLAY
  163.                 FileSubType$ = "Display drv"
  164.             Case VFT2_DRV_MOUSE
  165.                 FileSubType$ = "Mouse drv"
  166.             Case VFT2_DRV_NETWORK
  167.                 FileSubType$ = "Network drv"
  168.             Case VFT2_DRV_INSTALLABLE
  169.                 FileSubType$ = "Installable"
  170.             Case VFT2_DRV_SOUND
  171.                 FileSubType$ = "Sound drv"
  172.             Case VFT2_DRV_COMM
  173.                 FileSubType$ = "Comm drv"
  174.             Case VFT2_UNKNOWN
  175.                 FileSubType$ = "Unknown"
  176.         End Select
  177.     Case VFT_FONT
  178.         FileType$ = "Font"
  179.         Select Case X.dwFileSubType
  180.             Case VFT_FONT_RASTER
  181.                 FileSubType$ = "Raster Font"
  182.             Case VFT_FONT_VECTOR
  183.                 FileSubType$ = "Vector Font"
  184.             Case VFT_FONT_TRUETYPE
  185.                 FileSubType$ = "TrueType Font"
  186.         End Select
  187.     Case VFT_VXD
  188.         FileType$ = "VxD"
  189.     Case VFT_STATIC_LIB
  190.         FileType$ = "Lib"
  191.     Case Else
  192.     FileType$ = "Unknown"
  193. End Select
  194. Verinfo2.Show 1
  195. End Sub
  196. Sub Drive1_Change ()
  197.     Dir1.Path = Drive1.Drive
  198.     File1.Path = Dir1.Path
  199.     Label1(2).Caption = File1.Path
  200. End Sub
  201. Sub EndProgram_Click ()
  202.     End
  203. End Sub
  204. Sub File1_Click ()
  205.     Text1.Text = File1.List(File1.ListIndex)
  206. End Sub
  207. Sub File1_DblClick ()
  208.     DisplayVerInfo
  209. End Sub
  210. Sub File1_PathChange ()
  211.     Text1.Text = "*.*"
  212.     File1.Pattern = "*.*"
  213. End Sub
  214. Sub Form_Load ()
  215.     Dim Buffer$
  216.     ' **** Set Default Dir to Windows System Subdirectory ****
  217.     Buffer$ = Space$(256)
  218.     r% = GetSystemDirectory(Buffer$, Len(Buffer$))
  219.     Dir1.Path = Buffer$
  220.     File1.Path = Buffer$
  221.     Drive1.Drive = Left$(Buffer$, 1)
  222.     About2.lbl_Title = "VER.DLL Demo"
  223.     About2.lbl_Version = "Version 10.15.94"
  224. End Sub
  225. Function HIWORD (X As Long) As Integer
  226.     HIWORD = X \ &HFFFF&
  227. End Function
  228. Function LOWORD (X As Long) As Integer
  229.     LOWORD = X And &HFFFF&
  230. End Function
  231. Sub Text1_KeyPress (KeyAscii As Integer)
  232.     If KeyAscii = 13 Then
  233.         File1.Pattern = Text1.Text
  234.     KeyAscii = 0
  235.     If File1.ListCount = 1 Then DisplayVerInfo
  236.         If File1.ListCount = 0 Then
  237.             MsgBox "Invalid Filename"
  238.             File1.Pattern = "*.*"
  239.             Text1.Text = "*.*"
  240.         End If
  241.         File1.SetFocus
  242.     End If
  243. End Sub
  244.