发表评论
经常用VB调用外部可执行文件,但如果调用的可执行文件无效,则会引起程序错误,因此要加入一个判断是否可效的模块。
1、将以下代码保存为.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
2、修改主窗体代码如下
Private Sub Form_Load() If CheckPEFile("这里写您要判断的可执行文件路径") = True Then '判断是不是有效的可执行文件 Shell "路径", vbNormalFocus Unload Me Else '如果文件无效,则报错 MsgBox "您要运行的可执行文件并不是一个有效的Win32可执行文件!", vbOKOnly + vbExclamation, "错误" Unload Me End If End Sub