what Function DLL

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]

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

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.

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

Quote:

---

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.

Code:

---

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

---

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.

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. :)

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.

Code:

---

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

---

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.

OK...

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

Code:

---


' 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

---

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.

hahahahaha,

sorry, I didn't realise that'd happen

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

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

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

---

Sorry,

They are listview controls!

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.

Code:

---

' 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

---

You can use this equivalent

Code:

---

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

---

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