unzipdll.pas 5.1 KB

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