home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / ktools / source / ofzip.pas < prev    next >
Pascal/Delphi Source File  |  1994-09-17  |  8KB  |  291 lines
  1. Unit OFZip;
  2. { lecture du contenu d'un fichier ZIP }
  3. { Kostrzewa Bruno }
  4. { juin 1994 }
  5.  
  6. INTERFACE
  7.  
  8. Uses Dos,
  9.      OBinFile,
  10.      OTableau;
  11.  
  12. Const
  13.  
  14.  EndDirSign=$06054B50 ;  { fin du répertoire des fichiers }
  15.  FileDirSign=$02014B50 ; { entête des fichiers dans le répertoire }
  16.  
  17.  tab_method:Array[0..6] of string[8] =
  18.   ('Stored','Shrunk','Reduc.1','Reduc.2','Reduc.3','Reduc.4','Imploded');
  19.  mois:Array[1..12] of string[3] =
  20.   ('Jan','Fev','Mar','Avr','Mai','Jun','Jul','Aou','Sep','Oct','Nov','Dec');
  21.  
  22.  erFile   = $100;
  23.  erNotZip = $101;
  24.  erDisks  = $102;
  25.  erFatale = $103;
  26.  
  27. Type
  28.  TEndDirDesc=record
  29.   sign        :longint;    { signature fin rép }
  30.   nmr_disk    :word;       { numéro du disque }
  31.   nmr_disk_dir:word;       { disque contenant début rép }
  32.   nb_file_disk:word;       { nbre de fichier sur ce disque }
  33.   total_file  :word;       { nbre total de fichiers dans rép }
  34.   size_dir    :longint;    { taille du rép }
  35.   start_dir   :longint;    { offset début rép sur son disque }
  36.   comment_len :word;       { longueur du commentaire }
  37.   end;
  38.  
  39.  TFileDirDesc=record
  40.   sign        :longint;    { signature entête des fichiers }
  41.   version     :word;       { version du logiciel de compression }
  42.   version_extract:word;    { version pour extraire le fichier }
  43.   bit_flag    :word;       { drapeaux }
  44.   method      :word;       { méthode de compression }
  45.   time_date   :longint;    { date et heure de modification }
  46.   crc_32      :longint;    { cyclic redundancy check 32 bits du fichier }
  47.   comp_size   :longint;    { taille fichier compressé }
  48.   uncomp_size :longint;    { taille fichier décompressé }
  49.   filenamelen :word;       { longueur du nom de fichier }
  50.   extrafieldlen:word;      { longueur extra_field }
  51.   filecomlen  :word;       { longueur du commentaire du fichier }
  52.   disk_nmr    :word;       { numéro du disque contenant le fichier }
  53.   int_attr    :word;       { attribut fichier interne }
  54.   ext_attr    :longint;    { attribut fichier externe }
  55.   start_header:longint;    { offset début entête du fichier sur son disque }
  56.   end;
  57.  
  58.  PString=^String;
  59.  
  60.  PFileZipDatas=^TFileZipDatas;
  61.  TFileZipDatas=record
  62.   FileDir:TFileDirDesc;
  63.   FName:PString;
  64.   FComment:PString;
  65.   End;
  66.  
  67.  PZipTab=^TZipTab;
  68.  TZipTab=object(TTabPtr)
  69.   TailleDecomp:Real;
  70.   Constructor Init(NomFichier:PathStr);
  71.   Function  GetErrorMsg:String; virtual;
  72.   Procedure Effacer(P: Pointer); virtual;
  73.   Function GetRec(n:Integer):PFileZipDatas;
  74.   end;
  75.  
  76. { fonctions utilitaires }
  77. Function Longueur(R:TFileZipDatas):String;
  78. Function Methode(R:TFileZipDatas):String;
  79. Function Taille(R:TFileZipDatas):String;
  80. Function Ratio(R:TFileZipDatas):String;
  81. Function ZDate(R:TFileZipDatas):String;
  82. Function ZHeure(R:TFileZipDatas):String;
  83. Function CRC32(R:TFileZipDatas):String;
  84. Function ZNom(R:TFileZipDatas):String;
  85.  
  86. IMPLEMENTATION
  87.  
  88. Function hexa(nbr:longint;long:integer):string;
  89. { conversion d'un nombre en hexadécimal }
  90. Const hexa_tab:array[0..15] of char =
  91.   ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  92. Var i:byte;
  93. Begin
  94.  if long=0 then long:=trunc(ln(nbr)/ln(16))+1;
  95.  hexa[0]:=char(long);
  96.  for i:=0 to long-1 do
  97.   hexa[long-i]:=hexa_tab[(nbr shr (4*i)) and $000F];
  98. End;
  99.  
  100. Function deci(nbr:longint;long:byte;with0:boolean):string;
  101. { écriture d'un entier sur long chiffres }
  102. Var i:byte;
  103.     d:string;
  104. Begin
  105.  if long=0 then long:=trunc(ln(nbr)/ln(10))+1;
  106.  d[0]:=char(long);
  107.  str(nbr:long,d);
  108.  for i:=1 to long do
  109.   if (d[i]=' ') and with0 then d[i]:='0';
  110.  deci:=d;
  111. End;
  112.  
  113. Procedure DisposeStr(P:PString);
  114. Var l:Byte;
  115. Begin
  116.  l:=ord(P^[0]);
  117.  freemem(P,l+1);
  118. End;
  119.  
  120. Function NewStr(S:String):PString;
  121. Var P:PString;
  122. Begin
  123.  GetMem(P,length(S)+1);
  124.  P^:=S;
  125.  NewStr:=P;
  126. End;
  127.  
  128. { Objet TZipTab }
  129.  
  130. Constructor TZipTab.Init(NomFichier:PathStr);
  131. Var f:PBinFile;
  132.     i,p:LongInt;
  133.     S:String;
  134.     EndDir:TEndDirDesc;
  135.     fdatas:PFileZipDatas;
  136. Begin
  137.  TTabPtr.Init(20,20);
  138.  TailleDecomp:=0;
  139.  f:=New(PBinFile,Init(NomFichier,8*1024));
  140.  if not f^.IsValid
  141.     then begin
  142.           ErrorFlag:=erFile;
  143.           exit;
  144.          end;
  145.  
  146.  { Recherche fin du répertoire des fichiers à partir de la fin }
  147.  p:=f^.datafilesize+1;
  148.  repeat
  149.   dec(p);
  150.   with f^ do
  151.    begin
  152.     setfileposit(p-sizeof(EndDir));
  153.     readvar(EndDir,sizeof(EndDir));
  154.    end;
  155.  until (EndDir.sign=EndDirSign) or (p=sizeof(EndDir));
  156.  if p=sizeof(EndDir)
  157.     then begin
  158.           ErrorFlag:=erNotZip;
  159.           exit;
  160.          end;
  161.  if EndDir.nmr_disk<>0
  162.     then begin
  163.           ErrorFlag:=erDisks;
  164.           exit;
  165.          end;
  166.  
  167.  { lecture des données }
  168.  f^.setfileposit(EndDir.start_dir);
  169.  for i:=1 to EndDir.total_file do
  170.   begin
  171.    new(fdatas);
  172.    fdatas^.fname:=nil;
  173.    fdatas^.fcomment:=nil;
  174.    f^.readvar(fdatas^.FileDir,sizeof(TFileDirDesc));
  175.    Ajouter(fdatas);
  176.    with fdatas^ do
  177.     begin
  178.      { vérification signature }
  179.      if FileDir.sign<>FileDirSign
  180.         then begin
  181.               ErrorFlag:=erFatale;
  182.               exit;
  183.              end
  184.         else begin
  185.               { mise à jour taille totale }
  186.               TailleDecomp:=TailleDecomp+FileDir.uncomp_size;
  187.               { nom du fichier }
  188.               f^.readvar(s[1],FileDir.filenamelen);
  189.               s[0]:=chr(FileDir.filenamelen);
  190.               fname:=newstr(s);
  191.               { commentaire fichier }
  192.               f^.setfileposit(f^.getfileposit+FileDir.extrafieldlen);
  193.               if FileDir.filecomlen<>0
  194.                  then begin
  195.                        f^.readvar(s[1],FileDir.filecomlen);
  196.                        s[0]:=chr(FileDir.filecomlen);
  197.                        fcomment:=newstr(s);
  198.                       end;
  199.              end;
  200.     end; {with}
  201.  end;  {for}
  202.  dispose(f,done);
  203. End;
  204.  
  205. Function TZipTab.GetErrorMsg:String;
  206. Begin
  207.  case ErrorFlag of
  208.   erFile   : GetErrorMsg:='Ouverture du fichier impossible.';
  209.   erNotZip : GetErrorMsg:='Format du fichier non reconnu.';
  210.   erDisks  : GetErrorMsg:='Les fichiers sont sur plusieurs disques.';
  211.   erFatale : GetErrorMsg:='Erreur fatale dans le fichier ZIP.';
  212.   else GetErrorMsg:=TTabPtr.GetErrorMsg;
  213.   end;
  214. End;
  215.  
  216. Procedure TZipTab.Effacer(P:Pointer);
  217. Var w:PFileZipDatas;
  218. Begin
  219.  w:=PFileZipDatas(p);
  220.  with w^ do
  221.   begin
  222.    if fname<>nil then disposestr(fname);
  223.    if fcomment<>nil then disposestr(fcomment);
  224.   end;
  225.  Dispose(w);
  226. End;
  227.  
  228. Function TZipTab.GetRec(n:Integer):PFileZipDatas;
  229. Var P:PFileZipDatas;
  230. Begin
  231.  if (n<1) or (n>NombreItems)
  232.     then P:=nil
  233.     else Lire(P,n);
  234.  GetRec:=P;
  235. End;
  236.  
  237. Function Longueur(R:TFileZipDatas):String;
  238. Begin
  239.  Longueur:=deci(R.FileDir.uncomp_size,8,false);
  240. End;
  241.  
  242. Function Methode(R:TFileZipDatas):String;
  243. Begin
  244.  Methode:=Tab_Method[R.FileDir.method];
  245. End;
  246.  
  247. Function Taille(R:TFileZipDatas):String;
  248. Begin
  249.  Taille:=deci(R.FileDir.comp_size,9,false);
  250. End;
  251.  
  252. Function Ratio(R:TFileZipDatas):String;
  253. Begin
  254.  Ratio:=deci(100-R.FileDir.comp_size*100 div R.FileDir.uncomp_size,
  255.              4,false)+'%';
  256. End;
  257.  
  258. Function ZDate(R:TFileZipDatas):String;
  259. Var t:DateTime;
  260. Begin
  261.  UnPackTime(R.FileDir.time_date,t);
  262.  ZDate:=deci(t.day,2,true)+' '+mois[t.month]+' '+deci(t.year,4,true);
  263. End;
  264.  
  265. Function ZHeure(R:TFileZipDatas):String;
  266. Var t:DateTime;
  267. Begin
  268.  UnPackTime(R.FileDir.time_date,t);
  269.  ZHeure:=deci(t.hour,2,true)+':'+deci(t.min,2,true)+':'+deci(t.sec,2,true);
  270. End;
  271.  
  272. Function CRC32(R:TFileZipDatas):String;
  273. Begin
  274.  CRC32:=hexa(R.FileDir.crc_32,8);
  275. End;
  276.  
  277. Function ZNom(R:TFileZipDatas):String;
  278. Var fd:DirStr;
  279.     fn:NameStr;
  280.     fe:ExtStr;
  281. Begin
  282.  fsplit(R.fname^,fd,fn,fe);
  283.  fd:=fn+fe;
  284.  while length(fd)<12 do fd:=fd+' ';
  285.  ZNom:=fd;
  286. End;
  287.  
  288. END.
  289.  
  290. {                          Fin du fichier OFZip.Pas                         }
  291.