Public Function GetDllVersion(ByVal DllName As String, _ MajorVersion As Long, _ MinorVersion As Long, _ BuildNumber As Long, _ PlatformID As Long, _ Optional ByVal bDefaultIE3 As Boolean = True) As Boolean 注释： 此函数用于获得 Windows 的 Shell32.DLL 等 DLL 的版本信息。 On Local Error GoTo Shell32VerErr Dim SecurityAttr As SECURITY_ATTRIBUTES Dim hThread As Long, ThreadID As Long Dim hModule As Long, lpThreadAddr As Long Dim VerInfo As DLLVERSIONINFO Dim ExitCode As Long Dim ErrorOccurred As Integer
ErrorOccurred = 0
注释： 先要装入 DLL。 hModule = LoadLibraryEx(DllName, vbNull, 0) If hModule Then 注释： 然后找到函数 DllGetVersion() 的地址。 lpThreadAddr = GetProcAddress(hModule, "DllGetVersion") If lpThreadAddr Then With SecurityAttr .lpSecurityDescriptor = 0 .bInheritHandle = 0 .nLength = Len(SecurityAttr) End With VerInfo.cbSize = Len(VerInfo)
注释： 真可惜！VB 无法通过地址直接调用函数，所以只好建立一个线程。 hThread = CreateThread(SecurityAttr, 0, ByVal lpThreadAddr, _ VerInfo, 0, ThreadID) If hThread Then 注释： 然后等待 DllGetVersion() 返回。 Do GetExitCodeThread hThread, ExitCode Loop Until ExitCode <> STILL_ACTIVE CloseHandle hThread 注释： 关闭线程。 Else ErrorOccurred = 3 注释： 建立线程出错。 End If Else ErrorOccurred = 2 注释： 找不到 DllGetVersion() 入口地址。 End If FreeLibrary hModule 注释： 释放 DLL。 Else ErrorOccurred = 1 注释： 无法装入 DLL。 End If
If Not ErrorOccurred Then With VerInfo MajorVersion = .dwMajorVersion MinorVersion = .dwMinorVersion BuildNumber = .dwBuildNumber PlatformID = .dwPlatformID End With ElseIf ErrorOccurred = 2 And bDefaultIE3 Then 注释： 找不到入口地址，说明是 IE 3.0 的 4.0 版 Shell32。 MajorVersion = 4: MinorVersion = 0: BuildNumber = 0: PlatformID = -1 Else GoTo Shell32VerErr 注释： 无法预料的错误…… End If GetDllVersion = True Exit Function
