VB 简单小问题，在线等
'//女孩不哭(QQ:191035066)@2011-12-23 22:03:37Option ExplicitPrivate Type VariableBuffer VariableParameter() As ByteEnd TypePrivate Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( ByVal lpLibFileName As String ) As LongPrivate Declare Function GetProcAddress Lib "kernel32" ( ByVal hModule As Long , ByVal lpProcName As String ) As LongPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc As Long , ByVal hwnd As Long , ByVal Msg As Long , ByVal wParam As Long , ByVal lParam As Long ) As LongPrivate Declare Function FreeLibrary Lib "kernel32" ( ByVal hLibModule As Long ) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long )Private m_opIndex As LongPrivate m_OpCode() As BytePublic Function ShellAPI( ByVal LibPath$, APIParam$) As Long Dim hProcAddress As Long , hModule As Long , X As Long , Y As Long Dim RetLong As Long , FunctionName As String , FunctionParameter As String Dim LongCount As Long , StringInfo As String , StrByteArray() As VariableBuffer Dim StringSize As Long , ByteArray() As Byte , IsHaveParameter As Boolean Dim ParameterArray() As String , OutputArray() As Long StringSize = 0 ReDim StrByteArray(StringSize) RetLong = InStr( 1 , APIParam, " " , vbTextCompare) If RetLong = 0 Then FunctionName = APIParam IsHaveParameter = False Else FunctionName = Left(APIParam, RetLong - 1 ) IsHaveParameter = True FunctionParameter = Right(APIParam, Len(APIParam) - RetLong) ParameterArray = Split(FunctionParameter, "," ) ReDim OutputArray(UBound(ParameterArray)) For X = 0 To UBound(ParameterArray) If IsNumeric(Trim(ParameterArray(X))) = True Then LongCount = CLng (Trim(ParameterArray(X))) OutputArray(X) = LongCount Else StringInfo = Mid(Trim(ParameterArray(X)), 2 , Len(ParameterArray(X)) - 3 ) If Len(StringInfo) = 0 Then OutputArray(X) = CLng (VarPtr(Null)) Else ReDim Preserve StrByteArray(StringSize) ByteArray = StrConv(StringInfo, vbFromUnicode) ReDim Preserve StrByteArray(StringSize).VariableParameter(UBound(ByteArray) + 1 ) CopyMemory StrByteArray(StringSize).VariableParameter( 0 ), ByteArray( 0 ), UBound(ByteArray) + 1 OutputArray(X) = CLng (VarPtr(StrByteArray(StringSize).VariableParameter( 0 ))) StringSize = StringSize + 1 End If End If Next X ReDim m_OpCode( 400 + 6 * UBound(OutputArray)) End If hModule = LoadLibrary( ByVal LibPath) If hModule = 0 Then ShellAPI = 0 MsgBox "LoadLibrary(""" & LibPath & """) 函数调用失败!" , vbCritical Exit Function End If hProcAddress = GetProcAddress(hModule, ByVal FunctionName) If hProcAddress = 0 Then ShellAPI = 0 MsgBox "GetProcAddress(""" & FunctionName & """) 函数调用失败!" , vbCritical FreeLibrary hModule Exit Function End If If IsHaveParameter = True Then ShellAPI = CallWindowProc(GetCodeStart(hProcAddress, OutputArray), 0 , 1 , 2 , 3 ) Else ShellAPI = CallWindowProc(hProcAddress, 0 , 1 , 2 , 3 ) End If FreeLibrary hModuleEnd FunctionPrivate Function GetCodeStart( ByVal lngProc As Long , arrParams() As Long ) As Long Dim lngIndex As Long , lngCodeStart As Long lngCodeStart = (VarPtr(m_OpCode( 0 )) Or &HF ) + 1 m_opIndex = lngCodeStart - VarPtr(m_OpCode( 0 )) For lngIndex = 0 To m_opIndex - 1 m_OpCode(lngIndex) = &HCC Next lngIndex For lngIndex = UBound(arrParams) To 0 Step - 1 AddByteToCode &H68 AddLongToCode arrParams(lngIndex) Next lngIndex AddByteToCode &HE8 AddLongToCode lngProc - VarPtr(m_OpCode(m_opIndex)) - 4 AddByteToCode &HC2 AddByteToCode &H10 AddByteToCode &H0 GetCodeStart = lngCodeStartEnd FunctionPrivate Sub AddLongToCode(lData As Long ) CopyMemory m_OpCode(m_opIndex), lData, 4 m_opIndex = m_opIndex + 4End SubPrivate Sub AddIntToCode(iData As Integer ) CopyMemory m_OpCode(m_opIndex), iData, 2 m_opIndex = m_opIndex + 2End SubPrivate Sub AddByteToCode(bData As Byte ) m_OpCode(m_opIndex) = bData m_opIndex = m_opIndex + 1End Sub