unzipdll.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232
  1. {
  2. $Id$
  3. }
  4. unit UnzipDLL;
  5. {$IFDEF VIRTUALPASCAL}
  6. {$Cdecl+,AlignRec-,OrgName+}
  7. {$ELSE}
  8. {$IFDEF FPC}
  9. {$PACKRECORDS 1}
  10. {$ENDIF}
  11. {$ENDIF}
  12. interface
  13. const
  14. {$IFDEF OS2}
  15. AllFiles: string [1] = '*';
  16. {$ELSE}
  17. AllFiles: string [3] = '*.*';
  18. {$ENDIF}
  19. UnzipErr: longint = 0;
  20. type
  21. TArgV = array [0..1024] of PChar;
  22. PArgV = ^TArgV;
  23. TCharArray = array [1..1024*1024] of char;
  24. PCharArray = ^TCharArray;
  25. function FileUnzipEx (SourceZipFile, TargetDirectory,
  26. FileSpecs: PChar): integer;
  27. (* Returns non-zero result on success. *)
  28. implementation
  29. uses
  30. {$IFDEF OS2}
  31. {$IFDEF FPC}
  32. DosCalls,
  33. {$ELSE FPC}
  34. {$IFDEF VirtualPascal}
  35. OS2Base,
  36. {$ELSE VirtualPascal}
  37. BseDos,
  38. {$ENDIF VirtualPascal}
  39. {$ENDIF FPC}
  40. {$ELSE}
  41. {$IFDEF WIN32}
  42. Windows,
  43. {$ENDIF WIN32}
  44. {$ENDIF OS2}
  45. Dos;
  46. type
  47. UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint; cdecl;
  48. const
  49. {$IFDEF OS2}
  50. LibPath = 'LIBPATH';
  51. {$ELSE}
  52. LibPath = 'PATH';
  53. {$ENDIF}
  54. UzpMainOrd = 4;
  55. DLLName: string [8] = 'UNZIP32'#0;
  56. UzpMain: UzpMainFunc = nil;
  57. QuiteOpt: array [1..4] of char = '-qq'#0;
  58. OverOpt: array [1..3] of char = '-o'#0;
  59. CaseInsOpt: array [1..3] of char = '-C'#0;
  60. ExDirOpt: array [1..3] of char = '-d'#0;
  61. OptCount = 4;
  62. var
  63. DLLHandle: longint;
  64. OldExit: pointer;
  65. function DLLInit: boolean;
  66. var
  67. {$IFDEF OS2}
  68. ErrPath: array [0..259] of char;
  69. {$ENDIF}
  70. DLLPath: PathStr;
  71. Dir: DirStr;
  72. Name: NameStr;
  73. Ext: ExtStr;
  74. begin
  75. DLLInit := false;
  76. FSplit (FExpand (ParamStr (0)), Dir, Name, Ext);
  77. DLLPath := Dir + DLLName;
  78. Insert ('.DLL', DLLPath, byte (DLLPath [0]));
  79. {$IFDEF OS2}
  80. if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0)
  81. and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0)
  82. then
  83. begin
  84. if ErrPath [0] <> #0 then
  85. begin
  86. Write (#13#10'Error while loading module ');
  87. WriteLn (PChar (@ErrPath));
  88. end;
  89. end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0;
  90. {$ELSE}
  91. {$IFDEF WIN32}
  92. DLLHandle := LoadLibrary (@DLLPath [1]);
  93. if DLLHandle = 0 then DLLHandle := LoadLibrary (@DLLName [1]);
  94. if DLLHandle = 0 then WriteLn (#13#10'Error while loading DLL.') else
  95. begin
  96. (* UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'UzpMain'));
  97. *)
  98. UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'Unz_Unzip'));
  99. DLLInit := Assigned (UzpMain);
  100. end;
  101. {$ENDIF}
  102. {$ENDIF}
  103. end;
  104. procedure NewExit;
  105. begin
  106. ExitProc := OldExit;
  107. {$IFDEF OS2}
  108. DosFreeModule (DLLHandle);
  109. {$ELSE}
  110. {$IFDEF WIN32}
  111. FreeLibrary (DLLHandle);
  112. {$ENDIF}
  113. {$ENDIF}
  114. end;
  115. function FileUnzipEx (SourceZipFile, TargetDirectory,
  116. FileSpecs: PChar): integer;
  117. var
  118. I, FCount, ArgC: longint;
  119. ArgV: TArgV;
  120. P: PChar;
  121. StrLen: array [Succ (OptCount)..1024] of longint;
  122. begin
  123. ArgV [0] := @DLLName;
  124. ArgV [1] := @QuiteOpt;
  125. ArgV [2] := @OverOpt;
  126. ArgV [3] := @CaseInsOpt;
  127. ArgV [4] := SourceZipFile;
  128. FCount := 0;
  129. if FileSpecs^ <> #0 then
  130. begin
  131. P := FileSpecs;
  132. I := 0;
  133. repeat
  134. case FileSpecs^ of
  135. '"': begin
  136. Inc (FileSpecs);
  137. repeat Inc (I) until (FileSpecs^ = '"') or (FileSpecs^ = #0);
  138. Inc (FileSpecs);
  139. Inc (I);
  140. end;
  141. '''': begin
  142. Inc (FileSpecs);
  143. repeat Inc (I) until (FileSpecs^ = '''') or (FileSpecs^ = #0);
  144. Inc (FileSpecs);
  145. Inc (I);
  146. end;
  147. #0, ' ', #9: begin
  148. Inc (I);
  149. Inc (FCount);
  150. GetMem (ArgV [OptCount + FCount], I);
  151. Move (P^, ArgV [OptCount + FCount]^, Pred (I));
  152. PCharArray (ArgV [OptCount + FCount])^ [I] := #0;
  153. StrLen [OptCount + FCount] := I;
  154. while (FileSpecs^ = #9) or (FileSpecs^ = ' ') do Inc (FileSpecs);
  155. P := FileSpecs;
  156. I := 0;
  157. end;
  158. else
  159. begin
  160. Inc (I);
  161. Inc (FileSpecs);
  162. end;
  163. end;
  164. until (FileSpecs^ = #0) and (I = 0);
  165. end else
  166. begin
  167. FCount := 1;
  168. StrLen [OptCount + FCount] := Succ (byte (AllFiles [0]));
  169. GetMem (ArgV [OptCount + FCount], StrLen [OptCount + FCount]);
  170. Move (AllFiles [1], ArgV [OptCount + FCount]^, StrLen [OptCount + FCount]);
  171. end;
  172. ArgC := Succ (FCount + OptCount);
  173. ArgV [ArgC] := @ExDirOpt;
  174. Inc (ArgC);
  175. ArgV [ArgC] := TargetDirectory;
  176. Inc (ArgC);
  177. ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *)
  178. UnzipErr := UzpMain (ArgC, ArgV);
  179. if UnzipErr <> 0 then FileUnzipEx := 0 else FileUnzipEx := FCount;
  180. for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
  181. end;
  182. begin
  183. if DLLInit then
  184. begin
  185. OldExit := ExitProc;
  186. ExitProc := @NewExit;
  187. end else
  188. begin
  189. WriteLn (#13#10'Dynamic library UNZIP32.DLL from InfoZip is needed to install.');
  190. WriteLn ('This library could not be found on your system, however.');
  191. WriteLn ('Please, download the library, either from the location where you found');
  192. WriteLn ('this installer, or from any FTP archive carrying InfoZip programs.');
  193. WriteLn ('If you have this DLL on your disk, please, check your configuration (' + LIBPATH + ').');
  194. Halt (255);
  195. end;
  196. end.
  197. {
  198. $Log$
  199. Revision 1.1 2000-07-13 06:30:22 michael
  200. + Initial import
  201. Revision 1.5 2000/06/18 18:27:32 hajny
  202. + archive validity checking, progress indicator, better error checking
  203. Revision 1.4 2000/06/13 16:21:36 hajny
  204. * Win32 support corrected/completed
  205. Revision 1.3 2000/03/05 17:57:08 hajny
  206. + added support for Win32 (untested)
  207. Revision 1.2 1999/06/10 07:28:29 hajny
  208. * compilable with TP again
  209. Revision 1.1 1999/02/19 16:45:26 peter
  210. * moved to fpinst/ directory
  211. + makefile
  212. }