Excel 2013 (64位) VBA字符串+ dll

Question

我有一个64位德尔菲(XE4)动态链接库。我从Excel调用它。

我使用以下技巧：http://www.devx.com/tips/Tip/37587

它适用于32位和64位的excel-2010，但不适用于excel-2013。

StrDataSizePtr^:=Length(tmpStr);//Access Violation here

有什么问题吗？excel-2013 vba有新的字符串格式吗？

谢谢!

编辑：

Delphi

{$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

Answer 1

看起来这个问题是由另一个Excel插件引起的。在一个纯新的Excel-2013安装上，它可以正常工作。从Excel-2013中删除插件后，错误就消失了。

( VBA "string hack“在Excel-2013中仍然有效)

Answer 2

那个密码从来没有正确过。这在过去可能是偶然的。VBA字符串的内部私有实现可能已经更改。或者你的运气没有变化，你的运气就没了。

无论如何，正确的解决方案是停止依赖于VBA字符串的私有内部实现细节。将字符串从本机代码传递给VBA就足够了。这样做吧：

Delphi

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)