home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / copy1.pas < prev    next >
Pascal/Delphi Source File  |  1985-11-18  |  4KB  |  123 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. PROGRAM copy_pas ;
  29.  
  30.   CONST
  31.     chunk_size = 4096 ;
  32.     fn_length = 64 ;
  33.  
  34.   TYPE
  35.     buffer_type = PACKED ARRAY [ 1..chunk_size ] OF byte ;
  36.     file_name_type = PACKED ARRAY [ 1..fn_length ] OF char ;
  37.  
  38.   VAR
  39.     fname : STRING ;
  40.     buf : buffer_type ;
  41.     i, in_file, out_file : integer ;
  42.     name : file_name_type ;
  43.  
  44.   FUNCTION gem_create( VAR fname : file_name_type ; mode : integer ) : integer;
  45.     GEMDOS( $3C ) ;
  46.  
  47.   FUNCTION gem_open( VAR fname : file_name_type ; mode : integer ) : integer;
  48.     GEMDOS( $3D ) ;
  49.  
  50.   PROCEDURE gem_close( handle : integer ) ;
  51.     GEMDOS( $3E ) ;
  52.  
  53.   FUNCTION gem_read( handle : integer ; nbytes : long_integer ;
  54.                 VAR buf : buffer_type ) : long_integer ;
  55.     GEMDOS( $3F ) ;
  56.  
  57.   FUNCTION gem_write( handle : integer ; nbytes : long_integer ;
  58.                 VAR buf : buffer_type ) : long_integer ;
  59.     GEMDOS( $40 ) ;
  60.  
  61.   PROCEDURE gem_seek( nbytes : long_integer ; handle, mode : integer ) ;
  62.     GEMDOS( $42 ) ;
  63.  
  64.   PROCEDURE copy_file( in_file, out_file : integer ) ;
  65.  
  66.     VAR
  67.       n : long_integer ;
  68.  
  69.     BEGIN
  70.       REPEAT
  71.         gem_close( out_file ) ;         { Close down the output! }
  72.         out_file := gem_open( name, 1 ) ;
  73.         gem_seek( 0, out_file, 2 ) ;    { Seek end-of-file }
  74.         n := gem_read( in_file, chunk_size, buf ) ;
  75.         writeln( 'read chunk of ', n, ' bytes' ) ;
  76.         IF n < 0 THEN
  77.           BEGIN
  78.             writeln( 'error ', n, ' on input file' ) ;
  79.             halt ;
  80.           END
  81.         ELSE IF n > 0 THEN
  82.           IF gem_write( out_file, n, buf ) = n THEN
  83.             writeln( 'wrote chunk properly' )
  84.           ELSE
  85.             BEGIN
  86.               writeln( 'error writing output file' ) ;
  87.               halt ;
  88.             END ;
  89.       UNTIL n = 0 ;
  90.     END ;
  91.  
  92.   BEGIN
  93.     write( 'Source file: ' ) ;
  94.     readln( fname ) ;
  95.     FOR i := 1 TO length( fname ) DO
  96.       name[i] := fname[i] ;
  97.     name[ length(fname) + 1 ] := chr(0) ;
  98.     in_file  := gem_open( name, 0 ) ;
  99.     IF in_file >= 0 THEN
  100.       writeln( 'opened input file' )
  101.     ELSE
  102.       BEGIN
  103.         writeln( 'error ', in_file, ' opening input' ) ;
  104.         halt ;
  105.       END ;
  106.     write( 'Destination file: ' ) ;
  107.     readln( fname ) ;
  108.     FOR i := 1 TO length( fname ) DO
  109.       name[i] := fname[i] ;
  110.     name[ length(fname) + 1 ] := chr(0) ;
  111.     out_file := gem_create( name, 0 ) ;
  112.     IF out_file >= 0 THEN
  113.       writeln( 'opened output file' )
  114.     ELSE
  115.       BEGIN
  116.         writeln( 'error ', out_file, ' opening output' ) ;
  117.         halt ;
  118.       END ;
  119.     copy_file( in_file, out_file ) ;
  120.     gem_close( in_file ) ;
  121.     gem_close( out_file ) ;
  122.   END.
  123.