progress.pas

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

unit progress;

interface

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

type
  TFrm_data_g = class(TForm)
    Button4: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    PanelBkGnd: TPanel;
    Label6: TLabel;
    close_Btn: TBitBtn;
    Edit_path: TEdit;
    Button2: TButton;
    Button1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure close_BtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
   // procedure CompactAccess(dbName: string; JetId: string = '4.0');   //压缩
   //procedure PreFileList(Path: string; ListName: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_data_g: TFrm_data_g;

implementation

uses DataM, SelectDirUnit, bkUnit, ysUnit;

{$R *.dfm}

procedure FileSearch(PathName:string);
var
  F : TSearchRec;
  Found : Boolean;
begin
  ChDir(PathName);
  Found := (FindFirst('*.bak', faAnyFile, F) = 0);
  while Found do
  begin
    if (F.Name = '.') or (F.Name = '..') then
    begin
      Found := (FindNext(F) = 0);
      Continue;
    end;

    if (F.Attr and faDirectory)>0 then
    begin
      Application.ProcessMessages;
      FileSearch(F.Name);
    end;
    //插入你的代码，F.Name就是文件名，GetCurrentDir可以得到当前目录
    Found := (FindNext(F) = 0);
  end;
  FindClose(F);
  ChDir('..\');
end;
{procedure CompactAccess(dbName: string; JetId: string = '4.0');   //压缩
var
  AVariant: Variant;
begin
  if FileExists(dbName + '.tmp') then DeleteFile(DbName + '.tmp');
  AVariant := CreateOleObject('JRO.JetEngine');
  bffrm:=tbffrm.create(application);
  bffrm.showmodal;
  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 TFrm_data_g.FormCreate(Sender: TObject);
var
  SourcePath: string;
begin


  SourcePath := ExtractFileDir(Application.ExeName); //取得应用程序路径

  if (StrLen(PChar(SourcePath)) <> 3) then
    SourcePath := SourcePath + '\';
    Edit_path.Text := SourcePath + 'dlzy' +
        formatdatetime('yyyymmdd', date) + '.bak'; //设置路径名＋文件名

end;


procedure TFrm_data_g.close_BtnClick(Sender: TObject);
begin
close;
end;



procedure TFrm_data_g.Button1Click(Sender: TObject);

{var
  s,ss,dbname: string;}
begin
ysfrm:=tysfrm.create(application);
ysfrm.showmodal;
{  if dm.conn.Connected = true then dm.conn.Connected := false;

  Sleep(500);
  dbname := ExtractFilePath(Application.ExeName)+'upload\'+ 'dlzy.mdb';

  try


     CompactAccess(dbname);
     MessageBox(handle, '数据库压缩成功!', '提示', mb_IconInformation + mb_Ok);
  except
     showmessage('数据库正在被使用！请确定已关闭其它使用该数据库程序！');
     showmessage('压缩失败！');
  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 TFrm_data_g.BitBtn2Click(Sender: TObject);
begin
 bffrm:=tbffrm.create(application);
  bffrm.showmodal;
end;
procedure TFrm_data_g.BitBtn3Click(Sender: TObject);
var
 s,ss,DataPath, dbname, dbbname: string;
var
  F : TSearchRec;
  Found : Boolean;
begin
if dm.conn.Connected = true then dm.conn.Connected := false;
    OpenDialog1.Filter := '备份文件 (*.bak)|*.bak|所有文件 (*.*)|*.*';
    OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    if OpenDialog1.Execute then
    DataPath := OpenDialog1.FileName;
    if DataPath <> '' then
  begin
      if  application.MessageBox('此操作将使上次备份以来的所有数据丢失，是否继续？',
         '恢复数据', MB_OKCANCEL) = idOK then
     begin
       dbname := ExtractFilePath(Application.ExeName)+'upload\'+ 'dlzy.mdb';
       dbbname := ExtractFilePath(OpenDialog1.FileName)+extractfilename(OpenDialog1.FileName);
    if not FileExists(dbbname) then
       begin
         MessageBox(self.Handle, '没有备份数据,不能还原', '提示', mb_IconInformation + mb_Ok)
       end
    else
      if fileexists(dbname) then
             DeleteFile(dbname);

      try
             CopyFile(Pchar(dbbname), Pchar(dbname), true);
              MessageBox(handle, '数据库还原成功!', '提示', mb_IconInformation + mb_Ok);

      except
           showmessage('数据库正在被使用！请确定已关闭其它使用该数据库程序！');
           showmessage('    恢复失败！');

      end;
  end;

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;
      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;
end;


end;


procedure TFrm_data_g.Button2Click(Sender: TObject);
begin
Application.CreateForm(TSelectDir, SelectDir); //显示路径选择窗体
  SelectDir.DriveComboBox1.Text := ExtractFileDrive(Edit_path.Text);
  if (FileExists(Edit_path.Text)) then //检测路径是否存在
    SelectDir.DirectoryListBox1.Directory := Edit_path.Text;
  if (SelectDir.ShowModal = mrOK) then //当返回值为mrOK时，得到选择的路径
     begin
      // if (StrLen(PChar(SourcePath)) <> 3)

   if copy(SelectDir.Label3.Caption,length(SelectDir.Label3.Caption),1)<>'\' then
   SelectDir.Label3.Caption:=SelectDir.Label3.Caption+'\';
   Edit_path.Text := SelectDir.Label3.Caption + 'dlzy' +
                 formatdatetime('yyyymmdd', date) + '.bak';

       end;
  SelectDir.free;
end;

end.