PROGRAM Upgrade;

{ note: if we run out of symbols again in the future, change some of   }
{       the fields in the config stuff into one big meaningless array. }

{$I platform.inc}

{ universele upgrade programma }

{$IFNDEF Upgrade} ### Missing define!... ## {$ENDIF}

{$IFDEF PLATFORM_DPMI} ### DO NOT compile for DPMI ! ### {$ENDIF}

{$IFOPT G+} ### DO NOT compile for 286 ! ###  {$ENDIF}
{$IFOPT B+} ### Complete Boolean Evalaluation must be DISABLED ### {$ENDIF}

USES Ramon,
     Dos,
     Globals,
     UpgrArea,
     UpgrUser,
     UpgrCfg,
     UpgrGlob;

VAR HulpRec  : ARRAY[0..MAXLEN_REC] OF BYTE;
    TestOnly : BOOLEAN;

VAR HadListUser    : BOOLEAN; { if TRUE, do not complain about LISTSERV missing }
    CreateListUser : BOOLEAN;


{**************************************************************************}
{                               WTRCFG                                     }
{**************************************************************************}


{ let op: als deze wijzigt dan apart type van maken!! }
TYPE FidoAddrType = RECORD
                          Zone   : WORD;
                          Net    : WORD;
                          Node   : WORD;
                          Point  : WORD;
                          Domain : STRING[25];
                    END;


{**************************************************************************}
{                               SUBSCRIPT                                  }
{**************************************************************************}


TYPE SubscriptBase01Record = RECORD
         { starts at byte  0 }     NextSegmentRecordNr : WORD;

                                   CASE INTEGER OF
                        {  2 }          0 : (UserList : ARRAY[1..5] OF WORD
    { next would start at 12 }              );
                        {  2 }          1 : (AreaList : ARRAY[1..5] OF WORD
    { next would start at 12 }              );
                             END;


{--------------------------------------------------------------------------}
{ UpgradeSubscript                                                         }
{                                                                          }
{ Deze routine upgrade een Subscript record.                               }
{                                                                          }
PROCEDURE UpgradeSubscript (VAR Rec; VAR Version : BYTE); FAR;
BEGIN
     { nog niet nodig }
END;


{**************************************************************************}
{                               LISTSERV                                   }
{**************************************************************************}


TYPE ListServer01Record = RECORD
     { start at byte   0 }      Deleted     : BOOLEAN;
                   {   1 }      ListSystem  : BYTE;
                   {   2 }      NextUser    : WORD;

                                CASE INTEGER OF
                   {   4 }           0 : (ListName        : STRING[30];
                   {  35 }                ListDescription : STRING[40];
                   {  76 }                ListAKA         : BYTE;
                   {  77 }                AllowRemote     : BOOLEAN;
                   {  78 }                AllowKnown      : BOOLEAN;
                   {  79 }                Active          : BOOLEAN;
                   {  80 }                AreaName        : STRING[60];
                   { 141 }                EchoList        : BOOLEAN;
                   { 142 }                ListEcho        : BOOLEAN;
  { next would be at 143 }               );

                   {   4 }           1 : (Address : FidoAddrType;
                   {  38 }                Name    : STRING[50];
  { next would be at  89 }               );

                   {   4 }           2 : (Domain  : STRING[50];
  { next would be at  55 }               );
                          END;

TYPE ListServer02Record = RECORD
     { start at byte   0 }      Deleted     : BOOLEAN;
                   {   1 }      ListSystem  : BYTE;
                   {   2 }      NextUser    : WORD;

                                CASE INTEGER OF
                   {   4 }           0 : (ListName        : STRING[30];
                   {  35 }                ListDescription : STRING[40];
                   {  76 }                ListWelcome     : STRING[79];
                   { 156 }                ListAKA         : BYTE;
                   { 157 }                AllowRemote     : BOOLEAN;
                   { 158 }                OnlyKnown       : BOOLEAN;
                   { 159 }                Active          : BOOLEAN;
                   { 160 }                AreaName        : STRING[60];
                   { 221 }                EchoList        : BOOLEAN;
                   { 222 }                ListEcho        : BOOLEAN;
  { next would be at 223 }               );

                   {   4 }           1 : (Address : FidoAddrType;
                   {  38 }                Name    : STRING[50];
  { next would be at  89 }               );

                   {   4 }           2 : (Email   : STRING[50];
  { next would be at  55 }               );
                          END;

TYPE ListServer03Record = RECORD
     { start at byte   0 }      Deleted     : BOOLEAN;
                   {   1 }      ListSystem  : BYTE;
                   {   2 }      NextUser    : WORD;

                                CASE INTEGER OF
                   {   4 }           0 : (ListName        : STRING[30];
                   {  35 }                ListDescription : STRING[40];
                   {  76 }                ListWelcome     : STRING[79];
                   { 156 }                ListAKA         : BYTE;
          { == 03 }{ 157 }                ListPrivate     : BOOLEAN;
                   { 158 }                OnlyKnown       : BOOLEAN;
                   { 159 }                Active          : BOOLEAN;
                   { 160 }                AreaName        : STRING[60];
                   { 221 }                EchoList        : BOOLEAN;
                   { 222 }                ListEcho        : BOOLEAN;
  { next would be at 223 }               );

                   {   4 }           1 : (Address : FidoAddrType;
                   {  38 }                Name    : STRING[50];
  { next would be at  89 }               );

                   {   4 }           2 : (Email   : STRING[50];
  { next would be at  55 }               );

                   {   4 }           3 : (GWAddress : FidoAddrType;
                   {  38 }                GWUser    : STRING[50];
                   {  89 }                GWEmail   : STRING[50]
  { next would be at 140 }               );
                          END;

TYPE ListServer04Record = RECORD
     { start at byte   0 }      Deleted     : BOOLEAN;
                   {   1 }      ListSystem  : BYTE;
                   {   2 }      NextUser    : WORD;
          {++0.92 }{   4 }      Access      : BYTE;

                                CASE INTEGER OF
                   {   5 }           0 : (ListName        : STRING[30];
                   {  36 }                ListDescription : STRING[40];
                   {  77 }                ListWelcome     : STRING[79];
                   { 157 }                ListAKA         : BYTE;
                   { 158 }                ListPrivate     : BOOLEAN;
                   { 159 }                OnlyKnown       : BOOLEAN;
                   { 160 }                Active          : BOOLEAN;
                   { 161 }                AreaName        : STRING[60];
                   { 222 }                EchoList        : BOOLEAN;
                   { 223 }                ListEcho        : BOOLEAN;
          {++0.92 }{ 224 }                DefaultAccess   : BYTE;
  { next would be at 225 }               );

                                     { fido }
                   {   5 }           1 : (Address   : FidoAddrType;
                   {  39 }                Name      : STRING[50];
  { next would be at  90 }               );

                                     { usenet }
                   {   5 }           2 : (Email     : STRING[50];
  { next would be at  56 }               );

                                     { remote gateway }
                   {   5 }           3 : (GWAddress : FidoAddrType;
                   {  39 }                GWUser    : STRING[50];
                   {  90 }                GWEmail   : STRING[50];
  { next would be at 141 }               );
                          END;

{ 0.93 }
TYPE ListServer05Record = RECORD
     { start at byte   0 }      Deleted        : BOOLEAN;
                   {   1 }      ListSystem     : BYTE;
                   {   2 }      NextUser       : WORD;
                   {   4 }      Access         : BYTE;
           {++0.93}{   5 }      SubscribedDate : LONGINT;
           {++0.93}{   9 }      ConfirmedDate  : LONGINT;
           {++0.93}{  13 }      ConfirmReqDate : LONGINT;
           {++0.93}{  17 }      ConfirmState   : BYTE;
           {++0.93}{  18 }      ConfirmCode    : LONGINT; { hex nr }

           { 5->22: @5 +17 L220 }
                                CASE INTEGER OF
                   {  22 }           0 : (ListName        : STRING[30];
                   {  53 }                ListDescription : STRING[40];
                   {  94 }                ListWelcome     : STRING[79];
                   { 174 }                ListAKA         : BYTE;
                   { 175 }                ListPrivate     : BOOLEAN;
                   { 176 }                OnlyKnown       : BOOLEAN;
                   { 177 }                Active          : BOOLEAN;
                   { 178 }                AreaName        : STRING[60];
                   { 239 }                EchoList        : BOOLEAN;
                   { 240 }                ListEcho        : BOOLEAN;
                   { 241 }                DefaultAccess   : BYTE;
           {++0.93}{ 242 }                MLAddress       : BYTE;
           {++0.93}{ 243 }                ConfirmInterval : BYTE;
  { next would be at 243 }               );

                                     { fido }
                   {  22 }           1 : (Address   : FidoAddrType;
                   {  56 }                Name      : STRING[50];
  { next would be at 107 }               );

                                     { usenet }
                   {  22 }           2 : (Email     : STRING[50];
  { next would be at  73 }               );

                                     { remote gateway }
                   {  22 }           3 : (GWAddress : FidoAddrType;
                   {  56 }                GWUser    : STRING[50];
                   { 107 }                GWEmail   : STRING[50];
  { next would be at 157 }               );
                          END;

{ 0.94.PRE9 }
TYPE ListServer06Record = RECORD
     { start at byte   0 }      Deleted        : BOOLEAN;
                   {   1 }      ListSystem     : BYTE;
                   {   2 }      NextUser       : WORD;
                   {   4 }      Access         : BYTE;
                   {   5 }      SubscribedDate : LONGINT;
                   {   9 }      ConfirmedDate  : LONGINT;
                   {  13 }      ConfirmReqDate : LONGINT;
                   {  17 }      ConfirmState   : BYTE;
                   {  18 }      ConfirmCode    : LONGINT; { hex nr }

                                CASE INTEGER OF
                   {  22 }           0 : (ListName        : STRING[30];
                   {  53 }                ListDescription : STRING[40];
                   {  94 }                ListWelcome     : STRING[79];
                   { 174 }                ListAKA         : BYTE;
                   { 175 }                ListPrivate     : BOOLEAN;
                   { 176 }                OnlyKnown       : BOOLEAN;
                   { 177 }                Active          : BOOLEAN;
                   { 178 }                AreaName        : STRING[60];
                   { 239 }                EchoList        : BOOLEAN;
                   { 240 }                ListEcho        : BOOLEAN;
                   { 241 }                DefaultAccess   : BYTE;
                   { 242 }                MLAddress       : BYTE;
                   { 243 }                ConfirmInterval : BYTE;
              {++} { 244 }                HomeDomain      : BYTE;
              {++} { 245 }                AdminPassword   : STRING[8];
  { next would be at 254 }               );

                                     { fido }
                   {  22 }           1 : (Address   : FidoAddrType;
                   {  56 }                Name      : STRING[50];
  { next would be at 107 }               );

                                     { usenet }
                   {  22 }           2 : (Email     : STRING[50];
  { next would be at  73 }               );

                                     { remote gateway }
                   {  22 }           3 : (GWAddress : FidoAddrType;
                   {  56 }                GWUser    : STRING[50];
                   { 107 }                GWEmail   : STRING[50];
  { next would be at 157 }               );
                          END;

CONST SEC_Dag    = 60*60*24;
      SEC_Uur    : LONGINT = 60*60;
      SEC_Minuut : LONGINT = 60;
      SEC_Jaar   : ARRAY[FALSE..TRUE] OF LONGINT = (365*SEC_Dag,{Schrikkel}366*SEC_Dag);
      SEC_Maand  : ARRAY[1..12] OF LONGINT =
                       (31*SEC_Dag,   { Januari  }
                        28*SEC_Dag,   { Februari }
                        31*SEC_Dag,   { Maart    }
                        30*SEC_Dag,   { April    }
                        31*SEC_Dag,   { Mei      }
                        30*SEC_Dag,   { Juni     }
                        31*SEC_Dag,   { Juli     }
                        31*SEC_Dag,   { Augustus }
                        30*SEC_Dag,   { SeptemBer}
                        31*SEC_Dag,   { Oktober  }
                        30*SEC_Dag,   { November }
                        31*SEC_Dag);  { December }

{--------------------------------------------------------------------------}
{ IsSchrikkel                                                              }
{                                                                          }
{ Standaard, is dit jaar een schrikkeljaar?                                }
{                                                                          }
FUNCTION IsSchrikkel (Year : WORD) : BOOLEAN;
BEGIN
     IsSchrikkel:=(Year MOD 400 = 0) OR
                   (NOT (Year MOD 100 = 0) AND (Year MOD 4 = 0));
END;


{--------------------------------------------------------------------------}
{ DosToUnix                                                                }
{                                                                          }
{ Converteert een dos datum naar een unix time.                            }
{                                                                          }
PROCEDURE DosToUnix (VAR Invoer : DateTime; VAR Result : LONGINT);

VAR Jaar,
    MaandNr : INTEGER;

BEGIN
     Result:=0;

     WITH Invoer DO
     BEGIN
          { doorloop het aantal jaren naar 1970 }
          FOR Jaar:=1970 TO (Year-1) DO
              Result:=Result+SEC_Jaar[IsSchrikkel (Jaar)];

          IF (Month = 0) OR (Month > 12) THEN
          BEGIN
               {LogMessage ('Invalid month in date: '+Byte2String (Month));}

               IF (Month = 0) THEN
                  Month:=1;

               IF (Month > 12) THEN
                  Month:=12;
          END;

          { doorloop het aantal maanden naar de huidige }
          FOR MaandNr:=1 TO (Month-1) DO
          BEGIN
               Result:=Result+SEC_Maand[MaandNr];
               { RWI 950318: toegevoeging controle op schrikkelmaand }
               IF (MaandNr = 2) AND IsSchrikkel (Year) THEN
                  Result:=Result+SEC_Dag;
          END;

          { tel hierbij het aantal dagen op }
          Result:=Result+SEC_Dag*(Day-1);

          { tel hierbij het aantal uren op }
          Result:=Result+SEC_Uur*Hour;

          { tel hierbij het aantal minuten }
          Result:=Result+SEC_Minuut*Min;

          { en uiteindelijk het aantal seconden }
          Result:=Result+Sec;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ GetCurrentUnixTime                                                       }
{                                                                          }
{ Converteert de huidige tijd naar Unix Tijd stempel.                      }
{                                                                          }
FUNCTION GetCurrentUnixTime : LONGINT;

VAR CurrentTime : DateTime;
    Res         : LONGINT;
    h,mi,s,x,
    y,mo,d,o    : WordLong;

BEGIN
     GetTime (h,mi,s,x);
     GetDate (y,mo,d,o);

     WITH CurrentTime DO
     BEGIN
          Year:=y;
          Month:=mo;
          Day:=d;
          Hour:=h;
          Min:=mi;
          Sec:=s;
     END; { with }

     DosToUnix (CurrentTime,Res);
     GetCurrentUnixTime:=Res;
END;


{--------------------------------------------------------------------------}
{ UpgradeListServ                                                          }
{                                                                          }
{ Deze routine upgrade een List Serv record.                               }
{                                                                          }
PROCEDURE UpgradeListServ (VAR Rec; VAR Version : BYTE); FAR;
BEGIN
     IF (Version = 1) THEN
     BEGIN
          { 01 -> 02

            ListWelcome toegevoegd *in het midden* (sick)
          }

          WITH ListServer02Record (Rec) DO
               IF (ListSystem = 0) THEN
               BEGIN
                    { schuif alle velden op; van achter naar voren }
                    ListEcho:=ListServer01Record (Rec).ListEcho;
                    EchoList:=ListServer01Record (Rec).EchoList;
                    AreaName:=ListServer01Record (Rec).AreaName;
                    Active:=ListServer01Record (Rec).Active;
                    OnlyKnown:=ListServer01Record (Rec).AllowKnown;
                    AllowRemote:=ListServer01Record (Rec).AllowRemote;
                    ListAKA:=ListServer01Record (Rec).ListAKA;

                    { nieuwe veld initialiseren }
                    ListWelcome:='';
               END;

          Version:=2;
     END;

     IF (Version = 2) THEN
     BEGIN
          { 02 -> 03

            AllowRemote hernoemd in ListPrivate (geen actie)
            GateWay user type toegevoegd (geen actie)
          }

          Version:=3;
     END;

     IF (Version = 3) THEN
     BEGIN
          { 03 -> 04

            Access is erbij gekomen.
            Hierdoor moet het variant record 1 byte opschuiven
            Vanaf byte 4 gaat naar byte 5, len = 220 bytjes
            Variant 0 heeft er 1 byte bij
          }

          Move (BA(Rec)[4],BA(Rec)[5],220);

          WITH ListServer04Record (Rec) DO
          BEGIN
               { zet het access type op 0 }
               Access:=0; { read / write }

               { zet de default access type }
               IF (ListSystem = 0) THEN
                  DefaultAccess:=0; { read/write }

          END; { with }

          Version:=4;
     END;

     IF (Version = 4) THEN
     BEGIN
          { 04->05

            Nieuwe velden:
                   - SubscribedDate
                   - ConfirmedDate
                   - ConfirmReqDate
                   - ConfirmState
                   - ConfirmCode
                   - MLAddress (variant only)
                   - ConfirmInterval
          }

          { maak ruimte voor de nieuwe velden }
          { @5 +17 L220 }
          Move (BA(Rec)[5],BA(Rec)[22],220);

          WITH ListServer05Record (Rec) DO
          BEGIN
               SubscribedDate:=GetCurrentUnixTime;
               ConfirmedDate:=SubscribedDate;
               ConfirmReqDate:=0;
               ConfirmState:=1;  { 1=Ok }
               ConfirmCode:=0;
               MLAddress:=2; { 2=ReplyTo, as before }
               ConfirmInterval:=30; { one month, approx. }
          END; { with }

          Version:=5;
     END;

     IF (Version = 5) THEN
     BEGIN
          { 05 -> 06

            HomeDomain toegevoegd
          }

          WITH ListServer06Record (Rec) DO
               IF (ListSystem = 0{List}) THEN
               BEGIN
                    HomeDomain:=1;
                    AdminPassword:='';
               END;

          Version:=6;
     END;
END;



{**************************************************************************}
{                               GRPDESC                                    }
{**************************************************************************}


TYPE GroupDesc01Record = RECORD
    { start at byte   0 }      GroupDesc : STRING[30];
                  {  31 }      OriginAka : BYTE;
          {  next at 32 }END;

TYPE GroupDesc02Record = RECORD
    { start at byte   0 }      GroupDesc : STRING[30];
                  {  31 }      OriginAka : BYTE;
                  {  32 }      Readonly  : BOOLEAN;
          {  next at 33 }END;

TYPE GroupDesc03Record = RECORD
    { start at byte   0 }      GroupDesc : STRING[60];
                  {  61 }      OriginAka : BYTE;
                  {  62 }      Readonly  : BOOLEAN;
          {  next at 63 }END;


{--------------------------------------------------------------------------}
{ UpgradeGroup                                                             }
{                                                                          }
{ Deze routine upgrade een Group record.                                   }
{                                                                          }
PROCEDURE UpgradeGroup (VAR Rec; VAR Version : BYTE); FAR;
BEGIN
     IF (Version = 1) THEN
     BEGIN
          { 01 -> 02

            ReadOnly toegevoegd. Is aan einde, dus is al 0 (FALSE)
          }

          Version:=2;
     END;

     IF (Version = 2) THEN
     BEGIN
          { 02 -> 03

            Description langer gemaakt.

          }

          WITH GroupDesc03Record (Rec) DO
          BEGIN
               OriginAka:=GroupDesc02Record (Rec).OriginAka;
               Readonly:=GroupDesc02Record (Rec).Readonly;

               { aanvullen met spaties }
               GroupDesc:=AddUpWithSpaces (60,GroupDesc);
               GroupDesc:=DeleteFrontAndBackSpaces (GroupDesc);
          END;

          Version:=3;
     END;
END;


{**************************************************************************}
{                               LISTUSER                                   }
{**************************************************************************}

TYPE ListUser01Record = RECORD
                 {   0 }      UserType       : BYTE; {0=Deleted,1=FTN,2=RFC,3=RemoteGW}
                 {   1 }      ListID         : WORD;
                 {   3 }      Aka            : FidoAddrType;
                 {  37 }      User           : STRING[50];
                 {  88 }      Email          : STRING[50];
                 { 139 }      Access         : BYTE; {0=RW,1=RO,2=WO}
                 { 140 }      SubscribedDate : LONGINT;
                 { 144 }      ConfirmedDate  : LONGINT;
                 { 148 }      ConfirmReqDate : LONGINT;
                 { 152 }      ConfirmState   : BYTE; {0=Never,1=OK,2=Req1,3=Req2,4=Req3}
                 { 153 }      ConfirmCode    : LONGINT; { hex nr }
        {  next at 157 }END;

TYPE ListUser02Record = RECORD
                 {   0 }      UserType       : BYTE; {0=Deleted,1=FTN,2=RFC,3=RemoteGW}
                 {   1 }      ListID         : WORD;
                 {   3 }      Aka            : FidoAddrType;
                 {  37 }      User           : STRING[50];
                 {  88 }      Email          : STRING[50];
                 { 139 }      Access         : BYTE; {0=RW,1=RO,2=WO}
                 { 140 }      SubscribedDate : LONGINT;
                 { 144 }      ConfirmedDate  : LONGINT;
                 { 148 }      ConfirmReqDate : LONGINT;
                 { 152 }      ConfirmState   : BYTE; {0=Never,1=OK,2=Req1,3=Req2,4=Req3}
                 { 153 }      ConfirmCode    : LONGINT; { hex nr }
                 { 157 }      ReceiveOwnMail : BOOLEAN;
        {  next at 158 }END;

{--------------------------------------------------------------------------}
{ UpgradeListUser                                                          }
{                                                                          }
{ Deze routine upgrade een ListUser record.                                }
{                                                                          }
PROCEDURE UpgradeListUser (VAR Rec; VAR Version : BYTE); FAR;
BEGIN
     IF Version = 1 THEN
     BEGIN
          { 01 -> 02

            - Added "ReceiveOwnMail" boolean; default to TRUE
          }

          ListUser02Record (Rec).ReceiveOwnMail := TRUE;
          Version := 2;
     END;
END;


{**************************************************************************}
{                               MAIN                                       }
{**************************************************************************}

CONST Database_Subscript : DatabaseRecord =
       (Filename : 'SUBSCRIP';
        Proc     : UpgradeSubscript;
        Header   : 'WtrGate SubscrBase ';
        Oldest   : 1;
        Latest   : 1;
        RecSizes : (SizeOf (SubscriptBase01Record),
                    0, { 02 }
                    0, { 03 }
                    0, { 04 }
                    0, { 05 }
                    0, { 06 }
                    0, { 07 }
                    0, { 08 }
                    0, { 09 }
                    0, { 10 }
                    0, { 11 }
                    0, { 12 }
                    0, { 13 }
                    0, { 14 }
                    0, { 15 }
                    0, { 16 }
                    0, { 17 }
                    0, { 18 }
                    0, { 19 }
                    0, { 20 }
                    0, { 21 }
                    0, { 22 }
                    0, { 23 }
                    0, { 24 }
                    0, { 25 }
                    0, { 26 }
                    0, { 27 }
                    0, { 28 }
                    0, { 29 }
                    0, { 30 }
                    0, { 31 }
                    0, { 32 }
                    0, { 33 }
                    0, { 34 }
                    0, { 35 }
                    0, { 36 }
                    0, { 37 }
                    0, { 38 }
                    0, { 39 }
                    0  { 40 }
                   )
       );

CONST Database_ListUser : DatabaseRecord =
       (Filename : 'LISTUSER';
        Proc     : UpgradeListUser;
        Header   : 'WtrGate ListUser ';
        Oldest   : 1;
        Latest   : 2;  { adjust TerminateListServ as well! }
        RecSizes : (SizeOf (ListUser01Record),
                    SizeOf (ListUser02Record),
                    0, { 03 }
                    0, { 04 }
                    0, { 05 }
                    0, { 06 }
                    0, { 07 }
                    0, { 08 }
                    0, { 09 }
                    0, { 10 }
                    0, { 11 }
                    0, { 12 }
                    0, { 13 }
                    0, { 14 }
                    0, { 15 }
                    0, { 16 }
                    0, { 17 }
                    0, { 18 }
                    0, { 19 }
                    0, { 20 }
                    0, { 21 }
                    0, { 22 }
                    0, { 23 }
                    0, { 24 }
                    0, { 25 }
                    0, { 26 }
                    0, { 27 }
                    0, { 28 }
                    0, { 29 }
                    0, { 30 }
                    0, { 31 }
                    0, { 32 }
                    0, { 33 }
                    0, { 34 }
                    0, { 35 }
                    0, { 36 }
                    0, { 37 }
                    0, { 38 }
                    0, { 39 }
                    0  { 40 }
               )                    
       );

CONST Database_GrpDescr : DatabaseRecord =
       (Filename : 'GRPDESCR';
        Proc     : UpgradeGroup;
        Header   : 'WtrGate GroupDescr ';
        Oldest   : 1;
        Latest   : 3;
        RecSizes : (SizeOf (GroupDesc01Record),
                    SizeOf (GroupDesc02Record),
                    SizeOf (GroupDesc03Record),
                    0, { 04 }
                    0, { 05 }
                    0, { 06 }
                    0, { 07 }
                    0, { 08 }
                    0, { 09 }
                    0, { 10 }
                    0, { 11 }
                    0, { 12 }
                    0, { 13 }
                    0, { 14 }
                    0, { 15 }
                    0, { 16 }
                    0, { 17 }
                    0, { 18 }
                    0, { 19 }
                    0, { 20 }
                    0, { 21 }
                    0, { 22 }
                    0, { 23 }
                    0, { 24 }
                    0, { 25 }
                    0, { 26 }
                    0, { 27 }
                    0, { 28 }
                    0, { 29 }
                    0, { 30 }
                    0, { 31 }
                    0, { 32 }
                    0, { 33 }
                    0, { 34 }
                    0, { 35 }
                    0, { 36 }
                    0, { 37 }
                    0, { 38 }
                    0, { 39 }
                    0  { 40 }
               )
       );

CONST Database_ListServ : DatabaseRecord =
       (Filename : 'LISTSERV';
        Proc     : UpgradeListServ;
        Header   : 'WtrGate ListServer ';
        Oldest   : 1;
        Latest   : 6;
        RecSizes : (SizeOf (ListServer01Record),
                    SizeOf (ListServer02Record),
                    SizeOf (ListServer03Record),
                    SizeOf (ListServer04Record),
                    SizeOf (ListServer05Record),
                    SizeOf (ListServer06Record),
                    0, { 07 }
                    0, { 08 }
                    0, { 09 }
                    0, { 10 }
                    0, { 11 }
                    0, { 12 }
                    0, { 13 }
                    0, { 14 }
                    0, { 15 }
                    0, { 16 }
                    0, { 17 }
                    0, { 18 }
                    0, { 19 }
                    0, { 20 }
                    0, { 21 }
                    0, { 22 }
                    0, { 23 }
                    0, { 24 }
                    0, { 25 }
                    0, { 26 }
                    0, { 27 }
                    0, { 28 }
                    0, { 29 }
                    0, { 30 }
                    0, { 31 }
                    0, { 32 }
                    0, { 33 }
                    0, { 34 }
                    0, { 35 }
                    0, { 36 }
                    0, { 37 }
                    0, { 38 }
                    0, { 39 }
                    0  { 40 }
               )
       );


{--------------------------------------------------------------------------}
{ UpgradeTdb                                                               }
{                                                                          }
{ Deze routine zorgt voor het upgraden van een database. Als de database   }
{ bestaat dan wordt deze geopend en de header ingelezen. Als de header     }
{ klopt dan wordt een tijdelijke file aan gemaakt met de nieuwe header en  }
{ worden de records een voor een ingelezen en aan de UpgradeProc gevoerd   }
{ om aangepast te worden.                                                  }
{                                                                          }
PROCEDURE UpgradeTdb (Database : DatabaseRecord);

VAR Filename  : STRING;
    OldBase   : FILE;
    NewBase   : FILE;
    IORes     : BYTE;
    Header    : STRING[26];
    VerOld,
    Version   : BYTE;
    Nop       : ValNop;
    TempFile  : FILE;
    BytesRead : WordLong;

    PROCEDURE CreatePrivMailArea (VAR Rec; VAR Base : FILE);
    BEGIN
         FillChar (Rec,MAXLEN_REC,0);

         WITH AreaBase09Record (Rec) DO
         BEGIN
              AreaType:=2; { is not scanned }
              AreaName_U:=LoCaseString (PrivAreaName);
              AreaName_F:=UpCaseString (AreaName_U);
              Comment:='Private Mail is stored here';
              UserList:=65535; { RAWI 980222 }
              IsInGroups[16]:=128; { group Z3 }
              OriginAKA:=1;
              OriginNr:=1;
              FidoMsgStyle:=PType;
              FidoMsgPath:=PPath;
              Decode:=PDecode;
              DecodePath:=PDecPath;
         END; { with }

         Version:=7;
         Database.Proc (Rec,Version); { upgrade to latest version }

         Seek (Base,FileSize (Base));
         BlockWrite (Base,Rec,Database.RecSizes[Database.Latest]);

         CreateP:=FALSE;

         WriteLn ('Note: created area "'+PrivAreaName+'" in group Z3');
    END;

{UpgradeTdb}
BEGIN
     Filename:=Database.Filename+'.TDB';

     { open de oude database }
     Assign (OldBase,Filename);
     {$I-} Reset (OldBase,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          { do not complain about LISTSERV when we had a LISTUSER }
          IF (Database.Filename = 'LISTSERV') AND (NOT HadListUser) THEN
             Exit;

          IF (IORes = 2) THEN
          BEGIN
               WriteLn (Filename,' not found');
               Exit;
          END;

          WriteLn ('Cannot open ',Filename,'(error ',IORes,')');
          Exit;
     END;

     IF (Database.Filename = 'LISTUSER') THEN
        HadListUser:=TRUE;

     IF (Database.Filename = 'LISTSERV') THEN
        CreateListUser:=TRUE;

     { check de header }
     Seek (OldBase,0);
     {$I-} BlockRead (OldBase,Header,25); {$I+} IORes:=IOResult;

     IF (IORes <> 0) OR
        (Copy (Header,1,Length (Database.Header)) <> Database.Header) THEN
     BEGIN
          WriteLn ('Header check failed for ',Filename);
          Close (OldBase);
          Exit;
     END;

     { extract the version number from the header }
     Val (Copy (Header,Length (Database.Header)+1,2),Version,Nop);
     IF (Nop <> 0) THEN
     BEGIN
          WriteLn ('Cannot determine version for ',Filename);
          Close (OldBase);
          Exit;
     END;

     IF (Version < Database.Oldest) THEN
     BEGIN
          WriteLn (Filename,' is too old to upgrade (version ',Version,' < ',Database.Oldest,')');
          Close (OldBase);
          Exit;
     END;

     IF (Version = Database.Latest) THEN
     BEGIN
          WriteLn (Filename,' is up to date');

          IF CreateP AND (Database.Filename <> 'AREABASE') THEN
             CreatePrivmailArea (HulpRec,OldBase);

          Close (OldBase);
          Exit;
     END;

     { maak een tijdelijke file aan }
     Assign (NewBase,Database.Filename+'.$$$');
     {$I-} ReWrite (NewBase,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error creating temporary ',Database.Filename+'.$$$ (error ',IORes,')');
          Close (OldBase);
          Exit;
     END;

     { schrijf de nieuwe header naar disk }
     Header[Length (Database.Header)+1]:=Chr (48+(Database.Latest DIV 10));
     Header[Length (Database.Header)+2]:=Chr (48+(Database.Latest MOD 10));

     Header[25]:=#26;
     BlockWrite (NewBase,Header,26);

     VerOld:=Version;

     Seek (OldBase,26);

     WHILE (FilePos (OldBase) < FileSize (OldBase)) DO
     BEGIN
          { we willen geen troep in de records, dus wissen we deze eerst }
          FillChar (HulpRec,MAXLEN_REC,0);

          { lees het oude record in }
          BlockRead (OldBase,HulpRec,Database.RecSizes[VerOld],BytesRead);

          { upgrade het record }
          Version:=VerOld;
          Database.Proc (HulpRec,Version);

          { interne controle }
          IF (Version <> Database.Latest) THEN
             WriteLn ('BUG!');

          { schrijf het nieuwe record weer weg }
          BlockWrite (NewBase,HulpRec,Database.RecSizes[Database.Latest]);

     END; { while }

     IF CreateP THEN
        CreatePrivmailArea (HulpRec,NewBase);

     Close (NewBase);
     Close (OldBase);

     WriteLn (Filename,' has been upgraded');

     IF (NOT TestOnly) THEN
     BEGIN
          Assign (TempFile,Database.Filename+'.OLD');
          {$I-} Erase (TempFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) AND (IORes <> 2) THEN
          BEGIN
               WriteLn ('Error deleting old backup file ',Database.Filename,'.OLD (error ',IORes,')');
               Exit;
          END;

          {$I-} Rename (OldBase,Database.Filename+'.OLD'); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               WriteLn ('Error renaming ',Filename,' to .OLD (error ',IORes,')');
               Exit;
          END;

          {$I-} Rename (NewBase,Filename); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               WriteLn ('Error renaming ',Database.Filename,'.$$$ to ',Filename,' (error ',IORes,')');
               Exit;
          END;
     END;
END;


TYPE FlexHeaderRecord = RECORD
                              Length   : WORD;  { including header }
                              FlexType : WORD;  { one of FLEX_* }
                        END;

{--------------------------------------------------------------------------}
{ UpgradFlexTdb                                                            }
{                                                                          }
{ This routine upgrades the Flex Database config.tdb.                      }
{                                                                          }
PROCEDURE UpgradeFlexTdb;

CONST FLEX_FILENAME_OLD : STRING[10] = 'CONFIG.OLD';
      FLEX_FILENAME_TMP : STRING[10] = 'CONFIG.$$$';
      FLEX_HEADER       : STRING[22] = 'WaterGate Flex Config ';
      FLEX_NOTUSED      = $0000;      { record type }
      MAXLEN_FLEXRECORD = 2048;

VAR OldBase,
    NewBase     : FILE;
    IORes       : BYTE;
    Header      : STRING[26];
    EndOfFile   : LONGINT;
    FlexHdr     : FlexHeaderRecord;
    Buffer      : ARRAY[1..MAXLEN_FLEXRECORD] OF BYTE;
    TempFile    : FILE;
    MadeChanges : BOOLEAN;

BEGIN
     { open de oude database }
     Assign (OldBase,FLEX_FILENAME);
     {$I-} Reset (OldBase,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          IF (IORes = 2) THEN
          BEGIN
               WriteLn (FLEX_FILENAME,' not found');
               Exit;
          END;

          WriteLn ('Cannot open ',FLEX_FILENAME,'(error ',IORes,')');
          Exit;
     END;

     { check de header }
     Seek (OldBase,0);
     {$I-} BlockRead (OldBase,Header[1],25); {$I+} IORes:=IOResult;
     Header[0]:=#25;

     IF (IORes <> 0) OR
        (Copy (Header,1,Length (FLEX_HEADER)) <> FLEX_HEADER) THEN
     BEGIN
          WriteLn ('Header check failed for ',FLEX_FILENAME);
          Close (OldBase);
          Exit;
     END;

     { extract the version number from the header }
     IF (Copy (Header,Length (FLEX_HEADER)+1,3) <> 'v01') THEN
     BEGIN
          WriteLn (FLEX_FILENAME,' is of an unsupported version');
          Close (OldBase);
          Exit;
     END;

     { maak een tijdelijke file aan }
     Assign (NewBase,FLEX_FILENAME_TMP);
     {$I-} ReWrite (NewBase,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error creating temporary '+FLEX_FILENAME_TMP+' (error ',IORes,')');
          Close (OldBase);
          Exit;
     END;

     { schrijf de nieuwe header naar disk }
     Header:=FLEX_HEADER+'v01'+#26; { exactly 26 chars }
     BlockWrite (NewBase,Header[1],26);

     { lees alle oude records een voor een in }
     Seek (OldBase,26);
     EndOfFile:=FileSize (OldBase)-SizeOf (FlexHeaderRecord);

     MadeChanges:=FALSE;

     WHILE (FilePos (OldBase) < EndOfFile) DO
     BEGIN
          BlockRead (OldBase,FlexHdr,SizeOf (FlexHeaderRecord));

          IF (FlexHdr.Length > MAXLEN_FLEXRECORD) THEN
          BEGIN
               WriteLn ('Too long record in ',FLEX_FILENAME,' (',FlexHdr.Length,')');
               Close (OldBase);
               Close (NewBase);
               Exit;
          END;

          BlockRead (OldBase,Buffer,FlexHdr.Length-SizeOf (FlexHeaderRecord));

          {Write ('[$' + Word2HexString (FlexHdr.FlexType) + '] ');}


          { Update Mapper record }
          IF (FlexHdr.FlexType = $0100) THEN
          BEGIN
               { $0100 -> $0101

                 Added InOut field
               }

               Move (Buffer[2],Buffer[3],FlexHdr.Length-1);
               Buffer[2]:=3; { both in and out }

               FlexHdr.FlexType:=$0101;
               Inc (FlexHdr.Length);

               MadeChanges:=TRUE;
               {Writeln ('<0100 MAPPER>');}

          END;

          { Update AreaFix Forward Record }
          IF (FlexHdr.FlexType = $0003) THEN
          BEGIN
               { $0003 -> $0005

                 Added ExportAKA
               }

               Buffer[112]:=1; { first AKA }

               FlexHdr.FlexType:=$0005;
               Inc (FlexHdr.Length);

               MadeChanges:=TRUE;
               {Writeln ('<0003 afix forward>');}
          END;

          { Update mailing list server record }
          IF (FlexHdr.FlexType = $0200) THEN
          BEGIN
               { $0200 -> $0201

                 Added UseMessageCounter and MessageCounter fields
               }

               FillChar (Buffer [316], 1, 1);     { Use counter by defualt }
               FillChar (Buffer [317], 4, 0);     { Start at message #0    }

               FlexHdr.FlexType := $0201;
               Inc (FlexHdr.Length, 5);

               {Writeln ('<0200 MAILING LIST>');}
               MadeChanges := TRUE;
          END;

          { write new/not deleted/updated record to new base }
          IF (FlexHdr.FlexType <> FLEX_NOTUSED) THEN
          BEGIN
               BlockWrite (NewBase,FlexHdr,SizeOf (FlexHeaderRecord));
               BlockWrite (NewBase,Buffer,FlexHdr.Length-SizeOf (FlexHeaderRecord));
          END;
     END; { while }

     Close (NewBase);
     Close (OldBase);

     IF MadeChanges THEN
     BEGIN
          WriteLn (FLEX_FILENAME,' has been upgraded');

          IF (NOT TestOnly) THEN
          BEGIN
               Assign (TempFile,FLEX_FILENAME_OLD);
               {$I-} Erase (TempFile); {$I+} IORes:=IOResult;
               IF (IORes <> 0) AND (IORes <> 2) THEN
               BEGIN
                    WriteLn ('Error deleting old backup file '+FLEX_FILENAME_OLD+' (error ',IORes,')');
                    Exit;
               END;

               {$I-} Rename (OldBase,FLEX_FILENAME_OLD); {$I+} IORes:=IOResult;
               IF (IORes <> 0) THEN
               BEGIN
                    WriteLn ('Error renaming ',FLEX_FILENAME,' to .OLD (error ',IORes,')');
                    Exit;
               END;

               {$I-} Rename (NewBase,FLEX_FILENAME); {$I+} IORes:=IOResult;
               IF (IORes <> 0) THEN
               BEGIN
                    WriteLn ('Error renaming '+FLEX_FILENAME_TMP+' to ',FLEX_FILENAME,' (error ',IORes,')');
                    Exit;
               END;
          END;
     END ELSE
     BEGIN
          WriteLn (FLEX_FILENAME,' is up to date');

          { no changes, delete the .$$$ file again }
          Assign (TempFile,FLEX_FILENAME_TMP);
          {$I-} Erase (TempFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) AND (IORes <> 2) THEN
          BEGIN
               WriteLn ('Error deleting temporary file '+FLEX_FILENAME_TMP+' (error ',IORes,')');
               Exit;
          END;
     END;
END;


{**************************************************************************}
{                         TERMINATE LISTSERV                               }
{**************************************************************************}


{--------------------------------------------------------------------------}
{ TerminateListServ                                                        0
{                                                                          }
{ This routine terminates the live of the LISTSERV.TDB base. It exports    }
{ its mailing list definitions to the flex database and writes all the     }
{ user records to the LISTUSER.TDB file. The changes were too many to keep }
{ LISTSERV.TDB in a new form.                                              }
{                                                                          }
PROCEDURE TerminateListServ;

VAR ListServBase : FILE;
    ListUserBase : FILE;
    FlexBase     : FILE;
    IORes        : BYTE;

    FUNCTION OpenBases : BOOLEAN;

    VAR Header : STRING[30];

    BEGIN
         OpenBases:=FALSE; { assume failure }

         { open the LISTSERV.TDB file }
         Assign (ListServBase,'LISTSERV.TDB');
         {$I-} Reset (ListServBase,1); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              WriteLn ('Failed to open LISTSERV.TDB (error ',IORes,')');
              Exit; { with FALSE }
         END;

         { open the flex database - it might not exist. If so, create it }
         Assign (FlexBase,FLEX_FILENAME);
         {$I-} Reset (FlexBase,1); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              IF (IORes = 2) THEN
              BEGIN
                   { not found - create it }
                   {$I-} ReWrite (FlexBase,1); {$I+} IORes:=IOResult;
                   IF (IORes <> 0) THEN
                   BEGIN
                        WriteLn ('Error creating '+FLEX_FILENAME+' (error ',IORes,')');
                        Close (ListServBase);
                        Exit; { with FALSE }
                   END;

                   { successful creation - write the header }
                   Header:='WaterGate Flex Config v01'#26; { exactly 26 chars }
                   BlockWrite (FlexBase,Header[1],26);
              END ELSE
              BEGIN
                   { other but not-found error - report }
                   WriteLn ('Failed to open '+FLEX_FILENAME+' (error ',IORes,')');
                   Close (ListServBase);
                   Exit; { with FALSE }
              END;
         END ELSE
             { seek to EOF, ready to add new records }
             Seek (FlexBase,FileSize (FlexBase));

         Assign (ListUserBase,'LISTUSER.TDB');
         {$I-} Reset (ListUserBase,1); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              { if not a not-found error, then complain }
              IF (IORes <> 2) THEN
              BEGIN
                   WriteLn ('Failed to open LISTUSER.TDB (error ',IORes,')');
                   Close (ListServBase);
                   Close (FlexBase);
                   Exit; { with FALSE }
              END;

              { not found, so try to create it, then write the header }
              {$I-} ReWrite (ListUserBase,1); {$I+} IORes:=IOResult;
              IF (IORes <> 0) THEN
              BEGIN
                   WriteLn ('Failed to create LISTUSER.TDB (error ',IORes,')');
                   Close (ListServBase);
                   Close (FlexBase);
                   Exit; { with FALSE }
              END;

              { create the new base - write the header }
              FillChar (Header[1],28,#26);
              Header:=Database_ListUser.Header+
                      AddUpWithPre0s (2,Byte2String (Database_ListUser.Latest));
              BlockWrite (ListUserBase,Header[0],26);
         END ELSE
             { seek to EOF, ready to add new records }
             Seek (ListUserBase,FileSize (ListUserBase));

         OpenBases:=TRUE; { OK! }
    END;

{TerminateListServ}

{ latest version must match flex record in flexcfg.pas! }

TYPE MailingListRecord = RECORD
                               ListID          : WORD;
                               Name            : STRING[30];
                               Description     : STRING[40];
                               WelcomeFile     : STRING[79];
                               FooterFile      : STRING[79];
                               PrivateList     : BOOLEAN;
                               OnlyKnown       : BOOLEAN;
                               Passive         : BOOLEAN;
                               NameInSubject   : BOOLEAN;
                               AKA             : BYTE;
                               MLAddress       : BYTE;
                               HomeDomain      : BYTE;
                               DefaultAccess   : BYTE;
                               ConfirmInterval : BYTE;
                               AdminPassword   : STRING[8];
                               AreaName        : STRING[60];
                               AreaToList      : BOOLEAN;
                               ListToArea      : BOOLEAN;
                               UseMessageCounter:BOOLEAN;
                               MessageCounter  : LONGINT;
                         END;

    PROCEDURE ExportSubscribers (VAR RecNr : WORD; ListID : WORD);

    VAR ListServRec  : ListServer06Record;
        ListUserRec  : ListUser02Record;

    BEGIN
         WHILE (RecNr <> 65535) DO
         BEGIN
              Seek (ListServBase,26+Longint (RecNr-1)*SizeOf (ListServer06Record));
              BlockRead (ListServBase,ListServRec,SizeOf (ListServer06Record));

              RecNr:=ListServRec.NextUser;

              FillChar (ListUserRec,SizeOf (ListUserRec),0);

              ListUserRec.ListID:=ListID;

              ListUserRec.Access:=ListServRec.Access;
              ListUserRec.SubscribedDate:=ListServRec.SubscribedDate;
              ListUserRec.ConfirmedDate:=ListServRec.ConfirmedDate;
              ListUserRec.ConfirmReqDate:=ListServRec.ConfirmReqDate;
              ListUserRec.ConfirmState:=ListServRec.ConfirmState;
              ListUserRec.ConfirmCode:=ListServRec.ConfirmCode;

              ListUserRec.ReceiveOwnMail := TRUE;

              CASE ListServRec.ListSystem OF
                   1 : BEGIN
                            { FTN }
                            ListUserRec.UserType:=1;
                            ListUserRec.User:=ListServRec.Name;
                            ListUserRec.Aka:=ListServRec.Address;
                       END;

                   2 : BEGIN
                            { RFC }
                            ListUserRec.UserType:=2;
                            ListUserRec.Email:=ListServRec.Email;
                       END;

                   3 : BEGIN
                            { RemoteGW }
                            ListUserRec.UserType:=3;
                            ListUserRec.User:=ListServRec.GWUser;
                            ListUserRec.Aka:=ListServRec.GWAddress;
                            ListUserRec.Email:=ListServRec.GWEmail;
                       END;

                   ELSE
                       WriteLn ('Unknown record type ',ListServRec.ListSystem);
              END; { case }

              BlockWrite (ListUserBase,ListUserRec,SizeOf (ListUserRec));
         END; { while }
    END;

CONST LISTSERV_OLD = 'LISTSERV.OLD';

VAR ListID           : WORD;
    Lp,
    ListServRecCount : WORD;
    ListServRec      : ListServer06Record;
    MLRec            : MailingListRecord;
    FlexHdr          : FlexHeaderRecord;

BEGIN
     WriteLn ('Exporting LISTSERV.TDB to LISTUSER.TDB and Flex Database');

     IF (NOT OpenBases) THEN
     BEGIN
          WriteLn ('Export failed!');
          Exit;
     END;

     { loop through the LISTSERV.TDB searching for mailing list }
     { definitions. Copy the definition into a flex base and    }
     { walk through the link list of subscribers and export     }
     { each to the new ListUser base.                           }

     ListID:=0;
     ListServRecCount:=(FileSize (ListServBase)-26) DIV SizeOf (ListServer06Record);

     FOR Lp:=1 TO ListServRecCount DO
     BEGIN
          Seek (ListServBase,26+Longint (Lp-1)*SizeOf (ListServer06Record));
          BlockRead (ListServBase,ListServRec,SizeOf (ListServer06Record));

          IF (NOT ListServRec.Deleted) AND
             (ListServRec.ListSystem = 0) THEN
          BEGIN
               { found a mailing list record }

               { must make sure this one is unique! }
               Inc (ListID);

               { create a flex record }
               FlexHdr.Length:=SizeOf (MailingListRecord)+SizeOf (FlexHeaderRecord);
               FlexHdr.FlexType:=$0201; { Mailing list v2 }

               { fill the mailing list record }
               FillChar (MLRec,SizeOf (MailingListRecord),0);

               MLRec.ListID:=ListID;
               MLRec.Name:=ListServRec.ListName;
               MLRec.Description:=ListServRec.ListDescription;
               MLRec.WelcomeFile:=ListServRec.ListWelcome;
               MLRec.FooterFile:='';
               MLRec.PrivateList:=ListServRec.ListPrivate;
               MLRec.OnlyKnown:=ListServRec.OnlyKnown;
               MLRec.Passive:=(NOT ListServRec.Active);
               MLRec.NameInSubject:=FALSE;
               MLRec.AKA:=ListServRec.ListAKA;
               MLRec.MLAddress:=ListServRec.MLAddress;
               MLRec.HomeDomain:=ListServRec.HomeDomain;
               MLRec.DefaultAccess:=ListServRec.DefaultAccess;
               MLRec.ConfirmInterval:=ListServRec.ConfirmInterval;
               MLRec.AdminPassword:=ListServRec.AdminPassword;
               MLRec.AreaName:=ListServRec.AreaName;
               MLRec.AreaToList:=ListServRec.EchoList;
               MLRec.ListToArea:=ListServRec.ListEcho;
               MLRec.UseMessageCounter:=TRUE;
               MLRec.MessageCounter:=0;


               BlockWrite (FlexBase,FlexHdr,SizeOf (FlexHdr));
               BlockWrite (FlexBase,MLRec,SizeOf (MailingListRecord));

               ExportSubscribers (ListServRec.NextUser,ListID);
          END; { if }
     END; { for }

     { close the bases }
     Close (ListServBase);
     Close (ListUserBase);
     Close (FlexBase);

     { delete the LISTSERV.OLD file if it already existed }
     { (for example because of the upgrade).              }
     Assign (FlexBase,LISTSERV_OLD);
     {$I-} Erase (FlexBase); {$I+} IORes:=IOResult;

     {$I-} Rename (ListServBase,LISTSERV_OLD); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        WriteLn ('Failed to rename LISTSERV.TDB to '+LISTSERV_OLD+' (error ',IORes,')');

     WriteLn ('Export completed');
END;


{--------------------------------------------------------------------------}
{ TellStory                                                                }
{                                                                          }
PROCEDURE TellStory;
BEGIN
     WriteLn ('This program upgrades the WaterGate Databases (*.tdb files) to the format');
     WriteLn ('used by WaterGate version '+FullProgramVersion+'.');
     WriteLn;
     WriteLn ('Databases dating back to versions from 1994 can be upgraded.');
     WriteLn;
     WriteLn ('Run this program in the directory where the .tdb files can be found. You');
     WriteLn ('have to type UPGRADE NOW to start the actual upgrade.');
     WriteLn;
END;


{--------------------------------------------------------------------------}
{ main                                                                     }
{                                                                          }

VAR Lp  : BYTE;
    Arg : STRING[10];

BEGIN
     WriteLn (DesktopProgramName+' Upgrade '+FullProgramVersion);
     WriteLn (CopyrightLine);
     WriteLn;

     Arg:='';
     TestOnly:=FALSE;

     IF (ParamCount > 0) THEN
     BEGIN
          Arg:=UpCaseString (ParamStr (1));
          IF (Arg = 'TEST') THEN
             TestOnly:=TRUE;
     END;

     IF (ParamCount <> 1) OR ((Arg <> 'NOW') AND (NOT TestOnly)) THEN
     BEGIN
          TellStory;
          Halt;
     END;

     IF TestOnly THEN
     BEGIN
          WriteLn ('TESTMODE - Creating .$$$ files only');
          WriteLn;
     END;

     CreateP:=FALSE;
     HadListUser:=FALSE;

     UpgradeTdb (Database_WtrCfg);
     UpgradeTdb (Database_AreaBase);
     UpgradeTdb (Database_UserBase);
     UpgradeTdb (Database_Subscript);
     UpgradeTdb (Database_ListUser);
     UpgradeTdb (Database_GrpDescr);
     UpgradeTdb (Database_ListServ);

     UpgradeFlexTdb;

     IF CreateListUser THEN
        TerminateListServ;

     IF CreateP THEN
        WriteLn ('NOTE: Please create an area named ',PrivAreaName);

     WriteLn;
     WriteLn ('Upgrade complete!');
END.
