unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics, Forms,
StdCtrls, ShellAPI;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
//Programm (xxx.exe) finden:
procedure FindAllFiles(RootFolder:
string; Mask:
string = '
xxx.exe'; Recurse: Boolean = True);
//Partitionen ermitteln:
procedure LaufwerkeErmitteln;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
Abbruch: boolean;
//Zum Abbrechen des Suchvorgangs
Laufwerke: TStringList;
//Liste mit den Partitionen
ProgrammPfad:
string;
//selbsterklärend: Programmpfad halt
implementation
{$R *.dfm}
//Alle Partitionen der Festplatte ermitteln, bzw. 2. Festplatten:
//==============================================================================
procedure TForm1.LaufwerkeErmitteln;
var Drive: Char;
Str:
String;
begin
for Drive := '
A'
to '
Z'
do //alle möglichen Buchstaben durchtesten
begin
Str := '
';
case GetDriveType(PChar(Drive + '
:\'))
of
DRIVE_FIXED:
//Nur Festplatten anzeigen
Str := Drive + '
:\';
end;
if Str <> '
'
then
Laufwerke.Add(Str);
//Partition zur Stringlist (Laufwerke) hinzufügen
end;
end;
//Alle Partitionen der Festplatte ermitteln, bzw. 2. Festplatten:
//==============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Laufwerke := TStringList.Create;
//in dieser werden die Partitionen gespeichert
LaufwerkeErmitteln;
//Partitionen herausfinden
end;
//Das Programm auf der Festplatte finden (adress.exe):
//==============================================================================
procedure TForm1.FindAllFiles(RootFolder:
string; Mask:
string = '
xxx.exe'; Recurse: Boolean = True);
var SR: TSearchRec;
begin
//Rootfolder: Pfad
//SR.Name: Dateiname (xxx.exe)
if AnsiLastChar(RootFolder)^ <> '
\'
then
RootFolder := RootFolder + '
\';
if Recurse
then
begin
if FindFirst(RootFolder + '
*.*', faAnyFile, SR) = 0
then
begin
try
repeat
if SR.Attr
and faDirectory = faDirectory
then
if (SR.
Name <> '
.')
and (SR.
Name <> '
..')
then
begin
FindAllFiles(RootFolder + SR.
Name, Mask, Recurse);
end;
until (FindNext(SR) <> 0)
or (Abbruch);
finally
FindClose(SR);
end;
end;
if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0
then
begin
try
repeat
if SR.Attr
and faDirectory <> faDirectory
then
begin
Application.ProcessMessages;
ProgrammPfad := RootFolder + SR.
name;
if ProgrammPfad <> '
'
then abbruch := true;
//Falls Programm gefunden, aus der procedure raus gehen
end;
until (FindNext(SR) <> 0)
or (Abbruch);
finally
FindClose(SR);
end;
end;
end;
end;
//Suche starten und Programm "xxx.exe" öffnen:
//==============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
//für alle Partitionen wiederholen:
for i := 0
to Laufwerke.Count - 1
do
FindAllFiles(Laufwerke[i]);
//Programm starten
ShellExecute(Form1.Handle, '
open', PChar(ProgrammPfad),
nil,
nil, SW_SHOW);
end;
//Speicher der Stringlist wieder freigeben:
//==============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
Laufwerke.Free;
end;
end.