判断一个文件是不是 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
'-------------------------------------------