home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKDIR.ZIP / CakExt.pas < prev    next >
Pascal/Delphi Source File  |  2001-10-28  |  16KB  |  457 lines
  1. // Common Archiver Kit Experiment(CAKE)
  2. // Common Interface for Compression/Decompression components.
  3.  
  4. //Copyright (C) Joseph Leung 2001 (lycj@yahoo.com)
  5. //
  6. //This library is free software; you can redistribute it and/or
  7. //modify it under the terms of the GNU Lesser General Public
  8. //License as published by the Free Software Foundation; either
  9. //version 2.1 of the License, or (at your option) any later version.
  10. //
  11. //This library is distributed in the hope that it will be useful,
  12. //but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. //MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14. //Lesser General Public License for more details.
  15. //
  16. //You should have received a copy of the GNU Lesser General Public
  17. //License along with this library; if not, write to the Free Software
  18. //Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19.  
  20. //////////////////////////////////////////////////////////////////////
  21. ////////////               CAKExtension                   ////////////
  22. //////////////////////////////////////////////////////////////////////
  23. // ___________________________________________
  24. // ___________________________________________|
  25. // CakExt                                     |
  26. // lastupdate 10.28.2001                      |
  27. // hIsToRy - Check CakDir.pas                 |
  28. // ___________________________________________|
  29. //
  30. // INFO - Use CAKE to support more archive via Dos archiver using Scripts!!
  31. //        You are suggested to use CAKE to call this component.
  32. //        (Although you can compile this alone)
  33. //
  34. // To use it...
  35. // 1. Put a cakdir in ur form (Called cakDir1 in this case)
  36. // 2. Put this line in Form OnShow(not onCreate!),
  37. //    so it will check the path for extensions.
  38. //      CakDir1.CakExtScriptPath := Cakdir1.GrabProgramPath + 'Extension\';
  39. //    You can then read what's supported using
  40. //      Cakdir1.treatasExt
  41. // 3. When user load an archiver that required to use extension,
  42. //    it will do autmatically! (no other changes required to support extension)
  43. //
  44.  
  45. unit CakExt;
  46.  
  47. interface
  48.  
  49. uses
  50.   Windows, SysUtils, Classes, Shellapi;
  51.  
  52. const SCRIPTEXT = '.INI';
  53.       SCRIPTFILTER = '*' + SCRIPTEXT;
  54.       MACRO = '%';
  55.       SPACE = ' ';
  56.       DOT = '.';
  57.       INFO = 'Info';
  58.       FEATURES = 'Features';
  59.       PATHS = 'Paths';
  60.       STRINGS = 'Strings';
  61.       PARAM = 'Param';
  62.       COMMANDS = 'Commands';
  63.       LIST = 'List';
  64.       ERROR = 'Error!'; 
  65. type
  66.   WorktypeEx = (Ex_None,            //Donothing
  67.               Ex_LoadContents,      //List Archive
  68.               Ex_Extract,           //Extract Archive
  69.               Ex_Test,              //Test Archive
  70.               Ex_Add,               //Add file to archive
  71.               Ex_Delete,            //Delete file from archive
  72.               Ex_SFX                //Create Self extractables
  73.               );
  74.   ExtractOptionstypeEx = record
  75.                    extr_to : string;
  76.                    extract_files : string;
  77.                    end;
  78.   AddOptionstypeEx = record
  79.                    add_files : string;
  80.                    end;
  81.   DeleteOptionstypeEx = record
  82.                    del_files : string;
  83.                    end;
  84.   ContenttypeEx = record
  85.               _Filename,_FileArchive : String;
  86.               _FileSize,_FilePackedSize : integer;
  87.               _FileRatio : integer;
  88.               end;
  89.   TCakExt = class(TComponent)
  90.   private { Private declarations }
  91.     Supporttype : string;
  92.     ScriptPath : string;
  93.     Log : string;
  94.     batfilename : string;
  95.   protected { Protected declarations }
  96.     procedure runandwait(programpath,Programparam : string);
  97.     
  98.   public { Public declarations }
  99.     DosOutput : TStrings;
  100.     ExtractOptionsEx : ExtractOptionstypeEx;
  101.     AddOptionsEx : AddOptionstypeEx;
  102.     DeleteOptionsEx : DeleteOptionstypeEx;
  103.     Total_Contents : integer;
  104.     Archive_Contents : array of ContenttypeEx;
  105.  
  106.     function Supportactions(Archivetype : string; Action : worktypeEx) : boolean;
  107.     procedure RePollScriptDirectory;
  108.     procedure Process(Archivename : string; Action : worktypeEx);
  109.     function TranslateString(Inifilename, Macroname, Archivename : string; var Executename : string) : string;
  110.     
  111.     constructor Create( AOwner: TComponent ); override;
  112.     destructor Destroy; override;
  113.   published
  114.     property ScriptDirectory : string read ScriptPath write ScriptPath;
  115.     property Supportformats : string read Supporttype write Supporttype;
  116.     property Logfile : string read log write log;
  117.     property Batchfilename : string read batfilename;
  118.     { Published declarations }
  119.   end;
  120.  
  121. procedure Register;
  122.  
  123. implementation
  124. uses ConsoleApp, Inifiles;
  125. /////////////////////////////////////////////////////////////////////////
  126. ////////////              CAKE's functions                   ////////////
  127. /////////////////////////////////////////////////////////////////////////
  128.  
  129. function GetStringInIni(filename : string; section : string; key : string; default : string) : string;
  130. var Ini : TInifile;
  131. begin
  132.   Ini := TIniFile.Create(filename);
  133.   try
  134.   with Ini do
  135.         result := ReadString(section,key,'');
  136.   finally
  137.   Ini.Free;
  138.   end;
  139.   if result = '' then result := default;
  140. end;
  141.  
  142. function GetIntegerInIni(filename : string; section : string; key : string; default : integer) : integer;
  143. var Ini : TInifile;
  144. begin
  145.   Ini := TIniFile.Create(filename);
  146.   try
  147.   with Ini do
  148.         result := ReadInteger(section,key,default);
  149.   finally
  150.   Ini.Free;
  151.   end;
  152.   //if result =  then result := default;
  153. end;
  154.  
  155. function AppendSlash(input : string) : string;
  156. begin
  157.         if length(input) > 0 then
  158.         if input[Length(input)] = '\' then
  159.                 result := input else
  160.                 result := input + '\' else
  161.         result := input;
  162. end;
  163.  
  164. function Removefileext(input : string) : string;
  165. var
  166.   I: Integer;
  167. begin
  168.   I := LastDelimiter('.\:', input);
  169.   if (I > 0) and (input[I] = '.') then
  170.     Result := Copy(input, 0, i-1) else
  171.     Result := input;
  172. end;
  173.  
  174. procedure TCakExt.runandwait(programpath,Programparam : string);
  175. Var
  176.    exInfo: TShellExecuteInfo;
  177.    exitcode: DWORD;
  178. Begin
  179.    FillChar( exInfo, Sizeof(exInfo), 0 );
  180.  
  181.    With exInfo Do Begin
  182.      cbSize:= Sizeof( exInfo ); // required!
  183.      fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
  184.      Wnd   := 0;
  185.      lpVerb:= 'open';
  186.      lpFile:= Pchar( programpath );
  187.      lpParameters := Pchar( Programparam);
  188.      nShow := SW_NORMAL;
  189.    End;
  190.    If ShellExecuteEx( @exInfo ) Then Begin
  191.       While GetExitCodeProcess( exinfo.hProcess, exitcode )
  192.             and (exitcode = STILL_ACTIVE)
  193.       Do
  194.         Sleep( 500 );
  195.       CloseHandle( exinfo.hProcess );
  196.    End
  197. end;
  198.  
  199. /////////////////////////////////////////////////////////////////////////
  200.  
  201. constructor TCakExt.Create( AOwner: TComponent ); 
  202. begin
  203. inherited Create( AOwner );
  204. DosOutput := TStringList.create();
  205. log := 'c:\Cake.log';  //if not specified...hungry?
  206. batfilename := 'c:\run.bat';
  207. end;
  208.  
  209. destructor TCakExt.Destroy; 
  210. begin
  211. DosOutput.free;
  212. inherited Destroy;
  213. end;
  214.  
  215. /////////////////////////////////////////////////////////////////////////
  216. procedure TCakExt.Process(Archivename : string; Action : worktypeEx);
  217. var Archivetype : string;
  218.     File2Run, Param : string;
  219.     IniFilename : string;
  220.     ExitCode : integer;
  221.     mode : integer;
  222.     k : string;
  223. function Calculatesize(sizestring : string) : integer;
  224. var i : integer;
  225.     k,l : string;
  226. begin
  227.         k := '';
  228.         l := TrimRight(TrimLeft(sizestring));
  229.         for i := 0 to length(l)  do
  230.                 if strtointdef(l[i],-1) <> -1 then
  231.                         k := k + l[i];
  232.         result := strtointdef(k,0);
  233. end;
  234. procedure Loadfilelist;
  235. var i : integer;
  236.     linestart,linestop : integer;
  237.     filenamestart, filenamestop : integer;
  238.     filesizestart, filesizestop : integer;
  239.     filepackedsizestart, filepackedsizestop : integer;
  240. begin
  241.         linestart := GetIntegerInINI(Inifilename,LIST,'LINESTART',-1);
  242.         linestop := GetIntegerInINI(Inifilename,LIST,'LINESTOP',-1);
  243.         filenamestart := GetIntegerInINI(Inifilename,LIST,'FILENAME-START',-1);
  244.         filenamestop := GetIntegerInINI(Inifilename,LIST,'FILENAME-STOP',-1);
  245.         filesizestart := GetIntegerInINI(Inifilename,LIST,'FILESIZE-START',-1);
  246.         filesizestop := GetIntegerInINI(Inifilename,LIST,'FILESIZE-STOP',-1);
  247.         filepackedsizestart := GetIntegerInINI(Inifilename,LIST,'FILEPACKEDSIZE-START',-1);
  248.         filepackedsizestop := GetIntegerInINI(Inifilename,LIST,'FILEPACKEDSIZE-STOP',-1);
  249.  
  250.         Total_Contents := Dosoutput.Count + linestop - linestart;
  251.         if Total_Contents > 0 then
  252.         begin
  253.         SetLength(Archive_Contents,Total_Contents);
  254.         for i := linestart to Dosoutput.Count + linestop - 1 do
  255.                 with Archive_Contents[i - linestart] do
  256.                 begin
  257.                 if (filenamestart <> filenamestop) then
  258.                 _Filename := TrimRight(TrimLeft(Copy(Dosoutput.strings[i],filenamestart,filenamestop-filenamestart)));
  259.  
  260.                 if (filesizestart <> filesizestop) then
  261.                 _FileSize := calculatesize(Copy(Dosoutput.strings[i],filesizestart,filesizestop-filesizestart));
  262.                 
  263.                 if (filepackedsizestart <> filepackedsizestop) then
  264.                 _FilePackedSize := calculatesize(Copy(Dosoutput.strings[i],filepackedsizestart,filepackedsizestop-filepackedsizestart));
  265.  
  266.                 _FileRatio := 100;
  267.  
  268.                 if _FileSize > 0 then
  269.                 _FileRatio := Trunc(_FilePackedSize / _FileSize * 100);
  270.  
  271.  
  272.                 _FileArchive := Archivename;
  273.                 end;
  274.         end;
  275. end;
  276. procedure MakeBatch(batfilename,file2run : string);
  277. var tf : textfile;
  278. begin
  279.         Assignfile(tf,batfilename);
  280.         Rewrite(tf);
  281.         Writeln(tf,'@'+file2run);
  282.         Writeln(tf,'@'+'Exit');
  283.         Closefile(tf);
  284. end;
  285. begin
  286.         Archivetype := Extractfileext(Archivename);
  287.         Archivetype := Copy(Archivetype,2,Length(Archivetype)-1);
  288.         Inifilename := Appendslash(ScriptPath) + Archivetype + SCRIPTEXT;
  289.         DosOutput.Clear;
  290.         if not SupportActions(Archivetype,Action) then exit;
  291.  
  292.  
  293.         Case Action of
  294.         Ex_LoadContents : Param := TranslateString(IniFilename,'LIST',Archivename,File2Run);
  295.         Ex_Extract : Param := TranslateString(IniFilename,'EXTRACT',Archivename,File2Run);
  296.         Ex_Test : Param := TranslateString(IniFilename,'TEST',Archivename,File2Run);
  297.         Ex_Add : Param := TranslateString(IniFilename,'ADD',Archivename,File2Run);
  298.         Ex_SFX : Param := TranslateString(IniFilename,'SFX',Archivename,File2Run);
  299.         Ex_Delete : Param := TranslateString(IniFilename,'DELETE',Archivename,File2Run);
  300.         end;
  301.  
  302.         mode := GetIntegerInINI(IniFilename,COMMANDS,'MODE',0);
  303.  
  304.         if fileexists(File2Run) and (File2Run <> '') then
  305.         begin
  306.         Case mode of
  307.         0 : ExitCode:= ExecConsoleApp(File2Run,Param,DosOutput,nil);
  308.         1 : begin
  309.             MakeBatch(Batfilename,File2run + SPACE + Param + ' >' + log);
  310.             RunAndWait(Batfilename,'');
  311.             if fileexists(log) then
  312.             DosOutput.LoadFromFile(log);
  313.             exitCode := 0;
  314.             end;
  315.         else
  316.         ExitCode := -1;
  317.         end;
  318.  
  319.         Case Action of
  320.         Ex_LoadContents : Loadfilelist;
  321.         end;
  322.  
  323.         end else
  324.         begin
  325.         ExitCode:= -1;
  326.         k := GetStringInINI(IniFilename,INFO,'DOWNLOAD','<none>');
  327.         MessageBox(0,
  328.         pchar('Cannot found executable specified in Extension script' + #13 + 'D/L Info > ' + k),
  329.         pchar('Not found!'),
  330.         0);
  331.         end;
  332.  
  333.  
  334.  
  335.         DosOutput.Add('Exitcode = ' + Inttostr(Exitcode))
  336.  
  337. end;
  338.  
  339. function TCakExt.Supportactions(Archivetype : string; Action : worktypeEx) : boolean;
  340. var IniFilename,atype : string;
  341. begin
  342.         if Archivetype = '' then
  343.                 begin
  344.                 Result := false;
  345.                 exit;
  346.                 end;
  347.         if Archivetype[1] = '.' then
  348.                 atype := copy(archivetype,2,length(archivetype)-1) else
  349.                 atype := archivetype;
  350.         Inifilename := Appendslash(ScriptPath) + Atype + SCRIPTEXT;
  351.         Case Action of
  352.         Ex_None : Result := false;
  353.         Ex_LoadContents : result := (GetIntegerInIni(inifilename, FEATURES, 'LIST',0) = 1);
  354.         Ex_Extract : result := (GetIntegerInIni(inifilename, FEATURES, 'EXTRACT',0) = 1);
  355.         Ex_Test : result := (GetIntegerInIni(inifilename, FEATURES, 'TEST',0) = 1);
  356.         Ex_Add : result := (GetIntegerInIni(inifilename, FEATURES, 'ADD',0) = 1);
  357.         Ex_Delete : result := (GetIntegerInIni(inifilename, FEATURES, 'DELETE',0) = 1);
  358.         Ex_SFX : result := (GetIntegerInIni(inifilename, FEATURES, 'SFX',0) = 1);
  359.         else result := false;
  360.         end;
  361. end;
  362.  
  363. function TCakExt.TranslateString(Inifilename, Macroname, Archivename : string; var Executename : string) : string;
  364. var k,l : string;
  365.     i,j : integer;
  366.     Newmacro : string;
  367. function Locatemacro(Macroname : string) : string;
  368. var k : string;
  369. begin
  370.          k := '';
  371.          if (Macroname = 'ADD') or (Macroname = 'EXTRACT') or
  372.            (Macroname = 'LIST') or (Macroname = 'TEST') or
  373.            (Macroname = 'DELETE') or (Macroname = 'SFX') then
  374.                 k := GetStringInIni(Inifilename,COMMANDS,Macroname,'') else
  375.          if (Macroname = 'EXEPATH') or (Macroname = 'UNEXEPATH') then
  376.                 k := GetStringInIni(Inifilename,PATHS,Macroname,'') else
  377.          if (Macroname = 'ARCHIVE-NAME') then
  378.                 k := Removefileext(Archivename) else
  379.          if (Macroname = 'ARCHIVE-EXT') then
  380.                 k := Extractfileext(Archivename) else
  381.          if (Macroname = 'ADDFILE') or (Macroname = 'FILE2ADD') then
  382.                 k := AddOptionsEx.add_files else
  383.          if (Macroname = 'EXTRACTTO') then
  384.                 k := ExtractOptionsEx.extr_to else
  385.          if (Macroname = 'FILE2EXTR') then
  386.                 k := ExtractOptionsEx.extract_files else
  387.           if (Macroname = 'FILE2DEL') then
  388.                 k := DeleteOptionsEx.del_files else
  389.  
  390.          k := GetStringInIni(Inifilename,STRINGS,Macroname,'');
  391.          result := k;
  392. end;
  393. procedure Translate;
  394. begin
  395.         NewMacro := Copy(k,i+1,j-i-1);
  396.         if (NewMacro = 'EXEPATH') or (NewMacro = 'UNEXEPATH') then
  397.         begin
  398.         Executename := LocateMacro(NewMacro);
  399.         l := '';
  400.         end else
  401.         l := LocateMacro(NewMacro);
  402.         k := Copy(k,0,i-1) + l + Copy(k,j+1,length(k) - j);
  403. end;
  404. procedure Looptranslate;
  405. begin
  406.         i := pos(MACRO,k);
  407.          while i <> 0 do
  408.          begin
  409.          j := i + 1;
  410.          while (k[j] <> MACRO) and (j < length(k)) do
  411.                         Inc(j);
  412.  
  413.          if k[j] <> MACRO then
  414.                         begin
  415.                         result := ERROR;
  416.                         exit;
  417.                         end
  418.                         else
  419.                         Translate;
  420.                         
  421.          i := pos(MACRO,k);
  422.          end;
  423. end;
  424. begin
  425.          k := LocateMacro(Macroname);
  426.          looptranslate;
  427.          result := k;
  428.  
  429. end;
  430.  
  431.  
  432. procedure TCakExt.RePollScriptDirectory;
  433. var sr: TSearchRec;
  434.     k: string;
  435.     FileAttrs : integer;
  436. begin
  437.         k := Appendslash(Scriptpath) + SCRIPTFILTER;
  438.         FileAttrs := 0;
  439.         FileAttrs := FileAttrs + faAnyFile;
  440.         supporttype :=  '';
  441.         if FindFirst(k , FileAttrs, sr) = 0 then
  442.         begin
  443.         supporttype := supporttype + SPACE + DOT + Removefileext(sr.name);
  444.         while (FindNext(sr) = 0) do
  445.              supporttype := supporttype + SPACE + DOT + Removefileext(sr.name);
  446.         end;
  447.         FindClose(sr);
  448. end;
  449.  
  450.  
  451. procedure Register;
  452. begin
  453.   RegisterComponents('Qzip', [TCakExt]);
  454. end;
  455.  
  456. end.
  457.