home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / COMPRESS / ZIPDS12.ZIP / ZIPDS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-03  |  7.2 KB  |  289 lines
  1.  
  2. (*
  3.  * (C) 1989 Samuel H. Smith, 15-feb-89
  4.  *
  5.  * This program is provided courtesy of:
  6.  *         The Tool Shop
  7.  *         Samuel H. Smith
  8.  *         P. O. Box 4808
  9.  *         Panorama City, CA 91412-4808
  10.  *         (818) 891-6780
  11.  *
  12.  * Disclaimer
  13.  * ----------
  14.  *
  15.  * If you modify this program, I would appreciate a copy of the new 
  16.  * source code.   Please don't delete my name from the program.
  17.  *
  18.  * I cannot be responsible for any damages resulting from the use or mis-
  19.  * use of this program!
  20.  *
  21.  * If you have any questions, bugs, or suggestions, please contact me at
  22.  * The Tool Shop,  (818) 891-6780
  23.  *
  24.  * Enjoy!     Samuel H. Smith
  25.  *
  26.  *)
  27.  
  28.  
  29. {$r-,s-}            (* enable range checking *)
  30. {$v-}               (* allow variable length string params *)
  31. {$D+,L+}
  32.  
  33. uses
  34.    Dos,Tools,MDosIO;
  35.  
  36. const
  37.    whoami   = 'ZIPDS: Zipfile Date Stamper  v1.2 01-03-91;  (C) 1991 S.H.Smith';
  38.  
  39. type
  40.    signature_type = longint;
  41.  
  42. const
  43.    local_file_header_signature = $04034b50;
  44.  
  45. type
  46.    local_file_header = record
  47.       version_needed_to_extract:    word;
  48.       general_purpose_bit_flag:     word;
  49.       compression_method:           word;
  50.       last_mod_file_time:           word;
  51.       last_mod_file_date:           word;
  52.       crc32:                        longint;
  53.       compressed_size:              longint;
  54.       uncompressed_size:            longint;
  55.       filename_length:              word;
  56.       extra_field_length:           word;
  57.    end;
  58.  
  59. const
  60.    central_file_header_signature = $02014b50;
  61.  
  62. type
  63.    central_directory_file_header = record
  64.       version_made_by:                 word;
  65.       version_needed_to_extract:       word;
  66.       general_purpose_bit_flag:        word;
  67.       compression_method:              word;
  68.       last_mod_file_time:              word;
  69.       last_mod_file_date:              word;
  70.       crc32:                           longint;
  71.       compressed_size:                 longint;
  72.       uncompressed_size:               longint;
  73.       filename_length:                 word;
  74.       extra_field_length:              word;
  75.       file_comment_length:             word;
  76.       disk_number_start:               word;
  77.       internal_file_attributes:        word;
  78.       external_file_attributes:        longint;
  79.       relative_offset_local_header:    longint;
  80.    end;
  81.  
  82. const
  83.    end_central_dir_signature = $06054b50;
  84.  
  85. type
  86.    end_central_dir_record = record
  87.       number_this_disk:                         word;
  88.       number_disk_with_start_central_directory: word;
  89.       total_entries_central_dir_on_this_disk:   word;
  90.       total_entries_central_dir:                word;
  91.       size_central_directory:                   longint;
  92.       offset_start_central_directory:           longint;
  93.       zipfile_comment_length:                   word;
  94.    end;
  95.  
  96. var
  97.    zipfd:      dos_handle;
  98.    zipfn:      dos_filename;
  99.    newdate:    word;
  100.    newtime:    word;
  101.    err:        integer;
  102.  
  103.  
  104. (* ---------------------------------------------------------- *)
  105. procedure get_string(len: word; var s: string);
  106. var
  107.    n: word;
  108. begin
  109.    if len > 255 then
  110.       len := 255;
  111.    n := dos_read(zipfd,s[1],len);
  112.    s[0] := chr(len);
  113. end;
  114.  
  115.  
  116. (* ---------------------------------------------------------- *)
  117. procedure process_local_file_header;
  118. var
  119.    n:             word;
  120.    rec:           local_file_header;
  121.    filename:      string;
  122.    extra:         string;
  123.  
  124. begin
  125.    n := dos_read(zipfd,rec,sizeof(rec));
  126.    get_string(rec.filename_length,filename);
  127.    get_string(rec.extra_field_length,extra);
  128.    dos_lseek(zipfd,rec.compressed_size,seek_cur);
  129.  
  130.    (* track newest member *)
  131.    if dos_jdate(rec.last_mod_file_time, rec.last_mod_file_date) >
  132.       dos_jdate(newtime,newdate) then
  133.    begin
  134.       newdate := rec.last_mod_file_date;
  135.       newtime := rec.last_mod_file_time;
  136.    end;
  137.  
  138. end;
  139.  
  140.  
  141. (* ---------------------------------------------------------- *)
  142. procedure process_central_file_header;
  143. var
  144.    n:             word;
  145.    rec:           central_directory_file_header;
  146.    filename:      string;
  147.    extra:         string;
  148.    comment:       string;
  149.  
  150. begin
  151.    n := dos_read(zipfd,rec,sizeof(rec));
  152.    get_string(rec.filename_length,filename);
  153.    get_string(rec.extra_field_length,extra);
  154.    get_string(rec.file_comment_length,comment);
  155. end;
  156.  
  157.  
  158. (* ---------------------------------------------------------- *)
  159. procedure process_end_central_dir;
  160. var
  161.    n:             word;
  162.    rec:           end_central_dir_record;
  163.    comment:       string;
  164.  
  165. begin
  166.    n := dos_read(zipfd,rec,sizeof(rec));
  167.    get_string(rec.zipfile_comment_length,comment);
  168. end;
  169.  
  170.  
  171. (* ---------------------------------------------------------- *)
  172. procedure process_headers(name: dos_filename);
  173. var
  174.    sig:  longint;
  175.  
  176. begin
  177.    newdate := 0;
  178.    newtime := 0;
  179.  
  180.    while true do
  181.    begin
  182.  
  183.       if dos_read(zipfd,sig,sizeof(sig)) <> sizeof(sig) then
  184.       begin
  185.          write('has errors!  Truncated!  '^G);
  186.          inc(err);
  187.          exit;
  188.       end
  189.       else
  190.  
  191.       if sig = local_file_header_signature then
  192.          process_local_file_header
  193.       else
  194.  
  195.       if sig = central_file_header_signature then
  196.       begin
  197.          process_central_file_header;
  198.          write('Okay.  ');
  199.          exit;
  200.       end
  201.       else
  202.  
  203.       if sig = end_central_dir_signature then
  204.       begin
  205.          process_end_central_dir;
  206.          write('Okay..  ');
  207.          exit;
  208.       end
  209.       else
  210.  
  211.       begin
  212.          write('has errors!  Bad header!  sig='^g,sig);
  213.          inc(err);
  214.          exit;
  215.       end;
  216.    end;
  217. end;
  218.  
  219.  
  220. (* ---------------------------------------------------------- *)
  221. procedure process_zip(dir,name: dos_filename);
  222. var
  223.    time,date:  word;
  224. begin
  225.    write(dir,name,' ');
  226.    zipfd := dos_open(dir+name,open_update);
  227.    if zipfd = dos_error then
  228.    begin
  229.       writeln(' Can''t open!');
  230.       exit;
  231.    end;
  232.  
  233.    process_headers(dir+name);
  234.  
  235.    dos_file_times(zipfd,time_get,time,date);
  236.    if dos_jdate(time,date) <> dos_jdate(newtime,newdate) then
  237.    if (newdate <> 0) and (newtime <> 0) then
  238.    begin
  239.       write('Stamping date.');
  240.       dos_file_times(zipfd,time_set,newtime,newdate);
  241.    end;
  242.  
  243.    dos_close(zipfd);
  244.    writeln;
  245. end;
  246.  
  247.  
  248. (* ---------------------------------------------------------- *)
  249. var
  250.    DirInfo:       SearchRec;
  251.    Dir,Nam,Ext:   dos_filename;
  252.  
  253. begin
  254.    writeln;
  255.    writeln(whoami);
  256.    writeln;
  257.  
  258.    if paramcount = 0 then
  259.    begin
  260.       writeln('Courtesy of:  S.H.Smith  and  The Tool Shop BBS,  (818) 891-6780.');
  261.       writeln;
  262.       writeln('Usage:  ZipDS *.zip [>OUT]');
  263.       writeln;
  264.       writeln('Sets non-0 errorlevel on truncated zipfiles.');
  265.       writeln('Stamps all zipfiles with date of newest member file.');
  266.       writeln('Also produces the proper error message for use with PROUTEST.');
  267.       writeln;
  268.       halt(99);
  269.    end;
  270.  
  271.    err := 0;
  272.  
  273.    zipfn := paramstr(1);
  274.    if pos('.',zipfn) = 0 then
  275.       zipfn := zipfn + '.zip';
  276.  
  277.    FSplit(zipfn,Dir,Nam,Ext);
  278.    FindFirst(zipfn,$21,DirInfo);
  279.    while (DosError = 0) do
  280.    begin
  281.       process_zip(Dir,DirInfo.name);
  282.       FindNext(DirInfo);
  283.    end;
  284.  
  285.    writeln(err,' errors detected.');;
  286.    halt(err);
  287. end.
  288.  
  289.