I have problem with delphi code. I want to call the function in delphi to process the fortran function, but I have transferred to DLL. Here is code Fortran
SUBROUTINE c_zsn(m,d,k,f,zsn,nf)
! Specify that the routine name is to be made available to callers of the
! DLL and that the external name should not have any prefix or suffix
!MS$ ATTRIBUTES DLLEXPORT :: c_zsn
!MS$ ATTRIBUTES ALIAS:'c_zsn' :: c_zsn
!MS$ ATTRIBUTES VALUE :: m,d,k,nf
!MS$ ATTRIBUTES REFERENCE :: f,zsn
IMPLICIT NONE
INTEGER :: nf,i
REAL(KIND(0.D0)) :: m,d,k,f(0:(nf-1)),zsn(0:(nf-1)),om,pi
COMPLEX(KIND(0.D0)) :: j
j = (0.d0, 1.d0)
pi = 4.d0 * datan(1.d0)
do i=0,nf-1
om = 2.d0*pi*f(i)
zsn(i) = abs(-om**2*m-j*om*d+k)
end do
END SUBROUTINE
and here is code for the Delphi that I used
procedure TForm1.Button2Click(Sender: TObject);
type tarray=array[0..10]of double;
var a:thandle;
fcn:function(s,d,f:double;var g,h:tarray;n:integer):double;
e,f,d,g,h,i,j:double;
k:tarray;
l,o:tarray;
n,m:integer;
begin
a:=LoadLibrary('dllsub.dll');
if (A=0) then
begin
Application.MessageBox('Failed to open library','Error', MB_OK or MB_ICONEXCLAMATION);
exit;
end;
#fcn:=GetProcAddress(a, 'c_zsn');
if #b=nil then
begin
ShowMessage('Failed to open function');
exit;
end;
e:=2;
f:=200;
d:=0.01;
n:=10;
for m:=0 to n do
l[m]:=m;
fcn(e,d,f,l,o,n); // this is the problem
FreeLibrary(a);
end;
I cannot call the function (the bold one).
I would declare the function like this:
procedure c_zsn(
m: Double;
d: Double;
k: double;
f: PDouble;
zsn: PDouble;
n: Integer
); stdcall; external 'dllsub.dll';
You do need to specify the calling convention. You omitted that which meant that your code used the default register calling convention which is private to Delphi. I'm guessing that the calling convention is stdcall but it may be cdecl. Check the compiler documentation to be sure.
And it is not at all obvious to me why you declared a function that returns a double. The Fortran does not do that.
Other than that I changed the parameter names to match the Fortran code. I also switched to load time linking which is easier to code against. You can skip the calls to LoadLibrary and GetProcAddress and let the loader resolve the linkage.
Finally, I think the two arrays are better passed as PDouble (that is pointer to Double) rather than committing at compile time to fixed size arrays.
You can call the function like this:
c_zsn(e,d,f,#l[0],#o[0],n);
Do note that you have declared arrays of length 11 rather than length 10. Did you mean to do that? I think you should declare the arrays like this:
var
l, o: array [0..9] of Double;
One final point is that the Fortran code is very simple. It would be very easy indeed to translate it into Delphi.
Related
I have a program with a lot of structures defined as static arrays of char and records (usually consisting of arrays of char, but that's not so important).
I am trying to create a generic interface for these structures, so they can be passed to a back-end C DLL.
I am able to handle all types of records by using the <T: record> constraint, but array[0..n] of char falls foul of the 'non-nullable value type' rule.
I can use unconstrained generics by declaring types for my different static arrays (TMyArray = array[0..5] of char - this is fine, as it's already there in existing code), but I need to lose my <T: record> constraint. As my code will not work with classes nor dynamic arrays I'd like to be able to restrict T to being either a record or static array of char.
I am able to have two constructors with and without the record constraint. I can then test that it the unconstrained type is an array by using old-style RTTI:
var
l: PTypeInfo;
begin
l := TypeInfo(T);
assert(l.Kind = tkArray);
end;
but I don't think I can check that the contained type is a char? 2010 RTTI complains that T must be a class, so I don't think that's a goer either.
I can get around it somewhat by creating records containing only my static char array, but that feels a bit of a fudge and will look quite clumsy in code.
This is a compiler defect. A fixed length array is a non-nullable value type. The defect is still present in Delphi 10 Seattle. This program fails to compile:
{$APPTYPE CONSOLE}
type
TFoo = record
class procedure Bar<T: record>(const arg: T); static;
end;
class procedure TFoo.Bar<T>(const arg: T);
begin
end;
type
TArr = array [0..0] of char;
var
Arr: TArr;
begin
TFoo.Bar<TArr>(Arr);
end.
The error is:
[dcc32 Error] E2512 Type parameter 'T' must be a non-nullable value type
So, I guess you will have to handle this with a runtime check using RTTI. Which you can certainly do. This program demonstrates:
{$APPTYPE CONSOLE}
uses
Rtti, TypInfo;
type
TFoo = record
class procedure Bar<T>(const arg: T); static;
end;
class procedure TFoo.Bar<T>(const arg: T);
var
TypInfo: PTypeInfo;
ArrayTypeData: TArrayTypeData;
begin
TypInfo := TypeInfo(T);
if TypInfo.Kind = tkArray then begin
ArrayTypeData := GetTypeData(TypInfo).ArrayData;
Writeln(ord(ArrayTypeData.ElType^.Kind));
Writeln(ArrayTypeData.Size);
Writeln(ArrayTypeData.ElCount);
Writeln(ArrayTypeData.DimCount);
end;
end;
type
TArr = array [1..32] of char;
var
Arr: TArr;
begin
TFoo.Bar<TArr>(Arr);
Readln;
end.
The output is:
9
64
32
1
Note that ord(tkWChar) == 9. So, this gives you the means to do the following:
Detect that the type is an array.
Check that it has a single dimension.
Check that the element type is as expected.
Check that the element count is as expected.
That's all the information you need to check that the type meets your requirements.
I have a C based DLL that exports a function that has char*** as an argument, this is a pointer to a pointer to a pointer of char (Non-unicode) My question is, after much frustration, what is the equivalent declaration at the Delphi end?
I've tried for example:
// C Method declaration
void method (char*** arg)
TArrayOfPAnsiChar = array of PAnsiChar;
PArrayOfPAnsiChar = ^TArrayOfPAnsiChar;
PPArrayOfPAnsiChar = ^PArrayOfPAnsiChar;
// Delphi declaration
procedure method (var p : PPArrayOfPAnsiChar); cdecl;
p : PPArrayOfAnsiChar;
method (p)
But I'm not getting anything sensible back. Any suggestions? The var in the declaration is of course already a pointer so perhaps that's where I am going wrong. I've tried many variants, written down on paper what the structure is and reverse engineered a Delphi declration but to no avail. This DLL is used in other C based applications so I assume its functioning correctly.
Using XE6
Don't use array of, because that declares a dynamic array, and use AnsiChar rather than Char, since the latter is two bytes in Delphi.
PPAnsiChar = ^PAnsiChar;
PPPAnsiChar = ^PPAnsiChar;
procedure Method(Arg: PPPAnsiChar); cdecl;
or
procedure Method(var Arg: PPAnsiChar); cdecl;
If you want to index into the variable like an array, add {$POINTERMATH ON} before declaring the types
In this case char*** is a pointer to a pointer that points to an array where each element points to a string.
This implies that the callee is returning data to the caller. So you want to use:
procedure method(out Arg: PPAnsiChar); cdecl; external dllname;
where PPAnsiChar is ^PAnsiChar. Note that PPAnsiChar is defined in the System unit.
The C code has three levels of indirection. The outermost is how function passses data from callee to caller. That's represented as a Delphi out parameter. The remaining two levels of indirection are captured in PPAnsiChar. Finally C's char is an 8 bit type on Windows and so maps to AnsiChar.
You will also need to iterate over the array when the function returns. Like this:
var
StrArr: PPAnsiChar;
Str: string;
....
method(StrArr);
while StrArr^ <> nil do
begin
Str := StrArr^;
Inc(StrArr);
end;
I'm assuming that the length of the array is indicated by a terminating null pointer. If instead you are told the length, you use a for loop as should be obvious.
I'm using Delphi XE and the Matlab 2012B compiler on Windows 7.
I'm trying to write several wrapper functions so DLL files created with the Matlab 2012b Compiler can be more easily called from Delphi XE. I found that I should use the _proxy functions when using the MCR, which indeed allowed me to call several functions successfully. I can also pass strings to Matlab without problems by passing them as PAnsiChar.
I'm currently trying to create a StructArray with some field names.
As I've already successfully created numeric arrays and matrices, I'm pretty sure the first 2 parameters are OK. I expect the last one is causing the error, but I don't know how to solve this (yet). Looking at the Matlab help and example files I'm doing what should be done. Obviously I'm wrong...
I know that with Matlab r13 we had to pass the fieldnames as an array[0..n] of pAnsiChar instead of an array of pAnsiChar. I tried this here as well to no avail.
Can someone tell me if I have indeed made the correct function mapping to mxCreateStructArray(_730_proxy) and if I'm passing the parameters as expected?
type
mxArray = pointer;
// mxArray *mxCreateStructArray(mwSize ndim, const mwSize *dims, int nfields, const char **fieldnames);
function MCRdll_CreateStructArray(aDimCount: integer; aDims: pointer; aFieldCount: integer; aFields: PPAnsiChar): mxArray; cdecl; external 'mclmcrrt8_0.dll' name 'mxCreateStructArray_730_proxy';
function MCR_CreateStructArray(aFieldNames: TArray<string>): mxArray;
var
i: integer;
lstDims: array of integer;
lstNames: array of pAnsiChar;
begin
SetLength(lstNames, Length(aFieldNames));
for i := 0 to Length(aFieldNames) - 1 do
lstNames[i] := ToPAnsiChar(aFieldNames[i]); //Creates a new PAnsiChar with the content of aFieldNames[i]
SetLength(lstDims, 2);
lstDims[0] := 1;
lstDims[1] := Length(aFieldNames);
//This call raises an "External Exception" from Matlab.
Result := MCRdll_CreateStructArray(Length(lstDims), #lstDims, Length(lstNames), #lstNames);
end;
The MATLAB C API function is:
mxArray *mxCreateStructArray(mwSize ndim, const mwSize *dims,
int nfields, const char **fieldnames);
As I understand it, mwSize is by default the same as int. That translates to Integer in Delphi. The const char** parameter is the address of an array of const C strings. Translate that to Delphi and you have:
function MCRdll_CreateStructArray(ndim: Integer; dims: PInteger;
nFields: Integer; fieldnames: PPAnsiChar): mxArray; cdecl;
external 'mclmcrrt8_0.dll' name 'mxCreateStructArray_730_proxy';
Now, how to get the parameters. Well, assuming you want a vector, dims is an array of length 2, and ndim is that length. I'd declare that as a static array:
var
dims: array [0..1] of Integer;
As for the field names, those are variable length. So you need a dynamic array of PAnsiChar. That is:
var
fieldnames: array of PAnsiChar;
You also need to pass the vector length for your struct array to your function. That makes your function be something like this:
function MCR_CreateStructArray(len: Integer;
const aFieldNames: array of AnsiString): mxArray;
var
i: integer;
dims: array [0..1] of Integer;
fieldnames: array of PAnsiChar;
begin
if Length(aFieldNames)=0 then
begin
Result := nil;
exit;
end;
dims[0] := 1;
dims[1] := len;
SetLength(fieldnames, Length(aFieldNames));
for i := 0 to high(fieldnames) do
fieldnames[i] := PAnsiChar(aFieldNames[i]);
Result := MCRdll_CreateStructArray(Length(dims), #lstDims[0],
Length(fieldnames), #fieldnames[0]);
end;
An alternative to the final parameter is to pass PPAnsiChar(fieldnames). That works because a dynamic array variable is the address of the first element.
So, what was wrong with your version? The biggest mistake you made was to use untyped pointers for the two arrays that you pass to MCRdll_CreateStructArray. This means that the compiler cannot check that you got the indirection correct. And you did not.
First of all in your code you pass #lstDims to the second parameter. Now lstDims is a dynamic array in your code. The implementation of that has lstDims being a pointer to the first element. So, informally, lstDims has type ^Integer. And therefore #lstDims has type ^^Integer. That's one level of indirection too far. And you made the exact same mistake in the final parameter.
One final point. I've change the signature of the function to receive an array of AnsiString. That's the easy way for me to write the code because I don't need to worry about the UTF-16 to ANSI conversion, and can use a simple PAnsiChar cast. You'd probably benefit from this helper:
function ToAnsiStringArray(const arr: array of string): TArray<AnsiString>;
var
i: Integer;
begin
SetLength(Result, Length(arr));
for i := 0 to high(Result) do
Result[i] := AnsiString(arr[i]);
end;
I've not compiled any of this so there may be some imprecision. I trust you'll not be put off by that.
I am experimenting with the ability to dynamically invoke procedures or functions that reside in a function table. The specific application is a DLL that exports a pointer to a function table together with information on the number of arguments and types. The host application then has the ability to interrogate the DLL and call the functions. If they were object methods I could use Rtti to invoke them but they are normal procedures and functions. The DLL has to export normal function pointers not objects because the DLL could be written in any language including C, Delphi etc.
For example, I have a record declared and filled out in a DLL:
TAPI = record
add : function (var a, b : double) : double;
mult : function (var a, b : double) : double;
end;
PAPI = ^TAPI;
I retrieve the pointer to this record, declared as:
apiPtr : PAPI;
Assume I also have access to the names of the procedures, number of arguments and argument types for each entry in the record.
Assume I want to call the add function. The function pointer to add will be:
#apiPtr^.add // I assume this will give me a pointer to the add function
I assume there is no other way other than to use some asm to push the necessary arguments on the stack and retrieve the result?
First question, what is the best calling convention to declare the procedure as, cdecl? Seems easiest for assembling the stack before the call.
Second question, are there any examples online that actually do this? I came across http://www.swissdelphicenter.ch/torry/showcode.php?id=1745 (DynamicDllCall) which is close to what I want but I simplified as below, it now returns a pointer (EAX) to the result:
function DynamicDllCall(proc : pointer; const Parameters: array of Pointer): pointer;
var x, n: Integer;
p: Pointer;
begin
n := High(Parameters);
if n > -1 then begin
x := n;
repeat
p := Parameters[x];
asm
PUSH p
end;
Dec(x);
until x = -1;
end;
asm
CALL proc
MOV p, EAX <- must be changed to "FST result" if return value is double
end;
result := p;
end;
but I can't get it to work, it returns a value for the first parameters instead of the result. Maybe I have the calling convention wrong or maybe I misunderstand how to retrieve the result in EAX.
I call DynamicDllCall as follows:
var proc : pointer;
parameters: array of Pointer;
x, y, z : double;
p : pointer;
begin
x:= 2.3; y := 6.7;
SetLength(parameters, 2);
parameters[0] := #x; parameters[1] := #y;
proc := #apiPtr^.add;
p := DynamicDllCall(proc, Parameters);
z := double (p^);
Any advice gratefully received. I appreciate that some may feel this isn't the way one should go about doing this but I am still curious if it is at least possible.
Update 1 I can confirm that the add function is getting the correct values to do the addition.
Update 2 If I change the signature of add to:
add : function (var a, b, c : double) : double;
and I assign the result to c inside add, then I can retrieve the correct answer in the parameters array (assuming I add one more element to it, 3 instead of 2). The problem therefore is that I misunderstand how values are returned from functions. Can anyone explain how functions return values and how best to retrieve them?
Update 3 I have my answer. I should have guessed. Delphi returns different types via different registers. eg integers return via EAX, double on the other hand returns via ST(0). To copy ST(0) to the result variable I must use "FST result" rather than "MOV p, EAX". I least I now know it is possible in principle to do this. Whether it is a sensible thing to do is another matter I must now think about.
This is an XY problem: You want to do X, and, for whatever reason, you've decided Y is the solution, but you're having trouble making Y work. In your case, X is call external functions via pointers and Y is manually push parameters on the stack. But to accomplish X, you don't really need to do Y.
The expression #apiPtr^.add will not give you a pointer to the function. It will give you a pointer to the add field of the TAPI record. (Since add is the first member of the record, the address of that field will be equal to the address held in apiPtr; in code, Assert(CompareMem(#apiPtr, #apiPtr^.add, SizeOf(Pointer)).) The add field holds a pointer to the function, so if that's what you want, just use apiPtr^.add (and note that the ^ is optional in Delphi).
The best calling convention to use is stdcall. Any language that supports exporting DLL functions will support that calling convention.
You don't need assembler or any other tricky stack manipulation to call your functions. You already know the function's type because you used it to declare add. To call the function pointed to by that field, simply use the same syntax as for calling an ordinary function:
z := apiPtr.add(x, y);
The compiler knows the declared type of the add field, so it will arrange the stack for you.
This is a hard problem to solve. One way to dynamically access methods in a DLL at runtime would be to use a foreign function interface library such as libffi, dyncall or DynaCall(). None of these however have yet been ported to the Delphi environment.
If the application is to interface a set of methods in a DLL together with Rtti information provided by the DLL and expose them to a scripting language such as Python, one option is to write Delphi code that inspects the DLL and writes out a ctypes compatible script which can be loaded into an embedded Python interpreter at runtime. So long as one defines before hand a limited but sufficient set of types that the DLL methods can handle, this is a practical solution.
I found a Windows API function that performs "natural comparison" of strings. It is defined as follows:
int StrCmpLogicalW(
LPCWSTR psz1,
LPCWSTR psz2
);
To use it in Delphi, I declared it this way:
interface
function StrCmpLogicalW(psz1, psz2: PWideChar): integer; stdcall;
implementation
function StrCmpLogicalW; external 'shlwapi.dll' name 'StrCmpLogicalW';
Because it compares Unicode strings, I'm not sure how to call it when I want to compare ANSI strings. It seems to be enough to cast strings to WideString and then to PWideChar, however, I have no idea whether this approach is correct:
function AnsiNaturalCompareText(const S1, S2: string): integer;
begin
Result := StrCmpLogicalW(PWideChar(WideString(S1)), PWideChar(WideString(S2)));
end;
I know very little about character encoding so this is the reason of my question. Is this function OK or should I first convert both the compared strings somehow?
Keep in mind that casting a string to a WideString will convert it using default system codepage which may or may not be what you need. Typically, you'd want to use current user's locale.
From WCharFromChar in System.pas:
Result := MultiByteToWideChar(DefaultSystemCodePage, 0, CharSource, SrcBytes,
WCharDest, DestChars);
You can change DefaultSystemCodePage by calling SetMultiByteConversionCodePage.
The easier way to accomplish the task would be to declare your function as:
interface
function StrCmpLogicalW(const sz1, sz2: WideString): Integer; stdcall;
implementation
function StrCmpLogicalW; external 'shlwapi.dll' name 'StrCmpLogicalW';
Because a WideString variable is a pointer to a WideChar (in the same way an AnsiString variable is a pointer to an AnsiChar.)
And this way Delphi will automatically "up-convert" an AnsiString to a WideString for you.
Update
And since we're now in the world of UnicodeString, you would make it:
interface
function StrCmpLogicalW(const sz1, sz2: UnicodeString): Integer; stdcall;
implementation
function StrCmpLogicalW; external 'shlwapi.dll' name 'StrCmpLogicalW';
Because a UnicodeString variable is still a pointer to a \0\0 terminated string of WideChars. So if you call:
var
s1, s1: AnsiString;
begin
s1 := 'Hello';
s2 := 'world';
nCompare := StrCmpLogicalW(s1, s2);
end;
When you try to pass an AnsiString into a function that takes a UnicodeString, the compiler will automatically call MultiByteToWideChar for you in the generated code.
CompareString supports numeric sorting in Windows 7
Starting in Windows 7, Microsoft added SORT_DIGITSASNUMBERS to CompareString:
Windows 7: Treat digits as numbers during sorting, for example, sort "2" before "10".
None of this helps answer the actual question, which deals with when you have to convert or cast strings.
There might be an ANSI variant for your function to (I haven't checked). Most Wide API's are available as an ANSI version too, just change the W suffix to an A, and you're set. Windows does the back-and-forth conversion transparantly for you in that case.
PS: Here's an article describing the lack of StrCmpLogicalA : http://blogs.msdn.com/joshpoley/archive/2008/04/28/strcmplogicala.aspx
Use System.StringToOleStr, which is a handy wrapper around MultiByteToWideChar, see Gabr's answer:
function AnsiNaturalCompareText(const S1, S2: string): integer;
var
W1: PWideChar;
W2: PWideChar;
begin
W1 := StringToOleStr(S1);
W2 := StringToOleStr(S2);
Result := StrCmpLogicalW(W1, W2);
SysFreeString(W1);
SysFreeString(W2);
end;
But then, Ian Boyd's solution looks and is much nicer!