what Function DLL

[catocom]

I used to have a little program that would
take a DLL and show what it had in it, but
I don't remember what it was called.

What do you guys use?
Does vb5 it's self have a way to do this?

P.S.

but i'd still like to know how to use
multiple keydowns with SendKey, or if
it can be done.

[Edited by catocom on 07-03-2000 at 05:17 AM]

[Paul282]

I've got an app that came in my API book and it shows all the imports and exports of a dll.

I'll try to find it tonight when I get home. It's not big so I'll send you the project (or if the code is fairly compact, post the code)

Paul

[Iain17]

I don't know VB 5 so i am not sure if this will work.

In VB 6 there is an object browser (F2). If you add a dll to your project you can view all of the properties, events, and methods of that dll.

[Paul282]

Oh?

Do you just mean ActiveX dlls? I was talking about opening C/C++ Dlls like the GDI32.dll etc

But yeah, if they're activex dlls then the object browser will give you more info

Originally posted by catocom
but i'd still like to know how to use
multiple keydowns with SendKey, or if
it can be done.

You can use multiple SendKeys by using this code. It will open Notepad and send the text Hello! to it.

Shell "C:\Windows\Notepad.exe", vbNormalFocus
AppActivate "Untitled - Notepad"
SendKeys "Hello!"

[catocom]

Thanks for the replies guys!

Paul if you you'd post that code I'll check it out.
Please thankyou.

-------------------------

Megatron sorry I wasn't very clear.
What I was talking about was like
Hold down (crtl) hold down (alt) and press (-)

or something like that.

---------------------------

Thanks for the input Lain.
Wouldn't it be nice if Object Browser would
show all DLLs.

[MrShickadance]

In Windows NT you should be able to right-click on a DLL and select "Quick View" This shows you all functions in a DLL and all references to other DLL's. Just though I would mention that.

[catocom]

I must not be getting enough sleep.
I didn't even think about Quick View.

Thanks MrShickadance!!

That also gave me an idea for my very next
program.

I'm going to make a Search/database/help program
that will search the harddrive(s) for all files
that contain functions that can be used in vb,
sort them in a database showing the file it's linked
to, and were I can anotate each one then make
help file for example code for each one.

For the SendKey's try this. This will send Ctrl, Alt and - at the same time.

AppActivate "MyAppTitle"
SendKeys "^" & "%" & "-"

[catocom]

That's exactly what I needed to Know.

I"ve got about ten books on vb and none
had anything that resembled that.
It would have probably taken me another
six months to figure it out.

[Paul282]

OK...

Haven't really looked at it very much...

' Bas file

Option Explicit

' ---------
' Constants
' ---------
Public Const MAX_PATH = 260

' Constants for Image file
Public Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16
Public Const IMAGE_SIZEOF_SHORT_NAME = 8
Public Const IMAGE_DIRECTORY_ENTRY_EXPORT = 0          ' Export Directory
Public Const IMAGE_DIRECTORY_ENTRY_IMPORT = 1          ' Import Directory

Public Const IMAGE_DIRECTORY_ENTRY_RESOURCE = 2        ' Resource Directory
Public Const IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3       ' Exception Directory
Public Const IMAGE_DIRECTORY_ENTRY_SECURITY = 4        ' Security Directory
Public Const IMAGE_DIRECTORY_ENTRY_BASERELOC = 5       ' Base Relocation Table
Public Const IMAGE_DIRECTORY_ENTRY_DEBUG = 6           ' Debug Directory
Public Const IMAGE_DIRECTORY_ENTRY_COPYRIGHT = 7       ' Description String
Public Const IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8       ' Machine Value (MIPS GP)
Public Const IMAGE_DIRECTORY_ENTRY_TLS = 9             ' TLS Directory
Public Const IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10    ' Load Configuration Directory
Public Const IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11   ' Bound Import Directory in headers
Public Const IMAGE_DIRECTORY_ENTRY_IAT = 12            ' Import Address Table

Public Const IMAGE_FILE_RELOCS_STRIPPED = &H1
Public Const IMAGE_FILE_EXECUTABLE_IMAGE = &H2
Public Const IMAGE_FILE_AGGRESSIVE_WS_TRIM = &H10
Public Const IMAGE_FILE_LARGE_ADDRESS_AWARE = &H20
Public Const IMAGE_FILE_BYTES_REVERSED_LO = &H80
Public Const IMAGE_FILE_BYTES_REVERSED_HI = &H8000
Public Const IMAGE_FILE_32BIT_MACHINE = &H100
Public Const IMAGE_FILE_DEBUG_STRIPPED = &H200
Public Const IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = &H400
Public Const IMAGE_FILE_SYSTEM = &H1000
Public Const IMAGE_FILE_DLL = &H2000
Public Const IMAGE_FILE_UP_SYSTEM_ONLY = &H4000
Public Const IMAGE_FILE_LINE_NUMS_STRIPPED = &H4
Public Const IMAGE_FILE_LOCAL_SYMS_STRIPPED = &H8
Public Const IMAGE_FILE_16BIT_MACHINE = &H40

' ----------------------
' Structures for PE File
' ----------------------

'-----------------------------------------------
' Data Directory entry
Public Type IMAGE_DATA_DIRECTORY  ' 8 bytes
   RVA  As Long
   size  As Long
End Type
'-----------------------------------------------
' Optional header (all three parts)
Public Type IMAGE_OPTIONAL_HEADER       ' 232 bytes
     'Standard fields.
   Magic  As Integer
   MajorLinkerVersion  As Byte
   MinorLinkerVersion  As Byte
   SizeOfCode  As Long
   SizeOfInitializedData  As Long
   SizeOfUninitializedData  As Long
   AddressOfEntryPoint  As Long
   BaseOfCode  As Long
   BaseOfData  As Long
     'NT additional fields.
   ImageBase  As Long
   SectionAlignment  As Long
   FileAlignment  As Long
   MajorOperatingSystemVersion  As Integer
   MinorOperatingSystemVersion  As Integer
   MajorImageVersion  As Integer
   MinorImageVersion  As Integer
   MajorSubsystemVersion  As Integer
   MinorSubsystemVersion  As Integer
   Win32VersionValue  As Long
   SizeOfImage  As Long
   SizeOfHeaders  As Long
   CheckSum  As Long
   Subsystem  As Integer
   DllCharacteristics  As Integer
   SizeOfStackReserve  As Long
   SizeOfStackCommit  As Long
   SizeOfHeapReserve  As Long
   SizeOfHeapCommit  As Long
   LoaderFlags  As Long
   NumberOfRvaAndSizes  As Long     '96
   ' Data directories
   DataDirectory(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES) As IMAGE_DATA_DIRECTORY   ' 17*8 + 96 = 232
End Type

'-----------------------------------------------
' COFF File header
Public Type IMAGE_COFF_HEADER     ' 20 bytes
   Machine  As Integer
   NumberOfSections  As Integer
   TimeDateStamp  As Long
   PointerToSymbolTable  As Long
   NumberOfSymbols  As Long
   SizeOfOptionalHeader  As Integer
   Characteristics  As Integer
End Type

'-----------------------------------------------
' PE File header without MS-DOS stub
Public Type IMAGE_PE_FILE_HEADER   ' 256 bytes
   Signature  As Long                           ' 4 bytes -- PE signature
   FileHeader As IMAGE_COFF_HEADER            ' 20 bytes -- This is the COFF header
   OptionalHeader As IMAGE_OPTIONAL_HEADER    ' 232 bytes
End Type

'-----------------------------------------------
' Section header
Public Type IMAGE_SECTION_HEADER    '40 bytes
   ImageName(0 To IMAGE_SIZEOF_SHORT_NAME) As Byte       ' 8 bytes
   Misc As Long
   VirtualAddress As Long
   SizeofRawData As Long
   PointerToRawData As Long
   PointerToRelocations As Long
   PointerToLinenumbers As Long
   NumberOfRelocations As Integer
   NumberOfLinenumbers As Integer
   Characteristics As Long
End Type

'-----------------------------------------------
' Export Directory table
Public Type IMAGE_EXPORT_DIRECTORY_TABLE  ' 40 bytes
   Characteristics  As Long
   TimeDateStamp  As Long
   MajorVersion  As Integer
   MinorVersion  As Integer
   Name As Long
   Base As Long
   NumberOfFunctions  As Long
   NumberOfNames As Long                 ' We need this one
   pAddressOfFunctions  As Long
   ExportNamePointerTableRVA  As Long     ' We need this one
   pAddressOfNameOrdinals  As Long
End Type

'-----------------------------------------------
'-----------------------------------------------
' List entry -- Used by LOADED_IMAGE (for MapAndLoad)
Public Type LIST_ENTRY         ' 8 bytes
   FLink As Long
   Blink As Long
End Type

'-----------------------------------------------
' Loaded Image -- For use with MapAndLoad
Public Type LOADED_IMAGE       ' 48 bytes (46 bytes packed)
   ModuleName As Long
   hFile As Long
   MappedAddress As Long         ' Base address of mapped file
   pFileHeader As Long           ' Pointer to IMAGE_PE_FILE_HEADER
   pLastRvaSection As Long       ' Pointer to first COFF section header (section table)??
   NumberOfSections As Long
   pSections As Long             ' Pointer to first COFF section header (section table)??
   Characteristics As Long       ' Image characteristics value
   fSystemImage As Byte
   fDOSImage As Byte
   Links As LIST_ENTRY            ' 2 longs
   SizeOfImage As Long
End Type


' -----------------------------
' Function to use with PE files
' -----------------------------

'''''BOOL MapAndLoad(
'''''   IN LPSTR ImageName,
'''''   IN LPSTR DllPath,
'''''   OUT PLOADED_IMAGE LoadedImage,
'''''   IN BOOL DotDll,
'''''   IN BOOL ReadOnly);

Public Declare Function MapAndLoad Lib "Imagehlp.dll" ( _
   ByVal ImageName As String, _
   ByVal DLLPath As String, _
   LoadedImage As LOADED_IMAGE, _
   DotDLL As Long, _
   ReadOnly As Long) As Long

'''''BOOL UnMapAndLoad(
'''''  IN PLOADED_IMAGE LoadedImage
''''');

Public Declare Function UnMapAndLoad Lib "Imagehlp.dll" ( _
   LoadedImage As LOADED_IMAGE) As Long

'''''LPVOID ImageRvaToVa(
'''''  IN PIMAGE_PE_FILE_HEADER NtHeaders,
'''''  IN LPVOID Base,
'''''  IN DWORD Rva,
'''''  IN OUT PIMAGE_SECTION_HEADER *LastRvaSection
''''');
 
Public Declare Function ImageRvaToVa Lib "Imagehlp.dll" ( _
   ByVal NTHeaders As Long, _
   ByVal Base As Long, _
   ByVal RVA As Long, _
   ByVal LastRvaSection As Long) As Long


' --------------
' For API errors
' --------------
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200

Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
  ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

' ----------
' CopyMemory
' ----------
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
   lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

' ----
' Misc
' ----
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" ( _
   ByVal lpBuffer As String, _
   ByVal nSize As Long _
) As Long

Declare Sub VBGetTarget Lib "kernel32" Alias "RtlMoveMemory" ( _
   Target As Any, _
   ByVal lPointer As Long, _
   ByVal cbCopy As Long)

' ------
' Other API
' ------
Declare Function lstrlenA Lib "kernel32" (ByVal lpsz As Long) As Long

' ------------
' Version Info
' ------------
Public Const LANG_ENGLISH = &H409         ' include files say = &H09 ??
   
Public Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersion As Long
   dwFileVersionMS As Long
   dwFileVersionLS As Long
   dwProductVersionMS As Long
   dwProductVersionLS As Long
   dwFileFlagsMask As Long
   dwFileFlags As Long
   dwFileOS As Long
   dwFileType As Long
   dwFileSubtype As Long
   dwFileDateMS As Long
   dwFileDateLS As Long
End Type

Public Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" ( _
   ByVal lptstrFilename As String, _
   lpdwHandle As Long _
) As Long

Public Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" ( _
   ByVal lptstrFilename As String, _
   ByVal dwHandle As Long, _
   ByVal dwLen As Long, _
   lpData As Byte _
) As Long

Public Declare Function VerLanguageName Lib "version.dll" Alias "VerLanguageNameA" ( _
   ByVal wLang As Long, _
   ByVal szLang As String, _
   ByVal nSize As Long _
) As Long

Public Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" ( _
   pBlock As Byte, _
   ByVal lpSubBlock As String, _
   lplpBuffer As Long, _
   puLen As Long _
) As Long

Public Function GetAPIErrorText(ByVal lError As Long) As String
    
   Dim sOut As String
   Dim sMsg As String
   Dim lret As Long
   
   GetAPIErrorText = ""
   sMsg = String$(256, 0)
   
   lret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                       FORMAT_MESSAGE_IGNORE_INSERTS, _
                       0&, lError, 0&, sMsg, Len(sMsg), 0&)
   
   sOut = "Error: " & lError & "(&H" & Hex(lError) & "): "
   If lret <> 0 Then
      ' Check for ending vbcrlf
      sMsg = Trim0(sMsg)
      If Right$(sMsg, 2) = vbCrLf Then sMsg = Left$(sMsg, Len(sMsg) - 2)
      sOut = sOut & Trim0(sMsg)
   Else
      sOut = sOut & "<No such error>"
   End If
   
   GetAPIErrorText = sOut
      
End Function
Public Sub RaiseApiError(ByVal e As Long)
Err.Raise vbObjectError + 29000 + e, App.EXEName & ".Windows", GetAPIErrorText(e)
End Sub

Public Function Trim0(sName As String) As String

' Keep left portion of string sName up to first 0. Useful with Win API null terminated strings.

Dim x As Integer
x = InStr(sName, Chr$(0))
If x > 0 Then Trim0 = Left$(sName, x - 1) Else Trim0 = sName

End Function

Function GetPEChar(vValue As Variant) As String

' Function returns name of constant for given value.

Dim sName As String
sName = ""

If (vValue And &H1) Then sName = sName & "   RELOCS_STRIPPED" & vbCrLf
If (vValue And &H2) Then sName = sName & "   EXECUTABLE_IMAGE" & vbCrLf
If (vValue And &H10) Then sName = sName & "   AGGRESSIVE_WS_TRIM" & vbCrLf
If (vValue And &H20) Then sName = sName & "   LARGE_ADDRESS_AWARE" & vbCrLf
If (vValue And &H80) Then sName = sName & "   BYTES_REVERSED_LO" & vbCrLf
If (vValue And &H8000) Then sName = sName & "   BYTES_REVERSED_HI" & vbCrLf
If (vValue And &H100) Then sName = sName & "   32BIT_MACHINE" & vbCrLf
If (vValue And &H200) Then sName = sName & "   DEBUG_STRIPPED" & vbCrLf
If (vValue And &H400) Then sName = sName & "   REMOVABLE_RUN_FROM_SWAP" & vbCrLf
If (vValue And &H1000) Then sName = sName & "   SYSTEM_FILE" & vbCrLf

If (vValue And &H2000) Then sName = sName & "   DLL" & vbCrLf
If (vValue And &H4000) Then sName = sName & "   UP_SYSTEM_ONLY" & vbCrLf

If (vValue And &H4) Then sName = sName & "   LINE_NUMS_STRIPPED" & vbCrLf
If (vValue And &H8) Then sName = sName & "   LOCAL_SYMS_STRIPPED" & vbCrLf
If (vValue And &H40) Then sName = sName & "   16BIT_MACHINE" & vbCrLf

If Right$(sName, 2) = vbCrLf Then sName = Left$(sName, Len(sName) - 2)
GetPEChar = sName

End Function

Function LPSTRtoBSTR(ByVal lpsz As Long) As String

' Input: a valid LPSTR pointer lpsz
' Output: a sBSTR with the same character array

Dim cChars As Long

' Get number of characters in lpsz
cChars = lstrlenA(lpsz)

' Initialize string
LPSTRtoBSTR = String$(cChars, 0)

' Copy string
CopyMemory ByVal StrPtr(LPSTRtoBSTR), ByVal lpsz, cChars

' Convert to Unicode
LPSTRtoBSTR = Trim0(StrConv(LPSTRtoBSTR, vbUnicode))

End Function








'Form

Option Explicit

Sub GetExports(sFile As String)

Dim i As Integer, j As Integer
Dim lret As Long
Dim baseaddr As Long
Dim rvaExportDirTable As Long
Dim vaExportDirTable As Long
Dim cNames As Long
Dim sName As String

' --------
' Pointers
' --------
' Pointer to Export Name Pointer Table
Dim ExportNamePointerTableVA As Long
' Pointer to next address
Dim pNextAddress As Long
' Next address
Dim lNextAddress As Long

' ----------
' Structures
' ----------
' Loaded image
Dim loadimage As LOADED_IMAGE
' PE File header
Dim peheader As IMAGE_PE_FILE_HEADER
' Export directory
Dim exportdir As IMAGE_EXPORT_DIRECTORY_TABLE
  
' ----------
' Load image
' ----------
lret = MapAndLoad(sFile, "", loadimage, True, True)

' Check for error and display
If lret = 0 Then
   txtVersion = "MapAndLoad failed for exports." & GetAPIErrorText(Err.LastDllError)
   Exit Sub
End If

' ------------
' Base address
' ------------
baseaddr = loadimage.MappedAddress

' -----------------------------
' Copy the IMAGE_PE_FILE_HEADER
' -----------------------------
' at address loadimage.pFileheader to
' peheader variable so we can access its members
CopyMemory ByVal VarPtr(peheader), ByVal loadimage.pFileHeader, 256

' -------------------------------
' Get the VA of export directory
' -------------------------------
rvaExportDirTable = peheader.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_EXPORT).RVA
If rvaExportDirTable = 0 Then
   txtVersion = "No export directory."
   Exit Sub
End If

' Call RvaToVa to get VA from RVA
vaExportDirTable = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, rvaExportDirTable, 0&)

'''''Debug.Print "MappedAddr:" & Hex(loadimage.MappedAddress)
'''''Debug.Print "rvaExportDirTable:" & Hex(rvaExportDirTable)
'''''Debug.Print "VA:" & Hex(vaExportDirTable)
'''''Debug.Print loadimage.MappedAddress + rvaExportDirTable - vaExportDirTable
'''''Debug.Print

' ------------------------------------
' Get Export Directory table structure
' ------------------------------------
CopyMemory ByVal VarPtr(exportdir), ByVal vaExportDirTable, LenB(exportdir)

' ----------------------
' Number of export names
' ----------------------
cNames = exportdir.NumberOfNames
lblExports.Caption = "Exports: " & cNames

' -------------------------------
' Get VA of Export Name Pointer Table
' -------------------------------
' exportdir.ExportNamePointerTableRVA is pointer to Export Name Pointer Table
' Convert RVA to VA
ExportNamePointerTableVA = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, exportdir.ExportNamePointerTableRVA, 0&)

' --------------------
' Collect Export Names
' --------------------
' Start at the beginning of names
pNextAddress = ExportNamePointerTableVA

' Get the next address (to export name)
VBGetTarget lNextAddress, pNextAddress, 4
lvExports.ListItems.Clear

For i = 0 To cNames - 1

   ' Convert address of this name from RVA to VA
   lNextAddress = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, lNextAddress, 0&)
   
   ' Convert ANSI string to BSTR
   sName = LPSTRtoBSTR(lNextAddress)
   lvExports.ListItems.Add , , sName

   ' Point to next address in table
   pNextAddress = pNextAddress + 4

   ' Get the address
   VBGetTarget lNextAddress, pNextAddress, 4

Next

UnloadImage:

' ------------
' Unload image
' ------------
lret = UnMapAndLoad(loadimage)
If lret = 0 Then
   txtVersion = "UnMapAndLoad failed for exports." & GetAPIErrorText(Err.LastDllError)
End If

End Sub
Sub GetImports(sFile As String)

Dim i As Integer, j As Integer
Dim lret As Long
Dim baseaddr As Long
Dim rvaImportDirTable As Long
Dim vaImportDirTable As Long

Dim cNames As Long
Dim sDLLName As String
Dim sFunctionName As String

Dim li As ListItem

' --------
' Pointers
' --------
Dim pImportDirTableEntry As Long
Dim LookupTableRVA As Long
Dim LookupTableVA As Long
Dim pLookupTableEntry As Long
Dim LookupTableEntry As Long
Dim pImportFunctionName As Long
Dim DLLNameRVA As Long
Dim DLLNameVA As Long

' ----------
' Structures
' ----------
' Loaded image
Dim loadimage As LOADED_IMAGE
' PE File header
Dim peheader As IMAGE_PE_FILE_HEADER
  
' ----------
' Load image
' ----------
lret = MapAndLoad(sFile, "", loadimage, True, True)

' Check for error and display
If lret = 0 Then
   txtVersion = "MapAndLoad failed for imports." & GetAPIErrorText(Err.LastDllError)
   Exit Sub
End If

' ------------
' Base address
' ------------
baseaddr = loadimage.MappedAddress

' -----------------------------
' Copy the IMAGE_PE_FILE_HEADER
' -----------------------------
' at address loadimage.pFileheader to
' peheader variable so we can access its members
CopyMemory ByVal VarPtr(peheader), ByVal loadimage.pFileHeader, 256

' -------------------------------
' Get the VA of import directory
' -------------------------------
rvaImportDirTable = peheader.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_IMPORT).RVA
If rvaImportDirTable = 0 Then
   txtVersion = "No import directory."
   Exit Sub
End If

' Call RvaToVa to get VA from RVA
vaImportDirTable = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, rvaImportDirTable, 0&)

' -----------------------------------------------
' Cycle through Import Dir Table until null entry
' -----------------------------------------------
lvImports.ListItems.Clear
cNames = 0

' Start with first entry in Import Dir Table
pImportDirTableEntry = vaImportDirTable

Do
   VBGetTarget LookupTableRVA, pImportDirTableEntry, 4
   VBGetTarget DLLNameRVA, pImportDirTableEntry + 12, 4
   If LookupTableRVA = 0 And DLLNameRVA = 0 Then Exit Do
   ' Convert to VA
   LookupTableVA = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, LookupTableRVA, 0&)
   DLLNameVA = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, DLLNameRVA, 0&)
  
   sDLLName = LPSTRtoBSTR(DLLNameVA)
   
   ' Now get all imported functions from this DLL
   pLookupTableEntry = LookupTableVA
   
   Do
      VBGetTarget LookupTableEntry, pLookupTableEntry, 4
      If LookupTableEntry = 0 Then Exit Do
      
      ' Check most significant bit
      ' If 0 then skip since it is by ordinal not by name
      If LookupTableEntry >= 0 Then
         
         cNames = cNames + 1
         ' Mask MSB
         LookupTableEntry = LookupTableEntry And &H7FFFFFFF
      
         ' Convert RVA to VA to get address of function name
         pImportFunctionName = ImageRvaToVa(loadimage.pFileHeader, loadimage.MappedAddress, LookupTableEntry, 0&)
         
         ' Name is at offset 2 in entry
         sFunctionName = LPSTRtoBSTR(pImportFunctionName + 2)

         Set li = lvImports.ListItems.Add()
         li.Text = sFunctionName
         li.ListSubItems.Add , , sDLLName
      
      End If
      
      ' Next entry
      pLookupTableEntry = pLookupTableEntry + 4
   Loop

   ' Next Import Directory Table entry
   pImportDirTableEntry = pImportDirTableEntry + 20
   
Loop

lblImports = "Imports: " & cNames

UnloadImage:

' ------------
' Unload image
' ------------
lret = UnMapAndLoad(loadimage)
If lret = 0 Then
   txtVersion = "UnMapAndLoad failed for imports." & GetAPIErrorText(Err.LastDllError)
End If

End Sub

Private Sub chkDLLsOnly_Click()
   If chkDLLsOnly = 1 Then
      File1.Pattern = "*.dll"
   Else
      File1.Pattern = "*.*"
   End If
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()

On Error GoTo ERR_Drive1_Change

Dir1.Path = Drive1.Drive
File1.Path = Dir1.Path

Exit Sub
ERR_Drive1_Change:
   MsgBox "Error in Drive1_Change. " & Err.Number & ": " & Err.Description

End Sub

Private Sub File1_Click()

Dim sFile As String

sFile = File1.Path
If Right(sFile, 1) <> "\" Then sFile = sFile & "\"
sFile = sFile & File1.FileName

' Caption
Me.Caption = "rpiPEInfo: " & sFile

' Clear all controls
ClearAll
GetVersionInfo sFile
If GetPEFileChars Then
   GetExports sFile
   GetImports sFile
End If

End Sub
Sub ClearAll()

lvExports.ListItems.Clear
lvImports.ListItems.Clear
txtVersion = ""
txtDetails = ""

End Sub

Function GetPEFileChars() As Boolean

' Returns false if not a PE file (no PE signature)
' Otherwise opens the file and reads the characteristics flag
' which follows the PE file signature
' Also gets preferred base address.

On Error GoTo ERR_GetPEFileChars

Dim bSigOffset As Byte
Dim lCOFFOffset As Long
Dim lOptHeaderOffset As Long
Dim lSectionTableOffset As Long

Dim lBase As Long
Dim iFlag As Integer
Dim lDataDirEntryCount As Long

Dim lSignature As Long

Dim bSectionName(1 To 8) As Byte
Dim sSectionName As String

Dim i As Integer, j As Integer

Dim sText As String
Dim sFile As String
Dim fr As Integer
fr = FreeFile

txtDetails = txtDetails & vbCrLf & "FILE CHARACTERISTICS:"

' Get path/name of file
sFile = File1.Path
If Right(sFile, 1) <> "\" Then sFile = sFile & "\"
sFile = sFile & File1.FileName

Open sFile For Binary Access Read As #fr

'Check for PE file signature
Get #fr, &H3C + 1, bSigOffset
Get #fr, bSigOffset + 1, lSignature
If Not lSignature = &H4550 Then     ' PE\0\0 backwards in memory
   Close fr
   txtDetails = txtDetails & vbCrLf & "   No PE signature"
   Exit Function
End If

' -------------------
' Some table offsets
' -------------------
' COFF offset
lCOFFOffset = CLng(bSigOffset) + 4

' Optional Header offset
lOptHeaderOffset = lCOFFOffset + 20

' -------------------------------
' Get some values at these offsets
' -------------------------------
' Characteristics of file
Get #fr, lCOFFOffset + 18 + 1, iFlag
sText = GetPEChar(iFlag)

' Preferred image base address
Get #fr, lOptHeaderOffset + 28 + 1, lBase
sText = sText & vbCrLf & "Base Address: &H" & Hex(lBase)

' -------------------
' Section table names
' -------------------
' Number of data directory entries
Get #fr, lOptHeaderOffset + 92 + 1, lDataDirEntryCount

' Use this to find offset of section table
lSectionTableOffset = lOptHeaderOffset + 96 + lDataDirEntryCount * 8

' Get section table names
If lDataDirEntryCount > 0 Then
   sText = sText & vbCrLf & "SECTION NAMES:"
   For j = 1 To lDataDirEntryCount
      ' Be careful here is 8-character names are NOT null terminated!
      ' Thus, we use an 8-byte buffer
      For i = 1 To 8
         Get #fr, lSectionTableOffset + i + (j - 1) * 40, bSectionName(i)
      Next
      sSectionName = StrConv(bSectionName, vbUnicode)
      sSectionName = Trim(Replace(sSectionName, Chr(0), " "))
      If sSectionName <> "" Then
         sText = sText & vbCrLf & "   " & sSectionName
      End If
   
   Next

End If

Close fr

' -------
' Display
' -------
txtDetails = txtDetails & vbCrLf & sText
GetPEFileChars = True

Exit Function
ERR_GetPEFileChars:
   txtDetails = "Error " & Err.Number & ": " & Err.Description

End Function
Private Sub Form_Load()

Dim sDir As String
Dim lret As Long

lvImports.ColumnHeaders.Add , , "Function", lvImports.Width / 2
lvImports.ColumnHeaders.Add , , "DLL", lvImports.Width / 2, lvwColumnCenter
lvImports.View = lvwReport

lvExports.ColumnHeaders.Add , , "Function", lvExports.Width
lvExports.View = lvwReport

sDir = String(MAX_PATH, 0)
lret = GetSystemDirectory(sDir, MAX_PATH)
Drive1.Drive = sDir
Dir1.Path = sDir
chkDLLsOnly = 1

End Sub


Sub GetVersionInfo(sFQName)

Dim lFileVerInfoSize As Long
Dim lpHandle As Long
Dim lret As Long
Dim lpData As Long
Dim bData() As Byte
Dim sVersionValue As String
Dim pValue As Long
Dim ValueSize As Long
Dim ff As VS_FIXEDFILEINFO
Dim sFileVersion As String
Dim sProductVersion As String
Dim lUpper As Long
Dim lLower As Long
Dim sVersion As String
Dim i As Integer
Dim sCompany As String

' --------------------------
' Get file version info size
' --------------------------
lFileVerInfoSize = GetFileVersionInfoSize(sFQName, lpHandle)
If lFileVerInfoSize = 0 Then
   txtVersion = GetAPIErrorText(Err.LastDllError)
   Exit Sub
End If

' ----------------------------
' Get file version info buffer
' ----------------------------
ReDim bData(1 To lFileVerInfoSize)

lret = GetFileVersionInfo(sFQName, lpHandle, lFileVerInfoSize, bData(1))
If lret = 0 Then
   txtVersion = GetAPIErrorText(Err.LastDllError)
   Exit Sub
End If

' ------------------------------
' Get version info -- root block
' ------------------------------
sVersionValue = "\"
lret = VerQueryValue(bData(1), sVersionValue, pValue, ValueSize)  ' pValue is passed ByRef
If lret = 0 Then Exit Sub

CopyMemory ByVal VarPtr(ff), ByVal pValue, ValueSize
' OR
''CopyMemory ff, ByVal ppValue, ValueSize

' ---------------------------------
' Prepare file version (both halfs)
' ---------------------------------
lUpper = CLng(ff.dwFileVersionMS / &H10000)
lLower = CLng(ff.dwFileVersionMS And &HFFFF&)
sFileVersion = CStr(lUpper) & "." & CStr(lLower)

lUpper = CLng(ff.dwFileVersionLS / &H10000)
lLower = CLng(ff.dwFileVersionLS And &HFFFF&)
sFileVersion = sFileVersion & "." & CStr(lUpper) & "." & CStr(lLower)

' Prepare product version (both halfs)
lUpper = CLng(ff.dwProductVersionMS / &H10000)
lLower = CLng(ff.dwProductVersionMS And &HFFFF&)
sProductVersion = CStr(lUpper) & "." & CStr(lLower)

lUpper = CLng(ff.dwProductVersionLS / &H10000)
lLower = CLng(ff.dwProductVersionLS And &HFFFF&)
sProductVersion = sProductVersion & "." & CStr(lUpper) & "." & CStr(lLower)

sVersion = "File Version " & sFileVersion & vbCrLf & "Product Version " & sProductVersion

''dwFileDateXX seems always to be 0!
''sVersion = sVersion & "  TimeDateStamp: " & Hex(ff.dwFileDateMS) & Hex(ff.dwFileDateLS)
sVersion = sVersion & vbCrLf & "File Date: " & FileDateTime(sFQName)

' --------------------------------
' Get version info -- company name
' --------------------------------
' Get languages
Dim cLangs As Long
Dim iLangID As Integer
Dim iCodePageID As Integer
Dim sLangID As String
Dim sCodePageID As String
sVersionValue = "\VarFileInfo\Translation"
lret = VerQueryValue(bData(1), sVersionValue, pValue, ValueSize)  ' pValue is passed ByRef
If lret <> 0 Then
   cLangs = ValueSize / 4
   For i = 0 To cLangs - 1
      VBGetTarget iLangID, pValue + 4 * i, 2
      VBGetTarget iCodePageID, pValue + 4 * i + 2, 2
      If iLangID = LANG_ENGLISH Then Exit For
   Next
Else
   ' Use English anyway!!
   iLangID = &H409
   iCodePageID = &H4B0
End If

' Format these as 4-character hex strings
sLangID = Hex$(iLangID)
Do While Len(sLangID) < 4
   sLangID = "0" & sLangID
Loop
sCodePageID = Hex$(iCodePageID)
Do While Len(sCodePageID) < 4
   sCodePageID = "0" & sCodePageID
Loop

' Use English language
sVersionValue = "\StringFileInfo\" & sLangID & sCodePageID & "\CompanyName"
lret = VerQueryValue(bData(1), sVersionValue, pValue, ValueSize)  ' pValue is passed ByRef
If lret = 0 Then
   txtVersion = ""
   Exit Sub
End If
sCompany = ""
For i = 1 To ValueSize
   sCompany = sCompany & Chr(bData(pValue - VarPtr(bData(1)) + i))
Next

sVersion = sVersion & vbCrLf & "Company: " & sCompany

' ----------
' Display it
' ----------
txtDetails = sVersion

End Sub

Private Sub lvExports_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lvExports.SortKey = ColumnHeader.Index - 1
End Sub

Private Sub lvImports_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lvImports.SortKey = ColumnHeader.Index - 1
End Sub

Private Sub mnuCopyToClip_Click()
   CopyToClip
End Sub

Sub CopyToClip()

' Copy to clipboard

Dim s As String, i As Integer

s = Me.Caption

s = s & vbCrLf & "**********" & vbCrLf

s = s & txtDetails

s = s & vbCrLf & "**********" & vbCrLf

s = s & lblExports.Caption & vbCrLf
For i = 1 To lvExports.ListItems.Count
   s = s & lvExports.ListItems(i) & vbCrLf
Next

s = s & "**********" & vbCrLf

s = s & lblImports.Caption & vbCrLf
For i = 1 To lvImports.ListItems.Count
   s = s & lvImports.ListItems(i).Text & " (" & lvImports.ListItems(i).ListSubItems(1).Text & ")" & vbCrLf
Next

Clipboard.Clear
Clipboard.SetText s

MsgBox "Exports copied to clipboard.", vbInformation

End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

[catocom]

Thanks Paul!!!

This will keep me busy for awhile.

I just started writing my own program.
This will help tremendously !

I hope the program I'm writing will
make life easier for all vb programmers.

Paul, regarding your post, you have some smilies showing up in it, so if you want, you can choose to disable them.

[Paul282]

hahahahaha,

sorry, I didn't realise that'd happen

[catocom]

I think i just about got this prog ready
run, finaly, maybe?

What kind of Controls do I need to use
with this code?

Private Sub lvExports_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lvExports.SortKey = ColumnHeader.Index - 1
End Sub

Private Sub lvImports_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
lvImports.SortKey = ColumnHeader.Index - 1
End Sub

[Paul282]

Sorry,

They are listview controls!

[catocom]

I'm using VB5 witch I don't think supports the
Replace funtion. That's the only reason I can see
I'm getting this error.
Does anyone know a fix, workaround, or a referance
I can load to make this work.

It's giving me a "Variable Not Defined" error, and
highlights Replace.

' Get section table names
If lDataDirEntryCount > 0 Then
   sText = sText & vbCrLf & "SECTION NAMES:"
   For j = 1 To lDataDirEntryCount
      ' Be careful here is 8-character names are NOT null terminated!
      ' Thus, we use an 8-byte buffer
      For i = 1 To 8
         Get #fr, lSectionTableOffset + i + (j - 1) * 40, bSectionName(i)
      Next
      sSectionName = StrConv(bSectionName, vbUnicode)
      sSectionName = Trim(Replace(sSectionName, Chr(0), " "))
      If sSectionName <> "" Then
         sText = sText & vbCrLf & "   " & sSectionName
      End If
   
   Next

End If

[KWell]

You can use this equivalent

Function ReplaceFnct(MyStr As String, ToReplace As String, ReplacingBy As String) As String
 Dim i As Integer
 Dim StrTmp As String
 StrTmp = MyStr 
 i = InStr(StrTmp, ToReplace)
 
 While i <> 0
  StrTmp = Left(StrTmp, i - 1) & ReplacingBy & Mid(StrTmp, i + Len(ToReplace))
  i = InStr(StrTmp, ToReplace)
 Wend
 ReplaceFnct = StrTmp
End Function

[catocom]

I was about to go crazy.
I've been working on that for days.