求：ACCSEE数据库的压缩备份与解压恢复代码，在线。。。。。。

[net_jun]

如题。请贴出代码。

[MEFULEU]

zip控件的压缩效果不就很好用吗？
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Zlib, StdCtrls,FileCtrl;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
opendlg: TOpenDialog;
savedlg: TSaveDialog;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


procedure CompressFiles(Files : TStrings; const Filename : String);

var

infile, outfile, tmpFile : TFileStream;

compr : TCompressionStream;

i,l : Integer;

s : String;

begin

if Files.Count > 0 then

begin

outFile := TFileStream.Create(Filename,fmCreate);

try

{ the number of files }

l := Files.Count;

outfile.Write(l,SizeOf(l));

for i := 0 to Files.Count-1 do

begin

infile := TFileStream.Create(Files[i],fmOpenRead);

try

{ the original filename }

s := ExtractFilename(Files[i]);

l := Length(s);

outfile.Write(l,SizeOf(l));

outfile.Write(s[1],l);

{ the original filesize }

l := infile.Size;

outfile.Write(l,SizeOf(l));

{ compress and store the file temporary}

tmpFile := TFileStream.Create('tmp',fmCreate);

compr := TCompressionStream.Create(clMax,tmpfile);

try

compr.CopyFrom(infile,l);

finally

compr.Free;

tmpFile.Free;

end;

{ append the compressed file to the destination file }

tmpFile := TFileStream.Create('tmp',fmOpenRead);

try

outfile.CopyFrom(tmpFile,0);

finally

tmpFile.Free;

end;

finally

infile.Free;

end;

end;

finally

outfile.Free;

end;

DeleteFile('tmp');

end;

end;

procedure DecompressFiles(const Filename, DestDirectory : String);

var

dest,s : String;

decompr : TDecompressionStream;

infile, outfile : TFilestream;

i,l,c : Integer;

begin

// IncludeTrailingPathDelimiter (D6/D7 only)

dest := IncludeTrailingPathDelimiter(DestDirectory);

infile := TFileStream.Create(Filename,fmOpenRead);

try

{ number of files }

infile.Read(c,SizeOf(c));

for i := 1 to c do

begin

{ read filename }

infile.Read(l,SizeOf(l));

SetLength(s,l);

infile.Read(s[1],l);

{ read filesize }

infile.Read(l,SizeOf(l));

{ decompress the files and store it }

s := dest+s; //include the path

outfile := TFileStream.Create(s,fmCreate);

decompr := TDecompressionStream.Create(infile);

try

outfile.CopyFrom(decompr,l);

finally

outfile.Free;

decompr.Free;

end;

end;

finally

infile.Free;

end;

end;
///////////////////////////////////////////////////////////////////////////////
//在一个句炳上显示提示
procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text:PWideChar);
const

TOOLTIPS_CLASS = 'tooltips_class32';

TTS_ALWAYSTIP = $01;

TTS_NOPREFIX = $02;

TTS_BALLOON = $40;

TTF_SUBCLASS = $0010;

TTF_TRANSPARENT = $0100;

TTF_CENTERTIP = $0002;

TTM_ADDTOOL = $0400 + 50;

TTM_SETTITLE = (WM_USER + 32);

ICC_WIN95_CLASSES = $000000FF;

type

TOOLINFO = packed record

cbSize: integer;

uFlags: integer;

hwnd: THandle;

uId: integer;

rect: TRect;

hinst: THandle;

lpszText: PWideChar;

lParam: integer;

end;

var

hWndTip: THandle;

ti: TOOLINFO;

hWnd: THandle;

begin

hWnd := Control.Handle;

hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,

WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,

0, 0, 0, 0, hWnd, 0, HInstance, nil);

if hWndTip <> 0 then

begin

SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

ti.cbSize := SizeOf(ti);

ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;

ti.hwnd := hWnd;

ti.lpszText := Text;

Windows.GetClientRect(hWnd, ti.rect);

SendMessage(hWndTip, TTM_ADDTOOL, 1, integer(@ti));

SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));

end;

end;



procedure TForm1.Button1Click(Sender: TObject);
var dir :String;
begin
if opendlg.Execute then
begin
if SelectDirectory('我的电脑','请选择要压缩的文件',dir) then
begin
DecompressFiles(opendlg.FileName,dir);
ShowMessage('解压完毕!');
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
filename :String;
i :integer;
lt :TStringList;
dir :String ;
begin
lt:=TStringList.Create;
lt.Clear;
if opendlg.Execute then
begin
for i:=0 to opendlg.Files.Count-1 do
begin
lt.Add(opendlg.Files.Strings[i])
end;

if savedlg.Execute then
begin
CompressFiles(lt,savedlg.FileName);
end;

ShowMessage('压缩完毕!');
end;

lt.Free ;
end;

[SharpExpress]

用zlib很多相关说明的

[constantine]

问题：在Delphi中用ADO压缩Access数据库之不引用JRO类型库方法

看到很多富翁提出类似问题,给出一个比较好的解决方法
第一个参数为原始数据库文件名(完整路径),第二个参数为密码
修改后可以实现压缩后与压缩前有不同的密码!
//引用ComObj,ActiveX
function CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
const
SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
+'Jet OLEDB:Database Password=%s;';
var
SPath,SFile:Array [0..254] Of Char;
STempFileName:String;
JE:OleVariant;
begin
GetTempPath(40,SPath);//取得Windows的Temp路径
GetTempFileName(SPath,'~CP',0,SFile);//取得Temp文件名,Windows将自动建立0字节文件
STempFileName:=SFile;//PChar->String
DeleteFile(STempFileName);//删除Windows建立的0字节文件
try
JE:=CreateOleObject('JRO.JetEngine');//建立OLE对象,函数结束OLE对象超过作用域自动释放
OleCheck(JE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
format(SConnectionString,[STempFileName,APassWord])));//压缩数据库
//复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有达到函数的功能
result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
DeleteFile(STempFileName);//删除临时文件
except
result:=false;//压缩失败
end;
end;

---------------------------------------
动态创建、压缩Access数据库(*.MDB)

声明：这是前无古人，后无来者的解决方案(有点吹，但是我实在太激动了！)，希望各位能多多关照
创建Access数据库几乎是所有Delphi+Access所遇到的难题，我经过两头(昨天上午到现在)的艰苦奋战，终于将它全部解开，现在一一奉献给大家：

一、通过OLE方式创建
相信各位都用通过OLE方式访问Word、Excel文件的经历，具体我不说太多，直接把具体代码写出来就完了
在引用部分加入：
uses ComObj;
实现部分：
procedure TFormOffice.BitBtn1Click(Sender: TObject);
var
CreateAccess:OleVariant;
begin
CreateAccess:=CreateOleObject('ADOX.Catalog');
CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\Aceco.mdb');
end;

说明：
1、在C:\下创建Aceco.mdb；
2、是Access2000格式，用Access97打不开；
3、系统需安装MDAC，这是好消息，客户不需安装Access也可以

二、通过DBEngine创建
这才是关键中的关键，是我一定要写出来的原因！
各位是否还记得安装Delphi的时候，如果你选择自定义安装(我一般用Delphi写控件，所以当然是越小越好)，会有很多安装选项，让你选择Access97或Access2000，还有MDAC等，问题就在这里！Delphi5.0中早就封装了现成的类，只是大家都没有注意而已它位于：
$Delphi5\Imports
目录下！
其中有DAO97.DCU文件，它是通过DAO350.DLL来完成的，其中的定义部分和DAO350.DLL如出一辙！OK，到现在，所有的一切都明白了(可惜我花了一天时间！)。那么具体实现起来就太方便了，具体过程如下：
在引用部分加入：
uses DAO97;
实现部分：
procedure TFormOffice.BitBtn4Click(Sender: TObject);
var
Engine:DBEngine;
begin
Engine:=CoDBEngine.Create;
Engine.CreateDatabase('c:\NewAccess.mdb',';LANGID=0x0804;CP=936;COUNTRY=0;',dbEncrypt);
end;

说明：
1、在C:\下创建NewAccess.mdb；
2、语言国家是简体中文；
3、压缩整理数据库用Engine.CompactDatabase('c:\invoice.mdb','c:\God.mdb','',0,'');就是将c:\invoice.mdb压缩整理成c:\God.mdb，剩下的只是将c:\invoice.mdb删除(DeleteFile('c:\invoice.mdb');)，然后将c:\God.mdb重新命名(RenameFile('c:\God.mdb','c:\invoice.mdb');)即可。

三、通过Access97创建，然后拷贝
四、通过ODBC的API函数创建

补充：
1、通过OLE方式创建时如果是Access97，那么可能是CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.3.5.1;Data Source=c:\Aceco.mdb');，嘿嘿，小弟对VB实在是一窍不通，还望各位再测试一下(可以需要MDAC比较低的版本)。
2、关于CreateDatabase中国家的设置：
Module LanguageConstants; // DAO predefined constants.
dbLangArabic = ;LANGID=0x0401;CP=1256;COUNTRY=0;
dbLangCzech = ;LANGID=0x0405;CP=1250;COUNTRY=0;
dbLangDutch = ;LANGID=0x0413;CP=1252;COUNTRY=0;
dbLangGeneral = ;LANGID=0x0409;CP=1252;COUNTRY=0;
dbLangGreek = ;LANGID=0x0408;CP=1253;COUNTRY=0;
dbLangHebrew = ;LANGID=0x040D;CP=1255;COUNTRY=0;
dbLangHungarian = ;LANGID=0x040E;CP=1250;COUNTRY=0;
dbLangIcelandic = ;LANGID=0x040F;CP=1252;COUNTRY=0;
dbLangNordic = ;LANGID=0x041D;CP=1252;COUNTRY=0;
dbLangNorwDan = ;LANGID=0x0414;CP=1252;COUNTRY=0;
dbLangPolish = ;LANGID=0x0415;CP=1250;COUNTRY=0;
dbLangCyrillic = ;LANGID=0x0419;CP=1251;COUNTRY=0;
dbLangSpanish = ;LANGID=0x040A;CP=1252;COUNTRY=0;
dbLangSwedFin = ;LANGID=0x040B;CP=1252;COUNTRY=0;
dbLangTurkish = ;LANGID=0x041F;CP=1254;COUNTRY=0;
dbLangJapanese = ;LANGID=0x0411;CP=932;COUNTRY=0;
dbLangChineseSimplified = ;LANGID=0x0804;CP=936;COUNTRY=0;
dbLangChineseTraditional = ;LANGID=0x0404;CP=950;COUNTRY=0;
dbLangKorean = ;LANGID=0x0412;CP=949;COUNTRY=0;
dbLangThai = ;LANGID=0x041E;CP=874;COUNTRY=0;
dbLangSlovenian = ;LANGID=0x0424;CP=1250;COUNTRY=0;

3、关于CreateDatabase中数据库版本信息
Enum DatabaseTypeEnum;
dbVersion10 = 1;
dbEncrypt = 2;
dbDecrypt = 4;
dbVersion11 = 8;
dbVersion20 = 16;
dbVersion30 = 32;

4、其它方面，希望各位再加补充。


StarFarm-->Hank
2000/12/29

[Mrkang]

gz

[OYGX]

// Access 数据库压缩后，只是原数据库密码被清除　　uses ComObj,ExtCtrls;
procedure TFmain.button1Click(Sender: TObject);
var
X: OleVariant;
sourcefiles,tempfiles:string;
begin
try //此处换你的数据库名
sourcefiles:=extractfilepath(application.exename)+'db1.mdb';
tempfiles:=extractfilepath(application.exename)+'temp.mdb';
ADOConnection1.Connected:=false;
X:= createoleobject('JRO.JetEngine');
X.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=123456;Data Source='+sourcefiles+'','Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+tempfiles+'');
if fileExists(sourcefiles) and FileExists(tempfiles) then
if deleteFile(sourcefiles)then
RenameFile(tempfiles,sourcefiles);
ADOConnection1.Connected:=true;
application.MessageBox('数据库维护，压缩完毕！','系统提示:',mb_ok+64);
except
X.Release;
end;
end;

[蒋晟]

in DAO, specify ";pwd=password;" in the Password parameter of CompactDatabase. In JRO, specify the 'provider-specific "Jet OLEDB:Database Password=password" in the destination connection parameter of 'CompactDatabase.