收录日期:2020/10/27 23:02:46 时间:2016/05/12 05:44:43 标签:基础类
================================
.pas文件
================================
{$R-,Q-,X+,W-,D-,L-,Y-}

unit cfxapid;

interface

const
  CFX_STRING_NOT_FOUND = -1;

  type
  // Basic wrapper class, translates Pascal methods calls to C++ methods calls
  TCFXBaseClass = class
    private
    function callMethod0(index: integer): integer;
    function callMethod1(parm1, index: integer): integer;
    function callMethod2(parm1, parm2, index: integer): integer;
    function callMethod3(parm1, parm2, parm3, index: integer): integer;
  end;

  TCFXStringSet = class(TCFXBaseClass)
    function AddString(S: PChar):integer;
    function GetCount: integer;
    function GetString(Index: integer): PChar;
    function GetIndexForString(S: PChar): integer;
  end;

  TCFXQuery = class(TCFXBaseClass)
    function GetName: PChar;
    function GetRowCount: integer;
    function GetColumns: TCFXStringSet;
    function GetData(Row, Column: integer): PChar;
    function AddRow: integer;
    procedure SetData(Row, Column: integer; Data: PChar);
  end;

  TCFXException = class(TCFXBaseClass)
    function GetError: PChar;
    function GetDiagnostics: PChar;
  end;

  TCFXRequest = class(TCFXBaseClass)
    function AttributeExists(AttrName: PChar): boolean;
    function GetAttribute(AttrName: PChar): PChar;
    function GetAttributeList: TCFXStringSet;
    function GetQuery: TCFXQuery;
    function GetSetting(SettingName: PChar): PChar;
    procedure Write(S: PChar);
    procedure SetVariable(Name: PChar; Value: PChar);
    function AddQuery(Name: PChar; Columns: TCFXStringSet): TCFXQuery;
    function Debug: boolean;
    procedure WriteDebug(Output: PChar);
    function CreateStringSet: TCFXStringSet;
    procedure ThrowException(Error, Diagnostics: PChar);
    procedure ReThrowException(e: TCFXException);
    procedure SetCustomData(Data: pointer);
    function GetCustomData: pointer;
  end;

implementation

//=========================================================
// TCFXBaseClass class
//=========================================================
  function TCFXBaseClass.callMethod0(index: integer): integer;
  asm
    push ebx
    mov ebx, index

    mov eax, Self
    mov ecx, eax
    mov edx, [eax]

    call dword ptr [edx+ebx]
    pop ebx
  end;

  function TCFXBaseClass.callMethod1(parm1: integer; index: integer): integer;
  asm
    push ebx
    mov ebx, index
    push parm1
    mov eax, Self
    mov ecx, eax
    mov edx, [eax]
    call dword ptr [edx+ebx]
    pop ebx

  end;

  function TCFXBaseClass.callMethod2(parm1, parm2, index: integer): integer;
  asm
    push ebx
    push parm2
    push parm1
    mov ebx, index

    mov eax, Self
    mov ecx, eax
    mov edx, [eax]

    call DWORD PTR [edx+ebx]
    pop ebx
  end;


  function TCFXBaseClass.callMethod3(parm1, parm2, parm3, index: integer): integer;
  asm
    push ebx
    push parm3
    push parm2
    push parm1
    mov ebx, index

    mov eax, Self
    mov ecx, eax
    mov edx, [eax]

    call DWORD PTR [edx+ebx]
    pop ebx
  end;

//=========================================================
//  TCFXRequest class
//=========================================================
  function TCFXRequest.AttributeExists(AttrName: PChar): boolean;
  begin
    Result:=boolean(callMethod1(integer(AttrName), 4));
  end;

  function TCFXRequest.GetAttribute(AttrName: PChar): PChar;
  begin
    Result:=PChar(callMethod1(integer(AttrName), 8));
  end;

  function TCFXRequest.GetAttributeList: TCFXStringSet;
  begin
    Result:=TCFXStringSet(callMethod0(12));
  end;

  function TCFXRequest.GetQuery: TCFXQuery;
  begin
    Result:=TCFXQuery(callMethod0(16));
  end;

  function TCFXRequest.GetSetting(SettingName: PChar): PChar;
  begin
    Result:=PChar(TCFXQuery(callMethod1(integer(SettingName), 20)));
  end;

  procedure TCFXRequest.Write(S: PChar);
  begin
    callMethod1(integer(S), 24);
  end;

  procedure TCFXRequest.SetVariable(Name: PChar; Value: PChar);
  begin
    callMethod2(integer(Name), integer(Value), 28);
  end;

  function TCFXRequest.AddQuery(Name: PChar; Columns: TCFXStringSet): TCFXQuery;
  begin
    Result:=TCFXQuery(callMethod2(integer(Name), integer(Columns), 32));
  end;

  function TCFXRequest.Debug: boolean;
  begin
    Result:=boolean(callMethod0(36));
  end;

  procedure TCFXRequest.WriteDebug(Output: PChar);
  begin
    callMethod1(integer(Output), 40);
  end;

  function TCFXRequest.CreateStringSet: TCFXStringSet;
  begin
    Result:=TCFXStringSet(callMethod0(44));
  end;

  procedure TCFXRequest.ThrowException(Error, Diagnostics: PChar);
  begin
    callMethod2(integer(Error), integer(Diagnostics), 48);
  end;

  procedure TCFXRequest.ReThrowException(e: TCFXException);
  begin
    callMethod1(integer(e), 52);
  end;

  procedure TCFXRequest.SetCustomData(Data: pointer);
  begin
    callMethod1(integer(Data), 56);
  end;

  function TCFXRequest.GetCustomData: pointer;
  begin
    Result:=Pointer(callMethod0(60));
  end;

//=========================================================
//  TCFXStringSet class
//=========================================================
  function TCFXStringSet.AddString(S: PChar):integer;
  begin
    Result:=callMethod1(integer(S), 4);
  end;

  function TCFXStringSet.GetCount: integer;
  begin
    Result:=callMethod0(8);
  end;

  function TCFXStringSet.GetString(Index: integer): PChar;
  begin
    Result:=PChar(callMethod1(Index, 12));
  end;

  function TCFXStringSet.GetIndexForString(S: PChar): integer;
  begin
    Result:=callMethod1(integer(S), 16);
  end;

//=========================================================
//  TCFXQuery class
//=========================================================
  function TCFXQuery.GetName: PChar;
  begin
    Result:=PChar(callMethod0(4));
  end;

  function TCFXQuery.GetRowCount: integer;
  begin
    Result:=callMethod0(8);
  end;

  function TCFXQuery.GetColumns: TCFXStringSet;
  begin
   Result:=TCFXStringSet(callMethod0(12));
  end;

  function TCFXQuery.GetData(Row, Column: integer): PChar;
  begin
    Result:=PChar(callMethod2(Row, Column, 16));
  end;

  function TCFXQuery.AddRow: integer;
  begin
   Result:=callMethod0(20);
  end;

  procedure TCFXQuery.SetData(Row, Column: integer; Data: PChar);
  begin
   callMethod3(Row, Column, integer(Data), 24);
  end;

//=========================================================
//  TCFXException class
//=========================================================
  function TCFXException.GetError: PChar;
  begin
   Result:=PChar(callMethod0(4));
  end;

  function TCFXException.GetDiagnostics: PChar;
  begin
   Result:=PChar(callMethod0(8));
  end;


end.

==========================
工程文件
==========================
// "Hello World" simple Delphi custom tag
library cfxd_hello;


uses SysUtils, CFXAPID;
//==========================================================

procedure ProcessTagRequest(Request: TCFXRequest); export; cdecl;
const HelloStr: PChar = '<P>Hello World from Delphi CFX tag !';
begin
  try
      Request.Write(HelloStr);

  except
    on Ex: Exception do
      Request.ThrowException('Exception occured while processing tag',
       PChar('<b>Exception class:</b> ' + Ex.ClassName + '<br>' +
             '<b>Exception message:</b> ' + Ex.Message));
  end;

end; //ProcessTagRequest



exports ProcessTagRequest;

begin
end.
就几个方法的调用嘛
有必要转换吗?BCB直接可以编译.pas源程序呀。在项目里直接加上这个文件不行吗?
BCB可以直接调用delphi的程序的。。
你看看帮助。
太长了。。。

奇怪的现象:用了验证控件后按钮失效! 有些人其实就爱闹事 请问怎样将confirm中的中文变成英文? 一个存储过程出错 [求助][急件]如何删除文件里面的数据? 文件问题。。不知道什么错误。。 问大虾,input数据被截断 XmlHttp 是在客户机上工作,还是在服务器上工作??? 我在C++ Builder用#import语句导入DLL库时,为什么出现这样的错误? vc+soap toolkit 调用web service的问题(请大家帮忙) 谁有EMS SQL Manager2005的注册码?100 如何禁用网页对话框的关闭按钮,大家帮帮忙啊!!! asp中如何过滤转换英文的双引号 水晶报表问题 求一SQL获取表中,上下行某一字段的差值 ActionListener 使用中的问题, 当HTML的INPUT的type为password时,怎么能让付给他的值表示出来? MDI窗体变量传递,新手请教! ________用户控件不能完全显示的奇怪问题! 谢谢前辈们! 象这些复杂说明作何解释较好? 用asp删除一个sql数据库表的问题。 windows xp 不能安装!求高手赐教 请问怎么使文字环绕图片? 关于mysql数据同步 关于DispatchMessage的问题 求条型码 请问如何在GUI程序中加如图片呢?用点击按钮后,就在面版显示一张图片,具体应该怎么做? 请问怎样设置开发servlet? 如何构建一个BBS论坛 郁闷死,手里有VS2005加SQL2005正式版,而且是正版就是装不了,帮帮忙啊