home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKINST.ZIP / cmarc139.lzh / BEL32.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-13  |  12.3 KB  |  262 lines
  1. // ô¥ìçâAü[âJâCâoâRâôâ|ü[âlâôâg for Delphi/C++Builder
  2. // Common Archivers Component for Delphi/C++Builder
  3. // Copyright(C) NORG1964/M.Yoneda 1997,1998,1999,2000,2001
  4. //
  5. // BGA32è╓ÿAâéâWâàü[âï    BGA32.PAS
  6. //
  7. // v1.36:UNBEL32.DLLé╔éµéΘBELî`Ä«é╓é╠æ╬ë₧é≡èJÄn
  8. // v1.38:DLL é⌐éτé╠âGâôâgâèâ|âCâôâgé╠ĵô╛ò√û@é≡ò╧ìXé╡é╜
  9. //
  10. unit BEL32;
  11.  
  12. interface
  13.  
  14. uses
  15.     Windows,
  16.     SysUtils,
  17.     Classes,
  18.     Archives;
  19.  
  20. type
  21.     TBel32 = class( TArchiver )
  22.     protected
  23.         class procedure LoadDll; override;
  24.         class procedure FreeDll; override;
  25.  
  26.     private
  27.         FArchiveFileName:    string;
  28.  
  29.     protected
  30.         function  BuildCmdLine( Cmd,ArchiveFileName:string;Options:TArchiverOptions;Path:String;FileList:array of const;UseResFile:boolean ):String;
  31.  
  32.         function  FindOpen ( Handle:HWND;ArchiveFileName:string;dwMode:DWORD ):THARC; override;
  33.         function  FindFirst( hArc:THArc;var IndivisualInfo:TIndivisualInfo;FileMask:string ):integer; override;
  34.         function  FindNext ( hArc:THArc;var IndivisualInfo:TIndivisualInfo                   ):integer; override;
  35.         function  FindClose( hArc:THArc                                                       ):integer; override;
  36.  
  37.     public
  38.         function Unbel( Handle:HWND;cmdline:string;var Output:string ):Integer;
  39.         function UnpackFiles  ( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;DstPath:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer; override;
  40. //        function PackFiles    ( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer; override;
  41. //        function RemoveItems  ( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer; override;
  42. //        function UpdateArchive( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer; override;
  43. //        function MakeSfx      ( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;DstPath:String                                           ;var Output:string ):Integer; override;
  44. //        function UnpackToMem  ( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;FileName:string;lpvBuffer:LPVOID;dwSize:DWORD;lpdwWriteSize:LPDWORD   ):Integer; override;
  45.         function CheckArchive (             ArchiveFileName:string;CheckMode:integer;CheckOptions:integer ):DWORD; override;
  46. //        function SetOwnerWindowEx ( Handle:HWND;lpArcProc:LPARCHIVERPROC ):boolean; override;
  47. //        function KillOwnerWindowEx( Handle:HWND                                 ):boolean; override;
  48.     end;
  49.  
  50.     function IsBelArchive( ArchiveFileName:string ):boolean;
  51.  
  52. //    function UnbelOpenArchive( Handle:HWND;ArchiveFileName:PAnsiChar;dwMode:DWORD ):THARC; stdcall;
  53. //    function UnbelCloseArchive( hArc:THARC ):integer; stdcall;
  54. //    function UnbelFindFirst( hArc:THArc;FileMask:PAnsiChar;IndivisualInfo:PIndivisualInfo ):integer; stdcall;
  55. //    function UnbelFindNext( hArc:THArc;IndivisualInfo:PIndivisualInfo ):integer; stdcall;
  56. //    function UnbelSetOwnerWindowEx( Handle:HWND;lpArcProc:LPARCHIVERPROC ):BOOL; stdcall;
  57.  
  58. implementation
  59.  
  60. //---------------------------------------------------------------------
  61. var
  62.     FArchiver:        TArchiverDLL;
  63.  
  64. procedure LoadDll;
  65. begin
  66.     if Assigned( FArchiver ) then exit;
  67.     FArchiver := TArchiverDll.Create( 'GCA î`Ä«Åæî╔','UnGCA32.DLL','UnGCA' );
  68. end;
  69.  
  70. procedure FreeDll;
  71. begin
  72.     FArchiver.Free;
  73.     FArchiver := nil;
  74. end;
  75.  
  76. //---------------------------------------------------------------------
  77. class procedure TBel32.LoadDll;
  78. begin
  79.     Bel32.LoadDll;
  80. end;
  81.  
  82. class procedure TBel32.FreeDll;
  83. begin
  84.     Bel32.FreeDll;
  85. end;
  86.  
  87. function TBel32.UnpackFiles( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;DstPath:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer;
  88. begin
  89.     FCmdLine := BuildCmdLine( 'x',ArchiveFileName,Options,DstPath,FileList,ruOnUnpack in Options.ResFileUsage );
  90.     result := Unbel( Handle,FCmdLine,Output );
  91. end;
  92.  
  93. //    function TBel32.PackFiles( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer;
  94. //    begin
  95. //        FCmdLine := BuildCmdLine( 'u',ArchiveFileName,Options,BaseDir,FileList,ruOnPack in Options.ResFileUsage );
  96. //        result := Unbel( Handle,FCmdLine,Output );
  97. //    end;
  98.  
  99. //    function TBel32.RemoveItems( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer;
  100. //    begin
  101. //        FCmdLine := BuildCmdLine( 'd',ArchiveFileName,Options,'',FileList,ruOnRemoveItem in Options.ResFileUsage );
  102. //        result := Unbel( Handle,FCmdLine,Output );
  103. //    end;
  104.  
  105. //    function TBel32.UpdateArchive( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;BaseDir:String;FileList:array of const;UseResFile:boolean;var Output:string ):Integer;
  106. //    begin
  107. //        FCmdLine := BuildCmdLine( 'f',ArchiveFileName,Options,BaseDir,FileList,ruOnUpdate in Options.ResFileUsage );
  108. //        result := Unbel( Handle,FCmdLine,Output );
  109. //    end;
  110.  
  111. //    function TBel32.MakeSfx( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;DstPath:String;var Output:string ):Integer;
  112. //    begin
  113. //        FCmdLine := BuildCmdLine( 's',ArchiveFileName,Options,DstPath,[nil],false );
  114. //        result := Unbel( Handle,FCmdLine,Output );
  115. //    end;
  116.  
  117. //    function TBel32.UnpackToMem( Handle:HWND;ArchiveFileName:string;Options:TArchiverOptions;FileName:string;lpvBuffer:LPVOID;dwSize:DWORD;lpdwWriteSize:LPDWORD ):Integer;
  118. //    begin
  119. //        FCmdLine := BuildCmdLine( '',ArchiveFileName,Options,'',[FileName],false );
  120. //        result := FArchiver.ExtractMem( Handle,PChar( FCmdLine ),lpvBuffer,dwSize,nil,nil,lpdwWriteSize );
  121. //    end;
  122.  
  123. function TBel32.CheckArchive( ArchiveFileName:string;CheckMode:integer;CheckOptions:integer ):DWORD;
  124. begin
  125.     result := FArchiver.CheckArchive( PChar( ArchiveFileName ),CheckMode+CheckOptions );
  126. end;
  127.  
  128. //    function TBel32.SetOwnerWindowEx ( Handle:HWND;lpArcProc:LPARCHIVERPROC ):boolean;
  129. //    begin
  130. //        inherited SetOwnerWindowEx( Handle,lpArcProc );
  131. //        result := FArchiver.SetOwnerWindowEx( Handle,lpArcProc );
  132. //    end;
  133. //
  134. //    function TBel32.KillOwnerWindowEx( Handle:HWND ):boolean;
  135. //    begin
  136. //        result := UnBelKillOwnerWindowEx( Handle );
  137. //        inherited KillOwnerWindowEx( Handle );
  138. //    end;
  139.  
  140. function TBel32.Unbel( Handle:HWND;CmdLine:string;var Output:string ):Integer;
  141. begin
  142.     result := FArchiver.ArchiverProc( Handle,PChar( CmdLine ),PAnsiChar( Output ),Length( Output ));
  143. end;
  144.  
  145. function TBel32.BuildCmdLine( Cmd,ArchiveFileName:string;Options:TArchiverOptions;Path:String;FileList:array of const;UseResFile:boolean ):String;
  146. var
  147.     CmdLine:    TCmdOpt;
  148. begin
  149.     with Options do begin
  150.         CmdLine := TCmdOpt.Create;
  151.  
  152. //        CmdLine.Add( '-+' );            //    Åφé╔âîâWâXâgâèé╠É▌ÆΦé≡û│Äïé╖éΘ
  153.  
  154. //        CmdLine.AddIntOpt( 'a'    ,a     );        //    a[0|1|2]                æ«É½é╠ì─î╗üB
  155. //        CmdLine.AddIntOpt( 'c'    ,c     );        //    c[0|1]                â^âCâÇâXâ^âôâvîƒì╕é≡Å╚ù¬
  156. //        CmdLine.AddIntOpt( 'd'    ,d     );        //    d[0|1]                âfâBâîâNâgâèû╝é╠èiö[
  157. //        CmdLine.AddIntOpt( 'e'    ,e     );        //    e[0|1]                Ä½ÅæâTâCâYé≡ö╝ò¬é╔é╡é─ê│Åk
  158. //        CmdLine.AddIntOpt( 'f'    ,f     );        //    f[0|1]                âfâBâXâNÄcù╩â`âFâbâNé╠ÆåÄ~
  159. //        CmdLine.AddIntOpt( 'h'    ,h     );        //    h[0|1|2|3]            âwâbâ_é╠î`Ä«é≡ÄwÆΦ
  160. //        CmdLine.AddIntOpt( 'i'    ,i     );        //    i[0|1|2]                âtâ@âCâïæIæ≡é┼æσò╢ÄÜé╞żò╢ÄÜé≡ïµò╩
  161. //        CmdLine.AddIntOpt( 'l'    ,l     );        //    l[0|1|2]                ôWèJâìâOé╠âtâ@âCâïû╝é╠ò\Īû@é╠ò╧ìX
  162. //        CmdLine.AddIntOpt( 'm'    ,m     );        //    m[0|1|2]                Ä┐ûΓé╔ yes é╞ë╝ÆΦ
  163.  
  164. //        if not CallBackEnabled
  165. //        then CmdLine.AddIntOpt( 'n' ,n )        //    n[0|1]                ôWèJÅ≤ï╡â_âCâAâìâOò\Īé╠ù}Ä~
  166. //        else CmdLine.AddIntOpt( 'n' ,1 );    //    n[0|1]                ôWèJÅ≤ï╡â_âCâAâìâOò\Īé╠ù}Ä~
  167.  
  168. //        CmdLine.AddIntOpt( 'o'    ,o     );        //    o[0|1|2]                ïîî`Ä«é┼Åæî╔é≡ì∞ɼ
  169. //        CmdLine.AddIntOpt( 'p'    ,p     );        //    p[0|1|2]                æSâpâXû╝é┼ìçÆv
  170. //        CmdLine.AddIntOpt( 'r'    ,r     );        //    r[0|1|2]                ì─ïAôIîƒì⌡
  171. //        CmdLine.AddIntOpt( 's'    ,s     );        //    s[0|1]                âXâLâbâvò\Īé╠ù}ɺ
  172. //        CmdLine.AddIntOpt( 't'    ,t     );        //    t[0|1]                Åæî╔é╠ìXÉVô·Ä₧é╠ÄwÆΦ
  173.  
  174. //        CmdLine.AddIntOpt( 'u'    ,u      );        //    u[0|1]                âtâ@âCâïé╠ìXÉVüiÉVé╡éóéαé╠üj
  175. //        CmdLine.AddPath1 ( 'w'  ,w   );        //    w[0|1|<Dirû╝>]        ì∞ï╞ùpâfâBâîâNâgâèé╠ÄwÆΦ
  176. //        CmdLine.AddIntOpt( 'x'    ,x      );        //    x[0|1]                âfâBâîâNâgâèû╝é≡ùLî°é╔é╖éΘ
  177. //        CmdLine.AddIntOpt( 'y'    ,y      );        //    y[0|1]                æSé─é╠Ä┐ûΓé╔ yes é╞ë╝ÆΦ
  178. //        CmdLine.AddIntOpt( 'z'    ,z      );        //    z[0|1|2|<ègÆúÄq>]    ûóê│Åkâtâ@âCâïé╠ÄwÆΦ            ###ègÆúÄqé═âTâ|ü[âgé╡é╚éó###
  179. //        CmdLine.AddIntOpt( 'jc' ,jc  );        //    jc[0|1]                öjæ╣âwâbâ_é≡û│Äï
  180. //        CmdLine.AddIntOpt( 'jd' ,jd  );        //    jd[<âTâCâY>]        âfâBâXâNé╠ï≤é½ùeù╩é≡èmöF
  181. //        CmdLine.AddIntOpt( 'je' ,je  );        //    je[<âTâCâY>]        Huffman âoâbâtâ@é╠æσé½é│é≡ÄwÆΦ
  182. //        CmdLine.AddIntOpt( 'jf' ,jf  );        //    jf[0|1]                âïü[âgïLìåé╠ìφÅ£
  183. //        CmdLine.AddIntOpt( 'jh' ,jh  );         //    jh[0|1]                WindowsNT/95 ÉΩùpé╠â}ü[âNé≡Åæî╔é╔òtë┴
  184. //        CmdLine.AddIntOpt( 'ji' ,ji  );        //    ji[0|1]                ÆZéóâtâ@âCâïû╝é┼èiö[
  185. //        CmdLine.AddIntOpt( 'jm' ,jm  );        //    jm[0|1|2|3|4]        ê│Åkî`Ä«é≡ÄwÆΦ
  186. //        CmdLine.AddIntOpt( 'jn' ,jn  );        //    jn[0|1]                ÉVïKâtâ@âCâïé╠é▌
  187. //        CmdLine.AddStrOpt( 'jo' ,jo  );        //    jo[<Ä₧ìÅÄwÆΦ>]        YYMMDDHHMMSS é╠ô·òtê╚ì~
  188. //        CmdLine.AddStrOpt( 'job',job );        //    job[<Ä₧ìÅÄwÆΦ>]    YYMMDDHHMMSS é╠ô·òtê╚æO
  189. //        CmdLine.AddIntOpt( 'jp' ,jp  );        //    jp[0|1]                ÉiÆ╗âoü[é≡âvâìâOâîâXüEâoü[é┼ò\Ī
  190. //        CmdLine.AddIntOpt( 'jr' ,jr  );        //    jr[0|1]                âtâ@âCâïé╠Æué½è╖éª
  191. //        CmdLine.AddIntOpt( 'jss',jss );        //    jss[0|1]                ê│Åkâtâ@âCâïâIü[âvâôâGâëü[é≡û│ÄïüBÆ╩ÅφüCê│ÅkÄ₧é╔ê│Åkæ╬Å█âtâ@
  192. //        CmdLine.AddIntOpt( 'jw' ,jw  );        //    jw[0|1|2|3|4]        WinSFX/WinSFXM é≡ì∞ɼ
  193. //        CmdLine.AddFList2( 'jx' ,[jx] );        //    jx[<âtâ@âCâïû╝>]    Å£èOé╖éΘâtâ@âCâïû╝
  194. //        CmdLine.AddIntOpt( 'jyc',jyc );        //    jyc[0|1]                âfâBâîâNâgâèì∞ɼé╠èmöFé≡Å╚ù¬
  195. //        CmdLine.AddIntOpt( 'jyd',jyd );        //    jyd[0|1]                âtâ@âCâïìφÅ£é╠èmöFé≡Å╚ù¬
  196. //        CmdLine.AddIntOpt( 'jyk',jyk );        //    jyk[0|1]                Ägùpé┼é½éΘâfâBâXâNùeù╩é╠èmöFé╠Å╚ù¬
  197. //        CmdLine.AddIntOpt( 'jyn',jyn );        //    jyn[0|1]                ÉVâtâ@âCâïû╝é╠ùvïüé╠Å╚ù¬
  198. //        CmdLine.AddIntOpt( 'jyo',jyo );        //    jyo[0|1]                è∙æ╢âtâ@âCâïé╓é╠ÅπÅæé½èmöFé╠Å╚ù¬
  199. //        CmdLine.AddStrOpt( 'jz' ,jz  );        //    jz[<âtâ@âCâïû╝>]    âtâ@âCâïÆìÄ▀é╠âtâ@âCâïé≡ïƒïï
  200. //        CmdLine.AddIntOpt( 'ga' ,ga  );        //    ga[0|1]                Åæé½ì₧é▌òsë┬æ«É½é≡û│Äï
  201. //        CmdLine.AddIntOpt( 'gd' ,gd  );        //    gd[0|1]                ù]ò¬é╚âfü[â^é╠ìφÅ£
  202. //        CmdLine.AddIntOpt( 'ge' ,ge  );        //    ge[0|1]                ì┼Åëé╠ègÆúÄqé≡öFÄ»
  203. //        CmdLine.AddIntOpt( 'gf' ,gf  );        //    gf[0|1|2]            é╖é┼é╔éáéΘâtâ@âCâïé╠ìXÉV
  204. //        CmdLine.AddIntOpt( 'gj' ,gj  );        //    gj[0|1]                x û╜ù▀é≡ e û╜ù▀é╞ô»ùlé╞î⌐é╚é╖
  205. //        CmdLine.AddIntOpt( 'gm' ,gm  );        //    gm[0|1]                âGâëü[âüâbâZü[âWò\Īé╠ù}Ä~
  206. //        CmdLine.AddIntOpt( 'gn' ,gn  );        //    gn[0|1|2]            ôWèJâtâ@âCâïé╠ìçîvâTâCâYé≡ 100% é╞é╡é╜ÉiÆ╗âOâëâté╠ò\Ī
  207. //        CmdLine.AddIntOpt( 'go' ,go  );        //    go[0|1]                â_âCâAâìâOé╠âIü[âiü[âEâBâôâhâEé╠ÄwÆΦ
  208. //        CmdLine.AddIntOpt( 'gp' ,gp  );        //    gp[0|1]                âEâBâôâhâEé≡ Disable é╔é╡é╚éó
  209. //        CmdLine.AddStrOpt( 'gr' ,gr  );        //    gr[<âtâ@âCâïû╝>]    ò╧ìXâtâ@âCâïû╝é≡ïƒïï
  210. //        CmdLine.AddIntOpt( 'gs' ,gs  );        //    gs[<âTâCâY>]        âwâbâ_îƒì⌡âTâCâYé╠ÄwÆΦ
  211. //        CmdLine.AddIntOpt( 'gu' ,gu  );        //    gu[0|1]                WinSFXüCDosSFX é╔æSé─é╠âtâ@âCâïé≡èiö[
  212. //        CmdLine.AddIntOpt( 'gw' ,gw  );        //    gw[0|1|2|3|4]        WinSFX32/WinSFX32M é≡ì∞ɼ
  213.  
  214.         CmdLine.Add( UserOptions );
  215.  
  216.         AddFileSpec1( CmdLine,ArchiveFileName,Path );
  217. //        AddFileSpec2( CmdLine,Options,FileList,UseResFile );
  218.  
  219.         result := cmd + CmdLine.Str;    //    v0.43ê╚Åπé╠Ä₧
  220. //        result := ArchiveFileName;        //    v0.43ûóû₧é╠Ä₧-âTâ|ü[âgé╡é╚éó
  221.  
  222.         CmdLine.Free;
  223.     end;
  224. end;
  225.  
  226. function TBel32.FindOpen( Handle:HWND;ArchiveFileName:string;dwMode:DWORD ):THARC;
  227. begin
  228.     FArchiveFileName := ExpandFileName( ArchiveFileName );
  229.     result:= 1;    //    0 é┼é╚é»éΩé╬é╚é±é┼éαéµéó
  230. end;
  231.  
  232. function TBel32.FindClose( hArc:THArc ):integer;
  233. begin
  234.     FArchiveFileName := '';
  235.     result := 0;
  236. end;
  237.  
  238. function TBel32.FindFirst( hArc:THArc;var IndivisualInfo:TIndivisualInfo;FileMask:string ):integer;
  239. begin
  240. //    result := FArchiver.FindFirst( hArc,PChar( FileMask ),@IndivisualInfo );
  241.     result := FArchiver.FindFirst( hArc,PChar( FArchiveFileName ),@IndivisualInfo );
  242.     result := 0;
  243. end;
  244.  
  245. function TBel32.FindNext( hArc:THArc;var IndivisualInfo:TIndivisualInfo ):integer;
  246. begin
  247.     result := FArchiver.FindNext( hArc,@IndivisualInfo )
  248. end;
  249.  
  250. function IsBelArchive( ArchiveFileName:string ):boolean;
  251. begin
  252.     try
  253.         LoadDLL;
  254.         ArchiveFileName := ExpandFileName( ArchiveFileName );
  255.         result := FArchiver.CheckArchive( PChar( ArchiveFileName ),0 ) <> 0;    //    é▄é┴é╜é¡éáé─é╔é╚éτé╚éóé╠é┼Æìê╙üI
  256.     except
  257.         result := false;
  258.     end;
  259. end;
  260.  
  261. end.
  262.