Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FAQ-S.ZIP/SUBS3.PAS

Pascal/Delphi Source File | 1991-02-15 | 22.7 KB | 819 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }

unit subs3;

interface

uses crt,dos,mycomman,
     gentypes,configrt,statret,gensubs,subs1,windows,subs2,modem,
     protocol;

const local_file_header_signature = $04034b50;
      central_file_header_signature = $02014b50;
      end_central_dir_signature = $06054b50;
      compression_methods: array[0..6] of string[8]=
      (' Stored ',' Shrunk ','Reduce-1','Reduce-2','Reduce-3','Reduce-4','?');
      uinbufsize=512;
      hsize=8192;

type
   signature_type = longint;

   local_file_header = record
      version_needed_to_extract:    word;
      general_purpose_bit_flag:     word;
      compression_method:           word;
      last_mod_file_time:           word;
      last_mod_file_date:           word;
      crc32:                        longint;
      compressed_size:              longint;
      uncompressed_size:            longint;
      filename_length:              word;
      extra_field_length:           word;
   end;

   central_directory_file_header = record
      version_made_by:                 word;
      version_needed_to_extract:       word;
      general_purpose_bit_flag:        word;
      compression_method:              word;
      last_mod_file_time:              word;
      last_mod_file_date:              word;
      crc32:                           longint;
      compressed_size:                 longint;
      uncompressed_size:               longint;
      filename_length:                 word;
      extra_field_length:              word;
      file_comment_length:             word;
      disk_number_start:               word;
      internal_file_attributes:        word;
      external_file_attributes:        longint;
      relative_offset_local_header:    longint;
   end;

   end_central_dir_record = record
      number_this_disk:                         word;
      number_disk_with_start_central_directory: word;
      total_entries_central_dir_on_this_disk:   word;
      total_entries_central_dir:                word;
      size_central_directory:                   longint;
      offset_start_central_directory:           longint;
      zipfile_comment_length:                   word;
   end;

   central_list_ptr = ^central_list;
   central_list = record
      dir:     central_directory_file_header;
      name:    string;
      extra:   string;
      comment: string;
      next:    central_list_ptr;
   end;

   string8=string[8];

   sarray = array[0..255] of string[64];

   hsize_array_integer = array[0..hsize] of integer;
   hsize_array_byte    = array[0..hsize] of byte;

var
   zipfd:   dos_handle;
   zipfn:   dos_filename;
   efn:     dos_filename;
   dir:     anystr;
   var
   zipname:       dos_filename;
   scratchzip:    dos_filename;
   pattern:       dos_filename;
   extcount:      integer;
   xrec:          central_directory_file_header;
   rec:           local_file_header;
   ofd:           dos_handle;
   sig:           signature_type;
   cdir:          central_list_ptr;
   lcdir:         central_list_ptr;
   endrec:        end_central_dir_record;
   filename:      string;
   extra:         string;
   dups:          boolean;
   zipeof:      boolean;
   csize:       longint;
   cusize:      longint;
   cmethod:     integer;
   ctime:       word;
   cdate:       word;
   inbuf:       array[1..uinbufsize] of byte;
   inpos:       integer;
   incnt:       integer;
   pc:          byte;
   pcbits:      byte;
   pcbitv:      byte;
   outbuf:      array[0..4096] of byte; {for rle look-back}
   outpos:      longint;                {absolute position in outfile}
   outcnt:      integer;
   outfd:       dos_handle;
   factor:      integer;
   followers:   sarray;
   exstate:     integer;
   c:           integer;
   v:           integer;
   len:         integer;
   prefix_of:   hsize_array_integer;
   suffix_of:   hsize_array_byte;
   stack:       hsize_array_byte;
   stackp:      integer;

function getextdesc:string;
function wildcardmatch (w,f:sstr):boolean;
procedure get_string (len:word; var s:string);
procedure itoa2 (i:integer; var sp);
function format_date (date:word):string8;
function format_time (time:word):string8;
procedure process_local_file_header;
procedure process_central_file_header;
procedure process_end_central_dir;
procedure process_headers;
procedure listzip (name:dos_filename);
procedure arcview (fname:lstr);
procedure pakview (filename:lstr);
procedure lharcview (filename:lstr);
procedure zipview (fn:lstr);
procedure extractzip (ffile,mainzip,todir:anystr);
procedure extractarc (ffile,mainzip,todir:anystr);
procedure extractpak (ffile,mainzip,todir:anystr);
procedure extractlzh (ffile,mainzip,todir:anystr);
procedure extract (ffile,mainzip,todir:anystr);
procedure addtozip (zipname,fn:anystr);
procedure addcomment (path:anystr; filename:sstr);
function getpath (dir:anystr):lstr;
procedure getpathname (fname:lstr; var path:lstr; var name:sstr);
procedure writefreespace (path:lstr);
function allowxfer:boolean;
procedure fileinfo (yiyiyi:integer);

implementation

function getextdesc:string;
  var nappa:string[255];
      a,b,c:string;
      extdone:boolean;
      finalcut:integer;
  begin
   getextdesc:='';
   nappa:='';
   extdone:=false;
   finalcut:=0;
   writeln (^P'Extended Description 3 Lines Max - Hit [CR] to end (Wordwrap Active)'^R);
   writeln (^P'[--------|---------|---------|---------|---------|---------|---------|--------]'^R);
   repeat
    buflen:=80;
    wordwrap:=true;
    getstr (1);
    finalcut:=finalcut+1;
    if finalcut>2 then extdone:=true;
    if length(input)<1 then extdone:=true else
    nappa:=nappa+input;
   until extdone;
   wordwrap:=false;
   getextdesc:=nappa;
  end;


(* ---------------------------------------------------------- *)

function wildcardmatch (w,f:sstr):boolean;
var a,b:sstr;

    procedure transform (t:sstr; var q:sstr);
    var p:integer;

      procedure filluntil (k:char; n:integer);
      begin
        while length(q)<n do q:=q+k
      end;

      procedure dopart (mx:integer);
      var k:char;
      begin
        repeat
          if p>length(t)
            then k:='.'
            else k:=t[p];
          p:=p+1;
          case k of
            '.':begin
                  filluntil (' ',mx);
                  exit
                end;
            '*':filluntil ('?',mx);
            else if length(q)<mx then q:=q+k
          end
        until 0=1
      end;

    begin
      p:=1;
      q:='';
      dopart (8);
      dopart (11)
    end;

    function theymatch:boolean;
    var cnt:integer;
    begin
      theymatch:=false;
      for cnt:=1 to 11 do
        if (a[cnt]<>'?') and (b[cnt]<>'?') and
           (upcase(a[cnt])<>upcase(b[cnt])) then exit;
      theymatch:=true
    end;

  begin
    transform (w,a);
    transform (f,b);
    wildcardmatch:=theymatch
  end;

(* ---------------------------------------------------------- *)

(* ---------------------------------------------------------- *)
procedure get_string(len: word; var s: string);
var
   n: word;
begin
   if len > 255 then
      len := 255;
   n := dos_read(zipfd,s[1],len);
   s[0] := chr(len);
end;

(* ---------------------------------------------------------- *)
procedure itoa2(i: integer; var sp);
var
   s: array[1..2] of char absolute sp;
begin
   s[1] := chr( (i div 10) + ord('0'));
   s[2] := chr( (i mod 10) + ord('0'));
end;

function format_date(date: word): string8;
const
   s:       string8 = 'mm-dd-yy';
begin
   itoa2(((date shr 9) and 127)+80, s[7]);
   itoa2( (date shr 5) and 15,  s[1]);
   itoa2( (date      ) and 31,  s[4]);
   format_date := s;
end;

function format_time(time: word): string8;
const
   s:       string8 = 'hh:mm:ss';
begin
   itoa2( (time shr 11) and 31, s[1]);
   itoa2( (time shr  5) and 63, s[4]);
   itoa2( (time shl  1) and 63, s[7]);
   format_time := s;
end;

(* ---------------------------------------------------------- *)
procedure process_local_file_header;
var
   n:             word;
   rec:           local_file_header;
   filename:      string;
   extra:         string;

begin
   n := dos_read(zipfd,rec,sizeof(rec));
   get_string(rec.filename_length,filename);
   get_string(rec.extra_field_length,extra);
   dos_lseek(zipfd,rec.compressed_size,seek_cur);
end;

(* ---------------------------------------------------------- *)
procedure process_central_file_header;
var
   n:             word;
   rec:           central_directory_file_header;
   filename:      string;
   extra:         string;
   comment:       string;

begin
   n := dos_read(zipfd,rec,sizeof(rec));
   get_string(rec.filename_length,filename);
   get_string(rec.extra_field_length,extra);
   get_string(rec.file_comment_length,comment);

   write(rec.uncompressed_size:7,'  ',
           compression_methods[rec.compression_method]:8,' ',
           rec.compressed_size:7,'   ',
           format_date(rec.last_mod_file_date),'  ',
           format_time(rec.last_mod_file_time));

   if (rec.internal_file_attributes and 1) <> 0 then
      write('   Ascii  ')
   else
      write('  Binary  ');

   writeln(filename);

(**************
   writeln;
   writeln('central file header');
   writeln('   filename = ',filename);
   writeln('   extra = ',extra);
   writeln('   file comment = ',comment);
   writeln('   version_made_by = ',rec.version_made_by);
   writeln('   version_needed_to_extract = ',rec.version_needed_to_extract);
   writeln('   general_purpose_bit_flag = ',rec.general_purpose_bit_flag);
   writeln('   compression_method = ',rec.compression_method);
   writeln('   last_mod_file_time = ',rec.last_mod_file_time);
   writeln('   last_mod_file_date = ',rec.last_mod_file_date);
   writeln('   crc32 = ',rec.crc32);
   writeln('   compressed_size = ',rec.compressed_size);
   writeln('   uncompressed_size = ',rec.uncompressed_size);
   writeln('   disk_number_start = ',rec.disk_number_start);
   writeln('   internal_file_attributes = ',rec.internal_file_attributes);
   writeln('   external_file_attributes = ',rec.external_file_attributes);
   writeln('   relative_offset_local_header = ',rec.relative_offset_local_header);
***********)

end;


(* ---------------------------------------------------------- *)
procedure process_end_central_dir;
var
   n:             word;
   rec:           end_central_dir_record;
   comment:       string;

begin
   n := dos_read(zipfd,rec,sizeof(rec));
   get_string(rec.zipfile_comment_length,comment);

(*******
   writeln;
   writeln('end central dir');
   writeln('   zipfile comment = ',comment);
   writeln('   number_this_disk = ',rec.number_this_disk);
   writeln('   number_disk_with_start_central_directory = ',rec.number_disk_with_start_central_directory);
   writeln('   total_entries_central_dir_on_this_disk = ',rec.total_entries_central_dir_on_this_disk);
   writeln('   total_entries_central_dir = ',rec.total_entries_central_dir);
   writeln('   size_central_directory = ',rec.size_central_directory);
   writeln('   offset_start_central_directory = ',rec.offset_start_central_directory);
********)

end;

(* ---------------------------------------------------------- *)
procedure process_headers;
var
   sig:  longint;
   fail: integer;

begin
   fail := 0;

   while true do
   begin

      if dos_read(zipfd,sig,sizeof(sig)) <> sizeof(sig) then
         exit
      else

      if sig = local_file_header_signature then
         process_local_file_header
      else

      if sig = central_file_header_signature then
         process_central_file_header
      else

      if sig = end_central_dir_signature then
      begin
         process_end_central_dir;
         exit;
      end
      else

      begin
         inc(fail);
         if fail > 100 then
         begin
            writeln('Invalid Zipfile Header!');
            exit;
         end;
      end;
   end;
end;

(* ---------------------------------------------------------- *)
procedure listzip(name: dos_filename);
begin
   zipfd := dos_open(name,open_read);
   if zipfd = dos_error then
   begin
      writeln('Can''t open: ',name);
      exit;
   end;
   writeln;
   if (pos('?',zipfn)+pos('*',zipfn)) > 0 then
   begin
      writeln('Zipfile: '+name);
      writeln;
   end;
   writeln('  Size    Method   Zipped     Date      Time     Type     File Name');
   if (asciigraphics in urec.config) then
   writeln('──────── ──────── ────────  ────────  ────────  ──────  ─────────────')
   else
   writeln('-------- -------- --------  --------  --------  ------  -------------');
   process_headers;
   dos_close(zipfd);
end;

(* ---------------------------------------------------------- *)

procedure arcview (fname:lstr);
var f:file of byte;
    b:byte;
    sg:boolean;
    size:longint;
    n:integer;

function getsize:longint;
var x:longint;
    b:array [1..4] of byte absolute x;
    cnt:integer;
begin
 for cnt:=1 to 4 do read (f,b[cnt]);
 getsize:=x
end;

begin
 assign (f,fname);
 reset (f);
 iocode:=ioresult;
 if iocode<>0 then begin
  fileerror ('LISTARCHIVE',fname);
  exit;
 end;
 if (filesize(f)<32) then begin
  writeln (^M'That file isn''t an archive!');
  close (f);
  exit;
 end;
 writeln ('Filename        Size');
 if (asciigraphics in urec.config) then
 writeln ('────────────    ────') else
 writeln ('------------    ----');
 repeat
  read (f,b);
  if b<>26 then begin
   writeln (^M'That file isn''t an archive!');
   close (f);
   exit
  end;
  read (f,b);
  if b=0 then begin
   close (f);
   exit
  end;
  sg:=false;
  for n:=1 to 13 do begin
   read (f,b);
   if b=0 then sg:=true;
   if sg then b:=32;
   write (chr(b))
  end;
  size:=getsize;
  for n:=1 to 6 do read (f,b);
  writeln ('   ',getsize);
  seek (f,filepos(f)+size)
 until break or hungupon;
end;

procedure pakview (filename:lstr);
var f:file of byte;
begin
 if not exist (pak) then begin
  writeln (^M'Error: '+pak+' not found. Notify Sysop.'^M);
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+pak+' v '+filename+' >PAK.LST');
 printfile ('PAK.LST')
end;

procedure lharcview (filename:lstr);
var f:file of byte;
begin
 if not exist (lharc) then begin
  writeln (^M'Error: '+lharc+' not found. Notify Sysop.'^M);
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+lharc+' v '+filename+' >LHARC.LST');
 printfile ('LHARC.LST')
end;

procedure zipview (fn:lstr);
var f:file of byte;
    dirinfo:searchrec;
    dir,nam,ext:dos_filename;
begin
 assign (f,fn);
 reset (f);
 iocode:=ioresult;
 if iocode<>0 then begin
  fileerror ('LISTARCHIVE',fn);
  exit;
 end;
 if (filesize(f)<32) then begin
  writeln (^M'That file isn''t an archive!');
  close (f);
  exit;
 end;
 close (f);
 zipfn:=fn;
 if pos('.',zipfn)=0 then zipfn:=zipfn+'.ZIP';
 fsplit(zipfn,dir,nam,ext);
 findfirst(zipfn,$21,dirinfo);
 while (doserror=0) do
 begin
  listzip (dir+dirinfo.name);
  findnext (dirinfo);
 end;
end;

procedure extractzip (ffile,mainzip,todir:anystr);
var f:file of byte;
begin
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 if not exist (faqdir+'PKUNZIP.EXE') then begin
  writeln (^M'Error: PKUNZIP.EXE not found [supposed to be in '+faqdir+'].');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+faqdir+'PKUNZIP.EXE '+mainzip+' '+ffile+' '+todir+' >NUL');
end;

procedure extractarc (ffile,mainzip,todir:anystr);
var f1,f2,f3:anystr;
begin
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 f1:=faqdir+'PKUNPAK.EXE';
 f2:=faqdir+'PKXARC.EXE';
 f3:=faqdir+'PKXARC.COM';
 if ((not exist (f1)) and (not exist (f2)) and (not exist (f3))) then
 begin
  writeln (^M'Error: PKUNPAK.EXE, PKXARC.EXE, and PKXARC.COM not found!');
  writeln ('There are supposed to be in '+faqdir+'.');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 if exist (f1) then exec (GetEnv('COMSPEC'),'/C '+f1+' '+mainzip+' '+ffile+' '+todir) else
 if exist (f2) then exec (GetEnv('COMSPEC'),'/C '+f2+' '+mainzip+' '+ffile+' '+todir) else
 if exist (f3) then exec (GetEnv('COMSPEC'),'/C '+f3+' '+mainzip+' '+ffile+' '+todir);
end;

procedure extractpak (ffile,mainzip,todir:anystr);
begin
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 if not exist (pak) then begin
  writeln (^M'Error: '+pak+' not found!');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+pak+' '+mainzip+' '+ffile+' '+todir);
end;

procedure extractlzh (ffile,mainzip,todir:anystr);
var lh1,lh2:lstr;
begin
 lh1:=faqdir+'LHARC.EXE';
 lh2:=faqdir+'LHARC.COM';
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 if (not exist (lh1)) and (not exist (lh2)) then begin
  writeln (^M'Error: LHARC.EXE, and LHARC.COM not found!');
  writeln ('There are supposed to be in '+faqdir+'.');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 if exist (lh1) then exec (GetEnv('COMSPEC'),'/C '+lh1+' '+mainzip+' '+ffile+' '+todir) else
 if exist (lh2) then exec (GetEnv('COMSPEC'),'/C '+lh2+' '+mainzip+' '+ffile+' '+todir);
end;

procedure extract (ffile,mainzip,todir:anystr);
var t:sstr;
    x:integer;
begin
 x:=pos ('.',mainzip);
 t:=copy (mainzip,x+1,3);
 t:=upstring(t);
 if t='ZIP' then extractzip (ffile,mainzip,todir) else
 if t='ARC' then extractarc (ffile,mainzip,todir) else
 if t='PAK' then extractpak (ffile,mainzip,todir) else
 if t='LZH' then extractlzh (ffile,mainzip,todir);
end;

procedure addtozip (zipname,fn:anystr);
begin
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 if not exist (faqdir+'PKZIP.EXE') then begin
  writeln (^M'Error: PKZIP.EXE not found [supposed to be in '+faqdir+'].');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+faqdir+'PKZIP.EXE -ex '+zipname+' '+fn+' >NUL');
end;

procedure addcomment (path:anystr; filename:sstr);
var filename1:sstr;
begin
 if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
 filename1:=copy(filename,length(filename)-2,3);
 if not exist (faqdir+'COMMENT.BAT') then begin
  writeln (^M'Error: COMMENT.BAT not found [supposed to be in '+faqdir+'].');
  writeln ('Please notify Sysop!!');
  exit;
 end;
 exec (GetEnv('COMSPEC'),'/C '+faqdir+'COMMENT.BAT '+path+filename+' '+filename1);
end;

function getpath (dir:anystr):lstr;
  var q,r:integer;
      f:file;
      b,found:boolean;
      p,s:lstr;
      t:text;
  begin
    getpath:=dir;
    if ulvl<sysoplevel then exit;
    repeat
      found:=false;
      writestr ('Upload Path [CR/'+dir+']:');
      if hungupon then exit;
      if length(input)=0 then input:=dir;
      p:=input;
      if input[length(p)]<>'\' then p:=p+'\';
      b:=true;
      if exist (faqdir+'SECURITY.DIR') then begin
       assign (t,faqdir+'SECURITY.DIR');
       reset (t);
       repeat
        readln (t,s);
        if s[length(s)]<>'\' then s:=s+'\';
        if match(s,p) then begin
         found:=true;
         writeln;
         writeln (^G'That Directory is protected by the Sysop!');
         writeln;
        end;
       until eof(t) or (found);
       textclose (t);
       if found then exit;
      end;
      assign (f,p+'CON');
      reset (f);
      q:=ioresult;
      close (f);
      r:=ioresult;
      if q<>0 then begin
        writestr ('  Path doesn''t exist!  Create it [y/n]? *');
        b:=yes;
        if b then begin
          mkdir (copy(p,1,length(p)-1));
          q:=ioresult;
          b:=q=0;
          if b
            then writestr ('Directory created')
            else writestr ('Unable to create directory')
        end
      end
    until b;
    getpath:=p
  end;

  procedure getpathname (fname:lstr; var path:lstr; var name:sstr);
  var p:integer;
  begin
    path:='';
    repeat
      p:=pos('\',fname);
      if p<>0 then begin
        path:=path+copy(fname,1,p);
        fname:=copy(fname,p+1,255)
      end
    until p=0;
    name:=fname
  end;

  procedure writefreespace (path:lstr);

  function unsigned (i:integer):real;
  begin
    if i>=0
      then unsigned:=i
      else unsigned:=65536.0+i
  end;

  var drive:byte;
      r:registers;
      csize,free,total:real;
  begin
    r.ah:=$36;
    r.dl:=ord(upcase(path[1]))-64;
    intr ($21,r);
    if r.ax=-1 then begin
      writeln ('Invalid Drive!');
      exit
    end;
    csize:=unsigned(r.ax)*unsigned(r.cx);
    free:=csize*unsigned(r.bx);
    total:=csize*unsigned(r.dx);
    free:=free/1024;
    total:=total/1024;
    write (free:0:0,'k ');
    if free<125 then write ('(minimal!) ');
    writeln ('out of ',total:0:0,'k')
  end;

  function allowxfer:boolean;
  var cnt:baudratetype;
      k:char;
  begin
    allowxfer:=false;
    for cnt:=firstbaud to lastbaud do
      if baudrate=baudarray[cnt]
        then if not (cnt in downloadrates)
          then begin
            writeln ('Sorry, File Transfer is not allowed at ',baudrate,' Baud!');
            exit
          end;
    if parity then begin
      writeln ('Please select NO Parity (N,8,1) and hit [Return]:');
      parity:=false;
      setparam (usecom,baudrate,parity);
      repeat
        k:=getchar;
        if hungupon then exit
      until k in [#13,#141];
      if k=#141 then begin
        parity:=true;
        setparam (usecom,baudrate,parity);
        writeln ('You did not turn off parity.  Transfer aborted.');
        exit
      end
    end;
    allowxfer:=true
  end;

  procedure fileinfo (yiyiyi:integer);
  var i:integer;
      ud:udrec;
      okay:boolean;
      a,b,c:string;
  begin
   if nofiles then exit;
   i:=yiyiyi;
   if i<1 then begin
    i:=getfilenum ('get Info on');
    if i=0 then exit;
   end;
   seekudfile (i);
   read (udfile,ud);
   okay:=checkok (ud);
   if not okay then exit;
   writehdr ('Extended File Information');
    writeln (^R'    Filename: '^S,ud.filename);
    writeln (^R'        Size: '^S,ud.filesize);
    writeln (^R'      Points: '^S,ud.points);
    writeln (^R'Program Name: '^S,ud.programname,' '+strr(ud.disknum)+^R'/'^S+strr(ud.totaldisk));
    writeln (^R'   Times D/L: '^S,ud.downloaded);
    writeln (^R' Unrated/New: '^S,yesno(ud.newfile));
    writeln (^R' Special Ask: '^S,yesno(ud.specialfile));
    writeln (^R'     Sent by: '^S,ud.sentby);
    writeln (^R'     Sent on: '^S,datestr(ud.when));
    writeln (^R'     Sent at: '^S,timestr(ud.when));
    writeln (' Extended Desc: '^S);
    a:=copy (ud.extdesc,1,80);
    ansicolor (urec.statcolor);
    writeln (a);
    if length(ud.extdesc)>80 then begin
     b:=copy (ud.extdesc,81,80);
     ansicolor (urec.statcolor);
     writeln (b);
    end;
    if length(ud.extdesc)>160 then begin
     c:=copy (ud.extdesc,161,80);
     ansicolor (urec.statcolor);
     writeln (c);
    end;
  end;

begin
end.