unitsjbf.pas

纺织类 纤维强力测试中蠕变性能测试源码

unit UnitSJBF;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, FileCtrl;

type
  TDataBack = class(TForm)
    BackBtn: TButton;
    ResumlBtn: TButton;
    Bevel1: TBevel;
    Button2: TButton;
    Edit1: TEdit;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    Button1: TButton;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure BackBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ResumlBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataBack: TDataBack;

implementation

uses UnitNew;

{$R *.dfm}
function CurrentIsValidDir(SearchRec:TSearchRec):integer;
begin
if ((SearchRec.Attr <> 16) and
    (SearchRec.Name<>'.')  and
    (SearchRec.Name<>'..')) then
  Result:=0
  else if ((SearchRec.Attr = 16) and
           (SearchRec.Name<>'.') and
           (SearchRec.Name<>'..')) then
  Result:=1
  else
  Result:=2;
end;

procedure TDataBack.Button2Click(Sender: TObject);
begin
close;
end;

procedure TDataBack.FormCreate(Sender: TObject);
begin
edit1.Text:=DirectoryListBox1.Directory;
end;

procedure TDataBack.DirectoryListBox1Change(Sender: TObject);
begin
edit1.Text:=DirectoryListBox1.Directory;
end;

procedure TDataBack.BackBtnClick(Sender: TObject);
var

  i:Integer;
 CurrentDir:string;
 Subdir:TStringList;
 SearchRec:TsearchRec;
begin
//以下是递归部分，查找各子目录。
  //ml:=getcurrentdir;
  if not directoryexists(edit1.Text) then MKdir(edit1.Text);
  CurrentDir:=getcurrentdir;
  Subdir:=TStringList.Create;
 if (FindFirst(CurrentDir+'\*.*', faDirectory, SearchRec)=0) then
  begin
   repeat
    if CurrentIsValidDir(SearchRec)=1 then
     begin
      Subdir.Add(SearchRec.Name);
     end;
    application.ProcessMessages ;
   until (FindNext(SearchRec) <> 0);
  end;
 FindClose(SearchRec);
 //第一次调用FindFirst和FindNext查找符合要求的文件
 for i:=0 to Subdir.Count-1 do
  begin
   if (FindFirst(CurrentDir+'\'+Subdir.Strings[i]+'\*.mdb', faAnyFile, SearchRec)=0) then
  begin
   repeat
    if CurrentIsValidDir(SearchRec)=0 then
      begin
      copyfile(pchar(CurrentDir+'\'+Subdir.Strings[i]+'\'+SearchRec.Name),pchar(edit1.Text+'\'+SearchRec.Name),false);
      end;
     application.ProcessMessages ;
     until (FindNext(SearchRec) <> 0);
  end;
  FindClose(SearchRec);
  end;

//资源释放并返回结果。
 //Subdir.Free;

end;

procedure TDataBack.Button1Click(Sender: TObject);
begin
OKBottomDlg.ShowModal;
end;

procedure TDataBack.ResumlBtnClick(Sender: TObject);
begin
copyfile(pchar(getCurrentDir+'\数据库备份\yarn.mdb'),pchar(getCurrentDir+'\纤维性能测试\yarn.mdb'),false);
copyfile(pchar(getCurrentDir+'\数据库备份\yarn.mdb'),pchar(getCurrentDir+'\纱线性能测试\yarn.mdb'),false);
copyfile(pchar(getCurrentDir+'\数据库备份\fabric.mdb'),pchar(getCurrentDir+'\织物性能测试\yarn.mdb'),false);
end;

end.