{ ------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                   }
{ (c) 1991-1999 Peter Mandrella                                       }
{ (c) 2000-2001 OpenXP-Team                                           }
{ (c) 2002-2026 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 - StartUp }

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

unit xp2x;

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;

var
  { First start of XP2? }
  XPFirstStart: Boolean;
  
procedure zusatz_menue;
procedure setaltfkeys;

procedure defaultcolors;
procedure readcolors;
procedure setcolors;
procedure readpar;
procedure GetResdata;
procedure FreeResdata;
procedure loadresource;
procedure setmenus;
procedure freemenus;

procedure initvar;
procedure SetNtAllowed;
procedure readconfig;
procedure saveconfig;
procedure SaveConfig2;
procedure cfgsave;       { mit Fenster }
procedure GlobalModified;
function  AskSave:boolean;

procedure setAutoTZ(const XPStart:boolean);
procedure checkTimeZone(const XPStart:boolean);

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

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

procedure setmenu(nr:byte; s:string);
begin
  getmem(menu[nr],length(s)+1);
  menu[nr]^:=s;
end;

procedure zusatz_menue;         { Zusatz-Men neu aufbauen }
var s       : string;
    i,ml    : byte;
    n       : byte;
    m1empty : boolean;
  begin
  freemem(menu[2],length(menu[2]^)+1);
  freemem(menu[menus],length(menu[menus]^)+1);
  s:=''; ml:=14;
  n:=0;

  for i:=1 to 10 do                                  { Zusatzmenue 1-10 }
    with fkeys[0]^[i] do
      if menue<>'' then begin
        s:=s+','+hex(i+$24,3)+menue;
        ml:=max(ml,length(menue)-iif(cpos('^',menue)>0,3,2));
        inc(n);
        end;
  m1empty:=false;
  if s<>'' then s:=',-'+s else m1empty:=true;
  s:='Zusatz,'+forms(getres2(10,100),ml+4)+'@K,'+getres2(10,101)+s;
  getmem(menu[2],length(s)+1);
  menu[2]^:=s;

  s:='';
  for i:=1 to iif(screenlines=25,9,10) do            { Zusatzmenue 11-20 }
    with fkeys[4]^[i] do
      if menue<>'' then begin
        s:=s+','+hex(i+$24,3)+menue;
        ml:=max(ml,length(menue)-iif(cpos('^',menue)>0,3,2));
        inc(n);
        end;
  if m1empty and (s<>'') then s:=',-'+s; 
  getmem(menu[menus],length(s)+1);
  menu[menus]^:=s;
end;

procedure setmenus;
var i : integer;
begin
  for i:=0 to menus do
    if (i<>11) then setmenu(i,getres2(10,i));
  zusatz_menue;
  case videotype of
    0,1 : setmenu(11,'Zeilen,0b125');
    2   : setmenu(11,'Zeilen,0b125,0b226,0b329,0b431,0b535,0b638,0b743,0b850');
    3   : setmenu(11,'Zeilen,0b125,0b226,0b328,0b430,0b533,0b636,0b740,0b844,0b950');
  end;
  FreeRes;
end;


procedure freemenus;
var i : integer;
begin
  for i:=0 to menus do
    freemem(menu[i],length(menu[i]^)+1);
end;


procedure readmenudat;   { Liste der unsichtbaren Menpunkte einlesen }
var f       : file;
    version : integer;
    i,j,w   : integer;
begin
  anzhidden:=0;
  if ParMenu then exit;
{$IFDEF Debug }
  dbLog('-- Mendatei einlesen');
{$ENDIF }
  assign(f,menufile);
  if existf(f) then begin
    reset(f,1);
    blockread(f,version,2);
    if version=1 then begin
      blockread(f,anzhidden,2);
      anzhidden:=minmax(anzhidden,0,min(maxhidden,filesize(f) div 2 - 2));
      if anzhidden>0 then begin
        getmem(hidden,2*anzhidden);
        blockread(f,hidden^,2*anzhidden);
        end;
      end;
    close(f);
    end;
  if anzhidden>0 then             { zur Sicherheit nochmal sortieren... }
    for i:=anzhidden downto 2 do
      for j:=1 to i-1 do
        if hidden^[j]>hidden^[j+1] then begin
          w:=hidden^[j];
          hidden^[j]:=hidden^[j+1];
          hidden^[j+1]:=w;
          end;
end;


procedure HelpScreen;
var n,i     : integer;
    t       : taste;
    sclines : byte;
begin
  DosOutput;
  iomaus:=false;
  n:=res2anz(202);
  writeln;
  sclines:=getscreenlines;
  for i:=1 to n do begin
    writeln(getres2(202,i));
    if (i+5) mod (sclines-1)=0 then
      if not outputredirected then begin
        write(getres(12));
        get(t,curon);
        write(#13,sp(30),#13);
        end;
    end;
  CloseResource;
  runerror:=false;
  halt;
end;


procedure readpar;
var i  : integer;
    s  : string[127];
    t  : text;
    sr : searchrec;

  function _is(ss:string):boolean;
  begin
    _is:=('/'+ss=lstr(s)) or ('-'+ss=lstr(s));
  end;

  function isl(ss:string):boolean;
  begin
    isl:=('/'+ss=lstr(left(s,length(ss)+1))) or
         ('-'+ss=lstr(left(s,length(ss)+1)));
  end;

  function ReplDP(s:string):string;   { Fido-Boxname: "_" -> ":" }
  var p1,p2 : byte;
  begin
    p1:=cpos(':',s);
    p2:=cpos('_',s);
    if (p2>0) and (((p1=0) or ((p2<p1) and (ival(left(s,p2-1))>0)))) then
      s[p2]:=':';
    ReplDP:=s;
  end;

  procedure NetPar(s:string);
  var p : byte;
  begin
    p:=cpos(':',s);
    s:=ReplDP(trim(s));
    if p=0 then
      ParNetcall:=s
    else begin
      ParNetcall:=left(s,min(p-1,BoxNameLen));
      ParNCtime:=formi(ival(copy(s,p+1,2)),2)+':'+formi(ival(copy(s,p+4,2)),2);
      end;
  end;

  procedure UserPar(s:string);
  var p : byte;
  begin
    p:=cpos(':',s);
    s:=ReplDP(s);
    if p=0 then
      writeln('fehlerhafte /user - Option')
    else begin
      s[p]:=' ';
      ParSetuser:=left(s,sizeof(ParSetuser)-1);
      end;
  end;

  procedure SetZeilen(z:byte);
  begin
    case videotype of
      2 : if z in [25,26,29,31,35,38,43,50] then ParZeilen:=z;
      3 : if z in [25,26,28,30,33,36,40,44,50] then ParZeilen:=z;
    end;
  end;

  procedure Par_mailto; { Mailto: Parameter auswerten }
  Var i,j,k :  Byte;
      s2    : string[8];
      s3    : string[128];
  begin                 { -mailto:user@name?subject=betreff;serverbox }
    if deutsch then
    begin
      keyboard('nd');
{     writeln('Deutsch'); }
    end else
    begin
      keyboard('md');
{     writeln('Englisch'); }
    end;
    i:=cposx('\',s);
    if i <= length(s) then keyboard(keyup+mid(s,i+1)+keydown);
    j:=cpos('?',s);       
    k:=cpos('&',s);
    if (k=0) or (j<k) then k:=j;
    if k=0 then k:=i;
    keyboard(copy(s,9,k-9)+keydown);    
    if j>0 then 
    begin 
      s3:=copy(s,j+1,i-j-1);  { Zwischen ? und ; }      
      if ustr(left(s3,4))='SUBJ' then 
      begin
        k:=cposX('&',s3);
        keyboard(copy(s3,9,k-9));
        end;
      end;
    ParNoBeta:=true;
    ParNoDLL:=true;
  end;

  procedure ParAuswerten;
  begin
    if _is('h') or _is('?') then ParHelp:=true else
    if _is('d')    then ParDebug:=true else
    if isl('df:') then ParDebFlags:=ParDebFlags or ival(mid(s,5)) else
    if _is('dd')   then ParDDebug:=true else
    if _is('trace')then ParTrace:=true else
    if _is('m')    then ParMono:=true else
    if _is('j')    then ParNojoke:=true else
    if isl('n:')   then NetPar(ustr(mid(s,4))) else
    if isl('nr:')  then begin
                          NetPar(ustr(mid(s,5)));
                          ParRelogin:=true;
                        end else
    if isl('nsp:') then begin
                          NetPar(ustr(mid(s,6)));
                          ParNSpecial:=true;
                        end else
    if _is('r')    then ParReorg:=true else
    if _is('rp')   then ParTestres:=false else
    if _is('pack') then ParPack:=true else
    if isl('xpack:') then begin
                         ParXpack:=true;
                         ParXPfile:=ustr(copy(s,8,8));
                       end else
    if _is('xpack')then ParXPack:=true else
    if _is('q')    then ParQuiet:=true else
    if _is('maus') then ParMaus:=true else
    if isl('ip:') then ParPuffer:=ustr(copy(s,5,70)) else
    if isl('ipe:')then begin
                         ParPuffer:=ustr(copy(s,6,70));
                         ParPufED:=true;
                       end else
    if _is('g')    then ParGelesen:=true else
    if isl('ips:')then ParSendbuf:=ustr(mid(s,6)) else
    if isl('t:')  then ParTiming:=ival(copy(s,4,2)) else
    if _is('x')    then ParExit:=true else
    if _is('xx')   then ParXX:=true else
    if isl('user:') then UserPar(mid(s,7)) else
    if isl('k:')  then begin
                         if length(s) = 4 then Parkey:=s[4]
                         else begin 
                           parkey:=' ';
                           if length(s)>4 then keyboard(_getmacro(mid(s,4)));
                           end;
                         end else
    if _is('eb')   then ParEmpfbest:=true else
    if _is('pa')   then ParPass:='*' else
    if isl('pa:') then ParPass:=mid(s,5) else
    if isl('pw:') then ParPasswd:=mid(paramstr(i),5) else
    if isl('z:')  then SetZeilen(ival(mid(s,4))) else

    { Achtung! Folgende Reihenfolge muss bleiben! }
    if _is('w0')   then ParWintime:=0 else
    if _is('os2a') then begin ParWintime:=1; ParOS2:=1; end else
    if _is('os2b') then begin ParWintime:=1; ParOS2:=2; end else
    if _is('os2c') then begin ParWintime:=1; ParOS2:=3; end else
    if _is('os2d') then begin ParWintime:=1; ParOs2:=4; end else
    if _is('w')    then ParWintime:=1 else
    if _is('w1')   then ParWintime:=1 else
    if _is('w2')   then ParWintime:=2 else
    { Reihenfolge bis hier }

    if _is('ss')   then ParSsaver:=true else
  { if isl('gd:') then SetGebdat(mid(s,5)) else }
    if isl('av:') then ParAV:=mid(s,5) else
    if isl('autostart:') then ParAutost:=mid(s,12) else
    if isl('l:')  then ParLanguage:=ustr(mid(s,4)) else
    if isl('f:') then ParFontfile:=ustr(mid(s,4)) else
    if _is('nomem')then ParNomem:=true else
    if _is('sd')   then ParNoSmart:=true else
    if _is('lcd')  then ParLCD:=true else
    if _is('menu') then ParMenu:=true else
    if _is('g1')   then ParG1:=true else
    if _is('g2')   then ParG2:=true else
{$IFDEF Beta } { Keine Beta-Meldung anzeigen }
    if _is('nb')   then ParNoBeta:=true else
{$ELSE } { nb bergehen, auch wenn nicht ben”tigt }
    if _is('nb')   then else
{$ENDIF }
    if _is('novdmchk') then ParNoDLL:=true else
    if isl('mailto:') then Par_mailto else
    {Dummy da schon in xpx.pas komplett ausgewertet}
    if _is('noovrbuf')   then else
    if isl('lfn') and (not LFNEnabled) then EnableLFN else
    if isl('312') then OldXPComp := true else
    if _is('nolock') then ParNolock:=true
    else               begin
                         writeln('unbekannte Option: ',paramstr(i),#7);
                         delay(500);
                       end
  end;


  procedure ReadParFile;
  begin
    reset(t);
    while not eof(t) do begin
      readln(t,s);
      s:=trim(s);
      if s<>'' then ParAuswerten;
      end;
    close(t);
  end;

begin
  { Unter Win/OS2/Linux: Default "/w", Rechenzeitfreigabe abschalten mit "/w0" }
  {$IFNDEF NO386}
  if (winversion>0) or (lo(dosversion)>=20) or (DOSEmuVersion <> '')
    then ParWintime:=1;
  {$ENDIF}
  extended:=exist('xtended.15');
  findfirst(AutoxDir+'*.OPT',0,sr);    { permanente Parameter-Datei }
  while doserror=0 do begin
    assign(t,AutoxDir+sr.name);
    ReadParfile;
    findnext(sr);
  end;
  FindClose(sr);
  for i:=1 to paramcount do begin      { Command-Line-Parameter }
    s:=paramstr(i);
    ParAuswerten;
    end;
  findfirst(AutoxDir+'*.PAR',0,sr);    { tempor„re Parameter-Datei }
  while doserror=0 do begin
    assign(t,AutoxDir+sr.name);
    ReadParfile;
    erase(t);
    if ioresult<>0 then
      writeln('Fehler: kann '+AutoxDir+sr.name+' nicht l”schen!');
    findnext(sr);
  end;
  FindClose(sr);
  if VideoType<2 then ParFontfile:='';
  if (ParFontfile<>'') and (ParFontfile[1]<>'*') then
    ParFontfile:=FExpand(ParFontfile);
  if ParDebug then Multi3:=ShowStack;
  if ParDDebug then dbOpenLog('database.log');
  ListDebug:=ParDebug;
  if (left(ParAutost,4)<='0001') and (right(ParAutost,4)>='2359') then
    ParAutost:='';
end;

{$I xp2cfg.inc}

procedure GetResdata;
const intbrett = '$/¯';
var s : string;
    p : byte;
    i : integer;

  procedure getkey(var c:char);
  begin
    if p<=length(s) then begin
      if s[p]='^' then begin
        inc(p);
        c:=chr(ord(s[p])-64);
        end
      else
        c:=s[p];
      inc(p,2);
      end;
  end;

begin
  helpfile:=getres(1);
{$IFDEF UnixFS}
   lostring(helpfile);
{$ENDIF}
  keydeffile:=getres(2);
  _fehler_:=getres2(11,1);
  _hinweis_:=getres2(11,2);
  _daylen_:=ival(getres2(11,3));
  s:=getres2(11,4);
  getmem(_days_,length(s)+1);
  _days_^:=s;
  statbrett:=intbrett+getres2(11,5);
  unvbrett:=intbrett+getres2(11,6);
  netbrett:=intbrett+getres2(11,7);
  _jn_:=getres2(11,8);
  masklanguage(_jn_);
  _wotag_:=getres2(11,9);
  for i:=1 to 12 do
    monat[i].tag:=getres2(11,i+9);
  ListHelpStr:=getres2(11,22);
  freeres;
  if IsRes(22) then begin     { Tastendefinitionen }
    s:=getres2(22,1);         { Bretter }
    p:=1;
    getkey(k0_S);  getkey(k0_A);  getkey(k0_H);  getkey(k0_cH);
    getkey(k0_L);  getkey(k0_E);  getkey(k0_V);  getkey(k0_cT);
    getkey(k0_P);  getkey(k0_Le); getkey(k0_B);  getkey(k0_I);
    getkey(k0_TE); getkey(k0_cG); getkey(k0_cE); getkey(k0_cW);
    getkey(k0_cF); getkey(k0_Ac); getkey(k0_SB);
    s:=getres2(22,2);          { User }
    p:=1;
    getkey(k1_S);  getkey(k1_A);  getkey(k1_H);  getkey(k1_V);
    getkey(k1_L);  getkey(k1_E);  getkey(k1_cV); getkey(k1_B);
    getkey(k1_I);  getkey(k1_TE); getkey(k1_R);  getkey(k1_P);
    getkey(k1_cE); getkey(k1_cW); getkey(k1_U);  getkey(k1_SB);
    s:=getres2(22,3);          { Nachrichten }
    p:=1;
    getkey(k2_S);  getkey(k2_cR); getkey(k2_cH); getkey(k2_I);
    getkey(k2_O);  getkey(k2_H);  getkey(k2_L);  getkey(k2_K);
    getkey(k2_cU); getkey(k2_V);  getkey(k2_cE); getkey(k2_U);
    getkey(k2_cF); getkey(k2_cI); getkey(k2_G);  getkey(k2_cA);
    getkey(k2_KA); getkey(k2_EA); getkey(k2_cW); getkey(k2_cD);
    getkey(k2_R);  getkey(k2_cN); getkey(k2_BB); getkey(k2_A);
    getkey(k2_b);  getkey(k2_cB); getkey(k2_SB); getkey(k2_p);
    getkey(k2_cP); getkey(k2_SP); getkey(k2_cT); getkey(k2_cQ);
    s:=getres2(22,4);          { AutoVersand }
    p:=1;
    getkey(k3_H);  getkey(k3_E);  getkey(k3_L);  getkey(k3_A);
    getkey(k3_T);  getkey(k3_I);  getkey(k3_S);  getkey(k3_K);
    s:=getres2(22,5);          { Lister }
    p:=1;
    getkey(k4_D);  getkey(k4_W);  getkey(k4_L);  getkey(k4_cL);
    getkey(k4_H);  getkey(k4_F);
    freeres;
    end;
end;

procedure FreeResdata;
begin
  freemem(_days_,length(_days_^)+1);
end;


procedure loadresource;             { Sprachmodul laden }
var lf : string[12];
    lf2: string[12];
    sr : searchrec;
    t  : text;
    s  : string[40];
    ca : char;
    choice   : boolean;
    resFiles : string;                 { alle 'XP-?.RES' (je .RES ein char) }
    resOther : string[sizeof(ParLanguage)-1];    { erste gefundene XP-*.RES }

  procedure WrLf;
  begin
    rewrite(t);
    writeln(t,lf);
    close(t);
  end;

  procedure select_language;
  var i : byte;
  begin
    if (resFiles='') and (resOther<>'') then
      ParLanguage:=resOther
    else if length(resFiles)=1 then
      ParLanguage:=resFiles
    else begin                                       { ggf. Auswahl bringen }
      choice:=true;
      ParLanguage:=firstchar(resFiles);
      for i:=1 to length(resFiles) do
        write('<'+resFiles[i]+'>'+
              iifs(resFiles[i]='D','eutsch',iifs(resFiles[i]='E','nglish',''))+
              iifs(i<length(resFiles),' / ',' ?  '+ParLanguage));
      GotoXY(wherex-1,wherey);
      repeat
        ca:=upcase(readkey);
      until (cpos(ca,resFiles)>0) or (ca=keycr);
      if (ca<>keycr) then                               { <Enter> = Default }
      begin
        write(ca);
        parlanguage:=ca;
      end;
    end;
  end;

  procedure ResNotFound(const f:string);
  begin
    writeln(iifs(ParLanguage='D','Sprachmodul ','Language module ')+f+
            iifs(ParLanguage='D',' nicht gefunden',' not found'));
  end;

begin { loadresource }
  choice:=false;
  lf:=''; resFiles:=''; resOther:='';
  languageopt:=false;
  col.colmbox:=$70;
  col.colmboxrahmen:=$70;
  findfirst('XP-*.RES',ffAnyFile,sr); { Hier drfte es keine Probleme geben }
  if DosError<>0 then
    interr('Kein Sprachmodul installiert / No language module installed (XP-*.RES)')
  else while doserror=0 do
  begin
    if sr.name[5]='.' then                 { Ressourcen nach dem Muster     }
    begin                                  { 'XP-?.RES' in resFiles ablegen }
      if upcase(sr.name[4])='D' then       { ('D' und 'E' vorne!)           }
        insert(upcase(sr.name[4]),resFiles,1)
      else if upcase(sr.name[4])='E' then
        insert(upcase(sr.name[4]),resFiles,iif(firstchar(resFiles)='D',2,1))
      else
        resFiles:=resFiles+upcase(sr.name[4]);
    end
    else if resOther='' then
      resOther:=copy(sr.name,4,cpos('.',sr.name)-4); { 1. 'XP-*.RES' merken }
    findnext(sr);
    if not languageopt then          { Sprachenwechsel in Men deaktivieren }
      languageopt:=doserror=0;       { (siehe auch xp4o2.pas und xp4.inc)   }
  end;
  FindClose(sr);
  assign(t,'XP.RES');
  reset(t);
  { ----------------------------------------------------------------------- }
  if ioresult<>0 then                        { Wenn XP.RES nicht existiert  }
  begin
    if ParLanguage='' then                  { /L Parameter bercksichtigen, }
    begin
      select_language;                      { ansonsten Auswahl bringen     }
      lf:='XP-'+ParLanguage+'.RES';
      WrLf;                                          { und XP.RES erstellen }
      ParLanguage:='';
    end;
  end
  { ----------------------------------------------------------------------- }
  else begin                                             { XP.RES vorhanden }
    readln(t,lf);
    close(t);
    if (ParLanguage='') and not exist(lf) then
    begin
      ResNotFound(lf);              { 'Sprachmodul XP-*.RES nicht gefunden' }
      writeln;
      select_language;
      lf:='XP-'+ParLanguage+'.RES';
      WrLf;
      ParLanguage:='';
    end;
  end;
  { ----------------------------------------------------------------------- }
  if (ParLanguage<>'') then                                  { /L angegeben }
  begin
    lf2:='XP-'+ParLanguage+'.RES';
    if not exist(lf2) then
    begin
      ResNotFound(lf2);             { 'Sprachmodul XP-*.RES nicht gefunden' }
      writeln;
      if (lf<>'') and exist(lf) then          { wenn existierende Ressource }
        lf2:=lf                               { in XP.RES, diese verwenden  }
      else begin
        select_language;
        lf2:='XP-'+ParLanguage+'.RES';
      end;
    end;
    if (ustr(lf)<>lf2) then
    begin
      lf:=lf2;
      WrLf;
    end;
  end;
  { ----------------------------------------------------------------------- }

  { ab hier ist 'lf' immer mit einer existierenden Ressource belegt! }
  ParLanguage:=copy(lf,4,cpos('.',lf)-4);
  assign(t,lf);
  reset(t);
  readln(t); readln(t);
  readln(t,s);
  deutsch:=(lstr(s)='deutsch');
  close(t);
  if not OpenResource(lf,ResMinmem) or (getres(6)<>LangVersion) then
  begin
    if exist('XP.RES') then _era('XP.RES');
    if choice then
    begin
      writeln;  { damit Ausgabe nicht direkt }
      writeln;  { hinter Eingabe erfolgt     }
    end;
    interr(iifs(deutsch,'Falsche Version von ','Wrong version of ')+lf);
  end;
  GetResdata;
  if ParHelp then HelpScreen;
end;


end.