udataoper.pas

非长好的DELPHI办公系统 直接可以用

unit uDataOper;

interface

uses
  Windows, Classes, SysUtils, Variants, ComObj, ADODB;

type
  TDisProgress = class(TThread)
    private
      { Private declarations }
    protected
      procedure Execute; override;
  end;



implementation


procedure CompactAccess(ADBName: string; JetId: string = '4.0');   //压缩
var
  AVariant: Variant;
begin
  if FileExists(ADBName + '.tmp') then DeleteFile(ADBName + '.tmp');
  AVariant := CreateOleObject('JRO.JetEngine');
  AVariant.CompactDataBase('Provider=Microsoft.Jet.OLEDB.' + JetId + ';Jet OLEDB:DataBase Password=780927+790621;Data Source=' + ADBName ,
  'Provider=Microsoft.Jet.OLEDB.' + JetId + ';Jet OLEDB:DataBase Password=780927+790621;Data Source=' + ADBName + '.tmp');
  DeleteFile(ADBName);
  ReNameFile(ADBName + '.tmp', ADBName);
end;

procedure BackupData(hPar: THandle; acPer: TADOConnection);
var
  sBakName: string;
begin
  sBakName := 'per' + FormatDateTime('mmdd', Date()) + '.bak';
  if FileExists(sBakName) and (MessageBox(hPar, PAnsiChar('今天数据已有备件,要重新备份吗?'), '提示', MB_YESNO + MB_ICONQUESTION) = IDNO) then Exit;
  TDisProgress.Create(False);
  if FileExists(sBakName) then DeleteFile(sBakName);
  CopyFile(PAnsiChar('permis.mdb'), PAnsiChar(sBakName), True);
  CompactAccess(sBakName);
end;

procedure ComRepData(hPar: THandle; acPer: TADOConnection);
begin
  if acPer.Connected then acPer.Close;
  try
    try
      CompactAccess('goods.mdb');
    except
      MessageBox(hPar, PAnsiChar('压缩修复失败,请确定数据库不在使用中!'), '提示', MB_OK + MB_ICONINFORMATION);
    end;
  finally
    acPer.Connected := True;
  end;
end;

procedure RestoreData(hPar: THandle; acPer: TADOConnection);
begin
  frmReData := TfrmReData.Create(nil, hPar, acPer);
  frmReData.ShowModal;
  FreeAndNil(frmReData);
end;

procedure ExportData(hPar: THandle; acPer: TADOConnection);
begin
  frmExData := TfrmExData.Create(nil, hPar, acPer);
  frmExData.ShowModal;
  FreeAndNil(frmExData);
end;

{ TDisProgress }


end.