home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPBOOK
/
TEXTFILE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-07
|
2KB
|
100 lines
{ TEXTFILE.PAS }
program TextFiles;
{ Demonstrates copying a text file to another file }
var
DataLine : String;
Error : Integer;
InFileName : String[80];
InFile : Text;
Line : Integer;
OutFileName : String[80];
OutFile : Text;
TotalLines : Word;
Response : String[80];
begin
{ Get name of input file and open the file }
Repeat
Write('Enter the name of the file to read (CR=done): ');
Readln( InFileName );
if Length( InFileName ) > 0 then
begin
Assign( InFile, InFileName );
{$I-}
Reset( InFile );
{$I+}
Error := IoResult;
if Error <> 0 then
writeln('Unable to open ',InfileName,'.');
end; { if begin }
Until (Error = 0) or (Length( InFileName ) = 0);
{ Get name of output file and open the file }
If Length( InFileName ) > 0 then
begin
repeat
repeat
Error := 0;
Write('Enter the name of the file to COPY TO (CR=done): ');
Readln( OutFileName );
if Length( OutFileName ) > 0 then
begin
Assign( OutFile, OutFileName );
{$I-}
Reset( OutFile );
{$I+}
Error := IoResult;
if Error = 0 then
begin
Close ( OutFile );
Write(OutFileName,' already exists. Overwrite (Y/Cr=No)? ');
Readln( Response );
if (Response = 'Y') or (Response = 'y') then
Error := 1; { Allow exit from the filename query loop }
end; { if begin }
end; { if begin }
until (Error <> 0) or (Length( OutFileName ) = 0);
if Error <> 0 then
begin
{$I-}
Rewrite( OutFile );
{$I+}
Error := IoResult;
if Error <> 0 then
Writeln('Problem creating ',OutFileName,'.');
end; { if begin }
until (Error = 0) or (Length( OutFileName ) = 0);
{ Copy the input file to the output file }
if Length( OutFileName ) > 0 then
begin
while not Eof(InFile) do
begin
Readln( InFile, DataLine );
Writeln( OutFile, DataLine );
{ Write a dot on the screen for each line copied }
Write('.');
end; { while }
Writeln;
Close( InFile );
Close( OutFile );
end; { if begin }
end; { if begin }
end. { program }