Nach CD-Rom Laufwerk suchen und...

[meisterproppa]

Hallo Leute ,
habe folgendes Problem:

Ich möchte mit einem Buttonklick die Laufwerksbuchstaben von allen im system bfindlichen CD-Rom Laufwerken erhalten,um auf den darin befindlichen cd's nach dateien mit einer bestimmten dateierweiterung zu suchen (in allen ordern), von diesen gefundenen dateien soll dann die größte ausgewählt und in ein editfeld geschrieben werden.

Wer weiß einen Rat????

Vielen Dank schon mal

hoffe das ich mein problem einigermaßen gut geschildert habe :-))

[Jens Schumann]

Moin Meisterproppa,<br>
der folgende Source sucht auf allen CD-ROMS nach der dicksten Datei.<br>
<pre>
<font face="Verdana" size="1" color="#000000">unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
btn: TButton;
ListBox1: TListBox;
Label1: TLabel;
procedure btnClick(Sender: TObject);
private
{ Private-Deklarationen }
FBiggestFilename : String;
FBiggestFileSize : Integer;
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

Type
TGetFilesCallBack = procedure(Filename : String; SR : TSearchRec; var CanExit : Boolean);

function GetFiles(const ADirectory: string; Files: TStrings; SubFolders : Boolean; aCB : TGetFilesCallBack) : Boolean;
// Helper function to remove any slashes or add them if needed
function SlashSep(const Path, S: string): string;
begin
if AnsiLastChar(Path)^ &lt;&gt; '\' then
Result := Path + '\' + S
else
Result := Path + S;
end;
var
SearchRec: TSearchRec;
nStatus: Integer;
CanExit : Boolean;
begin
Result:=False;
CanExit:=False;
// First find all the files in the current directory
// You could put something else instead of *.*, such as *.jpeg or *.gif
// to find only files of those types.
nStatus := FindFirst(PChar(SlashSep(ADirectory, '*.*')), 0, SearchRec);
Try
while nStatus = 0 do
begin
Files.Add(SlashSep(ADirectory, SearchRec.Name));
If Assigned(aCB) then
aCB(SlashSep(ADirectory, SearchRec.Name),SearchRec,CanExit);
If CanExit then
begin
Result:=True;
Exit;
end;
nStatus := FindNext(SearchRec);
end;
Finally
FindClose(SearchRec);
end;
// Next look for subfolders and search them if required to do so
if SubFolders then
begin
Try
nStatus := FindFirst(PChar(SlashSep(ADirectory, '*.*')), faDirectory, SearchRec);
while (nStatus = 0) do
begin
// If it is a directory, then use recursion
if ((SearchRec.Attr and faDirectory) &lt;&gt; 0) then
begin
if ( (SearchRec.Name &lt;&gt; '.') and (SearchRec.Name &lt;&gt; '..') ) then
Result:=GetFiles(SlashSep(ADirectory, SearchRec.Name), Files, SubFolders,aCB);
If Result then Exit;
end;
nStatus := FindNext(SearchRec);
end;
Finally
FindClose(SearchRec);
end;
end;
end;

procedure FileSearchCallback(Filename : String; SR : TSearchRec; var CanExit : Boolean);
begin
Application.ProcessMessages;
If SR.Size&gt;Form1.FBiggestFileSize then
begin
Form1.FBiggestFileSize:=SR.Size;
Form1.FBiggestFilename:=Filename;
end;
end;

procedure TForm1.btnClick(Sender: TObject);
var
iCnt : Integer;
Drive : String;
begin
Listbox1.Clear;
For iCnt:=Ord('D') to Ord('Z') do
begin
Drive:=Chr(iCnt)+':';
If GetDriveType(PChar(Drive))= DRIVE_CDROM then
begin
Drive:=Drive+'\';
GetFiles(Drive,Listbox1.Items,True,@FileSearchCall back);
end;
end;
Label1.Caption:=FBiggestFilename;
end;

end.
</font></pre>
Jens<br&gt

[meisterproppa]

Danke Jens ,
Hab die Proceduren ein wenig umgestrickt, weil ich keine Listbox benötige, hab deswegen ne TStringList benutzt.

funzt suuupppppaaaaa.

Nochmals Danke..