Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 1 | unit ZMDllLoad19; |
2 | |||
3 | (* |
||
4 | ZMDLLLoad19.pas - Dynamically load the DLL |
||
5 | Copyright (C) 2009, 2010 by Russell J. Peters, Roger Aelbrecht, |
||
6 | Eric W. Engler and Chris Vleghert. |
||
7 | |||
8 | This file is part of TZipMaster Version 1.9. |
||
9 | |||
10 | TZipMaster is free software: you can redistribute it and/or modify |
||
11 | it under the terms of the GNU Lesser General Public License as published by |
||
12 | the Free Software Foundation, either version 3 of the License, or |
||
13 | (at your option) any later version. |
||
14 | |||
15 | TZipMaster is distributed in the hope that it will be useful, |
||
16 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
||
17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||
18 | GNU Lesser General Public License for more details. |
||
19 | |||
20 | You should have received a copy of the GNU Lesser General Public License |
||
21 | along with TZipMaster. If not, see <http://www.gnu.org/licenses/>. |
||
22 | |||
23 | contact: problems@delphizip.org (include ZipMaster in the subject). |
||
24 | updates: http://www.delphizip.org |
||
25 | DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip |
||
26 | |||
27 | modified 2009-09-22 |
||
28 | --------------------------------------------------------------------------- *) |
||
29 | |||
30 | interface |
||
31 | |||
32 | uses |
||
33 | Classes, Windows, ZMDelZip19, ZMWrkr19; |
||
34 | |||
35 | procedure _DLL_Abort(worker: TZMWorker; key: Cardinal); |
||
36 | function _DLL_Banner: String; |
||
37 | function _DLL_Build: Integer; |
||
38 | function _DLL_Exec(worker: TZMWorker; const Rec: pDLLCommands; |
||
39 | var key: Cardinal): Integer; |
||
40 | function _DLL_Load(worker: TZMWorker): Integer; |
||
41 | function _DLL_Loaded(worker: TZMWorker): Boolean; |
||
42 | function _DLL_Path: String; |
||
43 | procedure _DLL_Remove(worker: TZMWorker); |
||
44 | procedure _DLL_Unload(worker: TZMWorker); |
||
45 | |||
46 | implementation |
||
47 | |||
48 | {$I '.\ZMConfig19.inc'} |
||
49 | |||
50 | uses |
||
51 | SysUtils, ZipMstr19, ZMCompat19, ZMXcpt19, |
||
52 | {$IFNDEF STATIC_LOAD_DELZIP_DLL} |
||
53 | ZMCore19, ZMExtrLZ7719, ZMUtils19, ZMDLLOpr19, SyncObjs, |
||
54 | {$ENDIF} |
||
55 | ZMMsg19; |
||
56 | |||
57 | procedure CheckExec(RetVal: Integer); |
||
58 | var |
||
59 | x: Integer; |
||
60 | begin |
||
61 | if RetVal < 0 then |
||
62 | begin |
||
63 | x := -RetVal; |
||
64 | if x > _DZ_ERR_MAX then |
||
65 | raise EZipMaster.CreateResInt(GE_DLLCritical, x); |
||
66 | if (x = _DZ_ERR_CANCELLED) or (x = _DZ_ERR_ABORT) then |
||
67 | x := DS_Canceled |
||
68 | else |
||
69 | x := x + DZ_RES_GOOD; |
||
70 | raise EZipMaster.CreateResDisp(x, True); |
||
71 | end; |
||
72 | end; |
||
73 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
74 | // 'static' loaded dll functions |
||
75 | function DZ_Abort(C: Cardinal): Integer; STDCALL; EXTERNAL DelZipDLL_Name |
||
76 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
77 | function DZ_Path: pChar; STDCALL; EXTERNAL DelZipDLL_Name |
||
78 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
79 | function DZ_PrivVersion: Integer; STDCALL; EXTERNAL DelZipDLL_Name |
||
80 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
81 | function DZ_Exec(C: pDLLCommands): Integer; STDCALL; EXTERNAL DelZipDLL_Name |
||
82 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
83 | function DZ_Version: Integer; STDCALL; EXTERNAL DelZipDLL_Name |
||
84 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
85 | function DZ_Banner: pChar; STDCALL; EXTERNAL DelZipDLL_Name |
||
86 | {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
87 | function DZ_Name(var buf; bufsiz: Integer; wide: Boolean): Integer; STDCALL; |
||
88 | external DelZipDLL_Name {$IFDEF VERD2010up} Delayed {$ENDIF}; |
||
89 | {$ELSE} |
||
90 | |||
91 | type |
||
92 | TZMCount = record |
||
93 | worker: TZMWorker; |
||
94 | Count: Integer; |
||
95 | end; |
||
96 | |||
97 | type |
||
98 | TZMDLLLoader = class(TObject) |
||
99 | private |
||
100 | AbortFunc: TAbortOperationFunc; |
||
101 | BannerFunc: TDLLBannerFunc; |
||
102 | Counts: array of TZMCount; |
||
103 | ExecFunc: TDLLExecFunc; |
||
104 | fBanner: String; |
||
105 | fHasResDLL: Integer; |
||
106 | fKillTemp: Boolean; |
||
107 | fLoadErr: Integer; |
||
108 | fLoading: Integer; |
||
109 | fLoadPath: String; |
||
110 | fPath: String; |
||
111 | fVer: Integer; |
||
112 | // guard data for access by several threads |
||
113 | Guard: TCriticalSection; |
||
114 | hndl: HWND; |
||
115 | NameFunc: TDLLNameFunc; |
||
116 | PathFunc: TDLLPathFunc; |
||
117 | Priv: Integer; |
||
118 | PrivFunc: TDLLPrivVersionFunc; |
||
119 | TmpFileName: String; |
||
120 | VersFunc: TDLLVersionFunc; |
||
121 | function GetIsLoaded: Boolean; |
||
122 | function LoadLib(worker: TZMWorker; FullPath: String; MustExist: Boolean) |
||
123 | : Integer; |
||
124 | procedure ReleaseLib; |
||
125 | procedure RemoveTempDLL; |
||
126 | protected |
||
127 | function Counts_Dec(worker: TZMWorker): Integer; |
||
128 | function Counts_Find(worker: TZMWorker): Integer; |
||
129 | function Counts_Inc(worker: TZMWorker): Integer; |
||
130 | procedure Empty; |
||
131 | function ExtractResDLL(worker: TZMWorker; OnlyVersion: Boolean): Integer; |
||
132 | function LoadDLL(worker: TZMWorker): Integer; |
||
133 | function UnloadDLL: Integer; |
||
134 | property IsLoaded: Boolean Read GetIsLoaded; |
||
135 | public |
||
136 | procedure Abort(worker: TZMWorker; key: Cardinal); |
||
137 | procedure AfterConstruction; override; |
||
138 | function Banner: String; |
||
139 | procedure BeforeDestruction; override; |
||
140 | function Build: Integer; |
||
141 | function Exec(worker: TZMWorker; const Rec: pDLLCommands; var key: Cardinal) |
||
142 | : Integer; |
||
143 | function Load(worker: TZMWorker): Integer; |
||
144 | function Loaded(worker: TZMWorker): Boolean; |
||
145 | function Path: String; |
||
146 | procedure Remove(worker: TZMWorker); |
||
147 | procedure Unload(worker: TZMWorker); |
||
148 | property Ver: Integer Read fVer; |
||
149 | end; |
||
150 | |||
151 | const |
||
152 | MINDLLBUILD = DELZIPVERSION * 10000; |
||
153 | RESVER_UNTRIED = -99; // have not looked for resdll yet |
||
154 | RESVER_NONE = -1; // not available |
||
155 | RESVER_BAD = 0; // was bad copy/version |
||
156 | // const |
||
157 | MIN_RESDLL_SIZE = 50000; |
||
158 | MAX_RESDLL_SIZE = 600000; |
||
159 | |||
160 | var |
||
161 | G_LoadedDLL: TZMDLLLoader = nil; |
||
162 | |||
163 | procedure TZMDLLLoader.Abort(worker: TZMWorker; key: Cardinal); |
||
164 | begin |
||
165 | if Loaded(worker) and (hndl <> 0) then |
||
166 | AbortFunc(key); |
||
167 | end; |
||
168 | |||
169 | procedure TZMDLLLoader.AfterConstruction; |
||
170 | begin |
||
171 | inherited; |
||
172 | Guard := TCriticalSection.Create; |
||
173 | fKillTemp := False; |
||
174 | Empty; |
||
175 | fPath := DelZipDLL_Name; |
||
176 | TmpFileName := ''; |
||
177 | fLoading := 0; |
||
178 | fBanner := ''; |
||
179 | fHasResDLL := RESVER_UNTRIED; // unknown |
||
180 | end; |
||
181 | |||
182 | function TZMDLLLoader.Banner: String; |
||
183 | var |
||
184 | tmp: AnsiString; |
||
185 | begin |
||
186 | Result := ''; |
||
187 | if IsLoaded then |
||
188 | begin |
||
189 | tmp := BannerFunc; |
||
190 | Result := String(tmp); |
||
191 | end; |
||
192 | end; |
||
193 | |||
194 | procedure TZMDLLLoader.BeforeDestruction; |
||
195 | begin |
||
196 | if hndl <> 0 then |
||
197 | FreeLibrary(hndl); |
||
198 | Counts := nil; |
||
199 | FreeAndNil(Guard); |
||
200 | hndl := 0; |
||
201 | RemoveTempDLL; |
||
202 | inherited; |
||
203 | end; |
||
204 | |||
205 | function TZMDLLLoader.Build: Integer; |
||
206 | begin |
||
207 | Result := 0; |
||
208 | if IsLoaded then |
||
209 | Result := Priv; |
||
210 | end; |
||
211 | |||
212 | { TZMDLLLoader } |
||
213 | |||
214 | function TZMDLLLoader.Counts_Dec(worker: TZMWorker): Integer; |
||
215 | var |
||
216 | p: string; |
||
217 | keepLoaded: Boolean; |
||
218 | i: Integer; |
||
219 | begin |
||
220 | Result := -1; |
||
221 | Guard.Enter; |
||
222 | try |
||
223 | // find worker |
||
224 | i := Counts_Find(worker); |
||
225 | if i >= 0 then |
||
226 | begin |
||
227 | // found |
||
228 | Dec(Counts[i].Count); |
||
229 | Result := Counts[i].Count; |
||
230 | if Result < 1 then |
||
231 | begin |
||
232 | // not wanted - remove from list |
||
233 | Counts[i].worker := nil; |
||
234 | Counts[i].Count := 0; |
||
235 | end; |
||
236 | end; |
||
237 | // ignore unload if loading |
||
238 | if fLoading = 0 then |
||
239 | begin |
||
240 | keepLoaded := False; |
||
241 | for i := 0 to HIGH(Counts) do |
||
242 | if (Counts[i].worker <> nil) and (Counts[i].Count > 0) then |
||
243 | begin |
||
244 | keepLoaded := True; |
||
245 | break; |
||
246 | end; |
||
247 | |||
248 | if not keepLoaded then |
||
249 | begin |
||
250 | p := fPath; |
||
251 | UnloadDLL; |
||
252 | if worker.Verbosity >= zvVerbose then |
||
253 | worker.ReportMsg(LD_DLLUnloaded, [p]); |
||
254 | end; |
||
255 | end; |
||
256 | finally |
||
257 | Guard.Leave; |
||
258 | end; |
||
259 | end; |
||
260 | |||
261 | function TZMDLLLoader.Counts_Find(worker: TZMWorker): Integer; |
||
262 | var |
||
263 | i: Integer; |
||
264 | begin |
||
265 | Result := -1; |
||
266 | if Counts <> nil then |
||
267 | begin |
||
268 | for i := 0 to HIGH(Counts) do |
||
269 | begin |
||
270 | if Counts[i].worker = worker then |
||
271 | begin |
||
272 | // found |
||
273 | Result := i; |
||
274 | break; |
||
275 | end; |
||
276 | end; |
||
277 | end; |
||
278 | end; |
||
279 | |||
280 | function TZMDLLLoader.Counts_Inc(worker: TZMWorker): Integer; |
||
281 | var |
||
282 | len: Integer; |
||
283 | i: Integer; |
||
284 | loadVer: Integer; |
||
285 | begin |
||
286 | Guard.Enter; |
||
287 | try |
||
288 | // find worker |
||
289 | i := Counts_Find(worker); |
||
290 | if i >= 0 then |
||
291 | begin |
||
292 | // found |
||
293 | Inc(Counts[i].Count); |
||
294 | Result := Counts[i].Count; |
||
295 | end |
||
296 | else |
||
297 | begin |
||
298 | // need new one - any empty |
||
299 | i := Counts_Find(nil); |
||
300 | if i >= 0 then |
||
301 | begin |
||
302 | // have empty position - use it |
||
303 | Counts[i].worker := worker; |
||
304 | Counts[i].Count := 1; |
||
305 | Result := 1; |
||
306 | end |
||
307 | else |
||
308 | begin |
||
309 | // need to extend |
||
310 | len := HIGH(Counts); |
||
311 | if len > 0 then |
||
312 | Inc(len) |
||
313 | else |
||
314 | len := 0; |
||
315 | SetLength(Counts, len + 4); |
||
316 | // clear the rest |
||
317 | for i := len + 3 downto len + 1 do |
||
318 | begin |
||
319 | Counts[i].worker := nil; |
||
320 | Counts[i].Count := 0; |
||
321 | end; |
||
322 | i := len; |
||
323 | Counts[i].worker := worker; |
||
324 | Counts[i].Count := 1; |
||
325 | Result := 1; |
||
326 | end; |
||
327 | end; |
||
328 | if not IsLoaded then |
||
329 | begin |
||
330 | // avoid re-entry |
||
331 | Inc(fLoading); |
||
332 | try |
||
333 | if fLoading = 1 then |
||
334 | begin |
||
335 | try |
||
336 | loadVer := LoadDLL(worker); |
||
337 | except |
||
338 | on Ers: EZipMaster do |
||
339 | begin |
||
340 | loadVer := -1; |
||
341 | worker.ShowExceptionError(Ers); |
||
342 | end; |
||
343 | on E: Exception do |
||
344 | begin |
||
345 | loadVer := -1; |
||
346 | worker.ShowExceptionError(E); |
||
347 | end; |
||
348 | end; |
||
349 | if loadVer < DELZIPVERSION then |
||
350 | begin // could not load it - empty it (i is index for this worker) |
||
351 | Counts[i].worker := nil; |
||
352 | Counts[i].Count := 0; |
||
353 | |||
354 | if worker.Verbosity >= zvVerbose then |
||
355 | worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr) |
||
356 | , fLoadPath]); |
||
357 | Result := -1; |
||
358 | end |
||
359 | else |
||
360 | begin |
||
361 | if worker.Verbosity >= zvVerbose then |
||
362 | worker.ReportMsg(LD_DLLLoaded, [fPath]); |
||
363 | end; |
||
364 | end; |
||
365 | finally |
||
366 | Dec(fLoading); |
||
367 | end; |
||
368 | end; |
||
369 | finally |
||
370 | Guard.Leave; |
||
371 | end; |
||
372 | end; |
||
373 | |||
374 | procedure TZMDLLLoader.Empty; |
||
375 | begin |
||
376 | hndl := 0; |
||
377 | ExecFunc := nil; |
||
378 | VersFunc := nil; |
||
379 | PrivFunc := nil; |
||
380 | AbortFunc := nil; |
||
381 | NameFunc := nil; |
||
382 | PathFunc := nil; |
||
383 | BannerFunc := nil; |
||
384 | fVer := 0; |
||
385 | Priv := 0; |
||
386 | fBanner := ''; |
||
387 | end; |
||
388 | |||
389 | function TZMDLLLoader.Exec(worker: TZMWorker; const Rec: pDLLCommands; |
||
390 | var key: Cardinal): Integer; |
||
391 | begin |
||
392 | Result := -1; // what error |
||
393 | if Counts_Inc(worker) > 0 then |
||
394 | begin |
||
395 | try |
||
396 | Result := ExecFunc(Rec); |
||
397 | finally |
||
398 | Counts_Dec(worker); |
||
399 | key := 0; |
||
400 | end; |
||
401 | end; |
||
402 | end; |
||
403 | |||
404 | function TZMDLLLoader.ExtractResDLL(worker: TZMWorker; OnlyVersion: Boolean): |
||
405 | Integer; |
||
406 | var |
||
407 | fs: TFileStream; |
||
408 | rs: TResourceStream; |
||
409 | done: Boolean; |
||
410 | w: Word; |
||
411 | begin |
||
412 | done := False; |
||
413 | Result := -1; |
||
414 | fs := nil; |
||
415 | rs := nil; |
||
416 | try |
||
417 | // only check if unknown or know exists |
||
418 | if (fHasResDLL = RESVER_UNTRIED) or (fHasResDLL > MINDLLBUILD) then |
||
419 | rs := OpenResStream(DZRES_DLL, RT_RCDATA); |
||
420 | if fHasResDLL = RESVER_UNTRIED then |
||
421 | fHasResDLL := RESVER_NONE; // in case of exception |
||
422 | // read the dll version if it exists |
||
423 | if (rs <> nil) and (rs.Size > MIN_RESDLL_SIZE) and |
||
424 | (rs.Size < MAX_RESDLL_SIZE) then |
||
425 | begin |
||
426 | rs.Position := 0; |
||
427 | rs.ReadBuffer(Result, sizeof(Integer)); |
||
428 | fHasResDLL := Result; // the dll version |
||
429 | if (Result > MINDLLBUILD) and not OnlyVersion then |
||
430 | begin |
||
431 | rs.ReadBuffer(w, sizeof(Word)); |
||
432 | rs.Position := sizeof(Integer); |
||
433 | TmpFileName := worker.MakeTempFileName('DZ_', '.dll'); |
||
434 | if TmpFileName = '' then |
||
435 | raise EZipMaster.CreateResDisp(DS_NoTempFile, True); |
||
436 | fs := TFileStream.Create(TmpFileName, fmCreate); |
||
437 | if w = IMAGE_DOS_SIGNATURE then |
||
438 | done := fs.CopyFrom(rs, rs.Size - sizeof(Integer)) = |
||
439 | (rs.Size - sizeof(Integer)) |
||
440 | else |
||
441 | done := LZ77Extract(fs, rs, rs.Size - sizeof(Integer)) = 0; |
||
442 | |||
443 | if not done then |
||
444 | fHasResDLL := RESVER_BAD; // could not extract |
||
445 | end; |
||
446 | end; |
||
447 | finally |
||
448 | FreeAndNil(fs); |
||
449 | FreeAndNil(rs); |
||
450 | if not OnlyVersion then |
||
451 | begin |
||
452 | if (not done) and FileExists(TmpFileName) then |
||
453 | DeleteFile(TmpFileName); |
||
454 | if not FileExists(TmpFileName) then |
||
455 | TmpFileName := ''; |
||
456 | end; |
||
457 | end; |
||
458 | end; |
||
459 | |||
460 | function TZMDLLLoader.GetIsLoaded: Boolean; |
||
461 | begin |
||
462 | Result := hndl <> 0; |
||
463 | end; |
||
464 | |||
465 | function TZMDLLLoader.Load(worker: TZMWorker): Integer; |
||
466 | begin |
||
467 | Result := 0; |
||
468 | if Counts_Inc(worker) > 0 then |
||
469 | Result := G_LoadedDLL.Ver; |
||
470 | end; |
||
471 | |||
472 | function TZMDLLLoader.LoadDLL(worker: TZMWorker): Integer; |
||
473 | var |
||
474 | AllowResDLL: Boolean; |
||
475 | FullPath: String; |
||
476 | DBuild: Integer; |
||
477 | DLLDirectory: String; |
||
478 | dpth: string; |
||
479 | begin |
||
480 | if hndl = 0 then |
||
481 | begin |
||
482 | fVer := 0; |
||
483 | FullPath := ''; |
||
484 | DLLDirectory := DelimitPath(TZMDLLOpr(worker).DLLDirectory, False); |
||
485 | if DLLDirectory = '><' then |
||
486 | begin |
||
487 | // use res dll (or else) |
||
488 | if (TmpFileName <> '') or (ExtractResDLL(worker, False) > MINDLLBUILD{MIN_RESDLL_SIZE}) then |
||
489 | LoadLib(worker, TmpFileName, True); |
||
490 | Result := fVer; |
||
491 | exit; |
||
492 | end; |
||
493 | if DLLDirectory <> '' then |
||
494 | begin |
||
495 | // check relative? |
||
496 | if DLLDirectory[1] = '.' then |
||
497 | FullPath := PathConcat(ExtractFilePath(ParamStr(0)), DLLDirectory) |
||
498 | else |
||
499 | FullPath := DLLDirectory; |
||
500 | if (ExtractNameOfFile(DLLDirectory) <> '') and |
||
501 | (CompareText(ExtractFileExt(DLLDirectory), '.DLL') = 0) then |
||
502 | begin |
||
503 | // must load the named dll |
||
504 | LoadLib(worker, FullPath, True); |
||
505 | Result := fVer; |
||
506 | exit; |
||
507 | end; |
||
508 | dpth := ExtractFilePath(FullPath); |
||
509 | if (dpth <> '') and not DirExists(dpth) then |
||
510 | FullPath := ''; |
||
511 | end; |
||
512 | AllowResDLL := DLLDirectory = ''; // only if no path specified |
||
513 | // DBuild := MINDLLBUILD;//0; |
||
514 | if AllowResDLL then |
||
515 | begin |
||
516 | // check for res dll once only |
||
517 | if fHasResDLL = RESVER_UNTRIED then |
||
518 | ExtractResDLL(worker, True); // read the res dll version if it exists |
||
519 | if fHasResDLL < MINDLLBUILD then |
||
520 | AllowResDLL := False; // none or bad version |
||
521 | end; |
||
522 | DBuild := LoadLib(worker, PathConcat(FullPath, DelZipDLL_Name), not AllowResDLL); |
||
523 | // if not loaded we only get here if allowResDLL is true; |
||
524 | if DBuild < MINDLLBUILD then |
||
525 | begin |
||
526 | // use resdll if no other available |
||
527 | if (TmpFileName <> '') or (ExtractResDLL(worker, False) > 0) then |
||
528 | begin |
||
529 | if LoadLib(worker, TmpFileName, False) < MINDLLBUILD then |
||
530 | begin |
||
531 | // could not load the res dll |
||
532 | fHasResDLL := RESVER_BAD; // is bad version |
||
533 | end; |
||
534 | end; |
||
535 | end; |
||
536 | end; |
||
537 | Result := fVer; |
||
538 | // if (Result > 0) and (worker.Verbosity >= zvVerbose) then |
||
539 | // worker.ReportMsg(LD_DLLLoaded,[fPath]); |
||
540 | end; |
||
541 | |||
542 | function TZMDLLLoader.Loaded(worker: TZMWorker): Boolean; |
||
543 | var |
||
544 | i: Integer; |
||
545 | begin |
||
546 | Result := False; |
||
547 | i := Counts_Find(worker); |
||
548 | if (i >= 0) and (Counts[i].Count > 0) then |
||
549 | Result := True; |
||
550 | end; |
||
551 | |||
552 | // returns build |
||
553 | function TZMDLLLoader.LoadLib(worker: TZMWorker; FullPath: String; |
||
554 | MustExist: Boolean): Integer; |
||
555 | var |
||
556 | oldMode: Cardinal; |
||
557 | tmp: AnsiString; |
||
558 | begin |
||
559 | if hndl > 0 then |
||
560 | FreeLibrary(hndl); |
||
561 | Empty; |
||
562 | fLoadErr := 0; |
||
563 | fLoadPath := FullPath; |
||
564 | oldMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOGPFAULTERRORBOX); |
||
565 | try |
||
566 | hndl := LoadLibrary(pChar(FullPath)); |
||
567 | if hndl > HInstance_Error then |
||
568 | begin |
||
569 | @ExecFunc := GetProcAddress(hndl, DelZipDLL_Execfunc); |
||
570 | if (@ExecFunc <> nil) then |
||
571 | @VersFunc := GetProcAddress(hndl, DelZipDLL_Versfunc); |
||
572 | if (@VersFunc <> nil) then |
||
573 | @PrivFunc := GetProcAddress(hndl, DelZipDLL_Privfunc); |
||
574 | if (@PrivFunc <> nil) then |
||
575 | @AbortFunc := GetProcAddress(hndl, DelZipDLL_Abortfunc); |
||
576 | if (@AbortFunc <> nil) then |
||
577 | @NameFunc := GetProcAddress(hndl, DelZipDLL_Namefunc); |
||
578 | if (@NameFunc <> nil) then |
||
579 | @BannerFunc := GetProcAddress(hndl, DelZipDLL_Bannerfunc); |
||
580 | if (@BannerFunc <> nil) then |
||
581 | @PathFunc := GetProcAddress(hndl, DelZipDLL_Pathfunc); |
||
582 | end |
||
583 | else |
||
584 | fLoadErr := GetLastError; |
||
585 | finally |
||
586 | SetErrorMode(oldMode); |
||
587 | end; |
||
588 | if hndl <= HInstance_Error then |
||
589 | begin |
||
590 | Empty; |
||
591 | if MustExist then |
||
592 | begin |
||
593 | if worker.Verbosity >= zvVerbose then |
||
594 | worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr), |
||
595 | fLoadPath]); |
||
596 | raise EZipMaster.CreateResStr(LD_NoDLL, FullPath); |
||
597 | end; |
||
598 | Result := 0; |
||
599 | exit; |
||
600 | end; |
||
601 | if (@BannerFunc <> nil) then |
||
602 | begin |
||
603 | Priv := PrivFunc; |
||
604 | fVer := VersFunc; |
||
605 | SetLength(fPath, MAX_PATH + 1); |
||
606 | {$IFDEF UNICODE} |
||
607 | NameFunc(fPath[1], MAX_PATH, True); |
||
608 | {$ELSE} |
||
609 | NameFunc(fPath[1], MAX_PATH, False); |
||
610 | {$ENDIF} |
||
611 | fPath := String(pChar(fPath)); |
||
612 | tmp := BannerFunc; |
||
613 | fBanner := String(tmp); |
||
614 | end; |
||
615 | if (fVer < DELZIPVERSION) or (fVer > 300) then |
||
616 | begin |
||
617 | FullPath := fPath; |
||
618 | FreeLibrary(hndl); |
||
619 | Empty; |
||
620 | if MustExist then |
||
621 | begin |
||
622 | if worker.Verbosity >= zvVerbose then |
||
623 | worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr), |
||
624 | fLoadPath]); |
||
625 | raise EZipMaster.CreateResStr(LD_NoDLL, FullPath); |
||
626 | end; |
||
627 | end; |
||
628 | Result := Priv; |
||
629 | end; |
||
630 | |||
631 | function TZMDLLLoader.Path: String; |
||
632 | begin |
||
633 | Result := ''; |
||
634 | if IsLoaded then |
||
635 | Result := fPath; |
||
636 | end; |
||
637 | |||
638 | procedure TZMDLLLoader.ReleaseLib; |
||
639 | begin |
||
640 | if hndl <> 0 then |
||
641 | begin |
||
642 | FreeLibrary(hndl); |
||
643 | hndl := 0; |
||
644 | end; |
||
645 | if hndl = 0 then |
||
646 | begin |
||
647 | Empty; |
||
648 | fPath := ''; |
||
649 | if fKillTemp then |
||
650 | RemoveTempDLL; |
||
651 | end; |
||
652 | end; |
||
653 | |||
654 | procedure TZMDLLLoader.Remove(worker: TZMWorker); |
||
655 | var |
||
656 | i: Integer; |
||
657 | begin |
||
658 | Guard.Enter; |
||
659 | try |
||
660 | i := Counts_Find(worker); |
||
661 | if i >= 0 then |
||
662 | begin |
||
663 | // found - remove it |
||
664 | Counts[i].worker := nil; |
||
665 | Counts[i].Count := 0; |
||
666 | end; |
||
667 | finally |
||
668 | Guard.Leave; |
||
669 | end; |
||
670 | end; |
||
671 | |||
672 | procedure TZMDLLLoader.RemoveTempDLL; |
||
673 | var |
||
674 | t: String; |
||
675 | begin |
||
676 | t := TmpFileName; |
||
677 | TmpFileName := ''; |
||
678 | fKillTemp := False; |
||
679 | if (t <> '') and FileExists(t) then |
||
680 | SysUtils.DeleteFile(t); |
||
681 | end; |
||
682 | |||
683 | procedure TZMDLLLoader.Unload(worker: TZMWorker); |
||
684 | begin |
||
685 | Counts_Dec(worker); |
||
686 | end; |
||
687 | |||
688 | function TZMDLLLoader.UnloadDLL: Integer; |
||
689 | begin |
||
690 | ReleaseLib; |
||
691 | Result := fVer; |
||
692 | end; |
||
693 | {$ENDIF} |
||
694 | { public functions } |
||
695 | |||
696 | procedure _DLL_Abort(worker: TZMWorker; key: Cardinal); |
||
697 | begin |
||
698 | if key <> 0 then |
||
699 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
700 | DZ_Abort(key); |
||
701 | {$ELSE} |
||
702 | G_LoadedDLL.Abort(worker, key); |
||
703 | {$ENDIF} |
||
704 | end; |
||
705 | |||
706 | function _DLL_Banner: String; |
||
707 | begin |
||
708 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
709 | Result := DZ_Banner; |
||
710 | {$ELSE} |
||
711 | Result := G_LoadedDLL.Banner; |
||
712 | {$ENDIF} |
||
713 | end; |
||
714 | |||
715 | function _DLL_Build: Integer; |
||
716 | begin |
||
717 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
718 | Result := DZ_PrivVersion; |
||
719 | {$ELSE} |
||
720 | Result := G_LoadedDLL.Build; |
||
721 | {$ENDIF} |
||
722 | end; |
||
723 | |||
724 | function _DLL_Exec(worker: TZMWorker; const Rec: pDLLCommands; |
||
725 | var key: Cardinal): Integer; |
||
726 | begin |
||
727 | try |
||
728 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
729 | Result := DZ_Exec(Rec); |
||
730 | {$ELSE} |
||
731 | Result := G_LoadedDLL.Exec(worker, Rec, key); |
||
732 | {$ENDIF} |
||
733 | key := 0; |
||
734 | except |
||
735 | Result := -6; // -7; |
||
736 | key := 0; |
||
737 | end; |
||
738 | CheckExec(Result); |
||
739 | end; |
||
740 | |||
741 | function _DLL_Load(worker: TZMWorker): Integer; |
||
742 | begin |
||
743 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
744 | Result := DZ_Version; |
||
745 | {$ELSE} |
||
746 | Result := G_LoadedDLL.Load(worker); |
||
747 | {$ENDIF} |
||
748 | end; |
||
749 | |||
750 | function _DLL_Loaded(worker: TZMWorker): Boolean; |
||
751 | begin |
||
752 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
753 | Result := True; |
||
754 | {$ELSE} |
||
755 | Result := G_LoadedDLL.Loaded(worker); |
||
756 | {$ENDIF} |
||
757 | end; |
||
758 | |||
759 | function _DLL_Path: String; |
||
760 | begin |
||
761 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
762 | Result := DZ_Path; |
||
763 | {$ELSE} |
||
764 | Result := G_LoadedDLL.Path; |
||
765 | {$ENDIF} |
||
766 | end; |
||
767 | |||
768 | // remove from list |
||
769 | procedure _DLL_Remove(worker: TZMWorker); |
||
770 | begin |
||
771 | {$IFDEF STATIC_LOAD_DELZIP_DLL} |
||
772 | // nothing to do |
||
773 | {$ELSE} |
||
774 | G_LoadedDLL.Remove(worker); |
||
775 | {$ENDIF} |
||
776 | end; |
||
777 | |||
778 | procedure _DLL_Unload(worker: TZMWorker); |
||
779 | begin |
||
780 | {$IFNDEF STATIC_LOAD_DELZIP_DLL} |
||
781 | G_LoadedDLL.Unload(worker); |
||
782 | {$ENDIF} |
||
783 | end; |
||
784 | {$IFNDEF STATIC_LOAD_DELZIP_DLL} |
||
785 | |||
786 | initialization |
||
787 | |||
788 | G_LoadedDLL := TZMDLLLoader.Create; |
||
789 | |||
790 | finalization |
||
791 | |||
792 | FreeAndNil(G_LoadedDLL); |
||
793 | {$ENDIF} |
||
794 | |||
795 | end. |