Pascal/Turbo Pascal - Como pasar datos de un archivo a un txt y de un txt a un archivo

Hola! Tengo el siguiente problema, tengo que hacer un ejer donde me pide pasar todos los datos de un archivo a un txt y en otro me pide lo mismo pero del txt al archivo.. tengo la duda si lo que hice esta bien o esta terriblemente mal

Aca seria del archivo al txt:

procedure Listado_de_persona(var data:arch);
var
txt:text;
reg:archivo;
nom:string[20];
begin
write('Ingrese el nombre del archivo:');
readln(nom);
assign(data,nom);
reset(data);
assign(txt,'personas.txt');
rewrite(txt);
while not EOF(data)do begin
read(data,reg);
writeln(txt,reg.nombre);
writeln(txt,reg.apellido);
writeln(txt,reg.fecha);
writeln();
end;
end;

Aca del txt al archivo:

procedure Crear (var dato:medic);
var
nom:string[20];
txt:text;
reg:archivo;
begin
Write('Ingrese un nombre para el archivo:');
readln(nom);
assign(dato,nom);
rewrite(dato);
assign(txt,'c:\carga.txt');
reset(txt);
while not eof (txt) do begin
readln(txt,reg.nombre);
readln(txt,reg.vencimiento);
readln(txt,reg.stock);
readln(txt,reg.presentacion);
write(dato,reg);
end;
end;

En principio está todo bien. Si acaso yo te aconsejaría que cuando trates archivos la apertura y cierre de los mismos la hagas en el programa principal, aunque tampoco es estrictamente necesario

{Mira esto}

program textos;
uses
crt;
type
registro = record
nombre : string[80];
p1apell : string[80];
s2apell : string[80];
end;

var
tex : text;
regi : registro;
f : file of registro;
texto : string;


procedure entrada_registros(var r : registro);
begin
clrscr;
with r do
begin
write(' Entre Nombre : ');
readln(nombre);
write(' Entre 1§ Apellido : ');
readln(p1apell);
write(' Entre 2§ Apellido : ');
readln(s2apell);
end;
end;

procedure guardar_registros;
begin
entrada_registros(regi);
assign(f,'Datosreg.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,regi);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,regi);
close(f);
end;
end;


procedure de_registro_a_texto;
var
tom : boolean;
tt : longint;
begin
tom := false;
assign(f,'Datosreg.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error De Archivo o No Existe ? Pulse Una Tecla ¨');
readkey;
end
else
begin
assign(tex,'Temporal.txt');
for tt := 0 to filesize(f) - 1 do
begin
seek(f,tt);
read(f,regi);
if tom = false then
begin
rewrite(tex);
writeln(tex,regi.nombre);
writeln(tex,regi.p1apell);
writeln(tex,regi.s2apell);
close(tex);
tom := true;
end
else
begin
Append(tex);
writeln(tex,regi.nombre);
writeln(tex,regi.p1apell);
writeln(tex,regi.s2apell);
close(tex);
end;
end;
close(f);
end;
end;

procedure de_texto_a_registro;
begin
assign(f,'tempreg.tmp');
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
close(f);
erase(f);
end;
assign(tex,'Temporal.txt');
{$I-} reset(tex); {$I+}
if ioresult = 0 then
begin
while not eof(tex) do
begin
readln(tex,regi.nombre);
readln(tex,regi.p1apell);
readln(tex,regi.s2apell);
assign(f,'tempreg.tmp');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,regi);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,regi);
close(f);
end;
end;
close(tex);
end
else
begin
writeln(' Error De Archivo o No Existe ? Pulse Una Tecla ¨');
readkey;
end;
end;

procedure limpiar_de_archivos;
begin
assign(f,'Datosreg.dat');
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
close(f);
erase(f);
end;
assign(f,'tempreg.tmp');
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
close(f);
erase(f);
end;
assign(tex,'Temporal.txt');
{$I-} reset(tex); {$I+}
if ioresult = 0 then
begin
close(tex);
erase(tex);
end;
end;

procedure presenta_registros;
var
paso : longint;
op : char;
begin
clrscr;
writeln(' *** Cual Desea ver [1]=tempreg.tmp [2]=Datosreg.dat ***');
writeln;
repeat
op := readkey;
until op in['1','2'];
if op = '1' then
begin
assign(f,'tempreg.tmp');
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
clrscr;
for paso := 0 to filesize(f) - 1 do
begin
seek(f,paso);
read(f,regi);
writeln(' ',regi.nombre,' ',regi.p1apell,' ',regi.s2apell);
end;
close(f);
end;
end;
if op = '2' then
begin
assign(f,'Datosreg.dat');
{$I-} reset(f); {$I+}
if ioresult = 0 then
begin
clrscr;
for paso := 0 to filesize(f) - 1 do
begin
seek(f,paso);
read(f,regi);
writeln(' ',regi.nombre,' ',regi.p1apell,' ',regi.s2apell);
end;
close(f);
end;
end;
writeln;
write(' Pulse Una Tecla');
readkey;
end;

procedure presenta_texto;
begin
clrscr;
assign(tex,'Temporal.txt');
{$I-} reset(tex); {$I+}
if ioresult = 0 then
begin
while not eof(tex) do
begin
readln(tex,texto);
writeln(texto);
end;
close(tex);
writeln;
write(' Pulse Una Tecla');
readkey;
end;
end;

procedure menu;
var
sal : boolean;
tecla : char;
begin
sal := false;
repeat
clrscr;
writeln(' **** Menu Jeneral ****');
writeln;
writeln(' 1 = Entrada Registros');
writeln(' 2 = Regidtro a Texto');
writeln(' 3 = Texto a Registro');
writeln(' 4 = Limpiar Archivos');
writeln(' 5 = Ver Archivo Texto');
writeln(' 6 = ver Archivo Registros');
writeln(' 7 = Salir');
writeln;
writeln(' <<<< Elija Opcion >>>>');
repeat
tecla := readkey;
until tecla in['1','2','3','4','5','6','7'];
clrscr;
case tecla of
'1' : guardar_registros;
'2' : de_registro_a_texto;
'3' : de_texto_a_registro;
'4' : limpiar_de_archivos;
'5' : presenta_texto;
'6' : presenta_registros;
'7' : sal := true;
end;
until sal = true;
end;

begin
menu;
end.