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