{ ------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                   }
{ (c) 1991-1999 Peter Mandrella                                       }
{ (c) 2000-2001 OpenXP-Team                                           }
{ (c) 2002-2024 FreeXP, http://www.freexp.de                          }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.         }
{                                                                     }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der     }
{ Datei SLIZENZ.TXT oder auf http://www.crosspoint.de/oldlicense.html }
{ ------------------------------------------------------------------- }

{ Registrierung        }

{$I XPDEFINE.INC        }
{$O+,F+       }

unit xpreg;

interface

uses  crt,dos,typeform,fileio,inout,keys,winxp,maus2,maske,resource,
      xp0,xp1,xp1o,xp1o2,xp1input,xpglobal;

procedure license;
procedure BetaMessage;
procedure About;
function  LizenzNummer:string;


implementation  { ---------------------------------------------------        }

procedure license;
var x,y,i : byte;
    s     : string;
    p     : byte;

    msglines : byte;

    sely  : byte;
    sels  : string[80];
    n     : shortint;
    z     : taste;

  procedure ReadReg;
  var x,y  : byte;
      brk  : boolean;
      code : string[20];
      t    : text;
      nr   : longint;
      z    : taste;
  begin
    if not is_freereg then
    begin
      pushhp(1552);
      if ReadJN(getres2(521,1),false) then  { 'Sie sind bereits registriert. Mchten Sie die Registrierung lschen'        }
      with registriert do begin
        _era('regdat.xp');
        nr:=0;
        tc:='F';
        komreg:=false;
        orgreg:=false;
        message(getres2(521,8));    { 'Registrierung wurde gelscht.'        }
        mdelay(1500);
        closebox;
      end;
      pophp;
      exit;
    end;
    code:='';
    dialog(length(getres2(521,2))+27,3,'',x,y);
    maddstring(3,2,getres2(521,2),code,20,20,'');   { 'Registrierungs-Code: '        }
      mhnr(1553);
    readmask(brk);
    enddialog;
    if (code<>'') and (firstchar(code)<'A') then code:='A'+code;
    if brk or (code='') then
    begin
      message(getres2(521,3));    { 'Na, dann eben nicht.'        }
      wkey(2,false);
      closebox;
    end
    else if (cpos('-',code)=0) or
            (ival(copy(code,2,cpos('-',code)-2))=0) then
    begin
      message(getres2(521,4));   { 'Ungltiger Registrierungs-Code.'        }
      wkey(2,false);
      closebox;
    end
    else begin
      if ival(firstchar(code))>0 then
        nr:=ival(left(code,cpos('-',code)-1))
      else
        nr:=ival(copy(code,2,cpos('-',code)-2));
      if IsKomCode(nr) or IsOrgCode(nr) then
      begin
        msgbox(53,8,'',x,y);
        mwrt(x+3,y+2,'Sie sind als nicht-privater '+xp_display+'-Anwender');
        mwrt(x+3,y+3,'registriert. Soll dies in Ihren Nachrichten er-');
        mwrt(x+3,y+4,'kennbar sein?');
        z:='';
        pushhp(1554);
        if readbutton(x+3,y+6,2,getres(107),1,true,z)=1 then  { Ja/Nein        }
          code:='!'+code;
        pophp;
        closebox;
      end;
      assign(t,regdat);
      rewrite(t);
      writeln(t,code);
      close(t);
      msgbox(47,8,'',x,y);
      moff;
      wrt(x+3,y+2,getres2(521,5));   { 'Der Registrierungscode wurde gespeichert.'        }
      wrt(x+3,y+3,getres2(521,6));   { 'CrossPoint beendet sich jetzt selbst und'        }
      wrt(x+3,y+4,getres2(521,7));   { 'muá danach neu gestartet werden.'        }
      wrt(x+3,y+6,getres(12));       { 'Taste drcken ...'        }
      mon;
      xp1.wait(curon);
      quit:=true;
    end;
  end;

label again;

begin
  msglines:=ival(getres2(520,0));
  msgbox(70,msglines+9,'',x,y);
  moff;
  attrtxt(col.colmboxhigh);
  wrt(x+9,y+2,'\\//');
  wrt(x+9,y+3,'//\\');
  attrtxt(col.colmbox);
  wrt(x+3,y+2,'Cross');
  wrt(x+14,y+3,'Point');
  s := '(c) 1992-1999 ' + pm;
  wrt(x+67-length(s),y+1,s);
  s := '(c) 2000-2001' + forms(' ',5) + iifs(deutsch,'OpenXP-Team','OpenXP Team');
  wrt(x+67-length(s),y+2,s);
  s := forms(x_copyright,14) + forms(' ',length(pm)-length(author_name)) + author_name;
  wrt(x+67-length(s),y+3,s);
  s:=getres2(520,19)+LizenzNummer;   { 'Lizenznummer: '        }
  wrt(x+67-length(s),y+4,s);
  for i:=1 to msglines do
  begin
    s:=getres2(520,i);
    gotoxy(x+3,y+5+i);
    repeat
      p:=cposx('*',s);
      write(left(s,p-1));
      delete(s,1,p);
      p:=cposx('*',s);
      attrtxt(col.colmboxhigh);
      write(left(s,p-1));
      attrtxt(col.colmbox);
      delete(s,1,p);
    until s='';
  end;
  sels:=getres2(520,30);  { ' S^LIZENZ.TXT anzeigen , Registrierungs^code eingeben '        }
  mon;
again:
  sely:=y+msglines+7;
  attrtxt(col.colmbox);
  mwrt(x+3,sely,sp(65));
  z:='';
  n:=1;
  pushhp(1551);
  n:=ReadButton(x+3,sely,2,'*'+sels,n,true,z);
  pophp;
  s:='DOC\' + getres2(520,40);   { 'SLIZENZ.TXT'        }
  case n of
    1 : begin
          if not exist(s) then           { 'SLIZENZ.TXT'        }
            fehler(getreps2(520,41,s))   { '%s fehlt!'        }
          else
            if listfile(s,getres2(520,42),true,false,0)=0 then;    { 'D=Drucken    <Esc>=Ende'        }
          goto again;
          end;
    2 : begin
          ReadReg;
          if not quit then goto again;
        end;
  end;
  closebox;
  freeres;
end;

procedure BetaMessage;
var x,y,i,p  : byte;
    msglines : byte;
    z        : taste;
    s        : string;
begin
  msglines:=ival(getres2(530,0));
  msgbox(72,msglines+8,'',x,y);
  moff;
  attrtxt(col.colmboxhigh);
  wrt(x+9,y+2,'\\//');
  wrt(x+9,y+3,'//\\');
  attrtxt(col.colmbox);
  wrt(x+3,y+2,'Cross');
  wrt(x+14,y+3,'Point');
  s := '(c) 1992-1999 ' + pm;
  wrt(x+69-length(s),y+1,s);
  s := '(c) 2000-2001' + forms(' ',5) + iifs(deutsch,'OpenXP-Team','OpenXP Team');
  wrt(x+69-length(s),y+2,s);
  s := forms(x_copyright,14) + forms(' ',length(pm)-length(author_name)) + author_name;
  wrt(x+69-length(s),y+3,s);
  for i:=1 to msglines do begin
    s:=getres2(530,i);
    gotoxy(x+3,y+4+i);
    repeat
      p:=cposx('*',s);
      write(left(s,p-1));
      delete(s,1,p);
      p:=cposx('*',s);
      attrtxt(col.colmboxhigh);
      write(left(s,p-1));
      attrtxt(col.colmbox);
      delete(s,1,p);
    until s='';
  end;
  mon;
  pushhp(1550);
  quit := (ReadButton(x+45,y+msglines+6,2,'*'+getres2(530,30),1,true,z) <> 1);
  pophp;
  closebox;
  freeres;
end;

procedure About;
var x,y : byte;
    z   : taste;
    ver : string;
    addxVer,addxInf,addy : shortint;
    DiaWidth : byte;
begin
  addy := 1;
  ver := xp_xp+' '+verstr+betastr+iifs(rufstr<>'',' ("'+rufstr+'")','')+ovrstr;
 {$IFDEF Snapshot       }
  inc(addy);
 {$ENDIF       }
  { Breite des Dialogs aus Lnge der Versionsbezeichnung,            }
  { URL, eMail-Adresse und "Mandrella-String" (=30) berechnen        }
  DiaWidth:=max(max(max(length(author_url),length(author_mail))+7,length(ver)),30);
  addxVer:=iif(length(ver)=DiaWidth,0,(DiaWidth-length(ver)) div 2);
  addxInf:=iif(addxVer>0,0,(DiaWidth-max(max(length(author_url),length(author_mail))+7,30)) div 2);
  if odd(DiaWidth) then dec(DiaWidth);  { "gerade" Breite erzwingen        }
  diabox(DiaWidth+6,18+addy,'',x,y);
  moff;
  attrtxt(col.colmboxhigh);
  wrt(x+((DiaWidth+6) div 2)-2,y+2,'\\//');
  wrt(x+((DiaWidth+6) div 2)-2,y+3,'//\\');
  wrt(x+3+addxVer,y+5,ver);
  {$IFDEF Snapshot       }
    wrt(x+3+addxVer,y+6,'Snapshot: '+compiletime);
  {$ENDIF       }
  wrt(x+3+addxVer,y+5+addy,getres2(520,19)+LizenzNummer);
  attrtxt(col.colmbox);
  wrt(x+((DiaWidth+6) div 2)-8,y+2,'Cross');
  wrt(x+((DiaWidth+6) div 2)+3,y+3,'Point');
  wrt(x+3+addxInf,y+7+addy,forms('(c) 1992-1999',15)+pm);
  wrt(x+3+addxInf,y+8+addy,forms('(c) 2000-2001',15)+iifs(deutsch,'OpenXP-Team','OpenXP Team'));
  wrt(x+3+addxInf,y+9+addy,forms(x_copyright,15)+author_name);
  wrt(x+3+addxInf,y+11+addy,'Fido : '+author_fido);
  wrt(x+3+addxInf,y+12+addy,'eMail: '+author_mail);
  wrt(x+3+addxInf,y+13+addy,'WWW  : '+author_url);
  mon;
  ReadButton(x+((DiaWidth+6) div 2)-5,y+15+addy,1,'*   ^OK   ',1,true,z);
  closebox;
  freeres;
end;

function LizenzNummer:string;
begin
  with registriert do
    if is_freereg then LizenzNummer:=getres2(361,60) else
    if orgreg then LizenzNummer:='Org-'+tc+strs(nr) else
    if komreg then LizenzNummer:='Kom-'+tc+strs(nr) else
    LizenzNummer:=tc+strs(nr);
end;

end.

