{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT WGMain;

{ $DEFINE NOINTERACTIVE}

{$I platform.inc}

{$IFNDEF WTRGATE} ##### Check your conditional defines! ##### {$ENDIF}
{$IFDEF WTRTEST}  ##### Check your conditional defines! ##### {$ENDIF}

{ conditional defines nodig:
    WtrGate       Guess why...
    Beta          Alleen voor Beta versies

  directories nodig:
    exe         bin
    inc         ramon;object
    tpu         ramon;router;tdb;object;exec;c:\bp7\units
    obj         ramon;object
}

INTERFACE

PROCEDURE WGMain_Start;

IMPLEMENTATION

USES StackChk,
     Ramon,
     {$IFDEF PLATFORM_OVERLAY}
     Overlay,
     {$ENDIF}
     {$IFDEF PLATFORM_DOS_NOT_DPMI}
     XmsLib,
     {$ENDIF}
     Dos,
     Globals,
     Cfg,
     Fido,
     Database,
     Start,
     Logs,
     SwapMem,
     Language,
     Keys,
     Slice,
     UserBase,
     Msgs,
     Routing,
     ListSrv,
     {Stats,}
     NewStats,
     DupeChk,
     UUCPRout,
     ReadRout,
     Copyrigh,
     Err_Func,
     CharSets,
     BBSUsers,
     Tdb,
     Extend,
     Crt,
     Gateway,
     RunCfg,
     Outbound,
     AreaMgr,
     Deliver;

{---------------------------------------------------------------------------}
{ DoBogusKey                                                                }
{                                                                           }
{ Deze routine keilt een user naar dos als er een foute key gevonden werd.  }
{                                                                           }
PROCEDURE DoBogusKey;

CONST Line1 = 'Jowbmje!lfz!gpvoe"';
      Line2 = 'Zpv!ibwf!kvtu!cffo!jogfdufe!cz!uif!dvstf!pg!uif!qibsbp"';
      Line3 = 'Nbz!eppn!cf!uiz!eftujoz"';

    FUNCTION Decode (Line : STRING) : STRING;

    VAR Result : STRING;
        Lp     : BYTE;

    BEGIN
         Result:='';
         FOR Lp:=1 TO Length (Line) DO
             Result:=Result+Char (Ord (Line[Lp])-1);
         Decode:=Result;
    END;

BEGIN
     WriteLn (Decode (Line1),#7#7#7#7#7#7);
     WriteLn;
     WriteLn (Decode (Line2));
     WriteLn (Decode (Line3));
     WriteLn;
     Halt (3);
END;


{$I wtrstart.pas}

{--------------------------------------------------------------------------}
{ ShowHelp                                                                 }
{                                                                          }
{ Laat een simpele help file zien voor WtrGate.                            }
{                                                                          }
PROCEDURE ShowHelp (Name : STRING);

    PROCEDURE WriteOp (Op,Expl : STRING);
    BEGIN
         TextColor (White);
         Write (' ',Op);
         TextColor (LightGray);
         WriteLn ('  ',Expl);
    END;

BEGIN
     WriteLn ('Usage: '+Name+' <command/option> [<command/option>..]');
     WriteLn;
     WriteLn ('Commands:');
     WriteLn;
     WriteOp ('SCAN','Scans local message bases for outgoing messages.');
     WriteOp ('TOSS','Toss files in FTN inbound.');
     WriteOp ('UUCP','Process received UUCP jobs in spool directory.');
     WriteOp ('BAG ','Process received BAG files.');
     WriteOp ('SMTP','Process received SMTP from Mail Queue.');
     WriteOp ('POP3','Process received POP3 mailbox files.');
     WriteOp ('SOUP','Process received SOUP packages.');
     WriteLn;
     WriteOp ('NOTIFY [aka/uucpname]','Send notification to all users.');
     WriteOp ('TOSSBAD','Re-toss from BAD area.');
     WriteLn;

     Write ('<press enter for more>');

     { #13 werkt niet onder OS/2 }
     IF (Crt.ReadKey <> #13) THEN
     BEGIN           {<press enter for more>}
          Write (#13,'                      '#13);
          Exit;
     END;
                 {<press enter for more>}
     WriteLn (#13'Options:              ');
     WriteLn;
     WriteOp ('-NONETSCAN ','Do not scan netmail areas.');
     WriteOp ('-NOECHOSCAN','Do not scan echomail area.');
     WriteOp ('-NONETMAIL ','Do not route received netmail messages, but store them.');
     WriteOp ('-NOEXPORT  ','Only import new messages into the local bases.');
     WriteOp ('-NOLOCAL   ','Only export new messages, do not import them.');
     WriteOp ('-NONEWSTOSS','Do not toss UUCP jobs with news.');
     WriteOp ('-NODUPE    ','Turn off dupe checking.');
     WriteOp ('-NOTUNNEL  ','Do not write MailTunnel e-mails.');
     WriteOp ('-CLEANSCAN ','Ignore HighWater and *.MSG index files during SCAN.');
     WriteOp ('-KEEPFA    ','Keep f/a msg if file cannot be found (for busy LANs).');
     WriteOp ('-MEMUSAGE  ','Show memory used by configuration tables.');
     WriteOp ('-DEBUG     ','Force Debug Logging for this run.');
     {-OVR25K
      -OVR50K
      -QUIET}
END;


{---------------------------------------------------------------------------}
{ HeapErrorHandler                                                          }
{                                                                           }
{ Deze routine werkt de heap error af. Hier kan later een swap routine aan  }
{ gehangen worden om geheugen vrij te maken... Zie HeapError in de help     }
{ voor meer info.                                                           }
{                                                                           }
FUNCTION HeapErrorHandler (Size : WORD) : INTEGER; FAR;
BEGIN
     IF (Size <> 0) THEN
     BEGIN
          WriteXYC (1,3,cExitPrg,' Heap Allocation Error!! (Size: '+Word2String (Size)+')');
          WriteXY (1,4,'Exitting with a run-time error');
          { RWI 950317: niet leuk voor unattended mode...
          ReadKey;
          }
          HeapErrorHandler:=0; { crash with runtime error }
     END;
     { ELSE is er ruimte gemaakt en is HeapPtr gewijzigd }
END;


{---------------------------------------------------------------------------}
{ ShowBanner                                                                }
{                                                                           }
{ Prints the start-up banner.                                               }
{                                                                           }
PROCEDURE ShowBanner;
BEGIN
     WriteLn (DesktopProgramName+' v'+FullProgramVersion);
     WriteLn (CopyrightLine);
     WriteLn;
END;


{---------------------------------------------------------------------------}
{ WGMain_Start                                                              }
{                                                                           }
PROCEDURE WGMain_Start;

VAR Quit            : BOOLEAN;
    Search          : SearchRec;
    Param           : STRING;
    MenuAuto        : KeyType;
    ParamTel,
    IORes           : BYTE;
    WorkFlags       : WORD;
    Lp              : UserBaseRecordNrType;
    ForceNoDupes    : BOOLEAN;
    Dir             : DirStr;
    Name            : NameStr;
    Ext             : ExtStr;
    PrevWasNotify   : BOOLEAN;
    NotifyUserRecNr : UserBaseRecordNrType;
    StackLeft       : WORD;
    HaveMenu        : BOOLEAN;

LABEL Fatal,
      StartFail;

BEGIN
     CheckBreak:=FALSE;
     TextColor (LightGray);
     TextBackground (Black);

     {$IFNDEF PLATFORM_OS2_WIN32}
     {$IFOPT G+}
     { check for PC/AT or higher }
     IF (Test8086 = 0) THEN
     BEGIN
          ShowBanner;
          WriteLn (DesktopProgramName+' requires a PC/AT (286) or higher to run');
          Halt (1);
     END;
     {$ENDIF}
     {$ENDIF}

     { Verwerk de opties op de command line VOOR we het hele programma }
     { gaan opstarten.                                                 }

     MenuAuto:=kUnknown;
     WorkFlags:=0;

     ForceNoNet:=FALSE;
     ForceNoEcho:=FALSE;
     ForceNoRoute:=FALSE;
     ForceNoExport:=FALSE;         { gedefinieerd in Globals }
     ForceNoImport:=FALSE;         { gedefinieerd in Globals }
     ForceNoDupes:=FALSE;          { lokaal gedefinieerd     }
     ForceNoNewsToss:=FALSE;
     ForceNoFAKill:=FALSE;
     ForceCleanScan:=FALSE;
     ForceNoTunnel:=FALSE;
     ForceDebugLog:=FALSE;
     DebugMem:=FALSE;
     StayQuiet:=FALSE;
{$IFNDEF PLATFORM_WIN32}
     NoFullScreen:=FALSE;
{$ELSE}
     WriteLn ('** NoFullScreen mode forced for Win32 platform');
     NoFullScreen:=TRUE;
{$ENDIF}

     { extract the program name }
     FSplit (ParamStr (0),Dir,Name,Ext);

     PrevWasNotify:=FALSE;

     IF (ParamCount > 0) THEN
     BEGIN
          FOR ParamTel:=1 TO ParamCount DO
          BEGIN
               Param:=ParamStr (ParamTel);

               IF PrevWasNotify THEN
               BEGIN
                    { check for argument to Notify option: AKA or UUCPNAME }
                    PrevWasNotify:=FALSE;
                    NotifyArgument:=Param;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NODUPE') THEN
               BEGIN
                    ForceNoDupes:=TRUE;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'-NOLOCAL') THEN
               BEGIN
                    ForceNoImport:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NOEXPORT') THEN
               BEGIN
                    ForceNoExport:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NONETSCAN') THEN
               BEGIN
                    ForceNoNet:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NONETMAIL') THEN
               BEGIN
                    ForceNoRoute:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NOECHOSCAN') OR
                  CaselessMatch (Param,'-NOES') THEN
               BEGIN
                    ForceNoEcho:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NONEWSTOSS') THEN
               BEGIN
                    ForceNoNewsToss:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NOTUNNEL') THEN
               BEGIN
                    ForceNoTunnel:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-CLEANSCAN') THEN
               BEGIN
                    ForceCleanScan:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-KEEPFA') THEN
               BEGIN
                    ForceNoFAKill:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-MEMUSAGE') THEN
               BEGIN
                    DebugMem:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-OVR25K') OR
                  CaselessMatch (Param,'-OVR50K')
               THEN
                   Continue;

               IF CaselessMatch (Param,'-DEBUG') THEN
               BEGIN
                    ForceDebugLog:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-QUIET') THEN
               BEGIN
                    StayQuiet:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'-NOFULLSCREEN') THEN
               BEGIN
                    NoFullScreen:=TRUE;
                    Continue;
               END;

               IF CaselessMatch (Param,'TOSSFIDO') OR
                  CaselessMatch (Param,'TOSS') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_FIDOTOSS;
                    Continue;
               END;

               IF CaselessMatch (Param,'SCANFIDO') OR
                  CaselessMatch (Param,'SCAN') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_FIDOSCAN;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'TOSSBAD') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_TOSSBAD;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'NOTIFY') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_NOTIFY;
                    PrevWasNotify:=TRUE;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'TOSSUSE') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_UUCPTOSS OR WORK_BAGTOSS;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'UUCP') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_UUCPTOSS;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'BAG') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_BAGTOSS;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'SMTP') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_SMTPTOSS;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'POP3') THEN
               BEGIN
                    MenuAuto:=mOpt10;
                    WorkFlags:=WorkFlags OR WORK_POP3TOSS;
                    Continue; { for }
               END;

               IF CaselessMatch (Param,'SOUP') THEN
               BEGIN
                    MenuAuto := mOpt10;
                    WorkFlags := WorkFlags OR WORK_SOUPTOSS;
                    Continue; { for }
               END;

               { -- everything below this lines causes a program exit }
               {    so start with showing the banner.                 }

               ShowBanner;

               IF (Param = '?') OR
                  CaselessMatch (Param,'HELP') OR
                  CaselessMatch (Param,'-H') OR
                  (Param = '-?') OR
                  (Param = '/?') THEN
               BEGIN
                    ShowHelp (Name);
                    Exit;
               END;

               WriteLn ('Unknown command line option "'+Param+'" found.');
               WriteLn;
               WriteLn ('Use '+Name+' ? for help');
               Exit;
          END; { for }
     END; { if }

     IF (NOT StayQuiet) THEN
        ShowBanner;

     { lees de configuratie file }
     IF (NOT ReadConfigFile) THEN
        { error message has been printed already }
        Exit;

     {$IFDEF PLATFORM_DOS_NOT_DPMI}
     IF (NOT XMSPresent) AND (Config.CacheTdbs) THEN
     BEGIN
          LogMessage (liConfig,'XMS not detected; switching TDB caching OFF');
          Config.CacheTdbs:=FALSE;
     END;
     {$ENDIF}

     { OpenDatabases moet EERST ivm LOCKING }
     IF (NOT OpenDatabases) OR
        (NOT InitLang (Config.SystemDir)) OR
        (NOT CharSets_Init) THEN
     BEGIN
          CloseDatabases;
          LogClose;
          WriteLn;
          WriteLn ('# Unable to open configuration files'#7);
          WriteLn;
          Halt (1);
     END;

     { Forceer dupe checking }
     IF ForceNoDupes THEN
        Config.DoDupeChk:=FALSE;

     IF (WtrCheckKey = BogusKey) THEN
        DoBogusKey;

     WtrCheckBetaKey;
     HeapError:=@HeapErrorHandler;
     ConditionRed:=0; { geen error conditie (ivm ErrorLevel) }

     { controleer of er wel genoeg geheugen is }

     { RWI 950524: MaxAvail was eerst MemAvail. Dit lijkt me beter }
     { RWI 960118: weer terug veranderd. Language file laat een    }
     {             gat van 64k achter..                            }
     { RWI 961011: Nu altijd checken, ook bij -NOCHECK             }
     IF (_MemAvail < MemNeeded) THEN
     BEGIN
          { RWI 950524: hij is nu wat preciezer met zijn foutmelding }
          WriteLn ('# Not enough low memory to run '+DesktopProgramName+
                   ', need '+Word2String (((MemNeeded-_MemAvail) DIV 1024)+1)+'kb more');
          CloseDatabases;
          GOTO Fatal;
     END;

     { check configuration & set global smarthost info }
     IF (NOT StartUpWtrGate) THEN
     BEGIN
          ConditionRed:=1;
          CloseDatabases;
          GOTO Fatal;
     END;

     IF (WorkFlags = 0) AND (NoFullScreen) THEN
     BEGIN
          Writeln ('+ Nothing to do!');
          CloseDatabases;
          Exit;
     END;

     IF (MenuAuto = kUnknown) THEN
        StayQuiet:=FALSE;

     DesktopCopyright:='RvdW';

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          OpenDesktop (DesktopProgramName,FullProgramVersion);
          WriteKeysLine (' Initializing...');

          Log_SetWindowSize (Video.Rows-21);
          ScreenToo:=TRUE; { logs ook op het scherm afdrukken }
     END;

     Log_StoreFilePos; { for mailing to admin }

     {$IFDEF PLATFORM_OVERLAY}
     IF Config.LogDebug THEN
        LogMessage (liDebug,'Overlay: Permanent='+Longint2String (OvrGetBuf));
     {$ENDIF}

     IF Config.LogDebug THEN
     BEGIN
          Param:='';
          FOR ParamTel:=1 TO ParamCount DO
              Param:=Param+' '+ParamStr (ParamTel);

          IF (Param = '') THEN
             LogMessage (liTrivial,'No command line arguments')
          ELSE
              LogMessage (liTrivial,'Command line:'+Param);
     END;

     IF DebugMem THEN
     BEGIN
          LogExtraMessage (MEMUSEFOR+'Language = '+Word2String (LangSize));
          LogExtraMessage (MEMUSEFOR+'TdbCache = '+Longint2String (TdbCacheMem));
     END;

     IF Config.UseSwapfile THEN
     BEGIN
          StartSwapfile (Config.SwapfilePath,Longint (Config.SwapfileSize)*1024*1024{mb});
          IF (NOT SwapIsOpen) THEN
          BEGIN
               LogMessage (liFatal,'Swapfile not open; aborting');
               ConditionRed:=2;
               LogClose; { RWI 961208: added }
               GOTO StartFail;
          END;
     END;

     RunCfg_Init;

     (* do for dos version only!
     { Controleer of we DesqView in het geheugen aantreffen }
     { Zoja, maak dan even een melding. Dit omdat we dan nu }
     { Desqview screen writes gebruiken.                    }

     DV_Versie:=DV_Get_Version;
     IF (DV_Versie > 0) THEN
        LogExtraMessage ('Detected DesqView '+Word2String (DV_Versie SHR 8)+'.'+Word2String (DV_Versie AND 255));
     *)

     IF Config.TimeSlicing THEN
        Slice_Detect;

     { kijken of alle spool paden wel bestaan, anders aanmaken }
     FOR Lp:=1 TO UserBaseRecCount DO
     BEGIN
          ReadUserBaseRecord (Lp,UserData);

          IF (NOT UserData.Deleted) AND (UserData.System = _U) THEN
          BEGIN
               { kijken of het spool pad al bestaat, anders aanmaken }
               FindFirst (Config.SpoolBaseDir+UserData.UUCPName+'\*.*',saJustFiles,Search);
               IF (DosError = 3) THEN { path not found }
               BEGIN
                    IORes:=CreatePath (Config.SpoolBaseDir+UserData.UUCPName);
                    IF (IORes <> 0) THEN
                       LogDiskIOError (IORes,'Cannot create spool directory: '+Config.SpoolBaseDir+UserData.UUCPName);
               END;

               FindClose (Search);
          END; { system = usenet }
     END; { for }

     ReadUserBaseIndexTable;
     ReadAreaBaseIndexTable;

     Outbound_Init;
     InitExportedList;
     InitRoutingTable;

     IF (BBSNormalAreaRecNr <> NILRecordNr) OR
        (BBSEMailAreaRecNr <> NILRecordNr) OR
        (BBSViaRecNr <> NILRecordNr)
     THEN
         ReadBBSUsersIndex (DebugMem);

     Slice_Now;

     CharSets_LoadDefault;

     { time slice detectie is nu uitgevoerd }
     {$IFNDEF PLATFORM_WIN32}
     {$IFNDEF PLATFORM_OS2}
     IF Config.LogDebug AND (Slice_GetMultiTaskerName <> '') THEN
        LogMessage (liTrivial,'Detected '+Slice_GetMultiTaskerName+'; giving up time slices');
     {$ENDIF}
     {$ENDIF}

     ListServerTabelInit;
     Stats_Init;
     DupeCheckInit;

     LogClose;

     { Laat de Beta/CopyRight melding alleen zien als dit een }
     { beta compilatie is, en er geen opties op de command    }
     { line zijn meegegeven.                                  }

     {$IFNDEF NOINTERACTIVE}
     IF (Key <> kUnknown) THEN
     BEGIN
          {$IFDEF Alfa}
          ShowCopyright;
          {$ENDIF}

          {$IFDEF Beta}
          ShowCopyright;
          {$ENDIF}

          {$IFDEF Gamma}
          ShowCopyright;
          {$ENDIF}
     END;

     { De beveiliging zit overal... }
     HaveMenu:=FALSE;
     Quit:=(regKeyNumber = $FFFE); { = FALSE }
     REPEAT
           IF (MenuAuto <> kUnknown) THEN
           BEGIN
                Key:=MenuAuto;
                Quit:=TRUE;
           END ELSE
           BEGIN
                IF (NOT HaveMenu) THEN
                BEGIN
                     MenuDefine (30,3,'Main Menu');
                     MenuAddItem ('Scan message bases');
                     MenuAddItem ('Process FTN files');
                     MenuAddItem ('Process UUCP files');
                     MenuAddItem ('Process BAG files');
                     MenuAddItem ('Process SMTP files ');
                     MenuAddItem ('Process POP3 files');
                     MenuAddItem ('Process SOUP files');
                     MenuAddItem ('About WaterGate');
                     MenuAddItem ('Exit program');
                     MenuShow;
                     HaveMenu:=TRUE;
                END;

                WriteKeysLine (' ^Esc Exit  ^'#24#25' Choose  ^Enter Select');

                MenuSelect;

                IF (Key <> mOpt08) THEN
                BEGIN
                     MenuErase;
                     HaveMenu:=FALSE;
                END;
           END;

           CASE Key OF
                mOpt01 : StartWork (WORK_FIDOSCAN,TRUE);
                mOpt02 : StartWork (WORK_FIDOTOSS,TRUE);
                mOpt03 : StartWork (WORK_UUCPTOSS,TRUE);
                mOpt04 : StartWork (WORK_BAGTOSS,TRUE);
                mOpt05 : StartWork (WORK_SMTPTOSS,TRUE);
                mOpt06 : StartWork (WORK_POP3TOSS,TRUE);
                mOpt07 : StartWork (WORK_SOUPTOSS,TRUE);

                mOpt08 : ShowAboutBox;

                kEsc,
                mOpt09 : Quit:=TRUE;

                mOpt10 : StartWork (WorkFlags,FALSE);

           END; { case }
     UNTIL Quit;
     {$ELSE}                  {NOINTERACTIVE}
     StartWork (WorkFlags, FALSE);
     {$ENDIF}

     Outbound_Done;
     DupeCheckEnd;
     Stats_Close;

     StopSwapfile;

     JunkAreaBaseIndexTable;
     JunkUserBaseIndexTable;
     JunkExportedList;
     JunkRoutingTable;
     DeleteUUCPRoutingTable;
     JunkBBSUsersIndex;
     JunkGatewayChecks;
     JunkListServerTable;
     RunCfg_Done;

     {$IFDEF PLATFORM_OVERLAY}
     IF Config.LogDebug THEN
        LogMessage (liDebug,'Overlay statistics: LoadCount='+Word2String (OvrLoadCount));
     {$ENDIF}

     IF (SwapTopUse > 0) THEN
        LogMessage (liDebug,'Swap file usage: '+Longint2String (SwapTopUse)+' bytes');

     {$IFNDEF PLATFORM_OS2_WIN32}
     StackLeft:=StackChk_FindUnused;
     IF (StackLeft < 1000) THEN
        LogMessage (liReport,'Stack left: '+Word2String (StackLeft))
     ELSE
         LogMessage (liDebug,'Stack left: '+Word2String (StackLeft));
     {$ENDIF}

StartFail:

     { En sluit de log af }
     LogMessage (liTrivial,'Ending program');
     LogExtraMessage ('');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          NoKeySignOff;
          CloseDesktop;
          ScreenToo:=FALSE; { prevent log from corrupting memory }
          WriteLn ('Ending ',DesktopProgramName,' v',FullProgramVersion);
          KeySignOff;
     END;

Fatal:
     CloseDatabases;
     JunkLang;
     CharSets_Junk;

     IF (ConditionRed > 0) THEN
     BEGIN
          WriteLn (' # Exiting with errorlevel ',ConditionRed);
          WriteLn (#7);
     END;

     TdbDone;

     UnExtendHandles;

     DumpMem;

     LogClose;
     Halt (ConditionRed);
END;

END.
