unit WordToBity;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, StdCtrls, Buttons, OleCtnrs,Zlib;
type
TForm1 = class(TForm)
ADC: TADOConnection;
ADS: TADODataSet;
BitBtn1: TBitBtn;
OLE: TOleContainer;
Button1: TButton;
Edit1: TEdit;
procedure BitBtn1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure StringToComponent(Value: string;aComponet:TComponent);
function getHeadInfor(aOLE: TOleContainer):string;
procedure SaveCompInforToDb(Component: TComponent);
procedure ReadCompInforFromDb(index:string;
aOLE:TOleContainer);
function ComponentToString(Component: TComponent): string;
function CompressString(input:string):string;
function DeCompressString(input:string):string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i:integer;
begin
for i:=1 to 2 do
begin //当前路径
OLE.CreateObjectFromFile('word/'+inttostr(i)+'.doc',False);
OLE.DoVerb(ovPrimary );
SaveCompInforToDb(OLE);
exit;
end;
end;
//==============================================================================
//Summeray:把组件信息存储到数据库中
//==============================================================================
procedure TForm1.SaveCompInforToDb(Component: TComponent);
var
tempstr:string;
index:integer;
begin
if ADS.Active then ADS.Active:=True;
ADS.CommandText:='select * from HZ_Bid';
ADS.Active:=True;
ADS.Append;
ADS.FieldByName('ID').AsString:=IntToStr(ADS.Recordcount+1);
tempstr:=ComponentToString(Component);
index:=pos('Data = {',tempstr);
Delete(tempstr,1,index+Length('Data = {')-1);
ShowMessage(IntToStr(Length(tempstr)));
tempstr:=CompressString(tempstr);//压缩字符创
ShowMessage(IntToStr(Length(tempstr)));
ADS.FieldByName('Word').AsString:=tempstr;
ADS.post;
end;
//==============================================================================
//Summeray:得到OLE控件流文件的头信息
//==============================================================================
function TForm1.getHeadInfor(aOLE: TOleContainer): string;
var
strName:string;
begin
strName:=String(aOLE.Name);
Result:='object '+ strName+' : TOleContainer'+#13+#10+
'Left ='+IntToStr(aOLE.Left)+#13+#10+
'Top ='+IntToStr(aOLE.Top)+#13+#10+
'Width ='+IntToStr(aOLE.Top)+#13+#10+
'Height ='+IntToStr(aOLE.Height)+#13+#10+
'Caption = '+ quotedstr(aOLE.Caption)+#13+#10+
'TabOrder = 0'+#13+#10+
'Data = {';
end;
//==============================================================================
//Summeray:得到OLE控件流的流信息转换成字符串
//==============================================================================
function TForm1.ComponentToString(Component: TComponent): string;
var
BinStream:TMemoryStream;
StrStream: TStringStream;
s: string;
begin
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result:= StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free
end;
end;
//==============================================================================
//Summeray:把二进制的信息流转换为组件
//==============================================================================
procedure TForm1.StringToComponent(Value: string; aComponet: TComponent);
var
StrStream:TStringStream;
BinStream: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
BinStream.ReadComponent(aComponet)
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;
//==============================================================================
//Summeray:读取数据库中的组件信息
//==============================================================================
procedure TForm1.ReadCompInforFromDb(index:string;
aOLE:TOleContainer);
var
Tmpstr:string;
headinfor:string;
begin
headinfor:='';
with ADS do
begin
if Active then Active:=False;
CommandText:='Select * from HZ_Bid';
Active:=True;
Locate('id',Trim(index),[]);
Tmpstr:=FieldByName('Word').AsString;
end;
headinfor:=getHeadInfor(aOLE);
Tmpstr:=DeCompressString(Tmpstr);//解压字符串
Tmpstr:=headinfor+Tmpstr;
StringToComponent(Tmpstr,aOLE);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ReadCompInforFromDb(Trim(Edit1.Text),OLE);
OLE.DoVerb(1);
end;
//===============================压缩字符串=====================================
function TForm1.CompressString(input: string): string;
var
InpBuf, OutBuf: Pointer;
OutBytes: Integer;
begin
InpBuf := nil;
OutBuf := nil;
try
GetMem(InpBuf, Length(input));
Move(input[1], InpBuf^, Length(input));
CompressBuf(InpBuf, Length(input), OutBuf, OutBytes);
SetLength(result,OutBytes);
Move(OutBuf^, result[1], OutBytes);
finally
if InpBuf <> nil then FreeMem(InpBuf);
if OutBuf <> nil then FreeMem(OutBuf);
end;
end;
//============================解压字符串========================================
function TForm1.DeCompressString(input: string): string;
var
InpBuf, OutBuf: Pointer;
OutBytes: Integer;
begin
InpBuf := nil;
OutBuf := nil;
try
GetMem(InpBuf, Length(input));
Move(input[1], InpBuf^, Length(input));
DeCompressBuf(InpBuf, Length(input),0,OutBuf, OutBytes);
SetLength(result,OutBytes);
Move(OutBuf^, result[1], OutBytes);
finally
if InpBuf <> nil then FreeMem(InpBuf);
if OutBuf <> nil then FreeMem(OutBuf);
end;
end;
end.