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.
Related
I need know how enumarate handles on 64 bits applicatio, i made it on32 bits and works perfectly, but the same code compiled as 64 bits only show some handles.
i already changed variables to longword for example but without success.
i read about SystemHandleInformation on x64 should be another value instead $10 (16 dec) but tried without success.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Windows,
Classes,
PsApi;
const
SystemHandleInformation = $10;
STATUS_SUCCESS = $00000000;
STATUS_BUFFER_OVERFLOW = $80000005;
STATUS_INFO_LENGTH_MISMATCH = $C0000004;
//
type
NTSTATUS = Cardinal;
OBJECT_INFORMATION_CLASS = (ObjectBasicInformation, ObjectNameInformation,
ObjectTypeInformation, ObjectAllTypesInformation, ObjectHandleInformation);
//
SYSTEM_HANDLE = packed record
UniqueProcessId : USHORT;
CreatorBackTraceIndex : USHORT;
ObjectTypeIndex : UCHAR;
HandleAttributes : UCHAR;
HandleValue : USHORT;
HObject : PVOID;
GrantedAccess : ULONG;
end;
PSYSTEM_HANDLE = ^SYSTEM_HANDLE;
SYSTEM_HANDLE_ARRAY = Array[0..0] of SYSTEM_HANDLE;
PSYSTEM_HANDLE_ARRAY = ^SYSTEM_HANDLE_ARRAY;
//
SYSTEM_HANDLE_INFORMATION = packed record
uCount : ULONG;
Handles : SYSTEM_HANDLE_ARRAY;
end;
PSYSTEM_HANDLE_INFORMATION = ^SYSTEM_HANDLE_INFORMATION;
//
TNtQuerySystemInformation = function (SystemInformationClass:DWORD; SystemInformation:pointer; SystemInformationLength:DWORD; ReturnLength:PDWORD):THandle; stdcall;
TNtQueryObject = function (ObjectHandle:cardinal; ObjectInformationClass:OBJECT_INFORMATION_CLASS; ObjectInformation:pointer; Length:ULONG;ResultLength:PDWORD):THandle;stdcall;
var
NTQueryObject : TNtQueryObject;
NTQuerySystemInformation : TNtQuerySystemInformation;
Procedure EnumerateOpenFiles();
const
HANDLE_BUFFER_INCREASE_CHUNK = 5000 * 1024;
var
sDummy : string;
hProcess : THandle;
hObject : THandle;
ResultLength: DWORD;
aBufferSize : DWORD;
aIndex : LONG;//Integer;
pHandleInfo : PSYSTEM_HANDLE_INFORMATION;
HDummy : THandle;
lpszProcess : PWideChar;
begin
AbufferSize := HANDLE_BUFFER_INCREASE_CHUNK;
pHandleInfo := AllocMem(AbufferSize);
HDummy := NTQuerySystemInformation(DWORD(SystemHandleInformation), pHandleInfo, AbufferSize, #ResultLength); //Get the list of handles
if(HDummy = STATUS_SUCCESS) then
begin
for aIndex:=0 to pHandleInfo^.uCount-1 do
begin
hProcess := OpenProcess(PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, pHandleInfo.Handles[aIndex].UniqueProcessId); //open the process to get aditional info
if(hProcess <> INVALID_HANDLE_VALUE) then
begin
hObject := 0;
if DuplicateHandle(hProcess, pHandleInfo.Handles[aIndex].HandleValue, GetCurrentProcess(), #hObject, STANDARD_RIGHTS_REQUIRED, FALSE, 0) then //Get a copy of the original handle
begin
lpszProcess := AllocMem(MAX_PATH);
if GetModuleFileNameEx(hProcess, 0,lpszProcess, MAX_PATH) <> 0 then
sDummy:=lpszProcess
else
sDummy:= 'System Process';
WriteLn(Format('PID [%d] Process [%s]', [pHandleInfo.Handles[aIndex].UniqueProcessId, sDummy]));
FreeMem(lpszProcess);
CloseHandle(hObject);
end;
CloseHandle(hProcess);
end;
end;
end;
WriteLn('Finish');
FreeMem(pHandleInfo);
end;
begin
NTQueryObject := GetProcAddress(GetModuleHandle('NTDLL.DLL'), 'NtQueryObject');
NTQuerySystemInformation := GetProcAddress(GetModuleHandle('NTDLL.DLL'), 'NtQuerySystemInformation');
if (#NTQuerySystemInformation <> nil) and (#NTQuerySystemInformation <> nil) then EnumerateOpenFiles() else WriteLn('falhou no inicio');
ReadLn;
end.
That works perfectly on x86 application, but when i change to x64 he don't show the same results as x86, anyone know why?
Local variable names and two unremoved comments suggest that this is a variation on code posted by RRUZ at 2009 here. At that time there was no 64 bit Delphi version so it was not possible for him to test the code on 64 bits. Anyway, I was able to test this with XE2 on W7x64 using "jwanative.pas" for the missing NtQuerySystemInformation from your sample. You also have one end too many, you need to remove the end that comes before FreeMem(lpszProcess);. Otherwise the code will not compile - probably a copy/paste error on your part.
The error is mis-packing the SYSTEM_HANDLE and SYSTEM_HANDLE_INFORMATION records, their layouts are messed up for 64 bit when packed. This page by Geoff Chappell (have to acknowledge according to the site's terms) suggests that
The SYSTEM_HANDLE_INFORMATION is 0x14 and 0x20 bytes in 32-bit and
64-bit Windows, respectively.
Unpack it to have 32 bytes in x64 instead of 28 while packed.
Similarly, this page suggests:
The SYSTEM_HANDLE_TABLE_ENTRY_INFO structure is 0x10 or 0x18 bytes in
32-bit and 64-bit Windows, respectively.
Unpack your record and it will be 24 bytes on x64 instead of 20 while packed. Although the members slightly differ, you'll be able to see it runs about the same as on x32.
Note that the code may or may not run on later/future versions of OS. Microsoft not only does not fully document system information retrieval but also warn that
The NtQuerySystemInformation function and the structures that it
returns are internal to the operating system and subject to change
from one release of Windows to another.
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;
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)
I used same function ( OneWayEncrypt(edit1.Text) ) in Delphi 5 and 2010.
Why the results are different? (Or how can I give the same results from Delphi 2010?)
uses Sysutils, Windows, Dialogs, classes;
function OneWayEncrypt(AStr: string): string;
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCvalue: DWORD);
implementation
const
table: ARRAY[0..255] OF DWORD =
(
//table consts are here
);
PROCEDURE CalcCRC32(p: pointer; ByteCount: DWORD; VAR CRCvalue: DWORD);
VAR
i: DWORD;
q: ^Byte;
BEGIN
q := p;
FOR i := 0 TO ByteCount - 1 DO
BEGIN
CRCvalue := (CRCvalue SHR 8) XOR table[q^ XOR (CRCvalue AND $000000FF)];
INC(q);
END
END;
function OneWayEncrypt(AStr: string): string;
var
dwCrc: DWORD;
s: string;
begin
dwCrc := $FFFFFFFF;
s := 'X' + AStr + '7F';
CalcCRC32(Addr(s[1]), Length(s), dwCrc);
result := IntToHex(dwCrc, 8);
end;
Are you aware that string refers to a Unicode string in D2010, while it refers to AnsiString in versions < D2009? That should be the source of your problem.
So you have two choices:
You could replace all appearances of string with AnsiString. This should give you the same results as in D5, of course without Unicode support
You could refactor your code. I guess that the pointer-"hacking" is the crucial part here. But I have to admit, I didn't take the time to fully understand the code ;-)
(It could very well be that your code can't be used with Unicode anyways, due to the 255 consts = ISO8859?)
D2010 (and D2009) use Unicode strings (widestrings), so the character size is different (bytes). Try switching all references of string to AnsiString.
Minimal port, one line change:
// old code:
CalcCRC32(Addr(s[1]), Length(s), dwCrc);
// delphi 2010 code:
CalcCRC32( PAnsiChar(AnsiString(s)), Length(s), dwCrc);
Please be aware that any unicode content in the unicode "String" will be lost, but any ANSI (A-Z, 1,3,4, you know) codepoints you used before, for example "Hello", should work just like before. Since this is a CRC32 algorithm, it could do a CRC32 on a UTF8 encoding of the string too, easily.