unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CheckLst;
type
TForm1 =
class(TForm)
Button1: TButton;
CheckListBox1: TCheckListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure FindFiles (aPath, aFindMask:
String; aWithSub: Boolean; aResult: tStrings);
Var
FindRec: tSearchRec;
Begin
// Wenn die Stringliste nil ist oder aPath oder aFind nicht angegeben ist
// dann raus
If (aPath = '
')
or (aFindMask = '
')
or Not Assigned (aResult)
Then
Exit;
// Wenn am Ende der Pfadangabe noch kein \ steht, dieses hinzufügen
// (Oder die Funktion IncludeTrailingPathDelimiter aus der Unit SysUtils.pas verwenden)
If aPath[Length (aPath)] <> '
\'
Then
aPath := aPath + '
\';
// Im aktuellen Verzeichnis nach der Datei suchen
If FindFirst (aPath + aFindMask, faAnyFile, FindRec) = 0
Then
Repeat
If (FindRec.
Name <> '
.')
and (FindRec.
Name <> '
..')
Then
// ...Ergebnis in die Stringlist einfügen
aResult.Add (aPath + FindRec.
Name);
Until FindNext (FindRec) <> 0;
FindClose (FindRec);
// Wenn nicht in Unterverzeichnissen gesucht werden soll dann raus
If Not aWithSub
Then
Exit;
// In Unterverzeichnissen weiter suchen
If FindFirst (aPath + '
*.*', faAnyFile, FindRec) = 0
Then
Repeat
If (FindRec.
Name <> '
.')
and (FindRec.
Name <> '
..')
Then
// Feststellen, ob es sich um ein Verzeichnis handelt
If Boolean (FindRec.Attr
and faDirectory)
Then
// Funktion erneut aufrufen, um Verzeichnis zu durchsuchen (Rekursion)
FindFiles (aPath + FindRec.
Name, aFindMask, aWithSub, aResult);
Until FindNext (FindRec) <> 0;
FindClose (FindRec);
End;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DirectoryExists('
C:\Dokumente und Einstellungen\')
then
FindFiles ('
C:\Dokumente und Einstellungen\', '
*.mp3', True, CheckListBox1.Items)
else
CheckListBox1.Items.Text:='
Keine .mp3 Dateien in C:\Dokumente und Einstellungen';
end;
procedure TForm1.Button2Click(Sender: TObject);
sl: TStringList;
i: Integer;
begin
sl := TStringList.Create;
try
for i := 0
to CheckListBox1.Items.Count - 1
do
begin
if (CheckListBox1.Checked[i] = true)
then
sl.Add(CheckListBox2.Items[i]);
end;
finally
sl.SaveToFile('
C:\Liste.m3u');
ShellExecute(Application. '
open', PChar('
C:\Liste.m3u'),
Nil,
Nil, SW_NORMAL);
sl.Free;
end;
end.