Advanced Delphi Systems- Dosya işlemleri

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Advanced Delphi Systems- Dosya işlemleri

Mesaj gönderen Asri »

Aşağıdaki unit'i unit1'de uses olarak ekleyip bu unit içindeki procedure ve function'ları kullanbilirsiniz.

Bu unit program dosya işleminde kullanılır.

Kod: Tümünü seç

Unit ads_File;

Interface
Uses Windows, Classes, Forms, Dialogs, SysUtils, FileCtrl, ShellAPI;

Procedure ApOnlyOneInstance;

procedure NumberDirFiles(
  Directory   : String;
  StartNumber : Integer);

function GetFileSize_ads(const FileName: string): DWord;
function GetFileSize(const FileName: string): LongInt;
Function GetDiskFreeSpace(DriveLetter : String): Int64;
Function DeCompressMax(Var lstChr : TStringList; Var lstReplace: TStringList): Boolean;

Function CompressMax(Var lstChr : TStringList; Var lstReplace: TStringList): Integer;

{
CompressDups

This function replaces all duplicate character pairs with a new
single character value.  Only duplicates with 3 or more occurances
are replaced.

The replacement values start at 267 and range up to 999.

This function returns True if more compression can be achieved
and false if there is no more opportunity for compression.

Maximum compression would be achieved by using this function
recursively until it returns False indicating that no further
compression can be achieved.

lstChr :
  The lstChr argument is a TStringList variable that assumes special
  formatting.  It is assumed that this StringList contains each byte
  from a file on individual lines in sequential order as their ascii
  equilavent value with padded zeroes to the left for a width of 3.
  An example would be:
    lstChr[ 1] := '073';
    lstChr[ 2] := '073';
    lstChr[ 3] := '042';
    lstChr[ 4] := '000';
    lstChr[ 5] := '008';
    lstChr[ 6] := '000';
    lstChr[ 7] := '000';
    lstChr[ 8] := '000';
    lstChr[ 9] := '017';
    lstChr[10] := '000';
    lstChr[11] := '254';
    lstChr[12] := '000';
    lstChr[13] := '004';
    lstChr[14] := '000';
    lstChr[15] := '001';
    lstChr[16] := '000';
    lstChr[17] := '000';
  This StringList is both an Input an Output variable.  If compression
  is achieved lstChr is replaced with the new values.

lstReplace :
  The lstReplace argument is a TStringList variable that assumes special
  formatting.  It is assumed that this StringList contains each of the
  replacement character definitions in sequential order.  To restore the
  original byte stream the replacements would need to be made in reverse
  order.
  An example would be:
    lstReplace[ 1] := '0000257_000000';
    lstReplace[ 2] := '0000258_065254';
    lstReplace[ 3] := '0000259_137212';
    lstReplace[ 4] := '0000260_178132';
    lstReplace[ 5] := '0000261_151098';

boStartFirst :
  The boStartFirst argument is a boolean that determines where the Character
  pairs start.  If boStartFirst is True then the first character pair is made
  up of the first and second characters.  If boStartFirst is False then the
  first character pair is only the first character and the second character
  pair is made up of the second and third characters.  Different matches occur
  depending on where the pairing starts.  For maximum compression first run
  all the boStartFirst=True Then Run all the boStartFirst=False.

}

Function CompressDups(
  Var lstChr     : TStringList;
  Var lstReplace : TStringList;
  boStartFirst   : Boolean): Boolean;


{!~
FileToProcInUnit
Converts a File to a Procedure in a Delphi Unit
Arguments
  FromFile     : The full name and path of the file to be converted to a procedure.
  NewUnitPath  : The path to the new Delphi Unit that will be created.
  NewUnitNoExt : The name of the new Delphi Unit without any file extension.
  ResourceName : The variable name that will be associated with this file.

Example

//The following procedure creates a Delphi Unit called oasis_resstr01.pas.
//The path to this unit is contained in the variable GlobalExecutablePath.
//The file being converted to a procedure is GlobalCacheDir+'blank.tif'.
//The variable name assocated with this file is BlankPage.
procedure TDoc_MainForm.Button2Click(Sender: TObject);
begin
  FileToProcInUnit(
    GlobalCacheDir+'blank.tif',//FromFile,
    GlobalExecutablePath,//ResFilePath,
    'oasis_resstr01',//ResFileNoExt,
    'BlankPage');//ResourceName:String): Boolean;

end;

//The following procedure uses the generated procedure to create a file
//called TestTif.
procedure TDoc_MainForm.Button3Click(Sender: TObject);
begin
  WriteFileBlankPage(
    GlobalExecutablePath,//ToFilePath      : String;
    'TestTif'            //ToFileNameNoExt : String
    );                   //);
end;
}
Function FileToProcInUnit(
  FromFile,
  NewUnitPath,
  NewUnitNoExt,
  ResourceName:String): Boolean;

{!~ Closes a Windows Application:
  ExecutableName is usually the name of the executable
  WinClassName can be found by inspecting the messaging
    using WinSight that ships with Delphi}
procedure AppClose(ExecutableName,WinClassName : String);

{!~ Executes a Windows Application:
  ExecutableName is usually the name of the executable
  WinClassName can be found by inspecting the messaging
    using WinSight that ships with Delphi

  If the application is already running this function
  brings it to the front}
procedure AppExecute(
  ExecutableName : String;
  WinClassName   : String);

{!~ Returns the handle of a Windows Application}
function AppHandle(WinClassName : String): THandle;

{!~ Returns True if Application is running, False otherwise}
Function AppIsRunning(AppName: String): Boolean;

{!~ a subroutine of AppExecute}
Function AppLoad(const ExecutableName: string; show : word) : THandle;

{!~ a subroutine of AppExecute}
function AppSwitchTo(WinClassName   : String): boolean;

{!~ A SubRoutine of AppClose}
Function AppTerminate(AppName: String): Boolean;

{!~ Changes Directory}
Function CD(DirName: String): Boolean;

{!~ Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function CopyDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ Copies A File}
Function CopyFile(FromFile,ToFile:String): Boolean;

{!~ Copy Files}
Function CopyFiles(FromPath,ToPath,FileMask: String): Boolean;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function DelTree(DirectoryName: String): Boolean;

{!~ Deletes Files}
Function DeleteFiles(FilePath,FileMask: String): Boolean;

{!~ Returns Current Working Directory}
Function Directory: String;

{!~ Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function DirectoryCopy(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ Hides a directory.  Returns true if
successful and false otherwise}
Function DirectoryHide(Const FileString : String): Boolean;

{!~ Moves a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function DirectoryMove(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ UnHides a directory.  Returns true if
successful and false otherwise}
Function DirectoryUnHide(Const FileString : String): Boolean;

{!~
Empties a directory of normal files.
}
Function EmptyDirectory(Directory : String): Boolean;

{Triggers an Executable to update itself.
Don't worry about the handle parameter,
just pass HANDLE which is the applications
handle. This can be run in the Application's
Main Form Create method.}
Function ExecutableUpdate(
  ExecutablePath : String;
  ExecutableName : String;
  InstallPath    : String;
  Handle         : THandle): Boolean;

{!~Executes an executable with no parameters}
Function ExecuteExe(FileName : String): Boolean;

{!~Executes an executable with parameters}
Function ExecuteExeParams(
  FileName    : String;
  ParamString : String;
  DefaultDir  : String): Boolean;

{!~Executes an executable in a completely new process}
Function ExecuteNewProcess(
  FileName   : String;
  Visibility : integer):integer;

{!~ Loads a known file type using the appropriate
executable, e.g., WinWord for *.Doc, Paradox for *.db.}
Function ExecuteKnownFileType(
  Handle   : THandle;
  FileName : String): Boolean;

{!~ Returns The File Extension Without The Path, Name Or Period}
Function ExtractFileExtNoPeriod(FileString: String): String;

{!~ Returns The File Name Without The Path, Extension Or Period}
Function ExtractFileNameNoExt(FileString: String): String;

{!~ Returns The Files Date Time Stamp as TDateTime.
Returns 0 if there is an error}
Function FileDate(FileString: String): TDateTime;

{!~ Returns True is the filoe dates are the same, False otherwise.}
Function FileDatesSame(FileString1,FileString2: String): Boolean;

{!~ Returns The File Extension Without The Path, Name Or Period}
Function FileExt(FileString: String): String;

{!~This is a file handling routine.  This function reads a file (FromFile) ...
searching for every occurrance of OldChar and replacing it with NewString.  ...
The changed file is output to ToFile.}
{Copies A File}
Function FileFilterChar(
  FromFile   : String;
  ToFile     : String;
  OldChar    : Char;
  NewString  : ShortString): Boolean;

{!~ Moves a File From Source To Destination}
Function FileMove(SourceFile, DestinationFile: String): Boolean;

{!~ Returns The File Name Without The Path, Extension Or Period}
Function FileName(FileString: String): String;

{!~ Returns the next available file name number as a string
in the format 00000001}
Function FileNextNumberName(
  Directory   : String;
  Mask        : String
  ): String;

{!~ Returns The File size in bytes.  Does not work on a text file.}
Function FileNotTextSize(FileString: String): LongInt;

{!~ Returns The File Path Without The Name, Extension ,Period or trailing Backslash}
Function FilePath(FileString: String): String;

{!~ Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function File_CopyDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_DelTree(DirectoryName: String): Boolean;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_DeleteDirectory(DirectoryName: String): Boolean;

{!~ File_DirOperations_Detail
This is the directory management engine that is used by a number of other
file management functions.  This function can COPY, DELETE, MOVE, and RENAME
directories.}
Function File_DirOperations_Detail(
  Action            : String;  //COPY, DELETE, MOVE, RENAME
  RenameOnCollision : Boolean; //Renames if directory exists
  NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
  Silent            : Boolean; //No progress dialog is shown
  ShowProgress      : Boolean; //displays progress dialog but no file names
  FromDir           : String;  //From directory
  ToDir             : String   //To directory
  ): Boolean;

{!~ Returns the Creation Date for a file.}
Function File_GetCreationDate(FileName : String): TDateTime;

{!~ Returns the Date a file was last accessed.}
Function File_GetLastAccessDate(FileName : String): TDateTime;

{!~ Returns the Date a file was last modified.}
Function File_GetLastModifiedDate(FileName : String): TDateTime;

{!~ Returns the Long File Name of a file.}
Function File_GetLongFileName(FileName : String): String;

{!~ Returns the Short File Name of a file.}
Function File_GetShortFileName(FileName : String): String;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_KillDirectory(DirectoryName: String): Boolean;

{!~ Moves a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function File_MoveDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ ReNames a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_ReNameDirectory(
  OldDirectoryName: String;
  NewDirectoryName: String): Boolean;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_RemoveDirectory(DirectoryName: String): Boolean;

{!~ Populates a TStrings FileList with the files meeting selected
file attribute criteria in a directory.  The mask argument is a
standard DOS file argument like '*.*.  The InclDotFiles argument
allows the user to exclude the system files "." and ".." by
setting the value to False.  If the Intersection argument is set
to true then the result will reflect only those files that satisfy
all attribute criteria.  If Intersection is set to false then the
result will be a union of files that meet any of the criteria.}
Function FilesInDirDetail(
  FileList    : TStrings;
  Directory   : String;
  Mask        : String;
  Intersection: Boolean;
  IsReadOnly  : Boolean;
  IsHidden    : Boolean;
  IsSystem    : Boolean;
  IsVolumeID  : Boolean;
  IsDirectory : Boolean;
  IsArchive   : Boolean;
  IsNormal    : Boolean;
  InclDotFiles: Boolean): Boolean;

{!~
Empties the Temporary Internet Files directory.
Only validated with MS Internet Explorer 3.02
}
procedure Internet_EmptyCacheDirectories(
  TemporaryInternetDirectory : String);

{!~ Tests Directory Existence}
Function IsDir(IsDirPath: String): Boolean;

{!~ Returns True If Directory Is Empty, False Otherwise}
Function IsDirEmpty(DirName: String): Boolean;

{!~ Returns True If The File Exists, False Otherwise}
Function IsFile(DirName: String): Boolean;

{!~ Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function KillDirectory(DirectoryName: String): Boolean;

{!~ Makes A Directory}
Function MD(DirName: String): Boolean;

{!~ Moves a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function MoveDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;

{!~ Removes A Directory}
Function RD(DirName: String): Boolean;

{!~ ReNames a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function ReNameDir(OldDirName, NewDirName: String): Boolean;

{!~ ReNames a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function ReNameDirectory(
  OldDirectoryName: String;
  NewDirectoryName: String): Boolean;

{!~ Sets a File Date.}
Function SetFileDate(
  Const FileName : String;
  Const FileDate : TDateTime): Boolean;

{!~ Executes An External Executable}
Function WinExecute(ApToExec: String): THandle;

{!~ Executes An External Executable}
Function WinExecute32(
  FileName   : String;
  Visibility : integer):integer;

Implementation

Uses Ads_Strg, Ads_Conv;
{!~ ApOnlyOneInstance
Allows only one instance of an executable}
Procedure ApOnlyOneInstance;
Var
  ApOnlyOneInstanceHandle : THandle;
  MainCaption             : String;
Begin
  ApOnlyOneInstanceHandle := CreateMutex(nil, False, PChar(ParamStr(0)));
  If ApOnlyOneInstanceHandle < 1 Then
  Begin
    MainCaption := Application.MainForm.Caption;
    ShowMessage('Only one instance of the application can run at a time.');
    Halt;
  End;
End;

{!~ AppClose
  Closes a Windows Application:
  ExecutableName is usually the name of the executable
  WinClassName can be found by inspecting the messaging
    using WinSight that ships with Delphi

example:
This ButtonClick Closes Solitaire if it is open

procedure TForm1.Button2Click(Sender: TObject);
begin
  AppClose('Sol','Solitaire');
end;
}
procedure AppClose(ExecutableName,WinClassName : String);
Begin
  If AppIsRunning(WinClassName) Then
  Begin
    If AppTerminate(ExecutableName) Then Exit;;
  End;
end;

{!~ AppExecute
  Executes a Windows Application:
  ExecutableName is usually the name of the executable
  WinClassName can be found by inspecting the messaging
    using WinSight that ships with Delphi

  If the application is already running this function
  brings it to the front
example:
This ButtonClick activates Solitaire

procedure TForm1.Button1Click(Sender: TObject);
begin
  AppExecute('SOL.EXE','Sol');
end;
}
procedure AppExecute(
  ExecutableName : String;
  WinClassName   : String);
Begin
  If Not AppSwitchTo(WinClassName) Then
  Begin
    AppLoad(ExecutableName,SW_SHOWNORMAL)
  End;
End;

{!~ AppHandle
Returns the handle of a Windows Application}
function AppHandle(WinClassName : String): THandle;
Var
  Handle            : THandle;
  WinClassNamePChar : array[0..32] of char;
Begin
  StrPLCopy(WinClassNamePChar,WinClassName,32);
  Handle := FindWindow(WinClassNamePChar,nil);
  If Handle = 0 Then
  Begin
    Result := 0;
  End
  Else
  Begin
    Result := Handle;
  End;
End;

{!~ AppIsRunning
Returns True if Application is running, False otherwise
example:
An Edit Field is Set to True or False
depending on whether Solitaire is running

procedure TForm1.Button3Click(Sender: TObject);
begin
  If AppIsRunning('Solitaire') Then
    Edit1.Text := 'True'
  Else
    Edit1.Text := 'False';
end;
}
Function AppIsRunning(AppName: String): Boolean;
var WindHand : THandle;
    wcnPChar : array[0..32] of char;
    ClName   : array[0..32] of char;
{$IFDEF WIN32}
    WinClassNameShort   : ShortString;
    AppNameShort : ShortString;
{$ELSE}
    WinClassNameShort   : String;
    AppNameShort : String;
{$ENDIF}
Begin
{$IFDEF WIN32}
  WinClassNameShort   := ''{ShortString(WinClassName)};
  AppNameShort := ShortString(AppName);
  StrPLCopy(wcnPChar,WinClassNameShort,Length(WinClassNameShort));
  StrPLCopy(ClName,AppNameShort,Length(AppNameShort));
{$ELSE}
  WinClassNameShort   := ''{WinClassName};
  AppNameShort := AppName;
  StrPLCopy(wcnPChar,WinClassNameShort,Length(WinClassNameShort)+1);
  StrPLCopy(ClName,AppNameShort,Length(AppNameShort)+1);
{$ENDIF}
  WindHand := FindWindow(wcnPChar,ClName);
  If WindHand = 0 Then
  Begin
    WindHand := FindWindow(nil,ClName);
    If WindHand = 0 Then
    Begin
      WindHand := FindWindow(wcnPChar,nil);
      If WindHand = 0 Then
      Begin
        Result := False;
      End
      Else
      Begin
        Result := True;
      End;
    End
    Else
    Begin
      Result := True;
    End;
  End
  Else
  Begin
    Result := True;
  End;
End;

{!~ AppLoad
a subroutine of AppExecute}
Function AppLoad(const ExecutableName: string; show : word) : THandle;
Type
   SHOWBLOCK = record
     two       : word;
     cmdShow   : word;
   end;
   SHOWBLOCK_PTR = ^SHOWBLOCK;
   PARAMBLOCK = record
     wEnvSeg   : word;
     cmdLine   : PChar;
     show      : SHOWBLOCK_PTR;
     reserved1 : word;
     reserved2 : word;
End;
Var
   showCmd      : SHOWBLOCK;
   appletBlock  : PARAMBLOCK;
   appletPChar  : array [0..255] of char;
   cmdLinePChar : array [0..1]   of char;
Begin
   With showCmd do begin
     two := 2;
     cmdShow := show;
   End;
   With appletBlock do begin
     wEnvSeg   := 0;
     cmdLine   := StrPLCopy(cmdLinePChar,'',1);
     show      := @showCmd;
     reserved1 := 0;
     reserved2 := 0;
   End;
   Result      := LoadModule(
                    StrPLCopy(appletPChar,ExecutableName,255),
                    @appletBlock);
End;

{!~ AppSwitchTo
a subroutine of AppExecute}
function AppSwitchTo(WinClassName   : String): boolean;
Var
  Handle            : THandle;
  WinClassNamePChar : array[0..32] of char;
Begin
  StrPLCopy(WinClassNamePChar,WinClassName,32);
  Handle := FindWindow(WinClassNamePChar,nil);
  If Handle = 0 Then
  Begin
    Result := False;
  End
  Else
  Begin
    Result := True;
    If IsIconic(Handle) Then
    Begin
      ShowWindow(Handle,SW_RESTORE);
    End
    Else
    Begin
      BringWindowToTop(GetLastActivePopup(Handle));
    End;
  End;
End;

{!~ AppTerminate
A SubRoutine of AppClose}
Function AppTerminate(AppName: String): Boolean;
{$IFDEF NOT WIN32}
Var
  Task    : TTaskEntry;
  CurName : String;
  i       : Integer;
{$ENDIF}
Begin
  Result := False;
  If Not (AppName = '') Then
  Begin
{$IFDEF WIN32}

{$ELSE}
    Task.DwSize := SizeOf (TTaskEntry);
    If TaskFirst(@task) Then
    Begin
      Repeat
        CurName := '';
        For i := 0 To SizeOf(Task.szModule) Do
        Begin
          If Task.szModule[i] = #0 Then
          Begin
            Break;
          End
          Else
          Begin
            CurName := CurName + Task.szModule[i];
          End;
        End;
        If UpperCase(CurName) = UpperCase(AppName) Then
        Begin
          TerminateApp(task.hTask, NO_UAE_BOX);
          Result := True;
          Exit;
        end;
      Until not TaskNext(@task);
    End;
{$ENDIF}
  End;
end;

{!~ CD
Changes Directory}
Function CD(DirName: String): Boolean;
Begin
  If Not IsDir(DirName) Then
  Begin
    Result := False;
  End
  Else
  Begin
    ChDir(DirName);
    If Not (IOResult = 0) Then
    Begin
      Result := False;
    End
    Else
    Begin
      Result := True;
    End;
  End;
End;

{!~ CopyDirectory
Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function CopyDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;
Begin
  Result := File_CopyDirectory(SourceDirectoryName, DestDirectoryName);
End;

{!~ CopyFile
Copies A File}
Function CopyFile(FromFile,ToFile:String): Boolean;
Var
  FromF, ToF: file;
{$IFDEF WIN32}
  NumRead, NumWritten: Integer;
{$ELSE}
  NumRead, NumWritten: Word;
{$ENDIF}
  Buf: array[1..2048] of Char;
Begin
  If IsDir(FromFile) Then
  Begin
    {MessageDlg('Problem! There Was A Problem Copying '+FromFile,
        mtWarning, [mbOk], 0);}
    Result := False;
  End
  Else
  Begin
    AssignFile(FromF, FromFile);
    AssignFile(ToF, ToFile);
    Try
      FileMode := 0;  {Sets Reset To ReadOnly}
      Reset(FromF, 1);{ Record size = 1 }
      FileMode := 2;  {Sets Reset To ReadWrite}
      Rewrite(ToF, 1);{ Record size = 1 }
      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (Not (NumWritten = NumRead));
      System.CloseFile(FromF);
      System.CloseFile(ToF);
      Result := True;
    Except
      On EInOutError Do
      Begin
        Result := False;
      End;
      Else Result := False;
    End;
    If Result = False Then
      MessageDlg('Problem! There Was A Problem Copying '+FromFile,
        mtWarning, [mbOk], 0);
  End;
End;

{!~ CopyFiles
Copy Files}
Function CopyFiles(FromPath,ToPath,FileMask: String): Boolean;
var
  CopyFilesSearchRec: TSearchRec;
  FindFirstReturn:    Integer;
Begin
  Result := False;
  FindFirstReturn :=
    FindFirst(FromPath+'\'+FileMask, faAnyFile, CopyFilesSearchRec);
  If Not (CopyFilesSearchRec.Name = '') And
     Not (FindFirstReturn = -18)        Then
  Begin
    Result := True;
    CopyFile(FromPath+'\'+CopyFilesSearchRec.Name,ToPath+'\'+CopyFilesSearchRec.Name);
    While True Do
    Begin
      If FindNext(CopyFilesSearchRec)<0 Then
      Begin
        Break;
      End
      Else
      Begin
        CopyFile(FromPath+'\'+CopyFilesSearchRec.Name,ToPath+'\'+CopyFilesSearchRec.Name);
      End;
    End;
  End;
End;

{!~ DelTree
Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function DelTree(DirectoryName: String): Boolean;
begin
  Result :=
    File_DirOperations_Detail(
      'DELETE', //Action            : String;  //COPY, DELETE, MOVE, RENAME
      False,    //RenameOnCollision : Boolean; //Renames if directory exists
      True,     //NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
      True,     //Silent            : Boolean; //No progress dialog is shown
      False,    //ShowProgress      : Boolean; //displays progress dialog but no file names
      DirectoryName,//FromDir : String;  //From directory
      ''            //ToDir   : String   //To directory
      );
end;

{!~ DeleteFiles
Deletes Files}
Function DeleteFiles(FilePath,FileMask: String): Boolean;
var
  DeleteFilesSearchRec: TSearchRec;
  PreviousFileName, ThisFileName: String;
begin
  Result := False;
  FindFirst(FilePath+'\'+FileMask, faAnyFile, DeleteFilesSearchRec);
  If Not (DeleteFilesSearchRec.Name = '') Then
  Begin
    Result := True;
    DeleteFile(
      {$IFDEF WIN32}ConvertStringToPChar({$ENDIF}
      FilePath+'\'+DeleteFilesSearchRec.Name
      {$IFDEF WIN32}){$ENDIF}
      );
    While True Do
    Begin
      If FindNext(DeleteFilesSearchRec)<0 Then
      Begin
        Break;
      End
      Else
      Begin
           ThisFileName:= FilePath+'\'+DeleteFilesSearchRec.Name;
        DeleteFile(
          {$IFDEF WIN32}ConvertStringToPChar({$ENDIF}
          FilePath+'\'+DeleteFilesSearchRec.Name
          {$IFDEF WIN32}){$ENDIF}
          );
          If ThisFileName=PreviousFileName then begin
             Result:= False;
             Exit;
          end;
          PreviousFileName:= ThisFileName;
      End;
    End;
  End;
End;

{!~ Directory
Returns Current Working Directory}
Function Directory: String;
Var
  DirName: String;
Begin
  GetDir(0,DirName);
  Result := DirName;
End;

{!~ DirectoryCopy
Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function DirectoryCopy(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;
Begin
  Result := File_CopyDirectory(SourceDirectoryName, DestDirectoryName);
End;

{!~ DirectoryHide
Hides a directory.  Returns true if
successful and false otherwise}
Function DirectoryHide(Const FileString : String): Boolean;
Var
  Attributes    : Integer;
Begin
  Result := False;
  Try
    If Not DirectoryExists(FileString) Then Exit;
    Attributes := faDirectory + faHidden + faSysFile;
    FileSetAttr(FileString,Attributes);
    Result := True;
  Except
  End;
End;

{!~ DirectoryMove
Moves a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function DirectoryMove(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;
Begin
  Result := File_MoveDirectory(SourceDirectoryName, DestDirectoryName);
End;

{!~ DirectoryUnHide
UnHides a directory.  Returns true if
successful and false otherwise}
Function DirectoryUnHide(Const FileString : String): Boolean;
Var
  Attributes : Integer;
Begin
  Result := False;
  Try
    If Not DirectoryExists(FileString) Then Exit;
    Attributes := faDirectory;
    FileSetAttr(FileString,Attributes);
    Result := True;
  Except
  End;
End;

{!~ EmptyDirectory
Empties a directory of normal files.
}
Function EmptyDirectory(Directory : String): Boolean;
Var
  T : TStringList;
  i : Integer;
Begin
  T := TStringList.Create();
  Try
    Result := False;
    If Not (Copy(Directory,Length(Directory),1) = '\') Then
      Directory := Directory + '\';
    If Not DirectoryExists(Directory) Then Exit;

    {!~ FilesInDirDetail
    Populates a TStrings FileList with the files meeting selected
    file attribute criteria in a directory.  The mask argument is a
    standard DOS file argument like '*.*.  The InclDotFiles argument
    allows the user to exclude the system files "." and ".." by
    setting the value to False.  If the Intersection argument is set
    to true then the result will reflect only those files that satisfy
    all attribute criteria.  If Intersection is set to false then the
    result will be a union of files that meet any of the criteria.}
    FilesInDirDetail(
      T,                //FileList    : TStrings;
      Directory,        //Directory   : String;
      '*.*',            //Mask        : String;
      False,            //Intersection: Boolean;
      False,            //IsReadOnly  : Boolean;
      False,            //IsHidden    : Boolean;
      False,            //IsSystem    : Boolean;
      False,            //IsVolumeID  : Boolean;
      False,            //IsDirectory : Boolean;
      False,            //IsArchive   : Boolean;
      True,             //IsNormal    : Boolean;
      False);           //InclDotFiles: Boolean): Boolean;

    Result := True;
    For i := 0 To T.Count - 1 Do
    Begin
      Try
        If FileExists(Directory+T[i]) Then DeleteFile(PChar(Directory+T[i]));
      Except
        Result := False;
      End;
    End;
  Finally
    T.Free;
  End;
End;

{!~ ExecutableUpdate
Triggers an Executable to update itself.
Don't worry about the handle parameter,
just pass HANDLE which is the applications
handle. This can be run in the Application's
Main Form Create method.}
Function ExecutableUpdate(
  ExecutablePath : String;
  ExecutableName : String;
  InstallPath    : String;
  Handle         : THandle): Boolean;
Var
  Bat : TStringList;
Begin
  Result := False;
  If FileExists(ExecutablePath+ExecutableName+'.bat') Then
    DeleteFile(PChar(ExecutablePath+ExecutableName+'.bat'));
  If Not IsFile(ExecutablePath+ExecutableName+'.exe') Then Exit;
  If Not IsFile(InstallPath+ExecutableName+'.exe')    Then Exit;
  If UpperCase(ExecutablePath+ExecutableName+'.exe') =
     UpperCase(InstallPath   +ExecutableName+'.exe')
  Then Exit;

  If FileDatesSame(
       ExecutablePath+ExecutableName+'.exe',
       InstallPath   +ExecutableName+'.exe') Then Exit;
  If  FileExists(ExecutablePath+ExecutableName+'.old') Then
    DeleteFile(PChar(ExecutablePath+ExecutableName+'.old'));
  Bat := TStringList.Create();
  Try
    Bat.Clear;
    Bat.Add('@ECHO OFF');
    Bat.Add('REN '     +
            ExecutableName+
            '.exe '       +
            ExecutableName+
            '.old');
    Bat.Add('Copy '       +
            InstallPath   +
            ExecutableName+
            '.exe '       +
            ExecutablePath+
            ExecutableName+
            '.exe');
    Bat.Add('START '      +
            ExecutablePath+
            ExecutableName+
            '.exe');
    Bat.SaveToFile(
            ExecutablePath+
            ExecutableName+
            '.bat');
    ShowMessage('The Software is going to be upgraded');
    ExecuteKnownFileType(
      Handle,
      ExecutablePath+
      ExecutableName+
      '.bat');
    Result := True;
  Finally
    Bat.Clear;
    If Result Then Halt;
  End;
End;

{!~ ExecuteExe
Executes an executable with no parameters}
Function ExecuteExe(FileName : String): Boolean;
Begin
{  Result := False;}{zzz}
  ShellExecute(
    Application.Handle,
    nil,
    PChar(FileName),
    nil,
    nil,
    SW_SHOWNORMAL);
  Result := True;
End;

{!~ ExecuteExeParams
Executes an executable with parameters}
Function ExecuteExeParams(
  FileName    : String;
  ParamString : String;
  DefaultDir  : String): Boolean;
Begin
  ShellExecute(
    Application.Handle,
    nil,
    PChar(FileName),
    PChar(ParamString),
    PChar(DefaultDir),
    SW_SHOWNORMAL);
  Result := True;
End;

{!~ ExecuteKnownFileType
Loads a known file type using the appropriate
executable, e.g., WinWord for *.Doc, Paradox for *.db.}
Function ExecuteKnownFileType(
  Handle   : THandle;
  FileName : String): Boolean;
Var
  PFileName : array[0..128] of Char;
  PFilePath : array[0..128] of Char;
  FilePath  : String;
Begin
{  Result := False;}{zzz}
  FilePath := ExtractFilePath(FileName);
  StrPCopy(PFileName,FileName);
  StrPCopy(PFilePath,FilePath);
  ShellExecute(
    Handle,
    nil,
    PFileName,
    nil,
    PFilePath,
    SW_SHOWNORMAL);
  Result := True;
End;

{!~ ExtractFileExtNoPeriod
Returns The File Extension Without The Path, Name Or Period}
Function ExtractFileExtNoPeriod(FileString: String): String;
Var
  FileWithExtString: String;
  FileExtString: String;
  LenExt: Integer;
Begin
  FileWithExtString := ExtractFileName(FileString);
  FileExtString     := ExtractFileExt(FileString);
  LenExt            := Length(FileExtString);
  If LenExt = 0 Then
  Begin
    Result := '';
  End
  Else
  Begin
    If Copy(FileExtString,1,1) = '.' Then
    Begin
      FileExtString := Copy(FileExtString,2,LenExt-1);
      If Length(FileExtString) > 0 Then
      Begin
        Result := FileExtString;
      End
      Else
      Begin
        Result := '';
      End;
    End
    Else
    Begin
      Result := FileExtString;
    End;
  End;
End;

{!~ ExtractFileNameNoExt
Returns The File Name Without The Path, Extension Or Period}
Function ExtractFileNameNoExt(FileString: String): String;
Var
  FileWithExtString: String;
  FileExtString: String;
  LenExt: Integer;
  LenNameWithExt: Integer;
Begin
  FileWithExtString := ExtractFileName(FileString);
  LenNameWithExt    := Length(FileWithExtString);
  FileExtString     := ExtractFileExt(FileString);
  LenExt            := Length(FileExtString);
  If LenExt = 0 Then
  Begin
    Result := FileWithExtString;
  End
  Else
  Begin
    Result := Copy(FileWithExtString,1,(LenNameWithExt-LenExt));
  End;
End;

{!~ FileDate
Returns The Files Date Time Stamp as TDateTime.
Returns 0 if there is an error}
Function FileDate(FileString: String): TDateTime;
Begin
  Result := 0;
  Try
    If Not FileExists(FileString) Then Exit;
    Result := FileDateToDateTime(FileAge(FileString));
  Except
    Result := 0;
  End;
End;

{!~ FileDatesSame
Returns True is the file dates are the same, False otherwise.}
Function FileDatesSame(FileString1,FileString2: String): Boolean;
Begin
  {The default return value has been set to true because
  this routine will frequently be used for self installing executables.
  This default would eliminate a run away process if errors occur.}
  Try
    If FileDate(FileString1)=FileDate(FileString2) Then
    Begin
      Result := True;
    End
    Else
    Begin
      Result := False;
    End;
  Except
    Result := True;
  End;
End;

{!~ FileExt
Returns The File Extension Without The Path, Name Or Period}
Function FileExt(FileString: String): String;
Begin
  Result := ExtractFileExtNoPeriod(FileString);
End;

{!~ FileFilterChar
This is a file handling routine.  This function reads a file (FromFile) ...
searching for every occurrance of OldChar and replacing it with NewString.  ...
The changed file is output to ToFile.}
{Copies A File}
Function FileFilterChar(
  FromFile   : String;
  ToFile     : String;
  OldChar    : Char;
  NewString  : ShortString): Boolean;
Var
  FromF, ToF: file;
{$IFDEF WIN32}
  NumRead, NumWritten, i,j: Integer;
{$ELSE}
  NumRead, NumWritten: Word;
{$ENDIF}
  {Buf: array[1..2048] of Char;}
  Buf: array[1..1] of Char;
Begin
  If IsDir(FromFile) Then
  Begin
    {MessageDlg('Problem! There Was A Problem Copying '+FromFile,
        mtWarning, [mbOk], 0);}
    Result := False;
  End
  Else
  Begin
    AssignFile(FromF, FromFile);
    AssignFile(ToF, ToFile);
    Try
      FileMode := 0;  {Sets Reset To ReadOnly}
      Reset(FromF, 1);{ Record size = 1 }
      FileMode := 2;  {Sets Reset To ReadWrite}
      Rewrite(ToF, 1);{ Record size = 1 }
      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        For i := 1 to SizeOf(Buf) Do
        Begin
          If Buf[i] = OldChar Then
          Begin
            For j := 1 To Length(NewString) Do
            Begin
              BlockWrite(ToF, NewString[j], NumRead, NumWritten);
            End;
          End
          Else
          Begin
            BlockWrite(ToF, Buf, NumRead, NumWritten);
          End;
        End;
      until (NumRead = 0) {or (Not (NumWritten = NumRead))};
      System.CloseFile(FromF);
      System.CloseFile(ToF);
      Result := True;
    Except
      On EInOutError Do
      Begin
        Result := False;
      End;
      Else Result := False;
    End;
    If Result = False Then
      MessageDlg('Problem! There Was A Problem Copying '+FromFile,
        mtWarning, [mbOk], 0);
  End;
End;

{!~ FileMove
Moves a File From Source To Destination}
Function FileMove(SourceFile, DestinationFile: String): Boolean;
Var
  DestFileName: String;
  FS,FD: TextFile;
Begin
  If Not IsFile(SourceFile) Then
  Begin
    Result := False;
    Exit;
  End
  Else
  Begin
    AssignFile(FS, SourceFile);
    Reset(FS);
    CloseFile(FS);
  End;

  If IsFile(DestinationFile) Then
  Begin
    AssignFile(FD, SourceFile);
    Reset(FD);
    CloseFile(FD);
    If Length(FileExt(DestinationFile)) > 0 Then
    Begin
      DestFileName := FileName(DestinationFile)+'.'+FileExt(DestinationFile);
    End
    Else
    Begin
      DestFileName := FileName(DestinationFile);
    End;
    If Not DeleteFiles(FilePath(DestinationFile),DestFileName) Then
    Begin
      Result := False;
      Exit;
    End;
  End;

  Result := ReNameFile(SourceFile,DestinationFile);
End;

{!~ FileName
Returns The File Name Without The Path, Extension Or Period}
Function FileName(FileString: String): String;
Begin
  Result := ExtractFileNameNoExt(FileString);
End;

{!~ FileNextNumberName
Returns the next available file name number as a string
in the format 00000001}
Function FileNextNumberName(
  Directory   : String;
  Mask        : String
  ): String;
Var
  StringList : TStringList;
  CurLast_I  : Integer;
Begin
  Result := '';
  StringList := TStringList.Create();
  Try
    StringList.Clear;
    FilesInDirDetail(
      StringList,
      Directory,
      Mask,
      True,     {Intersection: Boolean;}
      False,    {IsReadOnly  : Boolean;}
      False,    {IsHidden    : Boolean;}
      False,    {IsSystem    : Boolean;}
      False,    {IsVolumeID  : Boolean;}
      False,    {IsDirectory : Boolean;}
      False,    {IsArchive   : Boolean;}
      True,     {IsNormal    : Boolean;}
      False);   {InclDotFiles: Boolean): Boolean;}
    StringList.Sorted := True;
    Try
      If StringList.Count = 0 Then
      Begin
        CurLast_I := 0;
      End
      Else
      Begin
        CurLast_I :=
          StrToInt(
            ExtractFileNameNoExt(
              StringList[StringList.Count-1]));
      End;
    Except
      CurLast_I := 0;
    End;
    Result := StringPad(IntToStr(CurLast_I+1),'0',8,False);
  Finally
    StringList.Free;
  End;
End;

{!~ FileNotTextSize
Returns The File size in bytes.  Does not work on a text file.}
Function FileNotTextSize(FileString: String): LongInt;
Var
   f    : file of Byte;
   size : Longint;
Begin
  Try
    AssignFile(f, FileString);
    Reset(f);
    size := FileSize(f);
    CloseFile(f);
    Result := Size;
  Except
    Result := 0;
  End;
End;

{!~ FilePath
Returns The File Path Without The Name, Extension ,Period or trailing Backslash}
Function FilePath(FileString: String): String;
Begin
  Try
    Result := ExtractFilePath(FileString);
  Except
    Result := '';
  End;
End;

{!~ File_CopyDirectory
Copies a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function File_CopyDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;
begin
  Result :=
    File_DirOperations_Detail(
      'COPY',   //Action            : String;  //COPY, DELETE, MOVE, RENAME
      False,    //RenameOnCollision : Boolean; //Renames if directory exists
      True,     //NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
      True,     //Silent            : Boolean; //No progress dialog is shown
      False,    //ShowProgress      : Boolean; //displays progress dialog but no file names
      SourceDirectoryName,//FromDir : String;  //From directory
      DestDirectoryName   //ToDir   : String   //To directory
      );
end;

{!~ File_DelTree
Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_DelTree(DirectoryName: String): Boolean;
Begin
  Result := DelTree(DirectoryName);
End;

{!~ File_DeleteDirectory
Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_DeleteDirectory(DirectoryName: String): Boolean;
Begin
  Result := DelTree(DirectoryName);
End;

{!~ File_DirOperations_Detail
This is the directory management engine that is used by a number of other
file management functions.  This function can COPY, DELETE, MOVE, and RENAME
directories.}
Function File_DirOperations_Detail(
  Action            : String;  //COPY, DELETE, MOVE, RENAME
  RenameOnCollision : Boolean; //Renames if directory exists
  NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
  Silent            : Boolean; //No progress dialog is shown
  ShowProgress      : Boolean; //displays progress dialog but no file names
  FromDir           : String;  //From directory
  ToDir             : String   //To directory
  ): Boolean;
var
  SHFileOpStruct : TSHFileOpStruct;
  FromBuf, ToBuf: Array [0..255] of Char;
begin
  Try
    If Not DirectoryExists(FromDir) Then
    Begin
      Result := False;
      Exit;
    End;
    Fillchar(SHFileOpStruct, Sizeof(SHFileOpStruct), 0 );
    FillChar(FromBuf,        Sizeof(FromBuf),        0 );
    FillChar(ToBuf,          Sizeof(ToBuf),          0 );
    StrPCopy(FromBuf,        FromDir);
    StrPCopy(ToBuf,          ToDir);
    With SHFileOpStruct Do
    Begin
      Wnd    := 0;
      If UpperCase(Action) = 'COPY'   Then wFunc := FO_COPY;
      If UpperCase(Action) = 'DELETE' Then wFunc := FO_DELETE;
      If UpperCase(Action) = 'MOVE'   Then wFunc := FO_MOVE;
      If UpperCase(Action) = 'RENAME' Then wFunc := FO_RENAME;
      pFrom  := @FromBuf;
      pTo    := @ToBuf;
      fFlags := FOF_ALLOWUNDO;
      If RenameOnCollision Then fFlags := fFlags or FOF_RENAMEONCOLLISION;
      If NoConfirmation    Then fFlags := fFlags or FOF_NOCONFIRMATION;
      If Silent            Then fFlags := fFlags or FOF_SILENT;
      If ShowProgress      Then fFlags := fFlags or FOF_SIMPLEPROGRESS;
    End;
    Result := (SHFileOperation(SHFileOpStruct) = 0);
  Except
    Result := False;
  End;
end;

{!~ File_GetCreationDate
Returns the Creation Date for a file.}
Function File_GetCreationDate(FileName : String): TDateTime;
var
  SearchRec : TSearchRec;
  DT        : TFileTime;
  ST        : TSystemTime;
begin
  Result := 0;
  If Not FileExists(FileName) Then Exit;
  Try
    SysUtils.FindFirst(FileName, faAnyFile, SearchRec);
    Try
      FileTimeToLocalFileTime(SearchRec.FindData.ftCreationTime,DT);
      FileTimeToSystemTime(DT, ST);
      Result := SystemTimeToDateTime(ST);
    Finally
      SysUtils.FindClose(SearchRec);
    End;
  Except
    Result := 0;
  End;
end;

{!~ File_GetLastAccessDate
Returns the Date a file was last accessed.}
Function File_GetLastAccessDate(FileName : String): TDateTime;
var
  SearchRec : TSearchRec;
  DT        : TFileTime;
  ST        : TSystemTime;
begin
  Result := 0;
  If Not FileExists(FileName) Then Exit;
  Try
    SysUtils.FindFirst(FileName, faAnyFile, SearchRec);
    Try
      FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime,DT);
      FileTimeToSystemTime(DT, ST);
      Result := SystemTimeToDateTime(ST);
    Finally
      SysUtils.FindClose(SearchRec);
    End;
  Except
    Result := 0;
  End;
end;

{!~ File_GetLastModifiedDate
Returns the Date a file was last modified.}
Function File_GetLastModifiedDate(FileName : String): TDateTime;
var
  SearchRec : TSearchRec;
  DT        : TFileTime;
  ST        : TSystemTime;
begin
  Result := 0;
  If Not FileExists(FileName) Then Exit;
  Try
    SysUtils.FindFirst(FileName, faAnyFile, SearchRec);
    Try
      FileTimeToLocalFileTime(SearchRec.FindData.ftLastWriteTime,DT);
      FileTimeToSystemTime(DT, ST);
      Result := SystemTimeToDateTime(ST);
    Finally
      SysUtils.FindClose(SearchRec);
    End;
  Except
    Result := 0;
  End;
end;

{!~ File_GetLongFileName
Returns the Long File Name of a file.}
Function File_GetLongFileName(FileName : String): String;
var
  SearchRec : TSearchRec;
begin
  Result := '';
  If Not FileExists(FileName) Then Exit;
  Try
    SysUtils.FindFirst(FileName, faAnyFile, SearchRec);
    Try
      Result := String(SearchRec.FindData.cFileName);
    Finally
      SysUtils.FindClose(SearchRec);
    End;
  Except
    Result := '';
  End;
end;

{!~ File_GetShortFileName
Returns the Short File Name of a file.}
Function File_GetShortFileName(FileName : String): String;
var
  SearchRec : TSearchRec;
begin
  Result := '';
  If Not FileExists(FileName) Then Exit;
  Try
    SysUtils.FindFirst(FileName, faAnyFile, SearchRec);
    Try
      Result := String(SearchRec.FindData.cAlternateFileName);
    Finally
      SysUtils.FindClose(SearchRec);
    End;
  Except
    Result := '';
  End;
end;

{!~ File_KillDirectory
Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_KillDirectory(DirectoryName: String): Boolean;
Begin
  Result := DelTree(DirectoryName);
End;

{!~ File_MoveDirectory
Moves a directory regardless of whether the directory is filled or has subdirectories.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise.}
Function File_MoveDirectory(
  SourceDirectoryName: String;
  DestDirectoryName: String): Boolean;
begin
  Result :=
    File_DirOperations_Detail(
      'MOVE',   //Action            : String;  //COPY, DELETE, MOVE, RENAME
      False,    //RenameOnCollision : Boolean; //Renames if directory exists
      True,     //NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
      True,     //Silent            : Boolean; //No progress dialog is shown
      False,    //ShowProgress      : Boolean; //displays progress dialog but no file names
      SourceDirectoryName,//FromDir : String;  //From directory
      DestDirectoryName   //ToDir   : String   //To directory
      );
end;

{!~ File_ReNameDirectory
ReNames a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_ReNameDirectory(
  OldDirectoryName: String;
  NewDirectoryName: String): Boolean;
begin
  Result :=
    File_DirOperations_Detail(
      'RENAME', //Action            : String;  //COPY, DELETE, MOVE, RENAME
      False,    //RenameOnCollision : Boolean; //Renames if directory exists
      True,     //NoConfirmation    : Boolean; //Responds "Yes to All" to any dialogs
      True,     //Silent            : Boolean; //No progress dialog is shown
      False,    //ShowProgress      : Boolean; //displays progress dialog but no file names
      OldDirectoryName,//FromDir : String;  //From directory
      NewDirectoryName //ToDir   : String   //To directory
      );
end;

{!~ File_RemoveDirectory
Completely deletes a directory regardless of whether the directory
is filled or has subdirectories.  No confirmation is requested so be careful.
This is a powerful utility.  If the operation is successful then True is
returned, False otherwise}
Function File_RemoveDirectory(DirectoryName: String): Boolean;
Begin
  Result := DelTree(DirectoryName);
End;

{!~ FilesInDirDetail
Populates a TStrings FileList with the files meeting selected
file attribute criteria in a directory.  The mask argument is a
standard DOS file argument like '*.*.  The InclDotFiles argument
allows the user to exclude the system files "." and ".." by
setting the value to False.  If the Intersection argument is set
to true then the result will reflect only those files that satisfy
all attribute criteria.  If Intersection is set to false then the
result will be a union of files that meet any of the criteria.}
Function FilesInDirDetail(
  FileList    : TStrings;
  Directory   : String;
  Mask        : String;
  Intersection: Boolean;
  IsReadOnly  : Boolean;
  IsHidden    : Boolean;
  IsSystem    : Boolean;
  IsVolumeID  : Boolean;
  IsDirectory : Boolean;
  IsArchive   : Boolean;
  IsNormal    : Boolean;
  InclDotFiles: Boolean): Boolean;
var
  j          : Integer;
  MaskPtr    : PChar;
  Ptr        : PChar;
  FileInfo   : TSearchRec;
  CurDir     : String;
  FileType   : TFileType;
  FileType_I : Integer;
  FileType_B : ShortString;
  TSList     : TStringList;
  BinaryAttr : ShortString;
  ShouldAdd  : Boolean;
begin
{  Result := False;}{zzz}
  TSList := TStringList.Create();
  Try
    Try
      FileType := [];
      If IsReadOnly  Then FileType := (FileType + [ftReadOnly]);
      If IsHidden    Then FileType := (FileType + [ftHidden]);
      If IsSystem    Then FileType := (FileType + [ftSystem]);
      If IsVolumeID  Then FileType := (FileType + [ftVolumeID]);
      If IsDirectory Then FileType := (FileType + [ftDirectory]);
      If IsArchive   Then FileType := (FileType + [ftArchive]);
      If IsNormal    Then FileType := (FileType + [ftNormal]);
      FileType_I := 0;
      If IsReadOnly  Then FileType_I := (FileType_I +   1);
      If IsHidden    Then FileType_I := (FileType_I +   2);
      If IsSystem    Then FileType_I := (FileType_I +   4);
      If IsVolumeID  Then FileType_I := (FileType_I +   8);
      If IsDirectory Then FileType_I := (FileType_I +  16);
      If IsArchive   Then FileType_I := (FileType_I +  32);
      If IsNormal    Then FileType_I := (FileType_I + 128);
      FileType_B := ConvertIntegerToBinaryString(FileType_I,8);
      TSList.Clear;
      GetDir(0,CurDir);
      ChDir(Directory);  { go to the directory we want }
      FileList.Clear;    { clear the list }

      MaskPtr := PChar(Mask);
      while Not (MaskPtr = nil) do
      begin
        Ptr := StrScan (MaskPtr, ';');
        If Not (Ptr = nil) Then Ptr^ := #0;
        If FindFirst(MaskPtr, 191, FileInfo) = 0 Then
        Begin
          Repeat            { exclude normal files if ftNormal not set }
          Begin
            If ftNormal in FileType Then
            Begin
              TSList.Add(FileInfo.Name);
            End
            Else
            Begin
              BinaryAttr := ConvertIntegerToBinaryString(FileInfo.Attr,8);
              If Intersection Then
              Begin
                ShouldAdd := True;
                For j := 1 To 8 Do
                Begin
                  If (FileType_B[j]='1') And (Not (BinaryAttr[j]='1')) Then
                  Begin
                    ShouldAdd := False;
                    Break;
                  End;
                End;
                If ShouldAdd Then
                  TSList.Add(FileInfo.Name);
              End
              Else
              Begin
                For j := 1 To 8 Do
                Begin
                  If (FileType_B[j]='1') And (BinaryAttr[j]='1') Then
                  Begin
                    TSList.Add(FileInfo.Name);
                    Break;
                  End;
                End;
              End;
            End;
          End;
          Until Not (FindNext(FileInfo) = 0);
          FindClose(FileInfo);
        End;
        If Not (Ptr = nil) then
        begin
          Ptr^ := ';';
          Inc (Ptr);
        end;
        MaskPtr := Ptr;
      end;
      ChDir(CurDir);
      TSList.Sorted := False;
      If Not InclDotFiles Then
      Begin
        If TSList.IndexOf('.') > -1 Then
          TSLIst.Delete(TSList.IndexOf('.'));
        If TSList.IndexOf('..') > -1 Then
          TSLIst.Delete(TSList.IndexOf('..'));
      End;
      TSList.Sorted := True;
      TSList.Sorted := False;
      FileList.Assign(TSList);
      Result := True;
    Except
      Result := False;
    End;
  Finally
    TSList.Free;
  End;
end;

{!~ Internet_EmptyCacheDirectories
Empties the Temporary Internet Files directory.
Only validated with MS Internet Explorer 3.02
}
procedure Internet_EmptyCacheDirectories(
  TemporaryInternetDirectory : String);
Var
  i,j: Integer;
  T  : TStringList;
  D  : TStringList;
begin
  T := TStringlist.Create();
  D := TStringList.Create();
  Try
    If TemporaryInternetDirectory = '' Then
    Begin
      ShowMessage('The Web Cache Directory needs to be provided!');
      Exit;
    End;
    If Not DirectoryExists(TemporaryInternetDirectory) Then
    Begin
      ShowMessage('The Web Cache Directory is invalid!');
      TemporaryInternetDirectory := '';
      Exit;
    End;
    If Not (Copy(TemporaryInternetDirectory,Length(TemporaryInternetDirectory),1) = '\') Then
    Begin
      TemporaryInternetDirectory := TemporaryInternetDirectory + '\';
    End;

    FilesInDirDetail(
      D,                    //FileList    : TStrings;
      TemporaryInternetDirectory,            //Directory   : String;
      '*.*',                //Mask        : String;
      True,                 //Intersection: Boolean;
      False,                //IsReadOnly  : Boolean;
      True,                 //IsHidden    : Boolean;
      False,                //IsSystem    : Boolean;
      False,                //IsVolumeID  : Boolean;
      True,                 //IsDirectory : Boolean;
      False,                //IsArchive   : Boolean;[/cod
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Cevapla