问题描述
我试着让代码在64位VBA下工作，它在32位VBA中工作得很好。
它是关于通用控件任务对话框的。
我使用Microsoft Access，但其他VBA主机的问题应该相同。
其中一部分在(32位和64位)VBA中都能很好地工作，另一部分则不然。
TaskDialogAPI在(32位和64位)VBA中工作良好
您可以启动程序TestTaskDlg进行测试。
Option Explicit
'Original API definition:
'------------------------
'HRESULT TaskDialog(
' HWND hwndOwner,
' HINSTANCE hInstance,
' PCWSTR pszWindowTitle,
' PCWSTR pszMainInstruction,
' PCWSTR pszContent,
' TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons,
' PCWSTR pszIcon,
' int *pnButton
');
Private Declare PtrSafe Function TaskDialog Lib "Comctl32.dll" _
(ByVal hWndParent As LongPtr, _
ByVal hInstance As LongPtr, _
ByVal pszWindowTitle As LongPtr, _
ByVal pszMainInstruction As LongPtr, _
ByVal pszContent As LongPtr, _
ByVal dwCommonButtons As Long, _
ByVal pszIcon As LongPtr, _
ByRef pnButton As Long _
) As Long
'Works fine with 32-Bit VBA and 64-Bit VBA:
Public Sub TestTaskDlg()
Debug.Print TaskDlg("Title", "MainInstructionText", "ContentText")
End Sub
Public Function TaskDlg( _
sWindowTitle As String, _
sMainInstruction As String, _
sContent As String _
) As Long
On Local Error GoTo Catch
Dim clickedButton As Long
TaskDlg = TaskDialog(0, _
0, _
StrPtr(sWindowTitle), _
StrPtr(sMainInstruction), _
StrPtr(sContent), _
0, _
0, _
clickedButton)
Debug.Print "Clicked button:", clickedButton
Done:
Exit Function
Catch:
MsgBox Err.Description, , Err.Number
Resume Done
End Function
TaskDialogIndirectAPI只能在32位VBA中正常工作
您可以启动程序TestTaskDlgIndirect进行测试。
在64位VBA中，它返回E_INVALIDARG (0x80070057 | -2147024809)，以某种方式指向无效参数。。。
如果我使用Len()而不是LenB()，并对这三行代码进行注释，它将显示一个正确的(空的)对话框，因此TaskDialogIndirect的调用应该是正确的。
tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)
有人知道为什么它不能在64位VBA中工作吗？
在我看来，我已经正确地将类型从Long转换为LongPtr。
我认为这是在运行时存储在结构中的值/指针的问题。
也许是一些高/低字节的东西？
感谢任何帮助。：-)
Option Explicit
'Original API definition:
'------------------------
'typedef struct _TASKDIALOGCONFIG {
' UINT cbSize;
' HWND hwndParent;
' HINSTANCE hInstance;
' TASKDIALOG_FLAGS dwFlags;
' TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons;
' PCWSTR pszWindowTitle;
' union {
' HICON hMainIcon;
' PCWSTR pszMainIcon;
' } DUMMYUNIONNAME;
' PCWSTR pszMainInstruction;
' PCWSTR pszContent;
' UINT cButtons;
' const TASKDIALOG_BUTTON *pButtons;
' int nDefaultButton;
' UINT cRadioButtons;
' const TASKDIALOG_BUTTON *pRadioButtons;
' int nDefaultRadioButton;
' PCWSTR pszVerificationText;
' PCWSTR pszExpandedInformation;
' PCWSTR pszExpandedControlText;
' PCWSTR pszCollapsedControlText;
' union {
' HICON hFooterIcon;
' PCWSTR pszFooterIcon;
' } DUMMYUNIONNAME2;
' PCWSTR pszFooter;
' PFTASKDIALOGCALLBACK pfCallback;
' LONG_PTR lpCallbackData;
' UINT cxWidth;
'} TASKDIALOGCONFIG;
Public Type TASKDIALOGCONFIG
cbSize As Long 'UINT
hWndParent As LongPtr 'HWND
hInstance As LongPtr 'HINSTANCE
dwFlags As Long 'TASKDIALOG_FLAGS
dwCommonButtons As Long 'TASKDIALOG_COMMON_BUTTON_FLAGS
pszWindowTitle As LongPtr 'PCWSTR
' Union
' {
hMainIcon As LongPtr 'Union means that the biggest type has to be declared: So LongPtr
' hMainIcon 'HICON
' pszMainIcon 'PCWSTR
' };
pszMainInstruction As LongPtr 'PCWSTR
pszContent As LongPtr 'PCWSTR
cButtons As Long 'UINT
pButtons As LongPtr 'TASKDIALOG_BUTTON *pButtons;
nDefaultButton As Long 'INT
cRadioButtons As Long 'UINT
pRadioButtons As LongPtr 'TASKDIALOG_BUTTON *pRadioButtons;
nDefaultRadioButton As Long 'INT
pszVerificationText As LongPtr 'PCWSTR
pszExpandedInformation As LongPtr 'PCWSTR
pszExpandedControlText As LongPtr 'PCWSTR
pszCollapsedControlText As LongPtr 'PCWSTR
'Union
'{
hFooterIcon As LongPtr 'Union means that the biggest type has to be declared: So LongPtr
' hFooterIcon 'HICON
' pszFooterIcon 'PCWSTR
'};
pszFooter As LongPtr 'PCWSTR
pfCallback As LongPtr 'PFTASKDIALOGCALLBACK
lpCallbackData As LongPtr 'LONG_PTR
cxWidth As Long 'UINT
End Type
'Original API definition:
'------------------------
'HRESULT TaskDialogIndirect(
' const TASKDIALOGCONFIG *pTaskConfig,
' int *pnButton,
' int *pnRadioButton,
' BOOL *pfVerificationFlagChecked
');
Private Declare PtrSafe Function TaskDialogIndirect Lib "Comctl32.dll" ( _
ByRef pTaskConfig As TASKDIALOGCONFIG, _
ByRef pnButton As Long, _
ByRef pnRadioButton As Long, _
ByRef pfVerificationFlagChecked As Long _
) As Long
'Works fine with 32-Bit VBA. But with 64-Bit VBA it returns E_INVALIDARG (0x80070057 | -2147024809)
Public Sub TestTaskDlgIndirect()
Debug.Print TaskDlgIndirect("Title", "MainInstructionText", "ContentText")
End Sub
Public Function TaskDlgIndirect( _
sWindowTitle As String, _
sMainInstruction As String, _
sContent As String _
) As Long
On Local Error GoTo Catch
Dim tdlgConfig As TASKDIALOGCONFIG
tdlgConfig.cbSize = LenB(tdlgConfig)
'Usually LenB() should be the right way to use, but when I use Len() and comment the three texts below, it shows a proper empty dialog!
tdlgConfig.pszWindowTitle = StrPtr(sWindowTitle)
tdlgConfig.pszMainInstruction = StrPtr(sMainInstruction)
tdlgConfig.pszContent = StrPtr(sContent)
Dim clickedButton As Long
Dim selectedRadio As Long
Dim verificationFlagChecked As Long
TaskDlgIndirect = TaskDialogIndirect(tdlgConfig, clickedButton, _
selectedRadio, verificationFlagChecked)
Debug.Print "Clicked button:", clickedButton
Done:
Exit Function
Catch:
MsgBox Err.Description, , Err.Number
Resume Done
End Function
更新
一些新见解：
似乎TASKDIALOGCONFIG在内部使用了一个1字节的封装。
在32位VBA(对结构使用4字节填充)中，这并不重要，因为结构的所有成员都是
Long类型，因此为4字节，因此根本没有填充
此外，在这个星座中，使用仅计算数据类型总和的Len(tdlgConfig)和计算结构实际大小的LenB(tdlgConfig)没有区别
此处两个结果都为96个字节。但在64位VBA(对结构使用8字节填充)中，结构的某些成员的类型为
Long(4字节)，而某些成员为LongLong(8字节)(为32位兼容性声明为LongPtr)。这导致VBA应用填充，这就是Len(tdlgConfig)返回160和LenB(tdlgConfig)176的原因。因此，由于我的测试没有提供任何文本(注释上面提到的3行代码)，只有当我使用
Len(tdlgConfig)(而不是LenB(tdlgConfig))时才会显示对话框，从而得出相同的结论，即64位API只需要160字节的结构。
因此，为了提供160字节的结构，我将其用于测试：
Public Type TASKDIALOGCONFIG
cbSize As Long
dummy2 As Long
dummy3 As Long
dummy4 As Long
dummy5 As Long
dummy6 As Long
dwCommonButtons As Long
dummy8 As Long
dummy9 As Long
dummy10 As Long
dummy11 As Long
dummy12 As Long
dummy13 As Long
dummy14 As Long
dummy15 As Long
dummy16 As Long
dummy17 As Long
dummy18 As Long
nDefaultButton As Long
dummy20 As Long
dummy21 As Long
dummy22 As Long
dummy23 As Long
dummy24 As Long
dummy25 As Long
dummy26 As Long
dummy27 As Long
dummy28 As Long
dummy29 As Long
dummy30 As Long
dummy31 As Long
dummy32 As Long
dummy33 As Long
dummy34 As Long
dummy35 As Long
dummy36 As Long
dummy37 As Long
dummy38 As Long
dummy39 As Long
dummy40 As Long
End Type
现在，Len(tdlgConfig)和LenB(tdlgConfig)都返回160。
调用没有文本的空对话框仍然运行良好。
我现在可以设置dwCommonButtons和nDefaultButton(都是类型Long)，到目前为止它是正确的。
例如：
Public Enum TD_COMMON_BUTTON_FLAGS
TDCBF_OK_BUTTON = &H1& '// Selected control returns value IDOK
TDCBF_YES_BUTTON = &H2& '// Selected control returns value IDYES
TDCBF_NO_BUTTON = &H4& '// Selected control returns value IDNO
TDCBF_CANCEL_BUTTON = &H8& '// Selected control returns value IDCANCEL
TDCBF_RETRY_BUTTON = &H10& '// Selected control returns value IDRETRY
TDCBF_CLOSE_BUTTON = &H20& '// Selected control returns value IDCLOSE
End Enum
'typedef DWORD TASKDIALOG_COMMON_BUTTON_FLAGS; // Note: _TASKDIALOG_COMMON_BUTTON_FLAGS is an int
Public Enum TD_COMMON_BUTTON_RETURN_CODES
IDOK = 1
IDCANCEL = 2
IDRETRY = 4
IDYES = 6
IDNO = 7
IDCLOSE = 8
End Enum
tdlgConfig.dwCommonButtons = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON
tdlgConfig.nDefaultButton = IDNO
所以我可以预期结构的大小很好，现在我必须找出如何设置LongLong(LongPtr)类型。。。
最后，我在64位VBA中设置了要使用的图标和结构中的字符串。
这是一个新的结构，我在其中为主图标和主指令文本命名了成员：
Public Type TASKDIALOGCONFIG
cbSize As Long
dummy2 As Long
dummy3 As Long
dummy4 As Long
dummy5 As Long
dummy6 As Long
dwCommonButtons As Long
dummy8 As Long
dummy9 As Long
hMainIcon1 As Long
hMainIcon2 As Long
pszMainInstruction1 As Long
pszMainInstruction2 As Long
dummy14 As Long
dummy15 As Long
dummy16 As Long
dummy17 As Long
dummy18 As Long
nDefaultButton As Long
dummy20 As Long
dummy21 As Long
dummy22 As Long
dummy23 As Long
dummy24 As Long
dummy25 As Long
dummy26 As Long
dummy27 As Long
dummy28 As Long
dummy29 As Long
dummy30 As Long
dummy31 As Long
dummy32 As Long
dummy33 As Long
dummy34 As Long
dummy35 As Long
dummy36 As Long
dummy37 As Long
dummy38 As Long
dummy39 As Long
dummy40 As Long
End Type
因为结构中的LongLong值现在都被拆分为单独的Long值，所以我无法以通用的方式设置它们。
经过一些尝试和错误，我找到了一种设置图标的方法。设置第一个Long值的方式与在32位VBA中设置的方式相同即可：
Const TD_SECURITY_ICON_OK As Integer = -8
tdlgConfig.hMainIcon1 = &HFFFF And TD_SECURITY_ICON_OK
将指针设置为字符串也有点棘手。我最后宣布CopyMemoryAPI…
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByVal destination As LongPtr, _
ByVal source As LongPtr, _
ByVal dataLength As LongPtr)
并像这样使用它在结构中设置字符串引用：
CopyMemory VarPtr(tdlgConfig.pszMainInstruction1), VarPtr(StrPtr("My main instruction")), 8
最后，我可以像这样使用函数TaskDialogIndirect：
Dim clickedButton As Long
Dim selectedRadio As Long
Dim verificationFlagChecked As Long
Call TaskDialogIndirect(tdlgConfig, clickedButton, _
selectedRadio, verificationFlagChecked)
Debug.Print "Clicked button:", clickedButton
剩下的就是纯粹的勤奋，设置其他文本等，并使用大小写区分使代码可执行32位和64位。
再次感谢GSerg的回复。
这是一个旧线程，但由于我刚刚制作了一个TaskDialogIndirect类，我想与VBA7x64兼容，我偶然发现了它，发现有很多误解从未消除。在过去的一年里，当我把代码移到64位时，我遇到了各种各样的打包/对齐问题，所以我认为我是一个很好的解释者，对其他偶然发现这个问题的人来说是合适的。
VBA将填充x64下的结构。这是正确的行为——并不是因为每个API都需要未填充的结构，就像GSerg所建议的那样，而是因为<em]这个>API确实需要。如果你在定义这些东西的SDK头CommCtrl.h中，就在任务对话框定义之前，你会看到：
#include <pshpack1.h>
然后在任务对话框之后，
#include <poppack.h>
这些页眉所做的就是调整对齐方式。pshpack1意味着从包含它的位置到poppack恢复默认的本机打包规则的位置，不应用任何打包。因此，与大多数API不同，这个API需要一个未添加的结构。这种情况并不常见；我不知道它为什么在这里，但它是。
VBA不提供任何不填充结构的选项。因此，这意味着使用8字节的数据类型是行不通的。但是API根据它认为内存布局的方式来解释结构。
至于URL_COMPONENTS的链接，我不知道还做了什么，也许它实际上是32位Office，结构在没有WOW64转换的情况下通过(就像事件跟踪API)，但你可以验证LenB和偏移在有或没有填充成员的情况下都是相同的。
我发现实现这个API最简单的方法就是声明
#If VBA7 Then
#If (Win64 <> 0) And (TWINBASIC = 0) Then
Private Type TASKDIALOG_BUTTON_VBA7
data(11) As byte
End Type
Private Type TASKDIALOGCONFIG_VBA7
data(159) As Byte
End Type
Private m_uButtons_VBA7() As TASKDIALOG_BUTTON_VBA7
Private m_uRadioButtons_VBA7() As TASKDIALOG_BUTTON_VBA7
Private uTDC_VBA7 As TASKDIALOGCONFIG_VBA7
这些是正确的无包装尺寸。对于所有其他模式，正常结构仍然存在(twinBASIC是VB6/VBA的100%兼容继任者，支持使用VBA7语法构建64位exes)，在调用API之前，我将所有常规结构复制到它们的正确偏移，包括按钮数组：
#If (VBA7 <> 0) And (TWINBASIC = 0) And (Win64 <> 0) Then
'Special handling for 64bit VBA7, which doesn't support our manually aligned structure.
ReDim m_uButtons_VBA7(uTDC.cButtons)
Dim i As Long
If uTDC.cButtons Then
For i = 0 to uTDC.cButtons - 1
CopyMemory m_uButtons_VBA7(i).data(0), m_uButtons(i).nButtonID, 4
CopyMemory m_uButtons_VBA7(i).data(4), m_uButtons(i).pszButtonText, 8
next i
End If
ReDim m_uRadioButtons_VBA7(uTDC.cRadioButtons)
If uTDC.cRadioButtons Then
For i = 0 to uTDC.cRadioButtons - 1
CopyMemory m_uRadioButtons_VBA7(i).data(0), m_uRadioButtons(i).nButtonID, 4
CopyMemory m_uRadioButtons_VBA7(i).data(4), m_uRadioButtons(i).pszButtonText, 8
next i
End If
Dim ptrBtn As LongPtr, ptrRbn As LongPtr
ptrBtn = VarPtr(m_uButtons_VBA7): ptrRbn = VarPtr(m_uRadioButtons_VBA7)
CopyMemory uTDC_VBA7.data(0), uTDC.cbSize, 4: CopyMemory uTDC_VBA7.data(4), uTDC.hWndParent, 8: CopyMemory uTDC_VBA7.data(12), uTDC.hInstance, 8
CopyMemory uTDC_VBA7.data(16), uTDC.dwFlags, 4: CopyMemory uTDC_VBA7.data(20), uTDC.dwCommonButtons, 4: CopyMemory uTDC_VBA7.data(24), uTDC.pszWindowTitle, 8
CopyMemory uTDC_VBA7.data(32), uTDC.pszMainIcon, 8: CopyMemory uTDC_VBA7.data(40), uTDC.pszMainInstruction, 8: CopyMemory uTDC_VBA7.data(48), uTDC.pszContent, 8
CopyMemory uTDC_VBA7.data(56), uTDC.cButtons, 4: CopyMemory uTDC_VBA7.data(60), ptrBtn, 8: CopyMemory uTDC_VBA7.data(68), uTDC.nDefaultButton, 4
CopyMemory uTDC_VBA7.data(72), uTDC.cRadioButtons, 4: CopyMemory uTDC_VBA7.data(76), ptrRbn, 8: CopyMemory uTDC_VBA7.data(84), uTDC.nDefaultRadioButton, 4
CopyMemory uTDC_VBA7.data(88), uTDC.pszVerificationText, 8: CopyMemory uTDC_VBA7.data(96), uTDC.pszExpandedInformation, 8: CopyMemory uTDC_VBA7.data(104), uTDC.pszExpandedControlText, 8
CopyMemory uTDC_VBA7.data(112), uTDC.pszCollapsedControlText, 8: CopyMemory uTDC_VBA7.data(120), uTDC.pszFooterIcon, 8: CopyMemory uTDC_VBA7.data(128), uTDC.pszFooter, 8
CopyMemory uTDC_VBA7.data(136), uTDC.pfCallback, 8: CopyMemory uTDC_VBA7.data(144), uTDC.lpCallbackData, 8: CopyMemory uTDC_VBA7.data(156), uTDC.CXWidth, 4
hr = TaskDialogIndirect_VBA7(uTDC_VBA7, pnButton, pnRadButton, pfVerify)
#Else
hr = TaskDialogIndirect(uTDC, pnButton, pnRadButton, pfVerify)
#End If
(如果你想看完整的类，它在GitHub上)