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

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