判断一个文件是不是Win32可执行文件VB6源代码

今天被 MicrosoftCTO 这个Q友问到这个问题，于是敲敲键盘写了这个函数模块：mCheckPEFile.bas

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length 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 GetFileSize Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpFileSizeHigh As Long) As Long

Private Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Any) As Long

Private Declare Function SetFilePointer Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByVal lDistanceToMove As Long, _
    lpDistanceToMoveHigh As Long, _
    ByVal dwMoveMethod As Long) As Long

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

'DOS .EXE头部
Private Type IMAGE_DOS_HEADER
    e_magic As Integer        '魔术字
    e_cblp As Integer         '文件最后页的字节数
    e_cp As Integer           '文件页数
    e_crlc As Integer         '重定义元素个数
    e_cparhdr As Integer      '头部尺寸，以段落为单位
    e_minalloc As Integer     '所需的最小附加段
    e_maxalloc As Integer     '所需的最大附加段
    e_ss As Integer           '初始的SS值（相对偏移量）
    e_sp As Integer           '初始的SP值
    e_csum As Integer         '校验和
    e_ip As Integer           '初始的IP值
    e_cs As Integer           '初始的CS值（相对偏移量）
    e_lfarlc As Integer       '重分配表文件地址
    e_ovno As Integer         '覆盖号
    e_res(0 To 3) As Integer  '保留字
    e_oemid As Integer        'OEM标识符（相对e_oeminfo）
    e_oeminfo As Integer      'OEM信息
    e_res2(0 To 9) As Integer '保留字
    e_lfanew As Long          '新exe头部的文件地址
End Type

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING As LOng= 3
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1

'函数：检查一个文件是不是可执行文件(Win32 PE)
'如果是Win32 PE文件，返回 True，否则返回 False
Public Function CheckPEFile(ByVal strFileName As String) As Boolean
    On Error Resume Next
    Dim hFile As Long
    Dim lngApiRet As Long
    Dim lngRet As Long
    Dim ReadBuf(4) As Byte
    hFile = CreateFile(strFileName, ByVal (GENERIC_READ Or FILE_SHARE_READ), 0, ByVal 0, OPEN_EXISTING, 0, ByVal 0)
    If hFile > 0 Then
       Dim PEDosHeader As IMAGE_DOS_HEADER
       lngApiRet = ReadFile(hFile, PEDosHeader, ByVal Len(PEDosHeader), lngRet, ByVal 0)
       If lngApiRet > 0 And lngRet = 64 Then
          '因为有些人喜欢鼓捣些很小的PE文件，那么这里改成：
          'If GetFileSize(hFile, 0) <68 Then
          If GetFileSize(hFile, 0) <424 Then '其实不止吧 呵呵
             CloseHandle hFile
             Exit Function
          End If
          CopyMemory ReadBuf(0), PEDosHeader.e_magic, 2
          If (Chr(ReadBuf(0)) & Chr(ReadBuf(1)) = "MZ") Then
              lngApiRet = SetFilePointer(hFile, PEDosHeader.e_lfanew, 0, FILE_BEGIN)
              If lngApiRet > 0 Then
                 lngApiRet = ReadFile(hFile, ReadBuf(0), 4, lngRet, ByVal 0)
                 If lngApiRet > 0 And lngRet = 4 Then
                    If (Chr(ReadBuf(0)) & Chr(ReadBuf(1)) = "PE") And (ReadBuf(2) = 0) And (ReadBuf(3) = 0) Then
                       CheckPEFile = True
                       CloseHandle hFile
                       Exit Function
                    End If
                 End If
              End If
          End If
       End If
       CloseHandle hFile
    End If
End Function

'-------------------------------------------
' 转载请注明出处
' 作者：唐细刚
' 博客：http://blog.csdn.net/tanaya
' 邮箱：vbcoder@126.com or tanaya@163.com
'-------------------------------------------