20.Delphi对象式数据管理功能


======================================================
注:本文源代码点此下载
======================================================

面向对象技术是九十年代的主流技术,各类应用软件如果以面向对象的方法构造并且渗透面向对象的风格将使软件具有更高的品质。在面向对象程序设计中,对象式数据管理占有很重要的地位。在delphi中,对对象式数据管理的支持方式是其一大特色。

delphi是一个面向对象的可视化设计与面向对象的语言相结合的集成开发环境。delphi的核心是部件。部件是对象的一种。delphi应用程序完全是由部件来构造的,因此开发高性能的delphi应用程序必然会涉及对象式数据管理技术。

对象式数据管理包括两方面的内容:

● 用对象来管理数据

● 对各类数据对象(包括对象和部件)的管理

delphi在这两方面都做的相当出色。在delphi的早期版本turbo pascal 中就曾有流(stream)、群(collection)和资源(resource)等专门用于对象式数据管理的类。在delphi中,这些功能得到了大大的加强。delphi将对象式数据管理类归结为stream对象(stream)和filer对象(filer),并将它们应用于可视部件类库(vcl)的方方面面。它们不仅提供了在内存、外存和windows资源中管理对象的功能,还提供了在数据库blob字段中对象的功能。

在本章中将介绍stream对象和filer对象的实现原理、应用方法以及在超媒体系统中的应用。这对于运用delphi 开发高级应用是很重要的。

20.1 流式对象的实现原理和应用

stream对象,又称流式对象,是tstream、thandlestream、tfilestream、tmemorystream、tresourcestream和tblobstream等的统称。它们分别代表了在各种媒介上存储数据的能力,它们将各种数据类型(包括对象和部件) 在内存、外存和数据库字段中的管理操作抽象为对象方法,并且充分利用了面向对象技术的优点,应用程序可以相当容易地在各种stream对象中拷贝数据。

下面介绍各种对象的数据和方法及使用方法。

20.1.1 tstream对象

tstream对象是能在各种媒介中存储二进制数据的对象的抽象对象。从tstream 对象继承的对象用于在内存、windows资源文件、磁盘文件和数据库字段等媒介中存储数据。

tstream中定义了两个属性:size和position。它们分别以字节为单位表示的流的大小和当前指针位置。tstream中定义的方法用于在各种流中读、写和相互拷贝二进制数据。因为所有的stream对象都是从tstream中继承来的,所以在tstream中定义的域和方法都能被stream对象调用和访问。此外,又由于面向对象技术的动态联编功能,tstream为各种流的应用提供了统一的接口,简化了流的使用;不同stream对象是抽象了对不同存储媒介的数据上的操作,因此,tstream的需方法为在不同媒介间的数据拷贝提供了最简捷的手段。

20.1.1.1 tstream的属性和方法

1. position属性

声明:property position: longint;

position属性指明流中读写的当前偏移量。

2. size属性

声明:property size: longint;

size属性指明了以字节为单位的流的的大小,它是只读的。

3. copyfrom方法

声明:function copyfrom(source: tstream; count: longint): longint;

copyfrom从source所指定的流中拷贝count个字节到当前流中, 并将指针从当前位置移动count个字节数,函数返回值是实际拷贝的字节数。

4. read方法

声明:function read(var buffer; count: longint): longint; virtual; abstract;

read方法从当前流中的当前位置起将count个字节的内容复制到buffer中,并把当前指针向后移动count个字节数,函数返回值是实际读的字节数。如果返回值小于count,这意味着读操作在读满所需字节数前指针已经到达了流的尾部。

read方法是抽象方法。每个后继stream对象都要根据自己特有的有关特定存储媒介的读操作覆盖该方法。而且流的所有其它的读数据的方法(如:readbuffer,readcomponent等)在完成实际的读操作时都调用了read方法。面向对象的动态联编的优点就体现在这儿。因为后继stream对象只需覆盖read方法,而其它读操作(如readbuffer、readcomponent等)都不需要重新定义,而且tstream还提供了统一的接口。

5. readbuffer方法

声明:procedure readbuffer(var buffer; count: longint);

readbuffer方法从流中将count个字节复制到buffer 中, 并将流的当前指针向后移动count个字节。如读操作超过流的尾部,readbuffer方法引起ereaderror异常事件。

6. readcomponent方法

声明:function readcomponent(instance: tcomponent): tcomponent;

readcomponent方法从当前流中读取由instance所指定的部件,函数返回所读的部件。readcomponent在读instance及其拥有的所有对象时创建了一个reader对象并调用它的readrootcomponent方法。

如果instance为nil,readcomponent的方法基于流中描述的部件类型信息创建部件,并返回新创建的部件。

7. readcomponentres方法

声明:function readcomponentres(instance: tcomponent): tcomponent;

readcomponentres方法从流中读取instance指定的部件,但是流的当前位置必须是由writecomponentres方法所写入的部件的位置。

readcomponentres 首先调用readresheader方法从流中读取资源头,然后调用readcomponent方法读取instance。如果流的当前位置不包含一个资源头。readresheader将引发一个einvalidimage异常事件。在classes库单元中也包含一个名为readcomponentres的函数,该函数执行相同的操作,只不过它基于应用程序包含的资源建立自己的流。

8. readresheader方法

声明:procedure readresheader;

readresheader方法从流的当前位置读取windows资源文件头,并将流的当前位置指针移到该文件头的尾部。如果流不包含一个有效的资源文件头,readresheader将引发一个einvalidimage异常事件。

流的readcomponentres方法在从资源文件中读取部件之前,会自动调用readresheader方法,因此,通常程序员通常不需要自己调用它。

9. seek方法

声明:function seek(offset: longint; origin: word): longint; virtual; abstract;

seek方法将流的当前指针移动offset个字节,字节移动的起点由origin指定。如果offset是负数,seek方法将从所描述的起点往流的头部移动。下表中列出了origin的不同取值和它们的含义:

表20.1 函数seek的参数的取值

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

常量值seek的起点 offset的取值

─────────────────────────────────

sofrombeginning 0流的开头 正 数

sofromcurrent 1 流的当前位置 正数或负数

sofromend 2 流的结尾 负 数

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

10. write方法

在delphi对象式管理的对象中有两类对象的方法都有称为write的:stream对象和filer对象。stream对象的write方法将数据写进流中。filer对象通过相关的流传递数据,在后文中会介绍这类方法。

stream对象的write方法声明如下:

function write(const buffer; count: longint): longint; virtual; abstract;

write方法将buffer中的count个字节写入流中,并将当前位置指针向流的尾部移动count个字节,函数返回写入的字节数。

tstream的write方法是抽象的,每个继承的stream对象都要通过覆盖该方法来提供向特定存储媒介(内存、磁盘文件等)写数据的特定方法。流的其它所有写数据的方法(如writebuffer、writecomponent)都调用write担当实际的写操作。

11. writebuffer方法

声明:procedure writebuffer(const buffer; count: longint);

writebuffer的功能与write相似。writebuffer方法调用write来执行实际的写操作,如果流没能写所有字节,writebuffer会触发一个ewriteerror异常事件。

12. writecomponent方法

在stream对象和filer对象都有被称为writecomponent的方法。stream对象的writecomponent方法将instance所指定的部件和它所包含的所有部件都写入流中;writer对象的writecomponent将指定部件的属性值写入writer对象的流中。

stream对象的writecomponent方法声明是这样的:

procedure writecomponent(instance: tcomponent);

writecomponent创建一个writer对象,并调用writer的writerootcomponent方法将instance及其拥有的对象写入流。

13. writecomponentres方法

声明:writecomponentres(const resname: string; instance: tcomponent);

writecomponentres方法首先往流中写入标准windows 资源文件头,然后将instance指定的部件写入流中。要读由writecomponentres写入的部件,必须调用readcomponentres方法。

writecomponentres使用resname传入的字符串作为资源文件头的资源名,然后调用writecomponent方法将instance和它拥有的部件写入流。

14. writedescendant方法

声明:procedure writedescendant(instance ancestor: tcomponent);

stream对象的writedescendant方法创建一个writer对象,然后调入该对象的writedescendant方法将instance部件写入流中。instance可以是从ancestor部件继承的窗体,也可以是在从祖先窗体中继承的窗体中相应于祖先窗体中ancestor部件的部件。

15. writedescendantres方法

声明:procedure writedescendantres(const resname: string;

instance, ancestor: tcomponent);

writedescendantres方法将windows资源文件头写入流,并使用resname作用资源名,然后调用writedescendant方法,将instance写入流。

20.1.1.2 tstream的实现原理

tstream对象是stream对象的基础类,这是stream对象的基础。为了能在不同媒介上的存储数据对象,后继的stream对象主要是在read和write方法上做了改进,。因此,了解tstream是掌握stream对象管理的核心。borland公司虽然提供了stream对象的接口说明文档,但对于其实现和应用方法却没有提及,笔者是从borland delphi 2.0 client/server suite 提供的源代码和部分例子程序中掌握了流式对象技术。

下面就从tstream的属性和方法的实现开始。

1. tstream属性的实现

前面介绍过,tstream具有position和size两个属性,作为抽象数据类型,它抽象了在各种存储媒介中读写数据所需要经常访问的域。那么它们是怎样实现的呢?

在自定义部件编写这一章中介绍过部件属性定义中的读写控制。position和size也作了读写控制。定义如下:

property position: longint read getposition write setposition;

property size: longint read getsize;

由上可知,position是可读写属性,而size是只读的。

position属性的实现就体现在getposition和setposition。当在程序运行过程中,任何读取position的值和给position赋值的操作都会自动触发私有方法getposition和setposition。两个方法的声明如下:

function tstream.getposition: longint;

begin

result := seek(0, 1);

end;

procedure tstream.setposition(pos: longint);

begin

seek(pos, 0);

end;

在设置位置时,delphi编译机制会自动将position传为pos。

前面介绍过seek的使用方法,第一参数是移动偏移量,第二个参数是移动的起点,返回值是移动后的指针位置。

size属性的实现只有读控制,完全屏蔽了写操作。读控制方法getsize实现如下:

function tstream.getsize: longint;

var

pos: longint;

begin

pos := seek(0, 1);

result := seek(0, 2);

seek(pos, 0);

end;

2. tstream方法的实现

⑴ copyfrom方法

copyfrom是stream对象中很有用的方法,它用于在不同存储媒介中拷贝数据。例如,内存与外部文件之间、内存与数据库字段之间等。它简化了许多内存分配、文件打开和读写等的细节,将所有拷贝操作都统一到stream对象上。

前面曾介绍:copyfrom方法带source和count两个参数并返回长整型。该方法将count个字节的内容从source拷贝到当前流中,如果count值为0则拷贝所有数据。

function tstream.copyfrom(source: tstream; count: longint): longint;

const

maxbufsize = $f000;

var

bufsize, n: integer;

buffer: pchar;

begin

if count = 0 then

begin

source.position := 0;

coung="zh-cn">资源文件中的部件时调用,通常程序员不需自己调用。如果读取的不是资源文件readresheader,将触发异常事件。

procedure tstream.readresheader;

var

readcount: longint;

header: array[0..79] of char;

begin

fillchar(header, sizeof(header), 0);

readcount := read(header, sizeof(header) - 1);

if (byte((@header[0])^) = $ff) and (word((@header[1])^) = 10) then

seek(strlen(header + 3) + 10 - readcount, 1)

else

raise einvalidimage.createres(sinvalidimage);

end;

readcomponentres在windows资源文件中读取部件,为了判断是否是资源文件,它首先调用readresheader方法,然后调用readcomponent方法读取instance指定的部件。下面是它的实现:

function tstream.readcomponentres(instance: tcomponent): tcomponent;

begin

readresheader;

result := readcomponent(instance);

end;

与readcomponentres相应的写方法是writecomponentres,delphi 调用这两个方法读写窗体文件(dfm文件),在后面书中会举用这两个方法读取dfm文件的例子。

⑷ writecomponent和writedescendant方法

stream对象的writedescendant方法在实现过程中,创建了twriter对象,然后利用twriter的writedescendant方法将instance写入流。而writecomponent方法只是简单地调用writedescendant方法将instance写入流。它们的实现如下:

procedure tstream.writecomponent(instance: tcomponent);

begin

writedescendent(instance, nil);

end;

procedure tstream.writedescendent(instance, ancestor: tcomponent);

var

writer: twriter;

begin

writer := twriter.create(self, 4096);

try

writer.writedescendent(instance, ancestor);

finally

writer.free;

end;

end;

⑸ writedescendantres和writecomponentres方法

writedescendantres方法用于将部件写入windows资源文件;而writecomponentres 方法只是简单地调用writedescendantres方法,它们的实现如下:

procedure tstream.writecomponentres(const resname: string; instance:

tcomponent);

begin

writedescendentres(resname, instance, nil);

end;

procedure tstream.writedescendentres(const resname: string; instance,

ancestor: tcomponent);

var

headersize: integer;

origin, imagesize: longint;

header: array[0..79] of char;

begin

byte((@header[0])^) := $ff;

word((@header[1])^) := 10;

headersize := strlen(strupper(strplcopy(@header[3], resname, 63))) + 10;

word((@header[headersize - 6])^) := $1030;

longint((@header[headersize - 4])^) := 0;

writebuffer(header, headersize);

origin := position;

writedescendent(instance, ancestor);

imagesize := position - origin;

position := origin - 4;

writebuffer(imagesize, sizeof(longint));

position := origin + imagesize;

end;

writecompnentres是与readcomponentres相应的对象写方法,这两个方法相互配合可读取delphi的dfm文件,从而利用delphi系统的功能。

20.1.2 thandlestream对象

thandlestream对象的行为特别象filestream对象,所不同的是它通过已创建的文件句柄而不是文件名来存储流中的数据。

thandlestream对象定义了handle属性,该属性提供了对文件句柄的只读访问,并且handle属性可以作为delphi的rtl文件管理函数的参数,利用文件类函数来读写数据。thandlestream覆盖了构造函数create,该函数带有handle 参数,该参数指定与thandlestream对象相关的文件句柄。

20.1.2.1 thandlestream的属性的方法:

1. handle属性

声明:property handle: integer;

handle属性提供了对文件句柄的只读访问,该句柄由thandlestream的构造方法create传入。因此除了用thandlestream提供的方法外,也可以用文件管理函数对句柄进行操作。实际上,thandlestream的方法在实现上也是运用文件管理函数进行实际的读写操作。

2. create方法

声明:constructor create(ahandle: integer);

create方法使用传入的handle参数创建一个与特定文件句柄相联的thandlestream对象,并且将ahandle赋给流的handle属性。

3. read、write和seek方法

这三个方法是tstream的虚方法,只是在thandlestream 中覆盖了这三个方法,以实现特定媒介──文件的数据存取。后面会详细介绍这三个方法的实现。

20.1.2.2 thandlestream的实现原理

thandlestream是从tstream继承来的,因此可以共用tstream中的属性和大多数方法。thandlestream在实现上主要是增加了一个属性handle和覆盖了create、read、write和seek四个方法。

1. 属性的实现

handle属性的实现正如delphi大多数属性的实现那样,先在对象定义的private部分声明一个存放数据的变量fhandle,然后在定义的public部分声明属性handle,其中属性定义的读写控制部分加上只读控制,读控制只是直接读取fhandle变量的值,其实现如下:

thandlestream = class(tstream)

private

fhandle: integer;

public

property handle: integer read fhandle;

end;

2. 方法的实现

thandlestream的create方法,以ahandle作为参数,在方法里面只是简单的将ahandle的值赋给fhandle,其实现如下:

constructor thandlestream.create(ahandle: integer);

begin

fhandle := ahandle;

end;

为实现针对文件的数据对象存储,thandlestream的read、write和seek方法覆盖了tstream中的相应方法。它们的实现都调用了windows的文件管理函数。

read方法调用fileread函数实现文件读操作,其实现如下:

function thandlestream.read(var buffer; count: longint): longint;

begin

result := fileread(fhandle, buffer, count);

if result = -1 then result := 0;

end;

write方法调用filewrite函数实现文件写操作,其实现如下:

function thandlestream.write(const buffer; count: longint): longint;

begin

result := filewrite(fhandle, buffer, count);

if result = -1 then result := 0;

end;

seek方法调用fileseek函数实现文件指针的移动,其实现如下:

function thandlestream.seek(offset: longint; origin: word): longint;

begin

result := fileseek(fhandle, offset, origin);

end;

20.1.3 tfilestream对象

tfilestream对象是在磁盘文件上存储数据的stream对象。tfilestream是从thandlestream继承下来的,它和thandlestream一样都是实现文件的存取操作。不同之处在于thandlestream用句柄访问文件,而tfilestream用文件名访问文件。实际上tfilestream是thandlestream上的一层包装,其内核是thandlestream的属性和方法。

tfilestream中没有增加新的属性和方法。它只是覆盖了的构造方法create和析构方法destory。在create方法中带两个参数filename和mode。filename描述要创建或打开的文件名,而mode描述文件模式如fmcreate、fmopenread和fmopenwrite等。create方法首先使用filecreate或fileopen函数创建或打开名为filename的文件,再将得到的文件句柄赋给fhandle。tfilestream的文件读写操作都是由从thandlestream继承的read

var

stream: tstream;

begin

stream := tfilestream.create(filename, fmcreate);

try

savetostream(stream);

finally

stream.free;

end;

end;

在delphi 的许多对象的savetostream 和savetofile、loadfromstream和loadfromfile方法的实现都有类似的嵌套结构。

20.1.5 tmemorystream对象

tmemorystream对象是一个管理动态内存中的数据的stream对象,它是从tcustommemorystream中继承下来的,除了从tcustommemorystream中继承的属性和方法外,它还增加和覆盖了一些用于从磁盘文件和其它注台读数据的方法。它还提供了写入、消除内存内容的动态内存管理方法。下面介绍它的这些属性和方法。

20.1.5.1 tmemorystream的属性和方法

1. capacity属性

声明:property copacity: longint;

capacity属性决定了分配给内存流的内存池的大小。这与size属性有些不同。size属性是描述流中数据的大小。在程序中可以将capacity 的值设置的比数据所需最大内存大一些,这样可以避免频繁地重新分配。

2. realloc方法

声明:function realloc(var newcapacity: longint): pointer; virtual;

realloc方法,以8k为单位分配动态内存,内存的大小由newcapacity指定,函数返回指向所分配内存的指针。

3. setsize方法

setsize方法消除内存流中包含的数据,并将内存流中内存池的大小设为size字节。如果size为零,是setsize方法将释放已有的内存池,并将memory属性置为nil;否则,setsize方法将内存池大小调整为size。

4. clear方法

声明:procedure clear;

clear方法释放内存中的内存池,并将memory属性置为nil。在调用clear方法后,size和position属性都为0。

5. loadfromstream方法

声明:procedure loadfromstream(stream: tstream);

loadfromstream方法将stream指定的流中的全部内容复制到memorystream中,复制过程将取代已有内容,使memorystream成为stream的一份拷贝。

6. loadfromfile方法

声明:procedure loadfromfile(count filename: string);

loadfromfile方法将filename指定文件的所有内容复制到memorystream中,并取代已有内容。调用loadfromfile方法后,memorystream将成为文件内容在内存中的完整拷贝。

20.1.5.2 tmemorystream对象的实现原理

tmemorystream从tcustommemorystream对象直接继承,因此可以享用tcustommemorystream的属性和方法。前面讲过,tcustommemorystream是用于内存中数据操作的抽象对象,它为memorystream对象的实现提供了框架,框架中的内容还要由具体memorystream对象去填充。tmemorystream对象就是按动态内存管理的需要填充框架中的具体内容。下面介绍tmemorystream对象的实现。

1. tmemorystream属性的实现

tmemorystream在其protected部分增加了一个capacity属性,该属性决定了memorystream所占动态内存的大小。tmemorystream首先在private部分声明了fcapacity变量作为存储capacity属性值的数据域,然后在protected部分声明了该属性。在属性声明的读控制部分简单读取fcapacity的值,在写控制处调用了方法setcapacity。该方法除了给fcapacity赋值外还执行了修改capacity属性所必需操作如状态改变等。

下面是属性的实现:

tmemorystream = class(tcustommemorystream)

private

fcapacity: longint;

procedure setcapacity(newcapacity: longint);

protected

property capacity: longint read fcapacity write setcapacity;

public

end;

写控制方法setcapacity的实现是这样的:

procedure tmemorystream.setcapacity(newcapacity: longint);

begin

setpointer(realloc(newcapacity), fsize);

fcapacity := newcapacity;

end;

在setcapacity 方法先是调用realloc重新分配内存,然后用newcapacity的值给fcapacity赋值。realloc方法进行某些对象状态的改变。

2. tmemorystream对象方法的实现

⑴ realloc方法

realloc方法是tmemorystream动态内存分配的核心,它的setsize、setcapacity等方法最终都是调用realloc进行内存的分配和初始化工作的。它的实现如下:

const

memorydelta = $2000;

function tmemorystream.realloc(var newcapacity: longint): pointer;

begin

if newcapacity > 0 then

newcapacity := (newcapacity + (memorydelta - 1)) and not (memorydelta - 1);

result := memory;

if newcapacity = 0) and (count >= 0) then

begin

pos := fposition + count;

if pos > 0 then

begin

if pos > fsize then

begin

if pos > fcapacity then

setcapacity(pos);

fsize := pos;

end;

system.move(buffer, pointer(longint(fmemory) + fposition)^, count);

fposition := pos;

result := count;

exit;

end;

end;

result := 0;

end;

buffer中存储要写入流的二进制数据,如果要写入的数据的字节超出了流的内存池的大小,则调用setcapacity方法再分配内存,然后用内存复制函数将buffer中的数据复制到fmemory中。接着移动位置指针,并返回写入数据的字节数。分析这段程序可以知道,fcapacity的值和fsize的值是不同的。

⑶ clear方法

clear方法消除内存流中的数据,将memory属性置为nil,并将fsize和fposition 的值设为0。其实现如下:

procedure tmemorystream.clear;

begin

setcapacity(0);

fsize := 0;

fposition := 0;

end;

⑷ loadfromstream和loadfromfile方法

loadfromstream方法首先根据传入的stream的size属性值重新分配动态内存,然后调用stream的readbuffer方法往fmemory中复制数据,结果stream的全部内容在内存中有了一份完整拷贝。其实现如下:

procedure tmemorystream.loadfromstream(stream: tstream);

var

count: longint;

begin

stream.position := 0;

count := stream.size;

setsize(count);

if countnil then freemem(fbuffer, fdataset.recordsize);

if fmodified then

try

ffield.datachanged;

except

application.handleexception(self);

end;

end;

如果blob流中的数据作了修改,就将ffield的fmodified置为true;如果ffield的modified为false就释放blob字段,如果fbuffer不为空,则释放临时内存。最后根据fmodified的值来决定是否启动ffield的事件处理过程datachanged。

不难看出,如果blob字段作了修改就不释放blob字段,并且对blob 字段的修改只有到destroy时才提交,这是因为读写blob字段时都避开了ffield,而直接调用bde api函数。这一点是在应用bde api编程中很重要,即一定要修改相应数据库部件的状态。

2. read和write方法的实现

read和write方法都调用bde api函数完成数据库blob字段的读写,其实现如下:

function tblobstream.read(var buffer; count: longint): longint;

var

status: dbiresult;

begin

result := 0;

if fopened then

begin

status := dbigetblob(fdataset.handle, frecord, ffieldno, fposition,

count, @buffer, result);

case status of

dbierr_none, dbierr_endofblob:

begin

if ffield.ftransliterate then

nativetoansibuf(fdataset.locale, @buffer, @buffer, result);

inc(fposition, result);

end;

dbierr_invalidbloboffset:

{nothing};

else

dbierror(status);

end;

end;

end;

read方法使用了bde api的dbigetblob函数从fdataset中读取数据,在本函数中,各参数的含义是这样的:fdataset.handle代表dataset的bde句柄,freacord表示blob字段所在记录,ffieldno表示blob字段号,fposition表示要读的的数据的起始位置,count表示要读的字节数,buffer是读出数据所占的内存,result是实际读出的字节数。该bde函数返回函数调用的错误状态信息。

read方法还调用了nativetoansibuf进行字符集的转换。

function tblobstream.write(const buffer; count: longint): longint;

var

temp: pointer;

begin

result := 0;

if fopened then

begin

if ffield.ftransliterate then

begin

getmem(temp, count);

try

ansitonativebuf(fdataset.locale, @buffer, temp, count);

check(dbiputblob(fdataset.handle, frecord, ffieldno, fposition,

count, temp));

finally

freemem(temp, count);

end;

end else

check(dbiputblob(fdataset.handle, frecord, ffieldno, fposition,

count, @buffer));

inc(fposition, count);

result := count;

fmodified := true;

end;

end;

write方法调用了bde api的dbiputblob函数实现往数据库blob字段存储数据。

该函数的各参数含义如下:

表20.2 调用函数dbiputblob的各传入参数的含义

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

参数名含义

──────────────────────────────

fdatasethandle 写入的数据库的bde句柄

frecord 写入数据的blob字段所在的记录

ffieldno blob字段号

fposition 写入的起始位置

count 写入的数据的字节数

buffer 所写入的数据占有的内存地址

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

方法中还根据ffield和ftransliterate的值判断是否进行相应的字符集转换,最后移动blob流的位置指针,并将修改标志fmodified置为true。

3. seek和getblobsize方法的实现

seek方法的功能主要是移动blob流的位置指针。getblobsize方法是私有的,在seek方法中被调用,其功能是得到blob数据的大小。它们的实现如下:

function tblobstream.getblobsize: longint;

begin

result := 0;

if fopened then

check(dbigetblobsize(fdataset.handle, frecord, ffieldno, result));

end;

function tblobstream.seek(offset: longint; origin: word): longint;

begin

case origin of

0: fposition := offset;

1: inc(fposition, offset);

2: fposition := getblobsize + offset;

end;

result := fposition;

end;

getblobsize调用了bde api的dbigetblobsize函数,该函数的参数的含义同前面的api函数相同。

4. truncate方法

该方法是通过调用bde api函数实现的。其实现如下:

procedure tblobstream.truncate;

begin

if fopened then

begin

check(dbitruncateblob(fdataset.handle, frecord, ffieldno, fposition));

fmodified := true;

end;

end;

该方法从blob流的当前位置起删除所有数据,并设置修改标志fmodified为true。在delphi vcl中许多部件特别是数据库应用方面的部件都用bde api函数完成对数据库的访问,如data access和data control部件。各种数据库部件都是bde api函数外层的包装简化了对数据库的访问操作。bde api中还提供了避开bde配置工具在程序中直接处理alias(建立、修改、删除等)的函数支持,这也是部件所没有提供的。在delphi数据库应用安装程序中,这些alias操作函数无疑是相当重要的。有关bde api函数的详细介绍,可阅读delphi2.0 client/server suite所带的bde api 帮助文件。

20.2 读写对象的实现原理和应用

读写对象(filer)包括tfiler对象、treader对象和twriter对象。tfiler对象是文件读写的基础对象,在应用程序中使用的主要是treader和twriter。treader和twriter对象都直接从tfiler对象继承。tfiler对象定义了filer对象的基本属性和方法。

filer对象主要完成两大功能:

● 存取窗体文件和窗体文件中的部件

● 提供数据缓冲,加快数据读写操作

20.2.1 tfiler对象

tfiler对象是treader和twriter的抽象类,定义了用于部件存储的基本属性和方法。它定义了root属性,root指明了所读或写的部件的根对象,它的create方法将stream对象作为传入参数以建立与stream对象的联系, filer对象的具体读写操作都是由stream对象完成。因此,只要是stream对象所能访问的媒介都能由filer对象存取部件。tfiler 对象还提供了两个定义属性的方法:defineproperty和definebinaryproperty,这两个方法使对象能读写不在部件published部分定义的属性。

因为filer对象主要用于存取delphi的窗体文件和窗体文件中的部件,所以要清楚地理解filer对象就要清楚delphi 窗体文件(dfm文件)的结构。

dfm文件是用于delphi存储窗体的。窗体是delphi可视化程序设计的核心。窗体对应delphi应用程序中的窗口,窗体中的可视部件对应窗口中的界面元素,非可视部件如ttable和topendialog,对应delphi应用程序的某项功能。delphi应用程序的设计实际上是以窗体的设计为中心。因此,dfm文件在delphi应用设计中也占很重要的位置。窗体中的所有元素包括窗体自身的属性都包含在dfm文件中。

在delphi应用程序窗口,界面元素是按拥有关系相互联系的,因此树状结构是最自然的表达形式;相应地,窗体中的部件也是按树状结构组织;对应在dfm文件中,也要表达这种关系。dfm文件在物理上,是以二进制方式存储的,在逻辑上则是以树状结构安排各部件的关系。delphi编辑窗口支持以文本方式显示dfm文件。从该文本中可以看清窗体的树状结构。下面是dfm文件的文本显示:

object form1: tform1

left = 72

top = 77

activecontrol = dbimage1

object panell: tpanel

left = 6

object dblabel1: tdbtext

end

object dbimage1: tdbimage

end

end

object panel2: tpanel

left = 6

object label1: tlable

end

end

object panel3: tpanel

left = 6

object dblabel2: tdbtext

end

end

end

关于dfm文件中存储属性值的规则,请参见自定义部件开发这一章。

对照tfiler对象的属性。root属性就表示部件树的根──窗体。filer对象的许多方法都是读从根起始的树中所有的部件。ancestor属性表示根的祖先对象,ignorechildren属性则是读部件时忽略根的子结点。

下面介绍filer对象的属性和方法。

20.2.1.1 tfiler对象的属性和方法

1. root属性

声明:property root: tcomponent;

root 属性给filer对象指出被读写的对象中哪一个对象是根或主要拥有者。rootcomponent和writerootcomponent方法在读和写部件及其拥有的部件前先设置root的值。

2. ancestor属性

声明:property ancestor: tpersistent;

ancestor属性用于往继承下来的窗体中写部件,因为当写部件时,write对象只需要写入与所继承的部件不同的属性,所以在写之前要跟踪每个继承的部件,并且比较它们的属性。

如果ancestor为nil,就表示没有相应的继承的部件,writer对象应当将部件完全写入流。ancestor一般为nil,只有当调用writedescendant和writedescendantres时,才给赋值。当编写和覆盖defineproperties时,必须设置ancestor的值。

3. ignorechildren属性

声明:property ignorechildren: boolean;

ignorechildren属性使一个writer对象存储部件时可以不存储该部件拥有的部件。如果ignorechildren属性为true,则writer对象存储部件不存它拥有的子部件。否则,writer对象将所有其拥有的对象写入流。

4. create方法

声明:constructor create(stream: tstream; bufsize: cardinal);

create方法创建一个新的filer对象,建立它和流stream的联系;并且给它分配一个缓冲区buffer。buffer的大小由bufsize指定。

5. defineproperty方法

声明:procedure defineproperty(const name: string; readdata: treaderproc;

writedata: twriterproc; hasdata: boolean); virtual; abstract;

defineproperty方法定义filer对象将作为属性存储的数据。name参数描述接受的属性名,该属性不在published部分定义。readdata和writedata参数指定在存取对象时读和写所需数据的方法。hasdata参数在运行时决定了属性是否有数据要存储。

只有当对象有数据要存储时,才在该对象的defineproperties中调用defineproperty。defineproperties有一个filer对象作为它的参数,调用的就是该filer对象的defineproperty和definebinaryproperty方法。当定义属性时,writer对象应当引用ancestor属性,如果该属性非空,writer对象应当只写入与从ancestor继承的不同的属性的值。

一个最简单的例子是tcomponent的defineproperties方法。尽管tcomponent 没有在published中定义left、top属性,但该方法存储了部件的位置信息。

procedure tcomponent.defineproperties(filer: tfiler);

begin

filer.defineproperty('left', readleft, writeleft, longrec(fdesigninfo).lo0);

end;

6. definebinaryproperty方法

声明:procedure definebinaryproperty(const name: string;

readdata, writedata: tstreamproc;

hisdata: boolean); virtual; abstract;

definebinaryproperty方法定义filer对象作为属性存储的二进制数据。name参数描述属性名。readdata和writedata参数描述所存储的对象中读写所需数据的方法。hasdata参数在运行时决定属性是否有数据要存。

definebinaryproperty和defineproperty方法的不同之处在于,二进制型的属性直接用stream对象读写,而不是通过filer对象。通过readdata和writedata传入的方法,直接将对象数据写入流或从流读出。

definebinaryproperty属性用得较少。只有标准的vcl对象定义了象图形、图像之类的二进制属性的部件中才用它。

7. flushbuffer方法

声明:procedure flushbuffer; virtual: abstract;

flushbuffer方法用于使filer对象的缓冲区与相联的stream对象同步。对reader对象来说,是通过重新分配缓冲区;对于writer对象是通过写入当前缓冲区。

flushbuffer是一个抽象方法,treader和twriter都覆盖了它,提供了具体实现。

20.2.1.2 tfiler对象的实现原理

tfiler对象是filer对象的基础类,它定义的大多数方法都是抽象类型的,没有具体实现它,这些方法要在treader和twrite中覆盖。但它们提供了filer对象的框架,了解它无疑是很重要的。

1. tfiler对象属性的实现

tfiler对象定义了三个属性:root、ancestor和ignorechildren。正如定义对象属性通常所采用的方法那样,要在private部分定义存储属性值的数据域,然后在public或published部分定义该属性,并按需要增加读写控制。它们的定义如下:

tfiler = class(tobject)

private

froot: tcomponent;

fancestor: tpersistent;

fignorechildren: boolean;

public

property root: tcomponent read froot write froot;

property ancestor: tpersistent read fancestor write fancestor;

property ignorechildren: boolean read fignorechildren write fignorechildren;

end;

它们在读写控制上都是直接读写私有的数据域。

在介绍treader和twriter的实现,我们还会看到这几个属性的原理介绍。

2. tfiler对象方法的实现

在tfiler对象定义的众多方法中很多都是抽象类方法,没有具体实现。在tfiler 的后继对象treader中覆盖了这些方法。在后面章节,会介绍这些方法的实现。

在tfiler对象中有具体实现的有两个方法create和destroy。

⑴ create方法的实现

create方法是tfiler的构造方法,它有两个参数stream和bufsize。stream是指定与tfiler对象相联系的stream对象,filer对象都是用stream对象完成具体的读写。bufsize是tfiler对象内部开设的缓冲区的大小。filer对象内部开设缓冲区是为了加快数据的读写,它的实现如下:

constructor tfiler.create(stream: tstream; bufsize: integer);

begin

fstream := stream;

getmem(fbuffer, bufsize);

fbufsize := bufsize;

end;

fstream、fbuffer和fbufsize都是tfiler在private部分定义的数据域。fstream表示与filer对象相联的stream对象,fbuffer指向filer对象内部开设的缓冲区,fbufsize是内部缓冲区的大小。create方法用stream参数值给fstream赋值,然后用getmem分配bufsize大小的动态内存作为内部缓冲区。

⑵ destroy方法的实现

destroy方法是tfiler对象的析构函数,它的作用就是释放动态内存。

destructor tfiler.destroy;

begin

if fbufferstreamposition + fbufpos) then

begin

writebuffer;

fstream.position := value;

end

else fbufpos := value - streamposition;

end;

writebuffer是twriter对象定义的私有方法,它的作用是将writer 对象内部缓冲区中的有效数据写入流中,并将fbufpos置为0。writer对象的flushbuffer对象就是用writebuffer方法刷新缓冲区。

在setposition方法中,如果value值超出了边界(fstream.position,fstream.position + fbufpos),就将缓冲区中的内容写入流,重新设置缓冲区在流中的相对位置;否则,就只是移动fbufpos指针。

2. twriter方法的实现

⑴ writelistbegin和writelistend的实现

这两个方法都是用于写连续若干个相同类型的值。writelistbegin写入valist标志,writelistend写入vanull标志。

procedure twriter.writelistbegin;

begin

writevalue(valist);

end;

procedure twriter.writelistend;

begin

writevalue(vanull);

end;

这两个方法都调用twriter对象的writevalue方法,该方法主要用于写入tvaluetype类型的值。

procedure twriter.writevalue(value: tvaluetype);

begin

write(value, sizeof(value));

end;

⑵ 简单数据类型的写入

简单数据类型指的是整型、字符型、字符串型、浮点型、布尔型等。twriter对象都定义了相应的写入方法。

writeinteger方法用于写入整型数据。

procedure twriter.writeinteger(value: longint);

begin

if (value >= -128) and (value = -32768) and (value[] then

begin

prefix := $f0 or byte(flags);

write(prefix, sizeof(prefix));

if ffchildpos in flags then writeinteger(achildpos);

end;

end;

如果ffchildpos置位,则存入部件在owner中的创建序值。更详细的信息请参阅treader的readprefix方法。

writecomponent方法往流中写入部件。

procedure twriter.writecomponent(component: tcomponent);

function findancestor(const name: string): tcomponent;

begin

end;

begin

include(component.fcomponentstate, cswriting);

if assigned(fancestorlist) then

ancestor := findancestor(component.name);

component.writestate(self);

exclude(component.fcomponentstate, cswriting);

end;

方法中用component的writstate方法写入部件的属性。在写入之前将component.fcomponentstate置为cswriting写入完后再将cswriting复位。

writedescendant是根据祖先aancestor的情况写入部件root。

procedure twriter.writedescendent(root: tcomponent; aancestor: tcomponent);

begin

frootancestor := aancestor;

fancestor := aancestor;

froot := root;

writesignature;

writecomponent(root);

end;

方法先调用writesignature方法写入filer对象标签。然后调用writecomponent将部件root写入流。

writerootcomponent方法则是调用writedescendant方法写入部件,只是将后者的ancestor参数以nil值传入。

procedure twriter.writerootcomponent(root: tcomponent);

begin

writedescendent(root, nil);

end;

20.2.3 treader对象

treader对象是可实例化的用于从相联系的流中读取数据的filer对象。treader对象从tfiler继承下来,除了从tfiler继承的属性和方法外,treader声明了不少属性、方法和事件。

owner和parent属性用于表示从reader对象的流中读取的部件的拥有者和双亲结点。onerror,onfindmethod和onsetname事件使应用程序在运行中读数据时能定制响应方式。除了覆盖了一些从tfiler对象中继承的方法外,treader对象还定义大量的读不同类型的数据和触发事件的方法。

20.2.3.1 treader对象的属性和方法

1. owner属性

声明:property owner: tcomponent;

reader对象的owner属性存储了将用来给从reader的流中读出的部件的owner属性赋值的部件。

2. parent属性

声明:property parent: tcomponent;

parent属性存储将用来给从reader的流中读出所有控制的parent属性赋值的部件。

3. position属性

声明:propertion: longint;

reader对象的position属性表示相联的流中读的当前位置。position的值还应包括读缓冲区的大小。对于reader 对象,position的值大于流的position 的值。如果将position的值设得超过当前缓冲区,将引起调用flushbuffer。

4. beginreferences方法

声明:procedure beginreferences;

beginreferences方法启动一连串关于读部件的命令,这些部件包含相互间的交叉引用。在使用上通常和fixupreferences和endreferences一起放在try…finally程序块中。

在调用了beginreferences后,reader对象创建读取所有对象和名字的列表。所有的独立对象被读出后,调用fixupreferences方法将名字的相互从流中转移到对象实例中。最后调用endreferences方法释放列表。

处理部件相互引用的程序块形式如下:

beginreferences; { 创建临时列表 }

try

{ 读出所有部件并将它们的名字放在一临时列表中 }

fixupreferences; { 分 解 }

finally

endreferences; { 释放临时列表 }

end;

5. fixupreferences方法

声明:procedure fixupreferences;

fixupreferences方法分解从流中读出的存在各种相互依赖部件的引用关系。fixupreferences总在try…finally块中并配合beginreferences和endreferences一起使用。

6. endreferences方法

声明:procedure endreferences;

endreferences方法终止处理相互引用的块操作,释放对象列表。它总配合beginreferences和fixupreferences一起使用。

7. readlistbegin方法

声明:procedure readlistbegin;

readlistbegin方法从reader对象相联的流中读取列表开始标志。如果流中紧接着要读取的项目不是一个由writelistbegin方法写入的列表起始标志,readlistbegin将引起一个读异常事件。

通常在调用readlistbegin方法之后,紧跟着一个读项目的循环,循环以endflist方法返回true 终止条件。这时,预示流中的下一个项目是列表结束标志,需要调用readlistend方法。

8. readlistend方法

声明:procedure readlistend;

readlistend 方法从流中读取列表结束标志。如果所读的项目不是一个列表结束标志,readlistend方法引发一个ereaderror异常事件。

9. endoflist方法

声明:function endoflist: boolean;

如果reader对象读到项目列表结果标志,endoflist方法返回true。

tstrings对象在从reader对象读取项目列表时使用了readlistbegin和readlistend方法。下面的readdata是tstrings的方法,用于在defineproperties方面中读string数据。

procedure tstrings.readdata(reader: treader);

begin

reader.readlistbegin; { 读列表开始标志 }

clear; { 清除已有的字符串 }

while not reader.endoflist do { 只要还有数据 … }

add(reader.readstring); { …读一个字符串并将其加在列表中 }

reader.readlistend; { 越过列表结束标志 }

end;

10. readsignature方法

声明:procedure readsignature;

readsignature方法从流中读取部件之前首先调用readsignature方法。在载入对象之前检测标签。reader对象就能防止疏忽大意,导致读取无效或过时的数据。filer标签是四个字符,对于delphi 2.0,该标签是“tpf0”。

11. readprefix方法

声明:procedure readprefix(var plags: tfilerflags; var achild, pos: integer);

readprefix方法的功能与readsignature的很相象,只不过它是读取流中部件前面的标志(prefix)。当一个write对象将部件写入流中时,它在部件前面预写了两个值,第一个值是指明部件是否是从祖先窗体中继承的窗体和它在窗体中的位置是否重要的标志;第二个值指明它在祖先窗体创建次序。readcomponent方法自动调用readprefix。但如果需要独立读取部件的预读标志,也可直接调用该方向。

12. onfindmethod事件

声明:property onfindmethod: tfindmethodevent;

onfindmethod事件,发生在reader对象读取对象的方法指针时,属性为方法指针的通常都是事件。

响应onfindmethod事件的理由,通常是处理过程找不到方法的情况。在findmethod方法没有找到由name指定的方法的情况下,如果它将onfindmethod方法的error 参数设为true,将引起readerror异常事件;反之,将error参数置为false,将防止findmethod方法引发异常事件。

13. error方法

声明:function error(const message: string): boolean; virtual;

error方法定义在reader对象的protected部分,它是用于reader对象的onerror事件。其返回值决定是否继续错误处理过程。如果返回值为true,则表示用程序应当继续错误处理;如果返回值为false,则表示错误情况被忽略。

如果读部件或属性出错。reader对象调用error方法。缺省情况下,error将返回值设为false,然后调用onerror事件处理过程。

treader对象总是在try…except程序块的except部分,并提供用户忽略错误的机会。error的使用方法如下:

try

… { 读部件 }

except

on e: exception do

begin

…{ 执行一些清除操作 }

if error(e.message) then raise;

end;

end;

14. onerror事件

声明:property onerror: treadererror;

当reader对象读取数据出错时将引发onerror事件。通过处理onerror事件,可以有选择地处理或忽略错误。

传给onerror事件处理过程的最后一个参数是名为handled的var参数。在缺省情况下,error方法将handled置为true。这将阻止错误更进一步处理。如果事件处理过程仍旧将handled置为false,reader对象将引发一个ereaderror异常事件。

15. setname方法

声明:procedure setname(component: tcomponent; var name: string virtual);

setname方法允许reader对象在将从流中读取的部件的name值赋给部件的name属性前修改name值。readcomponent方法在读取部件的属性值和其它数据前先读部件的类型和名字在读完名字后,readcomponent将所读的名字作为name参数传给setname,name 是个var参数,因此setname能在返回前修改字符串值。setname还调用了onsetname事件处理过程,将名字字符串作为var参数传入事件处理过程中,因此,事件处理过程也可修改字符串的值。

16. onsetname事件

声明:property onsetname: tsetnameevent;

onsetname事件发生在read对象设置部件的name属性前,onsetname事件处理过程的var参数name参数是一个var参数,因此,事件处理过程再将name赋给部件前,可以修改name的值。这对于想过滤窗体中部件的名字是很有帮助的。

下面的onsetname事件处理过程,命名了名字中包含“button”的部件,并用“pushbutton”替代。

procedure tform1.readersetname(reader: treader; component: tcomponent;

var name: string);

var

buttonpos: integer;

begin

buttonpos := pos('button', name);

if buttonposvabinary then

begin

dec(fbufpos);

skipvalue;

fcanhandleexcepts := true;

propvalueerror;

end;

stream := tmemorystream.create;

try

read(count, sizeof(count));

stream.setsize(count);

read(stream.memory^, count);

fcanhandleexcepts := true;

readdata(stream);

finally

stream.free;

end;

fpropname := '';

end;

end;

在两个方法都将name参数值与当前的属性名比较,如果相同则进行读操作。在definebinaryproperty中,创建了一个内存流。先将数据读到内存流中然后调用readdata读取数据。

3. flushbuffer的实现

flushbuffer方法用于清除reader对象的内部缓冲区中的内容,保持reader对象和流在位置(position)上的同步,其实现如下:

procedure treader.flushbuffer;

begin

fstream.position := fstream.position - (fbufend - fbufpos);

fbufpos := 0;

fbufend := 0;

end;

4. readlistbegin、readlistend和endoflist方法

这三个方法都是用于从reader对象的流中读取一连串的项目,并且这些项目都由writelistbegin写入的标志标定开始和writelistend写入标志,标定结束,在读循环中用endoflist进行判断。它们是在reader对象读取流中数据时经常用于的。它们的实现如下:

procedure treader.readlistbegin;

begin

checkvalue(valist);

end;

procedure treader.readlistend;

begin

checkvalue(vanull);

end;

function treader.endoflist: boolean;

begin

result := readvalue = vanull;

dec(fbufpos);

end;

项目表开始标志是valist,项目表结束标志是vanull,valist和vanull都是枚举类型tvaluetype定义的常量。

它们实现中调用的checkvalue是treader的私有方法,其实现如下:

procedure treader.checkvalue(value: tvaluetype);

begin

if readvalue1 then

begin

dec(fbufpos);

readstr;

propvalueerror;

end;

read(result, 1);

end;

出于读取dfm文件需要,filer对象支持读取标识符。

function treader.readident: string;

var

l: byte;

begin

case readvalue of

vaident:

begin

read(l, sizeof(byte));

setstring(result, pchar(nil), l);

read(result[1], l);

end;

vafalse:

result := 'false';

vatrue:

result := 'true';

vanil:

result := 'nil';

else

propvalueerror;

end;

end;

一般说来,各种复杂的数据结构都是由这些简单数据组成;定义了这些方法等于给读各种类型的数据提供了元操作,使用很方便。例如,读取字符串类型的数据时,如果采用传流方法还要判断字符串的长度,使用readstring方法就不同了。但应该特别注意的是这些类型数据的存储格式是由delphi设计的与简单数据类型有明显的不同。因此,存入数据时应当使用writer对象相应的方法,而且在读数据前要用nextvalue方法进行判断,否则会触发异常事件。

6. 读取部件的方法的实现

reader对象中用于读取部件的方法有readsignature、readprefix、readcomponent、readrootcomponent和readcomponents。

readsignature方法主要用于读取delphi filer对象标签一般在读取部件前,都要用调用readsignature方法以指导部件读写过程。

procedure treader.readsignature;

var

signature: longint;

begin

read(signature, sizeof(signature));

if signaturenil then

try

include(result.fcomponentstate, csloading);

if not (ffinherited in flags) then setcompname;

if result = nil then exit;

include(result.fcomponentstate, csreading);

result.readstate(self);

exclude(result.fcomponentstate, csreading);

if ffchildpos in flags then parent.setchildorder(result, position);

floaded.add(result);

except

if componentcreated then result.free;

raise;

end;

end;

readcompontent方法首先调用readprefix方法,读出部件标志位和它的创建次序值(create order)。然后用readstr方法分别读出部件类名和部件名。如果component参数为nil,则执行两个任务:

● 如果ffinberited 置位则从root 找已有部件,否则,就从系统的class表中找到该部件类型的定义并创建

● 如果结果不为空,将用部件的readstate方法读入各种属性值,并设置部件的parent 属性,并恢复它在parent部件的创建次序。

readcomponent方法主要是调用readcomponent方法从reader对象的流中读取一连串相关联的部件,并分解相互引用关系。

procedure treader.readcomponents(aowner, aparent: tcomponent;

proc: treadcomponentsproc);

var

component: tcomponent;

begin

root := aowner;

owner := aowner;

parent := aparent;

beginreferences;

try

while not endoflist do

begin

readsignature;

component := readcomponent(nil);

proc(component);

end;

fixupreferences;

finally

endreferences;

end;

end;

readcomponents首先用aowner和aparent参数给root,owner和parent赋值,用于重建各部件的相互引用。然后用一个while循环读取部件并用由proc传入的方法进行处理。在重建引用关系时,用了beginreferences、fixupreferences和endreferences嵌套模式。

readrootcomponent方法从reader对象的流中将部件及其拥有的部件全部读出。如果component参数为nil,则创建一个相同类型的部件,最后返回该部件:

function treader.readrootcomponent(root: tcomponent): tcomponent;

function finduniquename(const name: string): string;

begin

end;

var

i: integer;

flags: tfilerflags;

begin

readsignature;

result := nil;

try

readprefix(flags, i);

if root = nil then

begin

result := tcomponentclass(findclass(readstr)).create(nil);

result.name := readstr;

end else

begin

result := root;

readstr; { ignore class name }

if csdesigning in result.componentstate then

readstr else

result.name := finduniquename(readstr);

end;

froot := result;

if globalloaded0;

if not result then exit;

freeresource(hrsrc);

with tresourcestream.create(hinstance, resname, rt_rcdata) do

try

instance := readcomponent(instance);

finally

free;

end;

result := true;

end;

hinstance是一个delphi vcl定义的全局变量,代表当前应用程序的句柄。函数用了资源访问api函数findresource来测定是否存在resname所描述资源。因为在tresourcestream的创建过程还有findresource等操作,所以函数中调用了freeresource。最后函数调用了stream对象的readcomponent方法读出部件。因为函数的instance是var类型的参数,所以可以访问instance,得到读出的部件。

20.3.1.4 dfm文件与标准文本文件(txt文件)的相互转换

在delphi可视化设计环境中,允许程序员在代码编辑器中以文本的方式浏览和修改dfm文件内容。当用file/open命令直接打开dfm文件或者选择窗体设计窗口的弹出式菜单上的view as text命令时,就会在编辑器中出现文本形式的信息。我们姑且将这种文本形式称之为窗体设计脚本。delphi提供的这种脚本编辑功能是对delphi可视化设计的一大补充。当然这个脚本编辑能力是有限制的,比方说不能在脚本任意地添加和删除部件,因为代码和dfm脚本是紧密相连的,任意添加和修改会导致不一致性。然而在动态生成的dfm文件中,就不存在这一限制,后面会介绍dfm动态生成技术的应用。

实际上,dfm文件内容是二进制数据,它的脚本是经过delphi开发环境自动转化的,而且delphi vcl中的classes库单元中提供了在二进制流中的文件dfm和它的脚本之相互转化的过程。它们是objectbinarytotext和objecttextbinary、objectresourcetotext和objecttexttoresource。

objectbinarytotext过程将二进制流中存储的部件转化为基于文本的表现形式,这样就可以用文本处理函数进行处理,还可以用文本编辑器进行查找和替代操作,最后可以将文本再转化成二进制流中的部件。

objectbinarytotext过程的主程序是这样的:

procedure objectbinarytotext(input, output: tstream);

var

nestinglevel: integer;

saveseparator: char;

reader: treader;

writer: twriter;

procedure writeindent;

const

blanks: array[0..1] of char = ' ';

var

i: integer;

begin

for i := 1 to nestinglevel do writer.write(blanks, sizeof(blanks));

end;

procedure writestr(const s: string);

begin

writer.write(s[1], length(s));

end;

procedure newline;

begin

writestr(#13#10);

writeindent;

end;

procedure convertheader;

begin

end;

procedure convertbinary;

begin

end;

procedure convertvalue;

begin

end;

procedure convertproperty;

begin

end;

procedure convertobject;

begin

end;

begin

nestinglevel := 0;

reader := treader.create(input, 4096);

saveseparator := decimalseparator;

decimalseparator := '.';

try

writer := twriter.create(output, 4096);

try

reader.readsignature;

convertobject;

finally

writer.free;

end;

finally

decimalseparator := saveseparator;

reader.free;

end;

end;

过程中调用的convertobject过程是个递归过程,用于将dfm文件中的每一个部件转化为文本形式。因为由于部件的拥有关系,所以部件成嵌套结构,采用递归是最好的方式:

procedure convertobject;

begin

convertheader;

inc(nestinglevel);

while not reader.endoflist do convertproperty;

reader.readlistend;

while not reader.endoflist do convertobject;

reader.readlistend;

dec(nestinglevel);

writeindent;

writestr('end'#13#10);

end;

neststinglevel变量表示部件的嵌套层次。writeindent是写入每一行起始字符前的空格,convertheader过程是处理部件的继承标志信息。转换成的头信息文本有两种形式。

inherited testform1: ttestform[2]

或者:

object testform1: ttestform

前者是ffinherited和ffchildpos置位,后面是都没置位。

convertproperty过程用于转化属性。

procedure convertproperty;

begin

writeindent;

writestr(reader.readstr);

writestr(' = ');

convertvalue;

writestr(#13#10);

end;

writeindent语句写入属性名前的空格,writestr(reader.readstr)语句写入属性名convertvalue过程根据属性的类型将属性值转化为字符串,然后写入流中。

objecttexttobinary过程执行的功能与objectbinarytotext相反,将txt文件转换为二进制流中的部件,而且只要txt文件内容的书写符合dfm脚本语法,objecttexttobinary可将任何程序生成的txt文件转换为部件,这一功能也为dfm 文件的动态生成和编辑奠定了基础。objecttexttobinary过程的主程序如下:

procedure objecttexttobinary(input, output: tstream);

var

saveseparator: char;

parser: tparser;

writer: twriter;

begin

parser := tparser.create(input);

saveseparator := decimalseparator;

decimalseparator := '.';

try

writer := twriter.create(output, 4096);

try

writer.writesignature;

convertobject;

finally

writer.free;

end;

finally

decimalseparator := saveseparator;

parser.free;

end;

end;

在程序流程和结构上与objectbinarytotext差不多。convertobject也是个递归过程:

procedure convertobject;

var

inheritedobject: boolean;

begin

inheritedobject := false;

if parser.tokensymbolis('inherited') then

inheritedobject := true

else

parser.checktokensymbol('object');

parser.nexttoken;

convertheader(inheritedobject);

while not parser.tokensymbolis('end') and

not parser.tokensymbolis('object') and

not parser.tokensymbolis('inherited') do convertproperty;

writer.writelistend;

while not parser.tokensymbolis('end') do convertobject;

writer.writelistend;

parser.nexttoken;

end;

dfm文件与dfm脚本语言之间相互转换的任务由objectresourcetotext和objexttexttoresource两个过程完成。

procedure objectresourcetotext(input, output: tstream);

begin

input.readresheader;

objectbinarytotext(input, output);

end;

objecttexttoresource过程就比较复杂,因为dfm文件资源头中要包含继承标志信息,因此在调用objecttexttobinary后,就读取标志信息,然后写入资源头。

procedure objecttexttoresource(input, output: tstream);

var

len: byte;

tmp: longint;

memorystream: tmemorystream;

memorysize: longint;

header: array[0..79] of char;

begin

memorystream := tmemorystream.create;

try

objecttexttobinary(input, memorystream);

memorysize := memorystream.size;

fillchar(header, sizeof(header), 0);

memorystream.position := sizeof(longint); { skip header }

memorystream.read(len, 1);

if len and $f0 = $f0 then

begin

if ffchildpos in tfilerflags((len and $f0)) then

begin

memorystream.read(len, 1);

case tvaluetype(len) of

vaint8: len := 1;

vaint16: len := 2;

vaint32: len := 4;

end;

memorystream.read(tmp, len);

end;

memorystream.read(len, 1);

end;

memorystream.read(header[3], len);

strupper(@header[3]);

byte((@header[0])^) := $ff;

word((@header[1])^) := 10;

word((@header[len + 4])^) := $1030;

longint((@header[len + 6])^) := memorysize;

output.write(header, len + 10);

output.write(memorystream.memory^, memorysize);

finally

memorystream.free;

end;

end;

20.3.1.5 动态dfm文件应用揭秘

1. 动态dfm文件概述

动态dfm文件是相对于静态dfm文件而言。所谓静态dfm文件是指在delphi开发环境中设计的窗体文件。窗体的设计过程就是程序的编制过程。因此,动态dfm文件就是指在程序运行过程生成或存取的dfm文件。

动态dfm文件的创建和使用分别如下两种情况:

● 在程序运行过程中,由create方法动态生成窗体或部件,然后动态生成其它部件插入其中生成dfm文件

● 在delphi开发环境中,设计生成dfm文件,然后用dfm 文件存取函数,或者用stream对象和filer对象的方法,将dfm文件读入内存,进行处理,最后又存入磁盘中

由delphi的窗体设计的常规方法生成的dfm文件在程序运行一开始就规定了部件的结构。因为在窗体设计过程中,窗体中的每个部件都在程序的对象声明中定义了部件变量。这种固定的结构虽然能方便应用,但以牺牲灵活性为代价。

在delphi应用程序中有时需要在运行过程中创建控制,然后将该控制插入另一个部件中。例如:

procedure tform1.button1click(sender: tobject);

var

ctrl: tcontrol

begin

ctrl := tedit.create(self);

ctrl.top := 100;

ctrl.left := 100;

ctrl.width := 150;

ctrl.height := 20;

insertcontrol(ctrl);

end;

动态插入控制的优点是可以在任何时刻、任意位置插入任意数量的任何类型的控制。因为应用程序需求在很多情况下是在程序运行中才知道的,所以动态插入控制就显得很重要。而且在很多情况下,需要保存这些界面元素,留待程序再次调用。例如应用程序界面的定制、系统状态的保存、对话框的保存等。这时生成动态dfm文件是最佳选择。

动态插入控制的不足之处是在插入控制前,无法直观地看到控制的大小、风格、位置等,也就是动态插入控制的过程是非可视化的。但可以借助于静态dfm文件的可视化设计。这就是生成和使用动态dfm文件的第二种方法。也就是在应用程序运行前,在delphi开发环境中,使用可视化开发工具设计所需窗口或部件的样式,以dfm文件保存。然后在应用程序运行过程中,将dfm文件读入内存。delphi的stream对象和filer对象在读取dfm文件时,会根据dfm文件的内容自动创建部件及其拥有的所有部件。

在使用动态dfm文件时有两点需要注意。

● 每一个动态插入的控制或部件必须在程序中调用registerclass进行注册

● 读入dfm文件自动创建部件后,如果调用了insertcontrol方法, 则在关闭窗口时要调用removecontrol方法移去该控制,否则会产生异常事件

2. 动态dfm文件应用之一:超媒体系统的卡片设计

delphi多种类型的可视部件,如文本部件、编辑部件、图形图像部件、数据库部件、媒体媒放部件和ole部件等,每一种部件在屏幕中占据一定的区域,具有相当丰富的表现能力,可以作为卡片中的一种媒体,因此可以利用这些可视部件进行超媒体系统的卡片设计。

超媒体卡片设计要求卡片中的媒体数目和媒体种类是不受限制的,而且必须能够修改和存取卡片,因此,采用动态dfm文件是比较合适的。而且如果利用stream对象,将卡片存储在数据库blob字段中,就为把超文本与关系数据库技术结合起来创造了契机。

下面是超媒体卡片设计子系统中的部分源程序,它演示了如何创建对象、插入对象和存取动态dfm文件。

⑴ 在应用程序中注册对象

procedure tmainform.formcreate(sender: tobject);

begin

registerclass(tlabel);

registerclass(tedit);

registerclass(tmemo);

registerclass(tbutton);

registerclass(tpanel);

registerclass(tpanelp);

registerclass(tbitbtn);

end;

⑵ 创建和插入对象

procedure tmdichild.formclick(sender: tobject);

var

ctrl : tcontrol;

point: tpoint;

begin

getcursorpos(point);

point := background.screentoclient(point);

case curtoolindex of

1 : begin

ctrl := tlabel.create(self);

tlabel(ctrl).autosize := false;

tlabel(ctrl).caption := 'label'+s;

tlabel(ctrl).name := 'label 1';

tlabel(ctrl).top := point.y;

tlabel(ctrl).left := point.x;

tlabel(ctrl).height := round(100*res/1000/ratio);

tlabel(ctrl).width := round(600*res/1000/ratio);

tlabel(ctrl).color := clwhite;

tlabel(ctrl).font.color := clblack;

tlabel(ctrl).font.name := 'roman';

tlabel(ctrl).font.height := -tlabel(ctrl).height;

tlabel(ctrl).font.pitch := fpfixed;

tlabel(ctrl).enabled := false;

tlabel(ctrl).onclick := labelclick;

tlabel(ctrl).onmousemove := reportpos;

background.insertcontrol(ctrl);

curtool.down := false;

curtool := nil;

end;

2: begin

ctrl := tedit.create(self);

tedit(ctrl).autosize := true;

tedit(ctrl).top := point.y;

tedit(ctrl).left := point.x;

tedit(ctrl).height := 20;

background.insertcontrol(ctrl);

end;

3:

end;

end;

⑵ 存取动态dfm文件

procedure tmainform.fileopen(sender: tobject);

begin

if opendialog.execute then

begin

designwin := tmdichild.create(application);

readcomponentresfile(opendialog.filename, designwin);

designwin.init;

filename := opendialog.filename;

designwin.caption := ffilename;

end;

end;

designwin是在tmainform中定义的tmdichild类型的窗体部件,是卡片设计平台;ffilename是私有变量,用来保存当前编辑的卡片文件名。designwin的init方法实现如下:

procedure tmdichild.init;

var

i: integer;

ctrl: tcontrol;

begin

background.bringtofront;

with background do

for i:= 0 to controlcount - 1 do

if controls[i].namenil then

designwin.curcontrol.enabled := true;

writecomponentresfile(ffilename, designwin);

designwin.caption := filename;

end;

end;

因为在designwin的init方法中调用了insertcontrol方法,所以在关闭designwin窗口时要相应地调用removecontrol,否则在关闭designwin窗口时会产生内存错误。

procedure tmdichild.formclosequery(sender: tobject; var canclose: boolean);

var

i: integer;

ctrl: tcontrol;

removed: boolean;

begin

if modified = true then

if messagedlg('close the form?', mtconfirmation,

[mbok, mbcancel], 0) = mrcancel then

canclose := false;

if canclose = true then

begin

repeat

removed := false;

i := 0;

repeat

if background.controls[i].name = background.controlcount) or (removed = true);

until (removed = false);

sendmessage(objectins.handle, wm_mdichildclosed, 0, 0);

end;

end;

3. 动态dfm文件应用之二:超媒体系统脚本语言设计

超媒体脚本语言设计是超媒体系统设计的重要内容。脚本语言必须能够表达卡片中的多种媒体对象,必须是可编程,可理解的,必须是可执行的,应该可以由脚本语言生成超媒体系统中的卡片和链。

dfm文件可以看作是超媒体系统的卡片,dfm脚本能够表达dfm文件中的多种控制,也就是说能够表达卡片中的多种媒体对象,再加上dfm脚本的对象式表达,可编辑性,可转换为dfm文件,因此用作超媒体系统脚本语言较好的形式。

objectbinarytotext和objecttexttobinary过程提供了在部件和dfm脚本之间相互转化的功能,objectresourcetotext和objecttexttoresoure过程提供了dfm文件和dfm脚本之间相互转化的功能。这样就可以在应用程序中自如实现超媒体卡片和超媒体脚本语言相互转化。

下面是卡片和脚本语言相互转化的程序:

procedure tmdichild.cardtoscript;

var

in, out: tstream;

begin

in := tmemorystream.create;

out := tmemorystream.create;

try

in.writecomponentres(self.classname, self);

objectresourcetotext(in, out);

scriptform.scriptedit.lines.loadfromstream(out);

finally

in.free;

out.free;

end;

end;

scriptedit是个文本编辑器,它的lines属性是tstrings类型的对象。

procedure tscriptform.scripttocard;

var

in, out: tstream;

begin

in := tmemorystream.create;

out := tmemorystream.create;

try

scriptform.scriptedit.lines.savetofromstream(in);

objecttexttoresource(in, out);

in.readcomponentres(designwin);

finally

in.free;

out.free;

end;

end;

这两段程序是对整个卡片,即窗体级,进行转换的。objectbinarytotext和objecttexttobinary过程可以细化到部件级的转换。因此超媒体脚本语言的编辑可以细化到媒体对象级。

4. 超媒体编辑和表现系统与动态dfm文件的扩展

超媒体系统的媒体编辑与卡片管理有其特殊的需求,比如链接需求。这时采用已有的窗体部件和媒体部件并按常规的dfm文件处理就显得力不从心了。解决这个矛盾有两套方案:

● 利用delphi部件开发技术,继承和开发新的部件增加新的超媒体特有的属性和处理方法

● 扩展dfm文件结构,使之能按自己的需要任意地存取和转换部件和dfm文件

前者是充分利用delphi的面向对象部件开发技术,在存取和转换等处理上仍旧与常规dfm文件相同。而后者需要dfm的存取和转换上作比较大的改动。下文介绍扩展dfm文件的思路。

扩展动态dfm文件的总体思路是降低处理操作的数据的颗粒度,即从原先窗体级降低到部件级。

下面是存取操作的扩展示范:

var

filestream: tstream;

i: integer;

begin

filestream := tfilestream.create('overview.crd', fmopenwrite);

with twriter.create(filestream, 4096) do

try

for i := 0 to designwin.controlcount - 1 do

begin

writeinteger(mmid[i]);

writerootcomponent(designwin.controls[i]);

{ 写相应媒体扩展信息 }

……

end;

writelistend;

finally.

free;

end;

filestream.free;

end;

writeinteger(mmid[i])语句是写入媒体标识。

下面是相应的读扩展dfm的程序:

var

propinfo: ppropinfo;

method : tmethod;

filestream: tstream;

i: integer;

begin

filestream := tfilestream.create('overview.crd', fmopenread);

with treader.create(filestream, 4096) do

try

while not endoflist do

begin

case readinteger of

idtext: begin

ctrl := tcontrol(readrootcomponent(nil));

propinfo := getpropinfo(ctrl.classinfo, 'onclick');

method.code:= self.methodaddress(methodname);

method.data := self;

if method.codenil then

setmethodprop(ctrl, propinfo, method);

designwin.insertcontrol(ctrl);

end;

idimage:

……

end;

……

writelistend;

end;

finally.

free;

end;

filestream.free;

end;

20.3.2.2 blob字段与图形图像

在多媒体数据库中处理得比较多的是图形图像,因此早期的多媒体数据库在扩展关系数据库时往往是增加一个图像字段。blob字段是以二进制数据存储方式,因此它完全可以表达图形图像数据。

在tblobfield对象中提供了loadfrombitmap和savetobitmap方法存取位图数据。它们在实现上都是使用blobstream对象。

procedure tblobfield.loadfrombitmap(bitmap: tbitmap);

var

blobstream: tblobstream;

header: tgraphicheader;

begin

blobstream := tblobstream.create(self, bmwrite);

try

if (datatype = ftgraphic) or (datatype = fttypedbinary) then

begin

header.count := 1;

header.htype := $0100;

header.size := 0;

blobstream.write(header, sizeof(header));

bitmap.savetostream(blobstream);

header.size := blobstream.position - sizeof(header);

blobstream.position := 0;

blobstream.write(header, sizeof(header));

end else

bitmap.savetostream(blobstream);

finally

blobstream.free;

end;

end;

procedure tblobfield.savetobitmap(bitmap: tbitmap);

var

blobstream: tblobstream;

size: longint;

header: tgraphicheader;

begin

blobstream := tblobstream.create(self, bmread);

try

size := blobstream.size;

if size >= sizeof(tgraphicheader) then

begin

blobstream.read(header, sizeof(header));

if (header.count$0100) or

(header.sizeosempty) then

savetostream(stream)

stream.seek(sizeof(tstreamheader), 0);

filestream.copyfrom(stream, stream.size - sizeof(tstreamheader));

stream.free;

filestream.free;

end;

olecontainer1包含的服务器对象是中文word 6.0,程序中将分离出的数据存储在磁盘文件“test.doc”上。如果希望存储在不同的媒介上,可以使用相应的stream对象,分离的方法类似。但是,这种方法并非对所有的ole服务器数据都适用,如windows 95 附件中的写字板(wordpad)就不行。

(jun 初级教程完)


======================================================
在最后,我邀请大家参加新浪APP,就是新浪免费送大家的一个空间,支持PHP+MySql,免费二级域名,免费域名绑定 这个是我邀请的地址,您通过这个链接注册即为我的好友,并获赠云豆500个,价值5元哦!短网址是http://t.cn/SXOiLh我创建的小站每天访客已经达到2000+了,每天挂广告赚50+元哦,呵呵,饭钱不愁了,\(^o^)/
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值