accesscompact.dpr

MS ACCESS 数据库文件的压缩 Delphi 实现

program ACCESSCOMPACT;

// ***************************************************************************
//
// AccessCompact compacts and repairs Access 97 and Access 2000 databases.
//
// Author: David Simpson ([e-mail]), 19 Feb 2000
//
// Minor changes: Bob Wasaff ([e-mail]), 29 Sep 00 2000
//                David Simpson, 30 Sep 2000
//  Microsoft Jet 4.0 ADO 2.x
// ***************************************************************************

{$APPTYPE CONSOLE} 

uses
  SysUtils,
  ActiveX,
  JRO_TLB,
  ADODB_TLB in 'D:\Program Files\Borland\Delphi5\Imports\ADODB_TLB.pas';

// 'Microsoft Jet and Replication Objects 2.5 Library' or later
// C:\Program Files\Common Files\System\ADO\msjro.dll 

procedure CompactDB(const DBname, DBtype: string); 
var 
  MyJetEngine: JetEngine; 
  strDataSource, 
  strDataDest, 
  strDataDestName: string; 

begin 
  if not FileExists(DBname) then
    begin
      Writeln ('错误: 未找到文件 ', DBName);
     // writeln('Error: ''', DBName, ''' not found.');
      exit;
    end; 
  // delete any previous temporary mdb file
  strDataDestName := ExtractFilePath(DBname) + 'temp.mdb'; 
  if FileExists(StrDataDestName) then 
    begin 
      DeleteFile(strDataDestName); 
      writeln('删除用过的临时文件  ', strDataDestName);
    end;

  strDataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DBname + ';';
  strDataDest := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + strDataDestName + ';';

  // default to Access 2000 format unless 97 format is specified
  { default changed 30 Sep 2000 DRS }
  if DBtype = '97' then
    // Use Engine Type 4 for Access 97 db
    strDataDest := strDataDest + 'Jet OLEDB:Engine Type=4'
  else
    // Use Engine Type 5 for Access 2000 db
    strDataDest := strDataDest + 'Jet OLEDB:Engine Type=5';

  MyJetEngine := CoJetEngine.Create();
  try
    MyJetEngine.CompactDatabase(strDataSource, strDataDest);
    writeln(DBname, ' 被压缩到文件 ', strDataDestName + '。');
    MyJetEngine := nil;
    if DeleteFile(DBname) then
      begin
        writeln(DBname, ' 被清除。');
        if RenameFile(strDataDestName, DBName) then
          writeln(strDataDestName, ' 被恢复成 ', DBname + '。！！！！！！！成功完成。')
        else
          writeln('错误: ', strDataDestName, ' 不能被恢复到 ', DBname, '。');
      end
    else 
      writeln('错误: ', DBname, ' 不能被清除。');
  except 
    on E: Exception do writeln('错误: ', E.Message); 
  end 
end; 

begin 
  if ParamCount = 0 then 
    begin                            
      writeln('参数错误: 查看帮助信息请输入 "ACCESSCOMPACT [/]?" '); {Changed 29 Sep 2000 RVW} 
      halt; 
    end; 
  if (ParamStr(1) = '/?') or {Changed 29 Sep 2000 RVW} 
     (ParamStr(1) = '?') then 
    begin
      write('ACCESS 97/2000 数据 压缩修复 程序。');
      writeln('  操作完成后将重建数据库文件中的自动增量索引。'); 
      writeln('系统支持：Microsoft Jet and Replication Objects 2.5 Library or later');
      writeln; 
      writeln('ACCESSCOMPACT [drive:][path]filename [[/,-]97|2000]'); {Changed 29 Sep 2000 RVW} 
      writeln;
      writeln('  [drive:][path]filename  指定要操作的 ACCESS 97/2000 数据库文件。');
      writeln('  [97|2000]               数据库文件版本为 ACCESS 97 或 ACCESS 2000。缺省为 ACCESS 2000。');
      writeln;
      write('该文件将自动转到 命令行 模式下执行。');
      writeln('该文件为 命令行 模式设计，也可直接作为 WINDOWS NT 下的控制调度程序运行。');
      writeln('感谢： David Simpson, 30 Sep 2000 ');
      writeln('程序编制：赵清伟(Qingwei Zhao) 2002  CopyRight LuckSunbird 。  ');
    end 
  else 
    begin 
      CoInitialize(nil); 
      if (ParamCount = 2) then
        // default to Access 2000 format unless 97 format selected 
        if (Paramstr(2) = '-97') or {Changed 29 Sep 2000 RVW} 
        (Paramstr(2) = '/97') or 
          (Paramstr(2) = '97') then 
          CompactDB(ParamStr(1), '97') 
        else
          CompactDB(ParamStr(1), '2000')
      else 
        CompactDB(ParamStr(1), '2000'); 
    end 
end.