ysunit.pas

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

unit ysUnit;

interface

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

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

var
  bfFrm: TbfFrm;
   msgstr:string;
implementation

uses DataM, progress;

{$R *.dfm}

procedure TbfFrm.FormActivate(Sender: TObject);
var
  p,dbname: string;
  s,ss:string;
begin
 if dm.conn.Connected = true then dm.conn.Connected := false;
  try
   //Frm_data_g.a1.Active :=true;
   dbname :=Frm_data_g.Edit_path.Text;
    p:=ExtractFilePath(paramstr(0));
    if FileExists(dbname) then DeleteFile(dbname);
if  CopyFile(Pchar(p+'upload\'+ 'dlzy.mdb'), Pchar(dbname), true) then
       begin msgstr:='备份数据库成功完成!';
       // Frm_data_g.a1.Active :=false;
        end
     else
      msgstr:='数据库备份出错!请检查数据文件或磁盘。';
      // Frm_data_g.a1.Active :=false;
except
   msgstr:='数据库备份出错!请检查数据文件或磁盘。';
 // MessageBox(handle, '数据库备份成功!', '提示', mb_IconInformation + mb_Ok);
 // Frm_data_g.a1.Active :=false;


    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 // if dm.conn.Connected = false then dm.conn.Connected := true;
 //except
   //   showmessage('数据库正在被使用！请确定已关闭其它使用该数据库程序！');
   //   showmessage('备份失败');
  end;

end;


procedure TbfFrm.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 TbfFrm.FormClose(Sender: TObject; var Action: TCloseAction);
 var ss,s: string;
begin
//~~~~~~~~~~~~~~~~~~~~连接数据库~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


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;
  with dm do
 begin
user.Active :=true;
tbinput.Active :=true;
lyxx.Active :=true;
tdlyxx.Active :=true;
dqjjxx.Active :=true;

//qur_dmb.Active :=true;
//zyflml.Active :=true;
dlxxzy.Active :=true;
//adoqry_sl.Active :=true;
end;


  showmessage(msgstr);
Action := cafree;
end;

end.