1{
2}
3unit UnzipDLL;
4
5{$IFDEF VIRTUALPASCAL}
6{$Cdecl+,AlignRec-,OrgName+}
7{$ELSE}
8 {$IFDEF FPC}
9  {$PACKRECORDS 1}
10 {$ENDIF}
11{$ENDIF}
12
13interface
14
15uses
16 ZipTypes;
17
18const
19 UnzipErr: longint = 0;
20
21type
22 TArgV = array [0..1023] of PChar;
23 PArgV = ^TArgV;
24 TCharArray = array [1..1024*1024] of char;
25 PCharArray = ^TCharArray;
26 TFileUnzipEx = function (SourceZipFile, TargetDirectory,
27                                                    FileSpecs: PChar): integer;
28
29function DllFileUnzipEx (SourceZipFile, TargetDirectory,
30                                                    FileSpecs: PChar): integer;
31
32const
33 FileUnzipEx: TFileUnzipEx = @DllFileUnzipEx;
34
35(* Returns non-zero result on success. *)
36
37implementation
38
39uses
40{$IFDEF OS2}
41 {$IFDEF FPC}
42     DosCalls,
43 {$ELSE FPC}
44  {$IFDEF VirtualPascal}
45     OS2Base,
46  {$ELSE VirtualPascal}
47     BseDos,
48  {$ENDIF VirtualPascal}
49 {$ENDIF FPC}
50{$ELSE}
51 {$IFDEF WIN32}
52     Windows,
53 {$ENDIF WIN32}
54{$ENDIF OS2}
55 Unzip51g, Dos;
56
57type
58 UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint; cdecl;
59
60const
61{$IFDEF OS2}
62 AllFiles: string [1] = '*';
63{$ELSE}
64 {$IFDEF WIN32}
65 AllFiles: string [3] = '*.*';
66 {$ENDIF}
67{$ENDIF}
68{$IFDEF OS2}
69 LibPath = 'LIBPATH';
70{$ELSE}
71 LibPath = 'PATH';
72{$ENDIF}
73 UzpMainOrd = 4;
74 DLLName: string [8] = 'UNZIP32'#0;
75 UzpMain: UzpMainFunc = nil;
76 QuietOpt: array [1..4] of char = '-qq'#0;
77 OverOpt: array [1..3] of char = '-o'#0;
78 CaseInsOpt: array [1..3] of char = '-C'#0;
79 ExDirOpt: array [1..3] of char = '-d'#0;
80 OptCount = 4;
81
82var
83 DLLHandle: longint;
84 OldExit: pointer;
85 C: char;
86
87function DLLInit: boolean;
88var
89{$IFDEF OS2}
90 ErrPath: array [0..259] of char;
91{$ENDIF}
92 DLLPath: PathStr;
93 Dir: DirStr;
94 Name: NameStr;
95 Ext: ExtStr;
96begin
97 DLLInit := false;
98 FSplit (FExpand (ParamStr (0)), Dir, Name, Ext);
99 DLLPath := Dir + DLLName;
100 Insert ('.DLL', DLLPath, byte (DLLPath [0]));
101{$IFDEF OS2}
102 if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0)
103 and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0)
104                                                                           then
105 begin
106  if ErrPath [0] <> #0 then
107  begin
108   Write (#13#10'Error while loading module ');
109   WriteLn (PChar (@ErrPath));
110  end;
111 {$IFDEF FPC}
112 end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, pointer (UzpMain)) = 0;
113 {$ELSE}
114 end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0;
115 {$ENDIF}
116{$ELSE}
117 {$IFDEF WIN32}
118 DLLHandle := LoadLibrary (@DLLPath [1]);
119 if DLLHandle = 0 then DLLHandle := LoadLibrary (@DLLName [1]);
120 if DLLHandle = 0 then WriteLn (#13#10'Error while loading DLL.') else
121 begin
122(*  UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'UzpMain'));
123*)
124  UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'Unz_Unzip'));
125  DLLInit := Assigned (UzpMain);
126 end;
127 {$ENDIF}
128{$ENDIF}
129end;
130
131procedure NewExit;
132begin
133 ExitProc := OldExit;
134{$IFDEF OS2}
135 DosFreeModule (DLLHandle);
136{$ELSE}
137 {$IFDEF WIN32}
138 FreeLibrary (DLLHandle);
139 {$ENDIF}
140{$ENDIF}
141end;
142
143function DllFileUnzipEx (SourceZipFile, TargetDirectory,
144                                                    FileSpecs: PChar): integer;
145var
146 I, FCount, ArgC: longint;
147 ArgV: TArgV;
148 P: PChar;
149 StrLen: array [Succ (OptCount)..1023] of longint;
150begin
151 ArgV [0] := @DLLName;
152 ArgV [1] := @QuietOpt;
153 ArgV [2] := @OverOpt;
154 ArgV [3] := @CaseInsOpt;
155 ArgV [4] := SourceZipFile;
156 FCount := 0;
157 if FileSpecs^ <> #0 then
158 begin
159  P := FileSpecs;
160  I := 0;
161  repeat
162   case FileSpecs^ of
163    '"': begin
164          Inc (FileSpecs);
165          repeat Inc (I) until (FileSpecs^ = '"') or (FileSpecs^ = #0);
166          Inc (FileSpecs);
167          Inc (I);
168         end;
169    '''':  begin
170            Inc (FileSpecs);
171            repeat Inc (I) until (FileSpecs^ = '''') or (FileSpecs^ = #0);
172            Inc (FileSpecs);
173            Inc (I);
174           end;
175    #0, ' ', #9: begin
176                  Inc (I);
177                  Inc (FCount);
178                  GetMem (ArgV [OptCount + FCount], I);
179                  Move (P^, ArgV [OptCount + FCount]^, Pred (I));
180                  PCharArray (ArgV [OptCount + FCount])^ [I] := #0;
181                  StrLen [OptCount + FCount] := I;
182                  while (FileSpecs^ = #9) or (FileSpecs^ = ' ') do Inc (FileSpecs);
183                  P := FileSpecs;
184                  I := 0;
185                 end;
186    else
187    begin
188     Inc (I);
189     Inc (FileSpecs);
190    end;
191   end;
192  until (FileSpecs^ = #0) and (I = 0);
193 end else
194 begin
195  FCount := 1;
196  StrLen [OptCount + FCount] := Succ (byte (AllFiles [0]));
197  GetMem (ArgV [OptCount + FCount], StrLen [OptCount + FCount]);
198  Move (AllFiles [1], ArgV [OptCount + FCount]^, StrLen [OptCount + FCount]);
199 end;
200 ArgC := Succ (FCount + OptCount);
201 ArgV [ArgC] := @ExDirOpt;
202 Inc (ArgC);
203 ArgV [ArgC] := TargetDirectory;
204 Inc (ArgC);
205 ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *)
206 UnzipErr := UzpMain (ArgC, ArgV);
207 if UnzipErr <> 0 then DllFileUnzipEx := 0 else DllFileUnzipEx := FCount;
208 for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
209end;
210
211begin
212{$IFDEF EMX}
213 if os_Mode <> osOS2 then
214  FileUnzipEx := TFileUnzipEx (@Unzip51g.FileUnzipEx)
215 else
216{$ENDIF EMX}
217 if DLLInit then
218 begin
219  OldExit := ExitProc;
220  ExitProc := @NewExit;
221  if GetEnv ('TZ') = '' then
222  begin
223   WriteLn (#13#10'TZ variable was not found in your environment.');
224   WriteLn ('This variable is necessary for setting correct date/time of unpacked files.');
225   WriteLn ('Please, add it to your environment and restart this program afterwards.');
226   Halt (1);
227  end;
228 end else
229 begin
230  WriteLn (#13#10'Dynamic library UNZIP32.DLL from InfoZip is needed to unpack archives.');
231  WriteLn ('This library could not be found on your system, however.');
232  WriteLn ('Please, download the library, either from the location where you found');
233  WriteLn ('this package, or from any FTP archive carrying InfoZip programs.');
234  WriteLn ('If you already have this DLL, please, check your configuration (' + LibPath + ').');
235  WriteLn (#13#10'If you want to try unpacking the files with internal unpacking routine,');
236  WriteLn ('answer the following question with Y. However, this might not work correctly');
237  WriteLn ('under some conditions (e.g. for long names and drives not supporting them).');
238  Write (#13#10'Do you want to continue now (y/N)? ');
239  ReadLn (C);
240  if UpCase (C) = 'Y' then FileUnzipEx := TFileUnzipEx (@Unzip51g.FileUnzipEx) else Halt (255);
241 end;
242end.
243