Renegade-1.19/SOURCE/OFFLINE.PAS

{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}

{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-}

UNIT OffLine;

INTERFACE

PROCEDURE SetMessageAreaNewScanDate;
PROCEDURE DownloadPacket;
PROCEDURE uploadpacket(Already: Boolean);

IMPLEMENTATION

USES
  Crt,
  Dos,
  Common,
  Archive1,
  ExecBat,
  File0,
  File1,
  File2,
  File8,
  File11,
  Mail0,
  Mail1,
  Mail2,
  Mail4,
  NodeList,
  TimeFunc;

TYPE
  BSingle = ARRAY [0..3] OF Byte;

  NDXRec = RECORD
    Pointer: BSingle;
    Conf: Byte;
  END;

  QWKHeadeRec = RECORD
    Flag: Char;
    Num: ARRAY [1..7] OF Char;
    MsgDate: ARRAY [1..8] OF Char;
    MsgTime: ARRAY [1..5] OF Char;
    MsgTo: ARRAY [1..25] OF Char;
    MsgFrom: ARRAY [1..25] OF Char;
    MsgSubj: ARRAY [1..25] OF Char;
    MsgPWord: STRING[11];
    RNum: STRING[7];
    NumBlocks: ARRAY [1..6] OF Char;
    Status: Byte;
    MBase: SmallWord;
    Crap: STRING[3];
  END;

(*
PROCEDURE SetFileAreaNewScanDate;
VAR
  TempDate: Str10;
  Key: CHAR;
BEGIN
  {
  NL;
  Prt(FString.FileNewScan);
  }
  lRGLngStr(54,FALSE);
  MPL(10);
  Prompt(PD2Date(NewDate));
  Key := Char(GetKey);
  IF (Key = #13) THEN
  BEGIN
    NL;
    TempDate := PD2Date(NewDate);
  END
  ELSE
  BEGIN
    Buf := Key;
    DOBackSpace(1,10);
    InputFormatted('',TempDate,'##/##/####',TRUE);
    IF (TempDate = '') THEN
      TempDate := PD2Date(NewDate);
  END;
  IF (DayNum(TempDate) = 0) OR (DayNum(TempDate) > DayNum(DateStr)) THEN
  BEGIN
    NL;
    Print('Invalid date entered.');
  END
  ELSE
  BEGIN
    NL;
    Print('New file scan date set to: ^5'+TempDate+'^1');
    NewDate := Date2PD(TempDate);
    SL1('Reset file new scan date to: ^5'+TempDate+'.');
  END;
END;
*)

PROCEDURE SetMessageAreaNewScanDate;
VAR
  S: AStr;
  DT: DateTime;
  MArea,
  SaveMsgArea: Integer;
  l: LongInt;
BEGIN
  NL;
  Prt('Enter oldest date for new messages (mm/dd/yyyy): ');

  InputFormatted('',S,'##/##/####',TRUE);
  IF (DayNum(S) = 0) THEN
  BEGIN
    NL;
    Print('^7Invalid date entered!^1')
  END
  ELSE IF (S <> '') THEN
  BEGIN
    NL;
    Print('Current newscan date is now: ^5'+S);
    SaveMsgArea := MsgArea;
    FillChar(DT,SizeOf(DT),0);
    WITH DT DO
    BEGIN
      Month := StrToInt(Copy(S,1,2));
      Day := StrToInt(Copy(S,4,2));
      Year := StrToInt(Copy(S,7,4));
    END;
    l := DateToPack(DT);
    FOR MArea := 1 TO NumMsgAreas DO
    BEGIN
      InitMsgArea(MArea);
      LastReadRecord.LastRead := L;
      SaveLastReadRecord(LastReadRecord);
    END;
    MsgArea := SaveMsgArea;
    LoadMsgArea(MsgArea);
    SL1('Reset message last read pointers.');
  END;
END;

PROCEDURE DownloadPacket;
VAR
  IndexR:
  NDXRec;
  NDXFile,
  PNDXFile: FILE OF NDXRec;
  MsgFile: FILE;
  ControlTxt: Text;
  MHeader: MHeaderRec;
  QWKHeader: QWKHeadeRec;
  DT: DateTime;
  TransferFlags: TransferFlagSet;
  S,
  Texts: STRING;

  C: Char;

  FArrayRecNum: Byte;

  MArea,
  UseMsgArea,
  AvailableMsgAreas,
  SaveMsgArea,
  SaveFileArea: Integer;


  TotalNewMsgsInArea,
  TotalYourMsgsInArea,
  MsgNum,
  TempTextSize: Word;

  X,
  LastK,
  Marker,
  TotalMsgsAllAreas,
  TotalNewMsgsAllAreas,
  TotalYourMsgsAllAreas,
  LastUpdate: LongInt;

  SaveConfSystem,
  Ok: Boolean;

  PROCEDURE Real_To_Msb(PReal: Real; VAR B: BSingle);
  VAR
    R: ARRAY [0 .. 5] OF Byte ABSOLUTE PReal;
  BEGIN
    B[3] := R[0];
    Move(R[3],B[0],3);
  END;

  PROCEDURE KillEmail;
  VAR
    MsgNum1: Word;
  BEGIN
    InitMsgArea(-1);
    Reset(MsgHdrF);
    IF (IOResult = 0) THEN
    BEGIN
      FOR MsgNum1 := 1 TO FileSize(MsgHdrF) DO
      BEGIN
        Seek(MsgHdrF,(MsgNum1 - 1));
        Read(MsgHdrF,MHeader);
        IF ToYou(MHeader) THEN
        BEGIN
          Include(MHeader.Status,MDeleted);
          Seek(MsgHdrF,(MsgNum1 - 1));
          Write(MsgHdrF,MHeader);
        END
      END;
      Close(MsgHdrF);
    END;
    ThisUser.Waiting := 0;
  END;

  PROCEDURE Upload_Display;
  BEGIN
    LastUpdate := Timer;
    IF (NOT Abort) THEN
      Prompt(' <13>'+PadRightInt(TotalNewMsgsInArea,7)+
             '<13>'+PadRightInt(TotalYourMsgsInArea,6)+
             '<13>'+PadRightStr(IntToStr((FileSize(MsgFile) - LastK) DIV 1024)+'k',8));
  END;

  PROCEDURE UpdatePointers;
  VAR
    MArea1: Integer;
    MsgNum1: Word;
  BEGIN
    TotalNewMsgsAllAreas := 0;
    FOR MArea1 := 1 TO NumMsgAreas DO
      IF (CompMsgArea(MArea1,0) <> 0) THEN
      BEGIN
        InitMsgArea(MArea1);
        IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR (MAForceRead IN MemMsgArea.MAFlags)) THEN
        BEGIN
          LastError := IOResult;
          Reset(MsgHdrF);
          IF (IOResult = 2) THEN
            ReWrite(MsgHdrF);
          MsgNum1 := FirstNew;
          IF (MsgNum1 > 0) THEN
            TotalNewMsgsInArea := FileSize(MsgHdrF) - MsgNum1 + 1
          ELSE
            TotalNewMsgsInArea := 0;
          MsgNum1 := FileSize(MsgHdrF);
          IF (TotalNewMsgsAllAreas + TotalNewMsgsInArea > General.MaxQWKTotal) THEN
            MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + (General.MaxQWKtotal - TotalNewMsgsAllAreas);
          IF (TotalNewMsgsInArea > general.maxqwkbase) AND
             (((FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase) < MsgNum1) THEN
            MsgNum1 := (FileSize(MsgHdrF) - TotalNewMsgsInArea) + General.MaxQWKBase;
          Seek(MsgHdrF,MsgNum1- 1);
          Read(MsgHdrF,MHeader);
          LoadLastReadRecord(LastReadRecord);
          LastReadRecord.LastRead := MHeader.Date;
          SaveLastReadRecord(LastReadRecord);
          Inc(TotalNewMsgsAllAreas, MsgNum1 - (FileSize(MsgHdrF) - TotalNewMsgsInArea));
          Close(MsgHdrF);
        END;
      END;
  END;

BEGIN
  NL;
  IF (ThisUser.DefArcType < 1) OR (ThisUser.DefArcType > MaxArcs) OR
    (NOT General.FileArcInfo[ThisUser.DefArcType].Active) THEN
  BEGIN
    Print('Please select an archive type first.');
    Exit;
  END;

  IF (MakeQWKFor > 0) OR (Exist(TempDir+'QWK\'+General.PacketName+'QWK') AND
      PYNQ('Create a new QWK packet for download? ',0,FALSE)) THEN
    PurgeDir(TempDir+'QWK\',FALSE)
  ELSE
    PurgeDir(TempDir+'QWK\',FALSE);

  SaveMsgArea := MsgArea;

  SaveConfSystem := ConfSystem;
  ConfSystem := FALSE;
  IF (SaveConfSystem) THEN
    NewCompTables;

  OffLineMail := TRUE;

  IF (NOT Exist(TempDir+'QWK\'+General.PacketName+'QWK')) THEN
  BEGIN
    Assign(ControlTxt,TempDir+'QWK\CONTROL.DAT');
    ReWrite(ControlTxt);
    WriteLn(ControlTxt,StripColor(General.BBSName));
    WriteLn(ControlTxt);
    WriteLn(ControlTxt,General.BBSPhone);
    WriteLn(ControlTxt,General.SysOpName,', Sysop');
    WriteLn(ControlTxt,'0,'+General.PacketName);
    WriteLn(ControlTxt,Copy(DateStr,1,2)+'-'+Copy(DateStr,4,2)+'-'+Copy(DateStr,7,4)+','+TimeStr);
    WriteLn(ControlTxt,ThisUser.Name);
    WriteLn(ControlTxt);
    WriteLn(ControlTxt,'0');
    WriteLn(ControlTxt,'0');

    AvailableMsgAreas := 1;

    FOR MArea := 1 TO NumMsgAreas DO
      IF MsgAreaAC(MArea) THEN
        Inc(AvailableMsgAreas);

    WriteLn(ControlTxt,(AvailableMsgAreas - 1));

    FOR MArea := -1 TO NumMsgAreas DO
      IF (MArea > 0) AND MsgAreaAC(MArea) THEN
      BEGIN
        WriteLn(ControlTxt,MemMsgArea.QWKIndex);
        WriteLn(ControlTxt,Caps(StripColor(MemMsgArea.FileName)));
      END
      ELSE IF (MArea = -1) THEN
      BEGIN
        WriteLn(ControlTxt,0);
        WriteLn(ControlTxt,'Private Mail');
      END;

    WriteLn(ControlTxt,'WELCOME');
    WriteLn(ControlTxt,'NEWS');
    WriteLn(ControlTxt,'GOODBYE');
    Close(ControlTxt);

    IF (ThisUser.ScanFilesQWK) THEN
    BEGIN
      Assign(NewFilesF,TempDir+'QWK\NEWFILES.DAT');
      ReWrite(NewFilesF);
      InitFArray(FArray);
      FArrayRecNum := 0;
      GlobalNewFileScan(FArrayRecNum);
      Close(NewFilesF);
      LastError := IOResult;
    END;

    IF (General.QWKWelcome <> '') THEN
    BEGIN
      S := General.QWKWelcome;
      IF (OkANSI) AND Exist(S+'.ANS') THEN
        S := S +'.ANS'
      ELSE
        S := S +'.ASC';
      CopyMoveFile(TRUE,'',S,TempDir+'QWK\WELCOME',FALSE);
    END;

    IF (General.QWKNews <> '') THEN
    BEGIN
      S := General.QWKNews;
      IF (OkANSI) AND Exist(S+'.ANS') THEN
        S := S +'.ANS'
      ELSE
        S := S +'.ASC';
      CopyMoveFile(TRUE,'',S,TempDir+'QWK\NEWS',FALSE);
    END;

    IF (General.QWKGoodBye <> '') THEN
    BEGIN
      S := General.QWKGoodBye;
      IF (OkANSI) AND Exist(S+'.ANS') THEN
        S := S +'.ANS'
      ELSE
        S := S +'.ASC';
      CopyMoveFile(TRUE,'',S,TempDir+'QWK\GOODBYE',FALSE);
    END;

    Assign(MsgFile,TempDir+'QWK\MESSAGES.DAT');

    S := 'The Renegade Developement Team, Copyright (c) 1992-2009 (All rights reserved)';
    WHILE (Length(S) < 128) DO
      S := S + ' ';
    ReWrite(MsgFile,1);
    BlockWrite(MsgFile,S[1],128);

    FillChar(QWKHeader.Crap,SizeOf(QWKHeader.Crap),0);

    Assign(PNDXFile,TempDir+'QWK\PERSONAL.NDX');
    ReWrite(PNDXFile);

    LastK := 0;
    (*
    TotalNewMsgsInArea := 0;
    *)
    TotalMsgsAllAreas := 0;
    TotalNewMsgsAllAreas := 0;
    TotalYourMsgsAllAreas := 0;

    TempPause := FALSE;
    Abort := FALSE;
    Next := FALSE;

    CLS;
    Print(Centre('|The QWK<57>System is now gathering mail.'));
    NL;
    PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ');
    PrintACR('s<>t Num s<>u Message area name     s<>v  Short  s<>w Echo s<>x  Total  '+
             's<>y New s<>z Your s<>{ Size s<>');
    PrintACR('s<><73><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');

    FillChar(QWKHeader.MsgPWord,SizeOf(QWKHeader.MsgPWord),' ');

    FillChar(QWKHeader.RNum,SizeOf(QWKHeader.RNum),' ');

    QWKHeader.Status := 225;

    FOR MArea := -1 TO NumMsgAreas DO
    BEGIN
      IF (IOResult <> 0) THEN
      BEGIN
        WriteLn('error processing QWK packet.');
        Exit;
      END;

      IF (MArea = 0) OR ((MArea = -1) AND (NOT ThisUser.PrivateQWK)) OR
         ((CompMsgArea(MArea,0) = 0) AND (MArea >= 0)) THEN
        Continue;

      InitMsgArea(MArea);

      IF (MArea > 0) THEN
        UseMsgArea := MemMsgArea.QWKIndex
      ELSE
        UseMsgArea := 0;

      IF AACS(MemMsgArea.ACS) AND ((LastReadRecord.NewScan) OR
        (MAForceRead IN MemMsgArea.MAFlags)) AND (NOT Abort) AND (NOT HangUp) THEN
      BEGIN
        LastError := IOResult;
        Reset(MsgHdrF);
        IF (IOResult = 2) THEN
          ReWrite(MsgHdrF);
        Reset(MsgTxtF,1);
        IF (IOResult = 2) THEN
          ReWrite(MsgTxtF,1);

        QWKHeader.MBase := UseMsgArea;

        IndexR.Conf := UseMsgArea;

        TotalNewMsgsInArea := 0;

        TotalYourMsgsInArea := 0;

        PrintMain('}'+PadRightInt(MArea,4)+
                  '    ~'+PadLeftStr(MemMsgArea.Name,22)+
                  '  '+PadLeftStr(MemMsgArea.FileName,11)+
                  '<13>'+PadLeftStr(ShowYesNo(MemMsgArea.MAType <> 0),3)+
                  '<13>'+PadRightInt(FileSize(MsgHdrF),8));

        Upload_Display;

        IF (UseMsgArea > 0) THEN
          MsgNum := FirstNew
        ELSE
          MsgNum := 1;

        IF (MsgNum > 0) THEN
        BEGIN

          S := IntToStr(UseMsgArea);

          WHILE (Length(S) < 3) DO
            S := '0' + S;

          Assign(NDXFile,TempDir+'QWK\'+S+'.NDX');
          ReWrite(NDXFile);

          WKey;

          WHILE (MsgNum <= FileSize(MsgHdrF)) AND
                (TotalNewMsgsInArea < General.MaxQWKBase) AND
                ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) < General.MaxQWKTotal) AND
                (NOT Abort) AND (NOT HangUp) DO
          BEGIN
            IF (MArea >= 0) THEN
              Inc(TotalNewMsgsInArea);
            WKey;
            IF ((Timer - LastUpdate) > 3) OR ((Timer - LastUpdate) < 0) THEN
            BEGIN
              BackErase(22);
              Upload_Display;
            END;
            Seek(MsgHdrF,(MsgNum - 1));
            Read(MsgHdrF,MHeader);
            IF (NOT (MDeleted IN MHeader.Status)) AND
                NOT (Unvalidated IN MHeader.Status) AND
                NOT (FromYou(MHeader) AND NOT ThisUser.GetOwnQWK) AND
                NOT ((Prvt IN MHeader.Status) AND NOT (FromYou(MHeader) OR ToYou(MHeader))) AND
                NOT ((MArea = -1) AND NOT (ToYou(MHeader))) THEN
            BEGIN

              IF (MArea = -1) THEN
                Inc(TotalNewMsgsInArea);

              IF (Prvt IN MHeader.Status) THEN
                QWKHeader.Flag := '*'
              ELSE
                QWKHeader.Flag := ' ';

              S := IntToStr(MsgNum);
              FillChar(QWKHeader.Num[1],SizeOf(QWKHeader.Num),' ');
              Move(S[1],QWKHeader.Num[1],Length(S));

              PackToDate(DT,MHeader.Date);

              IF (MHeader.From.Anon = 0) THEN
                S := ZeroPad(IntToStr(DT.Month))+
                    '-'+ZeroPad(IntToStr(DT.Day))+
                    '-'+Copy(IntToStr(DT.Year),3,2)
              ELSE
                S := '';

              FillChar(QWKHeader.MsgDate[1],SizeOf(QWKHeader.MsgDate),' ');
              Move(S[1],QWKHeader.MsgDate[1],Length(S));

              IF (MHeader.From.Anon = 0) THEN
                S := ZeroPad(IntToStr(DT.Hour))+
                     ':'+ZeroPad(IntToStr(DT.Min))
              ELSE
                S := '';

              FillChar(QWKHeader.MsgTime,SizeOf(QWKHeader.MsgTime),' ');
              Move(S[1],QWKHeader.MsgTime[1],Length(S));

              S := MHeader.MTo.A1S;
              IF (MARealName IN MemMsgArea.MAFlags) THEN
                S := AllCaps(MHeader.MTo.Real);
              S := Caps(Usename(MHeader.MTo.Anon,S));

              FillChar(QWKHeader.MsgTo,SizeOf(QWKHeader.MsgTo),' ');
              Move(S[1],QWKHeader.MsgTo[1],Length(S));

              S := MHeader.From.A1S;
              IF (MARealName IN MemMsgArea.MAFlags) THEN
                S := AllCaps(MHeader.From.Real);
              S := Caps(Usename(MHeader.From.Anon,S));

              FillChar(QWKHeader.MsgFrom[1],SizeOf(QWKHeader.MsgFrom),' ');
              Move(S[1],QWKHeader.MsgFrom[1],Length(S));

              FillChar(QWKHeader.MsgSubj[1],SizeOf(QWKHeader.MsgSubj),' ');

              IF (MHeader.FileAttached > 0) THEN
                MHeader.Subject := StripName(MHeader.Subject);

              Move(MHeader.Subject[1],QWKHeader.MsgSubj[1],Length(MHeader.Subject));

              Marker := FilePos(MsgFile);

              BlockWrite(MsgFile,QWKHeader,128);

              Real_To_Msb(FileSize(MsgFile) DIV 128,IndexR.Pointer);
              Write(NDXFile,IndexR);

              IF ToYou(MHeader) THEN
              BEGIN
                Write(PNDXFile,IndexR);
                Inc(TotalYourMsgsInArea);
              END;

              X := 1;
              TempTextSize := 0;
              Texts := '';

              IF ((MHeader.Pointer - 1) < FileSize(MsgTxtF)) AND
                 (((MHeader.Pointer - 1) + MHeader.TextSize) <= FileSize(MsgTxtF)) THEN
              BEGIN
                Seek(MsgTxtF,(MHeader.Pointer - 1));
                REPEAT
                  BlockRead(MsgTxtF,S[0],1);
                  BlockRead(MsgTxtF,S[1],Byte(S[0]));
                  Inc(TempTextSize,(Length(S) + 1));
                  S := S + '<27>';
                  Texts := Texts + S;
                  IF (Length(Texts) > 128) THEN
                  BEGIN
                    BlockWrite(MsgFile,Texts[1],128);
                    Inc(X);
                    Move(Texts[129],Texts[1],(Length(Texts) - 128));
                    Dec(Texts[0],128);
                  END;
                UNTIL (TempTextSize >= MHeader.TextSize);
                IF (Texts <> '') THEN
                BEGIN
                  IF (Length(Texts) < 128) THEN
                  BEGIN
                    FillChar(Texts[Length(Texts) + 1],(128 - Length(Texts)),32);
                    Texts[0] := #128;
                  END;
                  BlockWrite(MsgFile,Texts[1],128);
                  Inc(X);
                END;
              END
              ELSE
              BEGIN
                Include(MHeader.Status,MDeleted);
                MHeader.TextSize := 0;
                MHeader.Pointer := -1;
                Seek(MsgHdrF,(MsgNum - 1));
                Write(MsgHdrF,MHeader);
              END;

              S := IntToStr(X);

              FillChar(QWKHeader.NumBlocks[1],SizeOf(QWKHeader.NumBlocks),' ');
              Move(S[1],QWKHeader.NumBlocks[1],Length(S));

              Seek(MsgFile,Marker);
              BlockWrite(MsgFile,QWKHeader,128);
              Seek(MsgFile,FileSize(MsgFile));
            END;
            Inc(MsgNum);
          END;
          Close(NDXFile);
        END;
        BackErase(22);
        Upload_Display;
        NL;
        IF (TotalNewMsgsInArea >= General.MaxQWKBase) THEN
          Print('Maximum number of messages per area reached.');
        IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) THEN
          Print('Maximum number of messages per QWK packet reached.');
        LastK := FileSize(MsgFile);
        Inc(TotalNewMsgsAllAreas,TotalNewMsgsInArea);
        Inc(TotalYourMsgsAllAreas,TotalYourMsgsInArea);
        Inc(TotalMsgsAllAreas,FileSize(MsgHdrF));
        Close(MsgHdrF);
        Close(MsgTxtF);
      END;
      IF ((TotalNewMsgsAllAreas + TotalNewMsgsInArea) >= General.MaxQWKTotal) OR Abort THEN
        Break;
    END;

    IF (FileSize(PNDXFile) = 0) THEN
    BEGIN
      Close(PNDXFile);
      Erase(PNDXFile);
    END
    ELSE
      Close(PNDXFile);
    NL;

    IF (NOT Abort) THEN
      Print('^0     Totals:'+PadRightInt(TotalMsgsAllAreas,43)+PadRightInt(TotalNewMsgsAllAreas,7)+
            PadRightInt(TotalYourMsgsAllAreas,6)+
            PadRightStr(IntToStr(FileSize(MsgFile) DIV 1024)+'k',8));

    Close(MsgFile);
    NL;

    lil := 0;
    IF (TotalNewMsgsAllAreas < 1) OR (Abort) THEN
    BEGIN
      IF (TotalNewMsgsAllAreas < 1) THEN
        Print('No new messages!');
      OffLineMail := FALSE;
      ConfSystem := SaveConfSystem;
      IF (SaveConfSystem) THEN
        NewCompTables;
      MsgArea := SaveMsgArea;
      LoadMsgArea(MsgArea);
      Exit;
    END;

    IF (MakeQWKFor = 0) THEN
    BEGIN
      NL;
      IF NOT PYNQ('Proceed to packet compression: ',0,TRUE) THEN
      BEGIN
        OffLineMail := FALSE;
        ConfSystem := SaveConfSystem;
        IF (SaveConfSystem) THEN
          NewCompTables;
        MsgArea := SaveMsgArea;
        LoadMsgArea(MsgArea);
        Exit;
      END;
    END;

    NL;
    Star('Compressing '+General.PacketName+'.QWK');

    ArcComp(Ok,ThisUser.DefArcType,TempDir+'QWK\'+General.PacketName+'.QWK',TempDir+'QWK\*.*');
    IF (NOT Ok) OR (NOT Exist(TempDir+'QWK\'+General.PacketName+'.QWK')) THEN
    BEGIN
      NL;
      Print('Error archiving QWK packet!');
      OffLineMail := FALSE;
      ConfSystem := SaveConfSystem;
      IF (SaveConfSystem) THEN
        NewCompTables;
      MsgArea := SaveMsgArea;
      LoadMsgArea(MsgArea);
      Exit;
    END;

    SysOpLog('QWK packet created.');
  END;

  FindFirst(TempDir+'QWK\'+General.PacketName+'.QWK',AnyFile,DirInfo);
  IF (InCom) AND (NSL < (DirInfo.Size DIV Rate)) AND (NOT General.qwktimeignore) THEN
  BEGIN
    NL;
    Print('Sorry, not enough time left online to transfer.');
    OffLineMail := FALSE;
    ConfSystem := SaveConfSystem;
    IF (SaveConfSystem) THEN
      NewCompTables;
    MsgArea := SaveMsgArea;
    LoadMsgArea(MsgArea);
    Exit;
  END;

  Star('Compressed packet size is '+ConvertBytes(DirInfo.Size,FALSE)+'.');

  IF (InCom) AND (NOT HangUp) THEN
  BEGIN
    SaveFileArea := FileArea;
    FileArea := -1;
    WITH MemFileArea DO
    BEGIN
      AreaName := 'Offline Mail';
      DLPath := TempDir+'QWK\';
      ULPath := TempDir+'QWK\';
      FAFlags := [FANoRatio];
    END;
    WITH FileInfo DO
    BEGIN
      FileName := Align(General.PacketName+'.QWK');
      Description := 'QWK Download';
      FilePoints := 0;
      Downloaded := 0;
      FileSize := GetFileSize(TempDir+'QWK\'+General.PacketName+'.QWK');
      OwnerNum := UserNum;
      OwnerName := Caps(ThisUser.Name);
      FileDate := Date2PD(DateStr);
      VPointer := -1;
      VTextSize := 0;
      FIFlags := [];
    END;
    TransferFlags := [IsQWK];
    DLX(FileInfo,-1,TransferFlags);
    FileArea := SaveFileArea;
    LoadFileArea(FileArea);
    IF (IsTransferOk IN TransferFlags) AND (NOT (IsKeyboardAbort IN TransferFlags)) THEN
    BEGIN

      Star('Updating message pointers');

      Inc(PublicReadThisCall,TotalNewMsgsAllAreas);

      UpdatePointers;

      Star('Message pointers updated');

      IF (ThisUser.PrivateQWK) THEN
      BEGIN
        KillEmail;
        Star('Private messages killed.');
      END;

    END;
  END
  ELSE
  BEGIN
    S := General.QWKLocalPath+General.PacketName;
    IF Exist(S+'.QWK') AND ((MakeQWKFor > 0) OR NOT (PYNQ(^M^J'Replace existing .QWK? ',0,FALSE))) THEN
      FOR C := 'A' TO 'Z' DO
        IF NOT (Exist(S+'.QW'+C)) THEN
        BEGIN
          S := S + '.QW' + C;
          Break;
        END;
    IF (Pos('.', S) = 0) THEN
      S := S + '.QWK';

    CopyMoveFile(TRUE,'',TempDir+'QWK\'+General.PacketName+'.QWK',S,FALSE);

    NL;
    UpdatePointers;
    IF (ThisUser.PrivateQWK) THEN
      KillEmail;
  END;
  IF Exist(TempDir+'QWK\'+General.PacketName+'.REP') THEN
  BEGIN
    NL;
    Star('Bidirectional upload of '+General.PacketName+'.REP detected');
    UploadPacket(TRUE);
  END;
  OffLineMail := FALSE;
  ConfSystem := SaveConfSystem;
  IF (SaveConfSystem) THEN
    NewCompTables;
  MsgArea := SaveMsgArea;
  LoadMsgArea(MsgArea);
  LastError := IOResult;
END;


PROCEDURE uploadpacket(Already:Boolean);
VAR
  F: FILE;
  User: UserRecordType;
  MHeader: MHeaderRec;
  QWKHeader: QWKHeadeRec;

  S,
  Os: STRING;

  Counter,
  Counter1: Byte;

  RCode,
  MArea,
  SaveMsgArea: Integer;

  X,
  Blocks: Word;

  TransferTime,
  TempDate: LongInt;

  Ok,
  UploadOk,
  KeyboardAbort,
  AddBatch,
  SaveConfSystem: Boolean;

  FUNCTION FindBase(IndexNumber: Word): Word;
  VAR
    j,
    k: Integer;
  BEGIN
    Reset(MsgAreaFile);
    j := 0;
    k := 0;
    WHILE (j = 0) AND NOT (EOF(MsgAreaFile)) DO
    BEGIN
      Inc(k);
      Read(MsgAreaFile,MemMsgArea);
      IF (MemMsgArea.QWKIndex = IndexNumber) THEN
        j := k;
    END;
    Close(MsgAreaFile);
    FindBase := k;
  END;

BEGIN
  IF (RPost IN ThisUser.Flags) THEN
  BEGIN
    NL;
    Print('You are restricted from posting messages.');
    Exit;
  END;

  SaveMsgArea := MsgArea;  (* Was ReadMsgArea *)

  SaveConfSystem := ConfSystem;
  ConfSystem := FALSE;
  IF (SaveConfSystem) THEN
    NewCompTables;

  PurgeDir(TempDir+'UP\',FALSE);

  TimeLock := TRUE;

  UploadOk := TRUE;
  KeyboardAbort := FALSE;

  IF (ComPortSpeed = 0) OR (UpQWKFor > 0) THEN
    CopyMoveFile(TRUE,'',General.QWKLocalPath+General.PacketName+'.REP',TempDir + 'QWK\' + General.PacketName+'.REP',FALSE)
  ELSE
  BEGIN
    IF (NOT Already) THEN
      Receive(General.PacketName+'.REP',TempDir+'\QWK',FALSE,UploadOk,KeyboardAbort,AddBatch,TransferTime)
    ELSE
      CopyMoveFile(FALSE,'',TempDir+'UP\'+General.PacketName+'.REP',
               TempDir+'QWK\'+General.PacketName+'.REP',FALSE);
  END;

  TimeLock := FALSE;

  IF (UploadOk) AND (NOT KeyboardAbort) THEN
  BEGIN

    SysOpLog('Uploaded REP packet');

    IF (NOT Already) THEN
      Print('Transfer successful');

    ExecBatch(Ok,TempDir+'QWK\',General.ArcsPath+
              FunctionalMCI(General.FileArcInfo[ThisUser.DefArcType].UnArcLine,
              TempDir+'QWK\'+General.PacketName+'.REP',
              General.PacketName+'.MSG'),
              General.FileArcInfo[ThisUser.DefArcType].SuccLevel,RCode,FALSE);

    IF (Ok) AND Exist(TempDir+'QWK\'+General.PacketName+'.MSG') THEN
    BEGIN
      Assign(F,TempDir+'QWK\'+General.PacketName+'.MSG');
      Reset(F,1);

      GetFTime(F,TempDate);

      IF (TempDate = ThisUser.LastQWK) THEN
      BEGIN
        NL;
        Print('This packet has already been uploaded here.');
        Close(F);
        Exit;
      END;

      ThisUser.LastQWK := TempDate;

      MHeader.FileAttached := 0;
      MHeader.MTo.UserNum := 0;
      MHeader.MTo.Anon := 0;
      MHeader.ReplyTo := 0;
      MHeader.Replies := 0;

      TempDate := GetPackDateTime;

      BlockRead(F,S,128);
      WHILE NOT EOF(F) DO
      BEGIN
        IF (IOResult <> 0) THEN
        BEGIN
          WriteLn('error processing REP packet.');
          Break;
        END;

        BlockRead(F,QWKHeader,128);

        S[0] := #6;
        Move(QWKHeader.NumBlocks[1],S[1],6);

        Blocks := (StrToInt(S) - 1);

        IF (QWKHeader.MBase = 0) THEN
          MArea := -1
        ELSE
          MArea := FindBase(QWKHeader.MBase);

        InitMsgArea(MArea);

        IF AACS(MemMsgArea.ACS) AND AACS(MemMsgArea.PostACS) AND NOT
           ((PublicPostsToday >= General.MaxPubPost) AND (NOT MsgSysOp)) THEN
        BEGIN
          LastError := IOResult;
          Reset(MsgHdrF);
          IF (IOResult = 2) THEN
            ReWrite(MsgHdrF);
          Reset(MsgTxtF,1);
          IF (IOResult = 2) THEN
            ReWrite(MsgTxtF,1);

          IF AACS(General.QWKNetworkACS) THEN
          BEGIN
            S[0] := #25;
            Move(QWKHeader.MsgFrom[1],S[1],SizeOf(QWKHeader.MsgFrom));
            WHILE (S[Length(S)] = ' ') DO
              Dec(S[0]);
            MHeader.From.UserNum := 0;
          END
          ELSE
          BEGIN
            IF (MARealName IN MemMsgArea.MAFlags) THEN
              S := ThisUser.RealName
            ELSE
              S := ThisUser.Name;
            MHeader.From.UserNum := UserNum;
          END;

          MHeader.From.A1S := S;
          MHeader.From.Real := S;
          MHeader.From.Name := S;
          MHeader.From.Anon := 0;

          S[0] := #25;
          Move(QWKHeader.MsgTo[1],S[1],SizeOf(QWKHeader.MsgTo));

          WHILE (S[Length(S)] = ' ') DO
            Dec(S[0]);

          MHeader.MTo.A1S := S;
          MHeader.MTo.Real := S;
          MHeader.MTo.Name := S;
          MHeader.MTo.UserNum := SearchUser(MHeader.MTo.Name,FALSE);

          MHeader.Pointer := (FileSize(MsgTxtF) + 1);
          MHeader.Date := TempDate;
          Inc(TempDate);
          GetDayOfWeek(MHeader.DayOfWeek);

          MHeader.Status := [];

          IF (QWKHeader.Flag IN ['*','+']) AND (MAPrivate IN MemMsgArea.MAFlags) THEN
            Include(MHeader.Status,Prvt);

          IF (RValidate IN ThisUser.Flags) THEN
            Include(MHeader.Status,Unvalidated);

          IF (AACS(MemMsgArea.MCIACS)) THEN
            Include(MHeader.Status,AllowMCI);

          Move(QWKHeader.MsgSubj[1],S[1],SizeOf(QWKHeader.MsgSubj));
          S[0] := Chr(SizeOf(QWKHeader.MsgSubj));

          WHILE (S[Length(S)] = ' ') DO
            Dec(S[0]);

          MHeader.Subject := S;

          SysOpLog(MHeader.From.Name+' posted on '+MemMsgArea.Name);
          SysOpLog('To: '+MHeader.MTo.Name);

          MHeader.OriginDate[0] := #14;
          Move(QWKHeader.MsgDate[1],MHeader.OriginDate[1],8);
          MHeader.OriginDate[9] := #32;
          Move(QWKHeader.MsgTime[1],MHeader.OriginDate[10],5);

          MHeader.TextSize := 0;

          IF (AllCaps(MHeader.MTo.A1S) <> 'QMAIL') THEN
          BEGIN
            Seek(MsgTxtF,FileSize(MsgTxtF));
            Os := '';
            X := 1;
            WHILE (X <= Blocks) AND (IOResult = 0) DO
            BEGIN
              BlockRead(F,S[1],128);
              S[0] := #128;
              S := Os + S;
              WHILE (Pos('<27>',S) > 0) DO
              BEGIN
                Os := Copy(S,1,Pos('<27>',S)-1);
                S := Copy(S,Pos('<27>',S)+1,Length(S));
                IF (MemMsgArea.MAType <> 0) AND (Copy(Os,1,4) = '--- ') THEN
                  Os := ''
                ELSE
                BEGIN
                  IF (LennMCI(Os) > 78) THEN
                    Os := Copy(Os,1,78 + Length(Os) - LennMCI(Os));
                  Inc(MHeader.TextSize,Length(Os)+1);
                  BlockWrite(MsgTxtF,Os,Length(Os)+1);
                END;
              END;
              Os := S;
              Inc(X);
            END;

            WHILE (S[Length(S)] = ' ') DO
              Dec(S[0]);

            IF (Length(S) > 0) THEN
            BEGIN
              Inc(MHeader.TextSize,(Length(S) + 1));
              BlockWrite(MsgTxtF,S,(Length(S) + 1));
            END;

            IF (MemMsgArea.MAType <> 0) THEN
            BEGIN
              NewEchoMail := TRUE;
              IF NOT (MAScanOut IN MemMsgArea.MAFlags) THEN
                UpdateBoard;
            END;

            IF (MemMsgArea.MAType <> 0) AND (MAAddTear IN MemMsgArea.MAFlags) THEN
              WITH MemMsgArea DO
              BEGIN
                S := '--- Renegade v'+General.Version;
                Inc(MHeader.TextSize,(Length(S) + 1));
                BlockWrite(MsgTxtF,S,(Length(S) + 1));
                IF (MemMsgArea.Origin <> '') THEN
                  S := MemMsgArea.Origin
                ELSE
                  S := General.Origin;
                S := ' * Origin: '+S+' (';
                IF (AKA > 19) THEN
                  AKA := 0;
                S := S + IntToStr(General.AKA[AKA].Zone)+':'+
                         IntToStr(General.AKA[AKA].Net)+'/'+
                         IntToStr(General.AKA[AKA].Node);
                IF (General.AKA[AKA].Point > 0) THEN
                  S := S +'.'+IntToStr(General.AKA[AKA].Point);
                S := S + ')';
                Inc(MHeader.TextSize,(Length(S) + 1));
                BlockWrite(MsgTxtF,S,(Length(S) + 1));
              END;

            CLS;
            Ok := FALSE;
            UploadOk := FALSE;
            Seek(MsgHdrF,FileSize(MsgHdrF));
            Write(MsgHdrF,MHeader);

            IF (UpQWKFor <= 0) THEN
              Anonymous(TRUE,MHeader);

            IF (MArea = -1) THEN
            BEGIN
              IF (MHeader.MTo.UserNum = 0) THEN
              BEGIN
                IF (AACS(General.NetMailACS)) AND
                   (PYNQ(^M^J'Is this to be a netmail message? ',0,FALSE)) THEN
                BEGIN
                  IF (General.AllowAlias) AND PYNQ('Send this with your real name? ',0,FALSE) THEN
                    MHeader.From.A1S := ThisUser.RealName;
                  WITH MHeader.MTo DO
                    GetNetAddress(Name,Zone,Net,Node,Point,X,FALSE);
                  IF (MHeader.MTo.Name = '') THEN
                    Include(MHeader.Status,MDeleted)
                  ELSE
                  BEGIN
                    Inc(ThisUser.Debit,X);
                    Include(MHeader.Status,NetMail);
                    MHeader.NetAttribute := General.NetAttribute *
                                            [Intransit,Private,Crash,KillSent,Hold,Local];
                    ChangeFlags(MHeader);
                    Counter1 := 0;
                    Counter := 0;
                    WHILE (Counter <= 19) AND (Counter1 = 0) DO
                    BEGIN
                      IF (General.AKA[Counter].Zone = MHeader.MTo.Zone) AND
                         (General.AKA[Counter].Zone <> 0) THEN
                        Counter1 := Counter;
                      Inc(Counter);
                    END;
                    MHeader.From.Zone := General.AKA[Counter1].Zone;
                    MHeader.From.Net := General.AKA[Counter1].Net;
                    MHeader.From.Node := General.AKA[Counter1].Node;
                    MHeader.From.Point := General.AKA[Counter1].Point;
                  END;
                END
                ELSE
                  Include(MHeader.Status,MDeleted);
              END
              ELSE
              BEGIN
                IF (MHeader.MTo.UserNum > 1) THEN
                BEGIN
                  Inc(ThisUser.EmailSent);

                  IF (PrivatePostsToday < 255) THEN
                    Inc(PrivatePostsToday);

                END
                ELSE
                BEGIN
                  Inc(ThisUser.Feedback);

                  IF (FeedbackPostsToday < 255) THEN
                    Inc(FeedbackPostsToday);

                END;
                LoadURec(User,MHeader.MTo.UserNum);
                Inc(User.Waiting);
                SaveURec(User,MHeader.MTo.UserNum);
              END;
            END
            ELSE
            BEGIN
              Inc(ThisUser.MsgPost);

              IF (PublicPostsToday < 255) THEN
                Inc(PublicPostsToday);

              AdjustBalance(General.CreditPost);
            END;
            Seek(MsgHdrF,(FileSize(MsgHdrF) - 1));
            Write(MsgHdrF,MHeader);

          END
          ELSE
          BEGIN
            IF (MHeader.Subject = 'DROP') THEN
            BEGIN
              LoadLastReadRecord(LastReadRecord);
              LastReadRecord.NewScan := FALSE;
              SaveLastReadRecord(LastReadRecord)
            END
            ELSE IF (MHeader.Subject = 'ADD') THEN
            BEGIN
              LoadLastReadRecord(LastReadRecord);
              LastReadRecord.NewScan := TRUE;
              SaveLastReadRecord(LastReadRecord);
            END;
            Seek(F,FilePos(F) + (Blocks * 128));
          END;
          Close(MsgHdrF);
          Close(MsgTxtF);
        END
        ELSE
          Seek(F,FilePos(F) + (Blocks * 128));
      END;
      Close(F);
    END
    ELSE
      Print('Unable to decompress REP packet.');
  END
  ELSE
    Print('Transfer unsuccessful');

  IF Exist(General.QWKLocalPath+General.PacketName+'.REP') AND (ComPortSpeed = 0)
     AND (UpQWKFor = 0) AND PYNQ(^M^J'Delete REP packet? ',0,FALSE) THEN
    Kill(General.QWKLocalPath+General.PacketName+'.REP');

  PurgeDir(TempDir+'QWK\',FALSE);

  Update_Screen;

  IF (SaveConfSystem) THEN
  BEGIN
    ConfSystem := SaveConfSystem;
    NewCompTables;
  END;

  MsgArea := SaveMsgArea;
  InitMsgArea(MsgArea);

  LastError := IOResult;
END;

END.