I've got a 64bit Delphi (XE4) dll. I call it from Excel VBA.
I use the following trick : http://www.devx.com/tips/Tip/37587
It works for 32bit and 64bit excel-2010, but not with excel-2013
StrDataSizePtr^:=Length(tmpStr);//Access Violation here
What can be the problem? Does excel-2013 vba has new String format?
Thank You!
EDIT:
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
That code has never been correct. It might have worked by chance in the past. It's possible that the internal private implementation of the VBA string has been changed. Or it is possible that it has stayed the same and your luck has just run out.
In any case, the correct solution is to stop relying on the private internal implementation detail of the VBA string. Passing a string from native code to VBA is simply enough. Do it like this:
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)
It looks like the problem was caused by an other Excel plugin.
On a pure new Excel-2013 install it works fine.
After removing plugins from the Excel-2013, the error gone.
(The VBA "string hack" still works in Excel-2013)
Related
I’ve got these 4 dll function probably created in c++ of which I have examples of calling these functions both in c ++ and in visual basic.
I have to use these functions in delphi (Delphi 7 and Delphi 10.4). VbOpen, VbClose, and VbWrite work just fine but I can't get VbRead to work.
I have already declared these functions as follows:
function VbOpen(_1: Integer;_2: LongInt;_3: BYTE;_4: BYTE;_5: BYTE;_6: BYTE;var _7: LongInt): Integer; stdcall;
function VbClose(var com:LongInt):Integer ; stdcall;
function VbWrite(var Command:AnsiString; var _3: LongInt): Integer; stdcall ;
function VbRead(var pBufOut : PAnsiChar ; var nBufferSize : LongInt;var _3: LongInt): integer; stdcall;
//
Call to VbRead
r:=VbOpen(5,...,...,...,...,,.);
if r=0 then
begin
//
IpCommand := '1009';
r:=VbWrite(IpCommand,errorCode);
// Visual Basic
GetMem(pBufOut,100);
r:=VbRead(pBufOut, pByteRead, errorCode);
if r=0 then
begin
if pByteRead > 0 then
begin
SetString(resultString, pBufOut, pdwByteRead);
end;
end;
end;
VbClose(errorCode); // Closes the connection and frees the used memory
The result of VbRead resultString are garbage characters but pByteRead bytes returned like a correct value.
Example in visual basic where I have the working exe file
Dim vReturn As Long
Dim vCodeErr As Long
Dim vRetByte As Long
Dim s As String
Dim strOut As String
Dim pBufOut(1000) As Byte
Dim i As Long
s = "1001" // comand code
vReturn = VbWrite(s, vCodeEr)
vReturn = VbRead(pBufOut(),vRetByte, vCodeEr)
' Close Com Port
vReturn = VbClose(vCodeEr)
i = 1
strOut = ""
While (i <= vRetByte)
strOut = strOut + String(1, pBufOut(i))
i = i + 1
Wend
From the user manual of the dll
Sintax DWORD VbRead(SAFERRAY** pBufOut, LPDWORD pByteRead, LPDWORD lpdwCodeError)
pBufOut address of the bytes read
pByteRead number of bytes read
lpdwCodeError system errors returned
Where is the error hiding?
Thanks for any help
Vincent
You probably have to use VarArrayCreate to allocate space.
var
Arr: Variant;
begin
Arr := VarArrayCreate([1000], varByte);
the VB example allocates 1000 Bytes. But you allocate with GetMem only 100 Bytes.
Also you might remove the "var" statements in methods vbRead and vbWrite.
I am trying to call a dll from Delphi XE5.
I have spent a day or so Googling for things like "Call C DLL from Delphi" and found a number of pages but nothing really helped me.
I have received examples of how to call the dll in VB:
Declare Function IxCommand Lib "IxxDLL.dll" (ByVal command As String, ByVal mailbox As String) As Integer
...
Sub Command1_Click ()
Dim command As String * 135
Dim mailbox As String * 135
command = "move:a,1000"
IxCommand( command, mailbox)
End Sub
Also calling the DLL in VC 6.0:
#include "stdafx.h"
#include "windows.h"
#include "stdio.h"
#include "string.h"
typedef UINT (CALLBACK* LPFNIXDLLFUNC)(char *ixstr, char *mbstr);
int main(int argc, char* argv[])
{
HINSTANCE hDLL; // Handle to DLL
LPFNIXDLLFUNC lpfnIxDllFunc; // Function pointer
hDLL = LoadLibrary( "IxxDLL.dll" );
if (hDLL == NULL) // Fails to load Indexer LPT
{
printf("Can't open IxxDLL.dll\n");
exit(1);
}
else // Success opening DLL - get DLL function pointer
{
lpfnIxDllFunc = (LPFNIXDLLFUNC)GetProcAddress(hDLL, "IxCommand");
}
printf( "Type Indexer LPT command and press <Enter> to send\n" );
printf( "Type \"exit\" and press <Enter> to quit\n\n" );
while( 1 )
{
char ix_str[135]; // String to be sent to Indexer LPT
char mailbox_str[135]; // Results from call into Indexer LPT
gets( ix_str ); // Get the string from the console
if( _stricmp( ix_str, "exit" ) == 0 ) // Leave this program if "exit"
break;
lpfnIxDllFunc( ix_str, mailbox_str ); // Otherwise call into Indexer LPT
printf( "%s\n\n", mailbox_str ); // Print the results
}
FreeLibrary( hDLL );
return 0;
}
A complication I have noticed is the need to define the size of the memory allocation before calling the DLL, as shown above.
The dll takes a command in the first argument and returns result text in the second argument.
Here is the Delphi code I have generated to try and call the DLL. I know the dll loads because it has a splash screen that shows. No error is generated when I call the dll. You will see that I used arrays to allocate space and then assigned their locations to Pchar variables. I do not have any header file for the original dll, nor the source code. You will see I declared the external function using stdcall but I have also tried cdecl with no change.
The Problem: The information returned in arg2 is not the expected text string but a string of what translates as non-english characters (looks like chinese).
I am guessing I am not sending the dll the correct variable types.
The Question: Can anyone help me formulate the declaration of the external function and use it correctly, so that I get back the text strings as desired?
See below:
function IxCommand (command : PChar; mailbox : PChar) : Integer; stdcall; external 'IxxDLL.dll';
...
procedure TfrmXYZ.btn1Click(Sender: TObject);
var
LocalResult : Integer;
arg1,
arg2 : PChar;
ArrayStrCmd : array[0..134] of char;
ArrayStrMbx : array[0..134] of char;
begin
ArrayStrCmd := 'Accel?:a' + #0;
ArrayStrMbx := ' ' + #0;
arg1 := #ArrayStrCmd;
arg2 := #ArrayStrMbx;
LocalResult := IxCommand(arg1, arg2);
end;
The problem is character encodings. In Delphi 2009+, PChar is an alias for PWideChar, but the DLL is using Ansi character strings instead, so you need to use PAnsiChar instead of PChar.
Try this:
function IxCommand (command : PAnsiChar; mailbox : PAnsiChar) : Integer; stdcall; external 'IxxDLL.dll';
...
procedure TfrmXYZ.btn1Click(Sender: TObject);
var
LocalResult : Integer;
ArrayStrCmd : array[0..134] of AnsiChar;
ArrayStrMbx : array[0..134] of AnsiChar;
begin
ArrayStrCmd := 'Accel?:a' + #0;
LocalResult := IxCommand(ArrayStrCmd, ArrayStrMbx);
end;
Alternatively:
function IxCommand (command : PAnsiChar; mailbox : PAnsiChar) : Integer; stdcall; external 'IxxDLL.dll';
...
procedure TfrmXYZ.btn1Click(Sender: TObject);
var
LocalResult : Integer;
ArrayStrCmd,
ArrayStrMbx : AnsiString;
begin
SetLength(ArrayStrCmd, 135);
StrPCopy(ArrayStrCmd, 'Accel?:a');
SetLength(ArrayStrMbx, 135);
LocalResult := IxCommand(PAnsiChar(arg1), PAnsiChar(arg2));
end;
You are using a Unicode version of Delphi for which Char is an alias to a 16 bit WideChar, and PChar is an alias to PWideChar.
Simply replace Char with AnsiChar and PChar with PAnsiChar.
function IxCommand(command, mailbox: PAnsiChar): Cardinal;
stdcall; external 'IxxDLL.dll';
The return value is UINT which maps to Cardinal in Delphi.
The calling code you have used is needlessly complex. I'd do it like this:
var
retval: Cardinal;
mailbox: array [0..134] of AnsiChar;
....
retval := IxCommand('Accel?:a', mailbox);
// check retval for errors
As you observe, there is scope for buffer overrun. I'm not sure how you are meant to guard against that. Documentation for the library, if it exists, would presumably explain how.
After adding the following Delphi function, I'm receiving an error regarding data-type misalignment: Project ... faulted with message: 'datatype misalignment at 0x77a7d7d8'. Process Stopped. Use Step or Run to continue.
The function I've added is below. Note that the function actually completes successfully, although only the timestamp is actually written to the file.
procedure Log(msg : String);
var
tempFolderChars : array [0..MAX_PATH] of Char;
tempFolder : string;
logFile : TextFile;
dt : TDateTime;
begin
GetTempPath(SizeOf(tempFolderChars), tempFolderChars);
tempFolder := IncludeTrailingPathDelimiter(String(tempFolderChars));
dt := Now();
AssignFile(logFile, tempFolder + 'GenericHolding.txt');
if FileExists(tempFolder + 'GenericHolding.txt') then
Append(logFile)
else
ReWrite(logFile);
Write(logFile, FormatDateTime('yyyy-mm-dd hh:nn:ss ', now));
Write(logFile, msg);
Write(logFile, #13, #10);
CloseFile(logFile);
end;
EDIT: Added more assembly output.
ntdll.NtQueryInformationProcess:
77BAFAC8 B816000000 mov eax,$00000016
77BAFACD 33C9 xor ecx,ecx
77BAFACF 8D542404 lea edx,[esp+$04]
77BAFAD3 64FF15C0000000 call dword ptr fs:[$000000c0]
77BAFADA 83C404 add esp,$04
77BAFADD C21400 ret $0014
Char is AnsiChar (SizeOf(Char)=1) in Delphi 2007 and earlier, but is WideChar (SizeOf(Char)=2) in Delphi 2009 and later.
GetTempPath() expects the first parameter to specify the number of characters that your buffer can hold, but you are specifying the number of bytes instead.
In Delphi 2007 and earlier, SizeOf(tempFolderChars) and Length(tempFolderChars) will be the same value, but in Delphi 2009 and later they will not be the same. In that latter case, you are telling GetTempPath() that you can accept twice as many characters as you really can.
You need to change SizeOf(tempFolderChars) to Length(tempFolderChars). You also need to pay attention to the return value of GetTempPath(), as it tells you how many characters were actually written into the buffer.
Try this instead:
procedure Log(msg : String);
var
tempFolderChars : array [0..MAX_PATH] of Char;
tempFolder : string;
len: DWORD;
...
begin
len := GetTempPath(Length(tempFolderChars), tempFolderChars);
if len = 0 then Exit;
SetString(tempFolder, tempFolderChars, len);
tempFolder := IncludeTrailingPathDelimiter(tempFolder);
...
end;
We are tring to use in delphi a pas file generated by Free Pascal. The link is at:
http://www.markwatson.com/opensource/FastTag_Pascal.zip
While testing, it prompts InValidPointer. Please look at the following error line in debugger.
interface
procedure ReadLexicon;
type sarray = array[1..12] of string;
type big_sarray = array[1..1000] of string; { used for word lists and tags: limit on size of input text }
type psarray = ^sarray;
{function GetTagList(word: string): psarray;}
procedure TagWordList(wordList : big_sarray; var tags : big_sarray);
implementation
uses SysUtils, Classes;
{ Hash Table Support - copied from FreePascal source: benchmork shootout examples }
type
THashEntryPtr = ^THashEntryRec;
THashEntryRec = record
name : string;
number : psarray;
next : THashEntryPtr;
end;
const
TABLE_SIZE = 100000;
...
...
...
function GetTagList(word: string): psarray;
var
ret : psarray;
ok : boolean;
begin
ok := localHash.fetch(word, ret);
if ok then GetTagList := ret else GetTagList := nil;
end;
procedure TagWordList(wordList : big_sarray; var tags : big_sarray);
var i : integer;
x : real;
psa : psarray;
lastThreeChars : string;
lastTwoChars : string;
lastChar : string;
firstTwoChars : string;
tagFirstTwoChars : string;
begin
for i := 0 to length(wordList) do
begin
**psa := GetTagList(wordList[i]);///// EInvalidPointer ERROR**
if psa <> nil then tags[i] := psa^[1] else tags[i] := '???';
end;
...
...
...
How can we fix it.
Thank you very much in advance.
The original source doesn't set any compiler mode, and so the default TP like mode is active, meaning string=shortstring.
Replace, in the entire source string with shortstring and it will probably work.
There are at least two errors I can find in the TagWordList procedure.
for i := 0 to length(wordList) do, the array is 1-based so the loop has to start with 1.
A bit later there is a check if i > 0 that fails for the same reason.
It could also be a wrong definition of the type big_sarray = array[1..1000] of string;. If you change that to a 0-based array it might work.
I have Delphi 2007 code that looks like this:
procedure WriteString(Stream: TFileStream; var SourceBuffer: PChar; s: string);
begin
StrPCopy(SourceBuffer,s);
Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;
I call it like this:
var
SourceBuffer : PChar;
MyFile: TFileStream;
....
SourceBuffer := StrAlloc(1024);
MyFile := TFileStream.Create('MyFile.txt',fmCreate);
WriteString(MyFile,SourceBuffer,'Some Text');
....
This worked in Delphi 2007, but it gives me a lot of junk characters in Delphi 2010. I know this is due to unicode compliance issues, but I am not sure how to address the issue.
Here is what I've tried so far:
Change the data type of
SourceBuffer(and also the parameter
expected by WideString) to PWideChar
Every one of the suggestions listed
here
What am I doing wrong?
You don't need a separate buffer to write a string to a stream. Probably the simplest way to do it is to encode the string to UTF8, like so:
procedure TStreamEx.writeString(const data: string);
var
len: cardinal;
oString: UTF8String;
begin
oString := UTF8String(data);
len := length(oString);
self.WriteBuffer(len, 4);
if len > 0 then
self.WriteBuffer(oString[1], len);
end;
function TStreamEx.readString: string;
var
len: integer;
iString: UTF8String;
begin
self.readBuffer(len, 4);
if len > 0 then
begin
setLength(iString, len);
self.ReadBuffer(iString[1], len);
result := string(iString);
end;
end;
I've declared TStreamEx as a class helper for TStream, but it shouldn't be too difficult to rewrite these as a solo procedure and function like your example.
Delphi 2010 has a nice solution for this, documented here:
http://docwiki.embarcadero.com/CodeExamples/en/StreamStrRdWr_%28Delphi%29
var
Writer: TStreamWriter;
...
{ Create a new stream writer directly. }
Writer := TStreamWriter.Create('MyFile.txt', false, TEncoding.UTF8);
Writer.Write('Some Text');
{ Close and free the writer. }
Writer.Free();