{ -------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                    }
{ (c) 2003-2025  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. }
{ -------------------------------------------------------------------- }

{ CrossPoint - Erweitertes Startup fuer FreeXP } 

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

unit xp2m;

interface

uses crt, xpcfg,
     dos,dosx,typeform,fileio,keys,inout,winxp,mouse,datadef,database,
     databaso,maske,video,help,printerx,lister,win2,maus2,crc,clip,
     resource,montage, xpglobal, xp0,xp1,xp10,xp1o2,xp1input,
     xp1help,xp5,xpdatum,lfn;

procedure testmpuffer;
{$IFNDEF NO386}
procedure test_dll;
{$ENDIF}
procedure ReadDomainlist;

implementation

uses xp2b,xp1o,xpe,xp3,xp9bp,xp9,xpnt,xpfido,xpkeys,xpreg,xpovl,hashfile;

procedure testmpuffer;
var i    : byte;
    s    : string[2];
    x,y  : byte;
begin
  {$IFDEF Debug }
  dbLog('-- MPUFFER-Groesse testen');
  {$ENDIF }
  for i:=0 to 19 do
  begin
    str(i,s);
    if exist('MPUFFER.'+s) then
    begin
      if (_filesize('MPUFFER.'+s)+(MinMB*$100000))<0 then
      begin
        pushhp(22805);
        msgbox((length(getres2(206,4))-2)+length(s)+6,8,'',x,y);
        moff;
        wrt(x+3,y+1,getres2(206,1));     { 'WARNUNG!' }
        wrt(x+3,y+3,getreps2(206,4,s));  { 'Die Ablage %s neigt sich dem Limit von 2 GB zu' }
        wrt(x+3,y+6,getres(12));         { 'Taste drcken ...' }
        freeres;
        mon;
        errsound; delay(60); errsound; delay(60); errsound;
        inout.cursor(curon);
        DisableDOS:=true;
        wkey(30,false);
        DisableDOS:=false;
        inout.cursor(curoff);
        closebox;
        pophp;
      end;
    end;
  end;
end;

{$IFNDEF NO386}
procedure test_dll;
var x,y,dll : byte;
          z : taste;

  { dll: 0 = XP_NTVDM.DLL fehlt            }
  {      1 = falsche XP_NTVDM.DLL-Revision }

begin
  if WinVersion=4 then
  begin
    if not exist('XP_NTVDM.DLL') then
      dll:=0
    else if not xp_ntvdm_ok or (xp_ntvdm_ver<>DLLVersion) then
      if copy(getenv('PUBLIC'),4,5)='Users' then
        exit                { Vista: PUBLIC=C:\Users\Public }
      else                            
        dll:=1
    else
      exit;
    msgbox(40,7,'',x,y);
    moff;
    if dll=0 then
      wrt(x+3,y+2,'XP_NTVDM.DLL fehlt!')
    else
      wrt(x+3,y+2,'Falsche Revision von XP_NTVDM.DLL!');
    mon;
  { pushhp(xxxx); }
    quit:=(ReadButton(x+3,y+5,2,'*'+getres2(530,30),1,true,z)<>1);
  { pophp; }
    closebox;
    freeres;
  end;
end;
{$ENDIF}

procedure ReadDomainlist;
var d   : DB;
    p   : DomainNodeP;
    dom : string[120];
    t : byte;

  function smaller(dl:DomainNodeP):boolean;
  begin
    smaller:=(dom<dl^.domain^);
  end;

  procedure InsertIntoList(var dl:DomainNodeP);
  begin
    if dl=nil then
      dl:=p
    else
      if smaller(dl) then
        InsertIntoList(dl^.left)
      else
        InsertIntoList(dl^.right);
  end;

  procedure freeDomainList(var DomainList:DomainNodeP);
  var lauf : DomainNodeP;
  begin
    if Assigned(Domainlist) then begin
      freeDomainList(DomainList^.left);
      lauf:=DomainList^.right;
      Dispose(DomainList);
      freeDomainList(lauf);
    end;
  end;

begin
  freeDomainList(DomainList);
  DomainList:=nil;
  dbOpen(d,BoxenFile,0);
  while not dbEOF(d) do
  begin
    inc(ntused[dbReadInt(d,'netztyp')]);
    if ntDomainReply(dbReadInt(d,'netztyp')) then
    begin
      new(p);
      t:=dbReadInt(d,'netztyp');
      if t in [nt_UUCP] then begin
        dom:=lstr(dbReadStr(d,'fqdn'));
        if dom='' then dom:=lstr(dbReadStr(d,'pointname')+dbReadStr(d,'domain'));
      end
      else if t in [nt_Client] then begin
        dom:=lstr(dbReadStr(d,'fqdn'));
        if dom='' then dom:=lstr(md5sum_str(dbReadStr(d,'email'))+'.mids.freexp.de');
      end 
      else 
       begin
        dom:=lstr(dbReadStr(d,'fqdn'));
        if dom='' then dom:=lstr(dbReadStr(d,'pointname')+'.'+dbReadStr(d,'boxname')+
                                 dbReadStr(d,'domain'));
      end;
      getmem(p^.domain,length(dom)+1);
      p^.domain^:=dom;
      p^.left:=nil;
      p^.right:=nil;
      insertintolist(DomainList);
    end;
    dbNext(d);
  end;
  dbClose(d);
end;

begin
end.

