Strasznie dziwny problem

napisałem program do archiwizowania plików *.txt który działa na nast. zasadzie "Podczas archiwizacji program wyszykuje wszystkie pliki i foldery w danej lokalizacji. Wyniki, w postaci linków są zapisywane w tymczasowym pliku. Następnie po kolei odczytywane są linki z pliku tymczasowego. Po wczytaniu linka, link jest kopiowany razem z zawartością wskazanego pliku do archiwum tar. " I podczas korzystania z programu między partycjami tzn pliki tekstowe są na jednej partycji, a na innej chce stworzyć archiwum, program wykonuje dziwną operacje. Mianowicie program wczytuje link z pliku tymczasowego następnie (i nie wiem dlaczego) zmienia literę dysku i ucina w ścieżce jeden folder. wygląda to tak:

plik tymczasowy

d:\1\Dane testowe\
d:\1\Dane testowe\df.txt
768
d:\1\Dane testowe\3\
d:\1\Dane testowe\3\1rohtefkjhsayfrwiyfihjsdgyhqwcoecfhsjhdgqwhrfiehsjdvtiuqhdsg.txt
67
d:\1\Dane testowe\3\2\
d:\1\Dane testowe\3\2\2.txt

archiwum

d:\1\

d:\1\Dane testowe\

d:\1\Dane testowe\df.txt
768
c:\3\

c:\3\1rohtefkjhsayfrwiyfihjsdgyhqwcoecfhsjhdgqwhrfiehsjdvtiuqhdsghoperyfpsdjdddjs.txt
jakies dane
c:\3\2\

c:\3\2\2.txt
jakies dane

jak wpisałem komendę, żeby mi wypisywał na ekranie te ścieżki na ekranie to wypisuje poprawne ścieżki. Dopiero w momencie zapisu coś mu odbija. Problem w tym, że nie wiem co... ;(

oto kod źródłowy (kompiluje się pod dev-pascalem):

program archiwizator;

uses
 Crt, SysUtils, Dos;

const
 maska: string = '*.*';

var
 plik_tym, n_fol_gl, nazwa_pliku, sciezka, buff, linia: string;
 objetosc: extended;
 licznik, licznik2: integer;
 wybor: byte;
 plikwej, rek, tymczasowy: Textfile;
 znak: char;

procedure szukanie;
var
sr: SearchRec;

 begin
  FindFirst(maska, ($01 and $02 and $04 and $08 and $20), sr);
  while DosError = 0 do
   begin
    writeln(tymczasowy, ExpandFileName(sr.Name));
    objetosc:=objetosc + sr.size;
    writeln(tymczasowy, sr.size);
    inc(licznik);
    FindNext(sr);
   end;
  FindFirst(maska, $3F, sr);
  while DosError = 0 do
   begin
   if (SR.Attr and $10 <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
    begin
     writeln(tymczasowy, ExpandFileName(sr.Name)+'\');
     ChDir(SR.Name);
     szukanie;
     ChDir('..');
    end;
    FindNext(SR);
   end;
 FindClose(sr);
end;

function DirectoryExists(Sciezka : string) : Boolean;
 var SR : SearchRec;
 begin
  DirectoryExists := False;
  FindFirst(Sciezka,Directory,SR);
   if DosError = 0 then
    DirectoryExists := True;
end;

procedure MakeDir(Dir: String);
  function Last(What: String; Where: String): Integer;
  var
    Ind : Integer;

  begin
    Result := 0;

    for Ind := (Length(Where)-Length(What)+1) downto 1 do
        if Copy(Where, Ind, Length(What)) = What then begin
           Result := Ind;
           Break;
        end;
  end;

var
  PrevDir : String;
  Ind     : Integer;

begin
  if Copy(Dir,2,1) <> ':' then
     if Copy(Dir,3,1) <> '\' then
        if Copy(Dir,1,1) = '\' then
           Dir := 'C:'+Dir
        else
           Dir := 'C:\'+Dir
     else
        Dir := 'C:'+Dir;

  if not DirectoryExists(Dir) then begin
     // if directory don't exist, get name of the previous directory

     Ind     := Last('\', Dir);         //  Position of the last '\'
     PrevDir := Copy(Dir, 1, Ind-1);    //  Previous directory

     // if previous directoy don't exist,
     // it's passed to this procedure - this is recursively...
     if not DirectoryExists(PrevDir) then
        MakeDir(PrevDir);

     // In thats point, the previous directory must be exist.
     // So, the actual directory (in "Dir" variable) will be created.
     CreateDir(Dir);
  end;
end; 

procedure spr_folder;
 begin
  if not DirectoryExists(n_fol_gl) then
   repeat
    writeln('Podany katalog nie istnieje, wpisz poprawna nazwe.');
    readln(n_fol_gl);
   until DirectoryExists(n_fol_gl);
end;

procedure tw_pliku;
 begin
 repeat
  ClrScr;
  writeln('Podaj sciezke i nazwe pliku(koniecznie z rozszerzeniem tar) w ktorym zostana zapisane pliki. ');
  readln(nazwa_pliku);
 until nazwa_pliku <> '';
 if not FileExists(nazwa_pliku) then
  begin
   assign(rek, nazwa_pliku);
   plik_tym:= nazwa_pliku+'.temptar';
   assign(tymczasowy, plik_tym);
  end
 else
  begin
   writeln('Plik o nazwie ', nazwa_pliku, ' juz istnieje. Wcisnij ENTER, zeby kontynuowac');
   readln;
   tw_pliku;
  end;
end;

procedure od_pliku;
begin
 repeat
 ClrScr;
  writeln('Podaj nazwe lub sciezke do pliku tar.');
  readln(nazwa_pliku);
 until nazwa_pliku <> '';
 if FileExists(nazwa_pliku) then
  begin
   assign(rek, nazwa_pliku);
   reset(rek);
  end
 else
  begin
   writeln('Plik o nazwie ', nazwa_pliku, ' nie istnieje. Wcisnij ENTER, zeby kontynuowac.');
   readln;
   od_pliku;
  end
end;

procedure pakowanie;

begin
  writeln('Podaj sciezke do folderu z ktorego pliki maja byc zarchiwizowane');
  readln(n_fol_gl);
  spr_folder;
  SetCurrentDir(n_fol_gl);
  ClrScr;
  tw_pliku;
  ReWrite(tymczasowy);
  szukanie;
  CloseFile(tymczasowy);
  if (objetosc > DiskFree(0)) then
   begin
    writeln('Za malo wolnego miejsca na dysku . Program konczy dzialanie');
    readln;
    exit;
   end
  else
   begin
    Reset(tymczasowy);
    Rewrite(rek);
    writeln(rek, n_fol_gl+'\');
    writeln(rek);
    repeat
    readln(tymczasowy, sciezka);
    if not ((FileGetAttr(sciezka) and Directory) = Directory) then
     begin
      AssignFile(plikwej, sciezka);
      readln(tymczasowy, linia);
      //writeln('plik: ', sciezka, ' linia:', linia);
      writeln(rek, sciezka);
      writeln(rek, linia);
      writeln('plik: ', sciezka, ' linia:', linia);
      Reset(plikwej);
      inc(licznik2);
      writeln('Spakowano ',licznik2,'/',licznik,' plikow');
      repeat
       readln(plikwej, buff);
       writeln(rek, buff);
      until eof(plikwej);
       writeln(rek, #03);
       CloseFile(plikwej);
      end
     else
     writeln(rek, sciezka);
     //writeln('Folder: ', sciezka);
     writeln(rek);
     writeln('Folder: ', sciezka);
    until eof(tymczasowy);
   CloseFile(tymczasowy);
   //DeleteFile(tymczasowy);
  end;
  writeln('Spakowano wszystkie pliki');
  readln;
end;

procedure rozpakowanie;

begin
 licznik:=0;
 licznik2:=0;
 writeln('Podaj sciezke do pliku tar');
 od_pliku;
 repeat
 readln(rek, sciezka);
 //writeln('sciezka:',sciezka);
 readln(rek, linia);
 //writeln('linia:',linia);
  if length(linia)=0 then
   begin
    MakeDir(sciezka);
   end
  else
   begin
    AssignFile(plikwej, sciezka);
    ReWrite(plikwej);
    licznik:=StrToInt(linia);
    repeat
     read(rek, znak);
      if znak=#03 then break;
     write(plikwej, znak);
    until znak=#03;
    CloseFile(plikwej);
   end;
  until eof(rek);
  CloseFile(rek);
  writeln('Wypakowano wszystkie pliki');
end;


begin
 licznik:=0;
 licznik2:=0;
 objetosc:=0;
 writeln('Wybierz opcje');
 writeln('1. Archiwizowanie');
 writeln('2. Rozpakowanie');
 readln(wybor);
 if wybor=1 then
  pakowanie;
 if wybor=2 then
  rozpakowanie;
 readln;
end.