HomePage Delphi Library
Unit Ads_File;
{Copyright(c)1998 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
[email protected]
[email protected]
[email protected]}
Interface
Uses
SysUtils, StdCtrls, Dialogs, Forms, ExtCtrls,
Messages, WinProcs, WinTypes, Buttons, Classes,
DB, DBTables, Controls, Grids, UtilKeys, IniFiles, Graphics,
ShellAPI, FileCtrl, Ads_Misc, wininet {$IFNDEF WIN32}, ToolHelp{$ENDIF};
{!~ 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;
{!~ 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;
{!~ 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_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 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_Datail
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_Datail(
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;
{!~ 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);
Begin
If AppIsRunning(WinClassName) Then
Begin
If AppTerminate(ExecutableName) Then Exit;;
End;
end;
{!~
This ButtonClick Closes Solitaire if it is open
procedure TForm1.Button2Click(Sender: TObject);
begin
AppClose('Sol','Solitaire');
end;
}
{!~ 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);
Begin
If Not AppSwitchTo(WinClassName) Then
Begin
AppLoad(ExecutableName,SW_SHOWNORMAL)
End;
End;
{!~
This ButtonClick activates Solitaire
procedure TForm1.Button1Click(Sender: TObject);
begin
AppExecute('SOL.EXE','Sol');
end;
}
{!~ 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;
{!~ Returns True if Application is running, False otherwise}
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;
{!~
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;
}
{!~ 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;
{!~ 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;
{!~ A SubRoutine of AppClose}
Function AppTerminate(AppName: String): Boolean;
{$IFDEF NOT WIN32}
Var
Task : TTaskEntry;
CurName : String;
i : Integer;
{$ENDIF}
Begin
Result := False;
If 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;
{!~ Changes Directory}
Function CD(DirName: String): Boolean;
Begin
If Not IsDir(DirName) Then
Begin
Result := False;
End
Else
Begin
ChDir(DirName);
If IOResult <> 0 Then
Begin
Result := False;
End
Else
Begin
Result := True;
End;
End;
End;
{!~ 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;
{!~ 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 (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;
{!~ 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;
{!~ 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_Datail(
'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;
{Deletes Files}
Function DeleteFiles(FilePath,FileMask: String): Boolean;
var
DeleteFilesSearchRec: TSearchRec;
begin
Result := False;
FindFirst(FilePath+'\'+FileMask, faAnyFile, DeleteFilesSearchRec);
If Not (DeleteFilesSearchRec.Name = '') Then
Begin
Result := True;
DeleteFile(
{$IFDEF WIN32}PChar({$ENDIF}
FilePath+'\'+DeleteFilesSearchRec.Name
{$IFDEF WIN32}){$ENDIF}
);
While True Do
Begin
If FindNext(DeleteFilesSearchRec)<0 Then
Begin
Break;
End
Else
Begin
DeleteFile(
{$IFDEF WIN32}PChar({$ENDIF}
FilePath+'\'+DeleteFilesSearchRec.Name
{$IFDEF WIN32}){$ENDIF}
);
End;
End;
End;
End;
{!~ Returns Current Working Directory}
Function Directory: String;
Var
DirName: String;
Begin
GetDir(0,DirName);
Result := DirName;
End;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~
Empties a directory of normal files.
}
Function EmptyDirectory(Directory : String): Boolean;
Var
T : TStringList;
i : Integer;
Begin
T := TStringList.Create();
Try
Result := False;
If Copy(Directory,Length(Directory),1) <> '\' Then
Directory := Directory + '\';
If Not DirectoryExists(Directory) Then Exit;
{!~ 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
DeleteFile(PChar(Directory+T[i]));
Except
Result := False;
End;
End;
Finally
T.Free;
End;
End;
{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 IsFile(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 IsFile(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;
{!~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;
{!~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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ Returns True is the filoe 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;
{!~ Returns The File Extension Without The Path, Name Or Period}
Function FileExt(FileString: String): String;
Begin
Result := ExtractFileExtNoPeriod(FileString);
End;
{!~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);
Result := False;
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 (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;
{!~ 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;
{!~ Returns The File Name Without The Path, Extension Or Period}
Function FileName(FileString: String): String;
Begin
Result := ExtractFileNameNoExt(FileString);
End;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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_Datail(
'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;
{!~ 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;
{!~ 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_Datail
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_Datail(
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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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;
{!~ 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_Datail(
'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;
{!~ 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_Datail(
'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;
{!~ 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;
{!~ 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 MaskPtr <> nil do
begin
Ptr := StrScan (MaskPtr, ';');
If 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 (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 FindNext(FileInfo) <> 0;
FindClose(FileInfo.FindHandle);
End;
If 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;
{!~
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 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;
False, //IsNormal : Boolean;
False); //InclDotFiles: Boolean): Boolean;
For J := 0 To D.Count - 1 Do
Begin
T.Clear;
FilesInDirDetail(
T, //FileList : TStrings;
TemporaryInternetDirectory+D[j]+'\', //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;
For i := 0 To T.Count - 1 Do
Begin
SysUtils.DeleteFile(TemporaryInternetDirectory+D[j]+'\'+T[i]);
End;
End;
Finally
T.Free;
D.Free;
End;
end;
{!~ Tests Directory Existence}
Function IsDir(IsDirPath: String): Boolean;
Var
FileGetAttrValue: Integer;
Begin
{$IFDEF WIN32}
Result := DirectoryExists(IsDirPath);
Exit;
{$ENDIF}
FileGetAttrValue := FileGetAttr(IsDirPath);
If FileGetAttrValue = 16 Then
Begin
Result := True
End
Else
Begin
Result := False
End;
End;
{!~ Returns True If Directory Is Empty, False Otherwise}
Function IsDirEmpty(DirName: String): Boolean;
Begin
If IsDir(DirName) Then
Begin
If IsFile(DirName+'\*.*') Then
Begin
Result := False;
End
Else
Begin
Result := True;
End;
End
Else
Begin
Result := False;
End;
End;
{!~ Returns True If The File Exists, False Otherwise}
Function IsFile(DirName: String): Boolean;
Var
IsFileSearchRec: TSearchRec;
JustPath: String;
Counter: Integer;
NameHolder: String;
Begin
{$IFDEF WIN32}
Result := FileExists(DirName);
Exit;
{$ENDIF}
Counter := 1;
Try
JustPath := ExtractFilePath(DirName);
JustPath := Copy(JustPath,1,Length(JustPath)-1);
Except
On EInOutError Do JustPath := DirName;
Else JustPath := DirName;
End;
If Not IsDir(JustPath) Then
Begin
Result := False;
Exit;
End;
FindFirst(DirName,faAnyFile, IsFileSearchRec);
If IsFileSearchRec.Name = '' Then
Begin
Result := False;
Exit;
End;
If (Not(IsFileSearchRec.Name = '.')) And
(Not (IsFileSearchRec.Name = '..')) And
(Length(IsFileSearchRec.Name) < 13) Then
Begin
Result := True;
Exit;
End;
NameHolder := 'skjjkhfhj';
While True Do
Begin
{FindReturn := }FindNext(IsFileSearchRec);
If IsFileSearchRec.Name = NameHolder Then
Exit;
If (Not (IsFileSearchRec.Name = '.')) And
(Not (IsFileSearchRec.Name = '..')) And
(Not (IsFileSearchRec.Name = '')) And
(Length(IsFileSearchRec.Name) < 13) Then
Begin
Result := True;
Exit;
End
Else
Begin
If IsFileSearchRec.Name = '' Then
Begin
Result := False;
End
Else
Begin
{Keep Going}
End;
End;
Counter := Counter + 1;
If Counter > 1000 Then
Exit;
End;
End;
{!~ 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;
Begin
Result := DelTree(DirectoryName);
End;
{!~ Makes A Directory}
Function MD(DirName: String): Boolean;
Begin
If IsDir(DirName) Then
Begin
Result := True;
End
Else
Begin
If FileExists(DirName) And Not IsDir(DirName) Then
Begin
Result := False;
End
Else
Begin
{$IFDEF WIN32}
ForceDirectories(DirName);
Result := True;
{$ELSE}
MkDir(DirName);
If IOResult <> 0 Then
Begin
Result := False;
End
Else
Begin
Result := True;
End;
{$ENDIF}
End;
End;
End;
{!~ 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;
Begin
Result := File_MoveDirectory(SourceDirectoryName, DestDirectoryName);
End;
{!~ Removes A Directory}
Function RD(DirName: String): Boolean;
Begin
Result := DelTree(DirName);
End;
{!~ 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;
Begin
Result := File_ReNameDirectory(OldDirName, NewDirName);
End;
{!~ 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;
Begin
Result := File_ReNameDirectory(OldDirectoryName, NewDirectoryName);
End;
{!~ Sets a File Date.}
Function SetFileDate(
Const FileName : String;
Const FileDate : TDateTime): Boolean;
Var
FileHandle : THandle;
FileSetDateResult : Integer;
Begin
Try
Try
FileHandle := FileOpen(FileName, fmOpenWrite OR fmShareDenyNone);
If FileHandle > 0 Then
Begin
FileSetDateResult :=
FileSetDate(
FileHandle,
DateTimeToFileDate(FileDate));
Result := (FileSetDateResult = 0);
End;
Except
Result := False;
End;
Finally
FileClose (FileHandle);
End;
End;
{!~ Executes An External Executable}
Function WinExecute(ApToExec: String): THandle;
Begin
Result := WinExec(ConvertStringToPChar(ApToExec),SW_SHOWNORMAL);
End;
Function WinExecute32(
FileName : String;
Visibility : integer):integer;
var
zAppName:array[0..512] of char;
zCurDir:array[0..255] of char;
WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess(nil,
zAppName, { pointer to command line string }
nil, { pointer to process security attributes}
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
else
begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Cardinal(Result));
end;
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;
Initialization
DelphiChecker(
RunOutsideIDE_ads,
'Advanced Delphi Systems Code',
RunOutsideIDECompany_ads,
RunOutsideIDEPhone_ads,
RunOutsideIDEDate_ads);
End.