实例介绍
【实例简介】
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
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论