Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const MAX_PATH As Long = 260

Private Type IMAGE_DEBUG_INFORMATION
   List As Long
   Size As Long
   MappedBase As Long
   Machine As Long
   Characteristics As Long
   CheckSum As Long
   ImageBase As Long
   SizeOfImage As Long
   NumberOfSections As Long
   Sections As Long                       'pointer to a IMAGE_SECTION_HEADER type
   ExportedNamesSize As Long
   ExportedNames As Long
   NumberOfFunctionTableEntries As Long
   FunctionTableEntries As Long           'pointer to a IMAGE_FUNCTION_ENTRY type
   LowestFunctionStartingAddress As Long
   HighestFunctionEndingAddress As Long
   NumberOfFpoTableEntries As Long
   FpoTableEntries As Long
   SizeOfCoffSymbols As Long
   CoffSymbols As Long                    'pointer to the COFF symbol table
   SizeOfCodeViewSymbols As Long
   CodeViewSymbols As Long
   ImageFilePath As Long
   ImageFileName As Long
   DebugFilePath As Long
   TimeDateStamp As Long
   RomImage As Long
   DebugDirectory As Long                 'pointer to a IMAGE_DEBUG_DIRECTORY type
   NumberOfDebugDirectories As Long
   OriginalFunctionTableBaseAddress As Long
   Reserved0 As Long
   Reserved1 As Long
   Reserved2 As Long
End Type

Private Declare Function MapDebugInformation Lib "ImageHlp.dll" _
  (ByVal FileHandle As Long, _
   ByVal FileName As String, _
   ByVal SymbolPath As String, _
   ByVal ImageBase As Long) _
   As Long

Private Declare Function UnmapDebugInformation Lib "imagehlp.dll" _
  (ByVal DebugInfo As Long) As Long

Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   ByVal lpSecurityAttributes As Long, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) _
   As Long

Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)


Private Function GetFileImageInformation(sDLLName As String) As String

   On Local Error GoTo fileExport_error
   
   Dim IMGDBG As IMAGE_DEBUG_INFORMATION
   Dim hFile As Long
   Dim ptrDbg As Long
   Dim strOut As String
   Const ERR_GENERIC = vbObjectError + 5555

  'obtain a handle to the specified file
   hFile = CreateFile(sDLLName, GENERIC_READ, _
                      FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                      0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)

  'if the handle is invalid, raise an
  'error to properly clean up and exit
   If hFile = INVALID_HANDLE_VALUE Then
       Err.Raise ERR_GENERIC
   End If

  'obtain a pointer to the image debug
  'info in the passed file
   ptrDbg = MapDebugInformation(hFile, sDLLName, vbNullString, 0&)
   
  'if the handle is invalid, raise an
  'error to properly clean up and exit
   If ptrDbg = 0 Then
       Err.Raise ERR_GENERIC
   End If
   
  'fill the UDT with the image debug info
   Call CopyMemory(IMGDBG, ByVal ptrDbg, Len(IMGDBG))

  'pad a string sufficiently large enough to
  'receive the string of exported functions
  'and copy the functions into the string.
   With IMGDBG
      strOut = String$(.ExportedNamesSize, vbNullChar)
      Call CopyMemory(ByVal strOut, ByVal .ExportedNames, .ExportedNamesSize)
   End With
   
  'if the calls above are successful, and the
  'file has exported methods, return the string
  'consisting of a series of null-terminated
  'strings naming all the functions exported
  'from the image
   GetFileImageInformation = strOut


fileExport_exit:
    Call UnmapDebugInformation(ptrDbg)
    Call CloseHandle(hFile)
    On Error GoTo 0
    Exit Function

fileExport_error:
    GetFileImageInformation = vbNullString
    Resume fileExport_exit
    
End Function


Private Sub Command1_Click()

   Dim sExports As String
   Dim tmp As String
   
   On Local Error GoTo enumdata_error
   
  'set up the common dialog
   With CommonDialog1
   
      .Flags = cdlOFNExplorer Or cdlOFNPathMustExist
      .CancelError = True
      .Filter = "DLL's (*.dll)|*.dll|OCX's (*.ocx)|*.ocx|All Files (*.*)|*.*"
      
     'get the file
      .ShowOpen
      
     'double check
      If Len(.FileName) > 0 Then
      
        'set up the form
         List1.Clear
         Label1.Caption = LCase$(.FileName)
      
        'retrieve the exported functions
         sExports = GetFileImageInformation(.FileName)
         
        'double check
         If Len(sExports) > 0 Then
         
           'remove an item from the string
           'returned and add to the list
            Do While Len(sExports) > 0 
               
               List1.AddItem StripNulls(sExports)
               
            Loop
         
         End If 'If Len(sExports)
      End If 'If .FileName
   End With 'With CDlg1
   

enumdata_exit:
   Exit Sub

enumdata_error:

   Label1.Caption = Err.Description
   Resume enumdata_exit
   
End Sub


Private Function StripNulls(startstr As String) As String

  Dim pos As Long
  pos = InStr(startstr, Chr$(0))
  
  If pos Then
      
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
    
  End If

End Function