(*

create table test( { 表名为 test }

docid number not null, { 文档编号 }

docname varchar(40) not null, { 文档标题 }

subid number not null, { 文档子编号 }

text varchar(2000) not null, { 子文档内容 }

primary key(docid, subid)); { 联合主键 }

*) 下面是程序实例中的主要部分：

{ ... ... }

const

bufsize = 2000; { 串的最大容量 }

type

tbuffer = array [1..bufsize] of char; { 串缓存 }

tfileofchar = file of char; { 字符类型文件 }

tchnchar = string[2]; { 汉字字符类型 }

{ sql查询，返回首记录首字段的值 }

function selectsql(s: string): variant;

begin

result := null;

with tadoquery.create(application) do try

connection := fmain.adoconnection1;

sql.append(s);

sql.savetofile(''c:\a.txt'');

open;

result := fields[0].asvariant;

finally

free;

end;

end;

{ 下面的函数将rtf文档存入数据库 }

function rtftodb(arichedit: trichedit; { 文档容器 }

docname: string; { 文档标题 }

atable: tadotable { 操作的表 }

): boolean; { 返回类型 }

const

tmpfilename = ''c:\x.rtf''; { 临时文档 }

var

docid, subid, l: integer; { 局部变量 }

s: string; { 串 }

f: tfileofchar; { 字符文件 }

buf: tbuffer; { 文本缓存 }

begin

arichedit.lines.savetofile(tmpfilename);{ 先存入文件 }

assignfile(f, tmpfilename); { 打开文件 }

reset(f);

try

docid := { 产生新的文档编号 }

selectsql(''select nvl(max(docid) + 1, 101) from test'');

with atable do if not active then active := true;{ 确认表打开 }

subid := 0; { 初始化子编号 }

while not eof(f) do begin

inc(subid);

blockread(f, buf, bufsize, l); { 读取两千个字符 }

s := buf;

setlength(s, l); { 取实际读取到的字节数 }

with atable do begin { 增加一条子文档 }

append;

fieldbyname(''docid'').asinteger := docid;

fieldbyname(''docname'').asstring := docname;

fieldbyname(''subid'').asinteger := subid;

fieldbyname(''text'').asstring := s;

post;

end;

end;

result := true; { 存储成功 }

except

result := false;{ 存储失败 }

end;

closefile(f); { 关闭文件 }

deletefile(tmpfilename);{ 删除文件 }

end;

{ 下面的函数从数据库中读取rtf文档，并在指定的容器中显示 }

function rtffromdb(arichedit: trichedit;{ rtf文档容器 }

docname: string; { 文档标题 }

aquery: tadoquery { 操作的数据集 }

): boolean; { 返回类型 }

const

tmpfilename = ''c:\temp\x.rtf''; { 临时文件 }

var

s: string; { 局部串变量 }

f: tfileofchar; { 字符文件 }

buf: tbuffer; { 串缓存 }

i, l: integer; { 局部变量 }

begin

arichedit.clear; { 清除当前显示的内容 }

assignfile(f, tmpfilename); { 关联文件 }

try

rewrite(f); { 打开文件，准备写入从数据库读出的数据 }

with aquery do begin

active := false; { 关闭数据集 }

sql.clear; { 重建sql语句 }

sql.append(''select subid, text from test where docname = '''''' +

docname + '''''' order by subid'');

open; { 打开数据集 }

if recordcount <> 0 then begin { 确认数据集非空 }

first; { 移到首记录-子文档 }

repeat { 读出一条子文档并写入文件 }

s := fieldbyname(''text'').asstring;

l := length(s);

for i := 1 to l do buf[i] := s[i];

blockwrite(f, buf, l);

next;

until eof;

end;

end;

closefile(f);{ 关闭文件 }

arichedit.lines.loadfromfile(tmpfilename);{ 从文件中装入rtf文档 }

result := true; { 读取成功 }

except { 读取失败 }

try closefile(f); except end;

result := false;

end;

deletefile(tmpfilename); { 删除临时文件 }

end;

{ 下面的函数将汉字单字转换成rtf中表示的形式。 }

{ 如表示汉字“国”的是ascii(b9)和ascii(fa)，这里是十六进制； }

{ 那么在 rtf文件中对“国”字的表示占用了 8个字节： }

{ \''b9\''fa }

{ 因此，需要在查询之前进行转换。由于表示方法中含有delphi用于 }

{ 字符串的分解符：单撇号“''”，因此在转换时需要考虑这一点， }

{ 否则就不能构造出正确的 sql查询语句 }

function chnchartortfcode(ch: tchnchar): string;

var

c1, c2: char;

o1, o2: byte;

s: string;

begin

c1 := ch[1];

c2 := ch[2];

o1 := ord(c1);

o2 := ord(c2);

s := format(''\''''''''%2x'', [o1]) + format(''\''''''''%2x'', [o2]);

result := lowercase(s);{ 转换为小写 }

end;

{ 根据需要检索的关键字转换成like中使用的串。 }

{ 这里用于区别汉字的方法是根据编码。 }

{ 按照windows 中的双字节编码规则，对于双字节字符 }

{ 如汉字字符，是由两个字节构成，其中第一个字节是 }

{ 引导字符。汉字引导字符的ascii 码大于 127，因此 }

{ 可以根据此特点来区分汉字和单字节字符。 }

function makelikertfstring(strtofind: string): string;

var

i: integer;

chnchar: tchnchar;

s: string;

begin

s := '''';

i := 0;

while i < length(strtofind) do begin

inc(i);

if integer(strtofind[i]) >= $80 then begin{ 汉字的首字节一定不小于128 }

chnchar := strtofind[i] + strtofind[i + 1];

inc(i);

s := s + chnchartortfcode(chnchar);

end else begin{ 单字节字符 }

s := s + strtofind[i];

if strtofind[i] = '''''''' then s := s + strtofind[i];{ 单撇号的特殊处理 }

end;

end;

result := s;

end;

{ 构造对关键字进行全文检索的查询语句 }

function makelikestring(strtofind: string): string;

var

s: string;

begin

s := makelikertfstring(strtofind);

s := ''select distinct docname from test where text like ''''%'' + s + ''%'''''';

result := s;

end;

{ ... ... }