[viv]

Check if a directory is empty

كود :

// This function returns true if Directory is an empty directory

function DirectoryIsEmpty(Directory: string): Boolean;
var
 SR: TSearchRec;
 i: Integer;
begin
 Result := False;
 FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
 for i := 1 to 2 do
   if (SR.Name = '.') or (SR.Name = '..') then
     Result := FindNext(SR) <> 0;
 FindClose(SR);
end;


// --------
// Example:
// --------

procedure TForm1.Button1Click(Sender: TObject);
begin
 if DirectoryIsEmpty('C:\test') then
   Label1.Caption := 'empty'
 else
   Label1.Caption := 'not empty';
end;

 Check if a file is in use

كود :

function IsFileInUse(FileName: TFileName): Boolean;
var
 HFileRes: HFILE;
begin
 Result := False;
 if not FileExists(FileName) then Exit;
 HFileRes := CreateFile(PChar(FileName),
                        GENERIC_READ or GENERIC_WRITE,
                        0,
                        nil,
                        OPEN_EXISTING,
                        FILE_ATTRIBUTE_NORMAL,
                        0);
 Result := (HFileRes = INVALID_HANDLE_VALUE);
 if not Result then
   CloseHandle(HFileRes);
end;

// Example

procedure TForm1.Button1Click(Sender: TObject);
begin
 if IsFileInUse('c:\Programs\delphi6\bin\delphi32.exe') then
   ShowMessage('File is in use.');
 else
   ShowMessage('File not in use.');
end;

Check if a file is on a local drive

كود :

// Check if a file is on a local drive

function IsOnLocalDrive(aFileName: string): Boolean;
var
 aDrive: string;
begin
 aDrive := ExtractFileDrive(aFileName);
 if (GetDriveType(PChar(aDrive)) = DRIVE_REMOVABLE) or
    (GetDriveType(PChar(aDrive)) = DRIVE_FIXED) then
   Result := True
 else
   Result := False;
end;


// Example
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
   if IsOnLocalDrive(OpenDialog1.FileName) then
     ShowMessage(OpenDialog1.FileName + ' is on a local drive.');
end;

Change file attributes

كود :

{
To set a file's attributes, pass the name of the file and
the attributes you want to the FileSetAttr function.
}

{
 To hide a file:
}

procedure TForm1.Button1Click(Sender: TObject);
begin
 FileSetAttr('C:\YourFile.ext', faHidden);
end;

{
 Other Files Attributes:
}

{
 faReadOnly  $00000001 Schreibgeschützte Datei
 faHidden    $00000002 Verborgene Datei
 faSysFile   $00000004 Systemdatei
 faVolumeID  $00000008 Laufwerks-ID
 faDirectory $00000010 Verzeichnis
 faArchive   $00000020 Archivdatei
 faAnyFile   $0000003F Beliebige Datei
}


{
 You can also set some attributes at once:
}

FileSetAttr('C:\Autoexec.bat', faReadOnly + faHidden);


{
 To remove write protection on a file:
}

if (FileGetAttr(FileName) and faReadOnly) > 0
then FileSetAttr(FileName, FileGetAttr(FileName) xor faReadOnly);

{
 Re-Set write protection:
}

FileSetAttr(FileName, FileGetAttr(FileName) or faReadOnly);

Get a file's date

كود :

// Get a file's date

function GetFileDateTime(const FileName: TFileName): TDateTime;
var
 FStruct: TOFSTRUCT;
 wndFile: Integer;
begin
 wndFile := OpenFile(PChar(FileName), FStruct, OF_SHARE_DENY_NONE);
 Result  := FileDateToDateTime(FileGetDate(wndFile));
 CloseHandle(wndFile);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Opendialog1.Execute then
   label1.Caption := DateTimeToStr(GetFileDateTime(Opendialog1.FileName));
end;

GetFileModifyDate

كود :

function GetFileModifyDate(FileName: string): TDateTime;
var
 h: THandle;
 Struct: TOFSTRUCT;
 lastwrite: Integer;
 t: TDateTime;
begin
 h := OpenFile(PChar(FileName), Struct, OF_SHARE_DENY_NONE);
 try
   if h <> HFILE_ERROR then
   begin
     lastwrite := FileGetDate(h);
     Result    := FileDateToDateTime(lastwrite);
   end;
 finally
   CloseHandle(h);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Opendialog1.Execute then
   label1.Caption := FormatDateTime('dddd, d. mmmm yyyy hh:mm:ss',
     GetFileModifyDate(Opendialog1.FileName));
end;

Move a file in the recycle bin

كود :

// Move a file in the recycle bin

uses ShellAPI;

function DeleteFileWithUndo(sFileName: string): Boolean;
var
 fos: TSHFileOpStruct;
begin
 FillChar(fos, SizeOf(fos), 0);
 with fos do
 begin
   wFunc  := FO_DELETE;
   pFrom  := PChar(sFileName);
   fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
 end;
 Result := (0 = ShFileOperation(fos));
end;

Rename a directory

كود :

uses
 ShellApi;

procedure RenameDir(DirFrom, DirTo: string);
var
 shellinfo: TSHFileOpStruct;
begin
 with shellinfo do
 begin
   Wnd    := 0;
   wFunc  := FO_RENAME;
   pFrom  := PChar(DirFrom);
   pTo    := PChar(DirTo);
   fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or
             FOF_SILENT or FOF_NOCONFIRMATION;
 end;
 SHFileOperation(shellinfo);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 RenameDir('C:\Dir1', 'C:\Dir2');
end;

---

Copy / move / delete whole directory

كود :

// Copy / move / delete whole directory

uses
 ShellApi;

function CopyDir(const fromDir, toDir: string): Boolean;
var
 fos: TSHFileOpStruct;
begin
 ZeroMemory(@fos, SizeOf(fos));
 with fos do
 begin
   wFunc  := FO_COPY;
   fFlags := FOF_FILESONLY;
   pFrom  := PChar(fromDir + #0);
   pTo    := PChar(toDir)
 end;
 Result := (0 = ShFileOperation(fos));
end;


function MoveDir(const fromDir, toDir: string): Boolean;
var
 fos: TSHFileOpStruct;
begin
 ZeroMemory(@fos, SizeOf(fos));
 with fos do
 begin
   wFunc  := FO_MOVE;
   fFlags := FOF_FILESONLY;
   pFrom  := PChar(fromDir + #0);
   pTo    := PChar(toDir)
 end;
 Result := (0 = ShFileOperation(fos));
end;

function DelDir(dir: string): Boolean;
var
 fos: TSHFileOpStruct;
begin
 ZeroMemory(@fos, SizeOf(fos));
 with fos do
 begin
   wFunc  := FO_DELETE;
   fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
   pFrom  := PChar(dir + #0);
 end;
 Result := (0 = ShFileOperation(fos));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 if cCopyDir('d:\download', 'e:\') = True then
   ShowMessage('Directory copied.');
end;

Copy Files to the Windows clipboard

كود :

uses
 ShlObj, ClipBrd;

procedure CopyFilesToClipboard(FileList: string);
var
 DropFiles: PDropFiles;
 hGlobal: THandle;
 iLen: Integer;
begin
 iLen := Length(FileList) + 2;
 FileList := FileList + #0#0;
 hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
   SizeOf(TDropFiles) + iLen);
 if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
 begin
   DropFiles := GlobalLock(hGlobal);
   DropFiles^.pFiles := SizeOf(TDropFiles);
   Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
   GlobalUnlock(hGlobal);
   Clipboard.SetAsHandle(CF_HDROP, hGlobal);
 end;
end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyFilesToClipboard('C:\Bootlog.Txt'#0'C:\AutoExec.Bat');
end;

{
 Separate the files with a #0.
}

Encrypt/ decrypt files or strings

كود :

// Encrypt/ decrypt files or strings

unit EZCrypt;

{modeled by Ben Hochstrasser(bhoc@surfeu.ch) after some code snippet from borland}

interface

uses Windows, Classes;

type
 TWordTriple = Array[0..2] of Word;

function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
function TextEncrypt(const s: string; Key: TWordTriple): string;
function TextDecrypt(const s: string; Key: TWordTriple): string;
function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;

implementation

function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
 pIn, pOut: ^byte;
 i : Cardinal;
begin
 if SrcSize = TargetSize then
 begin
   pIn := Src;
   pOut := Target;
   for i := 1 to SrcSize do
   begin
     pOut^ := pIn^ xor (Key[2] shr 8);
     Key[2] := Byte(pIn^ + Key[2]) * Key[0] + Key[1];
     inc(pIn);
     inc(pOut);
   end;
   Result := True;
 end else
   Result := False;
end;

function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
 pIn, pOut: ^byte;
 i : Cardinal;
begin
 if SrcSize = TargetSize then
 begin
   pIn := Src;
   pOut := Target;
   for i := 1 to SrcSize do
   begin
     pOut^ := pIn^ xor (Key[2] shr 8);
     Key[2] := byte(pOut^ + Key[2]) * Key[0] + Key[1];
     inc(pIn);
     inc(pOut);
   end;
   Result := True;
 end else
   Result := False;
end;

function TextCrypt(const s: string; Key: TWordTriple; Encrypt: Boolean): string;
var
 bOK: Boolean;
begin
 SetLength(Result, Length(s));
 if Encrypt then
   bOK := MemoryEncrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key)
 else
   bOK := MemoryDecrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key);
 if not bOK then Result := '';
end;

function FileCrypt(InFile, OutFile: String; Key: TWordTriple; Encrypt: Boolean): boolean;
var
 MIn, MOut: TMemoryStream;
begin
 MIn := TMemoryStream.Create;
 MOut := TMemoryStream.Create;
 Try
   MIn.LoadFromFile(InFile);
   MOut.SetSize(MIn.Size);
   if Encrypt then
     Result := MemoryEncrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key)
   else
     Result := MemoryDecrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key);
   MOut.SaveToFile(OutFile);
 finally
   MOut.Free;
   MIn.Free;
 end;
end;

function TextEncrypt(const s: string; Key: TWordTriple): string;
begin
 Result := TextCrypt(s, Key, True);
end;

function TextDecrypt(const s: string; Key: TWordTriple): string;
begin
 Result := TextCrypt(s, Key, False);
end;

function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
 Result := FileCrypt(InFile, OutFile, Key, True);
end;

function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
 Result := FileCrypt(InFile, OutFile, Key, False);
end;

[viv]

check if a path exists

كود :

uses FileCtrl;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if DirectoryExists('c:\windows') then
   ShowMessage('Path exists!');
end;

copy files

كود :

var
 fileSource, fileDest: string;
begin
 fileSource := 'C:\SourceFile.txt';
 fileDest := 'G:\DestFile.txt';
 CopyFile(PChar(fileSource), PChar(fileDest), False);
end;

create a directory

كود :

uses
 Dialogs;

begin
 {$I-}
 MkDir('c:\windows');
 {$I+}
 if IOResult <> 0 then
   MessageDlg('Cannot Create Directory/Verzeichnis kann nicht angelegt werden!',
     mtWarning, [mbOK], 0)
 else
   MessageDlg('Directory Created/Neues Verzeichnis angelegt.', mtInformation, [mbOK], 0);
end;

Extract Icons from a File

كود :

uses
 shellApi;

{...}

procedure TForm1.Button1Click(Sender: TObject);
const
 ExtrFileName = 'C:\WINNT\system32\moricons.dll';
var
 icon: TIcon;
 NumberOfIcons, i: Integer;
begin
 icon := TIcon.Create;
 try
   // Get the number of Icons
   NumberOfIcons := ExtractIcon(Handle, PChar(ExtrFileName), UINT(-1));
   ShowMessage(Format('%d Icons', [NumberOfIcons]));
   // Extract the first 5 icons
   for i := 1 to 5 do
   begin
     // Extract an icon
     icon.Handle := ExtractIcon(Handle, PChar(ExtrFileName), i);
     // Draw the icon on your form
     DrawIcon(Form1.Canvas.Handle, 10, i * 40, icon.Handle);
   end;
 finally
   icon.Free;
 end;
end;


// Note: If you are not using Delphi 4 you can remove the UINT.

get your program's directory 

كود :

procedure TForm1.Button1Click(Sender: TObject);
var
 sExePath: string;
begin
 sExePath := ExtractFilePath(Application.ExeName)
   ShowMessage(sExePath);
end;

{
 To get your program's Exe-Name:
 Und den Exe-Name:
}

procedure TForm1.Button2Click(Sender: TObject);
var
 sExeName: string;
begin
 sExeName := ExtractFileName(Application.ExeName);
 ShowMessage(sExeName);
end;


{
 Instead of Application.ExeName you can also use Paramstr(0)
 Anstatt Application.ExeName kann man auch Paramstr(0) einsetzen
}

{
 If you are working on a DLL and are interested in the filename of the
 DLL rather than the filename of the application, then you can use this function:
}

function GetModuleName: string;
var
 szFileName: array[0..MAX_PATH] of Char;
begin
 FillChar(szFileName, SizeOf(szFileName), #0);
 GetModuleFileName(hInstance, szFileName, MAX_PATH);
 Result := szFileName;
end;

get/set the current directory

كود :

// GetCurrentDir returns the fully qualified name of the current directory.

procedure TForm1.Button1Click(Sender: TObject);
begin
 label1.Caption := GetCurrentDir;
end;


// The SetCurrentDir function sets the current directory:

procedure TForm1.Button1Click(Sender: TObject);
begin
 SetCurrentDir('c:\windows');
end;

write to/read text files

كود :

// Create a new text file and write some text into it

procedure NewTxt;
var
 f: Textfile;
begin
 AssignFile(f, 'c:\ek.txt'); {Assigns the Filename}
 ReWrite(f); {Create a new file named ek.txt}
 Writeln(f, 'You have written text into a .txt file');
 Closefile(f); {Closes file F}
end;

// Open existing text file and append some text
procedure OpenTxt;
var
 F: Textfile;
begin
 AssignFile(f, 'c:\ek.txt'); {Assigns the Filename}
 Append(f); {Opens the file for editing}
 Writeln(f, 'You have written text into a .txt file');
 Closefile(f); {Closes file F}
end;

 // Open existing text file and show first line
procedure ReadTxt;
var
 F: Textfile;
 str: string;
begin  
 AssignFile(f, 'c:\ek.txt'); {Assigns the Filename}
 Reset(f); {Opens the file for reading}
 Readln(f, str);
 ShowMessage('1. line of textfile:' + str);
 Closefile(f); {Closes file F}
end;