spiegel-keyman/common/windows/delphi/general/utildir.pas

(*
  Name:             utildir
  Copyright:        Copyright (C) SIL International.
  Documentation:
  Description:
  Create Date:      20 Jun 2006

  Modified Date:    3 Feb 2015
  Authors:          mcdurdin
  Related Files:
  Dependencies:

  Bugs:
  Todo:
  Notes:
  History:          20 Jun 2006 - mcdurdin - Initial version
                    01 Aug 2006 - mcdurdin - Refactor util functions into multiple units
                    06 Oct 2006 - mcdurdin - Fix KGetTempFileName not returning correct extension
                    20 Jul 2008 - mcdurdin - Raise excpetion if GetTempFileName fails to avoid possible deletion of wrong files
                    16 Jan 2009 - mcdurdin - Widestring directory functions
                    16 Jan 2009 - mcdurdin - Fix crash when two copies of Keyman start simultaneously and try and grab the same temp folder name
                    04 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
                    01 May 2014 - mcdurdin - I4181 - V9.0 - Stop using DeleteFileAlways, MOVEFILE_DELAY_UNTIL_REBOOT
                    03 Feb 2015 - mcdurdin - I4574 - V9.0 - If any files are read-only, they need the read-only flag removed on install
*)
unit utildir;  // I3306

interface

function DirectoryEmpty(dir: WideString): Boolean;
function DirectoryExists(const Name: string): Boolean;
function ForceDirectories(Dir: string): Boolean;
procedure UnforceDirectories(Dir: string);
function EmptyDirectory(Dir: WideString): Boolean;
function RecursiveDelete(Dir: WideString): Boolean;   // I4181

function CopyFileCleanAttr(const src, dst: string; failIfExists: Boolean): Boolean;   // I4574
function DeleteFileCleanAttr(const filename: string): Boolean;   // I4574

function CreateTempPath: string;
procedure DeleteTempPath(const Path: string);

function KGetTempFileName(const ext: string = ''): string; // deprecated 'has race condition, use TTempFileManager';--> only used by debug functionality now   // I4181
function KGetTempPath: string;

function GetLongFileName(const fname: string): string;

function DosSlashes(const filename: string): string;

implementation

uses
  System.StrUtils,
  System.SysUtils,
  Winapi.Windows;

function DosSlashes(const filename: string): string;
begin
  Result := ReplaceStr(filename, '/', '\');
end;

function DirectoryEmpty(dir: WideString): Boolean;
var
    f: TSearchRec;
    n: Integer;
begin
    Result := False;
    if dir = '' then Exit;
    if dir[Length(dir)] <> '\' then dir := dir + '\';
    n := FindFirst(dir+'*.*', faDirectory, f);
    try
        while n = 0 do
        begin
            if (f.Name <> '.') and (f.Name <> '..') then Exit;
            n := FindNext(f);
        end;
    finally
        System.SysUtils.FindClose(f);
    end;
    Result := True;
end;

function EmptyDirectory(Dir: WideString): Boolean;
var
  f: TSearchRec;
  n: Integer;
begin
  Result := True;
  if dir = '' then Exit;
  if dir[Length(dir)] <> '\' then dir := dir + '\';
  n := FindFirst(dir+'*.*', faDirectory, f);
  try
    while n = 0 do
    begin
      if (f.Name <> '.') and (f.Name <> '..') then
      begin
        if (f.Attr and faDirectory) = faDirectory
          then Result := Result and EmptyDirectory(Dir + f.Name)
          else Result := Result and DeleteFileCleanAttr(Dir + f.Name);   // I4574
      end;
      n := FindNext(f);
    end;
  finally
    System.SysUtils.FindClose(f);
  end;
end;


function DirectoryExists(const Name: string): Boolean;
var
  Code: Dword;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> $FFFFFFFF) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function ForceDirectories(Dir: string): Boolean;
begin
  Result := False;
  if Length(Dir) = 0 then
    raise Exception.Create('Cannot create directory ' + Dir);
  if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
    Delete(Dir, Length(Dir), 1);
  if (Length(Dir) < 3) or DirectoryExists(Dir)
    or (ExtractFilePath(Dir) = Dir) then
    begin
      Result := True;
      Exit; // avoid 'xyz:\' problem.
    end;
  if not ForceDirectories(ExtractFilePath(Dir)) then Exit;
  Result := CreateDir(Dir);
end;

procedure UnforceDirectories(Dir: string);
{var
    f: TSearchRec;
    n: Integer;
    Found: Boolean;}
begin
    if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
        Delete(Dir, Length(Dir), 1);
    {n := FindFirst(Dir + '\*.*', faDirectory, f);
    try
        while n = 0 do
        begin
            if (f.Name <> '.') and (f.Name <> '..') then Exit;
            n := FindNext(f);
        end;
    finally
        FindClose(f);
    end;}
    if RemoveDirectory(PChar(Dir)) then UnforceDirectories(ExtractFilePath(Dir));
end;

function RecursiveDelete(Dir: WideString): Boolean;   // I4181
var
  f: TSearchRec;
  n: Integer;
begin
  if (Dir <> '') and (Dir[Length(Dir)] = '\') then
    Delete(Dir, Length(Dir), 1);

  n := FindFirst(Dir + '\*.*', faDirectory, f);
  if n = 0 then
  try
    while n = 0 do
    begin
      if (f.Name <> '.') and (f.Name <> '..') then
      begin
        if (f.Attr and faDirectory) = faDirectory then RecursiveDelete(Dir + '\' + f.Name)
        else DeleteFileCleanAttr(Dir + '\' + f.Name);   // I4574
      end;
      n := FindNext(f);
    end;
  finally
    System.SysUtils.FindClose(f);
  end;

  Result := RemoveDir(Dir);   // I4181
end;

function KGetTempPath: string;
var
  buf: array[0..260] of char;
begin
  GetTempPath(260, buf);
  Result := IncludeTrailingPathDelimiter(buf);
end;

function KGetTempFileName(const ext: string = ''): string;
var
  buf: array[0..260] of char;
begin
// This has a race condition -- with the file extension change...
  Result := ExcludeTrailingPathDelimiter(KGetTempPath);

  if GetTempFileName(PChar(Result), 'kmn', 0, buf) = 0 then
    RaiseLastOSError;

  if (ext <> '') then
  begin
    if FileExists(buf) then DeleteFileCleanAttr(buf);   // I4574
    Result := ChangeFileExt(buf, ext);
  end
  else
    Result := buf;
end;

function CreateTempPath: string;
var
  buf: array[0..260] of char;
  tempfile: string;
begin
  tempfile := '';

  repeat
    Result := ExcludeTrailingPathDelimiter(KGetTempPath);
    if (tempfile <> '') and FileExists(tempfile) then DeleteFileCleanAttr(tempfile);   // I4574

    if GetTempFileName(PChar(Result), 'kmn', 0, buf) = 0 then RaiseLastOSError;
    tempfile := buf;

    Result := ChangeFileExt(tempfile, '.dir');

    if DirectoryExists(Result) then Continue;

    if not CreateDir(Result) then
      raise Exception.Create('Unable to create temporary folder: '+SysErrorMessage(GetLastError));
  until True;

  if FileExists(tempfile) then DeleteFileCleanAttr(tempfile);   // I4574
end;

procedure DeleteTempPath(const Path: string);
begin
  RecursiveDelete(Path);
end;

function GetLongFileName(const fname: string): string;
var
  buf: array[0..260] of char;
  p: PChar;
begin
  buf[0] := #0;
  if GetFullPathName(PChar(fname), 260, buf, p) = 0
    then Result := fname
    else Result := buf;
end;

function CopyFileCleanAttr(const src, dst: string; failIfExists: Boolean): Boolean;   // I4574
begin
  // Remove read-only on destination file before overwrite
  if FileExists(dst) then
    SetFileAttributes(PChar(dst), FILE_ATTRIBUTE_NORMAL);

  Result := CopyFile(PChar(src), PChar(dst), failIfExists);
  if Result then
    // Remove read-only on destination file after copy
    SetFileAttributes(PChar(dst), FILE_ATTRIBUTE_NORMAL);
end;

function DeleteFileCleanAttr(const filename: string): Boolean;   // I4574
begin
  if FileExists(filename) then
    SetFileAttributes(PChar(filename), FILE_ATTRIBUTE_NORMAL);
  Result := System.SysUtils.DeleteFile(filename);
end;

end.