home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / misc~1 / 5 / osspascl / copy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-19  |  2.7 KB  |  99 lines
  1.  
  2. PROGRAM copy_pas ;
  3.  
  4.   CONST
  5.     chunk_size = 4096 ;
  6.     fn_length = 64 ;
  7.  
  8.   TYPE
  9.     buffer_type = PACKED ARRAY [ 1..chunk_size ] OF byte ;
  10.     file_name_type = PACKED ARRAY [ 1..fn_length ] OF char ;
  11.  
  12.   VAR
  13.     fname : STRING ;
  14.     buf : buffer_type ;
  15.     i, in_file, out_file : integer ;
  16.     name : file_name_type ;
  17.  
  18.   FUNCTION gem_create( VAR fname : file_name_type ; mode : integer ) : integer;
  19.     GEMDOS( $3C ) ;
  20.  
  21.   FUNCTION gem_open( VAR fname : file_name_type ; mode : integer ) : integer;
  22.     GEMDOS( $3D ) ;
  23.  
  24.   PROCEDURE gem_close( handle : integer ) ;
  25.     GEMDOS( $3E ) ;
  26.  
  27.   FUNCTION gem_read( handle : integer ; nbytes : long_integer ;
  28.                 VAR buf : buffer_type ) : long_integer ;
  29.     GEMDOS( $3F ) ;
  30.  
  31.   FUNCTION gem_write( handle : integer ; nbytes : long_integer ;
  32.                 VAR buf : buffer_type ) : long_integer ;
  33.     GEMDOS( $40 ) ;
  34.  
  35.   PROCEDURE gem_seek( nbytes : long_integer ; handle, mode : integer ) ;
  36.     GEMDOS( $42 ) ;
  37.  
  38.   PROCEDURE copy_file( in_file, out_file : integer ) ;
  39.  
  40.     VAR
  41.       n : long_integer ;
  42.  
  43.     BEGIN
  44.       REPEAT
  45.         gem_close( out_file ) ;         { Close down the output! }
  46.         out_file := gem_open( name, 1 ) ;
  47.         gem_seek( 0, out_file, 2 ) ;    { Seek end-of-file }
  48.         n := gem_read( in_file, chunk_size, buf ) ;
  49.         writeln( 'read chunk of ', n, ' bytes' ) ;
  50.         IF n < 0 THEN
  51.           BEGIN
  52.             writeln( 'error ', n, ' on input file' ) ;
  53.             halt ;
  54.           END
  55.         ELSE IF n > 0 THEN
  56.           IF gem_write( out_file, n, buf ) = n THEN
  57.             writeln( 'wrote chunk properly' )
  58.           ELSE
  59.             BEGIN
  60.               writeln( 'error writing output file' ) ;
  61.               halt ;
  62.             END ;
  63.       UNTIL n = 0 ;
  64.     END ;
  65.  
  66.   BEGIN
  67.     write( 'Source file: ' ) ;
  68.     readln( fname ) ;
  69.     FOR i := 1 TO length( fname ) DO
  70.       name[i] := fname[i] ;
  71.     name[ length(fname) + 1 ] := chr(0) ;
  72.     in_file  := gem_open( name, 0 ) ;
  73.     IF in_file >= 0 THEN
  74.       writeln( 'opened input file' )
  75.     ELSE
  76.       BEGIN
  77.         writeln( 'error ', in_file, ' opening input' ) ;
  78.         halt ;
  79.       END ;
  80.     write( 'Destination file: ' ) ;
  81.     readln( fname ) ;
  82.     FOR i := 1 TO length( fname ) DO
  83.       name[i] := fname[i] ;
  84.     name[ length(fname) + 1 ] := chr(0) ;
  85.     out_file := gem_create( name, 0 ) ;
  86.     IF out_file >= 0 THEN
  87.       writeln( 'opened output file' )
  88.     ELSE
  89.       BEGIN
  90.         writeln( 'error ', out_file, ' opening output' ) ;
  91.         halt ;
  92.       END ;
  93.     copy_file( in_file, out_file ) ;
  94.     gem_close( in_file ) ;
  95.     gem_close( out_file ) ;
  96.   END.
  97.  
  98.  
  99. Press <CR> to continue: