菜单

Delphi数据库编程新手指南

2019年8月24日 - 4166am金沙下载

 第一节处理BLOBs(很大的二进制数据块),在Access中存储图片

unit
WebAdoStream;

 

现在的数据库应用程序不仅仅只需要处理文本或数字数据。例如,基于Interner/Intranet或多媒体的应用开发,就需要频繁的显示数据库中的文字以及图片。在这一章中,我们将了解怎样通过ADO取出并显示Access数据库中的图形数据(图像)。不用担心,即使它所需的数据库编程技巧已远超前面课程所学。

{****************************************************************

 

如果你是从本教程的开头部分学起(尤其是第二章),你就会知道怎样连接数据库,并在DBGrid中显示Applications表(来源于我们的aboutdelphi.mdb数据库)。记住我们用到的三个数据组件:DBGrid、ADOTable和DataSource。回到第一章,我们创建数据库时,将Applications表的最后一个字段留为了空(在用一些虚拟的数据填充数据库后)。其字段名为Picture,类型为OLE对象类型。

       
单元名称:WebAdoStream.pas

unit Unit1;

向右滚到DBGrid的最后一列,你将看到如图所示内容:

       
创建日期:2009-10-01

interface

 

       
创建者    本模块改编于 New Midas VCL Library(1.00)的JxStream.pas

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, DBCtrls, Grids, DBGrids, Db, ADODB,jpeg, StdCtrls,dbtables;
   {一定要USES JPEG单元,使能存储JPG文件格式}
type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    ADOQuery1: TADOQuery;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    Image1: TImage;
    savebutton: TButton;
    showbutton: TButton;
    OpenDialog1: TOpenDialog;
    ADOQuery1id: TIntegerField;
    ADOQuery1pic: TBlobField;
    procedure savebuttonClick(Sender: TObject);
    procedure showbuttonClick(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

使用MS
Access时,我们可以在一个OLE对象类型的字段中存储图像(以及其他大型数据对象,如声音视频等)。该类型的数据被视为Binary
Large Object Bitmap
(BLOB)大型二进制位图对象。在处理图像时,可使用多种类型的图片格式。最常用的有JPEG、GIF和BMP。其中JPEG已被网页设计者广泛采用,因其所需的存储空间很小(换句话说,JPEG比BMP要小很多)。当然,BMP、GIF以及JPEG等图形格式,Delphi都能处理。接下来,我们主要讲解JPEG文件格式的处理。

       
功能:     

var
  Form1: TForm1;

 

       
当前版本:

implementation

第二节 在Access中存储图片(Storing picturesin Access)

       
Email:dcopyboy@tom.com

{$R *.DFM}

 
在讨论如何在Delphi窗口中显示数据库表中的图像前,让我们先往数据库里增加一些图形数据。运行Access,打开aboutdelphi.mdb库。打开Applications表(应有一行数据)并选中Picture字段。

        QQ:445235526

function JpegStartsInBlob(PicField:TBlobField):integer;
   var
    ghy: TADOBlobstream;
    buffer:Word;
    hx: string;
   begin
    Result := -1;
    ghy := TADOBlobstream.Create(PicField, bmRead);
    try
     while (Result = -1) and (ghy.Position + 1 < ghy.Size) do
     begin
      ghy.ReadBuffer(buffer, 1);
      hx:=IntToHex(buffer, 2);
      if hx = ’FF’ then begin
       ghy.ReadBuffer(buffer, 1);
       hx:=IntToHex(buffer, 2);
      if hx = ’D8’ then Result := ghy.Position – 2
       else if hx = ’FF’ then
             ghy.Position := ghy.Position-1;
      end; //if
     end; //while
     finally
      ghy.Free
     end;  //try
   end;

 

 

procedure TForm1.savebuttonClick(Sender: TObject);
var
picstream:tadoblobstream;
begin
adoquery1.edit;
picstream:=tadoblobstream.Create(tblobfield(adoquery1.fields[1]),bmWrite);
if form1.opendialog1.execute then
begin
4166am金沙下载,picstream.LoadFromFile(opendialog1.filename);
picstream.Position:=0;
adoquery1.edit;
tblobfield(adoquery1.Fields[1]).loadfromstream(picstream);
adoquery1.post;
end;

 

***************************************************************}

end;

按下面的步骤增加图像:

interface

procedure TForm1.showbuttonClick(Sender: TObject);
var
ghy:TADOBlobstream;
pic:tjpegimage;
begin
ghy := TADOBlobstream.Create(Adoquery1pic, bmRead);
try
  ghy.Seek(JpegStartsInBlob(Adoquery1pic),soFromBeginning);
  Pic:=TJpegImage.Create;
  try
   Pic.LoadFromStream(ghy);
   Image1.Picture.Graphic:=Pic;
  finally
   Pic.Free;
  end;
finally
ghy.Free
end;
end;

1、  单击右键→插入对象→选择“由文件创建”;

 

procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
if button in [nbFirst, nbPrior, nbNext, nbLast] then showbutton.Click;
end;

 

uses Windows, Classes,
SysUtils, SqlTimSt, FMTBcd, Variants, db, adodb;

end.

 

 

如果数据库中要存储的是BMP文件,则在procedure TForm1.showbuttonClick(Sender: TObject);过程中代码更改如下即可存储显示BMP文件格式的操作。
procedure TForm1.showbuttonClick(Sender: TObject);
var
ghy:TADOBlobstream;
pic:tbitmap;
begin
ghy := TADOBlobstream.Create(Adoquery1pic, bmRead);
try
 { ghy.Seek(JpegStartsInBlob(Adoquery1pic),soFromBeginning);}
  Pic:=Tbitmap.Create;
  try
   Pic.LoadFromStream(ghy);
   Image1.Picture.Graphic:=Pic;
  finally
   Pic.Free;
  end;
finally
ghy.Free
end;
end;
  到此用DELPHI存取JPEG文件到SQL Server数据库中的具体操作已经叙述完毕。

2、点击“浏览”→出现一个浏览对话框选→找到你想插入的.jpg文件→确定→确定;

type

 

注:Picture字段的文本内容为一个可执行的、用于处理计算机上JPEG文件的名称。当然,在表格上你不会看见图片。若要查看图片,双击该字段,关联应用程序即会打开该JPG文件。

  // 存贮版本错误.

 
现在,我们数据库里有了图片,接下来让我们在Delphi窗体中显示它。使用第二章带有数据组件的Delphi窗体。

  EPersistVersion =
class(Exception);

 

  EPersistError =
class(Exception);

第三节  用DBImage引出JPEG —— 错误方法

  EClassNotFound =
class(EPersistError);

     DBImage ——思路(The DBImage – takeone)

  EWriterError =
class(EPersistError);

当试图使用Delphi做新的尝试时,首先想到向其自带帮助寻求办法。文档内容:TDBImage(组件面板的Data
Controls页)表示数据库当前记录中一个BLOB字段的图形图像。使用TDBImage表示图形字段值。TDBImage允许窗体显示数据库中的图形数据。TDBImage仅仅比TImage组件多了一些数据可视属性。其中最重要的两个属性是:DataSource(数据源)和Field(字段)。DataSource属性将图形组件连接到数据库。在我们的窗体上有一个名为DataSource1的DataSource组件——代表一个数据集。Field属性表示保存图像的字段(在表中)。

  EReaderError =
class(EPersistError);

一切都清楚了,现在,在窗体上放置一个DBImage组件并使用默认名DBImage1。为了真正的使DBImage与表的BLOB字段相连,需要做以下配置(使用Object
Inspector):

  //
Unicode编码类型.

 DBImage1.DataSource = DataSource1

  TStrTransferFormat = (tfUtf16LE,
tfUtf16BE, tfUtf8);

DBImage1.DataField = Picture

  // 数据写入(以小端格式写入)

为了显示储存在Applications表中Picture字段的JPEG图像,这是必要诀窍。

  TWAStreamWriter =
class

为了验证此配置是否可用,将ADOTable1组件的Active属性设为True(在Object
Inspector中)。一旦这样做,将出现以下错误提示框:

  private

 

    FStream: TStream;

为什么会显示“位图图像无效”呢?我们有JPEG图片而不是BMP图片——问题就在这么?让我们再看看帮助。

   
FTransferFormat: TStrTransferFormat; // 未用

    
通过查找帮助文档得出:①为了得到数据库里的JPG图片,我们需使用TJpegImage对象;②为了显示图片,需要简单、不可视版本的Image组件;③同时,还需使用流(Stream)从BLOB对象中载出图片。帮助文档叙述:应使用TADOBlobStream来访问或改变ADO数据集中BLOB或memo(备注)字段的值。

    procedure
Write7BitEncodedInt(value: LongInt);

 

    // 写入shortstring. 适用于写入ClassName, 因为这些属性以

第三节 用流引出JPEG—错误的方法

    //
ShortString存在, 如果转换为String再写入, 则多了构造

      引出JPEG—思路二(Pullingthe Jpeg – take two!)

    //
String的步骤, 速度较慢

     
既然不能使用DBImage——那从窗体中删除它并放一个普通的TImage组件(Additional页)命名为ADOImage。不幸的是,Image组件没有任何数据可视化属性,因此,需要一个单独的方法来显示数据库表中的图片。最简单的方法是:在窗体上添加一个Button组件,将程序代码放在其OnClick事件中,按钮名称为:“btnShowImage”。

    procedure WriteShortString(const
value: ShortString);

为了使用ADOBLOBStream,帮助文档建议创建一个TADOBlobStream实例,用“流”的方式从数据库中读取图形字段,然后释放BLOB流。在中间的某个地方,我们将需要用LoadFromStream方法从TADOBlobStream对象中载入JPEG图像。Image组件的Picture、Graphic属性将用于存储和显示图片。

  public

 字段对象,它是什么?

    property Stream: TStream read
FStream write FStream;

在Delphi数据库程序的开发中,主要对象之一就是TField对象。字段组件是表示运行(或设计)时的数据集字段的非可视化对象。TADOTable(和其他TDataSet子类)提供设计时对Fields
Editor(字段编辑器)的访问方法。Fields
Editor使你能选择数据集中你所想包含的字段。更重要的是,它创建了应用程序数据集中使用的字段组件的稳固的列表。为了调用Fields
Editor,可以双击TADOTable组件。默认情况下,字段列表是空的。点击Add按钮打开一个对话框,里面列出了Applications表的字段列表。缺省情况下,所有字段都被选择,然后选择OK。

    property TransferFormat:
TStrTransferFormat read FTransferFormat write
FTransferFormat;

     
Delphi会按如下的方式给出字段的默认名称:Table(表)名+Field(字段)名。这意味着我们的图片字段名为:ADOTable1Picture。

    procedure WriteBuffer(const
Buffer; Count: Longint);

     
TADOBlobStream的Create(创建)方法创建一个实例用于读或写一个指定的BLOB字段对象,在这里是ADOTable1Picture字段。

    procedure WriteShortInt(value:
ShortInt);

     
我们在btnShowImage按钮的OnClick事件中写入程序代码。该代码将从当前所选行的Picture字段中读取图片。源代码如下所示:

    procedure WriteSmallInt(value:
SmallInt);

[delphi] 
      uses jpeg; 
      … 
      procedure TForm1.btnShowImageClick(Sender:TObject); 
      var 
bS:TADOBlobStream; 
        Pic :TJpegImage; 
      begin 
        bS:= TADOBlobStream.Create(ADOTable1.fieldbyname(‘Picture’) as
TBlobField,bmRead); 
        try 
          Pic:=TJpegImage.Create; 
           try 
           <SPAN style=”WHITE-SPACE: pre”> 
</SPAN>Pic.LoadFromStream(bS); 
            <SPAN style=”WHITE-SPACE: pre”>
</SPAN>ADOImage.Picture.Graphic:=Pic; 
          finally 
           <SPAN style=”WHITE-SPACE: pre”> 
</SPAN>Pic.Free; 
          end; 
       finally 
         bS.Free 
       end; 
     end; 

    procedure WriteLongInt(value:
LongInt);

      uses jpeg;
      …
      procedure TForm1.btnShowImageClick(Sender:TObject);
      var
bS:TADOBlobStream;
        Pic :TJpegImage;
      begin
        bS:= TADOBlobStream.Create(ADOTable1.fieldbyname(‘Picture’) as
TBlobField,bmRead);
        try
          Pic:=TJpegImage.Create;
           try
            Pic.LoadFromStream(bS);
             ADOImage.Picture.Graphic:=Pic;
          finally
            Pic.Free;
          end;
       finally
         bS.Free
       end;
     end;
     
OK,让我们运行这个工程。当然,设置ADOTable1.Active属性为True。表单显示后,点击按钮,将出现下面的显示:

    procedure WriteInt64(value:
Int64);

 

    procedure WriteByte(value:
Byte);

 

    procedure WriteWord(value:
Word);

      呃,
怎么哪?代码百分之百的正确但为什么不显示图像呢!记住“永不放弃,永不投降”!让我们深入到字节水平看看到底发生了什么!

    procedure WriteLongWord(value:
LongWord);

 

    procedure WriteCurrency(value:
Currency);

 第四节  在BLOB中寻找JPEG的开端

    procedure WriteSingle(value:
Single);

      OLE对象类型格式—思路三(OLEobject type format – take three!)
     
现在我们需要做的是把图片存储到磁盘(存为普通的二进制文件)并了解它里面的内容是什么。

    procedure WriteDouble(value:
Double);

     
所有的图片文件(格式)都有用来作为唯一标识的文件头。JPG以所谓的SOI标记开始,该标记的十六进制值是$FFD8。

    procedure WriteBool(value:
Boolean);

下面一行代码存储Picture字段的值到工作目录的相关文件(BlobImage.dat)。在窗体的OnCreate事件中放置这条代码,开始工程以后再移除该代码。

    procedure WriteDateTime(value:
TDateTime);

     (ADOTable1.fieldbyname(‘Picture’)as
TBlobField).SaveToFile(‘.\BlobImage.dat’);

    procedure WriteAscii(value:
string);

      一旦我们有了这个文件。我们就可以使用Hex editor看它的内容。

    procedure WriteString(value:
string);

 

    procedure WriteOleString(value:
WideString);

 

    procedure WriteBinary(const
Buffer; Size: Integer);

     
MSAccess把连接的OLE对象的路径作为对象定义的一部分存储在OLE对象字段中。因为OLE对象的存储定义没有被文档化,所以没有办法知道真正的图像数据被写之前能得到什么。

    procedure WriteTimeStamp(const
ATimeStamp: TSqlTimeStamp);

     
分两部分考虑。第一:我们需要找到’FFD8’并从那儿开始读取图像。第二:’FFD8’不可能总在文件的同一个位置。结论:我们需要一个函数,返回Access数据库中存储为OLE对象的JPG文件的SOI标记的位置。

    procedure WriteFMTBcd(const ABcd:
TBcd);

      正确的方法—思路四(The correct way – take four!)

    procedure WriteVariant(const V:
Variant);

     
提供了Blob类型字段后,函数应返回ADOBlobStream中’FFD8’字符串的位置。ReadBuffer(读缓冲区)从流中一个字节一个字节的读取数据。对ReadBuffer的每个调用都会一个字节一个字节的移动流的位置。当两个字节一起引出SOI标记时,函数返回流的位置。函数:

    procedure WriteObjectProps(Obj:
TPersistent);

[delphi] 
functionJpegStartsInBlob(PicField:TBlobField):integer; 
var 
   bS     : TADOBlobStream; 
   buffer : Word; 
   hx     : string; 
begin 
 Result := -1; 
  bS:= TADOBlobStream.Create(PicField, bmRead); 
  try 
   while (Result = -1) and (bS.Position + 1 < bS.Size) do 
   begin 
     bS.ReadBuffer(buffer, 1); 
     hx:=IntToHex(buffer, 2); 
     if hx = ‘FF’ then 
     begin 
      bS.ReadBuffer(buffer, 1); 
      hx:=IntToHex(buffer, 2); 
      if hx = ‘D8’ then 
        Result := bS.Position – 2 
      else if hx = ‘FF’ then 
        bS.Position := bS.Position-1; 
     end; //if  
   end; //while  
 finally 
   bS.Free 
 end; //try  
end; 

  end;

functionJpegStartsInBlob(PicField:TBlobField):integer;
var
   bS     : TADOBlobStream;
   buffer : Word;
   hx     : string;
begin
 Result := -1;
  bS:= TADOBlobStream.Create(PicField, bmRead);
  try
   while (Result = -1) and (bS.Position + 1 < bS.Size) do
   begin
     bS.ReadBuffer(buffer, 1);
     hx:=IntToHex(buffer, 2);
     if hx = ‘FF’ then
     begin
      bS.ReadBuffer(buffer, 1);
      hx:=IntToHex(buffer, 2);
      if hx = ‘D8’ then
        Result := bS.Position – 2
      else if hx = ‘FF’ then
        bS.Position := bS.Position-1;
     end; //if
   end; //while
 finally
   bS.Free
 end; //try
end;
   一旦有了SOI标记的位置信息,就能在ADOBlob流中找到图片的位置。

 

[delphi] 
     uses jpeg; 
     … 
procedure TForm1.btnShowImageClick(Sender:TObject); 
var 
 bS  : TADOBlobStream; 
  Pic: TJpegImage; 
  x :integer; 
begin 
  bS:= TADOBlobStream.Create(ADOTable1.fieldbyname(‘Picture’) as
TBlobField,bmRead); 
  try 
    x:= JpegStartsInBlob(ADOTable1.fieldbyname(‘Picture’) as
TBlobField); 
   bS.Seek(x, soFromBeginning); 
   Pic:=TJpegImage.Create; 
   try 
    Pic.LoadFromStream(bS); 
    ADOImage.Picture.Graphic:=Pic; 
   finally 
    Pic.Free; 
   end; 
 finally 
   bS.Free 
 end; 
end; 

  // 数据读取(以小端读取)

     uses jpeg;
     …
procedure TForm1.btnShowImageClick(Sender:TObject);
var
 bS  : TADOBlobStream;
  Pic: TJpegImage;
  x :integer;
begin
  bS:= TADOBlobStream.Create(ADOTable1.fieldbyname(‘Picture’) as
TBlobField,bmRead);
  try
    x:= JpegStartsInBlob(ADOTable1.fieldbyname(‘Picture’) as
TBlobField);
   bS.Seek(x, soFromBeginning);
   Pic:=TJpegImage.Create;
   try
    Pic.LoadFromStream(bS);
    ADOImage.Picture.Graphic:=Pic;
   finally
    Pic.Free;
   end;
 finally
   bS.Free
 end;
end;
运行工程,OK!

  TWAStreamReader =
class

 

  private

 

    FStream: TStream;

   现在谁会说编程没有趣味?

    FTransferFormat:
TStrTransferFormat;

     
注:在真正的代码程序中,我们会在TDataSet的AfterScroll事件中加入代码用于从当前行中读取和显示图像(它在ADOTable1AfterScroll事件过程中)。当应用程序从一个记录滚到另一个时,AfterScroll事件发生。

    function Read7BitEncodedInt:
LongInt;

    思路五!

    function ReadShortString:
string;

   
这就是本章的主要内容。现在你可以存储和显示所有你感兴趣的JPG图片。在这篇文章的最后一页,我会提供完整的代码(form1单元);所有的数据安排都放在表单的OnCreate事件中。这确保了所有的三个组件被正确连接—在设计时你不需要使用Object
Inspector(对象检视器)。

  public

   
我承认,这一章不适合初学者,但世界是残酷的!另一件事:你注意到最后你都不知道怎样改变(或增加一些新的)表中的图片!是的,那又是另一个完整的故事了!

    property Stream: TStream read
FStream write FStream;

 

    property TransferFormat:
TStrTransferFormat read FTransferFormat write
FTransferFormat;

 

    procedure ReadBuffer(var Buffer;
Count: Longint);

现在的数据库应用程序不仅仅只需要处理文本或数字数据。例如,基于Intern…

    function ReadShortInt:
ShortInt;

    function ReadSmallInt:
SmallInt;

    function ReadLongInt:
LongInt;

    function ReadInt64:
Int64;

    function ReadByte:
Byte;

    function ReadWord:
Word;

    function ReadLongWord:
LongWord;

    function ReadCurrency:
Currency;

    function ReadSingle:
Single;

    function ReadDouble:
Double;

    function ReadBool:
Boolean;

    function ReadDateTime:
TDateTime;

    // 读取ASCII字符串, 长度<=255, 多则截断.

    function ReadAscii(len: Byte):
string;

    function ReadString:
string;

    function ReadOleString:
WideString;

    function ReadBinary:
string;

    function ReadStream:
TStream;

    procedure ReadTimeStamp(var
ATimeStamp: TSqlTimeStamp);

    procedure ReadFMTBcd(var ABcd:
TBcd);

    function ReadVariant:
Variant;

    procedure ReadObjectProps(Obj:
TPersistent);

  end;

function
AdoQuerySaveTostream(Adoq: Tadoquery): TMemoryStream;

function
AdoQueryLoadFromstream(Adoq: Tadoquery; Stream: TMemoryStream):
boolean;

 

implementation

uses TypInfo;

 

resourcestring

 
SInvalidVariantType = ‘无效的Variant类型 %d’;

  SClassNotFound = ‘class %s not
found.’;

  SWriterError = ‘Stream write
error.’;

  SReaderError = ‘Stream read
error.’;

  SPersistClassError = ‘Persistable
class not supported.’;

  SPersistTypeNotSupported = ‘Type %s
not supported’;

 

type

  PIntArray =
^TIntArray;

  TIntArray = array[0..0] of
Integer;

 

const

  SimpleArrayTypes = [varSmallInt,
varInteger, varSingle, varDouble, varCurrency,

    varDate, varBoolean, varShortInt,
varByte, varWord, varLongWord];

 

  VariantSize: array[0..varLongWord]
of Word = (0, 0, SizeOf(SmallInt), SizeOf(Integer),

    SizeOf(Single), SizeOf(Double),
SizeOf(Currency), SizeOf(TDateTime), 0, 0,

    SizeOf(Integer), SizeOf(WordBool),
0, 0, 0, 0, SizeOf(ShortInt), SizeOf(Byte),

    SizeOf(Word),
SizeOf(LongWord));

 

  CMinVarType = $100;

  StreamFMTBcdID = CMinVarType +
1;

  StreamSQLTimeStampID = CMinVarType +
2;

 

 

{ TWAStreamWriter
}

 

procedure
TWAStreamWriter.Write7BitEncodedInt(value: Integer);

begin

  while value > $80
do

  begin

    WriteByte(Byte(value or
$80));

    value := value shr
7;

  end;

  WriteByte(value and
$FF);

end;

 

procedure
TWAStreamWriter.WriteAscii(value: string);

var

  len: Integer;

begin

  len := Length(value);

  if len > 255 then

    len := 255;

  if len > 0 then
WriteBuffer(PChar(value)^, len);

end;

 

procedure
TWAStreamWriter.WriteBinary(const Buffer; Size: Integer);

begin

 
Write7BitEncodedInt(Size);

  WriteBuffer(Buffer,
Size);

end;

 

procedure
TWAStreamWriter.WriteBool(value: Boolean);

begin

  if value then

    WriteByte(1)

  else

    WriteByte(0);

end;

 

procedure
TWAStreamWriter.WriteBuffer(const Buffer; Count: Integer);

begin

  if (Count <> 0) and
(Stream.Write(Buffer, Count) <> Count) then

    raise
EWriterError.Create(SWriterError);

end;

 

procedure
TWAStreamWriter.WriteByte(value: Byte);

begin

  WriteBuffer(value, 1);

end;

 

procedure
TWAStreamWriter.WriteCurrency(value: Currency);

begin

//  h2n_Data8(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteDateTime(value: TDateTime);

begin

//  h2n_Data8(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteDouble(value: Double);

begin

//  h2n_Data8(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteFMTBcd(const ABcd: TBcd);

begin

  with ABcd do

  begin

   
WriteByte(Precision);

   
WriteByte(SignSpecialPlaces);

    WriteBuffer(Fraction,
SizeOf(Fraction));

  end;

end;

 

procedure
TWAStreamWriter.WriteInt64(value: Int64);

begin

//  h2n_Data8(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteLongInt(value: Integer);

begin

//  h2n_Data4(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteLongWord(value: LongWord);

begin

//  h2n_Data4(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteObjectProps(Obj: TPersistent);

  procedure WriteCollection(Coll:
TCollection);

  var

    I: Integer;

  begin

   
WriteObjectProps(Coll);

   
WriteLongInt(Coll.Count);

    for I := 0 to Coll.Count – 1
do

     
WriteObjectProps(Coll.Items[I]);

  end;

 

var

  TypData: PTypeData;

  PropCount, I, OrdVal:
Integer;

  Int64Val: Int64;

  DblVal: Double;

  StrVal: string;

  ObjVal: TObject;

  WVal: WideString;

  VarVal: Variant;

  Props: PPropList;

  PropInfo: PPropInfo;

begin

  TypData :=
GetTypeData(Obj.ClassInfo);

  if TypData <> nil
then

  begin

    PropCount :=
TypData.PropCount;

    if PropCount > 0
then

    begin

      GetMem(Props, PropCount *
SizeOf(PPropInfo));

      try

        PropCount :=
GetPropList(PTypeInfo(Obj.ClassInfo), tkProperties,
Props);

 

        for I := 0 to PropCount – 1
do

        begin

          PropInfo :=
Props^[I];

          with PropInfo^
do

          begin

            case PropType^.Kind
of

              tkInteger:

                begin

                  OrdVal :=
GetOrdProp(Obj, PropInfo);

                 
WriteLongInt(OrdVal);

//                  case
GetTypeData(PropType^).OrdType of

//                    otSByte, otUByte:
WriteByte(OrdVal);

//                    otSWord, otUWord:
WriteWord(OrdVal);

//                    otSLong, otULong:
WriteLongInt(OrdVal);

//                  end;

                end;

 

              tkInt64:

                begin

                  Int64Val :=
GetInt64Prop(Obj, PropInfo);

                 
WriteInt64(Int64Val);

                end;

 

             
tkEnumeration:

                begin

                  OrdVal :=
GetOrdProp(Obj, PropInfo);

                 
WriteByte(OrdVal);

                end;

 

              tkFloat:

                begin

                  DblVal :=
GetFloatProp(Obj, PropInfo);

                 
WriteDouble(DblVal);

                end;

 

              tkLString,

               
tkString:

                begin

                  StrVal :=
GetStrProp(Obj, PropInfo);

                 
WriteString(StrVal);

                end;

 

              tkWString:

                begin

                  WVal :=
GetWideStrProp(Obj, PropInfo);

                 
WriteOleString(WVal);

                end;

 

              tkClass:

                begin

                  ObjVal :=
GetObjectProp(Obj, PropInfo);

                  if ObjVal is
TStrings then

                   
WriteString(TStrings(ObjVal).CommaText)

                  else if ObjVal is
TCollection then

                   
WriteCollection(TCollection(ObjVal))

                  else if ObjVal is
TPersistent then

                   
WriteObjectProps(TPersistent(ObjVal))

                  else

                    raise
EPersistError.Create(SPersistClassError);

                end;

 

              tkSet:

                begin

                  OrdVal :=
GetOrdProp(Obj, PropInfo);

                 
WriteLongInt(OrdVal);

                end;

 

              tkChar:

                begin

                  OrdVal :=
GetOrdProp(Obj, PropInfo);

                 
WriteByte(OrdVal);

                end;

 

              tkWChar:

                begin

                  OrdVal :=
GetOrdProp(Obj, PropInfo);

                 
WriteSmallInt(OrdVal);

                end;

 

              tkVariant:

                begin

                  VarVal :=
TypInfo.GetVariantProp(Obj, PropInfo);

                 
WriteVariant(VarVal);

                end;

 

             
tkDynArray:

                begin

                  TypData :=
GetTypeData(PropInfo.PropType^);

                  assert(TypData
<> nil);

                end;

            else

              raise
EPersistError.CreateFmt(SPersistTypeNotSupported,

               
[GetEnumName(TypeInfo(TTypeKind),
Ord(PropInfo.PropType^.Kind))]);

                {

                tkArray,

               
tkRecord,

               
tkMethod,

               
tkInterface,

               
tkDynArray

                }

            end; // case

          end; // with

        end; // for

      finally

        FreeMem(Props, PropCount *
SizeOf(PPropInfo));

      end;

    end;

  end;

end;

 

procedure
TWAStreamWriter.WriteOleString(value: WideString);

var

  S: string;

  len: Integer;

begin

  S :=
Utf8Encode(value);

  len := Length(S);

 
Write7BitEncodedInt(len);

  if len > 0 then

    WriteBuffer(PChar(S)^,
len);

end;

 

procedure
TWAStreamWriter.WriteShortInt(value: ShortInt);

begin

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteShortString(const value:
ShortString);

begin

 
WriteByte(Length(value));

  WriteBuffer(value[1],
Length(value));

end;

 

procedure
TWAStreamWriter.WriteSingle(value: Single);

begin

//  h2n_Data4(value);

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteSmallInt(value: SmallInt);

begin

//  value :=
Word(h2n_Word(Word(value)));

  WriteBuffer(value,
SizeOf(value));

end;

 

procedure
TWAStreamWriter.WriteString(value: string);

var

  S: string;

  len: Integer;

begin

  S :=
AnsiToUtf8(value);

  len := Length(S);

 
Write7BitEncodedInt(len);

  if len > 0 then

    WriteBuffer(PChar(S)^,
len);

end;

相关文章

发表评论

电子邮件地址不会被公开。 必填项已用*标注

网站地图xml地图