【问题标题】:How do I convert this program to work on a 64 bit machine?如何将此程序转换为在 64 位机器上运行?
【发布时间】:2011-09-09 11:45:33
【问题描述】:

此代码必须在 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

【问题讨论】:

  • 您收到什么类型的错误消息/指示表明它工作?编译失败了吗?加载?跑步?运行正确吗?
  • 在 x64 机器上编译失败
  • 好的。任何特定的错误信息?它是否报告缺少 kernel32?有没有 kernel64 的?
  • 无法测试这一点,因为我是在 32 位机器上,它需要在 64 位或 32 位上运行

标签: shell vba 32bit-64bit


【解决方案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

【讨论】:

  • 我建议@if_zero_equals_one 应该明确检查Win32 而不是使用#Else 以确保在另一个架构上的前向兼容性。如果代码在不受支持的架构上编译,#Else 子句会输出警告。
猜你喜欢
  • 2014-11-02
  • 2012-06-20
  • 2011-11-05
  • 1970-01-01
  • 2012-07-04
  • 2020-08-04
  • 2010-10-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多