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

📄 opfileut.~pas

📁 某省公路收费站违章车辆抓拍管理系统
💻 ~PAS
字号:
unit opFileUt;

interface

uses Sysutils, Windows;

function DoCopyDir(sDirName: string; sToDirName: string): boolean;
function CopyDir(sDirName: string; sToDirName: string): boolean;
function DoRemoveDir(sDirName: string): boolean;
function DeleteDir(sDirName: string): boolean;
function movedir(sDirName: string; sToDirName: string): boolean;

implementation

function DoCopyDir(sDirName: string; sToDirName: string): boolean;
var
  hFindFile: cardinal;
  t, tfile: string;
  sCurDir: string[255];
  FindFileData: WIN32_FIND_DATA;
begin
  //先保存当前目录
  sCurDir := GetCurrentDir;
  ChDir(sDirName);
  hFindFile := FindFirstFile('*.*', FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then begin
    if not DirectoryExists(sToDirName) then
      ForceDirectories(sToDirName);
    repeat
      tfile := FindFileData.cFileName;
      if (tfile = '.') or (tfile = '..') then
        continue;
      if FindFileData.dwFileAttributes =
        FILE_ATTRIBUTE_DIRECTORY then begin
        t := sToDirName + '\' + tfile;
        if not DirectoryExists(t) then
          ForceDirectories(t);
        if sDirName[Length(sDirName)] <> '\' then
          DoCopyDir(sDirName + '\' + tfile, t)
        else
          DoCopyDir(sDirName + tfile, sToDirName + tfile);
      end
      else begin
        t := sToDirName + '\' + tfile;
        copyfile(PChar(tfile), PChar(t), true);
      end;
    until FindNextFile(hFindFile, FindFileData) = false;
    FindClose(hFindFile);
  end
  else begin
    ChDir(sCurDir);
    result := false;
    exit;
  end;
  //回到原来的目录下
  ChDir(sCurDir);
  result := true;
end;


function CopyDir(sDirName: string; sToDirName: string): boolean;
begin
  if Length(sDirName) <= 0 then begin
    result := false;
    exit;
  end;
  //拷贝...
  result := DoCopyDir(sDirName, sToDirName);
end;

function DoRemoveDir(sDirName: string): boolean;
var
  hFindFile: cardinal;
  tfile: string;
  sCurDir: string;
  bEmptyDir: boolean;
  FindFileData: WIN32_FIND_DATA;
begin
  //如果删除的是空目录,则置bEmptyDir为True
  //初始时,bEmptyDir为True
  bEmptyDir := true;
  //先保存当前目录
  sCurDir := GetCurrentDir;
  SetLength(sCurDir, Length(sCurDir));
  ChDir(sDirName);
  hFindFile := FindFirstFile('*.*', FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then begin
    repeat
      tfile := FindFileData.cFileName;
      if (tfile = '.') or (tfile = '..') then begin
        bEmptyDir := bEmptyDir and true;
        continue;
      end;
      //不是空目录,置bEmptyDir为False
      bEmptyDir := false;
      if FindFileData.dwFileAttributes =
        FILE_ATTRIBUTE_DIRECTORY then begin
        if sDirName[Length(sDirName)] <> '\' then
          DoRemoveDir(sDirName + '\' + tfile)
        else
          DoRemoveDir(sDirName + tfile);
        if not RemoveDirectory(PChar(tfile)) then
          result := false
        else
          result := true;
      end
      else begin
        if not DeleteFile(PChar(tfile)) then
          result := false
        else
          result := true;
      end;
    until FindNextFile(hFindFile, FindFileData) = false;
    FindClose(hFindFile);
  end
  else begin
    ChDir(sCurDir);
    result := false;
    exit;
  end;
  //如果是空目录,则删除该空目录
  if bEmptyDir then begin
    //返回上一级目录
    ChDir('..');
    //删除空目录
    RemoveDirectory(PChar(sDirName));
  end;

  //回到原来的目录下
  ChDir(sCurDir);
  result := true;
end;

function DeleteDir(sDirName: string): boolean;
begin
  if Length(sDirName) <= 0 then begin
    result := false;
    exit;
  end;
  //删除...
  result := DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;

function movedir(sDirName: string; sToDirName: string): boolean;
begin
  if CopyDir(sDirName, sToDirName) then begin
    if RemoveDir(sDirName) then begin
      result := true
    end
    else begin
      result := false;
    end;
  end
  else result := false;
end;

end.

⌨️ 快捷键说明

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