设为首页收藏本站
切换到窄版

Lazarus中文社区

 找回密码
 立即注册（注册审核可向QQ群索取）

QQ登录

只需一步，快速开始

Lazarus中文社区»论坛 › Lazarus 拉扎勒斯 › Lazarus 答疑/分享 › WinCE|WM › Lazarus+QuickBurro开发WinCE/WM应用
Lazarus IDE and 组件 下载地址版权申明
返回列表 发新帖
查看: 3475|回复: 7

Lazarus+QuickBurro开发WinCE/WM应用

[复制链接]
wpy020327

该用户从未签到
发表于 2013-8-5 22:42:07 | 显示全部楼层 |阅读模式
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.

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？立即注册（注册审核可向QQ群索取）

x
回复

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-5 22:45:10 | 显示全部楼层
2、远程文件目录访问使得三层客户端可以轻松访问应用服务器上的文件目录，以便配合数据库访问、文件传输等功能实现各种特殊的文件读写与处理功能。 这里是示例：（代码略）

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？立即注册（注册审核可向QQ群索取）

x
回复 支持 反对

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-5 22:47:08 | 显示全部楼层
wpy020327 发表于 2013-8-5 22:45
2、远程文件目录访问使得三层客户端可以轻松访问应用服务器上的文件目录，以便配合数据库访问、文件传输等功 ...

3、文件传输、文件夹传输，自然也是非常重要的功能，示例：（代码略）

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？立即注册（注册审核可向QQ群索取）

x
回复 支持 反对

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-5 22:50:42 | 显示全部楼层
wpy020327 发表于 2013-8-5 22:47
3、文件传输、文件夹传输，自然也是非常重要的功能，示例：（代码略）

4、然后是消息传输，可以与其他各类终端之间交换各类消息，示例：（代码略）

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？立即注册（注册审核可向QQ群索取）

x
回复 支持 反对

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-5 22:53:56 | 显示全部楼层
结论：

    尽管Lazarus还存在着很多待修正的Bug，但总体情况还不错。若能绕过这些Bug，自己想办法解决，还是可以开发出很多令人欣喜的应用来的。
回复 支持 反对

使用道具 举报

claro

该用户从未签到
发表于 2013-8-8 17:33:18 | 显示全部楼层
期待源码。
回复 支持 反对

使用道具 举报

yayongm

该用户从未签到
发表于 2013-8-16 16:15:28 | 显示全部楼层
支持一下驴他爸!
友情提醒:模拟器运行和实体机运行还是有很大差别的.
回复 支持 反对

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-20 16:58:09 | 显示全部楼层
那肯定是的
因我手头没物理机，所以只能先用虚拟机调试啦
回复 支持 反对

使用道具 举报

返回列表 发新帖
*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2023-9-23 12:50 , Processed in 0.033079 second(s), 10 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表