oracle有rtf函数,Delphi中对Oracle存取RTF文档(作者：苏涌)

(*

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;

{ ... ... }