delphi 开发手机客户端连接PC服务器端进行数据查询服务

【实例简介】

     delphi 开发手机客户端连接PC服务器端进行数据查询服务

【实例截图】

【核心代码】

PC服务器端代码

unit Unit1;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, IniFiles,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
  Data.Win.ADODB, Datasnap.Provider, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ServerContainerUnit1, ServerMethodsUnit1;

procedure TForm1.Button1Click(Sender: TObject);
begin
  sTopNumber:= Edit1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
begin
  IniFile:= TIniFile.Create(ExtractFilePath(ParamStr(0)) 'MyServer.ini');
  try
    strConnStr:= IniFile.ReadString('SYSTEM', 'DBConnStr', '');
  finally
    FreeAndNil(IniFile);
  end;
  if strErr <> '' then
    Edit1.Text:= strErr;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  case DBFlag of
    1:
       MessageBox(Handle, PChar('数据源连接失败-conn！错误信息：' #13#10 strErr),
         PChar('错误'), MB_IconError MB_OK);
    2:
       MessageBox(Handle, PChar('数据源连接失败-table！错误信息：' #13#10 strErr),
         PChar('错误'), MB_IconError MB_OK);
    3:
       MessageBox(Handle, PChar('数据源连接成功!' #13#10 strErr),
         PChar('成功'), MB_IconInformation MB_OK);
  end;
end;

end.



unit ServerMethodsUnit1;

interface

uses System.SysUtils, System.Classes, System.Json, Variants,
    Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter,
  Data.DB, Data.Win.ADODB, Datasnap.Provider, Datasnap.DBClient;

type
  TServerMethods1 = class(TDSServerModule)
    DataSetProvider1: TDataSetProvider;
    Conn: TADOConnection;
    ADOQuery1: TADOQuery;
    ClientDataSet1: TClientDataSet;
    procedure DSServerModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
    //获取数据，参数为sql语句
    function MyGetData(const strSQL: string): OleVariant;
  end;

var
  DBFlag: integer;
  strErr: String = '';
  sTopNumber: string = '10';
  strConnStr: string = '';

implementation


{$R *.dfm}


uses System.StrUtils, Unit1;

procedure TServerMethods1.DSServerModuleCreate(Sender: TObject);
begin
  strErr:= 'OK!';
  Conn.Close;
  Conn.ConnectionString:= strConnStr;
  try
    Conn.Connected:= True;
    strErr:= '22222222222222';
  except
    on e: Exception do
    begin
      //MessageBox(Handle, PChar('数据源连接失败！错误信息：' #13#10 e.Message), PChar('错误'), MB_IconError MB_OK);
      DBFlag:= 1;
      strErr:= e.Message;
      Form1.Edit1.Text:= strErr;
      Exit;
    end;
  end;
  try
    ADOQuery1.Close;
    ADOQuery1.SQL.Text:= 'select top ' sTopNumber ' * from CALL_RECORD';
    ADOQuery1.Open;
    strErr:= '11111111111111';
  except
    on e: Exception do
    begin
      //MessageBox(Handle, PChar('数据源连接失败！错误信息：' #13#10 e.Message), PChar('错误'), MB_IconError MB_OK);
      DBFlag:= 2;
      strErr:= e.Message;
      Form1.Edit1.Text:= strErr;
      Exit;
    end;
  end;
  Form1.Edit1.Text:= strErr;
  DBFlag:= 3;
end;

function TServerMethods1.EchoString(Value: string): string;
begin
  Result := Value;
end;

function TServerMethods1.MyGetData(const strSQL: string): OleVariant;
begin
  ClientDataSet1.Close;
  try
    ADOQuery1.Close;
    ADOQuery1.SQL.Text:= strSQL;
    ADOQuery1.Open;
    ClientDataSet1.Open;
  except
    on e: exception do
    begin
      Result:= Unassigned;
      strErr:= 'MyGetData error 1';
      Form1.Edit1.Text:= strErr;
      Exit;
    end;
  end;
  strErr:= 'MyGetData OK 1';
  Form1.Edit1.Text:= strErr;
  Result:= ClientDataSet1.Data;
end;

function TServerMethods1.ReverseString(Value: string): string;
begin
  Result := System.StrUtils.ReverseString(Value);
end;

end.


unit ServerContainerUnit1;

interface

uses System.SysUtils, System.Classes,
  Datasnap.DSTCPServerTransport,
  Datasnap.DSServer, Datasnap.DSCommonServer,
  Datasnap.DSAuth, IPPeerServer, Data.DB, Data.Win.ADODB, Datasnap.Provider;

type
  TServerContainer1 = class(TDataModule)
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass1: TDSServerClass;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
  private
    { Private declarations }
  public
  end;

var
  ServerContainer1: TServerContainer1;
  DBFlag: Boolean;
  strErr: String;

implementation


{$R *.dfm}

uses Winapi.Windows, ServerMethodsUnit1;

procedure TServerContainer1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;


end.


手机客户端代码
unit UnMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Edit, System.Rtti, FMX.Layouts, FMX.Grid,
  Data.Bind.EngExt, Fmx.Bind.DBEngExt, Fmx.Bind.Grid, System.Bindings.Outputs,
  Fmx.Bind.Editors, Data.Bind.Components, Data.Bind.Grid, Data.Bind.DBScope,
  Data.DBXDataSnap, IPPeerClient, Data.DBXCommon, Data.DB, Datasnap.DBClient,
  Datasnap.DSConnect, Data.SqlExpr, FMX.Grid.Style, FMX.ScrollBox;

type
  TForm2 = class(TForm)
    edtIP: TEdit;
    edtPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    BindSourceDB1: TBindSourceDB;
    BindingsList1: TBindingsList;
    BindingsList2: TBindingsList;
    Grid1: TGrid;
    CheckBox1: TCheckBox;
    Button2: TButton;
    BindSourceDB2: TBindSourceDB;
    LinkGridToDataSourceBindSourceDB1: TLinkGridToDataSource;
    Label3: TLabel;
    edtTableName: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.SmXhdpiPh.fmx ANDROID}
{$R *.NmXhdpiPh.fmx ANDROID}

uses UnDM, Unit2;

procedure TForm2.Button1Click(Sender: TObject);
var
   dm : TServerMethods1Client;
begin
  try
    //连接指定IP和Port的应用服务器
    dmMain.SQLConn.Close;
    dmMain.SQLConn.Params.Values['HostName'] := edtIP.Text;
    dmMain.SQLConn.Params.Values['Port'] := edtPort.Text;
    try
      dmMain.SQLConn.Open;
      try
        //创建应用服务器上的Sample Methods在客户端的实现类
        dm := TServerMethods1Client.Create(dmMain.SQLConn.DBXConnection);
        //执行服务器上的方法
        if CheckBox1.IsChecked then
          ShowMessage(dm.ReverseString(edtIP.Text));
      finally
        dm.Free;
      end;

      //开启客户端数据集
      dmMain.cdsDataSet.Close;
//      dmMain.cdsDataSet.CommandText:= 'select * from OrderPrefix_Tab';
      dmMain.cdsDataSet.Open;
    except
      on E: Exception do
        ShowMessage(E.Message);
    end;
  finally
    dmMain.SQLConn.Close;
  end;
end;

procedure TForm2.Button2Click(Sender: TObject);
var
   dm : TServerMethods1Client;
   tmpOleVar: OleVariant;
begin
  dmMain.cdsDataSet.Close;
  try
    //连接指定IP和Port的应用服务器
    dmMain.SQLConn.Close;
    dmMain.SQLConn.Params.Values['HostName'] := edtIP.Text;
    dmMain.SQLConn.Params.Values['Port'] := edtPort.Text;
    try
      dmMain.SQLConn.Open;
      try
        //创建应用服务器上的Sample Methods在客户端的实现类
        dm := TServerMethods1Client.Create(dmMain.SQLConn.DBXConnection);
        //执行服务器上的方法
        tmpOleVar:= dm.MyGetData('select * from ' edtTableName.Text);
      finally
        dm.Free;
      end;
      if VarIsEmpty(tmpOleVar) then
      begin
        ShowMessage('查询结果为空！');
        Exit;
      end;
      dmMain.cdsDataSet.Data:= tmpOleVar;
    except
      on E: Exception do
        ShowMessage(E.Message);
    end;
  finally
    dmMain.SQLConn.Close;
  end;
end;

end.


unit Unit2;

interface

uses System.JSON, Data.DBXCommon, Data.DBXClient, Data.DBXDataSnap, Data.DBXJSON, Datasnap.DSProxy, System.Classes, System.SysUtils, Data.DB, Data.SqlExpr, Data.DBXDBReaders, Data.DBXCDSReaders, Data.DBXJSONReflect;

type
  TServerMethods1Client = class(TDSAdminClient)
  private
    FDSServerModuleCreateCommand: TDBXCommand;
    FEchoStringCommand: TDBXCommand;
    FReverseStringCommand: TDBXCommand;
    FMyGetDataCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    procedure DSServerModuleCreate(Sender: TObject);
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
    function MyGetData(strSQL: string): OleVariant;
  end;

implementation

procedure TServerMethods1Client.DSServerModuleCreate(Sender: TObject);
begin
  if FDSServerModuleCreateCommand = nil then
  begin
    FDSServerModuleCreateCommand := FDBXConnection.CreateCommand;
    FDSServerModuleCreateCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FDSServerModuleCreateCommand.Text := 'TServerMethods1.DSServerModuleCreate';
    FDSServerModuleCreateCommand.Prepare;
  end;
  if not Assigned(Sender) then
    FDSServerModuleCreateCommand.Parameters[0].Value.SetNull
  else
  begin
    FMarshal := TDBXClientCommand(FDSServerModuleCreateCommand.Parameters[0].ConnectionHandler).GetJSONMarshaler;
    try
      FDSServerModuleCreateCommand.Parameters[0].Value.SetJSONValue(FMarshal.Marshal(Sender), True);
      if FInstanceOwner then
        Sender.Free
    finally
      FreeAndNil(FMarshal)
    end
    end;
  FDSServerModuleCreateCommand.ExecuteUpdate;
end;

function TServerMethods1Client.EchoString(Value: string): string;
begin
  if FEchoStringCommand = nil then
  begin
    FEchoStringCommand := FDBXConnection.CreateCommand;
    FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FEchoStringCommand.Text := 'TServerMethods1.EchoString';
    FEchoStringCommand.Prepare;
  end;
  FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
  FEchoStringCommand.ExecuteUpdate;
  Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;

function TServerMethods1Client.ReverseString(Value: string): string;
begin
  if FReverseStringCommand = nil then
  begin
    FReverseStringCommand := FDBXConnection.CreateCommand;
    FReverseStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FReverseStringCommand.Text := 'TServerMethods1.ReverseString';
    FReverseStringCommand.Prepare;
  end;
  FReverseStringCommand.Parameters[0].Value.SetWideString(Value);
  FReverseStringCommand.ExecuteUpdate;
  Result := FReverseStringCommand.Parameters[1].Value.GetWideString;
end;

function TServerMethods1Client.MyGetData(strSQL: string): OleVariant;
begin
  if FMyGetDataCommand = nil then
  begin
    FMyGetDataCommand := FDBXConnection.CreateCommand;
    FMyGetDataCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FMyGetDataCommand.Text := 'TServerMethods1.MyGetData';
    FMyGetDataCommand.Prepare;
  end;
  FMyGetDataCommand.Parameters[0].Value.SetWideString(strSQL);
  FMyGetDataCommand.ExecuteUpdate;
  Result := FMyGetDataCommand.Parameters[1].Value.AsVariant;
end;


constructor TServerMethods1Client.Create(ADBXConnection: TDBXConnection);
begin
  inherited Create(ADBXConnection);
end;


constructor TServerMethods1Client.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
  inherited Create(ADBXConnection, AInstanceOwner);
end;


destructor TServerMethods1Client.Destroy;
begin
  FDSServerModuleCreateCommand.DisposeOf;
  FEchoStringCommand.DisposeOf;
  FReverseStringCommand.DisposeOf;
  FMyGetDataCommand.DisposeOf;
  inherited;
end;

end.

技术交流：QQ 58570143