|
1、使用TLazDBAccessor访问远程数据库
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, ComCtrls, LazConnection, LazAccessor, LazRpc, memds, db, LazParcel,
LazFileTransfer, LazFiles, LazMemTable;
type
//{ TForm1 }
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Button13: TButton;
Button14: TButton;
Button15: TButton;
Button16: TButton;
Button17: TButton;
Button18: TButton;
Button19: TButton;
Button2: TButton;
Button20: TButton;
Button21: TButton;
Button22: TButton;
Button23: TButton;
Button24: TButton;
Button25: TButton;
Button26: TButton;
Button27: TButton;
Button28: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
dba: TLazAccessor;
ImageList1: TImageList;
LazConn: TLazConnection;
MTab: TLazMemTable;
ListView1: TListView;
Memo1: TMemo;
Panel1: TPanel;
Panel2: TPanel;
ProgressBar1: TProgressBar;
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure Button15Click(Sender: TObject);
procedure Button16Click(Sender: TObject);
procedure Button17Click(Sender: TObject);
procedure Button18Click(Sender: TObject);
procedure Button19Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button20Click(Sender: TObject);
procedure Button21Click(Sender: TObject);
procedure Button22Click(Sender: TObject);
procedure Button23Click(Sender: TObject);
procedure Button24Click(Sender: TObject);
procedure Button25Click(Sender: TObject);
procedure Button26Click(Sender: TObject);
procedure Button27Click(Sender: TObject);
procedure Button28Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure dbaDatasetFetchProgress(Sender: TObject; AllPages: integer;
CurrentPage: integer);
procedure dbaPagingHeartbeat(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LazConnSessionHeartbeat(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
newid: string;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
//
// 退出...
procedure TForm1.Button5Click(Sender: TObject);
begin
application.Terminate;
end;
//
// 执行批量命令...
procedure TForm1.Button6Click(Sender: TObject);
var
batchsql: TStringList;
begin
BatchSql:=TStringList.Create;
BatchSql.Add('delete from customers where customerid=''''');
BatchSql.Add('delete from customers where customerid=''GREAL''');
memo1.Lines.add('');
if dba.ExecuteBatchSql(BatchSql) then
memo1.lines.add('执行批量SQL命令成功!')
else
memo1.lines.add('执行批量SQL命令失败!错误信息:'+dba.LastError);
Batchsql.Free;
end;
//
// 调用无返回数据集的存储过程...
procedure TForm1.Button7Click(Sender: TObject);
var
ParamParcel: TLazParcel;
stream: TMemoryStream;
begin
ParamParcel:=TLazParcel.create;
Stream:=TMemoryStream.Create;
ParamParcel.PutStringGoods('@seal_id','fucku111');
ParamParcel.PutStreamGoods('@carve_info',Stream);
ParamParcel.PutDateTimeGoods('@carve_date',now);
ParamParcel.PutDateTimeGoods('@receive_time',now);
memo1.Lines.add('');
if dba.ExecuteStoredProc('MakeMoulageUp',ParamParcel) then
memo1.lines.add('调用存储过程成功!')
else
memo1.lines.add('调用存储过程失败!错误信息:'+dba.LastError);
ParamParcel.Free;
Stream.free;
end;
//
// 运行带返回数据集的存储过程...
procedure TForm1.Button8Click(Sender: TObject);
var
ParamParcel: TLazParcel;
DsCount: integer;
begin
ParamParcel:=TLazParcel.create;
ParamParcel.PutstringGoods('@sqlstr','select * from customers',gdInput);
ParamParcel.PutIntegerGoods('@currentpage',1,gdInput);
ParamParcel.PutIntegerGoods('@pagesize',10,gdInput);
ParamParcel.PutIntegerGoods('@AllRecords',0,gdInputOutput);
memo1.Lines.add('');
if dba.ReadStoredProcDataset('PagingQuery',ParamParcel,DsCount,true) then
begin
memo1.lines.add('读存储过程中的数据集成功!');
memo1.Lines.Add(' 返回的数据集个数='+inttostr(DsCount));
if DsCount>0 then
begin
MTab.Close;
dba.GetStoredProcDataset(1,MTab);
memo1.lines.add('获取存储过程首个数据集完成!');
memo1.lines.add(' RecordCount='+inttostr(MTab.recordcount));
MTab.First;
listview1.Items.BeginUpdate;
listview1.Items.Clear;
while not MTab.EOF do
begin
with listview1.items.add do
begin
caption:=trim(MTab.GetAsString('CustomerId'));
subitems.add(trim(MTab.GetAsString('CompanyName')));
subitems.add(trim(MTab.GetAsString('Phone')));
end;
MTab.next;
end;
listview1.Items.EndUpdate;
MTab.Close;
end;
end
else
memo1.lines.add('读存储过程中的数据集失败!错误信息:'+dba.LastError);
ParamParcel.Free;
end;
//
// 表导出到文件...
procedure TForm1.Button9Click(Sender: TObject);
begin
if dba.TableToFile('select * from customers','f:\t.xml',2) then
memo1.lines.add('表导出到文件成功!')
else
memo1.lines.add('表导出到文件失败!错误信息:'+dba.LastError);
end;
//
// 读大数据集的进度事件...
procedure TForm1.dbaDatasetFetchProgress(Sender: TObject; AllPages: integer;
CurrentPage: integer);
begin
progressbar1.Max:=allpages;
progressbar1.Position:=CurrentPage;
end;
//
// 分页查询会话心跳包事件...
procedure TForm1.dbaPagingHeartbeat(Sender: TObject);
begin
memo1.lines.add('*** 分页查询心跳包成功发送!');
end;
//
// 读数据集测试...
procedure TForm1.Button1Click(Sender: TObject);
begin
if dba.ReadDataset('select * from customers',MTab) then
begin
memo1.lines.add('读远程数据集成功!');
memo1.lines.add(' 记录总数='+inttostr(MTab.RecordCount));
MTab.First;
listview1.Items.BeginUpdate;
listview1.Items.Clear;
while not MTab.EOF do
begin
with listview1.items.add do
begin
caption:=trim(MTab.GetAsString('CustomerId'));
subitems.add(trim(MTab.GetAsString('CompanyName')));
subitems.add(trim(MTab.GetAsString('Phone')));
end;
MTab.next;
end;
listview1.Items.EndUpdate;
MTab.Close;
end
else
memo1.lines.add('读远程数据集失败!Error='+dba.LastError);
end;
//
// 写Blob...
procedure TForm1.Button12Click(Sender: TObject);
var
Stream: TMemoryStream;
tmpstr: string;
begin
Stream:=TMemoryStream.Create;
tmpstr:='sjfdhsdhfjsdfhjsdfhbsd2387e82374e23723';
Stream.write(tmpstr[1],length(tmpstr));
stream.Position:=0;
if dba.StreamToBlobField(Stream,'ImageTable','ImageBody','ImageId=10') then
memo1.lines.add('流对象导入到Blob成功!大小='+inttostr(stream.size))
else
memo1.lines.add('流对象导入到Blob失败!错误信息:'+dba.LastError);
Stream.free;
end;
//
// 读表结构...
procedure TForm1.Button13Click(Sender: TObject);
begin
if dba.ReadTableHead('customers',mtab) then
memo1.lines.add('读表结构成功!')
else
memo1.lines.add('读表结构失败!'+dba.LastError);
end;
//
// 写数据集到远程数据表...
procedure TForm1.Button14Click(Sender: TObject);
begin
if not dba.ReadTableHead('customers',mtab) then
begin
memo1.lines.add('准备数据失败,写入操作失败!');
exit;
end;
mtab.append;
mtab.PutAsString('CustomerId','AKAKA');
mtab.PutAsString('CompanyName','杭州狐狸软件公司');
mtab.PutAsString('Phone','1355555555');
mtab.post;
if dba.WriteDataset(mtab,'customers') then
memo1.lines.add('写数据集到数据表成功!')
else
memo1.lines.add('写数据集到数据表失败!'+dba.LastError);
end;
//
// 数据集为容器的记录追加...
procedure TForm1.Button15Click(Sender: TObject);
begin
if not dba.ReadTableHead('customers',mtab) then
begin
memo1.lines.add('准备数据失败,写入操作失败!');
exit;
end;
Mtab.append;
Mtab.PutAsString('CustomerId','ALEX');
Mtab.PutAsString('CompanyName','新疆哈里波软件有限公司');
Mtab.post;
if dba.appendrecord('customers',Mtab) then
memo1.lines.add('追加记录到数据表成功!')
else
memo1.lines.add('追加记录到数据表失败!'+dba.LastError);
end;
//
// 以数据包裹为容器的记录追加...
procedure TForm1.Button16Click(Sender: TObject);
var
RecParcel: TLazParcel;
begin
RecParcel:=TLazParcel.Create;
RecParcel.PutStringGoods('CustomerId','ALEX2');
RecParcel.PutStringGoods('CompanyName','湖北九头鸟软件有限公司');
if dba.appendrecord('customers',RecParcel) then
memo1.lines.add('追加记录到数据表成功!')
else
memo1.lines.add('追加记录到数据表失败!'+dba.LastError);
RecParcel.free;
end;
//
// 以MemTable为记录容器的修改记录...
procedure TForm1.Button17Click(Sender: TObject);
begin
if not dba.ReadDataset('select * from customers where customerid=''ALEX''',MTab) then
begin
memo1.lines.add('因准备记录失败而导致修改记录失败!'+dba.LastError);
exit;
end;
MTab.edit;
MTab.PutAsString('CompanyName','浙江衢州第三水泥厂');
MTab.PutAsString('ContactName','赵萨那');
MTab.post;
if dba.updaterecord('customers','customerid=''ALEX''',MTab) then
memo1.lines.add('修改记录成功!')
else
memo1.lines.add('修改记录失败!'+dba.LastError);
end;
//
// 以LazParcel为记录容器的记录修改...
procedure TForm1.Button18Click(Sender: TObject);
var
RecParcel: TLazParcel;
begin
RecParcel:=TLazParcel.Create;
RecParcel.PutStringGoods('CompanyName','湖北武汉八匹马软件有限公司');
RecParcel.PutStringGoods('ContactName','史斟作');
if dba.updaterecord('customers','customerid=''ALEX2''',RecParcel) then
memo1.lines.add('修改记录成功!')
else
memo1.lines.add('修改记录失败!'+dba.LastError);
RecParcel.free;
end;
//
// 分配键值...
procedure TForm1.Button19Click(Sender: TObject);
begin
if dba.GenerateId('MyCustomers','CustomerId','','I','',NewId) then
memo1.lines.add('分配键值成功!NewId='+newid)
else
memo1.lines.add('分配键值失败!'+dba.LastError);
end;
//
// 归还键值...
procedure TForm1.Button20Click(Sender: TObject);
begin
if dba.FreeUnusedId('MyCustomers','CustomerId','',NewId) then
memo1.lines.add('归还未用键值成功!NewId='+newid)
else
memo1.lines.add('归还未用键值失败!'+dba.LastError);
end;
//
// 读多数据集...
procedure TForm1.Button21Click(Sender: TObject);
var
SqlList: TStringList;
begin
SqlList:=TStringList.create;
SqlList.add('SELECT * FROM CUSTOMERS');
sqllist.add('SELECT * FROM PRODUCTS');
sqllist.add('SELECT * FROM MYCUSTOMERS');
if dba.ReadMultipleDatasets(sqllist,true) then
begin
dba.GetResultDataset(1,MTab);
memo1.lines.add('一次读取三个数据集成功!');
memo1.lines.add(' 第二个表记录数='+inttostr(MTab.RecordCount));
dba.ClearResultDatasets;
end
else
memo1.lines.add('读多数据集失败!'+dba.LastError);
sqlList.free;
end;
//
// 写多数据集...
procedure TForm1.Button22Click(Sender: TObject);
var
MTab1,MTab2: TLazMemTable;
begin
MTab1:=TLazMemTable.Create(nil);
dba.ReadDataset('SELECT TOP 1 * FROM CUSTOMERS',MTab1);
MTab1.edit;
MTab1.PutAsString('CustomerId','OHYAH');
MTab1.PutAsString('CompanyName','湖南长沙秤砣有限公司');
MTab1.post;
memo1.lines.add('数据集1准备就绪!');
//
MTab2:=TLazMemTable.Create(nil);
dba.ReadDataset('SELECT TOP 1 * FROM MYCUSTOMERS',MTab2);
MTab2.edit;
MTab2.PutAsInteger('CustomerId',16);
MTab2.post;
memo1.lines.add('数据集2准备就绪!');
//
dba.AddWriteDataset('Customers','',MTab1);
dba.AddWriteDataset('MyCustomers','',MTab2);
memo1.lines.add('Add数据集成功!');
//
if dba.WriteMultipleDatasets(true) then
memo1.lines.add('一次写两个数据集成功!')
else
begin
memo1.lines.add('一次写两个数据集失败!Error='+dba.LastError);
dba.ClearWriteDatasets;
end;
//
MTab1.free;
MTab2.free;
end;
//
// 创建分页查询...
procedure TForm1.Button23Click(Sender: TObject);
var
allrecords: integer;
begin
if dba.CreateQuerySession('select * from customers',allrecords) then
memo1.Lines.Add('创建分页查询会话成功!总记录数='+inttostr(allrecords))
else
memo1.Lines.Add('创建分页查询会话失败!');
end;
//
// 读一页数据...
procedure TForm1.Button24Click(Sender: TObject);
begin
if dba.QueryPageData(10,1,MTab) then
begin
memo1.lines.add('读第2页成功!Count='+inttostr(MTab.recordCount));
MTab.First;
listview1.Items.BeginUpdate;
listview1.Items.Clear;
while not MTab.EOF do
begin
with listview1.items.add do
begin
caption:=trim(MTab.GetAsString('CustomerId'));
subitems.add(trim(MTab.GetAsString('CompanyName')));
subitems.add(trim(MTab.GetAsString('Phone')));
end;
MTab.next;
end;
listview1.Items.EndUpdate;
MTab.Close;
end
else
memo1.lines.add('读第2页失败!Error='+dba.LastError);
end;
//
// 检测分页查询状态...
procedure TForm1.Button25Click(Sender: TObject);
begin
if dba.InPageQuery then
memo1.lines.add('分页查询会话存活!')
else
memo1.lines.add('分页查询会话已不存在!');
end;
//
// 撤消分页查询会话...
procedure TForm1.Button26Click(Sender: TObject);
begin
if dba.FreeQuerySession then
memo1.lines.add('撤消分页查询会话成功!')
else
memo1.lines.add('撤消分页查询会话失败!'+dba.LastError);
end;
//
// 分页方式读大数据集...
procedure TForm1.Button27Click(Sender: TObject);
begin
if dba.ReadLargeDataset('select * from customers',10,MTab) then
memo1.lines.add('读大数据集成功!')
else
memo1.lines.add('读大数据集失败!'+dba.LastError);
end;
//
// 清除Blob...
procedure TForm1.Button11Click(Sender: TObject);
begin
if dba.ClearBlobField('ImageTable','ImageBody','ImageId=10') then
memo1.lines.add('清除Blob字段成功!')
else
memo1.lines.add('清除Blob字段失败!错误信息:'+dba.LastError);
end;
//
// 文件导入到表...
procedure TForm1.Button10Click(Sender: TObject);
var
tmpstr: string;
begin
if not dba.ExecuteSql('delete from customers',false,tmpstr) then
begin
memo1.lines.add('文件导入到表失败!错误信息:'+dba.LastError);
exit;
end;
if dba.FileToTable('f:\t.xml','customers') then
memo1.lines.add('文件导入到数据表成功!')
else
memo1.lines.add('文件导入到数据表失败!错误信息:'+dba.LastError);
end;
//
// 执行SQL命令,返回影响的行数...
procedure TForm1.Button28Click(Sender: TObject);
var
j: integer;
begin
if dba.ExecuteCommand('delete from customers where customerid is null',j) then
memo1.lines.add('执行SQL命令成功!影响的行数='+inttostr(j))
else
memo1.lines.add('执行SQL命令失败!'+dba.LastError);
end;
//
// 读Blob字段...
procedure TForm1.Button2Click(Sender: TObject);
var
Stream: TMemoryStream;
begin
Stream:=TMemoryStream.Create;
if dba.BlobFieldToStream('ImageTable','ImageBody','ImageId=10',Stream) then
memo1.lines.add('Blob导出到流对象成功!大小='+inttostr(stream.size))
else
memo1.lines.add('Blob导出到流对象失败!错误信息:'+dba.LastError);
Stream.free;
end;
//
// 远过程调用测试...
procedure TForm1.Button3Click(Sender: TObject);
var
tmpstr: string;
begin
if dba.ReadSimpleResult('select count(*) from customers',tmpstr) then
memo1.lines.add('读简单返回值成功!RetValue='+tmpstr)
else
memo1.lines.add('读简单返回值失败!'+dba.LastError);
end;
//
// 执行SQL命令...
procedure TForm1.Button4Click(Sender: TObject);
var
tmpstr: string;
begin
if dba.ExecuteSql('select count(*) from customers',true,tmpstr) then
memo1.lines.add('执行SQL命令成功!RetValue='+tmpstr)
else
memo1.lines.add('执行SQL命令失败!'+dba.LastError);
end;
//
// 程序启动时,连接应用服务器...
procedure TForm1.FormCreate(Sender: TObject);
begin
if lazconn.Connect then
memo1.lines.add('连接服务器成功!')
else
memo1.lines.add('连接服务器失败!Error='+dba.LastError);
end;
//
// 基本连接的心跳包事件...
procedure TForm1.LazConnSessionHeartbeat(Sender: TObject);
begin
memo1.lines.add('*** 基本连接心跳包成功发送!');
end;
end.
|
|