Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit Gen1;
  2. (************************************************************************
  3.  Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  4.       Eric W. Engler and Chris Vleghert.
  5.  
  6.    This file is part of TZipMaster Version 1.9.
  7.  
  8.     TZipMaster is free software: you can redistribute it and/or modify
  9.     it under the terms of the GNU Lesser General Public License as published by
  10.     the Free Software Foundation, either version 3 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     TZipMaster is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU Lesser General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU Lesser General Public License
  19.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  20.  
  21.     contact: problems@delphizip.org (include ZipMaster in the subject).
  22.     updates: http://www.delphizip.org
  23.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  24. ************************************************************************)
  25.  
  26.  
  27. interface
  28.  
  29. uses
  30.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  31.   Dialogs, StdCtrls, ExtCtrls;
  32.  
  33. type
  34.   TForm1 = class(TForm)
  35.     Memo1: TMemo;
  36.     Panel1: TPanel;
  37.     Button2: TButton;
  38.     procedure FormDestroy(Sender: TObject);
  39.     procedure FormCreate(Sender: TObject);
  40. //    procedure Button1Click(Sender: TObject);
  41.     procedure Button2Click(Sender: TObject);
  42.   private
  43.     { Private declarations }
  44.     funcs: TStringList;
  45.     template: TStringList;
  46.   public
  47.     function LoadFuncList(const fn: string): Integer;
  48.     function LoadTemplate(const fn: string): Integer;
  49.     function MakeAsm(const aName, sName: string): Integer;
  50. //    function MakeAsm(dll: Integer; const fn: String): Integer;
  51.     function MakeFunc(dst: TStrings; const func: string; dll: Integer): integer;
  52. //    function Process(const base: string): Integer;
  53.     { Public declarations }
  54.   end;
  55.  
  56. var
  57.   Form1: TForm1;
  58.  
  59. implementation
  60.  
  61. {$R *.dfm}
  62.                
  63. //#define DLL_KERNEL32        0
  64. //#define DLL_USER32          1
  65. //#define DLL_SHELL32         2
  66. const
  67.   MAX_DLL = 2;
  68.   DLL_Names: array [0..MAX_DLL] of string = (
  69.     'KERNAL' , 'USER', 'SHELL');
  70. //  ASM_Names: array [0..MAX_DLL] of string = (
  71. //    'DZKnl.asm', 'DZUsr.asm', 'DZShl.asm');
  72.  
  73. procedure TForm1.FormDestroy(Sender: TObject);
  74. begin
  75.   FreeAndNil(funcs);
  76.   FreeAndNil(template);
  77. end;
  78.  
  79. procedure TForm1.FormCreate(Sender: TObject);
  80. begin
  81.   funcs := TSTringList.Create;
  82.   template := TStringList.Create;
  83. end;
  84.  
  85. procedure TForm1.Button2Click(Sender: TObject);
  86. var
  87.   l: integer;
  88. begin
  89.   try
  90.     l := LoadFuncList('..\FuncList.txt');
  91.   except
  92.     l := -999;
  93.   end;
  94.   if l < 1 then
  95.   begin
  96.     Memo1.Lines.Add(' could not load function list');
  97.     exit;
  98.   end;
  99.   try
  100.     l := MakeAsm('..\jmps.asm', '..\funcs.cpp');
  101.   except
  102.     l := -999;
  103.   end;
  104.   if l < 12 then
  105.   begin
  106.     Memo1.Lines.Add(' could not write asm');
  107.     exit;
  108.   end;              
  109. end;
  110.  
  111. function TForm1.LoadFuncList(const fn: string): Integer;
  112. var
  113.   good: boolean;
  114.   i: integer;
  115.   n: integer;
  116.   c: integer;
  117.   s: string;
  118.   d: string;
  119.   f: string;
  120. begin
  121.   funcs.Clear;
  122.   funcs.LoadFromFile(fn);
  123.   i := funcs.Count -1;
  124.   while i >= 0 do
  125.   begin
  126.     good := false;
  127.     s := StringReplace(funcs[i], ' ', '', [rfReplaceAll]);
  128.     if (Length(s) > 6) and (s[1] in ['A'..'Z'])   then
  129.     begin
  130.       c := Pos(',', s);
  131.       if c >= 5 then
  132.       begin
  133.         d := copy(s, 1, c-1);
  134.         for n := 0 to MAX_DLL do
  135.           if d = Dll_Names[n] then
  136.           begin
  137.             // check the function
  138.             f := copy(s, c+1, 70);
  139.             if (length(f) >= 4) and (f[1] in ['a'..'z', 'A'..'Z', '_']) then
  140.             begin
  141.               good := True;
  142.             end;
  143.             break;
  144.           end;
  145.       end;
  146.     end;
  147.     if not good then
  148.     begin
  149.       Memo1.Lines.Add(' removed ' + funcs[i]);
  150.       funcs.Delete(i);  // remove rubbish
  151.     end;
  152.     dec(i);
  153.   end;
  154.   Result := funcs.Count;
  155. end;
  156.  
  157. function TForm1.LoadTemplate(const fn: string): Integer;
  158. begin
  159.   template.Clear;
  160.   template.LoadFromFile(fn);
  161.   Result := template.Count;
  162. end;
  163.  
  164. function DllNo(const dname: string): Integer;
  165. begin
  166.   result := 0;
  167.   while Result <= MAX_Dll do
  168.   begin
  169.     if dname = Dll_Names[Result] then
  170.       exit;
  171.     inc(Result);
  172.   end;
  173.   Result := -1;
  174. end;
  175.  
  176. function TForm1.MakeAsm(const aName, sName: string): Integer;
  177. var
  178. //  ids: integer;
  179.   asmtxt: TStringList;
  180.   nametxt: TStringList;
  181.   func: string;
  182.   i: integer;
  183.   c: integer;
  184.   dll: integer;
  185.   d: string;
  186.   s: string;
  187. begin
  188.   Result := 10;
  189.   nametxt := nil;
  190.   asmtxt := TStringList.Create;
  191.   try
  192.     nametxt := TStringList.Create;
  193.     asmtxt.Add('        .486p');
  194.     asmtxt.Add('        model flat');
  195.     asmtxt.Add('  ');
  196.     for i := 0 to Funcs.Count - 1 do
  197.     begin
  198.       s := funcs[i];
  199.       c := Pos(',', s);
  200.       if c >= 5 then
  201.       begin
  202.         d := copy(s, 1, c-1);
  203.         dll := DllNo(d);
  204.         if dll < 0 then
  205.         begin
  206.           Memo1.Lines.Add('  failed to make: ' + s);
  207.           exit;
  208.         end;
  209.         // get the function
  210.         func := copy(s, c+1, 70);      
  211.         asmtxt.Add('        extern z' + func + ' : proc');
  212.         asmtxt.Add('        global ' + func + ' : proc');
  213.       end;
  214.     end;
  215.     asmtxt.Add('  ');
  216.     asmtxt.Add('        public _u_jmps');
  217.     asmtxt.Add('  ');
  218.     asmtxt.Add('_DATA   segment dword public use32 ''DATA''');
  219.     asmtxt.Add('_u_jmps:');
  220.     for i := 0 to Funcs.Count - 1 do
  221.     begin
  222.       s := funcs[i];
  223.       c := Pos(',', s);
  224.       if c >= 5 then
  225.       begin
  226.         // get the function
  227.         func := copy(s, c+1, 70);
  228.         asmtxt.Add('        dd z' + func);
  229.       end;
  230.     end;
  231.     asmtxt.Add('_DATA   ends');
  232.     asmtxt.Add('  ');
  233.     asmtxt.Add('_TEXT   segment dword public use32 ''CODE''');  
  234.     nametxt.Add(' ');
  235. //    nametxt.Add('STRINGTABLE LANGUAGE 9, 1 // 0409');
  236.     nametxt.Add('const char *func_names[] =');
  237.     nametxt.Add('{');
  238. //    ids := 512;
  239.     Result := 0;
  240.     for i := 0 to Funcs.Count - 1 do
  241.     begin
  242.       s := funcs[i];
  243.       c := Pos(',', s);
  244.       if c >= 5 then
  245.       begin
  246.         d := copy(s, 1, c-1);
  247.         dll := DllNo(d);
  248.         if dll < 0 then
  249.         begin
  250.           Memo1.Lines.Add('  failed to make: ' + s);
  251.           Result := -1;
  252.           break;
  253.         end;
  254.         // get the function
  255.         func := copy(s, c+1, 70);
  256.         asmtxt.Add(func + ' proc near');
  257.         asmtxt.Add('        jmp dword ptr [_u_jmps + ' + IntToStr(i * 4) + ' ]');
  258.         asmtxt.Add(func + ' endp');
  259.         asmtxt.Add('  ');
  260. //        nametxt.Add('    ' + IntToStr(ids) + ', "' + IntToStr(dll) + func + '"');
  261.         nametxt.Add('    "' + IntToStr(dll) + func + '",');
  262.         inc(Result);
  263. //        inc(ids);
  264.       end;
  265.     end;
  266.     asmtxt.Add('_TEXT   ends');
  267.     asmtxt.Add('  ');
  268.     asmtxt.Add('      end');  
  269. //    nametxt.Add('}  ');
  270.     nametxt.Add('    0');
  271.     nametxt.Add('};');
  272.     if Result > 0 then
  273.     begin
  274.       asmtxt.SaveToFile(aname);
  275.       nametxt.SaveToFile(sName);
  276.     end;
  277.   finally
  278.     asmtxt.Free;
  279.     FreeAndNil(nametxt);
  280.   end;
  281. end;
  282.  
  283. function TForm1.MakeFunc(dst: TStrings; const func: string; dll: Integer):
  284.     integer;
  285. var
  286.   lno: integer;
  287.   active: boolean;
  288.   s: string;
  289.   dno: string;
  290. begin
  291.   Memo1.Lines.Add('Making: ' + DLL_Names[dll] + '.' + func);
  292.   Result := 0;
  293.   active := false;
  294.   dno := IntToStr(dll);
  295.   for lno := 0 to template.Count -1 do
  296.   begin
  297.     s := template[lno];    
  298.     if (length(s) >= 3) and (copy(s, 1, 3) = ';;;') then
  299.     begin
  300.       if active then
  301.         break;
  302.       active := true;
  303.       continue;
  304.     end;
  305.     if active then
  306.     begin
  307.       s := StringReplace(s, 'NAME', func, [rfReplaceAll]);
  308.       s := StringReplace(s, 'DLL', dno, [rfReplaceAll]);
  309.       dst.Add(s);
  310.       inc(Result);
  311.     end;
  312.   end;
  313. end;
  314.  
  315.  
  316. end.
  317.