compressdata.pas

一个源码客户信息管理系统

unit CompressData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzTabs, RzButton, StdCtrls, RzLabel, ExtCtrls;

type
  TCompressDataForm = class(TForm)
    Image1: TImage;
    RzLabel1: TRzLabel;
    RzBitBtn1: TRzBitBtn;
    //找出数据库的位置
    function LookOutDataSource:String;
    //打开数据
    procedure Opendata;
    procedure RzBitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CompressDataForm: TCompressDataForm;

implementation

uses DM, ComObj;

{$R *.dfm}

{ TCompressDataForm }

function TCompressDataForm.LookOutDataSource: String;
var
   F      : Word;
   Source,
   Temp   : String;
begin
//找出数据来源(字符串操作)
  Source := DM1.ADOConnection1.ConnectionString;
  F := Pos('Data Source=',Source);
  if F = 0 then
     Temp:=''
  else Temp:=Copy(Source,F+length('Data Source='),length(Source));

  F := Pos(';Mode=',Temp);
  if F = 0 then
     Result:=Temp
  else Result:=Copy(Temp,1,F-1);
end;

procedure TCompressDataForm.Opendata;
begin
   with DM1 do try
     ADOConnection1.Close;
     ADOConnection1.ConnectionString:='FILE NAME='+Application.GetNamePath+'Connect.udl';
     ADODataSet1.Open;
     ADODataSet2.Open;
     ADODataSet3.Open;
     ADODataSet4.Open;
     ADODataSet5.Open;
     ADODataSet6.Open;
     ADODataSet7.Open;
     ADODataSet8.Open;
     ADODataSet9.Open;
     ADODataSet10.Open;
     ADOTable1.Open;
     LinkManList.Open;
     SellList.Open;
     ADODataSet11.Open;
     LogData.Open;
     ADOSort.Open;
     ADODataSet1.Sort:='ID ASC';
     LogData.Sort:='Degree ASC';
   except
     messagebox(handle,'数据库打开出现意外失败，请重新启动应用程序。','错误',mb_ok+mb_iconerror);
   end;
end;

procedure TCompressDataForm.RzBitBtn1Click(Sender: TObject);
var
   dao    : OLEVariant;
   Source,
   Path   : String;
begin
//压缩数据库
//数据来源
Source:=LookOutDataSource;
if not FileExists(Source)then begin
   Messagebox(handle,'无法获得数据库来源，压缩修复ACCESS数据库失败。','错误',MB_OK+MB_ICONERROR);
   Exit;
end;

//数据路径
Path:=ExtractFilePath(Source);
try
   DM1.ADOConnection1.Close;
   dao:=CreateOleObject('DAO.DBEngine.36');
   dao.CompactDatabase(Source,Path+'_afs.da');
   DeleteFile(Source);
   RenameFile(Path+'_afs.da',Source);
   Opendata;
   Messagebox(handle,'数据库压缩成功！','提示',MB_OK+MB_ICONINFORMATION);
   Close;
except
  Messagebox(handle,pchar('无法正常读取数据库文件“'+Source+'”，如果该文件已经损坏或丢失，请重新安装本程序。'),'错误',MB_OK+MB_ICONERROR);
  Opendata;
end;
end;

end.