tczipper.pp 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885
  1. program tczipper;
  2. {
  3. This file is part of the Free Pascal packages.
  4. Copyright (c) 2012-2014 by the Free Pascal Development Team
  5. Created by Reinier Olislagers
  6. Tests zip/unzip functionality provided by the FPC zipper.pp unit.
  7. If passed a zip file name as first argument, it will try and decompress
  8. and list the contents of the zip file.
  9. See the file COPYING.FPC, included in this distribution,
  10. for details about the license.
  11. **********************************************************************}
  12. {$mode objfpc}{$h+}
  13. //Define this if you want to inspect the generated zips etc
  14. {$define KEEPTESTFILES}
  15. uses
  16. SysUtils, classes,
  17. zipper, unzip, zdeflate, zinflate, zip, md5, zstream, nullstream;
  18. type
  19. { TCallBackHandler }
  20. TCallBackHandler = class(TObject) //Callbacks used in zip/unzip processing
  21. private
  22. FPerformChecks: boolean;
  23. FOriginalContent: string;
  24. FShowContent: boolean;
  25. FStreamResult: boolean;
  26. public
  27. property PerformChecks: boolean read FPerformChecks write FPerformChecks; //If false, do not perform any consistency checks
  28. property OriginalContent: string read FOriginalContent write FOriginalContent; //Zip entry uncompressed content used in TestZipEntries
  29. property ShowContent: boolean read FShowContent write FShowContent; //Show contents of zip when extracting?
  30. property StreamResult: boolean read FStreamResult; //For handler to report success/failure
  31. procedure EndOfFile(Sender:TObject; const Ratio:double);
  32. procedure StartOfFile(Sender:TObject; const AFileName:string);
  33. procedure DoCreateZipOutputStream(Sender: TObject; var AStream: TStream;
  34. AItem: TFullZipFileEntry);
  35. procedure DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
  36. AItem: TFullZipFileEntry); //Used to verify zip entry decompressed contents
  37. constructor Create;
  38. end;
  39. procedure TCallBackHandler.EndOfFile(Sender: TObject; const Ratio: double);
  40. begin
  41. writeln('End of file handler hit; compression ratio: '+floattostr(ratio));
  42. if (FPerformChecks) and (Ratio<0) then
  43. begin
  44. writeln('Found compression ratio '+floattostr(Ratio)+', which should never be lower than 0.');
  45. halt(1);
  46. end;
  47. end;
  48. procedure TCallBackHandler.StartOfFile(Sender: TObject; const AFileName: string);
  49. begin
  50. writeln('Start of file handler hit; filename: '+AFileName);
  51. if (FPerformChecks) and (AFileName='') then
  52. begin
  53. writeln('Archive filename should not be empty.');
  54. halt(1);
  55. end;
  56. end;
  57. procedure TCallBackHandler.DoCreateZipOutputStream(Sender: TObject; var AStream: TStream;
  58. AItem: TFullZipFileEntry);
  59. begin
  60. AStream:=TMemoryStream.Create;
  61. end;
  62. procedure TCallBackHandler.DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
  63. AItem: TFullZipFileEntry);
  64. var
  65. DecompressedContent: string;
  66. begin
  67. //writeln('At end of '+AItem.ArchiveFileName);
  68. AStream.Position:=0;
  69. SetLength(DecompressedContent,Astream.Size);
  70. if AStream.Size>0 then
  71. (AStream as TMemoryStream).Read(DecompressedContent[1], AStream.Size);
  72. if (FPerformChecks) and (DecompressedContent<>OriginalContent) then
  73. begin
  74. FStreamResult:=false;
  75. writeln('TestZipEntries failed: found entry '+AItem.ArchiveFileName+
  76. ' has value ');
  77. writeln('*'+DecompressedContent+'*');
  78. writeln('expected ');
  79. writeln('*'+OriginalContent+'*');
  80. end;
  81. if (FPerformChecks=false) and (ShowContent=true) then
  82. begin
  83. //display only
  84. writeln('TestZipEntries info: found entry '+AItem.ArchiveFileName+
  85. ' has value ');
  86. writeln('*'+DecompressedContent+'*');
  87. end;
  88. Astream.Free;
  89. end;
  90. constructor TCallBackHandler.Create;
  91. begin
  92. FOriginalContent:='A'; //nice short demo content
  93. FStreamResult:=true;
  94. FPerformChecks:=true; //perform verification by default
  95. FShowContent:=true;
  96. end;
  97. function CompareCompressDecompress: boolean;
  98. var
  99. CallBackHandler: TCallBackHandler;
  100. CompressedFile: string;
  101. FileContents: TStringList;
  102. UncompressedFile1: string;
  103. UncompressedFile1Hash: string;
  104. UncompressedFile2: string;
  105. UncompressedFile2Hash: string;
  106. OurZipper: TZipper;
  107. UnZipper: TUnZipper;
  108. begin
  109. result:=true;
  110. FileContents:=TStringList.Create;
  111. OurZipper:=TZipper.Create;
  112. UnZipper:=TUnZipper.Create;
  113. CallBackHandler:=TCallBackHandler.Create;
  114. try
  115. // Set up uncompressed files
  116. FileContents.Add('This is an uncompressed file.');
  117. FileContents.Add('And another line.');
  118. UncompressedFile1:=SysUtils.GetTempFileName('', 'UN1');
  119. FileContents.SaveToFile(UncompressedFile1);
  120. FileContents.Clear;
  121. FileContents.Add('Have you looked into using fpcup today?');
  122. FileContents.Add('It works nicely with fpc and goes well with a fruity red wine, too.');
  123. // Second GetTempFileName call needs to be done after saving first file because
  124. // GetTempFileName checks for existing file names and may give the *same* file name
  125. // if called before
  126. UncompressedFile2:=SysUtils.GetTempFileName('', 'UN2');
  127. FileContents.SaveToFile(UncompressedFile2);
  128. // Remember their content, so we can compare later.
  129. UncompressedFile1Hash:=MD5Print(MD5File(UncompressedFile1, MDDefBufSize));
  130. UncompressedFile2Hash:=MD5Print(MD5File(UncompressedFile2, MDDefBufSize));
  131. // Test zip functionality.
  132. CompressedFile:=SysUtils.GetTempFileName('', 'CC');
  133. OurZipper.FileName:=CompressedFile;
  134. // Add the files only with their filenames, we don't want to create
  135. // subdirectories:
  136. OurZipper.Entries.AddFileEntry(UncompressedFile1,ExtractFileName(UncompressedFile1));
  137. OurZipper.Entries.AddFileEntry(UncompressedFile2,ExtractFileName(UncompressedFile2));
  138. OurZipper.OnStartFile:[email protected];
  139. OurZipper.OnEndFile:[email protected];
  140. OurZipper.ZipAllFiles;
  141. if not FileExists(CompressedFile) then
  142. begin
  143. writeln('Zip file was not created.');
  144. exit(false);
  145. end;
  146. // Delete original files
  147. {$IFNDEF KEEPTESTFILES}
  148. DeleteFile(UncompressedFile1);
  149. DeleteFile(UncompressedFile2);
  150. {$ENDIF}
  151. // Now unzip
  152. Unzipper.FileName:=CompressedFile;
  153. Unzipper.OutputPath:=ExtractFilePath(UncompressedFile1);
  154. UnZipper.OnStartFile:[email protected];
  155. UnZipper.OnEndFile:[email protected];
  156. Unzipper.Examine;
  157. Unzipper.UnZipAllFiles;
  158. // Now we should have the uncompressed files again
  159. if (not FileExists(UncompressedFile1)) or
  160. (not FileExists(UncompressedFile2)) then
  161. begin
  162. writeln('Unzip failed: could not find decompressed files.');
  163. exit(false);
  164. end;
  165. // Compare hashes
  166. if
  167. (UncompressedFile1Hash<>MD5Print(MD5File(UncompressedFile1, MDDefBufSize)))
  168. or
  169. (UncompressedFile2Hash<>MD5Print(MD5File(UncompressedFile2, MDDefBufSize)))
  170. then
  171. begin
  172. writeln('Unzip failed: uncompressed files are not the same as the originals.');
  173. exit(false);
  174. end;
  175. finally
  176. FileContents.Free;
  177. CallBackHandler.Free;
  178. OurZipper.Free;
  179. UnZipper.Free;
  180. {$IFNDEF KEEPTESTFILES}
  181. try
  182. if FileExists(CompressedFile) then DeleteFile(CompressedFile);
  183. if FileExists(UncompressedFile1) then DeleteFile(UncompressedFile1);
  184. if FileExists(UncompressedFile2) then DeleteFile(UncompressedFile2);
  185. finally
  186. // Ignore errors: OS should eventually clean out temp files anyway
  187. end;
  188. {$ENDIF}
  189. end;
  190. end;
  191. function CompressSmallStreams: boolean;
  192. // Compresses some small streams using default compression and
  193. // no compression (storage)
  194. // Just storing is the best option; compression will enlarge the zip.
  195. // Test verifies that the entries in the zip are not bigger than
  196. // the originals.
  197. var
  198. DestFile: string;
  199. z: TZipper;
  200. zfe: TZipFileEntry;
  201. s: string = 'abcd';
  202. DefaultStream, StoreStream: TStringStream;
  203. begin
  204. result:=true;
  205. DestFile:=SysUtils.GetTempFileName('', 'CS1');
  206. z:=TZipper.Create;
  207. z.FileName:=DestFile;
  208. try
  209. DefaultStream:=TStringStream.Create(s);
  210. StoreStream:=TStringStream.Create(s);
  211. //DefaultStream - compression level = Default
  212. zfe:=z.Entries.AddFileEntry(DefaultStream, 'Compressed');
  213. z.ZipAllFiles;
  214. if (z.Entries[0].Size>zfe.Size) then
  215. begin
  216. result:=false;
  217. writeln('Small stream test default compression failed: compressed size '+
  218. inttostr(z.Entries[0].Size) + ' > original size '+inttostr(zfe.Size));
  219. exit;
  220. end;
  221. finally
  222. DefaultStream.Free;
  223. StoreStream.Free;
  224. z.Free;
  225. end;
  226. {$IFNDEF KEEPTESTFILES}
  227. try
  228. DeleteFile(DestFile);
  229. except
  230. // ignore mess
  231. end;
  232. {$ENDIF}
  233. DestFile:=SysUtils.GetTempFileName('', 'CS2');
  234. z:=TZipper.Create;
  235. z.FileName:=DestFile;
  236. try
  237. DefaultStream:=TStringStream.Create(s);
  238. StoreStream:=TStringStream.Create(s);
  239. //StoreStream - compression level = Store
  240. zfe:=z.Entries.AddFileEntry(StoreStream, 'Uncompressed');
  241. zfe.CompressionLevel:=clnone;
  242. z.ZipAllFiles;
  243. if (z.Entries[0].Size>zfe.Size) then
  244. begin
  245. result:=false;
  246. writeln('Small stream test uncompressed failed: compressed size '+
  247. inttostr(z.Entries[0].Size) + ' > original size '+inttostr(zfe.Size));
  248. exit;
  249. end;
  250. finally
  251. DefaultStream.Free;
  252. StoreStream.Free;
  253. z.Free;
  254. end;
  255. {$IFNDEF KEEPTESTFILES}
  256. try
  257. DeleteFile(DestFile);
  258. except
  259. // ignore mess
  260. end;
  261. {$ENDIF}
  262. //The result can be checked with the command (on Linux):
  263. //unzip -v <DestFile>
  264. //The column Size Shows that compressed files are bigger than source files
  265. end;
  266. function ShowZipFile(ZipFile: string): boolean;
  267. // Reads zip file and lists entries
  268. var
  269. CallBackHandler: TCallBackHandler;
  270. i: integer;
  271. UnZipper: TUnZipper;
  272. UnzipArchiveFiles: TStringList;
  273. begin
  274. result:=true;
  275. UnZipper:=TUnZipper.Create;
  276. CallBackHandler:=TCallBackHandler.Create;
  277. UnzipArchiveFiles:=TStringList.Create;
  278. try
  279. CallBackHandler.PerformChecks:=false; //only display output
  280. UnZipper.FileName:=ZipFile;
  281. Unzipper.Examine;
  282. writeln('ShowZipFile: zip file has '+inttostr(UnZipper.Entries.Count)+' entries');
  283. i:=0;
  284. Unzipper.OnCreateStream:[email protected];
  285. Unzipper.OnDoneStream:[email protected];
  286. while i<Unzipper.Entries.Count do
  287. begin
  288. if CallBackHandler.StreamResult then
  289. begin
  290. UnzipArchiveFiles.Clear;
  291. UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
  292. Unzipper.UnZipFiles(UnzipArchiveFiles);
  293. // This will kick off the DoCreateOutZipStream/DoDoneOutZipStream handlers
  294. inc(i);
  295. end
  296. else
  297. begin
  298. break; // Handler has reported error; stop loop
  299. end;
  300. end;
  301. finally
  302. Unzipper.Free;
  303. CallBackHandler.Free;
  304. UnzipArchiveFiles.Free;
  305. end;
  306. end;
  307. function TestZipEntries(Entries: qword): boolean;
  308. // Adds Entries amount of zip file entries and reads them
  309. // Starting from 65535 entries, the zip needs to be in zip64 format
  310. var
  311. CallBackHandler: TCallBackHandler;
  312. DestFile: string;
  313. i: qword;
  314. OriginalContent: string = 'A'; //Uncompressed content for zip file entry
  315. ContentStreams: TFPList;
  316. ContentStream: TStringStream;
  317. UnZipper: TUnZipper;
  318. UnzipArchiveFiles: TStringList;
  319. Zipper: TZipper;
  320. begin
  321. result:=true;
  322. DestFile:=SysUtils.GetTempFileName('', 'E'+inttostr(Entries)+'_');
  323. Zipper:=TZipper.Create;
  324. Zipper.FileName:=DestFile;
  325. ContentStreams:=TFPList.Create;
  326. try
  327. i:=0;
  328. while i<Entries do
  329. begin
  330. ContentStream:=TStringStream.Create(OriginalContent);
  331. ContentStreams.Add(ContentStream);
  332. // Start filenames at 1
  333. Zipper.Entries.AddFileEntry(TStringStream(ContentStreams.Items[i]), format('%U',[i+1]));
  334. inc(i);
  335. end;
  336. Zipper.ZipAllFiles;
  337. {
  338. i:=0;
  339. while i<Entries do
  340. begin
  341. ContentStreams.Delete(i);
  342. end;
  343. }
  344. finally
  345. ContentStreams.Free;
  346. Zipper.Free;
  347. end;
  348. UnZipper:=TUnZipper.Create;
  349. CallBackHandler:=TCallBackHandler.Create;
  350. UnzipArchiveFiles:=TStringList.Create;
  351. try
  352. CallBackHandler.OriginalContent:=OriginalContent;
  353. UnZipper.FileName:=DestFile;
  354. Unzipper.Examine;
  355. if (UnZipper.Entries.Count<>Entries) then
  356. begin
  357. result:=false;
  358. writeln('TestZipEntries failed: found '+
  359. inttostr(UnZipper.Entries.Count) + ' entries; expected '+inttostr(Entries));
  360. exit;
  361. end;
  362. i:=0;
  363. Unzipper.OnCreateStream:[email protected];
  364. Unzipper.OnDoneStream:[email protected];
  365. while i<Entries do
  366. begin
  367. if CallBackHandler.StreamResult then
  368. begin
  369. UnzipArchiveFiles.Clear;
  370. UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
  371. Unzipper.UnZipFiles(UnzipArchiveFiles);
  372. // This will kick off the DoCreateOutZipStream/DoDoneOutZipStream handlers
  373. inc(i);
  374. end
  375. else
  376. begin
  377. break; // Handler has reported error; stop loop
  378. end;
  379. end;
  380. finally
  381. Unzipper.Free;
  382. CallBackHandler.Free;
  383. UnzipArchiveFiles.Free;
  384. end;
  385. {$IFNDEF KEEPTESTFILES}
  386. try
  387. DeleteFile(DestFile);
  388. except
  389. // ignore mess
  390. end;
  391. {$ENDIF}
  392. end;
  393. function TestEmptyZipEntries(Entries: qword): boolean;
  394. // Same as TestZipEntries, except uses empty data:
  395. // useful for testing large number of files
  396. var
  397. CallBackHandler: TCallBackHandler;
  398. DestFile: string;
  399. i: qword;
  400. ContentStreams: TFPList;
  401. ContentStream: TNullStream;
  402. UnZipper: TUnZipper;
  403. UnzipArchiveFiles: TStringList;
  404. Zipper: TZipper;
  405. begin
  406. result:=true;
  407. DestFile:=SysUtils.GetTempFileName('', 'EZ'+inttostr(Entries)+'_');
  408. Zipper:=TZipper.Create;
  409. Zipper.FileName:=DestFile;
  410. ContentStreams:=TFPList.Create;
  411. try
  412. i:=0;
  413. while i<Entries do
  414. begin
  415. ContentStream:=TNullStream.Create;
  416. ContentStreams.Add(ContentStream);
  417. // Start filenames at 1
  418. Zipper.Entries.AddFileEntry(TStringStream(ContentStreams.Items[i]), format('%U',[i+1]));
  419. inc(i);
  420. end;
  421. Zipper.ZipAllFiles;
  422. {
  423. i:=0;
  424. while i<Entries do
  425. begin
  426. ContentStreams.Delete(i);
  427. end;
  428. }
  429. finally
  430. ContentStreams.Free;
  431. Zipper.Free;
  432. end;
  433. UnZipper:=TUnZipper.Create;
  434. UnzipArchiveFiles:=TStringList.Create;
  435. CallBackHandler:=TCallBackHandler.Create;
  436. try
  437. // Use callbacks to dump zip output into the bit bucket
  438. CallBackHandler.PerformChecks:=false;
  439. CallBackHandler.ShowContent:=false;
  440. Unzipper.OnCreateStream:[email protected];
  441. Unzipper.OnDoneStream:[email protected];
  442. UnZipper.FileName:=DestFile;
  443. Unzipper.Examine;
  444. if (UnZipper.Entries.Count<>Entries) then
  445. begin
  446. result:=false;
  447. writeln('TestEmptyZipEntries failed: found '+
  448. inttostr(UnZipper.Entries.Count) + ' entries; expected '+inttostr(Entries));
  449. exit;
  450. end;
  451. i:=0;
  452. while i<Entries do
  453. begin
  454. UnzipArchiveFiles.Clear;
  455. UnzipArchiveFiles.Add(Unzipper.Entries[i].ArchiveFileName);
  456. Unzipper.UnZipFiles(UnzipArchiveFiles);
  457. inc(i);
  458. end;
  459. finally
  460. CallBackHandler.Free;
  461. Unzipper.Free;
  462. UnzipArchiveFiles.Free;
  463. end;
  464. {$IFNDEF KEEPTESTFILES}
  465. try
  466. DeleteFile(DestFile);
  467. except
  468. // ignore mess
  469. end;
  470. {$ENDIF}
  471. end;
  472. function SaveToFileTest: boolean;
  473. var
  474. NewFileName: string;
  475. OldFileName: string;
  476. z: TZipper;
  477. zfe: TZipFileEntry;
  478. s: string = 'abcd';
  479. DefaultStream: TStringStream;
  480. begin
  481. result:=true;
  482. OldFileName:=SysUtils.GetTempFileName('', 'OLD');
  483. NewFileName:=SysUtils.GetTempFileName('', 'NEW');
  484. z:=TZipper.Create;
  485. z.FileName:=OldFileName;
  486. try
  487. DefaultStream:=TStringStream.Create(s);
  488. zfe:=z.Entries.AddFileEntry(DefaultStream, 'Compressed');
  489. z.ZipAllFiles; //saves to OldFileName
  490. DeleteFile(NewFileName); //delete if present
  491. z.SaveToFile(NewFileName); //should save to newfilename
  492. if not(FileExists(NewFileName)) then
  493. begin
  494. writeln('Failure: file '+NewFileName+' does not exist.');
  495. result:=false;
  496. end
  497. else
  498. begin
  499. result:=true;
  500. end;
  501. finally
  502. DefaultStream.Free;
  503. z.Free;
  504. end;
  505. {$IFNDEF KEEPTESTFILES}
  506. try
  507. DeleteFile(DestFile);
  508. except
  509. // ignore mess
  510. end;
  511. {$ENDIF}
  512. end;
  513. function TestLargeFileName: boolean;
  514. // Zips/unzips 259-character filename
  515. var
  516. ArchiveFile: string;
  517. DestFile: string;
  518. s: string = 'a';
  519. DefaultStream: TStringStream;
  520. UnZipper: TUnZipper;
  521. Zipper: TZipper;
  522. begin
  523. result:=true;
  524. ArchiveFile:=StringOfChar('A',259);
  525. DestFile:=SysUtils.GetTempFileName('', 'TL');
  526. Zipper:=TZipper.Create;
  527. Zipper.FileName:=DestFile;
  528. try
  529. DefaultStream:=TStringStream.Create(s);
  530. Zipper.Entries.AddFileEntry(DefaultStream, ArchiveFile);
  531. Zipper.ZipAllFiles;
  532. finally
  533. DefaultStream.Free;
  534. Zipper.Free;
  535. end;
  536. UnZipper:=TUnZipper.Create;
  537. try
  538. UnZipper.FileName:=DestFile;
  539. Unzipper.Examine;
  540. if (Unzipper.Entries[0].ArchiveFileName<>ArchiveFile) then
  541. begin
  542. result:=false;
  543. writeln('TestLargeFileName failed: found filename length '+
  544. inttostr(Length(Unzipper.Entries[0].ArchiveFileName)));
  545. writeln('*'+Unzipper.Entries[0].ArchiveFileName + '*');
  546. writeln('Expected length '+inttostr(Length(ArchiveFile)));
  547. writeln('*'+ArchiveFile+'*');
  548. exit;
  549. end;
  550. finally
  551. Unzipper.Free;
  552. end;
  553. {$IFNDEF KEEPTESTFILES}
  554. try
  555. DeleteFile(DestFile);
  556. except
  557. // ignore mess
  558. end;
  559. {$ENDIF}
  560. end;
  561. function TestWindowsPath: boolean;
  562. // Zips filename in a subdirectory with a \ used as separator
  563. // Zip standard requires using /
  564. // On Linux, \ should be seen as a regular part of the filename
  565. var
  566. FileWithBackslash: string;
  567. DestFile: string;
  568. s: string = 'a';
  569. DefaultStream: TStringStream;
  570. UnZipper: TUnZipper;
  571. Zipper: TZipper;
  572. begin
  573. result:=true;
  574. FileWithBackslash:='test\afile.txt'; //on Windows, zip should handle this and internally replace \ with /
  575. // On *nix, this should just be a long file
  576. DestFile:=SysUtils.GetTempFileName('', 'TW');
  577. Zipper:=TZipper.Create;
  578. Zipper.FileName:=DestFile;
  579. try
  580. DefaultStream:=TStringStream.Create(s);
  581. Zipper.Entries.AddFileEntry(DefaultStream, FileWithBackslash);
  582. Zipper.ZipAllFiles;
  583. finally
  584. DefaultStream.Free;
  585. Zipper.Free;
  586. end;
  587. UnZipper:=TUnZipper.Create;
  588. try
  589. UnZipper.FileName:=DestFile;
  590. Unzipper.Examine;
  591. {$ifdef mswindows}
  592. if (pos('\',Unzipper.Entries[0].ArchiveFileName)>0) then
  593. begin
  594. result:=false;
  595. writeln('Failed: found \ in archive filename; expected /:');
  596. writeln('*'+Unzipper.Entries[0].ArchiveFileName+'*');
  597. exit;
  598. end;
  599. {$else}
  600. if (pos('\',Unzipper.Entries[0].ArchiveFileName)<=0) then
  601. begin
  602. result:=false;
  603. writeln('Failed: did not find / in archive filename:');
  604. writeln('*'+Unzipper.Entries[0].ArchiveFileName+'*');
  605. exit;
  606. end;
  607. {$endif}
  608. finally
  609. Unzipper.Free;
  610. end;
  611. {$IFNDEF KEEPTESTFILES}
  612. try
  613. DeleteFile(DestFile);
  614. except
  615. // ignore mess
  616. end;
  617. {$ENDIF}
  618. end;
  619. function TestLargeZip64: boolean;
  620. // Tests single zip file with large uncompressed content
  621. // which forces it to zip64 format
  622. var
  623. ArchiveFile: string;
  624. DestFile: string;
  625. ContentStream: TNullStream; //empty contents
  626. UnZipper: TUnZipper;
  627. Zipper: TZipper;
  628. begin
  629. result:=true;
  630. DestFile:=SysUtils.GetTempFileName('', 'LZ');
  631. Zipper:=TZipper.Create;
  632. Zipper.FileName:=DestFile;
  633. ArchiveFile:='HugeString.txt';
  634. ContentStream:=TNullStream.Create;
  635. // About 4Gb; content of 4 bytes+1 added
  636. ContentStream.Size:=(1+$FFFFFFFF);
  637. ContentStream.Position:=0;
  638. writeln('Buffer created');
  639. try
  640. Zipper.Entries.AddFileEntry(ContentStream, ArchiveFile);
  641. writeln('entry added');
  642. Zipper.ZipAllFiles;
  643. finally
  644. ContentStream.Free;
  645. Zipper.Free;
  646. end;
  647. UnZipper:=TUnZipper.Create;
  648. try
  649. UnZipper.FileName:=DestFile;
  650. Unzipper.Examine;
  651. if (UnZipper.Entries.Count<>1) then
  652. begin
  653. result:=false;
  654. writeln('TestLargeZip64 failed: found '+
  655. inttostr(UnZipper.Entries.Count) + ' entries; expected 1');
  656. exit;
  657. end;
  658. if (Unzipper.Entries[0].ArchiveFileName<>ArchiveFile) then
  659. begin
  660. result:=false;
  661. writeln('TestLargeZip64 failed: found filename length '+
  662. inttostr(Length(Unzipper.Entries[0].ArchiveFileName)));
  663. writeln('*'+Unzipper.Entries[0].ArchiveFileName + '*');
  664. writeln('Expected length '+inttostr(Length(ArchiveFile)));
  665. writeln('*'+ArchiveFile+'*');
  666. exit;
  667. end;
  668. finally
  669. Unzipper.Free;
  670. end;
  671. {$IFNDEF KEEPTESTFILES}
  672. try
  673. DeleteFile(DestFile);
  674. except
  675. // ignore mess
  676. end;
  677. {$ENDIF}
  678. end;
  679. var
  680. code: cardinal; //test result code: 0 for success
  681. begin
  682. code:=0;
  683. try
  684. if FileExists(ParamStr(1)) then
  685. begin
  686. writeln('');
  687. writeln('Started investigating file '+ParamStr(1));
  688. ShowZipFile(ParamStr(1));
  689. writeln('Finished investigating file '+ParamStr(1));
  690. writeln('');
  691. end;
  692. writeln('CompareCompressDecompress started');
  693. try
  694. if not(CompareCompressDecompress) then code:=code+2; //1 already taken by callback handler
  695. except
  696. On E: Exception do
  697. begin
  698. writeln('Exception: '+E.Message);
  699. code:=code+2;
  700. end;
  701. end;
  702. writeln('CompareCompressDecompress finished');
  703. writeln('');
  704. writeln('CompressSmallStreams started');
  705. try
  706. if not(CompressSmallStreams) then code:=code+4;
  707. except
  708. On E: Exception do
  709. begin
  710. writeln('Exception: '+E.Message);
  711. code:=code+4;
  712. end;
  713. end;
  714. writeln('CompressSmallStreams finished');
  715. writeln('');
  716. writeln('TestZipEntries(2) started');
  717. try
  718. if not(TestZipEntries(2)) then code:=code+8;
  719. except
  720. On E: Exception do
  721. begin
  722. writeln('Exception: '+E.Message);
  723. code:=code+8;
  724. end;
  725. end;
  726. writeln('TestZipEntries(2) finished');
  727. writeln('');
  728. writeln('TestLargeFileName started');
  729. try
  730. if not(TestLargeFileName) then code:=code+16;
  731. except
  732. On E: Exception do
  733. begin
  734. writeln('Exception: '+E.Message);
  735. code:=code+16;
  736. end;
  737. end;
  738. writeln('TestLargeFileName finished');
  739. writeln('');
  740. writeln('TestWindowsPath started');
  741. try
  742. if not(TestWindowsPath) then code:=code+32;
  743. except
  744. On E: Exception do
  745. begin
  746. writeln('Exception: '+E.Message);
  747. code:=code+32;
  748. end;
  749. end;
  750. writeln('TestWindowsPath finished');
  751. writeln('');
  752. writeln('TestEmptyZipEntries(10) started');
  753. // Run testemptyzipentries with a small number to test the test itself... as
  754. // well as zip structure generated with empty files.
  755. try
  756. if not(TestEmptyZipEntries(10)) then code:=code+64;
  757. except
  758. On E: Exception do
  759. begin
  760. writeln('Exception: '+E.Message);
  761. code:=code+64;
  762. end;
  763. end;
  764. writeln('TestEmptyZipEntries(10) finished');
  765. writeln('');
  766. writeln('SaveToFileTest started');
  767. try
  768. if not(SaveToFileTest) then code:=code+128;
  769. except
  770. On E: Exception do
  771. begin
  772. writeln('Exception: '+E.Message);
  773. code:=code+128;
  774. end;
  775. end;
  776. writeln('SaveToFileTest finished');
  777. writeln('');
  778. writeln('TestEmptyZipEntries(65537) started');
  779. writeln('(note: this will take a long time)');
  780. {Note: tested tools with this file:
  781. - info-zip unzip 6.0
  782. - Ionic's DotNetZip library unzip.exe utility verison 1.9.1.8 works
  783. - 7zip's 7za 9.22 beta works.
  784. }
  785. try
  786. if not(TestEmptyZipEntries(65537)) then code:=code+256;
  787. except
  788. On E: Exception do
  789. begin
  790. writeln('Exception: '+E.Message);
  791. code:=code+256;
  792. end;
  793. end;
  794. writeln('TestEmptyZipEntries(65537) finished');
  795. writeln('');
  796. { This test will take a very long time as it tries to zip a 4Gb memory block.
  797. It is therefore commented out by default }
  798. {
  799. writeln('TestLargeZip64 - started');
  800. if not(TestLargeZip64) then code:=code+thefollowingstatuscode;
  801. writeln('TestLargeZip64 format - finished');
  802. writeln('');
  803. }
  804. except
  805. on E: Exception do
  806. begin
  807. writeln('');
  808. writeln('Exception: ');
  809. writeln(E.Message);
  810. writeln('');
  811. if code=0 then code:=maxint; //more or less random error code
  812. end;
  813. end;
  814. if code=0 then
  815. writeln('Basic zip/unzip tests passed: code '+inttostr(code))
  816. else
  817. writeln('Basic zip/unzip tests failed: code '+inttostr(code));
  818. Halt(code);
  819. end.