1 program MiniUnz; 2 3 { mini unzip demo package by Gilles Vollant 4 5 Usage : miniunz [-exvlo] file.zip [file_to_extract] 6 7 -l or -v list the content of the zipfile. 8 -e extract a specific file or all files if [file_to_extract] is missing 9 -x like -e, but extract without path information 10 -o overwrite an existing file without warning 11 12 Pascal translation 13 Copyright (C) 2000 by Jacques Nomssi Nzali 14 For conditions of distribution and use, see copyright notice in readme.txt 15 }{$ifdef WIN32} 16 {$define Delphi} 17 {$ifndef FPC} 18 {$define Delphi32} 19 {$endif} 20 {$endif} 21 22 uses 23 sysutils, 24 {$ifdef Delphi} 25 Windows, 26 {$else} 27 zlib, 28 {$endif} 29 ziputils, 30 paszlib, 31 ctypes, 32 unzip; 33 34 const 35 CASESENSITIVITY = 0; 36 WRITEBUFFERSIZE = 8192; 37 38 39 { change_file_date : change the date/time of a file 40 filename : the filename of the file where date/time must be modified 41 dosdate : the new date at the MSDos format (4 bytes) 42 tmu_date : the SAME new date at the tm_unz format } 43 44 procedure change_file_date(const filename: PChar; dosdate: longword; tmu_date: tm_unz); 45 {$ifdef Delphi32} 46 var 47 hFile: THandle; 48 ftm, ftLocal, ftCreate, ftLastAcc, ftLastWrite: TFileTime; 49 begin 50 hFile := CreateFile(filename, GENERIC_READ or GENERIC_WRITE, 51 0, nil, OPEN_EXISTING, 0, 0); 52 GetFileTime(hFile, @ftCreate, @ftLastAcc, @ftLastWrite); 53 DosDateTimeToFileTime(word((dosdate shl 16)), word(dosdate), ftLocal); 54 LocalFileTimeToFileTime(ftLocal, ftm); 55 SetFileTime(hFile, @ftm, @ftLastAcc, @ftm); 56 CloseHandle(hFile); 57 end; 58 59 {$else} 60 {$if defined(FPC) and defined(win32)} 61 var 62 hFile : THandle; 63 ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite : TFileTime; 64 begin 65 hFile := CreateFile(filename,GENERIC_READ or GENERIC_WRITE, 66 0,NIL,OPEN_EXISTING,0,0); 67 GetFileTime(hFile, @ftCreate, @ftLastAcc, @ftLastWrite); 68 DosDateTimeToFileTime(WORD((dosdate shl 16)), WORD(dosdate), @ftLocal); 69 LocalFileTimeToFileTime(ftLocal, ftm); 70 SetFileTime(hFile,ftm, ftLastAcc, ftm); 71 CloseHandle(hFile); 72 end; 73 {$else} { msdos } 74 begin 75 FileSetDate(filename,dosdate); 76 end; 77 {$endif} 78 {$endif} 79 80 81 { mymkdir and change_file_date are not 100 % portable 82 As I don't know well Unix, I wait feedback for the unix portion } 83 mymkdirnull84 function mymkdir(dirname: PChar): boolean; 85 var 86 S: string; 87 begin 88 S := StrPas(dirname); 89 {$I-} 90 mkdir(S); 91 mymkdir := IOresult = 0; 92 end; 93 makedirnull94 function makedir(newdir: PChar): boolean; 95 var 96 buffer: PChar; 97 p: PChar; 98 len: cint; 99 var 100 hold: char; 101 begin 102 makedir := False; 103 len := strlen(newdir); 104 105 if (len <= 0) then 106 exit; 107 108 buffer := PChar(allocmem( len + 1)); 109 110 strcopy(buffer, newdir); 111 112 if (buffer[len - 1] = '/') then 113 buffer[len - 1] := #0; 114 115 if mymkdir(buffer) then 116 begin 117 if Assigned(buffer) then 118 freemem( buffer); 119 makedir := True; 120 exit; 121 end; 122 123 p := buffer + 1; 124 while True do 125 begin 126 while ((p^ <> #0) and (p^ <> '\') and (p^ <> '/')) do 127 Inc(p); 128 hold := p^; 129 p^ := #0; 130 if (not mymkdir(buffer)) {and (errno = ENOENT)} then 131 begin 132 WriteLn('couldn''t create directory ', buffer); 133 if Assigned(buffer) then 134 freemem( buffer); 135 exit; 136 end; 137 if (hold = #0) then 138 break; 139 p^ := hold; 140 Inc(p); 141 end; 142 if Assigned(buffer) then 143 freemem( buffer); 144 makedir := True; 145 end; 146 147 procedure do_banner; 148 begin 149 WriteLn('MiniUnz 0.15, demo package written by Gilles Vollant'); 150 WriteLn('Pascal port by Jacques Nomssi Nzali'); 151 WriteLn('more info at http://wwww.tu-chemnitz.de/~nomssi/paszlib.html'); 152 WriteLn; 153 end; 154 155 procedure do_help; 156 begin 157 WriteLn('Usage : miniunz [-exvlo] file.zip [file_to_extract]'); 158 WriteLn; 159 end; 160 LeadingZeronull161 function LeadingZero(w: word): string; 162 var 163 s: string; 164 begin 165 Str(w: 0, s); 166 if Length(s) = 1 then 167 s := '0' + s; 168 LeadingZero := s; 169 end; 170 HexToStrnull171 function HexToStr(w: clong): string; 172 const 173 ByteToChar: array[0..$F] of char = '0123456789ABCDEF'; 174 var 175 s: string; 176 i: cint; 177 x: clong; 178 begin 179 s := ''; 180 x := w; 181 for i := 0 to 3 do 182 begin 183 s := ByteToChar[byte(x) shr 4] + ByteToChar[byte(x) and $F] + s; 184 x := x shr 8; 185 end; 186 HexToStr := s; 187 end; 188 do_listnull189 function do_list(uf: unzFile): cint; 190 var 191 i: longword; 192 gi: unz_global_info; 193 err: cint; 194 var 195 filename_inzip: array[0..255] of char; 196 file_info: unz_file_info; 197 ratio: longword; 198 string_method: string[255]; 199 var 200 iLevel: cuInt; 201 begin 202 err := unzGetGlobalInfo(uf, gi); 203 if (err <> UNZ_OK) then 204 WriteLn('error ', err, ' with zipfile in unzGetGlobalInfo'); 205 WriteLn(' Length Method Size Ratio Date Time CRC-32 Name'); 206 WriteLn(' ------ ------ ---- ----- ---- ---- ------ ----'); 207 for i := 0 to gi.number_entry - 1 do 208 begin 209 ratio := 0; 210 err := unzGetCurrentFileInfo(uf, @file_info, filename_inzip, sizeof(filename_inzip), nil, 0, nil, 0); 211 if (err <> UNZ_OK) then 212 begin 213 WriteLn('error ', err, ' with zipfile in unzGetCurrentFileInfo'); 214 break; 215 end; 216 if (file_info.uncompressed_size > 0) then 217 ratio := (file_info.compressed_size * 100) div file_info.uncompressed_size; 218 219 if (file_info.compression_method = 0) then 220 string_method := 'Stored' 221 else 222 if (file_info.compression_method = Z_DEFLATED) then 223 begin 224 iLevel := cuInt((file_info.flag and $06) div 2); 225 case iLevel of 226 0: string_method := 'Defl:N'; 227 1: string_method := 'Defl:X'; 228 2, 3: string_method := 'Defl:F'; { 2:fast , 3 : extra fast} 229 else 230 string_method := 'Unkn. '; 231 end; 232 end; 233 234 WriteLn(file_info.uncompressed_size: 7, ' ', 235 string_method: 6, ' ', 236 file_info.compressed_size: 7, ' ', 237 ratio: 3, '% ', LeadingZero(longword(file_info.tmu_date.tm_mon) + 1), '-', 238 LeadingZero(longword(file_info.tmu_date.tm_mday)): 2, '-', 239 LeadingZero(longword(file_info.tmu_date.tm_year mod 100)): 2, ' ', 240 LeadingZero(longword(file_info.tmu_date.tm_hour)), ':', 241 LeadingZero(longword(file_info.tmu_date.tm_min)), ' ', 242 HexToStr(longword(file_info.crc)), ' ', 243 filename_inzip); 244 245 if ((i + 1) < gi.number_entry) then 246 begin 247 err := unzGoToNextFile(uf); 248 if (err <> UNZ_OK) then 249 begin 250 WriteLn('error ', err, ' with zipfile in unzGoToNextFile'); 251 break; 252 end; 253 end; 254 end; 255 256 do_list := 0; 257 end; 258 259 do_extract_currentfilenull260 function do_extract_currentfile(uf: unzFile; const popt_extract_without_path: cint; var popt_overwrite: cint): cint; 261 var 262 filename_inzip: packed array[0..255] of char; 263 filename_withoutpath: PChar; 264 p: PChar; 265 err: cint; 266 fout: FILEptr; 267 buf: pointer; 268 size_buf: cuInt; 269 file_info: unz_file_info; 270 var 271 write_filename: PChar; 272 skip: cint; 273 var 274 rep: char; 275 ftestexist: FILEptr; 276 var 277 answer: string[127]; 278 var 279 c: char; 280 begin 281 fout := nil; 282 283 err := unzGetCurrentFileInfo(uf, @file_info, filename_inzip, 284 sizeof(filename_inzip), nil, 0, nil, 0); 285 286 if (err <> UNZ_OK) then 287 begin 288 WriteLn('error ', err, ' with zipfile in unzGetCurrentFileInfo'); 289 do_extract_currentfile := err; 290 exit; 291 end; 292 293 size_buf := WRITEBUFFERSIZE; 294 buf := allocmem(size_buf); 295 if (buf = nil) then 296 begin 297 WriteLn('Error allocating memory'); 298 do_extract_currentfile := UNZ_INTERNALERROR; 299 exit; 300 end; 301 302 filename_withoutpath := filename_inzip; 303 p := filename_withoutpath; 304 while (p^ <> #0) do 305 begin 306 if (p^ = '/') or (p^ = '\') then 307 filename_withoutpath := p + 1; 308 Inc(p); 309 end; 310 311 if (filename_withoutpath^ = #0) then 312 begin 313 if (popt_extract_without_path = 0) then 314 begin 315 WriteLn('creating directory: ', filename_inzip); 316 mymkdir(filename_inzip); 317 end; 318 end 319 else 320 begin 321 322 skip := 0; 323 if (popt_extract_without_path = 0) then 324 write_filename := filename_inzip 325 else 326 write_filename := filename_withoutpath; 327 328 err := unzOpenCurrentFile(uf); 329 if (err <> UNZ_OK) then 330 WriteLn('error ', err, ' with zipfile in unzOpenCurrentFile'); 331 332 333 if ((popt_overwrite = 0) and (err = UNZ_OK)) then 334 begin 335 rep := #0; 336 337 ftestexist := fopen(write_filename, fopenread); 338 if (ftestexist <> nil) then 339 begin 340 fclose(ftestexist); 341 repeat 342 Write('The file ', write_filename, 343 ' exist. Overwrite ? [y]es, [n]o, [A]ll: '); 344 ReadLn(answer); 345 346 rep := answer[1]; 347 if ((rep >= 'a') and (rep <= 'z')) then 348 Dec(rep, $20); 349 until (rep = 'Y') or (rep = 'N') or (rep = 'A'); 350 end; 351 352 if (rep = 'N') then 353 skip := 1; 354 355 if (rep = 'A') then 356 popt_overwrite := 1; 357 end; 358 359 if (skip = 0) and (err = UNZ_OK) then 360 begin 361 fout := fopen(write_filename, fopenwrite); 362 363 { some zipfile don't contain directory alone before file } 364 if (fout = nil) and (popt_extract_without_path = 0) and 365 (filename_withoutpath <> PChar(@filename_inzip)) then 366 begin 367 c := (filename_withoutpath - 1)^; 368 (filename_withoutpath -1)^ := #0; 369 makedir(write_filename); 370 (filename_withoutpath -1)^ := c; 371 fout := fopen(write_filename, fopenwrite); 372 end; 373 374 if (fout = nil) then 375 WriteLn('error opening ', write_filename); 376 end; 377 378 if (fout <> nil) then 379 begin 380 WriteLn(' extracting: ', write_filename); 381 382 repeat 383 err := unzReadCurrentFile(uf, buf, size_buf); 384 if (err < 0) then 385 begin 386 WriteLn('error ', err, ' with zipfile in unzReadCurrentFile'); 387 break; 388 end; 389 if (err > 0) then 390 if (fwrite(buf, err, 1, fout) <> 1) then 391 begin 392 WriteLn('error in writing extracted file'); 393 err := UNZ_ERRNO; 394 break; 395 end; 396 until (err = 0); 397 fclose(fout); 398 if (err = 0) then 399 change_file_date(write_filename, file_info.dosDate, 400 file_info.tmu_date); 401 end; 402 403 if (err = UNZ_OK) then 404 begin 405 err := unzCloseCurrentFile(uf); 406 if (err <> UNZ_OK) then 407 WriteLn('error ', err, ' with zipfile in unzCloseCurrentFile') 408 else 409 unzCloseCurrentFile(uf); { don't lose the error } 410 end; 411 end; 412 413 if buf <> nil then 414 freemem( buf); 415 do_extract_currentfile := err; 416 end; 417 418 do_extractnull419 function do_extract(uf: unzFile; opt_extract_without_path: cint; opt_overwrite: cint): cint; 420 var 421 i: longword; 422 gi: unz_global_info; 423 err: cint; 424 begin 425 err := unzGetGlobalInfo(uf, gi); 426 if (err <> UNZ_OK) then 427 WriteLn('error ', err, ' with zipfile in unzGetGlobalInfo '); 428 429 for i := 0 to gi.number_entry - 1 do 430 begin 431 if (do_extract_currentfile(uf, opt_extract_without_path, 432 opt_overwrite) <> UNZ_OK) then 433 break; 434 435 if ((i + 1) < gi.number_entry) then 436 begin 437 err := unzGoToNextFile(uf); 438 if (err <> UNZ_OK) then 439 begin 440 WriteLn('error ', err, ' with zipfile in unzGoToNextFile'); 441 break; 442 end; 443 end; 444 end; 445 446 do_extract := 0; 447 end; 448 do_extract_onefilenull449 function do_extract_onefile(uf: unzFile; const filename: PChar; opt_extract_without_path: cint; opt_overwrite: cint): cint; 450 begin 451 if (unzLocateFile(uf, filename, CASESENSITIVITY) <> UNZ_OK) then 452 begin 453 WriteLn('file ', filename, ' not found in the zipfile'); 454 do_extract_onefile := 2; 455 exit; 456 end; 457 458 if (do_extract_currentfile(uf, opt_extract_without_path, 459 opt_overwrite) = UNZ_OK) then 460 do_extract_onefile := 0 461 else 462 do_extract_onefile := 1; 463 end; 464 465 { -------------------------------------------------------------------- } mainnull466 function main: cint; 467 const 468 zipfilename: PChar = nil; 469 filename_to_extract: PChar = nil; 470 var 471 i: cint; 472 opt_do_list: cint; 473 opt_do_extract: cint; 474 opt_do_extract_withoutpath: cint; 475 opt_overwrite: cint; 476 filename_try: array[0..512 - 1] of char; 477 uf: unzFile; 478 var 479 p: cint; 480 pstr: string[255]; 481 c: char; 482 begin 483 opt_do_list := 0; 484 opt_do_extract := 1; 485 opt_do_extract_withoutpath := 0; 486 opt_overwrite := 0; 487 uf := nil; 488 489 do_banner; 490 if (ParamCount = 0) then 491 begin 492 do_help; 493 Halt(0); 494 end 495 else 496 for i := 1 to ParamCount do 497 begin 498 pstr := ParamStr(i); 499 if pstr[1] = '-' then 500 for p := 2 to Length(pstr) do 501 begin 502 c := pstr[p]; 503 case UpCase(c) of 504 'L', 505 'V': opt_do_list := 1; 506 'X': opt_do_extract := 1; 507 'E': 508 begin 509 opt_do_extract := 1; 510 opt_do_extract_withoutpath := 1; 511 end; 512 'O': opt_overwrite := 1; 513 end; 514 end 515 else 516 begin 517 pstr := pstr + #0; 518 if (zipfilename = nil) then 519 zipfilename := StrNew(PChar(@pstr[1])) 520 else 521 if (filename_to_extract = nil) then 522 filename_to_extract := StrNew(PChar(@pstr[1])); 523 end; 524 end{ for }; 525 526 if (zipfilename <> nil) then 527 begin 528 strcopy(filename_try, zipfilename); 529 uf := unzOpen(zipfilename); 530 if (uf = nil) then 531 begin 532 strcat(filename_try, '.zip'); 533 uf := unzOpen(filename_try); 534 end; 535 end; 536 537 if (uf = nil) then 538 begin 539 WriteLn('Cannot open ', zipfilename, ' or ', zipfilename, '.zip'); 540 Halt(1); 541 end; 542 543 WriteLn(filename_try, ' opened'); 544 545 if (opt_do_list = 1) then 546 begin 547 main := do_list(uf); 548 exit; 549 end 550 else 551 if (opt_do_extract = 1) then 552 if (filename_to_extract = nil) then 553 begin 554 main := do_extract(uf, opt_do_extract_withoutpath, opt_overwrite); 555 exit; 556 end 557 else 558 begin 559 main := do_extract_onefile(uf, filename_to_extract, 560 opt_do_extract_withoutpath, opt_overwrite); 561 exit; 562 end; 563 564 unzCloseCurrentFile(uf); 565 566 strDispose(zipfilename); 567 strDispose(filename_to_extract); 568 main := 0; 569 end; 570 571 begin 572 main; 573 Write('Done...'); 574 Readln; 575 end. 576