关于API使用！！

[big_cactus]

如何调用VB里的API，最好有例子代码，多谢

[Ranma_True]

'This project needs 6 command buttons
Option Explicit
Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const DM_DUPLEX = &H1000&
Const DM_ORIENTATION = &H1&
Const PD_PRINTSETUP = &H40
Const PD_DISABLEPRINTTOFILE = &H80000
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type PAGESETUPDLG
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
flags As Long
ptPaperSize As POINTAPI
rtMinMargin As RECT
rtMargin As RECT
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As String
hPageSetupTemplate As Long
End Type
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 31
End Type
Private Type CHOOSEFONT
lStructSize As Long
hwndOwner As Long ' caller's window handle
hDC As Long ' printer DC/IC or NULL
lpLogFont As Long ' ptr. To a LOGFONT struct
iPointSize As Long ' 10 * size in points of selected font
flags As Long ' enum. Type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. To hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle of.EXE that
' contains cust. Dlg. Template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the EnumFonts
' call back with the extra FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type
Private Type PRINTDLG_TYPE
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hDC As Long
flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type
Private Type DEVNAMES_TYPE
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
extra As String * 100
End Type
Private Type DEVMODE_TYPE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Dim OFName As OPENFILENAME
Dim CustomColors() As Byte
Private Sub Command1_Click()
Dim sFile As String
sFile = ShowOpen
If sFile <> "" Then
MsgBox "You chose this file: " + sFile
Else
MsgBox "You pressed cancel"
End If
End Sub
Private Sub Command2_Click()
Dim sFile As String
sFile = ShowSave
If sFile <> "" Then
MsgBox "You chose this file: " + sFile
Else
MsgBox "You pressed cancel"
End If
End Sub
Private Sub Command3_Click()
Dim NewColor As Long
NewColor = ShowColor
If NewColor <> -1 Then
Me.BackColor = NewColor
Else
MsgBox "You chose cancel"
End If
End Sub
Private Sub Command4_Click()
MsgBox ShowFont
End Sub
Private Sub Command5_Click()
ShowPrinter Me
End Sub
Private Sub Command6_Click()
ShowPageSetupDlg
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
'Redim the variables to store the cutstom colors
ReDim CustomColors(0 To 16 * 4 - 1) As Byte
Dim I As Integer
For I = Lbound(CustomColors) To Ubound(CustomColors)
CustomColors(I) = 0
Next I
'Set the captions
Command1.Caption = "ShowOpen"
Command2.Caption = "ShowSave"
Command3.Caption = "ShowColor"
Command4.Caption = "ShowFont"
Command5.Caption = "ShowPrinter"
Command6.Caption = "ShowPageSetupDlg"
End Sub
Private Function ShowColor() As Long
Dim cc As CHOOSECOLOR
Dim Custcolor(16) As Long
Dim lReturn As Long

'set the structure size
cc.lStructSize = Len(cc)
'Set the owner
cc.hwndOwner = Me.hwnd
'set the application's instance
cc.hInstance = App.hInstance
'set the custom colors (converted to Unicode)
cc.lpCustColors = StrConv(CustomColors, vbUnicode)
'no extra flags
cc.flags = 0

'Show the 'Select Color'-dialog
If CHOOSECOLOR(cc) <> 0 Then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
Else
ShowColor = -1
End If
End Function
Private Function ShowOpen() As String
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the owner window
OFName.hwndOwner = Me.hwnd
'Set the application's instance
OFName.hInstance = App.hInstance
'Set the filet
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'Create a buffer
OFName.lpstrFile = Space$(254)
'Set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'Set the maximum number of chars
OFName.nMaxFileTitle = 255
'Set the initial directory
OFName.lpstrInitialDir = "C:\"
'Set the dialog title
OFName.lpstrTitle = "Open File - KPD-Team 1998"
'no extra flags
OFName.flags = 0

'Show the 'Open File'-dialog
If GetOpenFileName(OFName) Then
ShowOpen = Trim$(OFName.lpstrFile)
Else
ShowOpen = ""
End If
End Function
Private Function ShowFont() As String
Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
Dim fontname As String, retval As Long
lfont.lfHeight = 0 ' determine default height
lfont.lfWidth = 0 ' determine default width
lfont.lfEscapement = 0 ' angle between baseline and escapement vector
lfont.lfOrientation = 0 ' angle between baseline and orientation vector
lfont.lfWeight = FW_NORMAL ' normal weight I.e. Not bold
lfont.lfCharSet = DEFAULT_CHARSET ' use default character set
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS ' default precision mapping
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS ' default clipping precision
lfont.lfQuality = DEFAULT_QUALITY ' default quality setting
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN ' default pitch, proportional with serifs
lfont.lfFaceName = "Times New Roman" & vbNullChar ' string must be null-terminated
' Create the memory block which will act as the LOGFONT structure buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
pMem = GlobalLock(hMem) ' lock and get pointer
CopyMemory ByVal pMem, lfont, Len(lfont) ' copy structure's contents into block
' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
Cf.lStructSize = Len(cf) ' size of structure
cf.hwndOwner = Form1.hwnd ' window Form1 is opening this dialog box
cf.hDC = Printer.hDC ' device context of default printer (using VB's mechanism)
cf.lpLogFont = pMem ' pointer to LOGFONT memory block buffer
cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)
cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0) ' black
cf.nFontType = REGULAR_FONTTYPE ' regular font type I.e. Not bold or anything
cf.nSizeMin = 10 ' minimum point size
cf.nSizeMax = 72 ' maximum point size
' Now, call the function. If successful, copy the LOGFONT structure back into the structure
' and then print out the attributes we mentioned earlier that the user selected.
Retval = CHOOSEFONT(cf) ' open the dialog box
If retval <> 0 Then ' success
CopyMemory lfont, ByVal pMem, Len(lfont) ' copy memory back
' Now make the fixed-length string holding the font name into a "normal" string.
ShowFont = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
Debug.Print ' end the line
End If
' Deallocate the memory block we created earlier. Note that this must
' be done whether the function succeeded or not.
Retval = GlobalUnlock(hMem) ' destroy pointer, unlock block
retval = GlobalFree(hMem) ' free the allocated memory
End Function
Private Function ShowSave() As String
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the owner window
OFName.hwndOwner = Me.hwnd
'Set the application's instance
OFName.hInstance = App.hInstance
'Set the filet
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'Create a buffer
OFName.lpstrFile = Space$(254)
'Set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'Set the maximum number of chars
OFName.nMaxFileTitle = 255
'Set the initial directory
OFName.lpstrInitialDir = "C:\"
'Set the dialog title
OFName.lpstrTitle = "Save File - KPD-Team 1998"
'no extra flags
OFName.flags = 0

'Show the 'Save File'-dialog
If GetSaveFileName(OFName) Then
ShowSave = Trim$(OFName.lpstrFile)
Else
ShowSave = ""
End If
End Function
Private Function ShowPageSetupDlg() As Long
Dim m_PSD As PAGESETUPDLG
'Set the structure size
m_PSD.lStructSize = Len(m_PSD)
'Set the owner window
m_PSD.hwndOwner = Me.hwnd
'Set the application instance
m_PSD.hInstance = App.hInstance
'no extra flags
m_PSD.flags = 0

'Show the pagesetup dialog
If PAGESETUPDLG(m_PSD) Then
ShowPageSetupDlg = 0
Else
ShowPageSetupDlg = -1
End If
End Function
Public Sub ShowPrinter(frmOwner As Form, Optional PrintFlags As Long)
'-> Code by Donald Grover
Dim PrintDlg As PRINTDLG_TYPE
Dim DevMode As DEVMODE_TYPE
Dim DevName As DEVNAMES_TYPE

Dim lpDevMode As Long, lpDevName As Long
Dim bReturn As Integer
Dim objPrinter As Printer, NewPrinterName As String

' Use PrintDialog to get the handle to a memory
' block with a DevMode and DevName structures

PrintDlg.lStructSize = Len(PrintDlg)
PrintDlg.hwndOwner = frmOwner.hwnd

PrintDlg.flags = PrintFlags
On Error Resume Next
'Set the current orientation and duplex setting
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmSize = Len(DevMode)
DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
DevMode.dmPaperWidth = Printer.Width
DevMode.dmOrientation = Printer.Orientation
DevMode.dmPaperSize = Printer.PaperSize
DevMode.dmDuplex = Printer.Duplex
On Error GoTo 0

'Allocate memory for the initialization hDevMode structure
'and copy the settings gathered above into this memory
PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
lpDevMode = GlobalLock(PrintDlg.hDevMode)
If lpDevMode > 0 Then
CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
End If

'Set the current driver, device, and port name strings
With DevName
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
.wDefault = 0
End With

With Printer
DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
End With

'Allocate memory for the initial hDevName structure
'and copy the settings gathered above into this memory
PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
lpDevName = GlobalLock(PrintDlg.hDevNames)
If lpDevName > 0 Then
CopyMemory ByVal lpDevName, DevName, Len(DevName)
bReturn = GlobalUnlock(lpDevName)
End If

'Call the print dialog up and let the user make changes
If PrintDialog(PrintDlg) <> 0 Then

'First get the DevName structure.
lpDevName = GlobalLock(PrintDlg.hDevNames)
CopyMemory DevName, ByVal lpDevName, 45
bReturn = GlobalUnlock(lpDevName)
GlobalFree PrintDlg.hDevNames

'Next get the DevMode structure and set the printer
'properties appropriately
lpDevMode = GlobalLock(PrintDlg.hDevMode)
CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
GlobalFree PrintDlg.hDevMode
NewPrinterName = Ucase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
If Printer.DeviceName <> NewPrinterName Then
For Each objPrinter In Printers
If Ucase$(objPrinter.DeviceName) = NewPrinterName Then
Set Printer = objPrinter
'set printer toolbar name at this point
End If
Next
End If

On Error Resume Next
'Set printer object properties according to selections made
'by user
Printer.Copies = DevMode.dmCopies
Printer.Duplex = DevMode.dmDuplex
Printer.Orientation = DevMode.dmOrientation
Printer.PaperSize = DevMode.dmPaperSize
Printer.PrintQuality = DevMode.dmPrintQuality
Printer.ColorMode = DevMode.dmColor
Printer.PaperBin = DevMode.dmDefaultSource
On Error GoTo 0
End If
End Sub

[DeityFox]

Const VS_FFI_SIGNATURE = &HFEEF04BD
Const VS_FFI_STRUCVERSION = &H10000
Const VS_FFI_FILEFLAGSMASK = &H3F&
Const VS_FF_DEBUG = &H1
Const VS_FF_PRERELEASE = &H2
Const VS_FF_PATCHED = &H4
Const VS_FF_PRIVATEBUILD = &H8
Const VS_FF_INFOINFERRED = &H10
Const VS_FF_SPECIALBUILD = &H20
Const VOS_UNKNOWN = &H0
Const VOS_DOS = &H10000
Const VOS_OS216 = &H20000
Const VOS_OS232 = &H30000
Const VOS_NT = &H40000
Const VOS__BASE = &H0
Const VOS__WINDOWS16 = &H1
Const VOS__PM16 = &H2
Const VOS__PM32 = &H3
Const VOS__WINDOWS32 = &H4
Const VOS_DOS_WINDOWS16 = &H10001
Const VOS_DOS_WINDOWS32 = &H10004
Const VOS_OS216_PM16 = &H20002
Const VOS_OS232_PM32 = &H30003
Const VOS_NT_WINDOWS32 = &H40004
Const VFT_UNKNOWN = &H0
Const VFT_APP = &H1
Const VFT_DLL = &H2
Const VFT_DRV = &H3
Const VFT_FONT = &H4
Const VFT_VXD = &H5
Const VFT_STATIC_LIB = &H7
Const VFT2_UNKNOWN = &H0
Const VFT2_DRV_PRINTER = &H1
Const VFT2_DRV_KEYBOARD = &H2
Const VFT2_DRV_LANGUAGE = &H3
Const VFT2_DRV_DISPLAY = &H4
Const VFT2_DRV_MOUSE = &H5
Const VFT2_DRV_NETWORK = &H6
Const VFT2_DRV_SYSTEM = &H7
Const VFT2_DRV_INSTALLABLE = &H8
Const VFT2_DRV_SOUND = &H9
Const VFT2_DRV_COMM = &HA
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer ' e.g. = &h0000 = 0
dwStrucVersionh As Integer ' e.g. = &h0042 = .42
dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
dwFileFlagsMask As Long ' = &h3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Dim Filename As String, Directory As String, FullFileName As String
Dim StrucVer As String, FileVer As String, ProdVer As String
Dim FileFlags As String, FileOS As String, FileType As String, FileSubType As String
Private Sub DisplayVerInfo()
Dim rc As Long, lDummy As Long, sBuffer() As Byte
Dim lBufferLen As Long, lVerPointer As Long, udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long

'*** Get size ****
lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
If lBufferLen < 1 Then
MsgBox "No Version Info available!"
Exit Sub
End If

'**** Store info to udtVerBuffer struct ****
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)

'**** Determine Structure Version number - NOT USED ****
StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)

'**** Determine File Version number ****
FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)

'**** Determine Product Version number ****
ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)

'**** Determine Boolean attributes of File ****
FileFlags = ""
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then FileFlags = "Debug "
If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then FileFlags = FileFlags & "PreRel "
If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then FileFlags = FileFlags & "Patched "
If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private "
If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRE Then FileFlags = FileFlags & "Info "
If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special "
If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN Then FileFlags = FileFlags + "Unknown "

'**** Determine OS for which file was designed ****
Select Case udtVerBuffer.dwFileOS
Case VOS_DOS_WINDOWS16
FileOS = "DOS-Win16"
Case VOS_DOS_WINDOWS32
FileOS = "DOS-Win32"
Case VOS_OS216_PM16
FileOS = "OS/2-16 PM-16"
Case VOS_OS232_PM32
FileOS = "OS/2-16 PM-32"
Case VOS_NT_WINDOWS32
FileOS = "NT-Win32"
Case other
FileOS = "Unknown"
End Select
Select Case udtVerBuffer.dwFileType
Case VFT_APP
FileType = "App"
Case VFT_DLL
FileType = "DLL"
Case VFT_DRV
FileType = "Driver"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_DRV_PRINTER
FileSubType = "Printer drv"
Case VFT2_DRV_KEYBOARD
FileSubType = "Keyboard drv"
Case VFT2_DRV_LANGUAGE
FileSubType = "Language drv"
Case VFT2_DRV_DISPLAY
FileSubType = "Display drv"
Case VFT2_DRV_MOUSE
FileSubType = "Mouse drv"
Case VFT2_DRV_NETWORK
FileSubType = "Network drv"
Case VFT2_DRV_SYSTEM
FileSubType = "System drv"
Case VFT2_DRV_INSTALLABLE
FileSubType = "Installable"
Case VFT2_DRV_SOUND
FileSubType = "Sound drv"
Case VFT2_DRV_COMM
FileSubType = "Comm drv"
Case VFT2_UNKNOWN
FileSubType = "Unknown"
End Select
Case VFT_FONT
FileType = "Font"
Select Case udtVerBuffer.dwFileSubtype
Case VFT_FONT_RASTER
FileSubType = "Raster Font"
Case VFT_FONT_VECTOR
FileSubType = "Vector Font"
Case VFT_FONT_TRUETYPE
FileSubType = "TrueType Font"
End Select
Case VFT_VXD
FileType = "VxD"
Case VFT_STATIC_LIB
FileType = "Lib"
Case Else
FileType = "Unknown"
End Select
End Sub
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
'Source -> MS Knowledge Base
'set the file
Filename = "kernel32.dll"
Directory = "c:\windows\system\"
FullFileName = Directory + Filename
'set graphics mode to persistent
Me.AutoRedraw = True
'retrieve the information
DisplayVerInfo
'show the results
Me.Print "Full filename: " + FullFileName
Me.Print "File version: " + FileVer
Me.Print "Product version: " + ProdVer
Me.Print "File flags: " + FileFlags
Me.Print "File OS: " + FileOS
Me.Print "File type: " + FileType + IIf(FileSubType = "", "", " (" + FileSubType + ")")
End Sub