bkunit.pas

地理资源的录入程序运用了api的一些知识

unit bkUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, ComObj,StdCtrls, WinSkinStore, WinSkinData;

type
  TysFrm = class(TForm)
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ysFrm: TysFrm;
   msgstr:string;
implementation

uses DataM;

{$R *.dfm}

 procedure CompactAccess(dbName: string; JetId: string = '4.0');   //压缩
var
  AVariant: Variant;
begin
  if FileExists(dbName + '.tmp') then DeleteFile(DbName + '.tmp');
  AVariant := CreateOleObject('JRO.JetEngine');

  AVariant.CompactDataBase('Provider=Microsoft.Jet.OLEDB.' + JetId + ';Data Source='+ dbName,
  'Provider=Microsoft.Jet.OLEDB.' + JetId + ';Data Source='+ dbName + '.tmp');

  DeleteFile(DbName);
  ReNameFile(dbName + '.tmp', DbName);

  end;

procedure TysFrm.Timer1Timer(Sender: TObject);
begin
//用于显示进度条及文字提示
  self.ProgressBar1.Position:=self.ProgressBar1.Position+1;
  if label1.Caption='正在压缩数据库.....' then label1.Caption:='正在压缩数据库' else label1.Caption:=label1.Caption+'.';
  if self.ProgressBar1.Position=self.ProgressBar1.Max then begin timer1.Enabled:=false;close; end;
end;

procedure TysFrm.FormActivate(Sender: TObject);
var
  s,ss,dbname: string;
begin
  if dm.conn.Connected = true then dm.conn.Connected := false;

  Sleep(500);
  dbname := ExtractFilePath(Application.ExeName)+'upload\'+ 'dlzy.mdb';
 
  try
       CompactAccess(dbname);
         msgstr :='数据库压缩成功';
    // else
    //   msgstr:='数据库压缩出错!数据库正在被使用！请确定已关闭其它使用该数据库程序！';
  except
     msgstr :='数据库压缩失败！数据库可能正在被使用！请确定已关闭其它使用该数据库程序！'

  end;
   //~~~~~~~~~~~~~~~~~~~~连接数据库~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


begin
   ss:=ExtractFileDir(application.ExeName);
   if copy(ss,length(ss),1)<>'\' then ss:=ss+'\';
   if not fileexists(ss+'\upload\dlzy.mdb') then
   begin
       application.MessageBox('找不到数据库！','错误信息',48);
       application.Terminate;
       exit;
   end;
   try
     dm.conn.close;
     s:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ss+'\upload\dlzy.mdb';
     s:=s+';Persist Security Info=false';
     dm.conn.ConnectionString:=s;
     dm.conn.Open();
   except
       try
         dm.conn.close;
         s:='Provider=Microsoft.Jet.OLEDB.3.51;Data Source='+ss+'\upload\dlzy.mdb';
         s:=s+';Persist Security Info=False';
         dm.conn.ConnectionString:=s;
         dm.conn.Open();
       except
         on e:exception do
         begin
           application.MessageBox(pchar('无法连接数据库！'+#13+#13+e.Message),'错误信息',16);
           application.Terminate;
           exit;
         end;
       end;
     end;
end;

end;


procedure TysFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  showmessage(msgstr);
Action := cafree;
end;

end.