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;

{ ... ... }