unit1.pas

delphi的XMPRPC通讯例子

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,ECardUserXMLRPCUt,
  ECardUtilXMLRPCUt,SystemInfoUt,ConstValueUt;
type
  TCMSCommand = (cmdToken,cmdTokenResponse,cmdQuit,cmdQuitResponse,cmdShutDown,cmdShutDownResponse,
                 cmdMessage,cmdMessageResponse,cmdStream,cmdStreamResponse,cmdGetBalance,cmdGetBalanceResponse,
                 cmdSetConfig,cmdSetConfigResponse,cmdInfo,cmdInfoResponse,cmdRunMode,cmdRunModeResponse
                );
type
  TCMSTP = Packed Record
  C_IP:string;
  Case Command: TCMSCommand of
      cmdToken:
        (
          tSID: string[64]; //令牌号
          tUID: string[32]; //用户UID号
          tMAC: string[20]; //计算机MAC地址

        );

       cmdTokenResponse:
       (
          tResult: integer; //登录返回值
          tMsg:String[100]; //登录返回信息
        );

       cmdQuit:
       (
          qUID: string[32];
       );

       cmdQuitResponse:
       (
          qMsg: string[100];//退出返回信息
          qResult: integer;//退出返回值
       );

       cmdShutDownResponse:
       (
          sMsg: string[100];//关机返回信息
          sResult:integer;  //关机返回值
        );

      cmdMessage:
      (
          mUID: string[32];//用户UID号
          mMsg: string[250];//用户发送信息
       );

      cmdMessageResponse:
      (
          mrMsg: string[250];//服务器发送信息
       );

       cmdStream:
       (
          srMode:integer;  //模式 0-抓取屏幕 1-接收文件
          srPath:string[255];//保存路径
          srStreamLen: Int64;//流长度
        );

      cmdStreamResponse:
      (
          srpMode:integer;  //模式 0-接收屏幕捕获 1-接收文件
          srpUID:string[32]; //用户UID
          srpPath:string[255];//保存路径
          SrptreamLen: Int64;//流长度
       );

      cmdGetBalance:
      (
          gUID: string[32];//用户UID
       );

       cmdGetBalanceResponse:
       (
         gMsg: string[100];//余额返回信息
         gResult:integer;  //余额返回值
         gCharge:double;   //返回余额
        );

        cmdSetConfigResponse:
        (
          scServerPort: integer;//服务器通讯端口
          scLocalPort: integer; //客户端通讯端口
          scEcardAddr: string[100];//一卡通验证服务器
          scHomeAddr: string[100];//设定主页地址
          scElibAddr: string[100];//设定数字化资源地址
          scFilePath: string[255];//保存文件路径
         );

        cmdInfo:
        (
          iMACAddr: string[20];//MAC地址
          iHostName: string[50];//主机名
         );

        cmdRunModeResponse:
        (
          rRunMode: integer;//运行模式0-正常 1-免证 2-解除锁定 3-重新锁定
        );


end;

type
  TTestThread = class(TThread)   { 声明线程类 }
private
  tt_num :integer;
  tt_test:string;
  procedure showMemo;
protected
procedure Execute; override;{ 执行线程的方法 }
public
end;
type
  TfrmTCPClinet = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    Edit3: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
 
  private
    suscun,falsun,faisun,ppack:integer;

    treadcun:integer;
    { Private declarations }
  public
    test:array  of TTestThread ;

    { Public declarations }
  end;

var
  frmTCPClinet: TfrmTCPClinet;

implementation

{$R *.dfm}



procedure TfrmTCPClinet.Button1Click(Sender: TObject);
var
i:integer;

begin
    ppack:=100;
    suscun:=0;
    falsun:=0;
    faisun:=0;
    treadcun:=strtoint(Edit3.Text);
    setlength(test,treadcun);

    SIU_RD_SystemServerConfig.UserServerURL:=Edit1.Text;
    SIU_RD_SystemServerConfig.UtilServerURL:=Edit1.Text;
    for i:=0 to treadcun-1 do
    begin

      test[i]:=TTestThread.Create(false);
      test[i].tt_num:=i;

      test[i].FreeOnTerminate := True;
    end;

end;

procedure TTestThread.Execute;
var
ttdiv:integer;
eux:TECardUtilXMLRPC;
cux:TECardUserXMLRPC;
rc:array[0..1] of string;
ttstr,ttsid:string;
resFlag:Boolean;
begin

while not Terminated do
 begin
  try
   ttdiv:= frmTCPClinet.ppack mod 3;
   resFlag:=false;
   if ttdiv=0 then
    begin
     eux:=TECardUtilXMLRPC.Create;
     eux.ECUT_Init;
     resFlag:=eux.ECUT_GetSysDict(CT_SVR_DICT[(frmTCPClinet.ppack mod 11 )],rc);
     self.tt_test:=inttostr(self.tt_num)+rc[1];
     eux.Free;
    end;

   if ttdiv=1 then
    begin
     eux:=TECardUtilXMLRPC.Create;
     eux.ECUT_Init;
     resFlag:=eux.ECUT_GetSysTime(ttstr,rc);
     self.tt_test:=inttostr(self.tt_num)+rc[1];
     eux.Free;
    end;

   if ttdiv=2 then
    begin
     cux:=TECardUserXMLRPC.Create;
     cux.ECU_Init;
     rc[0]:='2';
     rc[1]:='2';
     resFlag:=cux.ECT_Login('admin','123@admin',rc);
     self.tt_test:=inttostr(self.tt_num)+rc[1];
     cux.Free;
    end;
    if resFlag= false  then
    frmTCPClinet.falsun:=frmTCPClinet.falsun+1
    else
    begin

     if  rc[0]='0' then
        frmTCPClinet.suscun:=frmTCPClinet.suscun+1
     else
       frmTCPClinet.faisun:=frmTCPClinet.faisun+1;
    end;

  except
  frmTCPClinet.falsun:=frmTCPClinet.falsun+1;
  self.tt_test:=inttostr(self.tt_num)+':发送失败';
  end;
  Synchronize(self.showMemo);
 end;


end;


procedure TTestThread.showMemo;
begin
  frmTCPClinet.ppack:= frmTCPClinet.ppack+1;
  frmTCPClinet.memo1.Lines.Add(self.tt_test);
  frmTCPClinet.Label1.Caption:='成功：'+inttostr(frmTCPClinet.suscun);
  frmTCPClinet.Label2.Caption:='失败：'+inttostr(frmTCPClinet.falsun);
  frmTCPClinet.Label3.Caption:='错误：'+inttostr(frmTCPClinet.faisun);
  frmTCPClinet.Label3.Repaint;
  frmTCPClinet.Label2.Repaint;
   frmTCPClinet.Label1.Repaint;
end;

procedure TfrmTCPClinet.Button3Click(Sender: TObject);
begin
  close;
end;

procedure TfrmTCPClinet.Button2Click(Sender: TObject);
var
i:integer;
begin
    for i:=0 to treadcun-1 do
    begin

      test[i].Terminate;

    end;
end;


end.