{$IFDEF MSDOS}
{$V-,S-,R-,F+,O+}
{$ENDIF}
{$I-}

Unit MKMsgJam;       {JAM Msg Object Unit}

Interface

Uses
  MKGlobT,
  MKMsgAbs,
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  OpCrt,
  SysUtils,
{$ENDIF}
  tMisc,
  MKFile,
  tGlob,
  Crc32,
  MKDos;

Const
{$IFDEF MSDOS}
  JamIdxBufSize = 256;
  JamSubBufSize = 2048;
  JamTxtBufSize = 2048;
  TxtSubBufSize = 1024;
{$ELSE}
  JamIdxBufSize = 2048;
  JamSubBufSize = 4096;
  JamTxtBufSize = 16384;
  TxtSubBufSize = 2048;
{$ENDIF}

  JamSubFieldDataSize = 1024;

  JamMsgPathLen = 128;
  JamMsgSubjLen = 100;
  JamMsgFromToLen = 65;

  sfReplace = True;
  sfAdd = False;

Type
  JamHdrType = Record
    Signature            : Array [1..4] Of Char;
    Created, ModCounter,
    ActiveMsgs, PwdCRC,
    BaseMsgNum           : LongInt;
    Extra                : Array [1..1000] Of Char;
  End;

  JamMsgHdrType = Record
    Signature                  : Array [1..4] Of Char;
    Rev, Resvd                 : Word;
    SubFieldLen, TimesRead,
    MsgIdCrc, ReplyCrc,
    ReplyTo, ReplyFirst,
    ReplyNext, DateWritten,
    DateRcvd, DateArrived,
    MsgNum, Attr1, Attr2,
    TextOfs, TextLen,
    PwdCrc, Cost               : LongInt;
  End;

  JamIdxType = Record
    MsgToCrc, HdrLoc : LongInt;
  End;

  JamLastType = Record
    NameCrc, UserNum,
    LastRead, HighRead  : LongInt;
  End;

  JamIdxArrayType = Array [0..JamIdxBufSize-1] Of JamIdxType;
  JamSubBuffer = Array [0..JamSubBufSize-1] Of Char;

  JamTxtBufType = Array [0..JamTxtBufSize-1] Of Char;
  JamTxtSubBuffer = Array [0..TxtSubBufSize-1] Of Char;
  HdrType = Record
    JamHdr: JamMsgHdrType;
    SubBuf: JamSubBuffer;
  End;

  JamMsgType = Record
    HdrFile, TxtFile,
    IdxFile             : shFile;
    MsgPath             : String [JamMsgPathLen];
    BaseHdr             : JamHdrType;
    Dest, Orig          : AddrType;
    MsgFrom, MsgTo      : String [JamMsgFromToLen];
    MsgSubj             : String [JamMsgSubjLen];
    MsgDate             : String [8];
    MsgTime             : String [5];
    CurrMsgNum          : LongInt;
    YourName, YourHdl   : String [35];
    NameCrc, HdlCrc,
    TxtPos, TxtEnd,
    TxtBufStart         : LongInt;
    TxtRead, IdxRead    : SysInt;
    MailType            : MsgMailType;
    BufFile             : shFile;
    LockCount, IdxStart : LongInt;
    TxtSubBuf           : JamTxtSubBuffer; {temp storage for text on subfields}
    TxtSubChars         : Integer;
  End;

  SubFieldType = Record
    LoId, HiId : Word;
    DataLen    : LongInt;
    Data       : Array [0..JamSubFieldDataSize-1] Of Char;
  End;
  PSubFieldType = ^SubFieldType;

  JamMsgObj = Object (AbsMsgObj)
    JM                    : ^JamMsgType;
    MsgHdr                : ^HdrType;
    JamIdx                : ^JamIdxArrayType;
    TxtBuf                : ^JamTxtBufType;
    Error                 : Word;
    SeekOver,
    NeedReCount,
    NeedGetTotal,
    IncRelative,
    NeedReSeek            : Boolean;
    CurRelative,
    TotalMsgsNumber,
    StartMsgNumber,
    EndMsgNumber          : LongInt;
    YourSavePos,
    YourLastPos           : LongInt;
    SeekCurr_Pos          : LongInt;
    yFound                : Boolean;
    TmpFileName           : PathStr;

    Procedure WriteMsgText (Var WriteError: Word);
    Procedure SetupCurrMsgHeader;
    Procedure ReadCurrMsgHeader;
    Procedure RemoveSubFields (id: Word);
    Constructor Init; {Initialize}
    Destructor Done; Virtual; {Done}
    Procedure SetMsgPath (St: String); Virtual; {Set netmail path}
    Function  GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area}
    Function  LockMsgBase: Boolean; Virtual; {Lock the message base}
    Function  UnLockMsgBase: Boolean; Virtual; {Unlock the message base}
    Procedure SetDest (Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Dest}
    Procedure SetOrig (Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Orig}
    Procedure SetFrom (Name: String); Virtual; {Set message from}
    Procedure SetTo (Name: String); Virtual; {Set message to}
    Procedure SetSubj (Str: String); Virtual; {Set message subject}
    Procedure SetCost (SCost: Word); Virtual; {Set message cost}
    Procedure SetRefer (SRefer: LongInt); Virtual; {Set message reference}
    Procedure SetSeeAlso (SAlso: LongInt); Virtual; {Set message see also}
    Function  GetNextSeeAlso: LongInt; Virtual;
    Procedure SetNextSeeAlso (SAlso: LongInt); Virtual;
    Procedure SetDate (SDate: String); Virtual; {Set message date}
    Procedure SetTime (STime: String); Virtual; {Set message time}
    Procedure SetLocal (LS: Boolean); Virtual; {Set local status}
    Procedure SetRcvd (RS: Boolean); Virtual; {Set received status}
    Procedure SetPriv (PS: Boolean); Virtual; {Set priveledge vs public status}
    Procedure SetCrash (SS: Boolean); Virtual; {Set crash netmail status}
    Procedure SetKillSent (SS: Boolean); Virtual; {Set kill/sent netmail status}
    Procedure SetSent (SS: Boolean); Virtual; {Set sent netmail status}
    Procedure SetFAttach (SS: Boolean); Virtual; {Set file attach status}
    Procedure SetReqRct (SS: Boolean); Virtual; {Set request receipt status}
    Procedure SetReqAud (SS: Boolean); Virtual; {Set request audit status}
    Procedure SetRetRct (SS: Boolean); Virtual; {Set return receipt status}
    Procedure SetFileReq (SS: Boolean); Virtual; {Set file request status}
    Procedure SetHold (SS: Boolean); Virtual; {Set file hold status}
    Procedure SetDirect (SS: Boolean); Virtual; {Set file direct status}
    Procedure DoString (Str: String); Virtual; {Add string to message text}
    Procedure DoChar (CH: Char); Virtual; {Add character to message text}
    Procedure DoStringLn (Str: String); Virtual; {Add string and newline to msg text}
    Procedure DoKludgeLn (Str: String); Virtual; {Add ^AKludge line to msg}
    Function  WriteMsg: Word; Virtual;
    Function  ReWriteMsg: Word; Virtual;
    Function  GetChar: Char; Virtual;
    Procedure AddTxtSubfield (St: String);
    Procedure MsgStartUp; Virtual; {set up msg for reading}
    Function  EOM: Boolean; Virtual; {No more msg text}
    Function  GetString (MaxLen: Word): String; Virtual; {Get wordwrapped string}
    Function  WasWrap: Boolean; Virtual; {Last line was soft wrapped no CR}
    Procedure SeekFirst (MsgNum: LongInt); Virtual; {Seek msg number}
    Procedure SeekNext; Virtual; {Find next matching msg}
    Procedure SeekPrior; Virtual; {Seek prior matching msg}
    Function  GetFrom: String; Virtual; {Get from name on current msg}
    Function  GetTo: String; Virtual; {Get to name on current msg}
    Function  GetSubj: String; Virtual; {Get subject on current msg}
    Function  GetCost: Word; Virtual; {Get cost of current msg}
    Function  GetDate: String; Virtual; {Get date of current msg}
    Function  GetTime: String; Virtual; {Get time of current msg}
    Function  GetRefer: LongInt; Virtual; {Get reply to of current msg}
    Function  GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
    Function  GetMsgNum: LongInt; Virtual; {Get message number}
    Procedure GetOrig (Var Addr: AddrType); Virtual; {Get origin address}
    Procedure GetDest (Var Addr: AddrType); Virtual; {Get destination address}
    Function  IsLocal: Boolean; Virtual; {Is current msg local}
    Function  IsCrash: Boolean; Virtual; {Is current msg crash}
    Function  IsKillSent: Boolean; Virtual; {Is current msg kill sent}
    Function  IsSent: Boolean; Virtual; {Is current msg sent}
    Function  IsFAttach: Boolean; Virtual; {Is current msg file attach}
    Function  IsReqRct: Boolean; Virtual; {Is current msg request receipt}
    Function  IsReqAud: Boolean; Virtual; {Is current msg request audit}
    Function  IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
    Function  IsFileReq: Boolean; Virtual; {Is current msg a file request}
    Function  IsRcvd: Boolean; Virtual; {Is current msg received}
    Function  IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
    Function  IsDeleted: Boolean; Virtual; {Is current msg deleted}
    Function  IsEchoed: Boolean; Virtual; {Msg should be echoed}
    Function  IsDirect: Boolean; Virtual; {Is current msg local}
    Function  IsHold: Boolean; Virtual; {Is current msg local}
    Function  GetMsgLoc: LongInt; Virtual; {Msg location}
    Procedure SetMsgLoc (ML: LongInt); Virtual; {Msg location}
    Procedure YoursFirst (Name: String; Handle: String); Virtual; {Seek your mail}
    Procedure YoursNext; Virtual; {Seek next your mail}
    Function  YoursFound: Boolean; Virtual; {Message found}
    Procedure StartNewMsg; Virtual;
    Function  OpenMsgBase: Word; Virtual;
    Function  CloseMsgBase: Word; Virtual;
    Function  MsgBaseExists: Boolean; Virtual; {Does msg base exist}
    Function  CreateMsgBase (MaxMsg: Word; MaxDays: Word): Word; Virtual;
    Function  SeekFound: Boolean; Virtual;
    Procedure SetMailType (MT: MsgMailType); Virtual; {Set message base type}
    Function  GetSubArea: Word; Virtual; {Get sub area number}
    Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
    Procedure DeleteMsg (CarePos: Boolean); Virtual; {Delete current message}
    Function  NumberOfMsgs: LongInt; Virtual; {Number of messages}
    Function  GetLastRead (UNum: LongInt): LongInt; Virtual; {Get last read for user num}
    Procedure SetLastRead (UNum: LongInt; LR: LongInt); Virtual; {Set last read}
    Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks}
    Function  GetTxtPos: LongInt; Virtual; {Get indicator of msg text position}
    Procedure SetTxtPos (TP: LongInt); Virtual; {Set text position}
    Procedure SetAttr1 (Mask: LongInt; St: Boolean); {Set attribute 1}
    Function  ReadIdx: Word;
    Function  WriteIdx: Word;
    Procedure AddSubField (id: Word; Data: String; AddMode: Boolean);
    Function  FindLastRead (Var LastFile: shFile; UNum: LongInt): LongInt;
    Function  ReReadIdx (Var IdxLoc : LongInt) : Word;
    Function  GetMsgNumRelative: LongInt; Virtual;
    Procedure GetTotalMsgs; Virtual;
    Function  GetLowMsgNum: LongInt; Virtual;
    Procedure SeekCurMsg;
    Function  GetHighMsgNumDir: LongInt; Virtual;
  End;

  JamMsgPtr = ^JamMsgObj;

Implementation

Const
  Jam_Local =         $00000001;
  Jam_InTransit =     $00000002;
  Jam_Priv =          $00000004;
  Jam_Rcvd =          $00000008;
  Jam_Sent =          $00000010;
  Jam_KillSent =      $00000020;
  Jam_AchvSent =      $00000040;
  Jam_Hold =          $00000080;
  Jam_Crash =         $00000100;
  Jam_Imm =           $00000200;
  Jam_Direct =        $00000400;
  Jam_Gate =          $00000800;
  Jam_Freq =          $00001000;
  Jam_FAttch =        $00002000;
  Jam_TruncFile =     $00004000;
  Jam_KillFile =      $00008000;
  Jam_RcptReq =       $00010000;
  Jam_ConfmReq =      $00020000;
  Jam_Orphan =        $00040000;
  Jam_Encrypt =       $00080000;
  Jam_Compress =      $00100000;
  Jam_Escaped =       $00200000;
  Jam_FPU =           $00400000;
  Jam_TypeLocal =     $00800000;
  Jam_TypeEcho =      $01000000;
  Jam_TypeNet =       $02000000;
  Jam_NoDisp =        $20000000;
  Jam_Locked =        $40000000;
  Jam_Deleted =       $80000000;
  Jam_DelOrRcvd =     Jam_Deleted Or Jam_Rcvd;

  jamsf_Source =      0;
  jamsf_Destination = 1;
  jamsf_From =        2;
  jamsf_To =          3;
  jamsf_MSGID =       4;
  jamsf_REPLY =       5;
  jamsf_Subject =     6;
  jamsf_PID =         7;
  jamsf_Via =         8;
  jamsf_Attaches =    9;
  jamsf_Freqs =       11;
  jamsf_Unknown =     2000;
  jamsf_SEENBY =      2001;
  jamsf_PATH =        2002;
  jamsf_FLAGS =       2003;

Function JamStrCrc (St: String): LongInt;
Var
  i   : Word;
  Crc : LongInt;

Begin
  Crc := - 1;
  For i := 1 To Length (St) Do
    Crc := UpdateCrc32 (Ord (LoCase (St [i])), Crc);
  JamStrCrc := Crc;
End;

Constructor JamMsgObj. Init;
Begin
  New (JM);
  New (JamIdx);
  New (MsgHdr);
  New (TxtBuf);

  If ((JM = Nil) Or (JamIdx = Nil) Or (MsgHdr = Nil) Or (TxtBuf = Nil)) Then
  Begin
    If JM <> Nil Then Dispose (JM);
    If JamIdx <> Nil Then Dispose (JamIdx);
    If MsgHdr <> Nil Then Dispose (MsgHdr);
    If TxtBuf <> Nil Then Dispose (TxtBuf);
    Fail;
    Exit;
  End;

  FillChar (JM^, SizeOf (JM^), #0);
  FillChar (MsgHdr^, SizeOf (MsgHdr^), #0);
  FillChar (JamIdx^, SizeOf (JamIdx^), #0);

  JM^. IdxStart := -30;
  Error := 0;
  StartMsgNumber := 0;
  TotalMsgsNumber := 0;
  EndMsgNumber := Abs (MaxLongInt);
End;

Destructor JamMsgObj. Done;
Begin
  shClose (JM^. HdrFile);
  shClose (JM^. TxtFile);
  shClose (JM^. IdxFile);

  If JM <> Nil Then Dispose (JM);
  If JamIdx <> Nil Then Dispose (JamIdx);
  If MsgHdr <> Nil Then Dispose (MsgHdr);
  If TxtBuf <> Nil Then Dispose (TxtBuf);
End;

Procedure JamMsgObj. SetMsgPath (St: String);
Begin
  JM^. MsgPath := Copy (St, 1, JamMsgPathLen - 4); { Path + '.ext' }
  NeedReCount := True;
  IncRelative := False;
End;

Function JamMsgObj. GetHighMsgNum: LongInt;
Begin
  GetHighMsgNum := EndMsgNumber;
End;

Function JamMsgObj. GetLowMsgNum: LongInt;
Begin
  GetLowMsgNum := StartMsgNumber;
End;

Function JamMsgObj. GetHighMsgNumDir: LongInt;
Begin
  GetHighMsgNumDir := JM^. BaseHdr. BaseMsgNum + shFileSize (JM^. IdxFile) - 1;
End;

Procedure JamMsgObj. SetDest (Var Addr: AddrType);
Begin
  JM^. Dest := Addr;
End;

Procedure JamMsgObj. SetOrig (Var Addr: AddrType);
Begin
  JM^. Orig := Addr;
End;

Procedure JamMsgObj. SetFrom (Name: String);
Begin
  JM^. MsgFrom := Name;
End;

Procedure JamMsgObj. SetTo (Name: String);
Begin
  JM^. MsgTo := Name;
End;

Procedure JamMsgObj. SetSubj (Str: String);
Begin
  JM^. MsgSubj := Str;
End;

Procedure JamMsgObj. SetCost (SCost: Word);
Begin
  MsgHdr^. JamHdr. Cost := SCost;
End;

Procedure JamMsgObj. SetRefer (SRefer: LongInt);
Begin
  MsgHdr^. JamHdr. ReplyTo := SRefer;
End;

Procedure JamMsgObj. SetSeeAlso (SAlso: LongInt);
Begin
  MsgHdr^. JamHdr. ReplyFirst := SAlso;
End;

Procedure JamMsgObj. SetDate (SDate: String);
Begin
  JM^. MsgDate := SDate;
End;

Procedure JamMsgObj. SetTime (STime: String);
Begin
  JM^. MsgTime := STime;
End;

Procedure JamMsgObj. SetAttr1 (Mask: LongInt; St: Boolean);
Begin
  If St Then
    MsgHdr^. JamHdr. Attr1 := MsgHdr^. JamHdr. Attr1 Or Mask
  Else
    MsgHdr^. JamHdr. Attr1 := MsgHdr^. JamHdr. Attr1 And (Not Mask);
End;

Procedure JamMsgObj. SetLocal (LS: Boolean);
Begin
  SetAttr1 (Jam_Local, LS);
End;

Procedure JamMsgObj. SetRcvd (RS: Boolean);
Begin
  SetAttr1 (Jam_Rcvd, RS);
End;

Procedure JamMsgObj. SetPriv (PS: Boolean);
Begin
  SetAttr1 (Jam_Priv, PS);
End;

Procedure JamMsgObj. SetCrash (SS: Boolean);
Begin
  SetAttr1 (Jam_Crash, SS);
End;

Procedure JamMsgObj. SetKillSent (SS: Boolean);
Begin
  SetAttr1 (Jam_KillSent, SS);
End;

Procedure JamMsgObj. SetSent (SS: Boolean);
Begin
  SetAttr1 (Jam_Sent, SS);
End;

Procedure JamMsgObj. SetFAttach (SS: Boolean);
Begin
  SetAttr1 (Jam_FAttch, SS);
End;

Procedure JamMsgObj. SetReqRct (SS: Boolean);
Begin
  SetAttr1 (Jam_RcptReq, SS);
End;

Procedure JamMsgObj. SetReqAud (SS: Boolean);
Begin
  SetAttr1 (Jam_ConfmReq, SS);
End;

Procedure JamMsgObj. SetRetRct (SS: Boolean);
Begin
End;

Procedure JamMsgObj. SetFileReq (SS: Boolean);
Begin
  SetAttr1 (Jam_Freq, SS);
End;

Procedure JamMsgObj. SetDirect (SS: Boolean);
Begin
  SetAttr1 (Jam_Direct, SS);
End;

Procedure JamMsgObj. SetHold (SS: Boolean);
Begin
  SetAttr1 (Jam_Hold, SS);
End;

Function JamMsgObj. GetFrom: String; {Get from name on current msg}
Begin
  GetFrom := JM^. MsgFrom;
End;

Function JamMsgObj. GetTo: String; {Get to name on current msg}
Begin
  GetTo := JM^. MsgTo;
End;

Function JamMsgObj. GetSubj: String; {Get subject on current msg}
Begin
  GetSubj := JM^. MsgSubj;
End;

Function JamMsgObj. GetCost: Word; {Get cost of current msg}
Begin
  GetCost := MsgHdr^. JamHdr. Cost;
End;

Function JamMsgObj. GetDate: String; {Get date of current msg}
Begin
  GetDate := JM^. MsgDate;
End;

Function JamMsgObj. GetTime: String; {Get time of current msg}
Begin
  GetTime := JM^. MsgTime;
End;

Function JamMsgObj. GetRefer: LongInt; {Get reply to of current msg}
Begin
  GetRefer := MsgHdr^. JamHdr. ReplyTo;
End;

Function JamMsgObj. GetSeeAlso: LongInt; {Get see also of current msg}
Begin
  GetSeeAlso := MsgHdr^. JamHdr. ReplyFirst;
End;

Function JamMsgObj. GetMsgNum: LongInt; {Get message number}
Begin
  GetMsgNum := {MsgHdr^. JamHdr} JM^. CurrMsgNum;
End;

Procedure JamMsgObj. GetOrig (Var Addr: AddrType); {Get origin address}
Begin
  Addr := JM^. Orig;
End;

Procedure JamMsgObj. GetDest (Var Addr: AddrType); {Get destination address}
Begin
  Addr := JM^. Dest;
End;

Function JamMsgObj. IsLocal: Boolean; {Is current msg local}
Begin
  IsLocal := (MsgHdr^. JamHdr. Attr1 And Jam_Local) <> 0;
End;

Function JamMsgObj. IsCrash: Boolean; {Is current msg crash}
Begin
  IsCrash := (MsgHdr^. JamHdr. Attr1 And Jam_Crash) <> 0;
End;

Function JamMsgObj. IsKillSent: Boolean; {Is current msg kill sent}
Begin
  IsKillSent := (MsgHdr^. JamHdr. Attr1 And Jam_KillSent) <> 0;
End;

Function JamMsgObj. IsSent: Boolean; {Is current msg sent}
Begin
  IsSent := (MsgHdr^. JamHdr. Attr1 And Jam_Sent) <> 0;
End;

Function JamMsgObj. IsFAttach: Boolean; {Is current msg file attach}
Begin
  IsFAttach := (MsgHdr^. JamHdr. Attr1 And Jam_FAttch) <> 0;
End;

Function JamMsgObj. IsReqRct: Boolean; {Is current msg request receipt}
Begin
  IsReqRct := (MsgHdr^. JamHdr. Attr1 And Jam_RcptReq) <> 0;
End;

Function JamMsgObj. IsReqAud: Boolean; {Is current msg request audit}
Begin
  IsReqAud := (MsgHdr^. JamHdr. Attr1 And Jam_ConfmReq) <> 0;
End;

Function JamMsgObj. IsRetRct: Boolean; {Is current msg a return receipt}
Begin
  IsRetRct := False;
End;

Function JamMsgObj. IsFileReq: Boolean; {Is current msg a file request}
Begin
  IsFileReq := (MsgHdr^. JamHdr. Attr1 And Jam_Freq) <> 0;
End;

Function JamMsgObj. IsRcvd: Boolean; {Is current msg received}
Begin
  IsRcvd := (MsgHdr^. JamHdr. Attr1 And Jam_Rcvd) <> 0;
End;

Function JamMsgObj. IsPriv: Boolean; {Is current msg priviledged/private}
Begin
  IsPriv := (MsgHdr^. JamHdr. Attr1 And Jam_Priv) <> 0;
End;

Function JamMsgObj. IsDeleted: Boolean; {Is current msg deleted}
Begin
  IsDeleted := (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) <> 0;
End;

Function JamMsgObj. IsEchoed: Boolean; {Is current msg echoed}
Begin
  IsEchoed := True;
End;

Function JamMsgObj. IsDirect: Boolean;
Begin
  IsDirect := (MsgHdr^. JamHdr. Attr1 And Jam_Direct) <> 0;
End;

Function JamMsgObj. IsHold: Boolean;
Begin
  IsHold := (MsgHdr^. JamHdr. Attr1 And Jam_Hold) <> 0;
End;

Function JamMsgObj. GetTxtPos: LongInt;
Begin
  GetTxtPos := JM^. TxtPos;
End;

Procedure JamMsgObj. SetTxtPos (TP: LongInt);
Begin
  JM^. TxtPos := TP;
End;

Procedure JamMsgObj. DoChar (CH: Char);
Begin
  Case CH Of
    #13: LastSoft := False;
    #10: ;
  Else
    LastSoft := True;
  End;

  If (JM^. TxtPos - JM^. TxtBufStart) >= JamTxtBufSize Then
  Begin
    If JM^. TxtBufStart = 0 Then
    Begin
      GetDir (0, TmpFileName);
      TmpFileName := GetTempName (TmpFileName);
      shAssign (JM^. BufFile, TmpFileName);
      FileMode := fmReadWrite + fmDenyNone;
      shReWrite (JM^. BufFile, 1);
    End;

    shWrite (JM^. BufFile, TxtBuf^, JM^. TxtPos - JM^. TxtBufStart);
    Error := shIOResult;
    JM^. TxtBufStart := shFileSize (JM^. BufFile);
  End;

  TxtBuf^ [JM^. TxtPos - JM^. TxtBufStart] := CH;
  Inc (JM^. TxtPos);
End;

Procedure JamMsgObj. AddSubField (id: Word; Data: String; AddMode: Boolean);
Var
  DLen     : Integer;
  SubField : PSubFieldType;

Begin
  If AddMode = sfReplace Then RemoveSubFields (id);

  DLen := Length (Data);
  If (MsgHdr^. JamHdr. SubFieldLen + 8 + DLen <= JamSubBufSize) Then
  Begin
    SubField := @MsgHdr^. SubBuf [MsgHdr^. JamHdr. SubFieldLen];
    SubField^. LoId := Id;
    SubField^. HiId := 0;
    SubField^. DataLen := DLen;
    Move (Data [1], SubField^. Data, DLen);
    Inc (MsgHdr^. JamHdr. SubFieldLen, 8 + DLen);
  End;
End;

Procedure JamMsgObj. RemoveSubFields (id: Word);
Var
  SubPtr, SubLen : LongInt;
  SubField       : PSubFieldType;

Begin
  SubPtr := 0;
  While (SubPtr < MsgHdr^. JamHdr. SubFieldLen) Do
  Begin
    SubField := @MsgHdr^. SubBuf [SubPtr];
    SubLen := SubField^. DataLen + 8;
    If SubField^. LoId = id Then
    Begin
      Dec (MsgHdr^. JamHdr. SubFieldLen, SubLen);
      Move (MsgHdr^. SubBuf [SubPtr + SubLen], SubField^,
        MsgHdr^. JamHdr. SubFieldLen - SubPtr);
    End
    Else
      Inc (SubPtr, SubLen);
  End;
End;

Procedure JamMsgObj. DoKludgeLn (Str: String);
Var
  TmpStr : String;

Begin
  If Str [1] = #1 Then Delete (Str, 1, 1);
  If Copy (Str, 1, 7) = 'MSGID: ' Then
  Begin
    TmpStr := Copy (Trim (Copy (Str, 8, 255)), 1, 100);
    AddSubField (jamsf_MSGID, TmpStr, sfReplace);
    MsgHdr^. JamHdr. MsgIdCrc := JamStrCrc (TmpStr);
  End Else
  If Copy (Str, 1, 7) = 'REPLY: ' Then
  Begin
    TmpStr := Copy (Trim (Copy (Str, 8, 255)), 1, 100);
    AddSubField (jamsf_REPLY, TmpStr, sfReplace);
    MsgHdr^. JamHdr. ReplyCrc := JamStrCrc (TmpStr);
  End Else
  If Copy (Str, 1, 5) = 'PID: ' Then
  Begin
    TmpStr := Copy (Trim (Copy (Str, 6, 255)), 1, 40);
    AddSubField (jamsf_PID, TmpStr, sfReplace);
  End Else
  If Copy (Str, 1, 7) = 'FLAGS: ' Then
  Begin
    TmpStr := Trim (Copy (Str, 8, 255));
    AddSubField (jamsf_FLAGS, TmpStr, sfReplace);
  End Else
  If Copy (Str, 1, 6) = 'PATH: ' Then
  Begin
    TmpStr := Trim (Copy (Str, 7, 255));
    AddSubField (jamsf_PATH, TmpStr, sfAdd);
  End Else
  If Copy (Str, 1, 4) = 'Via ' Then
  Begin
    TmpStr := Trim (Copy (Str, 5, 255));
    AddSubField (jamsf_Via, TmpStr, sfAdd);
  End Else
  If Copy (Str, 1, 9) = 'SEEN-BY: ' Then
  Begin
    TmpStr := Trim (Copy (Str, 10, 255));
    AddSubField (jamsf_SEENBY, TmpStr, sfAdd);
  End Else
  If Copy (Str, 1, 4) = 'INTL' Then  {ignore}
  Begin
  End Else
  If Copy (Str, 1, 4) = 'TOPT' Then  {ignore}
  Begin
  End Else
  If Copy (Str, 1, 4) = 'FMPT' Then  {ignore}
  Begin
  End Else
    AddSubField (jamsf_Unknown, Trim (Str), sfAdd);
End;

Procedure JamMsgObj. DoString (Str: String);
Var
  i : Integer;

Begin
  If Length (Str) > 0 Then
    If Str [1] = #1
    Then
      DoKludgeLn (Str)
    Else
      For i := 1 To Length (Str) Do
        DoChar (Str [i]);
End;

Procedure JamMsgObj. DoStringLn (Str: String);
Begin
  DoString (Str);
  If Not ((Length (Str) > 0) And (Str [1] = #1)) Then DoChar (#13);
End;

Procedure JamMsgObj. WriteMsgText (Var WriteError: Word);
Var
  i : SysInt;

Begin
  shSeekFile (JM^. TxtFile, shFileSize (JM^. TxtFile)); {seek end of text file}
  WriteError := shIOResult;

  If JM^. TxtBufStart > 0 Then
  Begin                                   {write text using buffer file}
    If WriteError = 0 Then                {flush buffer to file}
    Begin
      i := JM^. TxtPos - JM^. TxtBufStart;
      shWrite (JM^. BufFile, TxtBuf^, i);
      WriteError := shIOResult;
    End;

    If WriteError = 0 Then                {seek start of buffer file}
    Begin
      shSeekFile (JM^. BufFile, 0);
      WriteError := shIOResult;
    End;

    While ((Not shEoF (JM^. BufFile)) And (WriteError = 0)) Do
    Begin                                 {copy buffer file to text file}
      shRead (JM^. BufFile, TxtBuf^, SizeOf (TxtBuf^), i);
      WriteError := shIOResult;

      If WriteError = 0 Then
      Begin
        JM^. TxtBufStart := shFilePos (JM^. TxtFile);
        JM^. TxtRead := i;
        shWrite (JM^. TxtFile, TxtBuf^, i);
        Error := shIOResult;
      End;
    End;

    shClose (JM^. BufFile);
    Error := shIOResult;
    tDeleteFile (TmpFileName);
    Error := shIOResult;
  End
  Else
    If WriteError = 0 Then              {write text using TxtBuf only}
    Begin
      shWrite (JM^. TxtFile, TxtBuf^, JM^. TxtPos);
      WriteError := shIOResult;
      JM^. TxtRead := JM^. TxtPos;
    End;
End;

Procedure JamMsgObj. SetupCurrMsgHeader;
Var
  DT : DateTime;

Begin
  MsgHdr^. JamHdr. Signature [1] := 'J'; {Set signature}
  MsgHdr^. JamHdr. Signature [2] := 'A';
  MsgHdr^. JamHdr. Signature [3] := 'M';
  MsgHdr^. JamHdr. Signature [4] := #0;

  Case JM^. MailType Of
    mmtNormal   : SetAttr1 (Jam_TypeLocal, True);
    mmtEchoMail : SetAttr1 (Jam_TypeEcho, True);
    mmtNetMail  : SetAttr1 (Jam_TypeNet, True);
  End;

  MsgHdr^. JamHdr. Rev := 1;
  MsgHdr^. JamHdr. DateArrived := ToUnixDate (GetDosDate); {Get date processed}
  DT. Year := Str2Long (Copy (JM^. MsgDate, 7, 2)); {Convert date written}
  DT. Month := Str2Long (Copy (JM^. MsgDate, 1, 2));
  DT. Day := Str2Long (Copy (JM^. MsgDate, 4, 2));
  If DT. Year < 80 Then Inc (DT. Year, 2000)
                   Else Inc (DT. Year, 1900);
  DT. Sec := 0;
  DT. Hour := Str2Long (Copy (JM^. MsgTime, 1, 2));
  DT. Min := Str2Long (Copy (JM^. MsgTime, 4, 2));
  MsgHdr^. JamHdr. DateWritten := DateTime2UnixDate (DT);

  If IsValidAddr (JM^. Orig) Then                {Add subfields as needed}
    AddSubField (jamsf_Source, AddrStr (JM^. Orig), sfReplace);

  If IsValidAddr (JM^. Dest) Then
    AddSubField (jamsf_Destination, AddrStr (JM^. Dest), sfReplace);

  If Length (JM^. MsgFrom) > 0 Then
    AddSubField (jamsf_From, JM^. MsgFrom, sfReplace);
  If Length (JM^. MsgTo) > 0 Then
    AddSubField (jamsf_To, JM^. MsgTo, sfReplace);

  If Length (JM^. MsgSubj) > 0 Then
    If IsFileReq Then AddSubField (jamsf_Freqs, JM^. MsgSubj, sfReplace)
                 Else AddSubField (jamsf_Subject, JM^. MsgSubj, sfReplace);
End;

Function JamMsgObj. WriteMsg: Word;
Var
  WriteError : Word;
  TmpIdx     : JamIdxType;

Begin
  If LockMsgBase Then WriteError := 0
                 Else WriteError := 5;

  If WriteError = 0 Then
  Begin
    If LastSoft Then
    Begin
      DoChar (#13);
      DoChar (#10);
    End;

    SetupCurrMsgHeader;

    MsgHdr^. JamHdr. MsgNum := GetHighMsgNum + 1;      {handle message text}
    MsgHdr^. JamHdr. TextOfs := shFileSize (JM^. TxtFile);
    MsgHdr^. JamHdr. TextLen := JM^. TxtPos;
  End;

  If WriteError = 0 Then WriteMsgText (WriteError);

  If WriteError = 0 Then             {add index record}
  Begin
    TmpIdx. HdrLoc := shFileSize (JM^. HdrFile);
    TmpIdx. MsgToCrc := JamStrCrc (JM^. MsgTo);
    shSeekFile (JM^. IdxFile, shFileSize (JM^. IdxFile));
    WriteError := shIOResult;
  End;

  If WriteError = 0 Then             {write index record}
  Begin
    shWrite (JM^. IdxFile, TmpIdx, 1);
    WriteError := shIOResult;
  End;

  If WriteError = 0 Then
  Begin
    shSeekFile (JM^. HdrFile, shFileSize (JM^. HdrFile)); {to end of .jhr file}
    WriteError := shIOResult;
  End;

  If WriteError = 0 Then
  Begin                            {write msg header}
    shWrite (JM^. HdrFile, MsgHdr^, SizeOf (MsgHdr^. JamHdr) +
      MsgHdr^. JamHdr. SubFieldLen);
    WriteError := shIOResult;
  End;

  If WriteError = 0 Then
  Begin                            {update msg base header}
    Inc (JM^. BaseHdr. ActiveMsgs);
    Inc (JM^. BaseHdr. ModCounter);
  End;

  If UnLockMsgBase Then;           {unlock msg base}

  WriteMsg := ReadIdx;             {return result of writing msg}

  NeedReSeek := True;
  EndMsgNumber := GetHighMsgNumDir;
  Inc (TotalMsgsNumber);

  If StartMsgNumber = 0 Then
  Begin
    StartMsgNumber := MsgHdr^. JamHdr. MsgNum;
    EndMsgNumber := Abs (MaxLongInt);
    TotalMsgsNumber := 0;
    GetTotalMsgs;
  End;
End;

Function JamMsgObj. ReWriteMsg: Word;
Var
  WriteError : Word;
  IdxLoc     : LongInt;

Begin
  If LockMsgBase Then WriteError := 0
                 Else WriteError := 5;

  If WriteError = 0 Then
  Begin                                    {Handle message text}
    If LastSoft Then
    Begin
      DoChar (#13);
      DoChar (#10);
    End;

    Case JM^. MailType Of
      mmtNormal   : SetAttr1 (Jam_TypeLocal, True);
      mmtEchoMail : SetAttr1 (Jam_TypeEcho, True);
      mmtNetMail  : SetAttr1 (Jam_TypeNet, True);
    End;

    WriteMsgText (WriteError);

    If WriteError = 0 Then
    Begin                              {write msg header}
      ReReadIdx (IdxLoc);
      shSeekFile (JM^. HdrFile, JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc + 60);
      MsgHdr^. JamHdr. TextOfs := shFileSize (JM^. TxtFile)-JM^. TxtPos;
      MsgHdr^. JamHdr. TextLen := JM^. TxtPos;

      shWrite (JM^. HdrFile, MsgHdr^. JamHdr. TextOfs,
        SizeOf (MsgHdr^. JamHdr. TextOfs));
      shWrite (JM^. HdrFile, MsgHdr^. JamHdr. TextLen,
        SizeOf (MsgHdr^. JamHdr. TextLen));

      WriteError := shIOResult;
    End;

    If UnLockMsgBase Then;             {unlock msg base}
  End;

  ReWriteMsg := ReadIdx;               {return result of writing msg}
End;

Procedure JamMsgObj. ReWriteHdr;
Var
  IdxLoc, IdxOldPos, TOfs, TLen : LongInt;
  oHdr                          : ^HdrType;

Begin
  If LockMsgBase Then Error := 0
                 Else Error := 5;

  If Error = 0 Then
  Begin
    IdxOldPos := shFilePos (JM^. IdxFile);
    Error := ReReadIdx (IdxLoc);
  End;

  If Error = 0 Then
  Begin
    shSeekFile (JM^. HdrFile, JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc);
    Error := shIOResult;
  End;

  If Error = 0 Then
  Begin
    New (oHdr);
    Move (MsgHdr^, oHdr^, SizeOf (MsgHdr^));

    ReadCurrMsgHeader;
    TOfs := MsgHdr^. JamHdr. TextOfs;
    TLen := MsgHdr^. JamHdr. TextLen;

    Move (oHdr^, MsgHdr^, SizeOf (oHdr^));
    Dispose (oHdr);
  End;

  If Error = 0 Then
  Begin
    JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc := shFileSize (JM^. HdrFile);
    Error := WriteIdx;
  End;

  If Error = 0 Then
  Begin
    SetupCurrMsgHeader;

    MsgHdr^. JamHdr. TextOfs := TOfs;
    MsgHdr^. Jamhdr. TextLen := TLen;

    shSeekFile (JM^. HdrFile, JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc); {shSeekFile to end of .jhr file}
    Error := shIOResult;
  End;

  If Error = 0 Then
  Begin
    shWrite (JM^. HdrFile, MsgHdr^, SizeOf (MsgHdr^. JamHdr) +
      MsgHdr^. JamHdr. SubFieldLen);
    Inc (JM^. BaseHdr. ModCounter);
    shSeekFile (JM^. IdxFile, IdxOldPos);
  End;

  If UnLockMsgBase Then;
End;

Procedure JamMsgObj. AddTxtSubfield (St: String);
Var
  i, Len : Integer;

Begin
  Len := Length (St);
  i := TxtSubBufSize - JM^. TxtSubChars;
  If i < Len Then Len := i;

  Move (St [1], JM^. TxtSubBuf [JM^. TxtSubChars], Len);
  Inc (JM^. TxtSubChars, Len);

  If i > Len Then
  Begin
    JM^. TxtSubBuf [JM^. TxtSubChars] := #13;
    Inc (JM^. TxtSubChars);
  End;
End;

Procedure JamMsgObj. ReadCurrMsgHeader;
Var
  NumRead : SysInt;
  SubCtr  : LongInt;
  SubPtr  : PSubFieldType;

Begin
  shRead (JM^. HdrFile, MsgHdr^, SizeOf (MsgHdr^. JamHdr), NumRead);
  If MsgHdr^. JamHdr. SubFieldLen > JamSubBufSize Then
    MsgHdr^. JamHdr. SubFieldLen := JamSubBufSize;
  shRead (JM^. HdrFile, MsgHdr^. SubBuf, MsgHdr^. JamHdr. SubFieldLen,
    NumRead);
  MsgHdr^. JamHdr. SubFieldLen := NumRead;
  Error := shIOResult;

  SubCtr := 0;     { correcting subfields & remove last, if not fit in buffer }
  While (SubCtr < MsgHdr^. JamHdr. SubFieldLen) Do
  Begin
    If SubCtr > (MsgHdr^. JamHdr. SubFieldLen - 8) Then Break;
    SubPtr := @MsgHdr^. SubBuf [SubCtr];
    If SubPtr^. DataLen < 0 Then SubPtr^. DataLen := 0;
    If (SubCtr + SubPtr^. DataLen + 8) > MsgHdr^. JamHdr. SubFieldLen Then
      Break;
    Inc (SubCtr, SubPtr^. DataLen + 8);
  End;
  MsgHdr^. JamHdr. SubFieldLen := SubCtr;
End;

Procedure JamMsgObj. MsgStartUp;
Var
  SubCtr, IdxLoc, Len  : LongInt;
  NumRead              : SysInt;
  AddrMsgID, AddrReply : Boolean;
  SubPtr               : PSubFieldType;
  DT                   : DateTime;
  TmpStr               : String;

  Procedure SetString (Var Source, Dest; Count: Byte);
  Var
    S: String Absolute Dest;

  Begin
    Move (Source, S [1], Count);
    SetLength (S, Count);
  End;

Begin
  Error := 0;
  LastSoft := False;
  JM^. TxtSubChars := 0;
  JM^. MsgFrom := '';
  JM^. MsgTo := '';
  JM^. MsgSubj := '';
  FillChar (JM^. Orig, SizeOf (JM^. Orig), #0);
  FillChar (JM^. Dest, SizeOf (JM^. Dest), #0);
  AddrMsgID := False;
  AddrReply := False;

  If SeekFound Then
  Begin
    Error := ReReadIdx (IdxLoc);

    If Error = 0 Then
    Begin
      shSeekFile (JM^. HdrFile, JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc);
      Error := shIOResult;
    End;

    If Error = 0 Then ReadCurrMsgHeader;

    If Error = 0 Then
    Begin
      UnixDate2DateTime (MsgHdr^. JamHdr. DateWritten, DT);
      JM^. MsgDate := FormattedDate (Dt, 'MM-DD-YY');
      JM^. MsgTime := FormattedDate (Dt, 'HH:II');
      SubCtr := 0;
      While (SubCtr < MsgHdr^. JamHdr. SubFieldLen) Do
      Begin
        SubPtr := @MsgHdr^. SubBuf [SubCtr];
        Len := SubPtr^. DataLen;
        Inc (SubCtr, Len + 8);

        Case (SubPtr^. LoId) Of
         jamsf_Source :
             If Not AddrMsgID Then
             Begin
               If Len > 128 Then Len := 128;
               SetString (SubPtr^. Data, TmpStr, Len);
               ParseAddr (TmpStr, JM^. Orig, JM^. Orig);
             End;

         jamsf_Destination :
             If Not AddrReply Then
             Begin
               If Len > 128 Then Len := 128;
               SetString (SubPtr^. Data, TmpStr, Len);
               ParseAddr (TmpStr, JM^. Dest, JM^. Dest);
             End;

         jamsf_From :
             Begin
               If Len > JamMsgFromToLen Then Len := JamMsgFromToLen;
               SetString (SubPtr^. Data, JM^. MsgFrom, Len);
             End;

         jamsf_To :
             Begin
               If Len > JamMsgFromToLen Then Len := JamMsgFromToLen;
               SetString (SubPtr^. Data, JM^. MsgTo, Len);
             End;

         jamsf_MSGID :
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'MSGID: ' + TmpStr);
               If ParseAddr (ExtractWord (1, TmpStr, [' ']), JM^. Orig, JM^. Orig)
               Then
                 AddrMsgID := True;
             End;

         jamsf_REPLY :
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'REPLY: ' + TmpStr);
               If ParseAddr (ExtractWord (1, TmpStr, [' ']), JM^. Dest, JM^. Dest)
               Then
                 AddrReply := True;
             End;

         jamsf_Subject :
             Begin
               If Len > JamMsgSubjLen Then Len := JamMsgSubjLen;
               SetString (SubPtr^. Data, JM^. MsgSubj, Len);
             End;

         jamsf_PID :
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'PID: ' + TmpStr);
             End;

         jamsf_Via :
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'Via ' + TmpStr);
             End;

         jamsf_Attaches :
             If IsFAttach Then
             Begin
               If Len > JamMsgSubjLen Then Len := JamMsgSubjLen;
               SetString (SubPtr^. Data, JM^. MsgSubj, Len);
             End;

         jamsf_Freqs:
             If IsFileReq Then
             Begin
               If Len > JamMsgSubjLen Then Len := JamMsgSubjLen;
               SetString (SubPtr^. Data, JM^. MsgSubj, Len);
             End;

       jamsf_Unknown:
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1 + TmpStr);
             End;

       jamsf_SEENBY:
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'SEEN-BY: ' + TmpStr);
             End;

       jamsf_PATH:
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'PATH: ' + TmpStr);
             End;

       jamsf_FLAGS:
             Begin
               If Len > 240 Then Len := 240;
               SetString (SubPtr^. Data, TmpStr, Len);
               AddTxtSubfield (#1'FLAGS: ' + TmpStr);
             End;
        End;
      End;
    End;
  End;
End;

Procedure JamMsgObj. MsgTxtStartUp;
Begin
  LastSoft := False;
  JM^. TxtEnd := MsgHdr^. JamHdr. TextOfs + MsgHdr^. JamHdr. TextLen - 1;
  If JM^. TxtSubChars > 0 Then JM^. TxtPos := - JM^. TxtSubChars
                          Else JM^. TxtPos := MsgHdr^. JamHdr. TextOfs;
End;

Function JamMsgObj. GetChar: Char;
Begin
  If JM^. TxtPos < 0 Then
  Begin
    GetChar := JM^. TxtSubBuf [JM^. TxtSubChars + JM^. TxtPos];
    Inc (JM^. TxtPos);
    If JM^. TxtPos = 0 Then JM^. TxtPos := MsgHdr^. JamHdr. TextOfs;
  End Else
  Begin
    If ((JM^. TxtPos >= JM^. TxtBufStart + JM^. TxtRead) Or
        (JM^. TxtPos < JM^. TxtBufStart)) Then
    Begin
      JM^. TxtBufStart := JM^. TxtPos;
      shSeekFile (JM^. TxtFile, JM^. TxtBufStart);
      Error := shIOResult;
      If Error = 0 Then
      Begin
        shRead (JM^. TxtFile, TxtBuf^, SizeOf (TxtBuf^), JM^. TxtRead);
        Error := shIOResult;
      End;
    End;
    GetChar := TxtBuf^ [JM^. TxtPos - JM^. TxtBufStart];
    Inc (JM^. TxtPos);
  End;
End;

Function JamMsgObj. GetString (MaxLen: Word): String;
Var
  WPos               : LongInt;
  CurrLen, WLen      : Word;
  StrDone, StartSoft : Boolean;
  TmpCh              : Char;
  Tmp                : String;

Begin
  FillChar (Tmp, SizeOf (Tmp), #0);
  CurrLen := 0;
  WLen := 0;
  WPos := 0;
  StartSoft := LastSoft;
  LastSoft := True;
  StrDone := False;

  While ((CurrLen < MaxLen) And (Not EOM)) Do
  Begin
    TmpCh := GetChar;
    Case TmpCh Of
      ' ': If (CurrLen > 0) Or (Not StartSoft) Then
           Begin
             Inc (CurrLen);
             Tmp [CurrLen] := TmpCh;
             WLen := CurrLen;
             WPos := JM^. TxtPos;
           End
           Else
             StartSoft := False;
      #13: Begin
             LastSoft := False;
             StrDone := True;
             Break;
           End;
      #0:  ;
      #10: ;
      #141:;
    Else
      Inc (CurrLen);
      Tmp [CurrLen] := TmpCh;
    End;
  End;

  If Not (StrDone Or EOM) Then
    If WLen > 0 Then
    Begin
      CurrLen := WLen;
      JM^. TxtPos := WPos;
    End;

  SetLength (Tmp, CurrLen);
  GetString := Tmp;
End;

Function JamMsgObj. EOM: Boolean;
Begin
  EOM := (JM^. TxtPos >= 0) And
         ((JM^. TxtPos > JM^. TxtEnd) Or
          (JM^. TxtPos < MsgHdr^. JamHdr. TextOfs));
End;

Function JamMsgObj. WasWrap: Boolean;
Begin
  WasWrap := LastSoft;
End;

Function JamMsgObj. ReadIdx: Word;
Begin
  If JM^. IdxStart < 0 Then JM^. IdxStart := 0;
  shSeekFile (JM^. IdxFile, JM^. IdxStart);
  shRead (JM^. IdxFile, JamIdx^, JamIdxBufSize, JM^. IdxRead);
  FillChar (JamIdx^ [JM^. IdxRead],
    (JamIdxBufSize - JM^. IdxRead) * SizeOf (JamIdxType), #0);
  ReadIdx := shIOResult;
End;

Function JamMsgObj. ReReadIdx (Var IdxLoc : LongInt) : Word;
Begin
  IdxLoc := JM^. CurrMsgNum - JM^. BaseHdr. BaseMsgNum;

  If IdxLoc < JM^. IdxStart Then
  Begin
    If (JM^. IdxStart - IdxLoc) > JamIdxBufSize
    Then
      JM^. IdxStart := IdxLoc - (JamIdxBufSize Div 2)
    Else
      JM^. IdxStart := IdxLoc - (JamIdxBufSize - 1);

    ReReadIdx := ReadIdx;
  End
  Else
    If IdxLoc >= (JM^. IdxStart + JM^. IdxRead) Then
    Begin
      If (IdxLoc - (JM^. IdxStart + JM^. IdxRead)) > JamIdxBufSize
      Then
        JM^. IdxStart := IdxLoc - (JamIdxBufSize Div 2)
      Else
        JM^. IdxStart := IdxLoc;

      ReReadIdx := ReadIdx;
    End
    Else
      ReReadIdx := 0;
End;

Function JamMsgObj. WriteIdx: Word;
Begin
  shSeekFile (JM^. IdxFile, JM^. IdxStart);
  shWrite (JM^. IdxFile, JamIdx^, JM^. IdxRead);
  WriteIdx := shIOResult;
End;

Procedure JamMsgObj. SeekCurMsg;
Var
  IdxLoc  : LongInt;
  NumRead : SysInt;

Begin
  Error := ReReadIdx (IdxLoc);

  If SeekCurr_Pos <> JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc + 52 Then
  Begin
    SeekCurr_Pos := JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc + 52;
    shSeekFile (JM^. HdrFile, SeekCurr_Pos);
    shRead (JM^. HdrFile, MsgHdr^. JamHdr. Attr1,
      SizeOf (MsgHdr^. JamHdr. Attr1), NumRead);
    If shIOResult <> 0 Then;
  End;
End;

Function JamMsgObj. GetMsgNumRelative: LongInt;
Var
  sNum : LongInt;

Begin
  If NeedGetTotal Then
  Begin
    TotalMsgsNumber := 0;
    GetTotalMsgs;
  End;

  If NeedReCount Then
  Begin
    sNum := JM^. CurrMsgNum;
    SeekOver := False;
    SeekFirst (StartMsgNumber);
    SeekCurMsg;
    CurRelative := 1;
    IncRelative := False;

    While (JM^. CurrMsgNum <> sNum) And SeekFound Do
    Begin
      SeekCurMsg;
      If (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) = 0 Then Inc (CurRelative);
      SeekNext;
    End;

    SeekFirst (sNum);
    MsgStartUp;

    NeedReCount := False;
    IncRelative := True;
  End;

  GetMsgNumRelative := CurRelative;
End;

Procedure JamMsgObj. GetTotalMsgs;
Var
  sNum, Last : LongInt;
  SomeFound  : Boolean;

Begin
  sNum := JM^. CurrMsgNum;
  IncRelative := False;
  SeekFirst (JM^. BaseHdr. BaseMsgNum + shFileSize (JM^. IdxFile) - 1);
  SomeFound := False;

  While SeekFound Do
  Begin
    SeekCurMsg;
    If (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) = 0 Then
    Begin
      Inc (TotalMsgsNumber);
      If TotalMsgsNumber = 1 Then
      Begin
        EndMsgNumber := JM^. CurrMsgNum;
        SomeFound := True;
      End;

      Last := JM^. CurrMsgNum;
    End;
    SeekPrior;
  End;

  If SomeFound Then StartMsgNumber := Last
  Else
  Begin
    StartMsgNumber := 0;
    EndMsgNumber := 0;
  End;

  NeedReCount := True;
  IncRelative := True;
  If sNum = 0 Then sNum := StartMsgNumber;
  SeekFirst (sNum);
  {MsgStartUp;}
  NeedGetTotal := False;
End;

Procedure JamMsgObj. SeekFirst (MsgNum: LongInt);
Begin
  If (MsgNum > 0) And
     ((JM^. CurrMsgNum <> MsgNum) Or NeedReSeek Or SeekOver) Then
  Begin
    JM^. CurrMsgNum := MsgNum + 1;
    If JM^. CurrMsgNum < (JM^. BaseHdr. BaseMsgNum - 1) Then
       JM^. CurrMsgNum := JM^. BaseHdr. BaseMsgNum - 1;
    NeedReSeek := False;
    NeedReCount := True;
    SeekOver := False;
    SeekPrior;
    If TotalMsgsNumber > 0 Then SeekOver := False;
  End;
End;

Procedure JamMsgObj. SeekNext;
Var
  IdxLoc, oNum, HighMsg : LongInt;

Label
  Loop,
  Loop1;

Begin

Loop:
  If IncRelative Then
    If CurRelative >= TotalMsgsNumber Then
    Begin
      SeekOver := True;
      Exit;
    End;

  oNum := JM^. CurrMsgNum;
  HighMsg := GetHighMsgNumDir;
  SeekOver := False;
  If JM^. CurrMsgNum <= HighMsg Then Inc (JM^. CurrMsgNum);
  Error := ReReadIdx (IdxLoc);

  If JM^. CurrMsgNum <= HighMsg Then
  Begin
    While (((JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc <= 0) Or
          (JamIdx^ [IdxLoc - JM^. IdxStart]. MsgToCrc = -1)) And
          (JM^. CurrMsgNum <= HighMsg)) Do
    Begin
      Inc (JM^. CurrMsgNum);
      Error := ReReadIdx (IdxLoc);
    End;

    If JM^. CurrMsgNum > HighMsg Then
    Begin
      JM^. CurrMsgNum := oNum;
      GoTo Loop1;
    End;

  End Else
  Begin
    Dec (JM^. CurrMsgNum);

Loop1:
    Error := ReReadIdx (IdxLoc);
    SeekOver := True;
  End;

  If Not SeekOver And IncRelative Then
  Begin
    If ((JM^. CurrMsgNum < JM^. BaseHdr. BaseMsgNum) Or
        (JM^. CurrMsgNum > HighMsg)) Then
    Begin
      Dec (JM^. CurrMsgNum);
      SeekOver := True;
    End Else
    Begin
      SeekCurMsg;
      If JM^. CurrMsgNum = 0 Then Exit;
      If (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) <> 0 Then GoTo Loop;
      Inc (CurRelative);
    End;
  End;
End;

Procedure JamMsgObj. SeekPrior;
Var
  IdxLoc, oMsgNum : LongInt;

Label
  Loop;

Begin
  oMsgNum := -1;

Loop:
  SeekOver := False;
  If JM^. CurrMsgNum >= JM^. BaseHdr. BaseMsgNum Then Dec (JM^. CurrMsgNum);
  Error := ReReadIdx (IdxLoc);

  If JM^. CurrMsgNum >= StartMsgNumber Then
  While (((JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc < 0) Or
          (JamIdx^ [IdxLoc - JM^. IdxStart]. MsgToCrc = -1)) And
          (JM^. CurrMsgNum >= JM^. BaseHdr. BaseMsgNum)) Do
  Begin
    Dec (JM^. CurrMsgNum);
    Error := ReReadIdx (IdxLoc);
  End
  Else
  Begin
    Inc (JM^. CurrMsgNum);
    Error := ReReadIdx (IdxLoc);
    SeekFirst (GetLowMsgNum);
    SeekOver := True;
    NeedReCount := True;
  End;

  If Not SeekOver Then
  Begin
    If (JM^. CurrMsgNum = 0) Or (JM^. CurrMsgNum = oMsgNum) Then Exit;
    SeekCurMsg;
    If (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) <> 0 Then
    Begin
      oMsgNum := JM^. CurrMsgNum;
      GoTo Loop;
    End;

    If IncRelative Then Dec (CurRelative);
  End;
End;

Function JamMsgObj. SeekFound: Boolean;
Begin
  SeekFound := ((JM^. CurrMsgNum >= JM^. BaseHdr. BaseMsgNum) And
                (JM^. CurrMsgNum <= EndMsgNumber)) And (Not SeekOver);
End;

Function JamMsgObj. GetMsgLoc: LongInt;
Begin
  GetMsgLoc := GetMsgNum;
End;

Procedure JamMsgObj. SetMsgLoc (ML: LongInt);
Begin
  JM^. CurrMsgNum := ML;
End;

Procedure JamMsgObj. YoursFirst (Name: String; Handle: String);
Begin
  YourSavePos := shFilePos (JM^. IdxFile);
  JM^. NameCrc := JamStrCrc (Name);
  If Length (Handle) > 0 Then JM^. HdlCrc := JamStrCrc (Handle)
                         Else JM^. HdlCrc := JM^. NameCrc;
  YourLastPos := 0;
  YoursNext;
End;

Procedure JamMsgObj. YoursNext;
Const
  IdxBufSize = 256;

Type
  tjIdx = Array [0..IdxBufSize-1] Of JamIdxType;

Var
  i, j, NumRead : SysInt;
  sPos, Attr1   : LongInt;
  jIdx          : ^tjIdx;

Begin
  New (jIdx);
  shSeekFile (JM^. IdxFile, YourLastPos);

  While Not shEoF (JM^. IdxFile) And (shIOResult = 0) Do
  Begin
    sPos := shFilePos (JM^. IdxFile);
    shRead (JM^. IdxFile, jIdx^, IdxBufSize, j);

    For i := 0 To j-1 Do
      If (jIdx^ [i]. MsgToCrc = JM^. NameCrc) Or
         (jIdx^ [i]. MsgToCrc = JM^. HdlCrc) Then
        If shSeekFile (JM^. HdrFile, jIdx^ [i]. HdrLoc + 52) Then
        Begin
          shRead (JM^. HdrFile, Attr1, SizeOf (Attr1), NumRead);
          If NumRead = SizeOf (Attr1) Then
          Begin
            If (Attr1 And Jam_DelOrRcvd) <> 0 Then Continue;

            If shSeekFile (JM^. HdrFile, jIdx^ [i]. HdrLoc) Then
            Begin
              ReadCurrMsgHeader;
              If Error = 0 Then
              Begin
                JM^. CurrMsgNum := MsgHdr^. JamHdr. MsgNum;
                YourLastPos := sPos + i + 1;
                yFound := True;
                Dispose (jIdx);
                Exit;
              End;
            End;
          End;
        End;
  End;

  shSeekFile (JM^. IdxFile, YourSavePos);
  shRead (JM^. IdxFile, jIdx^, 1, NumRead);
  shSeekFile (JM^. HdrFile, jIdx^ [0]. HdrLoc);
  ReadCurrMsgHeader;
  If Error = 0 Then JM^. CurrMsgNum := MsgHdr^. JamHdr. MsgNum;
  yFound := False;
  Dispose (jIdx);
End;

Function JamMsgObj. YoursFound: Boolean;
Begin
  YoursFound := yFound;
End;

Procedure JamMsgObj. StartNewMsg;
Begin
  JM^. TxtBufStart := 0;
  JM^. TxtPos := 0;
  FillChar (MsgHdr^, SizeOf (MsgHdr^), #0);
  MsgHdr^. JamHdr. SubFieldLen := 0;
  MsgHdr^. JamHdr. MsgIdCrc := -1;
  MsgHdr^. JamHdr. ReplyCrc := -1;
  MsgHdr^. JamHdr. PwdCrc := -1;
  JM^. MsgTo := '';
  JM^. MsgFrom := '';
  JM^. MsgSubj := '';
  FillChar (JM^. Orig, SizeOf (JM^. Orig), #0);
  FillChar (JM^. Dest, SizeOf (JM^. Dest), #0);
  JM^. MsgDate := DateStr (GetDosDate);
  JM^. MsgTime := TimeStr (GetDosDate);
End;

Function JamMsgObj. MsgBaseExists: Boolean;
Begin
  MsgBaseExists := FileExists (JM^. MsgPath + '.JHR');
End;

Function JamMsgObj. OpenMsgBase: Word;
Var
  OpenError : Word;
  i         : SysInt;

Begin
  JM^. LockCount := 0;

  If (Not FileExists (JM^. MsgPath + '.JHR')) Or
     (Not FileExists (JM^. MsgPath + '.JDT')) Or
     (Not FileExists (JM^. MsgPath + '.JDX')) Then
  Begin
    OpenMsgBase := 2;
    Exit;
  End;

  shAssign (JM^. HdrFile, JM^. MsgPath + '.JHR');
  shAssign (JM^. TxtFile, JM^. MsgPath + '.JDT');
  shAssign (JM^. IdxFile, JM^. MsgPath + '.JDX');
  FileMode := fmReadWrite + fmDenyNone;
  shReset (JM^. HdrFile, 1);
  OpenError := shIOResult;

  If OpenError = 0 Then
  Begin
    shSeekFile (JM^. HdrFile, 1);
    shRead (JM^. HdrFile, JM^. BaseHdr. Signature [2], SizeOf (JM^. BaseHdr) - 1, i);
    EndMsgNumber := JM^. BaseHdr. BaseMsgNum + gFileSize (JM^. MsgPath + '.JDX') - 1;
    OpenError := shIOResult;
  End;

  If OpenError = 0 Then
  Begin
    FileMode := fmReadWrite + fmDenyNone;
    shReset (JM^. TxtFile, 1);
    OpenError := shIOResult;
  End;

  If OpenError = 0 Then
  Begin
    FileMode := fmReadWrite + fmDenyNone;
    shReset (JM^. IdxFile, SizeOf (JamIdxType));
    OpenError := shIOResult;
  End;

  JM^. IdxStart := -10;
  JM^. IdxRead := 0;
  JM^. TxtBufStart := -10;
  JM^. TxtRead := 0;
  SeekCurr_Pos := -1;
  OpenMsgBase := OpenError;
End;

Function JamMsgObj. CloseMsgBase: Word;
Var
  CloseError : Word;

Begin
  shClose (JM^. HdrFile);
  CloseError := shIOResult;
  shClose (JM^. TxtFile);
  If CloseError = 0 Then CloseError := shIOResult;
  shClose (JM^. IdxFile);
  If CloseError = 0 Then CloseError := shIOResult;
  CloseMsgBase := CloseError;
End;

Function JamMsgObj. CreateMsgBase (MaxMsg: Word; MaxDays: Word): Word;
Var
  TmpHdr         : ^JamHdrType;
  CreateError, i : Word;

Begin
  CreateError := 0;
  i := PosLastChar ('\', JM^. MsgPath);

  If i > 0 Then
    If Not MakePath (Copy (JM^. MsgPath, 1, i)) Then CreateError := 0;

  New (TmpHdr);
  If TmpHdr = Nil Then CreateError := 500 Else
  Begin
    FillChar (TmpHdr^, SizeOf (TmpHdr^), #0);
    TmpHdr^. Signature [1] := 'J';
    TmpHdr^. Signature [2] := 'A';
    TmpHdr^. Signature [3] := 'M';
    TmpHdr^. BaseMsgNum := 1;
    TmpHdr^. Created := ToUnixDate (GetDosDate);
    TmpHdr^. PwdCrc := - 1;
    CreateError := SaveFile (JM^. MsgPath + '.JHR', TmpHdr^, SizeOf (TmpHdr^));
    Dispose (TmpHdr);
    If CreateError = 0 Then CreateError := SaveFile (JM^. MsgPath + '.JLR', CreateError, 0);
    If CreateError = 0 Then CreateError := SaveFile (JM^. MsgPath + '.JDT', CreateError, 0);
    If CreateError = 0 Then CreateError := SaveFile (JM^. MsgPath + '.JDX', CreateError , 0);
    If shIOResult <> 0 Then;
  End;
  CreateMsgBase := CreateError;
End;

Procedure JamMsgObj. SetMailType (MT: MsgMailType);
Begin
  JM^. MailType := MT;
End;

Function JamMsgObj. GetSubArea: Word;
Begin
  GetSubArea := 0;
End;

Procedure JamMsgObj. DeleteMsg (CarePos: Boolean);
Var
  DelError       : Word;
  IdxLoc         : LongInt;
  IsBegin, IsEnd : Boolean;

Begin
  If LockMsgBase Then DelError := 0
                 Else DelError := 5;

  If (MsgHdr^. JamHdr. Attr1 And Jam_Deleted) = 0 Then
  Begin
    If DelError = 0 Then
    Begin
      SetAttr1 (Jam_Deleted, True);
      {Dec (JM^. BaseHdr. ActiveMsgs);}
      DelError := ReReadIdx (IdxLoc);
      Dec (TotalMsgsNumber);
    End;

    If DelError = 0 Then
    Begin
      shSeekFile (JM^. HdrFile, JamIdx^ [IdxLoc - JM^. IdxStart]. HdrLoc + 52);
      shWrite (JM^. HdrFile, MsgHdr^. JamHdr. Attr1,
        SizeOf (MsgHdr^. JamHdr. Attr1));
    End;
    {ReWriteHdr};
  End;

  If UnLockMsgBase Then;

  If DelError = 0 Then
  Begin
    NeedGetTotal := True;
    NeedReCount := True;
    NeedReSeek := True;

    If CarePos Then
    Begin
      IsBegin := (JM^. CurrMsgNum = StartMsgNumber);
      IsEnd := (JM^. CurrMsgNum = EndMsgNumber);
      TotalMsgsNumber := 0;
      GetTotalMsgs;
      If IsBegin Then SeekFirst (StartMsgNumber)
      Else
        If IsEnd Then SeekFirst (EndMsgNumber)
                 Else SeekFirst (JM^. CurrMsgNum);
    End;
  End;
End;

Function JamMsgObj. NumberOfMsgs: LongInt;
Begin
  NumberOfMsgs := {JM^. BaseHdr. ActiveMsgs} TotalMsgsNumber;
End;

Function JamMsgObj. FindLastRead (Var LastFile: shFile; UNum: LongInt): LongInt;
Const
  LastSize = 64;

Type
  LastArray = Array [1..LastSize] Of JamLastType;

Var
  LastError  : Word;
  i, NumRead : SysInt;
  LastStart  : LongInt;
  LastBuf    : ^LastArray;

Begin
  New (LastBuf);
  shSeekFile (LastFile, 0);
  LastError := shIOResult;

  While ((LastError = 0) And (Not shEoF (LastFile))) Do
  Begin
    LastStart := shFilePos (LastFile);
    shRead (LastFile, LastBuf^, LastSize, NumRead);
    LastError := shIOResult;

    For i := 1 To NumRead Do
      If LastBuf^ [i]. UserNum = UNum Then
      Begin
        FindLastRead := LastStart + i - 1;
        Dispose (LastBuf);
        Exit;
      End;
  End;

  FindLastRead := -1;
  Dispose (LastBuf);
End;

Function JamMsgObj. GetLastRead (UNum: LongInt): LongInt;
Var
  RecNum   : LongInt;
  LastFile : shFile;
  TmpLast  : JamLastType;
  i        : SysInt;

Begin
  GetLastRead := 0;
  shAssign (LastFile, JM^. MsgPath + '.JLR');
  FileMode := fmReadWrite + fmDenyNone;
  shReset (LastFile, SizeOf (JamLastType));
  Error := shIOResult;

  If Error <> 0 Then
  Begin
    shReWrite (LastFile, SizeOf (JamLastType));
    Error := shIOResult;
  End Else
  Begin
    RecNum := FindLastRead (LastFile, UNum);

    If RecNum >= 0 Then
    Begin
      shSeekFile (LastFile, RecNum);
      shRead (LastFile, TmpLast, 1, i);
      Error := shIOResult;

      If Error = 0 Then GetLastRead := TmpLast. HighRead;
    End;
  End;

  shClose (LastFile);
End;

Procedure JamMsgObj. SetLastRead (UNum: LongInt; LR: LongInt);
Var
  RecNum   : LongInt;
  LastFile : shFile;
  TmpLast  : JamLastType;
  i        : SysInt;

Begin
  shAssign (LastFile, JM^. MsgPath + '.JLR');
  FileMode := fmReadWrite + fmDenyNone;
  shReset (LastFile, SizeOf (JamLastType));
  Error := shIOResult;

  If Error <> 0 Then
  Begin
    shReWrite (LastFile, SizeOf (JamLastType));
    Error := shIOResult;
  End;

  RecNum := FindLastRead (LastFile, UNum);
  If RecNum >= 0 Then
  Begin
    shSeekFile (LastFile, RecNum);
    shRead (LastFile, TmpLast, 1, i);
    Error := shIOResult;

    If Error = 0 Then
    Begin
      TmpLast. HighRead := LR;
      TmpLast. LastRead := LR;
      shSeekFile (LastFile, RecNum);
      shWrite (LastFile, TmpLast, 1);
      Error := shIOResult;
    End;
  End Else
  Begin
    shSeekFile (LastFile, shFileSize (LastFile));
    Error := shIOResult;

    If Error = 0 Then
    Begin
      TmpLast. UserNum := UNum;
      TmpLast. NameCrc := UNum;
      TmpLast. HighRead := LR;
      TmpLast. LastRead := LR;
      shWrite (LastFile, TmpLast, 1);
      Error := shIOResult;
    End;
  End;

  shClose (LastFile);
End;

Function JamMsgObj. LockMsgBase: Boolean;
(*
Var
  LockError : Word;
  i         : SysInt;
*)
Begin
  LockMsgBase := True;
(*
  LockError := 0;
  If JM^. LockCount = 0 Then
  Begin
    If LockError = 0 Then LockError := shLock (JM^. HdrFile, 0, 1);
    If LockError = 0 Then
    Begin
      shSeekFile (JM^. HdrFile, 0);
      LockError := shIOResult;
    End;
    If LockError = 0 Then
    Begin
      shRead (JM^. HdrFile, JM^. BaseHdr , SizeOf (JM^. BaseHdr), i);
      LockError := shIOResult;
    End;
  End;
  Inc (JM^. LockCount);
  LockMsgBase := (LockError = 0);
*)
End;

Function JamMsgObj. UnLockMsgBase: Boolean;
(*
Var
  LockError: Word;
*)
Begin
  UnLockMsgBase := True;
(*
  LockError := 0;
  If JM^. LockCount > 0 Then Dec (JM^. LockCount);
  If JM^. LockCount = 0 Then
  Begin
    If LockError = 0 Then LockError := UnLockFile (JM^. HdrFile, 0, 1);
    If LockError = 0 Then
    Begin
      shSeekFile (JM^. HdrFile, 0);
      LockError := shIOResult;
    End;
    If LockError = 0 Then
    Begin
      shWrite (JM^. HdrFile, JM^. BaseHdr, SizeOf (JM^. BaseHdr));
      LockError := shIOResult;
    End;
  End;
  UnLockMsgBase := (LockError = 0);
*)
End;

{SetSeeAlso/GetSeeAlso provided by 2:201/623@FidoNet Jonas@iis.bbs.bad.se}

Procedure JamMsgObj. SetNextSeeAlso (SAlso: LongInt);
Begin
  MsgHdr^. JamHdr. ReplyNext := SAlso;
End;

Function JamMsgObj. GetNextSeeAlso: LongInt; {Get next see also of current msg}
Begin
  GetNextSeeAlso := MsgHdr^. JamHdr. ReplyNext;
End;

End.
