Use the following updated cfxapid.pas file to create 64-bit CFX tags with Delphi.
{$R-,Q-,X+,W-,D-,L-,Y-}
{===================================================================}
{ Cold Fusion extensions classes for Delphi (CFX_D) }
{ }
{ originally by Leonid Fofanov lfofanov@hotmail.com }
{ modified for unicode by George Wynne george@nssco.com 11/23/2010 }
{ modified for 64-bit by Dima Bayer dima077@gmail.com 07/09/2013 }
{ ==================================================================}
(*********************************************************
ColdFusion calls the entry function of c++ CFX_tag with parameter - c++ object.
This object includes callback functions that can be called by CFX_tag and executed
by ColdFusion. When CFX_tag is written in c++ these function can be called directly.
If a CFX_tag is written in Delphi those function cannot be called directly. Their
address should be extracted before calling them. This is done by 4 assembly functions:
callMethod0, callMethod1, callMethod2, callMethod3.
Every c++ object that has at least one virtual function, includes
pointer to virtual table. This pointer value can be found at the
zero address of an object.
The structure of virtual table of c++ objects received from ColdFusion:
Cell Number * Function * Offset in bytes in x86 * Offset in bytes in x64
1 * virtual destructor * 0 * 0
2 * virtual function one * 4 * 8
3 * virtual function two * 8 * 16
4 * virtual function three * 12 * 24
.
.
The algorithm for extracting and calling those callback virtual functions is:
1)Access pointer of the virtual table.
2)Get the first address of virtual table
3)Get the address of an appropriate virtual function.
4)Call the virtual function
These manipulations are done by 4 assembler functions of class TCFXBaseClass:
*)
unit cfxapid;
interface
const
CFX_STRING_NOT_FOUND = -1;
type
// Basic wrapper class, translates Pascal methods calls to C++ methods calls.
// All other classes in this file inherit from this class.
TCFXBaseClass = class
private
function callMethod0(index: int64): int64;
function callMethod1(parm1, index: int64): int64;
function callMethod2(parm1, parm2, index: int64): int64;
function callMethod3(parm1, parm2, parm3, index: int64): int64;
end;
TCFXStringSet = class(TCFXBaseClass)
function AddString(S: PAnsiChar):integer;
function GetCount: integer;
function GetString(Index: integer): PAnsiChar;
function GetIndexForString(S: PAnsiChar): integer;
end;
TCFXQuery = class(TCFXBaseClass)
function GetName: PAnsiChar;
function GetRowCount: integer;
function GetColumns: TCFXStringSet;
function GetData(Row, Column: integer): PAnsiChar;
function AddRow: integer;
procedure SetData(Row, Column: integer; Data: PAnsiChar);
end;
TCFXException = class(TCFXBaseClass)
function GetError: PAnsiChar;
function GetDiagnostics: PAnsiChar;
end;
TCFXRequest = class(TCFXBaseClass)
function AttributeExists(AttrName: PAnsiChar): boolean;
function GetAttribute(AttrName: PAnsiChar): PAnsiChar;
function GetAttributeList: TCFXStringSet;
function GetQuery: TCFXQuery;
function GetSetting(SettingName: PAnsiChar): PAnsiChar;
procedure Write(S: PAnsiChar);
procedure SetVariable(Name: PAnsiChar; Value: PAnsiChar);
function AddQuery(Name: PAnsiChar; Columns: TCFXStringSet): TCFXQuery;
function Debug: boolean;
procedure WriteDebug(Output: PAnsiChar);
function CreateStringSet: TCFXStringSet;
procedure ThrowException(Error, Diagnostics: PAnsiChar);
procedure ReThrowException(e: TCFXException);
procedure SetCustomData(Data: pointer);
function GetCustomData: pointer;
end;
implementation
//=========================================================
// TCFXBaseClass class
//=========================================================
//call c++ virtual function without parameters
//index - offset in bytes to the appropriate c++ function in c++ virtual table
function TCFXBaseClass.callMethod0(index: int64): int64;
asm
//Shadow space - at a minimum, each function must reserve
//32 bytes (four 64-bit values) on the stack.
push rbx
push rbx
push rbx
push rbx
mov rax, Self
mov rbx, [rax]
call qword ptr [rbx+rdx] //pointer to c++ virtual table + index
pop rbx
pop rbx
pop rbx
pop rbx
end;
//call c++ virtual function with one parameter
//parm1 - parameter to pass to c++ function
//index - offset in bytes to the appropriate c++ function in c++ virtual table
function TCFXBaseClass.callMethod1(parm1: int64; index: int64): int64;
asm
//Shadow space - at a minimum, each function must reserve
//32 bytes (four 64-bit values) on the stack.
push rbx
push rbx
push rbx
push rbx
mov rax, Self
mov rbx, [rax]
//parm1 is passed in rcx as in Pascal
call qword ptr [rbx+r8] //pointer to c++ virtual table + index
pop rbx
pop rbx
pop rbx
pop rbx
end;
//call c++ virtual function with 2 parameters
//parm1, parm1 - parameters to pass to c++ function
//index - offset in bytes to the appropriate c++ function
// in c++ virtual table
function TCFXBaseClass.callMethod2(parm1, parm2, index: int64): int64;
asm
//Shadow space - at a minimum, each function must reserve
//32 bytes (four 64-bit values) on the stack.
push rbx
push rbx
push rbx
push rbx
//Self assignment
mov rax, Self
mov rbx, [rax]
//parm1 and parm2 are passed to c++ exectly as in Pascal in x64
call qword ptr [rbx+r9] //pointer to c++ virtual table + index
pop rbx
pop rbx
pop rbx
pop rbx
end;
//call c++ virtual function with 3 parameters
//parm1, parm2, parm3 - parameters to pass to c++ function
//index - offset in bytes to the appropriate c++ function
// in c++ virtual table
function TCFXBaseClass.callMethod3(parm1, parm2, parm3, index: int64): int64;
asm
//Shadow space - at a minimum, each function must reserve
//32 bytes (four 64-bit values) on the stack.
push rbx
push rbx
push rbx
push rbx
//Self assignment
mov rax, Self
mov rbx, [rax]
mov rax, index
//parm1, parm2 and parm3 are passed to c++ exectly as in Pascal in x64
call qword ptr [rbx+rax] //pointer to c++ virtual table + index
pop rbx
pop rbx
pop rbx
pop rbx
end;
//=========================================================
// TCFXRequest class
//=========================================================
function TCFXRequest.AttributeExists(AttrName: PAnsiChar): boolean;
begin
Result:=boolean(callMethod1(int64(AttrName), 8));
end;
function TCFXRequest.GetAttribute(AttrName: PAnsiChar): PAnsiChar;
var
returnedString : PAnsiChar;
begin
returnedString := PAnsiChar(callMethod1(int64(AttrName), 16));
Result:=returnedString;//PAnsiChar();
end;
function TCFXRequest.GetAttributeList: TCFXStringSet;
begin
Result:=TCFXStringSet(callMethod0(24));
end;
function TCFXRequest.GetQuery: TCFXQuery;
begin
Result:=TCFXQuery(callMethod0(32));
end;
function TCFXRequest.GetSetting(SettingName: PAnsiChar): PAnsiChar;
begin
Result:=PAnsiChar(TCFXQuery(callMethod1(int64(SettingName), 40)));
end;
procedure TCFXRequest.Write(S: PAnsiChar);
begin
callMethod1(int64(S), 48);
end;
procedure TCFXRequest.SetVariable(Name: PAnsiChar; Value: PAnsiChar);
begin
callMethod2(int64(Name), int64(Value), 56);
end;
function TCFXRequest.AddQuery(Name: PAnsiChar; Columns: TCFXStringSet): TCFXQuery;
begin
Result:=TCFXQuery(callMethod2(int64(Name), int64(Columns), 64));
end;
function TCFXRequest.Debug: boolean;
begin
Result:=boolean(callMethod0(72));
end;
procedure TCFXRequest.WriteDebug(Output: PAnsiChar);
begin
callMethod1(int64(Output), 80);
end;
function TCFXRequest.CreateStringSet: TCFXStringSet;
begin
Result:=TCFXStringSet(callMethod0(88));
end;
procedure TCFXRequest.ThrowException(Error, Diagnostics: PAnsiChar);
begin
callMethod2(int64(Error), int64(Diagnostics), 96);
end;
procedure TCFXRequest.ReThrowException(e: TCFXException);
begin
callMethod1(int64(e), 104);
end;
procedure TCFXRequest.SetCustomData(Data: pointer);
begin
callMethod1(int64(Data), 112);
end;
function TCFXRequest.GetCustomData: pointer;
begin
Result:=Pointer(callMethod0(120));
end;
//=========================================================
// TCFXStringSet class
//=========================================================
function TCFXStringSet.AddString(S: PAnsiChar):integer;
begin
Result:=callMethod1(int64(S), 8);
end;
function TCFXStringSet.GetCount: integer;
begin
Result:=callMethod0(16);
end;
function TCFXStringSet.GetString(Index: integer): PAnsiChar;
begin
Result:=PAnsiChar(callMethod1(Index, 24));
end;
function TCFXStringSet.GetIndexForString(S: PAnsiChar): integer;
begin
Result:=callMethod1(int64(S), 32);
end;
//=========================================================
// TCFXQuery class
//=========================================================
function TCFXQuery.GetName: PAnsiChar;
begin
Result:=PAnsiChar(callMethod0(8));
end;
function TCFXQuery.GetRowCount: integer;
begin
Result:=callMethod0(16);
end;
function TCFXQuery.GetColumns: TCFXStringSet;
begin
Result:=TCFXStringSet(callMethod0(24));
end;
function TCFXQuery.GetData(Row, Column: integer): PAnsiChar;
begin
Result:=PAnsiChar(callMethod2(Row, Column, 32));
end;
function TCFXQuery.AddRow: integer;
begin
Result:=callMethod0(40);
end;
procedure TCFXQuery.SetData(Row, Column: integer; Data: PAnsiChar);
begin
callMethod3(Row, Column, int64(Data), 48);
end;
//=========================================================
// TCFXException class
//=========================================================
function TCFXException.GetError: PAnsiChar;
begin
Result:=PAnsiChar(callMethod0(8));
end;
function TCFXException.GetDiagnostics: PAnsiChar;
begin
Result:=PAnsiChar(callMethod0(16));
end;
end.
7
Replies
AdChoices