1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

{-Victor De la Rocha}
{-Algoritmia@groups.msn.com}
{-www.myalgorithm.com}
{
-Programa 4-Lee un archivo de texto, y lo graba en otro
 palabra por palabra
}
uses
 crt;const
 ARCHIVO='ARCHIVO4.TXT';{Unicamente lo leera, no lo modificara}
type
 F=TEXT;
var Letras,f2:F;
 Caracter:char;
 palabra:string;
procedure titulo(titulo:string;y:integer);
 begin  gotoxy(trunc((80/2)-(length(titulo))/2),y);
  write(titulo);
 end;{Procedure titulo}
 
begin{Programa Principal} ClrScr;
 titulo('Programa 4',1);
 titulo('>Duplica un archivo, palabra por palabra<',2);
 writeln;
 {*--->Asigno el ARCHIVO a Letras(El que voy a leer)<---*} assign(Letras,ARCHIVO);
 assign(f2,'copia4.txt');
 {*--->Intento crear los archivo<---*}
 {$I-}
  reset(Letras); {$I+}
  if ioresult=0 then {} else rewrite(Letras);
 reset(Letras);
 rewrite(f2);{creo el archivo dos o copia, como nuevo}
 reset(f2); {*---><---*}
 {append(f2);{abro f2, para escritura}
 {*--->Intento leer Letras caracter por caracter<---*}
  palabra:='';
  while not eof(Letras) do   begin
    while not eoln(Letras) do
     begin
      repeat
       append(f2);       read(Letras,Caracter);
       close(f2);
       palabra:=concat(palabra,Caracter);
      until (caracter=' ') OR (eof(Letras)=true);
       append(f2);       write(f2,palabra);
       {*--->Mostra en pantalla palabra por palabra<---*}
       delay(50);write(palabra);
       {*---><---*}
       palabra:='';       close(f2)
     end;{while not eoln}
    readln(Letras);
    append(f2);
    writeln(f2);    close(f2);
   end;{while not eof}
  Close(Letras);
 {*---><---*}
 ReadKey;end.