我有一个64位Delphi(XE4)dll。我从Excel VBA调用它。
我使用以下技巧:http://www.devx.com/tips/Tip/37587
它适用于 32 位和 64 位 excel-2010,但不适用于 excel-2013
StrDataSizePtr^:=Length(tmpStr);//Access Violation here
可能是什么问题?excel-2013 vba 有新的字符串格式吗?
谢谢!
编辑:
德 尔 福
{$IFDEF WIN64}
TPtrLong = UInt64;
{$ELSE}
TPtrLong = Longword;
{$ENDIF}
procedure StrToVBAStr(Str : String;VAR VBAStr : PAnsiChar);
VAR
VBAStrPtr : TPtrLong absolute VBAStr;
ResStrSizePtr : PLongword;
begin
if Length(Str)>Integer(StrLen(VBAStr))
then raise Exception.Create('StrToVBAStr : '+IntToStr(Length(Str))+'>'+IntToStr(StrLen(VBAStr)));
ResStrSizePtr:=Ptr(VBAStrPtr-4);//this points to VBA String size
VBAStr:=StrPLCopy(VBAStr,Str,Length(Str));//copy to VBAStr-be
ResStrSizePtr^:=Length(Str);//set VBAStr length
end;
function GetLastError(VAR Error : PAnsiChar) : Longint; stdcall;
VAR
sError : String;
begin
TRY
Result := _GetLastError(sError);
StrToVBAStr(sError, Error);
EXCEPT
Result := -1;
END;
end;
VBA
Private Declare PtrSafe Function XLDLL_GetLastErrorA Lib "XL.dll" Alias "GetLastError" ( _
ByRef Result As String) As Long
Public Sub XLDLL_Error(Optional ByVal Source As String = "")
Dim XLErr As String
XLErr = Space(1001)
If XLDLL_GetLastErrorA(XLErr) <> -1 Then
XL_LastError = XLErr
If XL_LastError <> "" Then
Err.Raise vbObjectError + 1000, Source, XL_LastError
End If
Else
Err.Raise vbObjectError + 1000, "XLDLL_Hiba", "XLDLL_GetLastErrorA hiba"
End If
End Sub
这段代码从来都不正确。它在过去可能是偶然的。VBA 字符串的内部专用实现可能已更改。或者它可能保持不变,你的运气刚刚用完。
无论如何,正确的解决方案是停止依赖 VBA 字符串的私有内部实现详细信息。将字符串从本机代码传递到 VBA 就足够了。这样做:
德 尔 福
procedure GetString(Str: PAnsiChar; var Len: Integer); stdcall;
var
Value: AnsiString;
begin
Value := ...;
StrLCopy(Str, PAnsiChar(Value), Len);
Len := Min(Len, Length(Value));
end;
VBA
Private Declare PtrSafe Sub GetString Lib "XL.dll" ( _
ByVal str As String, ByRef len As Long)
....
len = 1024
buff = Space(len)
GetString(buff, len)
buff = Left(buff, len)
看起来问题是由其他 Excel 插件引起的。在纯新的 Excel-2013 安装上,它工作正常。从Excel-2013中删除插件后,错误消失了。
(VBA"字符串黑客"在Excel-2013中仍然有效)