PE导出/输入表演示

本程序代码演示怎么遍历导出/输入表.下面是完整源码.

frmMain.fm

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "PE导出/输入表演示"
   ClientHeight    =   5655
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7890
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   7890
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdPath
      Caption         =   "..."
      Height          =   315
      Left            =   6960
      TabIndex        =   1
      Top             =   80
      Width           =   885
   End
   Begin VB.TextBox txtPath
      Height          =   285
      Left            =   0
      TabIndex        =   0
      Top             =   90
      Width           =   6915
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "退出(&C)"
      Height          =   375
      Left            =   6660
      TabIndex        =   6
      Top             =   5160
      Width           =   1185
   End
   Begin VB.CommandButton cmdImport
      Caption         =   "输入表(&I)"
      Height          =   375
      Left            =   5460
      TabIndex        =   5
      Top             =   5160
      Width           =   1185
   End
   Begin VB.CommandButton cmdExport
      Caption         =   "导出表(&E)"
      Height          =   375
      Left            =   4260
      TabIndex        =   4
      Top             =   5160
      Width           =   1185
   End
   Begin VB.ListBox lstImport
      Height          =   4560
      Left            =   3960
      TabIndex        =   3
      Top             =   450
      Width           =   3915
   End
   Begin VB.ListBox lstExport
      Height          =   4560
      Left            =   0
      TabIndex        =   2
      Top             =   450
      Width           =   3915
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Function IsArraryInitialize(strArray() As String) As Boolean
    On Error GoTo ErrHandle
    Dim i As Long
    i = UBound(strArray)
    IsArraryInitialize = True
    Exit Function
ErrHandle:
    IsArraryInitialize = False
End Function

Private Function IsObjArraryInitialize(objArray() As ImportDetailInfo) As Boolean
    On Error GoTo ErrHandle
    Dim i As Long
    i = UBound(objArray)
    IsObjArraryInitialize = True
    Exit Function
ErrHandle:
    IsObjArraryInitialize = False
End Function

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdExport_Click()
    Dim pExportInfo As ExportInfo, i As Integer
    If Trim(txtPath.Text) = "" Then
        MsgBox "请输入文件路径！！", vbCritical, "提示"
        txtPath.SetFocus
        Exit Sub
    End If
    If Dir(txtPath.Text, 1 Or 2 Or 4) = "" Then
        MsgBox "目标文件不存在！！", vbCritical, "提示"
        txtPath.SetFocus
        Exit Sub
    End If
    lstExport.Clear
    If GetExportTable(txtPath.Text, pExportInfo) Then
        lstExport.AddItem pExportInfo.strDllName & "导出函数列表："
        If IsArraryInitialize(pExportInfo.strFuns) Then
            For i = 0 To UBound(pExportInfo.strFuns)
                lstExport.AddItem "     " & pExportInfo.strFuns(i)
            Next
        End If
    End If
End Sub

Private Sub cmdImport_Click()
    Dim pImportInfo As ImportInfo, i As Integer, j As Integer
    If Trim(txtPath.Text) = "" Then
        MsgBox "请输入文件路径！！", vbCritical, "提示"
        txtPath.SetFocus
        Exit Sub
    End If
    If Dir(txtPath.Text, 1 Or 2 Or 4) = "" Then
        MsgBox "目标文件不存在！！", vbCritical, "提示"
        Exit Sub
    End If
    lstImport.Clear
    If GetImportTable(txtPath.Text, pImportInfo) Then
        lstImport.AddItem pImportInfo.strExePath & "输入函数列表："
        If IsObjArraryInitialize(pImportInfo.pDetailInfo) Then
            For i = 0 To UBound(pImportInfo.pDetailInfo)
                lstImport.AddItem "     模块：" & pImportInfo.pDetailInfo(i).strDllName & ""
                If IsArraryInitialize(pImportInfo.pDetailInfo(i).strFuns) Then
                    For j = 0 To UBound(pImportInfo.pDetailInfo(i).strFuns)
                        lstImport.AddItem "          " & pImportInfo.pDetailInfo(i).strFuns(j)
                    Next
                End If
            Next
        End If
    End If
End Sub

Private Sub cmdPath_Click()
    txtPath.Text = ShowDialogFile(Me.hWnd, 1, "请选择文件", "", "文件 (*.*)" & Chr(0) & "*.*", "", "")
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

modPEInfo.bas

Attribute VB_Name = "modPEInfo"

Option Explicit
Private Declare Function MapAndLoad Lib "imagehlp.dll" (ByVal ImageName As String, ByVal DllPath As String, LoadedImage As LOADED_IMAGE, ByVal DotDll As Boolean, ByVal ReadOnly As Boolean) As Long
Private Declare Function UnMapAndLoad Lib "imagehlp.dll" (hBase As Any) As Long
Private Declare Function ImageRvaToVa Lib "dbghelp" (ByRef NtHeaders As Any, Base As Any, ByVal Rva As Long, ByRef LastRvaSection As Any) As Long
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes As Any, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long

Private Type LOADED_IMAGE      '48个字节
   ModuleName As Long
   hFile As Long
   MappedAddress As Long      '映射文件基址
   pFileHeader As Long         'IMAGE_PE_FILE_HEADER的指针
   pLastRvaSection As Long      '第一个COFF段文件头的指针   ??
   NumberOfSections As Long
   pSections As Long         '第一个COFF段文件头的指针
   Characteristics As Long      '映像特征值
   fSystemImage As Byte
   fDosImage As Byte
   Links(7) As Byte         '2个长整型
   SizeOfImage As Long
End Type

Private Const FILE_MAP_READ = 4
Private Const PAGE_READONLY = &H2
Private Enum ImageSignatureTypes
   IMAGE_DOS_SIGNATURE = &H5A4D     ''// MZ
   IMAGE_OS2_SIGNATURE = &H454E     ''// NE
   IMAGE_OS2_SIGNATURE_LE = &H454C  ''// LE
   IMAGE_VXD_SIGNATURE = &H454C     ''// LE
   IMAGE_NT_SIGNATURE = &H4550      ''// PE00
End Enum

Private Type IMAGE_DOS_HEADER
    Magic    As Integer
    cblp     As Integer
    cp       As Integer
    crlc     As Integer
    cparhdr  As Integer
    minalloc As Integer
    maxalloc As Integer
    ss       As Integer
    sp       As Integer
    csum     As Integer
    ip       As Integer
    cs       As Integer
    lfarlc   As Integer
    ovno     As Integer
    res(3)   As Integer
    oemid    As Integer
    oeminfo  As Integer
    res2(9)  As Integer
    lfanew      As Long
End Type

Private Type IMAGE_FILE_HEADER
    Machine              As Integer
    NumberOfSections     As Integer
    TimeDateStamp        As Long
    PointerToSymbolTable As Long
    NumberOfSymbols      As Long
    SizeOfOtionalHeader  As Integer
    Characteristics      As Integer  '标志Dll
End Type

Private Type IMAGE_DATA_DIRECTORY
    DataRVA     As Long
    DataSize    As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
    Magic             As Integer
    MajorLinkVer      As Byte
    MinorLinkVer      As Byte
    CodeSize          As Long
    InitDataSize      As Long
    unInitDataSize    As Long
    EntryPoint        As Long
    CodeBase          As Long
    DataBase          As Long
    ImageBase         As Long
    SectionAlignment  As Long
    FileAlignment     As Long
    MajorOSVer        As Integer
    MinorOSVer        As Integer
    MajorImageVer     As Integer
    MinorImageVer     As Integer
    MajorSSVer        As Integer
    MinorSSVer        As Integer
    Win32Ver          As Long
    ImageSize         As Long
    HeaderSize        As Long
    Checksum          As Long
    Subsystem         As Integer
    DLLChars          As Integer
    StackRes          As Long
    StackCommit       As Long
    HeapReserve       As Long
    HeapCommit        As Long
    LoaderFlags       As Long
    RVAsAndSizes      As Long
    DataEntries(15)   As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_NT_HEADERS
    Signature As Long
    FileHeader As IMAGE_FILE_HEADER
    OptionalHeader As IMAGE_OPTIONAL_HEADER
End Type

Private Type IMAGE_SECTION_HEADER
    SectionName(7)    As Byte
    Address           As Long
    VirtualAddress    As Long
    SizeOfData        As Long
    PData             As Long
    PReloc            As Long
    PLineNums         As Long
    RelocCount        As Integer
    LineCount         As Integer
    Characteristics   As Long
End Type

Private Type IMAGE_IMPORT_DESCRIPTOR
    Characteristics As Long
    TimeDateStamp As Long
    ForwarderChain As Long
    pName As Long
    FirstThunk As Long
End Type

Private Type IMAGE_EXPORT_DIRECTORY
    Characteristics As Long
    TimeDateStamp As Long
    MajorVersion As Integer
    MinorVersion As Integer
    pName As Long
    Base As Long
    NumberOfFunctions As Long
    NumberOfNames As Long
    AddressOfFunctions As Long
    AddressOfNames As Long
    AddressOfNameOrdinals As Long
End Type

Private Type IMAGE_IMPORT_BY_NAME
    Hint As Integer
    pName(259) As Byte
'    pName As Integer
End Type

Private Type IMAGE_THUNK_DATA32
    AddressOfData As Long 'IMAGE_IMPORT_BY_NAME
End Type

Private Type IMAGE_THUNK_DATA
    AddressOfData As IMAGE_IMPORT_BY_NAME
End Type

'typedef struct _IMAGE_IMPORT_DESCRIPTOR {
'    union {
'        DWORD   Characteristics;            // 0 for terminating null import descriptor
'        DWORD   OriginalFirstThunk;         // RVA to original unbound IAT (PIMAGE_THUNK_DATA)
'    };
'    DWORD   TimeDateStamp;                  // 0 if not bound,
'                                            // -1 if bound, and real date/time stamp
'                                            //     in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
'                                            // O.W. date/time stamp of DLL bound to (Old BIND)
'
'    DWORD   ForwarderChain;                 // -1 if no forwarders
'    DWORD   Name;
'    DWORD   FirstThunk;                     // RVA to IAT (if bound this IAT has actual addresses)
'} IMAGE_IMPORT_DESCRIPTOR;
'typedef IMAGE_IMPORT_DESCRIPTOR UNALIGNED *PIMAGE_IMPORT_DESCRIPTOR;

'typedef struct _IMAGE_EXPORT_DIRECTORY {
'    DWORD   Characteristics;
'    DWORD   TimeDateStamp;
'    WORD    MajorVersion;
'    WORD    MinorVersion;
'    DWORD   Name;
'    DWORD   Base;
'    DWORD   NumberOfFunctions;
'    DWORD   NumberOfNames;
'    DWORD   AddressOfFunctions;     // RVA from base of image
'    DWORD   AddressOfNames;         // RVA from base of image
'    DWORD   AddressOfNameOrdinals;  // RVA from base of image
'} IMAGE_EXPORT_DIRECTORY, *PIMAGE_EXPORT_DIRECTORY;

'typedef struct _IMAGE_IMPORT_BY_NAME {
'    WORD    Hint;
'    BYTE    Name[1];
'} IMAGE_IMPORT_BY_NAME, *PIMAGE_IMPORT_BY_NAME;

'typedef struct _IMAGE_THUNK_DATA32 {
'    union {
'        PBYTE  ForwarderString;
'        PDWORD Function;
'        DWORD Ordinal;
'        PIMAGE_IMPORT_BY_NAME  AddressOfData;
'    } u1;
'} IMAGE_THUNK_DATA32;
'typedef IMAGE_THUNK_DATA32 * PIMAGE_THUNK_DATA32;

'Private Type IMAGE_RESOURCE_DIR
'    Characteristics   As Long
'    TimeStamp         As Long
'    MajorVersion      As Integer
'    MinorVersion      As Integer
'    NamedEntries      As Integer
'    IDEntries         As Integer
'End Type
'
'Private Type RESOURCE_DIR_ENTRY
'    Name              As Long
'    offset            As Long
'End Type
'
'Private Type RESOURCE_DATA_ENTRY
'    offset            As Long
'    Size              As Long
'    CodePage          As Long
'    Reserved          As Long
'End Type
'
'Private Type IconDescriptor
'    ID       As Long
'    offset   As Long
'    Size     As Long
'End Type

Public Type ExportInfo
    strDllName As String
    strFuns() As String
End Type

Public Type ImportDetailInfo
    strDllName As String
    strFuns() As String
End Type

Public Type ImportInfo
    strExePath As String
    pDetailInfo() As ImportDetailInfo
End Type

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

Private Const FILE_SHARE_READ = &H1
'***************************************************************************************************************************************************
'用于读写文件函数
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal lngFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
'Private Declare Function WriteFile Lib "kernel32" (ByVal lngFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal lngFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
'***************************************************************************************************************************************************
Public gpExportTable As ExportInfo

Public Function GetImportTable(ByVal strFilePath As String, pImportInfo As ImportInfo) As Boolean
    Dim tNTHeader      As IMAGE_NT_HEADERS
    Dim lngTmp As Long, strTmp As String, lngNextAddr As Long
    Dim i As Integer, intCount As Integer, intFunCount As Integer
    Dim pImport As IMAGE_IMPORT_DESCRIPTOR
    Dim pTunk As IMAGE_THUNK_DATA32, lngTunk As Long, lngNextTunk As Long
    Dim bytBuffer(129) As Byte
    Dim pDosHear As IMAGE_DOS_HEADER
    Dim pLoadModule As LOADED_IMAGE
    Dim pName As IMAGE_IMPORT_BY_NAME
    pImportInfo.strExePath = strFilePath
    If MapAndLoad(strFilePath, vbNullString, pLoadModule, True, True) Then
        CopyMemory pDosHear, ByVal pLoadModule.MappedAddress, Len(pDosHear)
        CopyMemory tNTHeader, ByVal pLoadModule.pFileHeader, Len(tNTHeader)
        lngTmp = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, tNTHeader.OptionalHeader.DataEntries(1).DataRVA, ByVal 0&)
        lngNextAddr = lngTmp
        Do While lngTmp <> 0
            CopyMemory pImport, ByVal lngNextAddr, Len(pImport)
            lngNextAddr = lngNextAddr + Len(pImport)
            lngTmp = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pImport.pName, ByVal 0&)
            If lngTmp = 0 Then Exit Do
            CopyMemory bytBuffer(0), ByVal lngTmp, 130
            strTmp = StrConv(bytBuffer, vbUnicode)
            strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
            Debug.Print "DLL模块为：" & strTmp
            ReDim Preserve pImportInfo.pDetailInfo(intCount)
            pImportInfo.pDetailInfo(intCount).strDllName = strTmp
            If pImport.Characteristics <> 0 Then
                lngTunk = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pImport.Characteristics, ByVal 0&)
            Else
                lngTunk = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pImport.FirstThunk, ByVal 0&)
            End If
            If lngTunk <> 0 Then
                lngNextTunk = lngTunk
                intFunCount = 0
                Do While lngTunk <> 0
                    CopyMemory pTunk, ByVal lngNextTunk, Len(pTunk)
                    lngNextTunk = lngNextTunk + 4
                    lngTunk = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pTunk.AddressOfData, ByVal 0&)
                    If lngTunk = 0 Then Exit Do
                    CopyMemory pName, ByVal lngTunk, Len(pName)
                    strTmp = StrConv(pName.pName, vbUnicode)
                    strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
                    Debug.Print "       ----函数为：" & strTmp
                    ReDim Preserve pImportInfo.pDetailInfo(intCount).strFuns(intFunCount)
                    pImportInfo.pDetailInfo(intCount).strFuns(intFunCount) = strTmp
                    intFunCount = intFunCount + 1
                Loop
            End If
            intCount = intCount + 1
        Loop
        UnMapAndLoad pLoadModule
        GetImportTable = True
        Exit Function
    End If
   
End Function

Public Function GetExportTable(ByVal strFilePath As String, pExportInfo As ExportInfo) As Boolean
    Dim tNTHeader      As IMAGE_NT_HEADERS
    Dim lngTmp As Long, strTmp As String, lngNextAddr As Long
    Dim i As Integer, intNo As Integer
    Dim pExport As IMAGE_EXPORT_DIRECTORY
    Dim hAddr As Long, lngNextTunk As Long
    Dim bytBuffer(129) As Byte
    Dim pLoadModule As LOADED_IMAGE
    Dim pName As IMAGE_IMPORT_BY_NAME
    If MapAndLoad(strFilePath, vbNullString, pLoadModule, True, True) Then
        CopyMemory tNTHeader, ByVal pLoadModule.pFileHeader, Len(tNTHeader)
        If tNTHeader.OptionalHeader.DataEntries(0).DataRVA = 0 Then
            MsgBox "没有发现到出表结构！！", vbCritical, "提示"
            Exit Function
        End If
        lngTmp = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, tNTHeader.OptionalHeader.DataEntries(0).DataRVA, ByVal 0&)
        CopyMemory pExport, ByVal lngTmp, Len(pExport)
        lngTmp = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pExport.pName, ByVal 0&)
        CopyMemory bytBuffer(0), ByVal lngTmp, 130
        strTmp = StrConv(bytBuffer, vbUnicode)
        strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
        Debug.Print "DLL模块为：" & strTmp
        pExportInfo.strDllName = strTmp
        ReDim pExportInfo.strFuns(pExport.NumberOfFunctions - 1)
        For i = 0 To pExport.NumberOfFunctions - 1
            '获取函数对应偏移地址指针
            hAddr = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, pExport.AddressOfNames + i * 4, ByVal 0&)
            '获取函数对应偏移地址
            CopyMemory hAddr, ByVal hAddr, 4
            '获取函数对应RAV地址
            hAddr = ImageRvaToVa(ByVal pLoadModule.pFileHeader, ByVal pLoadModule.MappedAddress, hAddr, ByVal 0&)
            CopyMemory bytBuffer(0), ByVal hAddr, 130
            strTmp = StrConv(bytBuffer, vbUnicode)
            strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
            Debug.Print "       ----函数名称为：" & strTmp
            pExportInfo.strFuns(i) = strTmp
        Next
        GetExportTable = True
        UnMapAndLoad pLoadModule
    End If
End Function

Public Function GetImportInfo(ByVal strFilePath As String) As Boolean
    Dim lngFile As Long
    Dim pNTHeader      As IMAGE_NT_HEADERS
    Dim lngTmp As Long, strTmp As String, lngNextAddr As Long
    Dim i As Integer, j As Integer
    Dim pImport As IMAGE_IMPORT_DESCRIPTOR, pExport As IMAGE_EXPORT_DIRECTORY
    Dim pTunk As IMAGE_THUNK_DATA32, lngTunk As Long, lngNextTunk As Long
    Dim bytBuffer(129) As Byte
    Dim pDosHear As IMAGE_DOS_HEADER
    Dim pLoadModule As LOADED_IMAGE
    Dim pName As IMAGE_IMPORT_BY_NAME
    Dim hMap As Long, hBase As Long, hAddr As Long
    lngFile = CreateFile(ByVal strFilePath, ByVal &H80000000, FILE_SHARE_READ, ByVal 0&, ByVal 3, ByVal 0&, ByVal 0&)
    If (lngFile > 0) Then
        hMap = CreateFileMapping(lngFile, ByVal 0&, PAGE_READONLY, 0, 0, vbNullString)
        If hMap = 0 Then
            Exit Function
        End If
        hBase = MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0)
        If hBase = 0 Then
            Exit Function
        End If
        CopyMemory pDosHear, ByVal hBase, Len(pDosHear)
        If pDosHear.Magic <> &H5A4D Then
            Exit Function
        End If
        CopyMemory pNTHeader, ByVal hBase + pDosHear.lfanew, Len(pNTHeader)
        If pNTHeader.Signature <> IMAGE_NT_SIGNATURE Then
            Exit Function
        End If
        Do While 1
            hAddr = ImageRvaToVa(ByVal hBase + pDosHear.lfanew, ByVal hBase, pNTHeader.OptionalHeader.DataEntries(1).DataRVA + j * Len(pImport), ByVal 0&)
            CopyMemory pImport, ByVal hAddr, Len(pImport)
            If pImport.pName = 0 Or pImport.Characteristics = 0 Then
                Exit Do
            End If
            hAddr = ImageRvaToVa(ByVal hBase + pDosHear.lfanew, ByVal hBase, pImport.pName, ByVal 0&)
            CopyMemory bytBuffer(0), ByVal hAddr, 130
            strTmp = StrConv(bytBuffer, vbUnicode)
            strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
            Debug.Print "DLL模块为：" & strTmp
            i = 0
            Do While 1
                hAddr = ImageRvaToVa(ByVal hBase + pDosHear.lfanew, ByVal hBase, pImport.Characteristics + i * 4, ByVal 0&)
                If hAddr = 0 Then Exit Do
                CopyMemory pTunk, ByVal hAddr, Len(pTunk)
                hAddr = ImageRvaToVa(ByVal hBase + pDosHear.lfanew, ByVal hBase, pTunk.AddressOfData, ByVal 0&)
                If hAddr = 0 Then Exit Do
                CopyMemory pName, ByVal hAddr, Len(pName)
                strTmp = StrConv(pName.pName, vbUnicode)
                strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
                Debug.Print "       ----函数为：" & strTmp
                i = i + 1
            Loop
            j = j + 1
        Loop
    End If
    UnmapViewOfFile ByVal hBase
    CloseHandle hMap
    CloseHandle lngFile
    GetImportInfo = True
End Function

 

 modBrowse.bas

Attribute VB_Name = "modBrowse"
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1

Private Const BIF_DONTGOBELOWDOMAIN = 2

Private Const OFN_HIDEREADONLY = &H4

Private Const OFN_PATHMUSTEXIST = &H800

Private Const OFN_FILEMUSTEXIST = &H1000

Private Const OFN_OVERWRITEPROMPT = &H2

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags  As Long
    lpfnCallback   As Long
    lParam   As Long
    iImage   As Long
End Type

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 Type OPENFILENAME
    lStructSize As Long
    hWnd 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

Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

Public Function GetFolderPath(ByVal objControl As TextBox, ByVal hWndOwner As Long)
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo

    szTitle = "请选择源路径:"
    With tBrowseInfo
        .hWndOwner = hWndOwner
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With

    lpIDList = SHBrowseForFolder(tBrowseInfo)

    If (lpIDList) Then
        sBuffer = Space(256)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        objControl.Text = sBuffer
    End If
End Function

Public Function ShowDialogFile(hWnd As Long, wMode As Integer, szDialogTitle As String, szFilename As String, szFilter As String, szDefDir As String, szDefExt As String) As String
    Dim x As Long, OFN As OPENFILENAME, szFile As String, szFileTitle As String
   
    OFN.lStructSize = Len(OFN)
    OFN.hWnd = hWnd
    OFN.lpstrTitle = szDialogTitle
    OFN.lpstrFile = szFilename & String$(250 - Len(szFilename), 0)
    OFN.nMaxFile = 255
    OFN.lpstrFileTitle = String$(255, 0)
    OFN.nMaxFileTitle = 255
    OFN.lpstrFilter = szFilter
    OFN.nFilterIndex = 1
    OFN.lpstrInitialDir = szDefDir
    OFN.lpstrDefExt = szDefExt

    If wMode = 1 Then
        OFN.Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
        x = GetOpenFileName(OFN)
    Else
        OFN.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST
        x = GetSaveFileName(OFN)
    End If
   
    If x <> 0 Then
        If InStr(OFN.lpstrFile, Chr$(0)) > 0 Then
            szFile = Left$(OFN.lpstrFile, InStr(OFN.lpstrFile, Chr$(0)) - 1)
        End If
        ShowDialogFile = szFile
    Else
        ShowDialogFile = ""
    End If
   
End Function