unit Gen1;
(************************************************************************
 Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
      Eric W. Engler and Chris Vleghert.

   This file is part of TZipMaster Version 1.9.

    TZipMaster is free software: you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    TZipMaster is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.

    contact: problems@delphizip.org (include ZipMaster in the subject).
    updates: http://www.delphizip.org
    DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip 
************************************************************************)


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button2: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
//    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    funcs: TStringList;
    template: TStringList;
  public
    function LoadFuncList(const fn: string): Integer;
    function LoadTemplate(const fn: string): Integer;
    function MakeAsm(const aName, sName: string): Integer;
//    function MakeAsm(dll: Integer; const fn: String): Integer;
    function MakeFunc(dst: TStrings; const func: string; dll: Integer): integer;
//    function Process(const base: string): Integer;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
                
//#define DLL_KERNEL32        0
//#define DLL_USER32          1
//#define DLL_SHELL32         2
const
  MAX_DLL = 2;
  DLL_Names: array [0..MAX_DLL] of string = (
    'KERNAL' , 'USER', 'SHELL');
//  ASM_Names: array [0..MAX_DLL] of string = (
//    'DZKnl.asm', 'DZUsr.asm', 'DZShl.asm');

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(funcs);
  FreeAndNil(template);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  funcs := TSTringList.Create;
  template := TStringList.Create;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  l: integer;
begin
  try
    l := LoadFuncList('..\FuncList.txt');
  except
    l := -999;
  end;
  if l < 1 then
  begin
    Memo1.Lines.Add(' could not load function list');
    exit;
  end;
  try
    l := MakeAsm('..\jmps.asm', '..\funcs.cpp');
  except
    l := -999;
  end;
  if l < 12 then
  begin
    Memo1.Lines.Add(' could not write asm');
    exit;
  end;              
end;

function TForm1.LoadFuncList(const fn: string): Integer;
var
  good: boolean;
  i: integer;
  n: integer;
  c: integer;
  s: string;
  d: string;
  f: string;
begin
  funcs.Clear;
  funcs.LoadFromFile(fn);
  i := funcs.Count -1;
  while i >= 0 do
  begin
    good := false;
    s := StringReplace(funcs[i], ' ', '', [rfReplaceAll]);
    if (Length(s) > 6) and (s[1] in ['A'..'Z'])   then
    begin
      c := Pos(',', s);
      if c >= 5 then
      begin
        d := copy(s, 1, c-1);
        for n := 0 to MAX_DLL do
          if d = Dll_Names[n] then
          begin
            // check the function
            f := copy(s, c+1, 70);
            if (length(f) >= 4) and (f[1] in ['a'..'z', 'A'..'Z', '_']) then
            begin
              good := True;
            end;
            break;
          end;
      end;
    end;
    if not good then
    begin
      Memo1.Lines.Add(' removed ' + funcs[i]);
      funcs.Delete(i);  // remove rubbish
    end;
    dec(i);
  end;
  Result := funcs.Count;
end;

function TForm1.LoadTemplate(const fn: string): Integer;
begin
  template.Clear;
  template.LoadFromFile(fn);
  Result := template.Count;
end;

function DllNo(const dname: string): Integer;
begin
  result := 0;
  while Result <= MAX_Dll do
  begin
    if dname = Dll_Names[Result] then
      exit;
    inc(Result);
  end;
  Result := -1;
end;

function TForm1.MakeAsm(const aName, sName: string): Integer;
var
//  ids: integer;
  asmtxt: TStringList;
  nametxt: TStringList;
  func: string;
  i: integer;
  c: integer;
  dll: integer;
  d: string;
  s: string;
begin
  Result := 10;
  nametxt := nil;
  asmtxt := TStringList.Create;
  try
    nametxt := TStringList.Create;
    asmtxt.Add('        .486p');
    asmtxt.Add('        model flat');
    asmtxt.Add('  ');
    for i := 0 to Funcs.Count - 1 do
    begin
      s := funcs[i];
      c := Pos(',', s);
      if c >= 5 then
      begin
        d := copy(s, 1, c-1);
        dll := DllNo(d);
        if dll < 0 then
        begin
          Memo1.Lines.Add('  failed to make: ' + s);
          exit;
        end;
        // get the function
        func := copy(s, c+1, 70);       
        asmtxt.Add('        extern z' + func + ' : proc');
        asmtxt.Add('        global ' + func + ' : proc');
      end;
    end;
    asmtxt.Add('  ');
    asmtxt.Add('        public _u_jmps');
    asmtxt.Add('  ');
    asmtxt.Add('_DATA   segment dword public use32 ''DATA''');
    asmtxt.Add('_u_jmps:');
    for i := 0 to Funcs.Count - 1 do
    begin
      s := funcs[i];
      c := Pos(',', s);
      if c >= 5 then
      begin
        // get the function
        func := copy(s, c+1, 70);
        asmtxt.Add('        dd z' + func);
      end;
    end;
    asmtxt.Add('_DATA   ends');
    asmtxt.Add('  ');
    asmtxt.Add('_TEXT   segment dword public use32 ''CODE''');  
    nametxt.Add(' ');
//    nametxt.Add('STRINGTABLE LANGUAGE 9, 1 // 0409');
    nametxt.Add('const char *func_names[] =');
    nametxt.Add('{');
//    ids := 512;
    Result := 0;
    for i := 0 to Funcs.Count - 1 do
    begin
      s := funcs[i];
      c := Pos(',', s);
      if c >= 5 then
      begin
        d := copy(s, 1, c-1);
        dll := DllNo(d);
        if dll < 0 then
        begin
          Memo1.Lines.Add('  failed to make: ' + s);
          Result := -1;
          break;
        end;
        // get the function
        func := copy(s, c+1, 70);
        asmtxt.Add(func + ' proc near');
        asmtxt.Add('        jmp dword ptr [_u_jmps + ' + IntToStr(i * 4) + ' ]');
        asmtxt.Add(func + ' endp');
        asmtxt.Add('  ');
//        nametxt.Add('    ' + IntToStr(ids) + ', "' + IntToStr(dll) + func + '"');
        nametxt.Add('    "' + IntToStr(dll) + func + '",');
        inc(Result);
//        inc(ids);
      end;
    end;
    asmtxt.Add('_TEXT   ends');
    asmtxt.Add('  ');
    asmtxt.Add('      end');   
//    nametxt.Add('}  ');
    nametxt.Add('    0');
    nametxt.Add('};');
    if Result > 0 then
    begin
      asmtxt.SaveToFile(aname);
      nametxt.SaveToFile(sName);
    end;
  finally
    asmtxt.Free;
    FreeAndNil(nametxt);
  end;
end;

function TForm1.MakeFunc(dst: TStrings; const func: string; dll: Integer):
    integer;
var
  lno: integer;
  active: boolean;
  s: string;
  dno: string;
begin
  Memo1.Lines.Add('Making: ' + DLL_Names[dll] + '.' + func);
  Result := 0;
  active := false;
  dno := IntToStr(dll);
  for lno := 0 to template.Count -1 do
  begin
    s := template[lno];     
    if (length(s) >= 3) and (copy(s, 1, 3) = ';;;') then
    begin
      if active then
        break;
      active := true;
      continue;
    end;
    if active then
    begin
      s := StringReplace(s, 'NAME', func, [rfReplaceAll]);
      s := StringReplace(s, 'DLL', dno, [rfReplaceAll]);
      dst.Add(s);
      inc(Result);
    end;
  end;
end;


end.