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

Lazarus中文社区

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

QQ登录

只需一步，快速开始

Lazarus中文社区»论坛 › Lazarus 拉扎勒斯 › Lazarus 组件发布 › WinCE/WM开发时的数据集容器类源码
Lazarus IDE and 组件 下载地址版权申明
返回列表 发新帖
查看: 3969|回复: 3

[数据库] WinCE/WM开发时的数据集容器类源码

[复制链接]
wpy020327

该用户从未签到
发表于 2013-8-8 20:25:17 | 显示全部楼层 |阅读模式
1、新编容器类（TLazMemTable）的原因
=========================

       在开发完成QuickBurro for Lazarus 开发包并在Windows下测试通过之后，咱迫不及待地在WinCE/WM上对开发包进行了测试，但是，让人沮丧的事情发生了：Lazarus的标准数据集对象TMemDataset等竟然不能正常工作，读写记录、字段得到的结果是错误的！  大跌眼镜！

      没办法，因为数据集容器对象是三层架构中最重要的对象之一，绝对不能少了——于是，就自己开写！

      由于只是容器类、同时也是为了减小工作量，俺把目标放低了点： 新实现的容器类只要能以一种高效紧凑的格式容纳数据集、能方便地定义结构、读写记录、与流对象之间进行转换以便进行远程传输、移动记录指针等——就基本够用了，记录删除、检索、改表结构、数据感知之类，暂且不用支持，因为移动设备端无需大规模编程，不用数据感知之类的高级功能。

      写了两天，调试后很快就测试通过了，然后，应用到QuickBurro for Lazarus 开发包中，最后，再基于这个类进行WinCE/WM下的编程测试——结果全线通过、效果令人满意。


2、容器类（TLazMemTable）的源码
=======================

//
//-------------------------------------------------------------------------
//                                                               
//                                                               
//    QuickBurro Middleware Application Development Package for Lazarus     
//                                                               
//    Version 4.28                                               
//    Update Date: 2013.8.5.                                    
//    Author: Jopher(W.G.Z.)                                    
//    QQ: 779545524  
//    QQ groups: 79114999,33286656,116166458,84945607,18594635      
//    Email: Jopher@189.cn  or wpy020327@163.com  
//    Homepage: http://www.quickburro.com/               
//                                                               
//    Copyright(C) Jopher Software Studio,2006-2013. All rights reserved   
//                                                               
//                                                               
//-------------------------------------------------------------------------
//
unit LazMemTable;
interface
uses
   SysUtils,
   Classes,
   LResources,
   db;
type
   TTableOpenEvent = procedure (Sender: TObject) of object;
   TTableCloseEvent = procedure (Sender: TObject) of Object;
   TLazMemTable=class(TComponent)
      private
         fActive: boolean;
         fFieldCount: integer;
         fRecordCount: integer;
         fRecNo: integer;
         fInAppend: boolean;
         fInEdit: boolean;
         fRecordSize: integer;
         fOnTableOpened: TTableOpenEvent;
         fOnTableClosed: TTableCloseEvent;
         DataAreaLength: integer;
         DataArea: array of byte;
         procedure SetActive(aActive: boolean);
         procedure SetRecNo(aRecNo: integer);
         function DoOpen(): boolean;
         function DoClose(): boolean;
      public
         Constructor Create(AOwner: TComponent); override;
         Destructor Destroy(); override;
         procedure Clear;
         procedure ClearRecords;
         procedure Open;
         procedure Close;
         function FindFieldDef(aFieldName: string): integer;
         procedure AddFieldDef(FieldName: string; FieldType: TFieldType; FieldSize: integer);
         procedure GetFieldDef(const aFieldIndex: integer; var FieldName: string; var FieldType: TFieldType; var FieldSize: integer); overload;
         procedure GetFieldDef(const FieldName: string; var FieldIndex: integer; var FieldType: TFieldType; var FieldSize: integer); overload;
         function GetAsString(const aFieldIndex: integer): string; overload;
         function GetAsString(const aFieldName: string): string; overload;
         function GetAsBoolean(const aFieldIndex: integer): Boolean; overload;
         function GetAsBoolean(const aFieldName: string): Boolean; overload;
         function GetAsInteger(const aFieldIndex: integer): Integer; overload;
         function GetAsInteger(const aFieldName: string): Integer; overload;
         function GetAsInt64(const aFieldIndex: integer): Int64; overload;
         function GetAsInt64(const aFieldName: string): Int64; overload;
         function GetAsSmallInt(const aFieldIndex: integer): SmallInt; overload;
         function GetAsSmallInt(const aFieldName: string): SmallInt; overload;
         function GetAsFloat(const aFieldIndex: integer): Double; overload;
         function GetAsFloat(const aFieldName: string): Double; overload;
         function GetAsDateTime(const aFieldIndex: integer): TDateTime; overload;
         function GetAsDateTime(const aFieldName: string): TDateTime; overload;
         function GetAsDate(const aFieldIndex: integer): TDateTime; overload;
         function GetAsDate(const aFieldName: string): TDateTime; overload;
         function GetAsTime(const aFieldIndex: integer): TDateTime; overload;
         function GetAsTime(const aFieldName: string): TDateTime; overload;
         function GetRecord(): string;
         procedure Append;
         procedure PutAsString(const aFieldIndex: integer; const aFieldValue: string); overload;
         procedure PutAsString(const aFieldName: string; const aFieldValue: string); overload;
         procedure PutAsBoolean(const aFieldIndex: integer; const aFieldValue: Boolean); overload;
         procedure PutAsBoolean(const aFieldName: string; const aFieldValue: Boolean); overload;
         procedure PutAsInteger(const aFieldIndex: integer; const aFieldValue: Integer); overload;
         procedure PutAsInteger(const aFieldName: string; const aFieldValue: Integer); overload;
         procedure PutAsInt64(const aFieldIndex: integer; const aFieldValue: Int64); overload;
         procedure PutAsInt64(const aFieldName: string; const aFieldValue: Int64); overload;
         procedure PutAsSmallInt(const aFieldIndex: integer; const aFieldValue: SmallInt); overload;
         procedure PutAsSmallInt(const aFieldName: string; const aFieldValue: SmallInt); overload;
         procedure PutAsFloat(const aFieldIndex: integer; const aFieldValue: Double); overload;
         procedure PutAsFloat(const aFieldName: string; const aFieldValue: Double); overload;
         procedure PutAsDateTime(const aFieldIndex: integer; const aFieldValue: TDateTime); overload;
         procedure PutAsDateTime(const aFieldName: string; const aFieldValue: TDateTime); overload;
         procedure PutAsDate(const aFieldIndex: integer; const aFieldValue: TDate); overload;
         procedure PutAsDate(const aFieldName: string; const aFieldValue: TDate); overload;
         procedure PutAsTime(const aFieldIndex: integer; const aFieldValue: TTime); overload;
         procedure PutAsTime(const aFieldName: string; const aFieldValue: TTime); overload;
         procedure PutRecord(RecData: string);
         procedure Edit;
         procedure Post;
         procedure First;
         procedure Last;
         procedure Next;
         procedure Prior;
         procedure MoveBy(Distance: integer);
         function Bof(): boolean;
         function Eof(): boolean;
         function LoadFromStream(aStream: TMemoryStream): boolean;
         function SaveToStream(aStream: TMemoryStream): boolean;
         function LoadFromFile(aFileName: string): boolean;
         function SaveToFile(aFileName: string): boolean;
         property FieldCount: integer read fFieldCount;
         property RecordCount: integer read fRecordCount;
         property InAppend: boolean read fInAppend;
         property InEdit: boolean read fInEdit;
         property RecordSize: integer read fRecordSize;
         property BufferSize: integer read DataAreaLength;
      published
         property Active: boolean read fActive write SetActive;
         property RecNo: integer read fRecNo write SetRecNo;
         property OnTableOpened: TTableOpenEvent read fOnTableOpened write fOnTableOpened;
         property OnTableClosed: TTableCloseEvent read fOnTableClosed write fOnTableClosed;
   end;
procedure Register;
implementation
const
   RecordSetOffset=12*1024;
   FieldDefSize=40;
procedure Register;
begin
  RegisterComponents('QuickBurro', [TLazMemTable]);
end;
Constructor TLazMemTable.Create(AOwner: TComponent);
begin
   inherited create(aOwner);
   fActive:=false;
   fFieldCount:=0;
   fRecordCount:=0;
   fRecNo:=-1;
   fInAppend:=false;
   fInEdit:=false;
   fRecordSize:=0;
   DataAreaLength:=12*1024;
   SetLength(DataArea,DataAreaLength);
end;
Destructor TLazMemTable.Destroy();
begin
   DataAreaLength:=0;
   SetLength(DataArea,DataAreaLength);
   inherited Destroy;
end;
procedure TLazMemTable.SetActive(aActive: boolean);
begin
   if fActive=aActive then
      exit;
   if aActive then
      doclose
   else
      doopen;
end;
procedure TLazMemTable.SetRecNo(aRecNo: integer);
begin
   if aRecNo<0 then
      fRecNo:=-1
   else
      begin
         if aRecNo>fRecordCount then
            fRecNo:=fRecordCount
         else
            fRecNo:=aRecNo;
      end;
end;
function TLazMemTable.DoOpen(): boolean;
begin
   if fFieldCount<=0 then
      result:=false
   else
      begin
         fActive:=true;
         result:=true;
         if assigned(fOnTableOpened) then
            fOnTableOpened(self);
      end;
end;
function TLazMemTable.DoClose(): boolean;
begin
   fActive:=false;
   fFieldCount:=0;
   fRecordCount:=0;
   fRecNo:=-1;
   fInAppend:=false;
   fInEdit:=false;
   fRecordSize:=0;
   DataAreaLength:=12*1024;
   SetLength(DataArea,DataAreaLength);
   result:=true;
   if assigned(fOnTableClosed) then
      fOnTableClosed(self);
end;
procedure TLazMemTable.Clear;
begin
   doclose;
end;
procedure TLazMemTable.ClearRecords;
begin
   DataAreaLength:=12*1024;
   SetLength(DataArea,DataAreaLength);
   fRecordCount:=0;
   fRecNo:=-1;
   fInAppend:=false;
   fInEdit:=false;
end;
procedure TLazMemTable.Open;
begin
   if fActive then
      exit;
   doopen;
end;
procedure TLazMemTable.Close;
begin
   if not fActive then
      exit;
   doclose;
end;
function TLazMemTable.FindFieldDef(aFieldName: string): integer;
var
   i: integer;
   tmpstr: string;
begin
   result:=-1;
   for i := 0 to fFieldCount-1 do
      begin
         tmpstr:=trim(string(copy(DataArea,RecordSetOffset-(i+1)*FieldDefSize,30)));
         if stricomp(PAnsiChar(aFieldName),PAnsiChar(tmpstr))=0 then
            begin
               result:=i;
               break;
            end;
      end;
end;
procedure TLazMemTable.AddFieldDef(FieldName: string; FieldType: TFieldType; FieldSize: integer);
var
   ptr: pointer;
   FldSize: integer;
begin
   ptr:=@DataArea[RecordSetOffset-(fFieldCount+1)*FieldDefSize];
   fillchar(ptr^,30,' ');
   move(FieldName[1],ptr^,length(FieldName));
   DataArea[RecordSetOffset-(fFieldCount+1)*FieldDefSize+30]:=ord(FieldType);
   case FieldType of
      ftString: FldSize:=FieldSize;
      ftBoolean: FldSize:=Sizeof(Boolean);
      ftInteger: FldSize:=Sizeof(Integer);
      ftLargeInt: FldSize:=Sizeof(Int64);
      ftSmallInt: FldSize:=Sizeof(SmallInt);
      ftFloat: FldSize:=Sizeof(Double);
      ftDateTime,ftDate,ftTime: FldSize:=Sizeof(TDateTime);
      else
         exit;
   end;
   ptr:=@DataArea[RecordSetOffset-(fFieldCount+1)*FieldDefSize+31];
   move(FldSize,ptr^,4);
   ptr:=@DataArea[RecordSetOffset-(fFieldCount+1)*FieldDefSize+35];
   move(fRecordSize,ptr^,4);
   inc(fFieldCount);
   fRecordSize:=fRecordSize+FldSize;
end;
procedure TLazMemTable.GetFieldDef(const aFieldIndex: integer; var FieldName: string; var FieldType: TFieldType; var FieldSize: integer);
var
   ptr: pointer;
begin
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize];
   setlength(FieldName,30);
   move(ptr^,FieldName[1],30);
   fieldName:=trim(FieldName);
   FieldType:=TFieldType(DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+30]);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
end;
procedure TLazMemTable.GetFieldDef(const FieldName: string; var FieldIndex: integer; var FieldType: TFieldType; var FieldSize: integer);
var
   ptr: pointer;
begin
   FieldIndex:=FindFieldDef(FieldName);
   if FieldIndex<>-1 then
      begin
         FieldType:=TFieldType(DataArea[RecordSetOffset-(FieldIndex+1)*FieldDefSize+30]);
         ptr:=@DataArea[RecordSetOffset-(FieldIndex+1)*FieldDefSize+31];
         move(ptr^,FieldSize,4);
      end;
end;
function TLazMemTable.GetAsString(const aFieldIndex: integer): string;
var
   ptr: pointer;
   FieldSize,FieldOffset,i,NullBytes: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:='';
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   NullBytes:=0;
   for i:= FieldSize-1 to 0 do
      begin
         if DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset+i]=0 then
            inc(NullBytes)
         else
            break;
      end;
   setlength(Result,fieldsize-nullbytes);
   if fieldsize>nullbytes then
      begin
         ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
         move(ptr^,Result[1],fieldsize-nullbytes);
      end;
end;
function TLazMemTable.GetAsString(const aFieldName: string): string;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=''
   else
      result:=GetAsString(FieldIndex);
end;
function TLazMemTable.GetAsBoolean(const aFieldIndex: integer): Boolean;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:=false;
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsBoolean(const aFieldName: string): Boolean;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=false
   else
      result:=GetAsBoolean(FieldIndex);
end;
function TLazMemTable.GetAsInteger(const aFieldIndex: integer): Integer;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:=0;
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsInteger(const aFieldName: string): Integer;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsInteger(FieldIndex);
end;
function TLazMemTable.GetAsInt64(const aFieldIndex: integer): Int64;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:=0;
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsInt64(const aFieldName: string): Int64;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsInt64(FieldIndex);
end;
function TLazMemTable.GetAsSmallInt(const aFieldIndex: integer): SmallInt;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:=0;
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsSmallInt(const aFieldName: string): SmallInt;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsSmallInt(FieldIndex);
end;
function TLazMemTable.GetAsFloat(const aFieldIndex: integer): Double;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      begin
         result:=0;
         exit;
      end;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsFloat(const aFieldName: string): Double;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsFloat(FieldIndex);
end;
function TLazMemTable.GetAsDateTime(const aFieldIndex: integer): TDateTime;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsDateTime(const aFieldName: string): TDateTime;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsDateTime(FieldIndex);
end;
function TLazMemTable.GetAsDate(const aFieldIndex: integer): TDateTime;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsDate(const aFieldName: string): TDateTime;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsDate(FieldIndex);
end;
function TLazMemTable.GetAsTime(const aFieldIndex: integer): TDateTime;
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(ptr^,result,fieldsize);
end;
function TLazMemTable.GetAsTime(const aFieldName: string): TDateTime;
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex<0 then
      result:=0
   else
      result:=GetAsTime(FieldIndex);
end;
function TLazMemTable.GetRecord(): string;
var
   ptr: pointer;
begin
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo];
   setlength(result,fRecordSize);
   move(ptr^,result[1],fRecordSize);
end;
procedure TLazMemTable.Append;
begin
   if not fActive then
      exit;
   if fInAppend or fInEdit then
      exit;
   if (RecordSetOffset+(fRecordCount+1)*fRecordSize)>DataAreaLength then
      begin
         DataAreaLength:=DataAreaLength+fRecordSize*100;
         SetLength(DataArea,DataAreaLength);
      end;
   fRecNo:=fRecordCount;
   inc(fRecordCount);
   fInAppend:=true;
end;
procedure TLazMemTable.PutAsString(const aFieldIndex: integer; const aFieldValue: string);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   fillchar(ptr^,FieldSize,0);
   if length(aFieldValue)>=FieldSize then
      move(aFieldValue[1],ptr^,FieldSize)
   else
      move(aFieldValue[1],ptr^,length(aFieldValue));
end;
procedure TLazMemTable.PutAsString(const aFieldName: string; const aFieldValue: string);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsString(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsBoolean(const aFieldIndex: integer; const aFieldValue: Boolean);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(Boolean));
end;
procedure TLazMemTable.PutAsBoolean(const aFieldName: string; const aFieldValue: Boolean);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsBoolean(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsInteger(const aFieldIndex: integer; const aFieldValue: Integer);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(Integer));
end;
procedure TLazMemTable.PutAsInteger(const aFieldName: string; const aFieldValue: Integer);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsInteger(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsInt64(const aFieldIndex: integer; const aFieldValue: Int64);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(Int64));
end;
procedure TLazMemTable.PutAsInt64(const aFieldName: string; const aFieldValue: Int64);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsInt64(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsSmallInt(const aFieldIndex: integer; const aFieldValue: SmallInt);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(SmallInt));
end;
procedure TLazMemTable.PutAsSmallInt(const aFieldName: string; const aFieldValue: SmallInt);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsSmallInt(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsFloat(const aFieldIndex: integer; const aFieldValue: Double);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(Double));
end;
procedure TLazMemTable.PutAsFloat(const aFieldName: string; const aFieldValue: Double);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsFloat(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsDateTime(const aFieldIndex: integer; const aFieldValue: TDateTime);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(TDateTime));
end;
procedure TLazMemTable.PutAsDateTime(const aFieldName: string; const aFieldValue: TDateTime);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsDateTime(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsDate(const aFieldIndex: integer; const aFieldValue: TDate);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(TDate));
end;
procedure TLazMemTable.PutAsDate(const aFieldName: string; const aFieldValue: TDate);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsDate(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutAsTime(const aFieldIndex: integer; const aFieldValue: TTime);
var
   ptr: pointer;
   FieldSize,FieldOffset: integer;
begin
   if not (fInAppend or fInEdit) then
      exit;
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+31];
   move(ptr^,FieldSize,4);
   ptr:=@DataArea[RecordSetOffset-(aFieldIndex+1)*FieldDefSize+35];
   move(ptr^,FieldOffset,4);
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo+FieldOffset];
   move(aFieldValue,ptr^,Sizeof(TTime));
end;
procedure TLazMemTable.PutAsTime(const aFieldName: string; const aFieldValue: TTime);
var
   FieldIndex: integer;
begin
   FieldIndex:=FindFieldDef(aFieldName);
   if FieldIndex>=0 then
      PutAsTime(FieldIndex,aFieldValue);
end;
procedure TLazMemTable.PutRecord(RecData: string);
var
   ptr: pointer;
begin
   ptr:=@DataArea[RecordSetOffset+fRecordSize*fRecNo];
   move(RecData[1],ptr^,fRecordSize);
end;
procedure TLazMemTable.Edit;
begin
   if not fActive then
      exit;
   if fInAppend or fInEdit then
      exit;
   if (fRecNo<0) or (fRecNo>=fRecordCount) then
      exit;
   fInEdit:=true;
end;
procedure TLazMemTable.Post;
begin
   if not (fInAppend or fInEdit) then
      exit;
   fInAppend:=false;
   fInEdit:=false;
end;
procedure TLazMemTable.First;
begin
   if (not fActive) or fInAppend or fInEdit then
      exit;
   if fRecordCount>0 then
      fRecNo:=0
   else
      fRecNo:=-1;
end;
procedure TLazMemTable.Last;
begin
   if (not fActive) or fInAppend or fInEdit then
      exit;
   if fRecordCount>0 then
      fRecNo:=fRecordCount-1
   else
      fRecNo:=-1;
end;
procedure TLazMemTable.Next;
begin
   if (not fActive) or fInAppend or fInEdit then
      exit;
   if (fRecordCount>0) and (fRecNo<fRecordCount) then
      inc(fRecNo);
end;
procedure TLazMemTable.Prior;
begin
   if (not fActive) or fInAppend or fInEdit then
      exit;
   if (fRecordCount>0) and (fRecNo>=0) then
      dec(fRecNo);
end;
procedure TLazMemTable.MoveBy(Distance: integer);
begin
   if (not fActive) or fInAppend or fInEdit then
      exit;
   if fRecNo+Distance<0 then
      fRecNo:=-1
   else
      begin
         if fRecNo+Distance>fRecordCount then
            fRecNo:=fRecordCount
         else
            fRecNo:=fRecNo+Distance;
      end;
end;
function TLazMemTable.Bof(): boolean;
begin
   result:=(not fActive) or (fRecordCount=0) or (fRecNo<0);
end;
function TLazMemTable.Eof(): boolean;
begin
   result:=(not fActive) or (fRecordCount=0) or (fRecNo>=fRecordCount);
end;
function TLazMemTable.LoadFromStream(aStream: TMemoryStream): boolean;
var
   ptr: Pointer;
begin
   aStream.Position:=0;
   aStream.Read(fFieldCount,4);
   aStream.Read(fRecordCount,4);
   aStream.Read(fRecordSize,4);
   if (fFieldCount<=0) or (fRecordCount<0) or (fRecordSize<=0)
      or (aStream.Size<>(12+fFieldCount*FieldDefSize+fRecordCount*fRecordSize)) then
      begin
         result:=false;
         exit;
      end;
   DataAreaLength:=RecordSetOffset+fRecordCount*fRecordSize;
   setlength(DataArea,DataAreaLength);
   ptr:=@DataArea[RecordSetOffset-fFieldCount*FieldDefSize];
   aStream.Read(ptr^,fFieldCount*FieldDefSize+fRecordCount*fRecordSize);
   fInAppend:=false;
   fInEdit:=false;
   if fRecordCount=0 then
      fRecNo:=-1
   else
      fRecNo:=0;
   fActive:=true;
   if assigned(fOnTableOpened) then
      fOnTableOpened(self);
   result:=true;
end;
function TLazMemTable.SaveToStream(aStream: TMemoryStream): boolean;
var
   ptr: Pointer;
begin
   if not fActive then
      begin
         result:=false;
         exit;
      end;
   aStream.Clear;
   aStream.Write(fFieldCount,4);
   aStream.Write(fRecordCount,4);
   aStream.Write(fRecordSize,4);
   ptr:=@DataArea[RecordSetOffset-fFieldCount*FieldDefSize];
   aStream.Write(ptr^,fFieldCount*FieldDefSize+fRecordCount*fRecordSize);
   result:=true;
end;
function TLazMemTable.LoadFromFile(aFileName: string): boolean;
var
   Stream: TMemoryStream;
begin
   Stream:=TMemoryStream.Create;
   try
      Stream.LoadFromFile(aFileName);
      result:=LoadFromStream(stream);
   except
      result:=false;
   end;
   FreeAndNil(Stream);
end;
function TLazMemTable.SaveToFile(aFileName: string): boolean;
var
   Stream: TMemoryStream;
begin
   Stream:=TMemoryStream.Create;
   try
      result:=SaveToStream(stream);
      if result then
         begin
            Stream.Position:=0;
            Stream.SaveToFile(aFileName);
         end;
   except
      result:=false;
   end;
   FreeAndNil(Stream);
end;
Initialization
   {$i lazmemtable.lrs}
end.


3、容器类（TLazMemTable）的功能测试程序
============================

unit main;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, LazMemTable, db;
type
  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    ImageList1: TImageList;
    qbmt: TLazMemTable;
    ListView1: TListView;
    Memo1: TMemo;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(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 ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure qbmtTableClosed(Sender: TObject);
    procedure qbmtTableOpened(Sender: TObject);
    procedure ShowTable;
    procedure Button15Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    Stream: TMemoryStream;
  end;
var
  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.ShowTable;
begin
   if not qbmt.Active then
      begin
         listview1.Items.Clear;
         exit;
      end;
   qbmt.First;
   listview1.Items.BeginUpdate;
   listview1.Items.Clear;
   while not qbmt.Eof do
      begin
         with listview1.Items.Add do
            begin
               caption:=qbmt.GetAsString('CustomerId');
               subitems.Add(qbmt.GetAsString('CustomerName'));
               if qbmt.GetAsBoolean('IsPersonal') then
                  subitems.Add('是')
               else
                  subitems.Add('否');
               subitems.Add(inttostr(qbmt.GetAsInteger('age')));
               subitems.Add(formatfloat('0.00',qbmt.GetAsFloat('height')));
               subitems.Add(qbmt.GetAsString('Telephone'));
               subitems.Add(formatDateTime('yyyy-mm-dd',qbmt.GetAsDateTime('CreateDate')));
               imageindex:=0;
            end;
         qbmt.Next;
      end;
   listview1.Items.EndUpdate;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  qbmt.Append;
  qbmt.PutAsString('CustomerId','13080001');
  qbmt.PutAsString('CustomerName','杭州新时代媒体广告有限公司');
  qbmt.PutAsBoolean('IsPersonal',false);
  qbmt.PutAsInteger('Age',35);
  qbmt.PutAsFloat('Height',175.5);
  qbmt.PutAsString('Telephone','18912345678');
  qbmt.PutAsDateTime('CreateDate',Now);
  qbmt.Post;
//
  qbmt.Append;
  qbmt.PutAsString('CustomerId','13080002');
  qbmt.PutAsString('CustomerName','上海新型材料有限公司');
  qbmt.PutAsBoolean('IsPersonal',false);
  qbmt.PutAsInteger('Age',42);
  qbmt.PutAsFloat('Height',185.0);
  qbmt.PutAsString('Telephone','1383838833');
  qbmt.PutAsDateTime('CreateDate',Now);
  qbmt.Post;
//
  qbmt.Append;
  qbmt.PutAsString('CustomerId','13080003');
  qbmt.PutAsString('CustomerName','江苏省盐城市美声工作室');
  qbmt.PutAsBoolean('IsPersonal',true);
  qbmt.PutAsInteger('Age',41);
  qbmt.PutAsFloat('Height',165.0);
  qbmt.PutAsString('Telephone','15309878872');
  qbmt.PutAsDateTime('CreateDate',Now);
  qbmt.Post;
//
  qbmt.Append;
  qbmt.PutAsString('CustomerId','13080004');
  qbmt.PutAsString('CustomerName','广东省韶关市墙体材料厂');
  qbmt.PutAsBoolean('IsPersonal',false);
  qbmt.PutAsInteger('Age',23);
  qbmt.PutAsFloat('Height',175.0);
  qbmt.PutAsString('Telephone','15302233422');
  qbmt.PutAsDateTime('CreateDate',Now);
  qbmt.Post;
//
  showtable;
  memo1.Lines.Add('追加4条记录成功！');
end;
procedure TForm1.Button12Click(Sender: TObject);
begin
  qbmt.Clear;
  showtable;
  memo1.Lines.Add('清除所有表结构及记录成功！');
  if qbmt.Active then
     memo1.Lines.Add('    内存表仍然处于打开状态！')
  else
     memo1.Lines.Add('    内存表已处于关闭状态！');
end;
procedure TForm1.Button13Click(Sender: TObject);
begin
  if qbmt.SaveToFile('c:\qbmt.dat') then
     memo1.Lines.Add('导出到文件成功！')
  else
     memo1.Lines.Add('导出到文件失败！')
end;
procedure TForm1.Button14Click(Sender: TObject);
begin
  if qbmt.LoadFromFile('c:\qbmt.dat') then
     begin
        showtable;
        memo1.Lines.Add('从文件导入成功！');
     end
  else
     memo1.Lines.Add('从文件导入失败！')
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
  qbmt.Next;
  memo1.Lines.Add('指向下一记录成功！RecNo='+inttostr(qbmt.RecNo));
  memo1.Lines.Add('                  CustomerName='+qbmt.GetAsString('CustomerName'));
end;
procedure TForm1.Button11Click(Sender: TObject);
begin
  qbmt.Last;
  memo1.Lines.Add('转尾记录成功！RecNo='+inttostr(qbmt.RecNo));
  memo1.Lines.Add('              CustomerName='+qbmt.GetAsString('CustomerName'));
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
  qbmt.edit;
  qbmt.PutAsString('CustomerName','北京市稀里糊涂市政建设有限公司');
  qbmt.PutAsString('Telephone','18080808800');
  qbmt.PutAsDateTime('CreateDate',Now);
  qbmt.Post;
  showtable;
  memo1.Lines.Add('修改记录成功！');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
  qbmt.Close;
  listview1.Items.Clear;
  memo1.Lines.Add('关闭数据表成功！');
  if qbmt.Bof then
     memo1.Lines.Add('   BOF=true')
  else
     memo1.Lines.Add('   BOF=false');
  if qbmt.Eof then
     memo1.Lines.Add('   EOF=true')
  else
     memo1.Lines.Add('   EOF=false');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
  qbmt.ClearRecords;
  showtable;
  memo1.Lines.Add('清除所有记录成功！');
  if qbmt.Active then
     memo1.Lines.Add('    内存表仍然处于打开状态！')
  else
     memo1.Lines.Add('    内存表已处于关闭状态！');
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
  Stream:=TMemoryStream.Create;
  memo1.Lines.Add('BufferSize='+inttostr(qbmt.bufferSize));
  if qbmt.SaveToStream(stream) then
     memo1.Lines.Add('导出到流对象成功！Stream.Size='+inttostr(Stream.Size))
  else
     memo1.Lines.Add('导出到流对象失败！');
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
  if qbmt.LoadFromStream(stream) then
     begin
        ShowTable;
        memo1.Lines.Add('从流对象导入成功！');
     end
  else
     memo1.Lines.Add('从流对象导入失败！');
  memo1.Lines.Add('BufferSize='+inttostr(qbmt.bufferSize));
  FreeAndNil(Stream);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
  qbmt.First;
  memo1.Lines.Add('转首记录成功！RecNo='+inttostr(qbmt.RecNo));
  memo1.Lines.Add('              CustomerName='+qbmt.GetAsString('CustomerName'));
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
  qbmt.Prior;
  memo1.Lines.Add('回退记录成功！RecNo='+inttostr(qbmt.RecNo));
  memo1.Lines.Add('              CustomerName='+qbmt.GetAsString('CustomerName'));
end;
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if listview1.Selected=nil then
     exit;
  qbmt.RecNo:=listview1.Selected.Index;
  memo1.Lines.Add('定位记录成功！CustomerName='+qbmt.GetAsString('CustomerName'));
end;
procedure TForm1.qbmtTableClosed(Sender: TObject);
begin
  memo1.Lines.Add('*** 内存表关闭事件激发！');
end;
procedure TForm1.qbmtTableOpened(Sender: TObject);
begin
  memo1.Lines.Add('*** 内存表打开事件激发！');
end;
procedure TForm1.Button15Click(Sender: TObject);
begin
  close;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  qbmt.AddFieldDef('CustomerId',ftString,8);
  qbmt.AddFieldDef('CustomerName',ftString,48);
  qbmt.AddFieldDef('IsPersonal',ftBoolean,0);
  qbmt.AddFieldDef('Age',ftInteger,0);
  qbmt.AddFieldDef('Height',ftFloat,0);
  qbmt.AddFieldDef('Telephone',ftString,16);
  qbmt.AddFieldDef('CreateDate',ftDateTime,0);
  qbmt.Open;
  if qbmt.Active then
     memo1.Lines.Add('创建并打开内存表成功！')
  else
     memo1.Lines.Add('创建并打开内存表失败！');
  memo1.Lines.Add('    FieldCount='+inttostr(qbmt.FieldCount)+'  RecordCount='+inttostr(qbmt.RecordCount)+' RecordSize='+inttostr(qbmt.recordsize));
  showtable;
end;
end.

本帖子中包含更多资源

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

x
回复

使用道具 举报

wpy020327

该用户从未签到
 楼主| 发表于 2013-8-8 20:29:49 | 显示全部楼层
4、使用此数据集容器类的WinCE/WM应用开发示例：

//
// 运行带返回数据集的存储过程...
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;

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

zyx7742

该用户从未签到
发表于 2013-12-11 09:36:23 | 显示全部楼层
学习了
回复 支持 反对

使用道具 举报

heroical

该用户从未签到
发表于 2014-2-5 10:55:56 | 显示全部楼层
QB是楼主写的？不玩笑？
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-5-2 20:55 , Processed in 0.031716 second(s), 10 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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