Список имен файлов и каталогов каждого диска.

uses sysutils,windows;
var f,f1:text;
a:cardinal;
s:string;
c:char;
s1,Root: string;
k,k1,i:integer;
BytesFreeToCalller,TotalFreeBytes,TotalBytes:int64;
ld : DWORD;
procedure Search(Path: String;var ff:text;var a,b:integer);
var sr : TSearchRec;
begin
  if FindFirst(Path+'\*.*', $14FFF, sr) = 0 then
  begin
    repeat
      if (sr.Attr and 16) = 16 then
      begin
        if sr.Name[1] <> '.' then
        begin
          s1:= Path+'\'+sr.Name;
          inc(a);
          Search(s1,ff,a,b);
        end;
      end else
       inc(b);
        Writeln(ff,'File: ',sr.Name,' Size = ', sr.Size, ' Date = ',
                 DateTimeToStr(FileDateToDateTime(sr.Time)),' Attr = ',
                 sr.attr);
 
    until FindNext(sr) <> 0;
  end;
end;
 
begin
    k:=0;
    k1:=0;
    s:='papka';
    if not DirectoryExists(s) then MkDir(s);
    ChDir(s);
    AssignFile (f, 'log.txt');
    Rewrite(f);
    a:=GetLogicalDrives;
    s:='';
    for c:='A' to 'z' do
    begin
      if a and 1=1 then s:=s+c;
      a:=a shr 1;
    end;
    ld:=GetLogicalDrives;
Root:='#:\';
for i := 0 to 25 do begin
Root[1]:=Char(Ord('A')+i);
if (ld and (1 shl i)) <> 0 then begin
write(F,Char(Ord('A') + i) + ':\');
GetDiskFreeSpaceEx(PChar(Root),@BytesFreeToCalller,@TotalFreeBytes,
@TotalBytes);
writeln(F,'Общие объем диска: ',TotalBytes div 1073741824 , ' Гб. ');
writeln(F,'Свободно на Диске: ',TotalFreeBytes div 1073741824, ' Гб. ');
AssignFile (f1, 'root.txt');
   Rewrite(f1);
   Search(PChar(Root),f1,k, k1);
   CloseFile(f1);
   writeln(f,'Каталогов = ', k,' Файлов = ', k1);
   k:=0;
   k1:=0;
   DeleteFile('root.txt');
writeln;
end;
end;
 
//вот так, если делать каждый диск по отдельности, то все получается,
//но нужно циклом, чтоб все сразу
    {AssignFile (f1, 'D.txt');
    Rewrite(f1);
    Search('D:',f1,k, k1);
    CloseFile(f1);}
    //вот пробую циклом и вызывает ошибку RunError(3)
    for i := 0 to 25 do begin
Root[1]:=Char(Ord('A')+i);
if (ld and (1 shl i)) <> 0 then begin
write(F,Char(Ord('A') + i) + ':\');
    AssignFile (f1, PChar(Root)); //пробовал писать PChar(Root.txt),ошибка
    Rewrite(f1);    //Здесь ошибка
    Search(PChar(Root),f1,k, k1);
 
    CloseFile(f1);
    close(f);
    end;
end;
    writeln('press ENTER');
    readln;
    end.