{$B+}            {Do not evaluate completely}
{$M 4096, 0, 0}  {A bit of stack, but reduce heap to be able to use EXEC}
Program EURO;
uses
  Dos;

const
  SwConst:word=$1234;
{This constant, if modified, must be modified in both EURO and EUROTSR so
that it always has the same value in both programs}

Var
   FirstP: string;   {This var will allocate the first parameter}

Procedure FastHelp;
Begin
     WriteLn ('Activates euro symbol handling in your system');
     WriteLn;
     WriteLn ('EURO [/U|/?|/A|/S]');
     WriteLn;
     WriteLn ('The EURO symbol is added to current codepage in the position');
     WriteLn ('159 (previously occupied by the symbol of French franc, one of');
     WriteLn ('the currencies that are part of the euro).');
     WriteLN ('You can produce the euro symbol from your keyboard by pressing');
     WriteLN ('AltGR+E (or RightAlt+E).');
     WriteLn;
     WriteLn ('    /U   Uninstalls euro support from your system');
     WriteLn ('    /?   Shows this help');
     WriteLN ('    /A   Shows About... information');
     WriteLN ('    /S   Displays status of EURO installation');
     Halt (0)
End;

Procedure About;
Var
   i: byte;
Begin
     WriteLn ('ABOUT EURO.... ');
     WriteLn;
     WriteLn ('EURO is a tool to enable Euro support in your DOS');
     WriteLn ('Copyright (C) 2000 - Aitor Santamarˇa');
     For I:=1 to 65 do Write (#196); WriteLn;
     WriteLn ('This utility is free software; you can redistribute it and/or');
     WriteLn ('modify it under the terms of the GNU General Public');
     WriteLn ('License as published by the Free Software Foundation; either');
     WriteLn ('version 2 of the License, or (at your option) any later version.');
     WriteLn ('This utility is distributed in the hope that it will be useful,');
     WriteLn ('but WITHOUT ANY GUARANTEE; without even the implied guarantee of');
     WriteLn ('MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU');
     WriteLn ('General Public License for more details. (http://www.gnu.org)');
     For I:=1 to 65 do Write (#196); WriteLn;
     WriteLN ('You can contact the author: aitor.sm@teleline.es');
     WriteLn ('Versions available:');
     WriteLn ('EN - English');
     WriteLn ('ES - Espa¤ol');
     Halt (0);
End;

Procedure PrintError (errcode: byte);
Begin
     Write ('EURO: Error ',errcode,': ');
     Case errcode of
                    1: WriteLn ('Unable to uninstall EURO');
                    2: WriteLn ('EURO is already installed');
                    3: WriteLn ('EURO support not found');
                    4: WriteLn ('Unable to install EURO (COMSPEC SET?)');
     End;
     Halt (errcode)
End;



Function IsPresent: boolean;
Var
   Regs: registers;
Begin
  with  Regs  do Begin
    CX := $101;
    DX := SwConst;
  End;
  Intr( $12, Regs );
  IsPresent := Regs.DX = Swap(SwConst)
End;

Procedure ShowStatus;
Begin
     Write ('EURO is ');
     If IsPresent Then WriteLn ('active')
                  Else WriteLn ('inactive');
     Halt (0)
End;


Procedure InstallEuroChar;
Const
     EuroPat : array [0..15] of byte = (0,0,30,33,65,64,254,64,252,64,64,33,30,0,0,0);
Var
   Regs: Registers;
Begin
     With Regs do Begin
          AX := $1110;  {Install character}
          BH := 16;     {VGA screen}
          BL := 0;      {first font set}
          CX := 1;      {just ONE character}
          DX := 159;    {French franc old character}
          ES := Seg(EuroPat);
          BP := Ofs(EuroPat)
     End;
     Intr ($10,Regs)
End;


Procedure Install;
Begin
     {EXECUTE}
     Exec (GetEnv('COMSPEC'),'/C EUROTSR.EXE');
     {If successful, then modify character table}
     If IsPresent Then
        Begin
             InstallEuroChar;
             WriteLn ('EURO: Installation successful')
        End
     Else PrintError(4);
End;



Function UnInstall: boolean;
Var
   Regs: registers;
Begin
  with  Regs  do Begin
    CX := $102;
    DX := SwConst;
  End;
  Intr( $12, Regs );
  UnInstall := Regs.DX = 0;
End;




BEGIN
     FirstP := ParamStr(1);
     {Check parameters, discard help, about and status}
     If (ParamCount>1) or ((ParamCount=1) and (FirstP[1]<>'/')) or
        ((ParamCount=1) and not (FirstP[2] in ['?','A','a','u','U','s','S']))
     Then Begin
        WriteLN ('Syntax error in parameters (use EURO /? if you need help).');
        Halt (0)
     End;
     If ParamStr(1)='/?' Then FastHelp;
     If (ParamStr(1)='/a') or (ParamStr(1)='/A') Then About;
     If (ParamStr(1)='/s') or (ParamStr(1)='/S') Then ShowStatus;
     {Check installed and /U}
     If IsPresent Then
        If (ParamStr(1)='/u') or (ParamStr(1)='/U') Then
           if UnInstall Then WriteLn ('EURO: Succesfully uninstalled')
                        Else PrintError(1)
        Else PrintError (2)
     Else If (ParamStr(1)='/u') or (ParamStr(1)='/U')
          Then PrintError(3)
          Else Install;
END.