home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ZIPV11.ZIP / ZIPV.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  8.4 KB  |  314 lines
  1.  
  2. (*
  3.  * file formats for archives created by pkzip
  4.  * s.smith, 2-2-89
  5.  *
  6.  *)
  7.  
  8. {$m 6000,0,0}
  9. {$s-,r-}
  10. {$d+,l+}
  11. {$v-}
  12.  
  13. uses MdosIO, DOS;
  14.  
  15. const
  16.    version = 'ZipV 1.1  -  Verbose ZIP directory listing  -  S.H.Smith, 2-17-89';
  17.  
  18. type
  19.    signature_type = longint;
  20.  
  21. const
  22.    local_file_header_signature = $04034b50;
  23.  
  24. type
  25.    local_file_header = record
  26.       version_needed_to_extract:    word;
  27.       general_purpose_bit_flag:     word;
  28.       compression_method:           word;
  29.       last_mod_file_time:           word;
  30.       last_mod_file_date:           word;
  31.       crc32:                        longint;
  32.       compressed_size:              longint;
  33.       uncompressed_size:            longint;
  34.       filename_length:              word;
  35.       extra_field_length:           word;
  36.    end;
  37.  
  38. const
  39.    central_file_header_signature = $02014b50;
  40.  
  41. type
  42.    central_directory_file_header = record
  43.       version_made_by:                 word;
  44.       version_needed_to_extract:       word;
  45.       general_purpose_bit_flag:        word;
  46.       compression_method:              word;
  47.       last_mod_file_time:              word;
  48.       last_mod_file_date:              word;
  49.       crc32:                           longint;
  50.       compressed_size:                 longint;
  51.       uncompressed_size:               longint;
  52.       filename_length:                 word;
  53.       extra_field_length:              word;
  54.       file_comment_length:             word;
  55.       disk_number_start:               word;
  56.       internal_file_attributes:        word;
  57.       external_file_attributes:        longint;
  58.       relative_offset_local_header:    longint;
  59.    end;
  60.  
  61. const
  62.    end_central_dir_signature = $06054b50;
  63.  
  64. type
  65.    end_central_dir_record = record
  66.       number_this_disk:                         word;
  67.       number_disk_with_start_central_directory: word;
  68.       total_entries_central_dir_on_this_disk:   word;
  69.       total_entries_central_dir:                word;
  70.       size_central_directory:                   longint;
  71.       offset_start_central_directory:           longint;
  72.       zipfile_comment_length:                   word;
  73.    end;
  74.  
  75. const
  76.    compression_methods: array[0..6] of string[8] =
  77.       (' Stored ', ' Shrunk ',
  78.        'Reduce-1', 'Reduce-2', 'Reduce-3', 'Reduce-4', '?');
  79.  
  80. var
  81.    zipfd:   dos_handle;
  82.    zipfn:   dos_filename;
  83.  
  84.  
  85. type
  86.    string8 = string[8];
  87.  
  88.  
  89.  
  90. (* ---------------------------------------------------------- *)
  91. procedure get_string(len: word; var s: string);
  92. var
  93.    n: word;
  94. begin
  95.    if len > 255 then
  96.       len := 255;
  97.    n := dos_read(zipfd,s[1],len);
  98.    s[0] := chr(len);
  99. end;
  100.  
  101.  
  102. (* ---------------------------------------------------------- *)
  103. procedure itoa2(i: integer; var sp);
  104. var
  105.    s: array[1..2] of char absolute sp;
  106. begin
  107.    s[1] := chr( (i div 10) + ord('0'));
  108.    s[2] := chr( (i mod 10) + ord('0'));
  109. end;
  110.  
  111. function format_date(date: word): string8;
  112. const
  113.    s:       string8 = 'mm-dd-yy';
  114. begin
  115.    itoa2(((date shr 9) and 127)+80, s[7]);
  116.    itoa2( (date shr 5) and 15,  s[1]);
  117.    itoa2( (date      ) and 31,  s[4]);
  118.    format_date := s;
  119. end;
  120.  
  121. function format_time(time: word): string8;
  122. const
  123.    s:       string8 = 'hh:mm:ss';
  124. begin
  125.    itoa2( (time shr 11) and 31, s[1]);
  126.    itoa2( (time shr  5) and 63, s[4]);
  127.    itoa2( (time shl  1) and 63, s[7]);
  128.    format_time := s;
  129. end;
  130.  
  131.  
  132. (* ---------------------------------------------------------- *)
  133. procedure process_local_file_header;
  134. var
  135.    n:             word;
  136.    rec:           local_file_header;
  137.    filename:      string;
  138.    extra:         string;
  139.  
  140. begin
  141.    n := dos_read(zipfd,rec,sizeof(rec));
  142.    get_string(rec.filename_length,filename);
  143.    get_string(rec.extra_field_length,extra);
  144.  
  145.    writeln(rec.uncompressed_size:7,'  ',
  146.            compression_methods[rec.compression_method]:8,' ',
  147.            rec.compressed_size:7,'   ',
  148.            format_date(rec.last_mod_file_date),'  ',
  149.            format_time(rec.last_mod_file_time),'   ',
  150.            filename);
  151.  
  152.    dos_lseek(zipfd,rec.compressed_size,seek_cur);
  153. end;
  154.  
  155.  
  156. (* ---------------------------------------------------------- *)
  157. procedure process_central_file_header;
  158. var
  159.    n:             word;
  160.    rec:           central_directory_file_header;
  161.    filename:      string;
  162.    extra:         string;
  163.    comment:       string;
  164.  
  165. begin
  166.    n := dos_read(zipfd,rec,sizeof(rec));
  167.    get_string(rec.filename_length,filename);
  168.    get_string(rec.extra_field_length,extra);
  169.    get_string(rec.file_comment_length,comment);
  170.  
  171. (**************
  172.    writeln;
  173.    writeln('central file header');
  174.    writeln('   filename = ',filename);
  175.    writeln('   extra = ',extra);
  176.    writeln('   file comment = ',comment);
  177.    writeln('   version_made_by = ',rec.version_made_by);
  178.    writeln('   version_needed_to_extract = ',rec.version_needed_to_extract);
  179.    writeln('   general_purpose_bit_flag = ',rec.general_purpose_bit_flag);
  180.    writeln('   compression_method = ',rec.compression_method);
  181.    writeln('   last_mod_file_time = ',rec.last_mod_file_time);
  182.    writeln('   last_mod_file_date = ',rec.last_mod_file_date);
  183.    writeln('   crc32 = ',rec.crc32);
  184.    writeln('   compressed_size = ',rec.compressed_size);
  185.    writeln('   uncompressed_size = ',rec.uncompressed_size);
  186.    writeln('   disk_number_start = ',rec.disk_number_start);
  187.    writeln('   internal_file_attributes = ',rec.internal_file_attributes);
  188.    writeln('   external_file_attributes = ',rec.external_file_attributes);
  189.    writeln('   relative_offset_local_header = ',rec.relative_offset_local_header);
  190. ***********)
  191.  
  192.    dos_lseek(zipfd,rec.compressed_size,seek_cur);
  193. end;
  194.  
  195.  
  196. (* ---------------------------------------------------------- *)
  197. procedure process_end_central_dir;
  198. var
  199.    n:             word;
  200.    rec:           end_central_dir_record;
  201.    comment:       string;
  202.  
  203. begin
  204.    n := dos_read(zipfd,rec,sizeof(rec));
  205.    get_string(rec.zipfile_comment_length,comment);
  206.  
  207. (*******
  208.    writeln;
  209.    writeln('end central dir');
  210.    writeln('   zipfile comment = ',comment);
  211.    writeln('   number_this_disk = ',rec.number_this_disk);
  212.    writeln('   number_disk_with_start_central_directory = ',rec.number_disk_with_start_central_directory);
  213.    writeln('   total_entries_central_dir_on_this_disk = ',rec.total_entries_central_dir_on_this_disk);
  214.    writeln('   total_entries_central_dir = ',rec.total_entries_central_dir);
  215.    writeln('   size_central_directory = ',rec.size_central_directory);
  216.    writeln('   offset_start_central_directory = ',rec.offset_start_central_directory);
  217. ********)
  218.  
  219. end;
  220.  
  221.  
  222. (* ---------------------------------------------------------- *)
  223. procedure process_headers;
  224. var
  225.    sig:  longint;
  226.    fail: integer;
  227.  
  228. begin
  229.    fail := 0;
  230.  
  231.    while true do
  232.    begin
  233.  
  234.       if dos_read(zipfd,sig,sizeof(sig)) <> sizeof(sig) then
  235.          exit
  236.       else
  237.  
  238.       if sig = local_file_header_signature then
  239.          process_local_file_header
  240.       else
  241.  
  242.       if sig = central_file_header_signature then
  243.          process_central_file_header
  244.       else
  245.  
  246.       if sig = end_central_dir_signature then
  247.          process_end_central_dir
  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. (* ---------------------------------------------------------- *)
  263. procedure list_zip(name: dos_filename);
  264. begin
  265.    zipfd := dos_open(name,open_read);
  266.    if zipfd = dos_error then
  267.    begin
  268.       writeln('Can''t open: ',name);
  269.       halt(1);
  270.    end;
  271.  
  272.    writeln;
  273.    if (pos('?',zipfn)+pos('*',zipfn)) > 0 then
  274.    begin
  275.       writeln('Zipfile: '+name);
  276.       writeln;
  277.    end;
  278.    writeln('  Size    Method   Zipped     Date      Time      File Name');
  279.    writeln('-------- -------- --------  --------  --------  -------------');
  280.  
  281.    process_headers;
  282.  
  283.    dos_close(zipfd);
  284. end;
  285.  
  286.  
  287. (* ---------------------------------------------------------- *)
  288. var
  289.    DirInfo:       SearchRec;
  290.    Dir,Nam,Ext:   dos_filename;
  291.  
  292. begin
  293.    if paramcount <> 1 then
  294.    begin
  295.       writeln(version);
  296.       writeln('Usage: ZipV [directory\]zipfile[.zip]');
  297.       halt(1);
  298.    end;
  299.  
  300.    zipfn := paramstr(1);
  301.    if pos('.',zipfn) = 0 then
  302.       zipfn := zipfn + '.zip';
  303.  
  304.    FSplit(zipfn,Dir,Nam,Ext);
  305.    FindFirst(zipfn,$21,DirInfo);
  306.    while (DosError = 0) do
  307.    begin
  308.       list_zip(Dir+DirInfo.name);
  309.       FindNext(DirInfo);
  310.    end;
  311.    halt(0);
  312. end.
  313.  
  314.