2011-06-06 55 views
0

此代碼必須在64位機器上工作,目前不支持。我需要修改這個腳本才能工作?如何將此程序轉換爲64位機器?

Option Explicit 

''' ************************************************************************* 
''' Module Constant Declaractions Follow 
''' ************************************************************************* 
''' Constant for the dwDesiredAccess parameter of the OpenProcess API function. 
Private Const PROCESS_QUERY_INFORMATION As Long = &H400 
''' Constant for the lpExitCode parameter of the GetExitCodeProcess API function. 
Private Const STILL_ACTIVE As Long = &H103 


''' ************************************************************************* 
''' Module Variable Declaractions Follow 
''' ************************************************************************* 
''' It's critical for the shell and wait procedure to trap for errors, but I 
''' didn't want that to distract from the example, so I'm employing a very 
''' rudimentary error handling scheme here. This variable is used to pass error 
''' messages between procedures. 
Public gszErrMsg As String 


''' ************************************************************************* 
''' Module DLL Declaractions Follow 
''' ************************************************************************* 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 


Public Sub ShellAndWait() 

    On Error GoTo ErrorHandler 

    ''' Clear the error mesaage variable. 
    gszErrMsg = vbNullString 
    If Not bShellAndWait("java TimeTable " & Environ("Username"), vbNormalFocus) Then Err.Raise 9999 

    Exit Sub 

ErrorHandler: 
    ''' If we ran into any errors this will explain what they are. 
    MsgBox gszErrMsg, vbCritical, "Shell and Wait Demo" 
End Sub 


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
''' Comments: Shells out to the specified command line and waits for it to 
'''    complete. The Shell function runs asynchronously, so you must 
'''    run it using this function if you need to do something with 
'''    its output or wait for it to finish before continuing. 
''' 
''' Arguments: szCommandLine [in] The command line to execute using Shell. 
'''    iWindowState [in] (Optional) The window state parameter to 
'''        pass to the Shell function. Default = vbHide. 
''' 
''' Returns: Boolean   True on success, False on error. 
''' 
''' Date  Developer  Action 
''' -------------------------------------------------------------------------- 
''' 05/19/05 Rob Bovey  Created 
''' 
Private Function bShellAndWait(ByVal szCommandLine As String, Optional ByVal iWindowState As Integer = vbHide) As Boolean 

    Dim lTaskID As Long 
    Dim lProcess As Long 
    Dim lExitCode As Long 
    Dim lResult As Long 

    On Error GoTo ErrorHandler 

    ''' Run the Shell function. 
    lTaskID = Shell(szCommandLine, iWindowState) 

    ''' Check for errors. 
    If lTaskID = 0 Then Err.Raise 9999, , "Shell function error." 

    ''' Get the process handle from the task ID returned by Shell. 
    lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lTaskID) 

    ''' Check for errors. 
    If lProcess = 0 Then Err.Raise 9999, , "Unable to open Shell process handle." 

    ''' Loop while the shelled process is still running. 
    Do 
     ''' lExitCode will be set to STILL_ACTIVE as long as the shelled process is running. 
     lResult = GetExitCodeProcess(lProcess, lExitCode) 
     DoEvents 
    Loop While lExitCode = STILL_ACTIVE 

    bShellAndWait = True 
    Exit Function 

ErrorHandler: 
    gszErrMsg = Err.Description 
    bShellAndWait = False 
End Function 
+0

什麼類型的錯誤消息/指示你接收它不管用?它編譯失敗嗎?加載?跑?正確運行? – 2011-06-06 17:34:38

+0

無法在x64機器上編譯 – 2011-06-06 17:44:52

+0

好的。任何特定的錯誤消息?它是否報告缺少kernel32?有沒有,也許是一個kernel64? – 2011-06-06 17:52:59

回答

1

更改此

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 

到這一點,它會編譯在32位和64位

#If Win64 Then 
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 
#Else 
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
    Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 
#End If 
+1

我建議@if_zero_equals_one應明確檢查'Win32'而不是使用'#Else'來檢查確保在另一架構上的前向兼容性如果代碼在不受支持的體系結構上編譯,則'#Else'子句可以輸出警告。 – 2011-06-08 19:13:58

相關問題