DataMuseum.dk

top - metrics - download

    Length: 2816 (0xb00)
    Types: TextFile
    Names: »VERSAMRG.PAS«

└─⟦398ae89d3⟧ Bits:30009789/_.ft.Ibm2.50007353.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »VERSAMRG.PAS« 

TextFile

PROGRAM versamrg;

(* Program versamrg is used for concatenating 8 files while stripping of
   the first 15 blocks @ 256 bytes. For further explanation se
   "Vejledning i konvertering af VersaDos-filsystemer til CP/M-filsystemer"
   V 1.0
*)

(*$I a:ioerrnum.pas           Declarations of Turbo pascal io error codes *)

   TYPE
      string_4 = string(.4.);
      string_2 = string(.2.);
      file_name_type = string(.14.);
      f = file;
      status_type = (succes, failure);

   CONST
      suffix: ARRAY(.1..8.) OF char = '12345678';
      srcdev: string_2 = 'b:';
      dstdev: string_2 = 'a:';
      size: ARRAY(.1..8.) OF integer = (260, 260
                                       ,260, 260
                                       ,260, 260
                                       ,260, 182
                                       );


   PROCEDURE copy(VAR status: status_type
                 ;VAR i,o: f
                 ;    n: integer
                 );

      VAR
         b: ARRAY(.0..127.) OF byte;
         j: integer;

     BEGIN (* COPY *)
      FOR j := 1 TO 30 DO
         IF not eof(i) THEN
            blockread(i,b,1);
      j := 1;
      WHILE (j <= n) and not eof(i) DO
        BEGIN
         blockread(i, b, 1);
         blockwrite(o, b, 1);
         j := j + 1;
        END;
      IF n = j - 1 THEN
         status := succes
      ELSE
         status := failure;
         writeln(output, j-1:4, ' blokke @ 128 oktetter kopieret.')
     END;  (* COPY *)



   VAR
      vol_id: string_4;    (* volume_id used in file names *)
      i: integer;          (* index of current input file *)
      src_name: file_name_type; (* name of current source file *)
      status: status_type;      (* status indicator *)
      src: f;                   (* current source file *)
      dst: f;                   (* destination file *)
      ios: byte;                (* i/o status *)


  BEGIN
   write(output, 'Angiv volume-id: ');
   readln(input, vol_id);

   assign(dst, dstdev + vol_id + '.txt');
   rewrite(dst);

   i := 0;
   REPEAT
      i := i + 1;
      src_name := srcdev + vol_id + '.' + suffix(.i.);
      writeln(output, 'Inddatafil: ', src_name);
      assign(src, src_name);
      (*$I-*)
      reset(src);
      (*$I+*)
      ios := IOresult;
      IF ios = IO_succes THEN
         copy( status, src, dst, size(.i.) )
      ELSE
         writeln(output, 'Åbningsfejl. IOS = ', ios);
      close(src)
   UNTIL (i >= 8) or (status <> succes);

   close(dst);
   IF (status = succes) and (i >= 8)THEN
      writeln(output, 'Status = succes')
   ELSE
      writeln(output, 'Status = failure')
 END.

«eof»