1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:

library DelphiDLL;
{
  element 5 AG / ShareIt!
  dll key generator example implementation
  version 2.5
}

uses
  Windows,
  SysUtils,Inifiles;

const // error result codes supported by element 5
  ERC_SUCCESS = 0;
  ERC_ERROR = 10;
  ERC_MEMORY = 11;
  ERC_FILE_IO = 12;
  ERC_BAD_ARGS = 13;
  ERC_BAD_INPUT = 14;
  ERC_EXPIRED = 15;
  ERC_INTERNAL = 16;
  MAX_RESULT = 4000;

// generate a key with some sort of algorithm, in this case, simply
var
  co,cp:char;
  coa:array[0..1]of char;
  glob_username,glob_vdate,glob_title,glob_id:string;

// return the parameters, i.e. key := '';
function GenKeyEx(ap: PInteger; userkey, cckey: PChar): Integer; export; stdcall;
var
  RDI:TIniFile;
  n,chk,my_expire:integer;
  tag, value: PChar;     // pointers for input processing
  ini_path,regtext,cctext,lang_id,reg_prod,reg_id,reg_name, email,regcode,dereg,exp_date: string;   // variables to hold assigned values (add more if needed)
begin
   // init error code and check for nil arguments
  if (ap = nil) then begin
    result := ERC_BAD_INPUT;
    exit;
  end;

  // iterate through args
  while (ap^ <> 0) do begin
    // get next tag
    tag := PChar(ap^); Inc(ap);
    if (tag = nil) then break;

    // get assigned value for tag
    value := PChar(ap^); Inc(ap);
    if (value = nil) then break; // oops a tag without a value

    // assign tag value
    if (StrIComp(tag, 'PRODUCT_ID') = 0) then
      begin
      reg_prod := StrPas(value);

      {Applikationsnamen aus ini lesen}
      try

      for n:=0 to length(reg_prod)-1 do chk:=strtoint(copy(reg_prod,n,1));
      except
      reg_prod:='';
      end;
      if reg_prod<>'' then
       begin
       try
       ini_path:=GetCurrentDir;
       if (ini_path<>'') and (copy(ini_path,length(ini_path),1)<>'\') then ini_path:=ini_path+'\';
       RDI:=TIniFile.Create(ini_path+reg_prod+'.ini');
       if RDI.ValueExists('General','AppName') then reg_prod:=RDI.ReadString('General','AppName','') else reg_prod:='';
       if RDI.ValueExists('General','AppTitle') then glob_title:=RDI.ReadString('General','AppTitle','') else glob_title:='';
       if glob_title='' then glob_title:=reg_prod;

       if RDI.ValueExists('Expire','Days') then my_expire:=RDI.ReadInteger('Expire','Days',0) else my_expire:=0;

       finally
       RDI.Free;
       end;
       end;
      end
    else if (StrIComp(tag, 'ADDITIONAL1') = 0) then
      begin
      reg_id := StrPas(value);
      try
      for n:=0 to length(reg_id)-1 do chk:=strtoint(copy(reg_id,n,1));
      except
      reg_id:='';
      end;
      end
    else if (StrIComp(tag, 'LANGUAGE_ID') = 0) then
      begin
      lang_id := StrPas(value);
      end
    else if (StrIComp(tag, 'REG_NAME') = 0) then
      begin
      reg_name := StrPas(value);
      end
    else if (StrIComp(tag, 'EMAIL') = 0) then
      begin
      email := StrPas(value);
      end;
    // add more lines if needed ...
  end;

  //Zu lanen Regnamen verhindern
  reg_name:=trim(reg_name);
  if length(reg_name)>24 then reg_name:=copy(reg_name,1,24);

  // generate key - change to your liking
  if (reg_prod<>'') and (reg_name <> '') and (reg_id <>'') and (length(reg_id)=10) and (email <> '') then begin
   reg_name:=glob_username;
   regcode:='dummykey';
   
   if lang_id='2' then
    begin
    regtext:='Vielen Dank für Ihre Registrierung!'#13#10#13#10'Produkt: '+glob_title+#13#10#13#10+
             'Name: '+reg_name+#13#10'ID: '+reg_id+#13#10'Code: '+regcode+#13#10#13#10;
    end
   else
    begin
    regtext:='Thank you for registering!'#13#10#13#10'Product: '+glob_title+#13#10#13#10+
             'Name: '+reg_name+#13#10'ID: '+reg_id+#13#10'Code: '+regcode+#13#10#13#10;
    end;

   cctext:='Produkt: '+reg_prod+#13#10#13#10+
            'Name: '+reg_name+#13#10'ID: '+reg_id+
             #13#10'Code: '+regcode;

   StrLCopy(cckey, PCHar(cctext), MAX_RESULT);
   StrLCopy(userkey, PChar(regtext), MAX_RESULT);

   result := ERC_SUCCESS;
  end else begin
   result := ERC_BAD_INPUT;
  end;
end;

exports
  GenKeyEx index 1 name 'GenKeyEx'; // do not change

// library initialization code
begin
  // if required add your init code here
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

function GenKeyEx(ap: PInteger; userkey, cckey: PChar): Integer; stdcall;
external 'delphiDLL.dll';
var
  Form1: TForm1;

const // error result codes supported by element 5
  ERC_SUCCESS = 0;
  ERC_ERROR = 10;
  ERC_MEMORY = 11;
  ERC_FILE_IO = 12;
  ERC_BAD_ARGS = 13;
  ERC_BAD_INPUT = 14;
  ERC_EXPIRED = 15;
  ERC_INTERNAL = 16;
  MAX_RESULT = 4000;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type
  PInput = record
    tag: PAnsiChar;
    value: PAnsiChar;
  end;
var
  myres: integer;
  myapp: pinteger;
  myreturn, myreturn1: PAnsiChar;
  mytest: TStrings;
begin
  mytest := TStringList.Create;

  mytest.Add('PURCHASE_ID=0');
  mytest.Add('RUNNING_NO=1');
  mytest.Add('PURCHASE_DATE=24/12/2000');
  mytest.Add('PRODUCT_ID=179983');
  mytest.Add('LANGUAGE_ID=2');
  mytest.Add('QUANTITY=1');
  mytest.Add('REG_NAME=Peter "Test" Müller');
  mytest.Add('ADDITIONAL1=0123456789');
  mytest.Add('ADDITIONAL2=');
  mytest.Add('RESELLER=');
  mytest.Add('LASTNAME=Müller');
  mytest.Add('FIRSTNAME=Peter');
  mytest.Add('COMPANY=');
  mytest.Add('EMAIL=mueller@test.net');
  mytest.Add('PHONE=');
  mytest.Add('FAX=');
  mytest.Add('STREET=');
  mytest.Add('ZIP=');
  mytest.Add('STATE=');
  mytest.Add('COUNTRY=');

  myapp := PInteger(mytest);
  MyReturn:='';
  MyReturn1:='';


  myres := GenKeyEx(myapp, @myReturn, @myreturn1);

  if myres = ERC_ERROR then
  begin
    myReturn := 'ERC_ERROR';
    myReturn1 := myReturn;
  end
  else if myres = ERC_MEMORY then
  begin
    myReturn := 'ERC_MEMORY';
    myReturn1 := myReturn;
  end
  else if myres = ERC_FILE_IO then
  begin
    myReturn := 'ERC_FILE_IO';
    myReturn1 := myReturn;
  end
  else if myres = ERC_BAD_ARGS then
  begin
    myReturn := 'ERC_BAD_ARGS';
    myReturn1 := myReturn;
  end
  else if myres = ERC_BAD_INPUT then
  begin
    myReturn := 'ERC_BAD_INPUT';
    myReturn1 := myReturn;
  end
  else if myres = ERC_EXPIRED then
  begin
    myReturn := 'ERC_EXPIRED';
    myReturn1 := myReturn;
  end
  else if myres = ERC_INTERNAL then
  begin
    myReturn := 'ERC_INTERNAL';
    myReturn1 := myReturn;
  end
  else if myres = MAX_RESULT then
  begin
    myReturn := 'ERC_MAX_RESULT';
    myReturn1 := myReturn;
  end;

  Memo1.Text := myReturn;
  Memo2.Text := myReturn1;

  myTest.Free;
end;

end.