Important Notice

The pages on this site contain documentation for very old MS-DOS software, purely for historical purposes. If you're looking for up-to-date documentation, particularly for programming, you should not rely on the information found here, as it will be woefully out of date.

  ◄Example► ◄Contents► ◄Index►                                    ◄Back►
 
PROGRAM copy1;
 
{ COPY1.PAS copies one file to another. It illustrates file I/O and
  dynamic memory allocation functions, including:
 
      Assign       BlockWrite    IOResult    Reset      SizeOf
      BlockRead    Dispose       New         Rewrite
}
 
CONST
    program_name = 'COPY1 ';
    program_desc = 'copies files using BlockRead and BlockWrite.';
    buf_size     = 4096;
 
TYPE
    access_t   = (read_acc, overwrite_acc, append_acc);
    file_buf_t = ARRAY [1..buf_size] OF Char;
 
VAR
    infile, outfile : FILE;
    mode            : access_t;
 
{============================= open_file ==============================}
 
FUNCTION open_file( VAR myfile : FILE;
                        mode   : access_t ) : Integer;
 
BEGIN
    IF mode = read_acc THEN Reset( myfile, 1 )
    ELSE IF mode = overwrite_acc THEN Rewrite( myfile, 1 );
 
    open_file := IOResult;
END; { function openfile }
 
{============================= copy_file ==============================}
{ Function copy_file copies one file to another with the BlockRead and
  BlockWrite procedures, through an internal buffer.
}
 
FUNCTION copy_file( VAR source : FILE;
                    VAR destin : FILE ) : Boolean;
 
VAR
    buf    : ^file_buf_t;
    result : Word;
    wrote  : Word;
 
BEGIN
 
    copy_file := True;
    New( buf );
 
    { Read-write until there's nothing left. }
    WHILE( NOT Eof( source ) ) DO
        BEGIN
        { Read and write input. }
        BlockRead( source, buf^, SizeOf( buf^ ), result );
        IF (IOResult <> 0) THEN
            BEGIN
            copy_file := False;
            Writeln( 'Read error.' );
            Exit;
            END;
        BlockWrite( destin, buf^, result, wrote );
        IF (IOResult <> 0) THEN
            BEGIN
            copy_file := False;
            Writeln( 'Write error.' );
            Exit;
            END;
        END; { while loop }
 
    Dispose( buf );
 
END; { function copy_file }
 
{============================ main program ============================}
 
BEGIN
 
    Writeln( program_name, program_desc );
    Writeln;
 
    IF (ParamCount = 2) THEN
{$I-}
        BEGIN
        { Assign and open the files. }
        Assign( infile, ParamStr( 1 ) );
        IF (IOResult <> 0) THEN
            Writeln( 'Unable to find input file ', ParamStr( 1 ) );
        IF (open_file( infile, read_acc ) <> 0) THEN
            BEGIN
            Writeln( 'Error opening input file ', ParamStr( 1 ) );
            Exit;
            END; { if error on openfile }
 
        Assign( outfile, ParamStr( 2 ) );
        IF (IOResult <> 0) THEN
            Writeln( 'Unable to open file ', ParamStr( 2 ) );
        IF (open_file( outfile, overwrite_acc ) <> 0) THEN
            BEGIN
            Writeln( 'Error opening output file ', ParamStr( 2 ) );
            Exit;
            END; { if error on openfile }
 
        IF (copy_file( infile, outfile )) THEN
            Writeln( 'Copy successful.' )
        ELSE
            Writeln( 'Copy failed.' );
{$I+}
        Close( infile );
        Close( outfile );
 
        END { if clause }
    ELSE
        Writeln( '  SYNTAX: COPY1 <source> <target>' );
 
END.