datasnap（数据快照）

Delphi数据库编程

下载此实例

开发语言：Pascal
实例大小：0.05M
下载次数：19
浏览次数：215
发布时间：2019-07-30
实例类别：Delphi数据库编程
发布人：guobaoguo
文件格式：.rar
所需积分：2

实例介绍

【实例简介】

【实例截图】

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;

interface

uses
  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;

implementation
uses 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.

标签： delphi

实例下载地址