home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / SUBS3.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-31  |  11KB  |  389 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit subs3;
  5.  
  6. interface
  7.  
  8. uses crt,dos,mdosio,
  9.      gentypes,configrt,modem,statret,gensubs,subs1,windows,subs2,textret,
  10.      mailret,userret,flags,mainr1,ansiedit,lineedit,chatstuf,
  11.      mainr2,overret1,protocol,mainmenu;
  12.  
  13. type
  14.    signature_type = longint;
  15. const
  16.    local_file_header_signature = $04034b50;
  17. type
  18.    local_file_header = record
  19.       version_needed_to_extract:    word;
  20.       general_purpose_bit_flag:     word;
  21.       compression_method:           word;
  22.       last_mod_file_time:           word;
  23.       last_mod_file_date:           word;
  24.       crc32:                        longint;
  25.       compressed_size:              longint;
  26.       uncompressed_size:            longint;
  27.       filename_length:              word;
  28.       extra_field_length:           word;
  29.    end;
  30. const
  31.    central_file_header_signature = $02014b50;
  32. type
  33.    central_directory_file_header = record
  34.       version_made_by:                 word;
  35.       version_needed_to_extract:       word;
  36.       general_purpose_bit_flag:        word;
  37.       compression_method:              word;
  38.       last_mod_file_time:              word;
  39.       last_mod_file_date:              word;
  40.       crc32:                           longint;
  41.       compressed_size:                 longint;
  42.       uncompressed_size:               longint;
  43.       filename_length:                 word;
  44.       extra_field_length:              word;
  45.       file_comment_length:             word;
  46.       disk_number_start:               word;
  47.       internal_file_attributes:        word;
  48.       external_file_attributes:        longint;
  49.       relative_offset_local_header:    longint;
  50.    end;
  51. const
  52.    end_central_dir_signature = $06054b50;
  53. type
  54.    end_central_dir_record = record
  55.       number_this_disk:                         word;
  56.       number_disk_with_start_central_directory: word;
  57.       total_entries_central_dir_on_this_disk:   word;
  58.       total_entries_central_dir:                word;
  59.       size_central_directory:                   longint;
  60.       offset_start_central_directory:           longint;
  61.       zipfile_comment_length:                   word;
  62.    end;
  63. const
  64.    compression_methods: array[0..6] of string[8]=
  65.       (' Stored ',' Shrunk ','Reduce-1','Reduce-2','Reduce-3','Reduce-4','?');
  66. var
  67.    zipfd:   dos_handle;
  68.    zipfn:   dos_filename;
  69. type
  70.    string8 = string[8];
  71.  
  72. procedure get_string (len:word; var s:string);
  73. procedure itoa2 (i:integer; var sp);
  74. function format_date (date:word):string8;
  75. function format_time (time:word):string8;
  76. procedure process_local_file_header;
  77. procedure process_central_file_header;
  78. procedure process_end_central_dir;
  79. procedure process_headers;
  80. procedure list_zip (name:dos_filename);
  81. procedure arcview (fname:lstr);
  82. procedure pakview (filename:lstr);
  83. procedure zipview (fn:lstr);
  84.  
  85. implementation
  86.  
  87. (* ---------------------------------------------------------- *)
  88. procedure get_string(len: word; var s: string);
  89. var
  90.    n: word;
  91. begin
  92.    if len > 255 then
  93.       len := 255;
  94.    n := dos_read(zipfd,s[1],len);
  95.    s[0] := chr(len);
  96. end;
  97.  
  98. (* ---------------------------------------------------------- *)
  99. procedure itoa2(i: integer; var sp);
  100. var
  101.    s: array[1..2] of char absolute sp;
  102. begin
  103.    s[1] := chr( (i div 10) + ord('0'));
  104.    s[2] := chr( (i mod 10) + ord('0'));
  105. end;
  106.  
  107. function format_date(date: word): string8;
  108. const
  109.    s:       string8 = 'mm-dd-yy';
  110. begin
  111.    itoa2(((date shr 9) and 127)+80, s[7]);
  112.    itoa2( (date shr 5) and 15,  s[1]);
  113.    itoa2( (date      ) and 31,  s[4]);
  114.    format_date := s;
  115. end;
  116.  
  117. function format_time(time: word): string8;
  118. const
  119.    s:       string8 = 'hh:mm:ss';
  120. begin
  121.    itoa2( (time shr 11) and 31, s[1]);
  122.    itoa2( (time shr  5) and 63, s[4]);
  123.    itoa2( (time shl  1) and 63, s[7]);
  124.    format_time := s;
  125. end;
  126.  
  127. (* ---------------------------------------------------------- *)
  128. procedure process_local_file_header;
  129. var
  130.    n:             word;
  131.    rec:           local_file_header;
  132.    filename:      string;
  133.    extra:         string;
  134.  
  135. begin
  136.    n := dos_read(zipfd,rec,sizeof(rec));
  137.    get_string(rec.filename_length,filename);
  138.    get_string(rec.extra_field_length,extra);
  139.    dos_lseek(zipfd,rec.compressed_size,seek_cur);
  140. end;
  141.  
  142. (* ---------------------------------------------------------- *)
  143. procedure process_central_file_header;
  144. var
  145.    n:             word;
  146.    rec:           central_directory_file_header;
  147.    filename:      string;
  148.    extra:         string;
  149.    comment:       string;
  150.  
  151. begin
  152.    n := dos_read(zipfd,rec,sizeof(rec));
  153.    get_string(rec.filename_length,filename);
  154.    get_string(rec.extra_field_length,extra);
  155.    get_string(rec.file_comment_length,comment);
  156.  
  157.    write(rec.uncompressed_size:7,'  ',
  158.            compression_methods[rec.compression_method]:8,' ',
  159.            rec.compressed_size:7,'   ',
  160.            format_date(rec.last_mod_file_date),'  ',
  161.            format_time(rec.last_mod_file_time));
  162.  
  163.    if (rec.internal_file_attributes and 1) <> 0 then
  164.       write('   Ascii  ')
  165.    else
  166.       write('  Binary  ');
  167.  
  168.    writeln(filename);
  169.  
  170. (**************
  171.    writeln;
  172.    writeln('central file header');
  173.    writeln('   filename = ',filename);
  174.    writeln('   extra = ',extra);
  175.    writeln('   file comment = ',comment);
  176.    writeln('   version_made_by = ',rec.version_made_by);
  177.    writeln('   version_needed_to_extract = ',rec.version_needed_to_extract);
  178.    writeln('   general_purpose_bit_flag = ',rec.general_purpose_bit_flag);
  179.    writeln('   compression_method = ',rec.compression_method);
  180.    writeln('   last_mod_file_time = ',rec.last_mod_file_time);
  181.    writeln('   last_mod_file_date = ',rec.last_mod_file_date);
  182.    writeln('   crc32 = ',rec.crc32);
  183.    writeln('   compressed_size = ',rec.compressed_size);
  184.    writeln('   uncompressed_size = ',rec.uncompressed_size);
  185.    writeln('   disk_number_start = ',rec.disk_number_start);
  186.    writeln('   internal_file_attributes = ',rec.internal_file_attributes);
  187.    writeln('   external_file_attributes = ',rec.external_file_attributes);
  188.    writeln('   relative_offset_local_header = ',rec.relative_offset_local_header);
  189. ***********)
  190.  
  191. end;
  192.  
  193.  
  194. (* ---------------------------------------------------------- *)
  195. procedure process_end_central_dir;
  196. var
  197.    n:             word;
  198.    rec:           end_central_dir_record;
  199.    comment:       string;
  200.  
  201. begin
  202.    n := dos_read(zipfd,rec,sizeof(rec));
  203.    get_string(rec.zipfile_comment_length,comment);
  204.  
  205. (*******
  206.    writeln;
  207.    writeln('end central dir');
  208.    writeln('   zipfile comment = ',comment);
  209.    writeln('   number_this_disk = ',rec.number_this_disk);
  210.    writeln('   number_disk_with_start_central_directory = ',rec.number_disk_with_start_central_directory);
  211.    writeln('   total_entries_central_dir_on_this_disk = ',rec.total_entries_central_dir_on_this_disk);
  212.    writeln('   total_entries_central_dir = ',rec.total_entries_central_dir);
  213.    writeln('   size_central_directory = ',rec.size_central_directory);
  214.    writeln('   offset_start_central_directory = ',rec.offset_start_central_directory);
  215. ********)
  216.  
  217. end;
  218.  
  219. (* ---------------------------------------------------------- *)
  220. procedure process_headers;
  221. var
  222.    sig:  longint;
  223.    fail: integer;
  224.  
  225. begin
  226.    fail := 0;
  227.  
  228.    while true do
  229.    begin
  230.  
  231.       if dos_read(zipfd,sig,sizeof(sig)) <> sizeof(sig) then
  232.          exit
  233.       else
  234.  
  235.       if sig = local_file_header_signature then
  236.          process_local_file_header
  237.       else
  238.  
  239.       if sig = central_file_header_signature then
  240.          process_central_file_header
  241.       else
  242.  
  243.       if sig = end_central_dir_signature then
  244.       begin
  245.          process_end_central_dir;
  246.          exit;
  247.       end
  248.       else
  249.  
  250.       begin
  251.          inc(fail);
  252.          if fail > 100 then
  253.          begin
  254.             writeln('Invalid Zipfile Header!');
  255.             exit;
  256.          end;
  257.       end;
  258.    end;
  259. end;
  260.  
  261. (* ---------------------------------------------------------- *)
  262. procedure list_zip(name: dos_filename);
  263. begin
  264.    zipfd := dos_open(name,open_read);
  265.    if zipfd = dos_error then
  266.    begin
  267.       writeln('Can''t open: ',name);
  268.       exit;
  269.    end;
  270.    writeln;
  271.    if (pos('?',zipfn)+pos('*',zipfn)) > 0 then
  272.    begin
  273.       writeln('Zipfile: '+name);
  274.       writeln;
  275.    end;
  276.    writeln('  Size    Method   Zipped     Date      Time     Type     File Name');
  277.    if (asciigraphics in urec.config) then
  278.    writeln('──────── ──────── ────────  ────────  ────────  ──────  ─────────────')
  279.    else
  280.    writeln('-------- -------- --------  --------  --------  ------  -------------');
  281.    process_headers;
  282.    dos_close(zipfd);
  283. end;
  284.  
  285.  
  286. (* ---------------------------------------------------------- *)
  287.  
  288. procedure arcview (fname:lstr);
  289. var f:file of byte;
  290.     b:byte;
  291.     sg:boolean;
  292.     size:longint;
  293.     n:integer;
  294.  
  295. function getsize:longint;
  296. var x:longint;
  297.     b:array [1..4] of byte absolute x;
  298.     cnt:integer;
  299. begin
  300.  for cnt:=1 to 4 do read (f,b[cnt]);
  301.  getsize:=x
  302. end;
  303.  
  304. begin
  305.  assign (f,fname);
  306.  reset (f);
  307.  iocode:=ioresult;
  308.  if iocode<>0 then begin
  309.   fileerror ('LISTARCHIVE',fname);
  310.   exit;
  311.  end;
  312.  if (filesize(f)<32) then begin
  313.   writeln (^M'That file isn''t an archive!');
  314.   close (f);
  315.   exit;
  316.  end;
  317.  writeln ('Filename.Ext    Size');
  318.  if (asciigraphics in urec.config) then
  319.  writeln ('────────────    ────') else
  320.  writeln ('------------    ----');
  321.  repeat
  322.   read (f,b);
  323.   if b<>26 then begin
  324.    writeln (^M'That file isn''t an archive!');
  325.    close (f);
  326.    exit
  327.   end;
  328.   read (f,b);
  329.   if b=0 then begin
  330.    close (f);
  331.    exit
  332.   end;
  333.   sg:=false;
  334.   for n:=1 to 13 do begin
  335.    read (f,b);
  336.    if b=0 then sg:=true;
  337.    if sg then b:=32;
  338.    write (chr(b))
  339.   end;
  340.   size:=getsize;
  341.   for n:=1 to 6 do read (f,b);
  342.   writeln ('   ',getsize);
  343.   seek (f,filepos(f)+size)
  344.  until break or hungupon;
  345. end;
  346.  
  347. procedure pakview (filename:lstr);
  348. var f:file of byte;
  349. begin
  350.  if not exist (pak) then begin
  351.   writeln (^M'Error: '+pak+' not found. Notify Sysop.'^M);
  352.   exit;
  353.  end;
  354.  exec (commandcom,'/C '+pak+' v '+filename+' >PAK.LST');
  355.  printfile ('PAK.LST')
  356. end;
  357.  
  358. procedure zipview (fn:lstr);
  359. var f:file of byte;
  360.     dirinfo:searchrec;
  361.     dir,nam,ext:dos_filename;
  362. begin
  363.  assign (f,fn);
  364.  reset (f);
  365.  iocode:=ioresult;
  366.  if iocode<>0 then begin
  367.   fileerror ('LISTARCHIVE',fn);
  368.   exit;
  369.  end;
  370.  if (filesize(f)<32) then begin
  371.   writeln (^M'That file isn''t an archive!');
  372.   close (f);
  373.   exit;
  374.  end;
  375.  close (f);
  376.  zipfn:=fn;
  377.  if pos('.',zipfn) = 0 then zipfn:=zipfn+'.Zip';
  378.  fsplit(zipfn,dir,nam,ext);
  379.  findfirst(zipfn,$21,dirinfo);
  380.  while (doserror=0) do
  381.  begin
  382.   list_zip (dir+dirinfo.name);
  383.   findnext (dirinfo);
  384.  end;
  385. end;
  386.  
  387. begin
  388. end.
  389.