ClientMainUnit.dfm
ClientMainUnit.pas
Datasnap.DSCommon.pas
DataSnapClientDemo.dpr
DataSnapClientDemo.dproj
DataSnapClientDemo.dproj.local
DataSnapClientDemo.identcache
DataSnapClientDemo.res
DataSnapClientDemo_Icon.ico
DataSnapDemoGroup.groupproj
DataSnapDemoGroup.groupproj.local
DataSnapSrvDemo.dpr
DataSnapSrvDemo.dproj
DataSnapSrvDemo.dproj.local
DataSnapSrvDemo.identcache
DataSnapSrvDemo.res
DataSnapSrvDemo_Icon.ico
ExecuteMoreClients.dpr
ExecuteMoreClients.dproj
ExecuteMoreClients.dproj.local
ExecuteMoreClients.identcache
ExecuteMoreClients.res
ExecuteMoreClients_Icon.ico
ServerContainerUnit1.dfm
ServerContainerUnit1.pas
ServerMethodsUnit1.dfm
ServerMethodsUnit1.pas
SrvMainUnit.dfm
SrvMainUnit.pas
SrvMainUnit.vlb
uServerProxy.pas
uTestMainUnit.dfm
uTestMainUnit.pas
unit ClientMainUnit;interfaceuses Winapi.Windows, Winapi.Messages, System.SysUtils,MidasLib, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IPPeerClient,Data.DBXJSON,System.JSON, Datasnap.DSCommon, Data.DB, Data.SqlExpr, Data.DBXDataSnap, Data.DBXCommon;type TClientMainForm = class(TForm) btn_RegCallback: TButton; btn_UnRegCallback: TButton; SQLConnection1: TSQLConnection; DemoChannelManager: TDSClientCallbackChannelManager; btn_ConnSrv: TButton; btn_DisConnSrv: TButton; edt_CallbackCount: TEdit; btn_RegCallback_Dyn: TButton; btn_UnRegCallback_Dyn: TButton; btn_RegSqlConn: TButton; edt_SecondLength: TEdit; Label1: TLabel; edt_SQL: TEdit; Label2: TLabel; btn_UnRegSqlConn: TButton; CheckBox1: TCheckBox; edt_SrvIp: TEdit; Label4: TLabel; Label5: TLabel; Label3: TLabel; edt_SqlConnCount: TEdit; edt_ManagerId: TEdit; Label6: TLabel; edt_CallbackId: TEdit; Label7: TLabel; Label8: TLabel; edt_UserName: TEdit; edt_UserPwd: TEdit; Label9: TLabel; CheckBox2: TCheckBox; GroupBox1: TGroupBox; Memo1: TMemo; btn_Clean: TButton; procedure btn_RegCallbackClick(Sender: TObject); procedure btn_UnRegCallbackClick(Sender: TObject); procedure btn_DisConnSrvClick(Sender: TObject); procedure btn_ConnSrvClick(Sender: TObject); procedure DemoChannelManagerServerConnectionTerminate(Sender: TObject); procedure btn_RegCallback_DynClick(Sender: TObject); procedure btn_UnRegCallback_DynClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SQLConnection1AfterConnect(Sender: TObject); procedure SQLConnection1AfterDisconnect(Sender: TObject); procedure DemoChannelManagerServerConnectionError(Sender: TObject); procedure btn_RegSqlConnClick(Sender: TObject); procedure btn_UnRegSqlConnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btn_CleanClick(Sender: TObject); private { Private declarations } FClientId,FCallbackId:string; FarrCount:Integer; arrSqlConn:array of TSQLConnection; arrChannelManager:array of TDSClientCallbackChannelManager; procedure SetupTask; public { Public declarations } end; TDemoCallback = class(TDBXCallback) public constructor Create; function Execute(const Arg:TJSONValue):TJSONValue;override; end;var ClientMainForm: TClientMainForm;implementationuses uServerProxy;{$R *.dfm}procedure TClientMainForm.btn_RegCallbackClick(Sender: TObject);begin //DemoChannelManager.UnregisterCallback(FCallbackId); SetupTask; DemoChannelManager.RegisterCallback(FCallbackId,TDemoCallback.Create);end;procedure TClientMainForm.btn_UnRegCallbackClick(Sender: TObject);begin DemoChannelManager.UnregisterCallback(FCallbackId);end;procedure TClientMainForm.btn_CleanClick(Sender: TObject);begin Memo1.Clear; Memo1.SetFocus;end;procedure TClientMainForm.btn_ConnSrvClick(Sender: TObject);begin SQLConnection1.Connected := False; SQLConnection1.KeepConnection := CheckBox1.Checked; SQLConnection1.Params.Values['HostName'] := edt_SrvIp.Text; SQLConnection1.Params.Values['User_Name'] := edt_UserName.Text; SQLConnection1.Params.Values['Password'] := edt_UserPwd.Text; SQLConnection1.Connected := True;end;procedure TClientMainForm.btn_DisConnSrvClick(Sender: TObject);begin SQLConnection1.Connected := False;end;procedure TClientMainForm.btn_RegCallback_DynClick(Sender: TObject);var i:integer; se:Cardinal; sManagerId,sCallbackId:string;begin se := GetTickCount; edt_SecondLength.Text := ''; Memo1.Lines.Clear; Application.ProcessMessages; Screen.Cursor := crHourGlass; try FarrCount := StrToIntDef(edt_CallbackCount.Text,1); btn_UnRegCallback_DynClick(Self); SetLength(arrChannelManager,FarrCount); for i := Low(arrChannelManager) to High(arrChannelManager) do begin sCallbackId := Format('%.4d',[i 1]); //IntToStr(GetTickCount());//'XXX-LMM'; sManagerId := '客户端_' sCallbackId; if not Assigned(arrChannelManager[i]) then arrChannelManager[i] := TDSClientCallbackChannelManager.Create(nil) else arrChannelManager[i].UnregisterCallback(sCallbackId); arrChannelManager[i].ChannelName := 'jfglxt'; //可以把应用程序标识存放于此 arrChannelManager[i].ManagerId := sManagerId; arrChannelManager[i].CommunicationProtocol := 'tcp/ip'; arrChannelManager[i].DSHostname := edt_SrvIp.Text; arrChannelManager[i].DSPort := '211'; arrChannelManager[i].UserName := edt_UserName.Text; arrChannelManager[i].Password := edt_UserPwd.Text; arrChannelManager[i].RegisterCallback(sCallbackId,TDemoCallback.Create); edt_CallbackCount.Text := IntToStr(i 1); Application.ProcessMessages; end; finally edt_SecondLength.Text := Format('%fs',[(gettickcount()-se)/1000]); Screen.Cursor := crDefault; end;end;procedure TClientMainForm.btn_UnRegCallback_DynClick(Sender: TObject);var i:integer; sCallbackId:string;begin for i := Low(arrChannelManager) to High(arrChannelManager) do begin sCallbackId := Format('%.4d',[i 1]); //IntToStr(GetTickCount());//'XXX-LMM'; if Assigned(arrChannelManager[i]) then begin arrChannelManager[i].UnregisterCallback(sCallbackId); FreeAndNil(arrChannelManager[i]); end; edt_CallbackCount.Text := IntToStr(i 1); Application.ProcessMessages; end;end;procedure TClientMainForm.btn_RegSqlConnClick(Sender: TObject);var i,iCount:Integer; vobj:TServerMethods1Client; se:Cardinal; sData :string;begin se := GetTickCount; edt_SecondLength.Text := ''; Memo1.Lines.Clear; //SQLConnection1.Close; //SQLConnection1.Open; iCount := StrToIntDef(edt_SqlConnCount.Text,1); btn_UnRegSqlConnClick(Self); //先判断并释之前的动态控件 Application.ProcessMessages; SetLength(arrSqlConn,iCount); for i := Low(arrSqlConn) to High(arrSqlConn) do begin if not Assigned(arrSqlConn[i]) then arrSqlConn[i] := TSQLConnection.Create(nil) else arrSqlConn[i].Connected := False; arrSqlConn[i].Name := Format('arrSqlConn_%.4d',[i 1]); arrSqlConn[i].DriverName := 'DataSnap'; arrSqlConn[i].LoginPrompt := False; //arrSqlConn[i].Params.Assign(SQLConnection1.Params); arrSqlConn[i].Params.Values['DriverUnit']:= 'Data.DBXDataSnap'; arrSqlConn[i].Params.Values['HostName'] := edt_SrvIp.Text; arrSqlConn[i].Params.Values['Port'] := '211'; arrSqlConn[i].Params.Values['CommunicationProtocol'] := 'tcp/ip'; arrSqlConn[i].Params.Values['DatasnapContext'] := 'datasnap/'; arrSqlConn[i].Params.Values['User_Name'] := edt_UserName.Text; arrSqlConn[i].Params.Values['PassWord'] := edt_UserPwd.Text; //arrSqlConn[i].Params.Values['DriverAssemblyLoader'] := 'Borland.Data.TDBXClientDriverLoader,Borland' // '.Data.DbxClientDriver,Version=20.0.0.0,Culture=neutral,PublicKey' // 'Token=91d62ebb5b0d1b1b'; arrSqlConn[i].Params.Values['Filters'] := '{}'; arrSqlConn[i].AfterConnect := SQLConnection1AfterConnect; arrSqlConn[i].AfterDisConnect := SQLConnection1AfterDisConnect; edt_SqlConnCount.Text := IntToStr(i 1); Application.ProcessMessages; end; Memo1.Lines.BeginUpdate; for i := Low(arrSqlConn) to High(arrSqlConn) do begin if not arrSqlConn[i].Connected then arrSqlConn[i].Connected := True; vobj := TServerMethods1Client.Create(arrSqlConn[i].DBXConnection); try try //Memo1.Lines.Text := (IntToStr(i) ':' vobj.OpenData(Edit2.Text)); sData := vobj.OpenData(edt_SQL.Text); edt_SqlConnCount.Text := IntToStr(i 1); Application.ProcessMessages; except on e:Exception do begin arrSqlConn[i].Connected := False; //arrSqlConn[i].Connected := True; ShowMessage('i=' IntToStr(i) '时出错！原因为:' e.Message); Break; end; end; finally if not CheckBox1.Checked then arrSqlConn[i].Connected := False; FreeAndNil(vobj); end; end; if CheckBox2.Checked then Memo1.Lines.Text := sData; Memo1.Lines.EndUpdate; edt_SecondLength.Text := Format('%fs',[(gettickcount()-se)/1000]);end;procedure TClientMainForm.btn_UnRegSqlConnClick(Sender: TObject);var i:integer;begin for i := Low(arrSqlConn) to High(arrSqlConn) do begin if Assigned(arrSqlConn[i]) then FreeAndNil(arrSqlConn[i]); edt_SqlConnCount.Text := IntToStr(i 1); Application.ProcessMessages; end;end;procedure TClientMainForm.DemoChannelManagerServerConnectionError( Sender: TObject);begin Memo1.Lines.Add('ServerConnectionError');end;procedure TClientMainForm.DemoChannelManagerServerConnectionTerminate( Sender: TObject);begin DemoChannelManager.UnregisterCallback(FCallbackId);end;procedure TClientMainForm.FormCreate(Sender: TObject);begin SQLConnection1.Connected := False; SetupTask;end;procedure TClientMainForm.FormDestroy(Sender: TObject);var i:integer;begin DemoChannelManager.UnregisterCallback(FCallbackId); for i := Low(arrChannelManager) to High(arrChannelManager) do begin if Assigned(arrChannelManager[i]) then begin arrChannelManager[i].UnregisterCallback(FCallbackId); FreeAndNil(arrChannelManager[i]); end; end; arrChannelManager := nil; for i := Low(arrSqlConn) to High(arrSqlConn) do begin if Assigned(arrSqlConn[i]) then FreeAndNil(arrSqlConn[i]); end;end;procedure TClientMainForm.SetupTask;begin with SQLConnection1 do begin Params.Clear; with ConnectionData.Properties do begin Values[TDBXPropertyNames.DriverName]:='DataSnap'; Values[TDBXPropertyNames.CommunicationProtocol]:='tcp/ip'; Values[TDBXPropertyNames.HostName]:=edt_SrvIp.Text; Values[TDBXPropertyNames.Port]:='211'; Values[TDBXPropertyNames.BufferKBSize]:='32'; Values[TDBXPropertyNames.DatasnapContext]:='datasnap/'; Values[TDBXPropertyNames.UserName] := edt_UserName.Text; Values[TDBXPropertyNames.Password] := edt_UserPwd.Text; end; LoginPrompt := False; KeepConnection := CheckBox1.Checked; end; FClientId := edt_ManagerId.Text; FCallbackId := edt_CallbackId.Text; DemoChannelManager.ChannelName := 'jfglxt'; DemoChannelManager.DSHostname := edt_SrvIp.Text; DemoChannelManager.ManagerId := FClientId; DemoChannelManager.UserName := edt_UserName.Text; DemoChannelManager.Password := edt_UserPwd.Text;end;procedure TClientMainForm.SQLConnection1AfterConnect(Sender: TObject);var sConnName:string;begin sConnName := TSQLConnection(Sender).Name; Memo1.Lines.Add(FormatDateTime('hh:nn:ss ->',Now) sConnName ' is Contented!');end;procedure TClientMainForm.SQLConnection1AfterDisconnect(Sender: TObject);var sConnName:string;begin sConnName := TSQLConnection(Sender).Name; Memo1.Lines.Add(FormatDateTime('hh:nn:ss ->',Now) sConnName ' is DisContented!');end;{ TDemoCallback }constructor TDemoCallback.Create;begin inherited;end;function TDemoCallback.Execute(const Arg: TJSONValue): TJSONValue;var sDemoMessage:string;begin Result := TJSONValue.Create; if Arg is TJSONString then begin sDemoMessage := TJSONString(Arg).Value; TThread.Synchronize(nil, procedure begin ClientMainForm.Memo1.Lines.Text := sDemoMessage; end ); end;end;end.
评论