...überprüfen ob Datein zum Schreiben auf CD vorhanden sind (WinXp)?

Autor: Dev4u.ch
Homepage: http://www.dev4u.ch

Kategorie: System

var
  
Form1: TForm1;
  dir, files: Integer;

implementation

{$R *.DFM}

uses
  
registry;

function Load(Key: string): string;
var
  
Reg: TRegistry;
begin
  
Reg := TRegistry.Create;
  try
    
Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
    try
      
Result := Reg.ReadString(Key);
    except
      
Result := '';
    end;
    Reg.CloseKey;
  finally
    
Reg.Free;
  end;
end;

procedure GetAllFiles(mask: string);
var
  
search: TSearchRec;
  directory: string;
begin
  
directory := ExtractFilePath(mask);

  // find all files
  
if FindFirst(mask, $23, search) = 0 then
  begin
    repeat
      
Inc(files);
    until FindNext(search) <> 0;
  end;



  // Subdirectories/ Unterverzeichnisse
  
if FindFirst(directory + '*.*', faDirectory, search) = 0 then
  begin
    repeat
      if 
((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then
      begin
        
GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask));
        Inc(dir);
      end;

    until FindNext(search) <> 0;
    FindClose(search);
  end;
end;




procedure TForm1.Button2Click(Sender: TObject);
var
  
directory: string;
  mask: string;
  location: string;
begin
  
files         := 0;
  dir           := 0;
  location      := load('CD Burning') + '\';  //Verzeichnis der temp. Daten
  
mask          := '*.*';
  directory     := location;
  Screen.Cursor := crHourGlass;
  try
    
GetAllFiles(directory + mask);
  finally
    
Screen.Cursor := crDefault;
  end;
  if files + dir <> 0 then
    
ShowMessage(IntToStr(files) + ' Files und ' + IntToStr(dir) + ' Ordner zum Brennen')
  else
    
ShowMessage('Keine Datem zum Brennen vorhanden');
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base