unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, shellapi, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, FileCtrl, XPMan, ComCtrls;
type
TForm1 =
class(TForm)
Memo1: TMemo;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label2: TLabel;
DriveComboBox1: TDriveComboBox;
Label3: TLabel;
Edit1: TEdit;
SpeedButton3: TSpeedButton;
CheckBox1: TCheckBox;
Bevel1: TBevel;
XPManifest1: TXPManifest;
ProgressBar1: TProgressBar;
Label4: TLabel;
ComboBox1: TComboBox;
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure FindAllFiles(RootFolder:
string; Mask:
string = '
*.*'; Recurse: Boolean = True);
var
SR: TSearchRec;
begin
// Implementation bis einschließlich Delphi 4
if RootFolder = '
'
then
Exit;
if AnsiLastChar(RootFolder)^ <> '
\'
then
RootFolder := RootFolder + '
\';
// Implementation ab Delphi 5
RootFolder := IncludeTrailingPathDelimiter(RootFolder);
if Recurse
then
if FindFirst(RootFolder + '
*.*', faAnyFile, SR) = 0
then
try
repeat
if SR.Attr
and faDirectory = faDirectory
then
// --> ein Verzeichnis wurde gefunden
// der Verzeichnisname steht in SR.Name
// der vollständige Verzeichnisname (inkl. darüberliegender Pfade) ist
// RootFolder + SR.Name
if (SR.
Name <> '
.')
and (SR.
Name <> '
..')
then
FindAllFiles(RootFolder + SR.
Name, Mask, Recurse);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0
then
try
repeat
if SR.Attr
and faDirectory <> faDirectory
then
begin
// --> eine Datei wurde gefunden
// der Dateiname steht in SR.Name
// der vollständige Dateiname (inkl. Pfadangabe) ist
// RootFolder + SR.Name
// folgende Zeile schreibt den vollständigen Namen in eine Memo Feld des
// Formulars Form1
Form1.Memo1.Lines.Add(RootFolder + SR.
Name);
end;
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;
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 DriveExists(DriveByte: Byte): Boolean;
begin
Result := GetLogicalDrives
and (1
shl DriveByte) <> 0;
end;
function DriveType(DriveByte: Byte):
String;
begin
case GetDriveType(PChar(Chr(DriveByte + Ord('
A')) + '
:\'))
of
{ DRIVE_UNKNOWN: Result := 'unbekannt';
DRIVE_NO_ROOT_DIR: Result := 'Laufwerk existiert nicht';
DRIVE_REMOVABLE: Result := 'Wechselmedium';
DRIVE_FIXED: Result := 'Festplatte';
DRIVE_REMOTE: Result := 'Netzwerk';
DRIVE_CDROM: Result := 'CD-ROM/DVD';
DRIVE_RAMDISK: Result := 'RAM Disk'; }
DRIVE_UNKNOWN: Result := '
unbekannt';
DRIVE_NO_ROOT_DIR: Result := '
';
DRIVE_REMOVABLE: Result := '
';
DRIVE_FIXED: Result := '
';
DRIVE_REMOTE: Result := '
';
DRIVE_CDROM: Result := '
';
DRIVE_RAMDISK: Result := '
';
else
Result := '
';
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Findallfiles (combobox1.text);
Copydir (memo1.lines, edit1.text);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
application.terminate;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 0
to 25
do
if DriveExists(I)
then
combobox1.Items.Add(Chr(I + Ord('
A')) + '
:\ (' + DriveType(I) + '
)');
end;
end.