[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    Unit MKMsgJam32;       {JAM Msg Object Unit}

    ///////////////////////////////////////////////////////////////////////////////
    // MKMsgJam32 Coded in Part by G.E. Ozz Nixon Jr. of www.warpgroup.com       //
    // ========================================================================= //
    // Original Source for DOS by Mythical Kindom's Mark May (mmay@dnaco.net)    //
    // Re-written and distributed with permission!                               //
    // See Original Copyright Notice before using any of this code!              //
    ///////////////////////////////////////////////////////////////////////////////

    Interface

    Uses
       MKFidoAddr32,
       Classes,
       SysUtils;

    Const
       Version='9.19.97';
       {idx buffer removed, 95 and NT buffer already!}
       JamSubBufSize = 4000;
       JamTxtBufSize = 32000;           {new msg text in-ram buffer}
       TxtSubBufSize = 2000;            {Note actual size is one greater}

    Type
    {on status only generated during errors!}
       TOnStatus=procedure(Sender:TComponent;fatal:boolean;status:string) of Object;

       JamHdrType=Packed Record
          Signature:Array[1..4] of Char;
          Created:LongInt;
          ModCounter:LongInt; {if different from last time, then check msgbase!}
          ActiveMsgs:LongInt;
          PwdCRC:LongInt;
          BaseMsgNum:LongInt;
          Extra:Array[1..1000] of Char;
       End;

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

       JamIdxType = packed Record
          MsgToCrc: LongInt;
          HdrLoc: LongInt;
       End;

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

       JamSubBuffer = Array[1..JamSubBufSize] of Char;

       JamTxtBufType = Array[0..JamTxtBufSize] Of Char;

       HdrType = Packed Record
          JamHdr: JamMsgHdrType;
          SubBuf: JamSubBuffer;
       End;

       MsgMailType = (mtNormal, mtEchoMail, mtNetMail);

       TJamMsgBase = Class(TComponent)
       private
          LastSoft:Boolean;
          HdrFile: File;
          TxtFile: File;
          IdxFile: File;
          MsgPath: String;
          BaseHdr: JamHdrType;
          Dest: AddrType;
          Orig: AddrType;
          MKMsgFrom: String;
          MKMsgTo: String;
          MKMsgSubj: String;
          MKMsgDate: String;
          MKMsgTime: String;
          CurrMsgNum: LongInt;
          YourName: String[35];
          YourHdl: String[35];
          NameCrc: LongInt;
          HdlCrc: LongInt;
          TxtPos: LongInt; {TxtPos < 0 means get from sub text}
          TxtEnd: LongInt;
          TxtBufStart: LongInt;
          TxtRead: Integer;
          MailType: MsgMailType;
          BufFile: File;
          LockCount: LongInt;
          TxtSubBuf: Array[0..TxtSubBufSize-1] of Char; {temp storage for text on subfields}
          TxtSubChars: Integer;
          MsgHdr: ^HdrType;
          JamIdx: JamIdxType;
          TxtBuf: ^JamTxtBufType;
          Error: Word;
          FActive:Boolean;
          FOnStatus: TOnStatus;
          MKGetHighMsgNumber:Longint;
          {Internal to JAM}
          Procedure SetAttr1(Mask: LongInt; St: Boolean);
          Procedure AddSubField(id: Word; Data: String);
          Procedure AddTxtSub(St: String);
          Function  WriteIdx: Word;
          Function  ReadIdx:Word;
          Function  FindLastRead(Var LastFile: File; UNum: LongInt): LongInt;
          {end of internal}
          Procedure SetCost(Value:Word); Virtual;
          Function  GetCost:Word; Virtual;
          Procedure SetRefer(Value: LongInt); Virtual;
          Procedure SetSeeAlso(Value: LongInt); Virtual;
          Function  GetSeeAlso:LongInt; Virtual;
          Function  GetNextSeeAlso:LongInt; Virtual;
          Procedure SetNextSeeAlso(Value:LongInt); Virtual;
          Procedure SetLocal(Value:Boolean); Virtual;
          Procedure SetRcvd(Value:Boolean); Virtual;
          Procedure SetPriv(Value:Boolean); Virtual;
          Procedure SetCrash(Value:Boolean); Virtual;
          Procedure SetKillSent(Value:Boolean); Virtual;
          Procedure SetSent(Value:Boolean); Virtual;
          Procedure SetFAttach(Value:Boolean); Virtual;
          Procedure SetReqRct(Value:Boolean); Virtual;
          Procedure SetReqAud(Value:Boolean); Virtual;
          Procedure SetRetRct(Value:Boolean); Virtual;
          Procedure SetFileReq(Value:Boolean); Virtual;
          Function  EOM: Boolean; Virtual;
          Function  GetRefer: LongInt; Virtual;
          Function  GetMsgNum: LongInt; Virtual;
          Function  IsLocal: Boolean; Virtual;
          Function  IsCrash: Boolean; Virtual;
          Function  IsKillSent: Boolean; Virtual;
          Function  IsSent: Boolean; Virtual;
          Function  IsFAttach: Boolean; Virtual;
          Function  IsReqRct: Boolean; Virtual;
          Function  IsReqAud: Boolean; Virtual;
          Function  IsRetRct: Boolean; Virtual;
          Function  IsFileReq: Boolean; Virtual;
          Function  IsRcvd: Boolean; Virtual;
          Function  IsPriv: Boolean; Virtual;
          Function  IsDeleted: Boolean; Virtual;
          Function  IsEchoed: Boolean; Virtual;
          Procedure SetMailType(Value: MsgMailType); Virtual;
          Procedure SetActive(Value:Boolean); Virtual;
          Function  MKMsgBaseExists: Boolean; Virtual;
          Function  MKSeekFound:Boolean; Virtual;
          Function  MKYoursFound:Boolean; Virtual;
          Function  MKNumberOfMsgs: LongInt; Virtual;

       public
          Constructor Create(AOwner:TComponent); Override;
          Destructor Destroy; Override;
          Function  LockMsgBase:Boolean; Virtual;
          Function  UnLockMsgBase:Boolean; Virtual;
          Procedure DoString(Str: String); Virtual;
          Procedure DoChar(Ch: Char); Virtual;
          Procedure DoStringLn(Str: String); Virtual;
          Procedure DoKludgeLn(Str: String); Virtual;
          Function  WriteMsg: Word; Virtual;
          Function  GetChar: Char; Virtual;
          Procedure MsgStartUp; Virtual;
          Function  GetString(MaxLen: Word): String; Virtual;
          Procedure SeekFirst(MsgNum: LongInt); Virtual;
          Procedure SeekNext; Virtual;
          Procedure SeekPrior; Virtual;
          Function  GetMsgLoc: LongInt; Virtual;
          Procedure SetMsgLoc(ML: LongInt); Virtual;
          Procedure YoursFirst(Name: String; Handle: String); Virtual;
          Procedure YoursNext; Virtual;
          Procedure StartNewMsg; Virtual;
          Function  OpenMsgBase: Word; Virtual;
          Function  CloseMsgBase: Word; Virtual;
          Function  CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;
          Procedure ReWriteHdr; Virtual;
          Procedure DeleteMsg; Virtual;
          Function  GetLastRead(UNum: LongInt): LongInt; Virtual;
          Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual;
          Procedure MsgTxtStartUp; Virtual;
          Function  GetTxtPos: LongInt; Virtual;
          Procedure SetTxtPos(TP: LongInt); Virtual;
          Function  GetSubArea: Word; Virtual;
          Procedure SetEcho(Value:Boolean); Virtual;

       Published
          property  Active: Boolean read FActive write SetActive;
          property  MsgPathFileName: String read MsgPath write MsgPath;
          property  GetHighMsgNum: LongInt read MKGetHighMsgNumber;
          property  HdrDest: AddrType read Dest write Dest;
          property  HdrOrig: AddrType read Orig write Orig;
          property  HdrFrom: String read MKMsgFrom write MKMsgFrom;
          property  HdrTo: String read MKMsgTo write MKMsgTo;
          property  HdrSubj: String read MKMsgSubj write MKMsgSubj;
          property  HdrCost: Word read GetCost write SetCost;
          property  HdrRefer: LongInt read GetRefer write SetRefer;
          property  HdrSeeAlso: LongInt read GetSeeAlso write SetSeeAlso;
          property  HdrNextSeeAlso: LongInt read GetNextSeeAlso write SetNextSeeAlso;
          property  HdrDate: String read MKMsgDate write MKMsgDate;
          property  HdrTime: String read MKMsgTime write MKMsgTime;
          property  HdrAttrLocal:Boolean read IsLocal write SetLocal;
          property  HdrAttrReceived:Boolean read IsRcvd write SetRcvd;
          property  HdrAttrCrash:Boolean read IsCrash write SetCrash;
          property  HdrAttrKillSend:Boolean read IsKillSent write SetKillSent;
          property  HdrAttrSent:Boolean read IsSent write SetSent;
          property  HdrAttrFileAttach:Boolean read IsFAttach write SetFAttach;
          property  HdrAttrRequestReceipt:Boolean read isReqRct write SetReqRct;
          property  HdrAttrRequestAudit:Boolean read isReqAud write SetReqAud;
          property  HdrAttrReturnReceipt:Boolean read isRetRct write SetRetRct;
          property  HdrAttrFileRequest:Boolean read isFileReq write SetFileReq;
          property  HdrAttrDelete:Boolean read isDeleted;
          property  HdrAttrEchoed:Boolean read isEchoed write SetEcho;
          {propogate private to fido32!}
          property  HdrAttrPrivate:Boolean read isPriv write SetPriv;
          property  EndOfMsgText:Boolean read EOM;
          Property  WasWrap: Boolean read LastSoft;
          Property  MsgBaseExists: Boolean read MKMsgBaseExists;
          Property  SeekFound: Boolean read MKSeekFound;
          Property  YoursFound: Boolean read MKyoursFound;
          Property  HdrMailType:MsgMailType read MailType write SetMailType;
          Property  MsgNumber:Longint read GetMsgNum;
          property  NumberOfMsgs: LongInt read MkNumberofMsgs;
          property  OnErrorStatus:TOnStatus read FOnstatus write FOnStatus;
       End;

    Procedure Register;

    Implementation

    Uses
       MKFile32,
       MKString32,
       Crc32;

    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;

    Type
       SubFieldType=Record {this is defined twice, why?}
          LoId:Word;
          HiId:Word;
          DataLen:LongInt;
          Data:Array[1..1000] of Char;
       End;

    Constructor TJamMsgBase.Create(AOwner:TComponent);
    Begin
       Inherited Create(AOwner);
       New(MsgHdr);
       New(TxtBuf);
       If ((MsgHdr=Nil) or (TxtBuf=Nil)) Then Begin
          If MsgHdr<>Nil Then Dispose(MsgHdr);
          If TxtBuf<>Nil Then Dispose(TxtBuf);
          if assigned(FOnStatus) then
             FOnStatus(self,True,'Error Initializing buffers - JAM Object not accessible!');
          Exit;
       End
       Else Begin
          MsgPath:='';
          Error:=0;
          FillChar(Dest,Sizeof(Dest),0);
          Orig:=Dest;
          MKMsgFrom:='Noone';
          MKMsgTo:='Noone';
          MKMsgSubj:='MsgBase Not Active yet';
          MKMsgDate:='mm-dd-yy';
          MKMsgTime:='hh:mm';
          FillChar(MsgHdr^,Sizeof(MsgHdr^),#0);
          FActive:=False;
       End;
    End;

    Destructor TJamMsgBase.Destroy;
    Begin
       If MsgHdr<>Nil Then Dispose(MsgHdr);
       If TxtBuf<>Nil Then Dispose(TxtBuf);
    End;

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

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

    Procedure TJamMsgBase.SetCost(Value:Word); {actual routine}
    Begin
       MsgHdr^.JamHdr.Cost:=Value;
    End;

    Function TJamMsgBase.GetCost: Word; {actual routine}
    Begin
       GetCost:=MsgHdr^.JamHdr.Cost;
    End;

    Procedure TJamMsgBase.SetRefer(Value:LongInt); {actual routine}
    Begin
       MsgHdr^.JamHdr.ReplyTo:=Value;
    End;

    Function TJamMsgBase.GetRefer:LongInt; {actual routine}
    Begin
       GetRefer:=MsgHdr^.JamHdr.ReplyTo;
    End;

    Procedure TJamMsgBase.SetSeeAlso(Value:LongInt); {actual routine}
    Begin
       MsgHdr^.JamHdr.ReplyFirst:=Value;
    End;

    Function TJamMsgBase.GetSeeAlso: LongInt; {actual routine}
    Begin
       GetSeeAlso:=MsgHdr^.JamHdr.ReplyFirst;
    End;

    Procedure TJamMsgBase.SetAttr1(Mask:LongInt;St:Boolean); {internal to JAM}
    Begin
       If St Then MsgHdr^.JamHdr.Attr1:=MsgHdr^.JamHdr.Attr1 Or Mask
       Else MsgHdr^.JamHdr.Attr1:=MsgHdr^.JamHdr.Attr1 And (Not Mask);
    End;

    Procedure TJamMsgBase.SetLocal(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Local,Value);
    End;

    Procedure TJamMsgBase.SetRcvd(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Rcvd,Value);
    End;

    Procedure TJamMsgBase.SetPriv(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Priv,Value);
    End;

    Procedure TJamMsgBase.SetCrash(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Crash,Value);
    End;

    Procedure TJamMsgBase.SetKillSent(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_KillSent,Value);
    End;

    Procedure TJamMsgBase.SetSent(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Sent,Value);
    End;

    Procedure TJamMsgBase.SetFAttach(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_FAttch,Value);
    End;

    Procedure TJamMsgBase.SetReqRct(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_RcptReq,Value);
    End;

    Procedure TJamMsgBase.SetReqAud(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_ConfmReq,Value); {actual routine}
    End;

    Procedure TJamMsgBase.SetRetRct(Value:Boolean); {actual routine}
    Begin
       {unused}
       if assigned(FOnStatus) then
          FOnStatus(self,False,'Return Receipt not supported by JAM Object!');
    End;

    Procedure TJamMsgBase.SetFileReq(Value:Boolean); {actual routine}
    Begin
       SetAttr1(Jam_Freq,Value); {actual routine}
    End;

    {rewritten 7-23-97 by warpgroup}
    Procedure TJamMsgBase.DoString(Str:String); {actual routine}
    Begin
       While Length(Str)>0 Do Begin
          DoChar(Str[1]);
          Delete(Str,1,1);
       End;
    End;

    Procedure TJamMsgBase.DoChar(Ch: Char); {actual routine}
    Var
       TmpStr: String;
       NumWrite: Integer;
       I:Integer;

    Begin
       Case ch of
         #13: LastSoft := False;
         #10: {absorb};
         Else LastSoft := True;
       End;
       If (TxtPos-TxtBufStart)>=JamTxtBufSize Then Begin {flush to disk for virtual memory!}
          If TxtBufStart=0 Then Begin
             i:=PosLastChar('\',MsgPath);
             If i>0 Then TmpStr:=Copy(MsgPath,1,i)
             Else Begin
                GetDir(0,TmpStr);
                AddBackSlash(TmpStr);
             End;
             shMakeFile(BufFile,GetTempName(TmpStr));
          End;
          NumWrite:=TxtPos-TxtBufStart;
          {$I-} shWrite(BufFile,TxtBuf^,NumWrite); {$I+}
          If MKFileError<>0 then Begin
          if assigned(FOnStatus) then
             FOnStatus(self,True,'Write Failed [dochar] Error ('+IntToStr(MKFileError)+')');
          End;
          TxtBufStart:=FileSize(BufFile);
       End;
       TxtBuf^[TxtPos-TxtBufStart]:=Ch;
       Inc(TxtPos);
    End;

    Procedure TJamMsgBase.DoStringLn(Str:String); {actual routine}
    Begin
       DoString(Str);
       DoChar(#13);
    End;

    Procedure TJamMsgBase.DoKludgeLn(Str:String); {actual routine}
    Var
       TmpStr: String;

    Begin
       If Str[1]=#1 Then Delete(Str,1,1); {drop 1st char!}
       If Copy(Str,1,3)='PID' Then Begin
          TmpStr:=StripLead(Copy(Str,4,255),':');
          TmpStr:=Copy(StripBoth(TmpStr, ' '),1,40);
          AddSubField(7,TmpStr);
       End
       Else If Copy(Str,1,5) = 'MSGID' Then Begin
          TmpStr := StripLead(Copy(Str,6,255),':');
          TmpStr := Copy(StripBoth(TmpStr,' '),1,100);
          AddSubField(4, TmpStr);
          MsgHdr^.JamHdr.MsgIdCrc := JamStrCrc(TmpStr);
       End
       Else If Copy(Str,1,4) = 'INTL' Then Begin {ignored!}
       End
       Else If Copy(Str,1,4) = 'TOPT' Then Begin {ignored!}
       End
       Else If Copy(Str,1,4) = 'FMPT' Then Begin {ignored!}
       End
       Else If (Copy(Str,1,6) = 'REPLY ') or(Copy(Str,1,6) = 'REPLY:') Then Begin
          TmpStr := StripLead(Copy(Str,8,255),':');
          TmpStr := Copy(StripBoth(TmpStr,' '),1,100);
          AddSubField(5, TmpStr);
          MsgHdr^.JamHdr.ReplyCrc := JamStrCrc(TmpStr);
       End
       Else If Copy(Str,1,4) = 'PATH' Then Begin
          TmpStr := StripLead(Copy(Str,5,255),':');
          TmpStr := StripBoth(TmpStr,' ');
          AddSubField(2002, TmpStr);
       End
       Else Begin
          AddSubField(2000, StripBoth(Str,' ')); {Unknown but saved}
       End;
    End;

    Procedure TJamMsgBase.AddSubField(id: Word; Data: String); {Internal to JAM}
    Type
       SubFieldType=Record {why is this here too?!}
          LoId: Word;
          HiId: Word;
          DataLen: LongInt;
          Data: Array[1..256] of Char;
       End;

    Var
       SubField: ^SubFieldType;

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

    Function  TJamMsgBase.WriteMsg:Word; {actual routine}
    Var
       DT:DateTime;
       WriteError:Word;
       i:Integer;
       TmpIdx:JamIdxType;

    Begin
       If LastSoft Then Begin
          DoChar(#13);
          DoChar(#10);
       End;
       Move('JAM'#0,MsgHdr^.JamHdr.Signature[1],4);{Set signature}
       Case MailType of
          mtNormal: SetAttr1(Jam_TypeLocal, True);
          mtEchoMail: SetAttr1(Jam_TypeEcho, True);
          mtNetMail: SetAttr1(Jam_TypeNet, True);
       End;
       MsgHdr^.JamHdr.Rev:=1;
       MsgHdr^.JamHdr.DateArrived:=ToUnixDate(GetDosDate); {Get date processed}
       DT.Year := Str2Long(Copy(MKMsgDate, 7, 2)); {Convert date written}
       DT.Month := Str2Long(Copy(MKMsgDate, 1, 2));
       DT.Day := Str2Long(Copy(MKMsgDate, 4, 2));
       If DT.Year < 80 Then Inc(DT.Year, 2000)
       Else Inc(DT.Year, 1900);
       DT.Sec := 0;
       DT.Hour := Str2Long(Copy(MKMsgTime, 1, 2));
       DT.Min := Str2Long(Copy(MKMsgTime, 4, 2));
       MsgHdr^.JamHdr.DateWritten := DTToUnixDate(DT);
       If Not LockMsgBase Then WriteError := 5
       Else Begin
          MsgHdr^.JamHdr.TextOfs := FileSize(TxtFile);
          MsgHdr^.JamHdr.MsgNum := GetHighMsgNum + 1;
          MsgHdr^.Jamhdr.TextLen := TxtPos;
          If TxtBufStart>0 Then Begin        {Write text using buffer file}
             i:=TxtPos-TxtBufStart;
             {$I-} shWrite(BufFile,TxtBuf^,i); {$I+} {write buffer to file}
             WriteError:=MKFileError;
             If WriteError=0 Then Begin          {seek start of buffer file}
                {$I-} shSeekFile(BufFile,0); {$I+}
                WriteError:=MKFileError;
                If WriteError=0 Then Begin          {seek end of text file}
                   {$I-} shSeekFile(TxtFile, FileSize(TxtFile)); {$I+}
                   WriteError:=MKFileError;
                   If MKFileError<>0 then Begin
                   if assigned(FOnStatus) then
                      FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+3000)+')');
                   End;
                End
                Else Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+2000)+')');
                End;
             End
             Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+1000)+')');
             End;
             {copy buffer file to text file}
             While ((Not Eof(BufFile)) and (WriteError = 0)) Do Begin
                {$I-} shRead(BufFile,TxtBuf^,SizeOf(TxtBuf^),i); {$I+}
                WriteError:=MKFileError;
                {check if eof error}
                If WriteError=0 Then Begin
                   TxtBufStart:=FilePos(TxtFile);
                   TxtRead:=i;
                   {$I-} shWrite(TxtFile,TxtBuf^,i); {$I+}
                   WriteError:=MkFileError;
                   If MKFileError<>0 then Begin
                   if assigned(FOnStatus) then
                      FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+4000)+')');
                   End;
                End;
             End;
             shCloseFile(BufFile);
             shEraseFile(BufFile);
             WriteError:=IoResult;
             If WriteError<>0 then Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+5000)+')');
             End;
          End
          Else Begin                            {Write text using TxtBuf only}
             {$I-} shSeekFile(Txtfile,FileSize(TxtFile)); {$I+}
             WriteError:=MKFileError;
             If WriteError=0 Then Begin
                {$I-} shWrite(TxtFile, TxtBuf^, TxtPos); {$I+}
                WriteError:=MKFileError;
                TxtRead:=TxtPos;
                If MKFileError<>0 then Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+7000)+')');
                End;
             End
             Else Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+6000)+')');
             End;
          End;
          If WriteError=0 Then Begin            {Add index record}
             TmpIdx.HdrLoc:=FileSize(HdrFile);
             TmpIdx.MsgToCrc:=JamStrCrc(MKMsgTo);
             {$I-} shSeekFile(IdxFile,FileSize(IdxFile)); {$I+}
             WriteError:=MKFileError;
             If WriteError=0 Then Begin            {write index record}
                {$I-} shWrite(IdxFile,TmpIdx,Sizeof(TmpIdx)); {$I+}
                WriteError:=MKFileError;
                If WriteError=0 Then Begin            {Add subfields as needed}
                   If Length(MKMsgTo)>0 Then AddSubField(3,MKMsgTo);
                   If Length(MKMsgFrom)>0 Then AddSubField(2,MKMsgFrom);
                   If Length(MKMsgSubj)>0 Then Begin
                      If IsFileReq Then AddSubField(11,MKMsgSubj)
                      Else AddSubField(6,MKMsgSubj);
                   End;
                   If ((Dest.Zone <> 0) or (Dest.Net <> 0) or
                      (Dest.Node <> 0) or (Dest.Point <> 0)) Then
                      AddSubField(1, AddrStr(Dest));
                   If ((Orig.Zone <> 0) or (Orig.Net <> 0) or
                      (Orig.Node <> 0) or (Orig.Point <> 0)) Then
                      AddSubField(0, AddrStr(Orig));
                   {Seek to end of .jhr file}
                   {$I-} shSeekFile(HdrFile,FileSize(HdrFile)); {$I+}
                   WriteError := mkFileError;
                   If WriteError = 0 Then Begin            {write msg header}
                      {$I-} shWrite(HdrFile,MsgHdr^,
                          SizeOf(MsgHdr^.JamHdr)+MsgHdr^.JamHdr.SubFieldLen); {$I+}
                      WriteError := MKFileError;
                      If WriteError = 0 Then Begin         {update msg base header}
                         Inc(BaseHdr.ActiveMsgs);
                         Inc(BaseHdr.ModCounter);
                      End
                      Else Begin
                      if assigned(FOnStatus) then
                      FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+12000)+')');
                      End;
                   End
                   Else Begin
                   if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+11000)+')');
                   End;
                End
                Else Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+10000)+')');
                End;
             End
             Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+9000)+')');
             End;
          End
          Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'Write Failed [writemsg] Error ('+IntToStr(MKFileError+8000)+')');
          End;
          UnLockMsgBase;                                   {unlock msg base}
          MKGetHighMsgNumber:=BaseHdr.BaseMsgNum+(FileSize(IdxFile) div Sizeof(JamIdx))-1;
       End;
       WriteMsg:=WriteError;                               {return result}
    End;

    Function TJamMsgBase.GetChar: Char; {actual routine}
    Begin
       If TxtPos < 0 Then Begin
          GetChar := TxtSubBuf[TxtSubChars + TxtPos];
          Inc(TxtPos);
          If TxtPos >= 0 Then TxtPos := MsgHdr^.JamHdr.TextOfs;
       End
       Else Begin
          If ((TxtPos < TxtBufStart) Or
             (TxtPos >= TxtBufStart + TxtRead)) Then Begin
             TxtBufStart := TxtPos - 80;
             If TxtBufStart < 0 Then TxtBufStart := 0;
             {$I-} shSeekFile(TxtFile, TxtBufStart); {$I+}
             Error := MKFileError;
             If Error = 0 Then Begin
                {$I-} shRead(TxtFile, TxtBuf^, SizeOf(TxtBuf^), TxtRead); {$I+}
                Error := MKFileError;
                If Error<>0 then
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'JAM Object [GetChar] Error ('+IntToStr(MKFileError+1000)+')');
             End
             Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [GetChar] Error ('+IntToStr(MKFileError)+')');
             End;
          End;
          GetChar := TxtBuf^[TxtPos - TxtBufStart];
          Inc(TxtPos);
       End;
    End;

    Procedure TJamMsgBase.AddTxtSub(St: String); {Internal to JAM}
    Var
       I:Word;

    Begin
       For I:=1 to Length(St) Do Begin
           If TxtSubChars<=TxtSubBufSize-1 Then Begin
              TxtSubBuf[TxtSubChars]:=St[i];
              Inc(TxtSubChars);
           End;
       End;
       If TxtSubChars<=TxtSubBufSize-1 Then Begin
          TxtSubBuf[TxtSubChars]:=#13;
          Inc(TxtSubChars);
       End;
    End;

    Procedure TJamMsgBase.MsgStartUp; {actual routine}
    Var
       SubCtr:LongInt;
       SubPtr:^SubFieldType;
       NumRead:Integer;
       DT:DateTime;
       TmpAddr:AddrType;

    Function MoveData(MaxByte:Byte):String;
    Var
       LengthSetting:Byte;
       TmpStr: String;

    Begin
       LengthSetting:=Min(SubPtr^.DataLen and $ff,MaxByte);
       Setlength(TmpStr,LengthSetting);
       Move(SubPtr^.Data,TmpStr[1],LengthSetting);
       MoveData:=TmpStr;
    End;

    Begin
       LastSoft:=False;
       MKMsgFrom:='';
       MKMsgTo:='';
       MKMsgSubj:='';
       TxtSubChars:=0;
       FillChar(Dest,SizeOf(Dest),#0); {added 2/25/95}
       FillChar(Orig,SizeOf(Orig),#0); {added 2/25/95}
       If SeekFound Then Begin
    {      Error:=ReadIdx;
          If Error=0 Then Begin}
             {$I-} shSeekFile(HdrFile,JamIdx.HdrLoc); {$I+}
             Error:=MKFileError;
             If Error=0 Then Begin
                {$I-} shRead(HdrFile,MsgHdr^,SizeOf(MsgHdr^),NumRead); {$I+}
                Error:=MKFileError;
                If Error = 0 Then Begin
                   UnixToDt(MsgHdr^.JamHdr.DateWritten,DT);
                   MKMsgDate:=FormattedDate(Dt,'MM-DD-YY',False);
                   MKMsgTime:=FormattedDate(Dt,'HH:II',False);
                   SubCtr:=1;
                   While ((SubCtr<=MsgHdr^.JamHdr.SubFieldLen) and
                      (SubCtr<JamSubBufSize)) Do Begin
                      SubPtr:=@MsgHdr^.SubBuf[SubCtr];
                      Inc(SubCtr,SubPtr^.DataLen+8);
                      Case(SubPtr^.LoId) Of
                         0: Begin {Orig}
                            FillChar(TmpAddr, SizeOf(TmpAddr), #0);
                            FillChar(Orig, SizeOf(Orig), #0);
                            ParseAddr(MoveData(128),TmpAddr,Orig);
                         End;
                         1: Begin {Dest}
                            FillChar(TmpAddr, SizeOf(TmpAddr), #0);
                            FillChar(Dest, SizeOf(Dest), #0);
                            ParseAddr(MoveData(128),TmpAddr,Dest);
                         End;
                         2: {MsgFrom}
                            MKMsgFrom:=MoveData(65);
                         3: {MsgTo}
                            MKMsgTo:=MoveData(65);
                         4: {MsgId}
                            AddTxtSub(#1'MSGID: ' + MoveData(240));
                         5: {Reply}
                            AddTxtSub(#1'REPLY: ' + MoveData(240));
                         6: {MsgSubj}
                            MKMsgSubj:=MoveData(100);
                         7: {PID}
                            AddTxtSub(#1'PID: ' + MoveData(240));
                         8: {VIA}
                            AddTxtSub(#1'Via ' + MoveData(240));
                         9: {File attached}
                            If IsFAttach Then MKMsgSubj:=MoveData(100);
                        11: {File request}
                            If IsFileReq Then MKMsgSubj:=MoveData(100);
                      2000:  {Unknown kludge}
                             AddTxtSub(#1 + MoveData(240));
                      2001: {SEEN-BY}
                            AddTxtSub(#1'SEEN-BY: ' + MoveData(240));
                      2002: {PATH}
                            AddTxtSub(#1'PATH: ' + MoveData(240));
                      2003: {FLAGS}
                            AddTxtSub(#1'FLAGS: ' + MoveData(240));
                      End;
                   End;
                End
                Else Begin
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [MsgStartup] Error ('+IntToStr(MKFileError+2000)+')');
                End;
             End
             Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [MsgStartup] Error ('+IntToStr(MKFileError+1000)+')');
             End;
    {      End
          Else Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [MsgStartup] Error ('+IntToStr(MKFileError)+')');
          End;}
       End;
    End;

    Procedure TJamMsgBase.MsgTxtStartUp; {actual routine}
    Begin
       LastSoft:=False;
       TxtEnd:=MsgHdr^.JamHdr.TextOfs+MsgHdr^.JamHdr.TextLen-1;
       If TxtSubChars>0 Then TxtPos:=-TxtSubChars
       Else TxtPos:=MsgHdr^.JamHdr.TextOfs;
    End;

    Function TJamMsgBase.GetString(MaxLen: Word): String; {actual routine}
      Var
        WPos: LongInt;
        WLen: Byte;
        StrDone: Boolean;
        StartSoft: Boolean;
        CurrLen: Word;
        TmpCh: Char;
        TmpGetString:String;

      Begin
      StrDone := False;
      CurrLen := 0;
      WPos := 0;
      WLen := 0;
      StartSoft := LastSoft;
      LastSoft := True;
      TmpCh := GetChar;
      TmpGetString:='';
      While ((Not StrDone) And (CurrLen < MaxLen) And (Not EOM)) Do
        Begin
        Case TmpCh of
          #$00:;
          #$0d: Begin
                StrDone := True;
                LastSoft := False;
                End;
          #$8d:;
          #$0a:;
          #$20: Begin
                If ((CurrLen <> 0) or (Not StartSoft)) Then
                  Begin
                  Inc(CurrLen);
                  WLen := CurrLen;
                  TmpGetString := TmpGetString + TmpCh;
                  WPos := TxtPos;
                  End
                Else
                  StartSoft := False;
                End;
          Else
            Begin
            Inc(CurrLen);
            TmpGetString := TmpGetString + TmpCh;
            End;
          End;
        If Not StrDone Then
          TmpCh := GetChar;
        End;
      If StrDone Then SetLength(TmpGetString,CurrLen)
      Else If EOM Then Begin
              SetLength(TmpGetString,CurrLen);
           End
           Else Begin
              If WLen = 0 Then Begin
                 SetLength(TmpGetString,CurrLen);
                 Dec(TxtPos);
              End
              Else Begin
                 SetLength(TmpGetString,WLen);
                 TxtPos := WPos;
              End;
           End;
       GetSTring:=TmpGetString;
    End;

    Function TJamMsgBase.EOM: Boolean; {actual routine}
      Begin
      EOM := (((TxtPos < MsgHdr^.JamHdr.TextOfs) Or
        (TxtPos > TxtEnd)) And (TxtPos >= 0));
      End;

    Function TJamMsgBase.GetMsgNum: LongInt; {Get message number}
      Begin
      GetMsgNum := MsgHdr^.JamHdr.MsgNum;
      End;

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

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

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

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

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

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

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

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

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

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

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

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

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

    Procedure TJamMsgBase.SeekFirst(MsgNum: LongInt); {Start msg seek}
    Begin
       CurrMsgNum:=MsgNum-1;
       If CurrMsgNum<BaseHdr.BaseMsgNum-1 Then CurrMsgNum:=BaseHdr.BaseMsgNum-1;
       SeekNext;
    End;

    Procedure TJamMsgBase.SeekNext; {Find next matching msg}
    Begin
       If CurrMsgNum<=GetHighMsgNum Then Inc(CurrMsgNum);
       Error:=ReadIdx;
       While (((JamIdx.HdrLoc<0) or (JamIdx.MsgToCrc=-1)) And
         (Error=0)) Do Begin
         Inc(CurrMsgNum);
         If (CurrMsgNum<=GetHighMsgNum) then Begin
         Error:=ReadIdx;
         If Error<>0 then
           if assigned(FOnStatus) then
              FOnStatus(self,True,'JAM Object [SeekNext] Error ('+IntToStr(Error)+')');
         End
         Else Begin
            JamIdx.HdrLoc:=-1;
            JamIdx.MsgToCrc:=-1;
            Error:=1;
         End;
       End;
    End;

    Procedure TJamMsgBase.SeekPrior;
    Begin
       If CurrMsgNum>=BaseHdr.BaseMsgNum Then Dec(CurrMsgNum);
       Error:=ReadIdx;
       If Error<>0 then
          if assigned(FOnStatus) then
          FOnStatus(self,True,'JAM Object [SeekPrior] Error ('+IntToStr(Error)+')');
       If CurrMsgNum>=BaseHdr.BaseMsgNum Then Begin
          While (((JamIdx.HdrLoc<0) or (JamIdx.MsgToCrc=-1)) And
             (CurrMsgNum>=BaseHdr.BaseMsgNum)) Do Begin
             Dec(CurrMsgNum);
             If (CurrMsgNum>=BaseHdr.BaseMsgNum) then Begin
             Error:=ReadIdx;
             If Error<>0 then
               if assigned(FOnStatus) then
             FOnStatus(self,True,'JAM Object [SeekPrior] Error ('+IntToStr(Error+1000)+')');
             End;
          End;
       End;
    End;

    Function TJamMsgBase.MKSeekFound: Boolean;
    Begin
       MKSeekFound:=((CurrMsgNum>=BaseHdr.BaseMsgNum) and
          (CurrMsgNum<=GetHighMsgNum) and (JamIdx.HdrLoc>-1) and (JamIdx.MsgToCrc<>-1));
    End;

    Function TJamMsgBase.GetMsgLoc: LongInt; {Msg location}
      Begin
      GetMsgLoc := GetMsgNum;
      End;

    Procedure TJamMsgBase.SetMsgLoc(ML: LongInt); {Msg location}
    Begin
       CurrMsgNum:=ML;
    End;

    Procedure TJamMsgBase.YoursFirst(Name:String;Handle:String);
    Begin
       YourName:=UpperCase(Name);
       YourHdl:=UpperCase(Handle);
       NameCrc:=JamStrCrc(Name);
       HdlCrc:=JamStrCrc(Handle);
       CurrMsgNum:=BaseHdr.BaseMsgNum-1;
       YoursNext;
    End;

    Procedure TJamMsgBase.YoursNext;
    Var
       Found:Boolean;
       NumRead:Integer;
       SubCtr:LongInt;
       SubPtr:^SubFieldType;

    Begin
       Error := 0;
       Found := False;
       Inc(CurrMsgNum);
       While ((Not Found) and (CurrMsgNum<=GetHighMsgNum) And (Error=0)) Do Begin
          Error:=ReadIdx;
          If Error=0 Then Begin                            {Check CRC values}
             If ((JamIdx.MsgToCrc=NameCrc) or
                (JamIdx.MsgToCrc=HdlCrc)) Then Begin
                {$I-} shSeekFile(HdrFile,JamIdx.HdrLoc); {$I+}
                Error:=MKFileError;
                If Error=0 Then Begin                        {Read message header}
                   {$I-} shRead(HdrFile,MsgHdr^,SizeOf(MsgHdr^),NumRead); {$I+}
                   Error:=MKFileError;
                   If Error<>0 then
                      if assigned(FOnStatus) then
                      FOnStatus(self,True,'JAM Object [YoursNext] Error ('+IntToStr(Error+2000)+')');
                End
                Else Begin
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [YoursNext] Error ('+IntToStr(Error+1000)+')');
                End;
                If ((Error=0) and (Not IsRcvd)) Then Begin
                   SubCtr:=1;
                   While ((SubCtr<=MsgHdr^.JamHdr.SubFieldLen) and
                      (SubCtr<JamSubBufSize)) Do Begin
                      SubPtr:=@MsgHdr^.SubBuf[SubCtr];
                      Inc(SubCtr,SubPtr^.DataLen+8);
                      Case(SubPtr^.LoId) Of
                         3:Begin {MsgTo}
                              If SubPtr^.DataLen and $ff>65 then SetLength(MKMsgTo,65)
                              Else SetLength(MKMsgTo,SubPtr^.DataLen and $ff);
                              Move(SubPtr^.Data, MKMsgTo[1], Length(MKMsgTo));
                              If ((UpperCase(MKMsgTo)=YourName) Or
                                 (UpperCase(MKMsgTo)=YourHdl)) Then
                              Found:=True;
                         End;
                      End;
                   End;
                End;
             End;
          End
          Else Begin
          if assigned(FOnStatus) then
            FOnStatus(self,True,'JAM Object [YoursNext] Error ('+IntToStr(Error)+')');
          End;
          If (Not Found) Then Inc(CurrMsgNum);
       End;
    End;

    Function TJamMsgBase.MKYoursFound:Boolean;
    Begin
       MKYoursFound:=((CurrMsgNum>=BaseHdr.BaseMsgNum) and
          (CurrMsgNum<=GetHighMsgNum) and (JamIdx.HdrLoc>-1) and (JamIdx.MsgToCrc<>-1));
    End;

    Procedure TJamMsgBase.StartNewMsg;
    Begin
       TxtBufStart:=0;
       TxtPos:=0;
       FillChar(MsgHdr^,SizeOf(MsgHdr^),#0);
       MsgHdr^.JamHdr.SubFieldLen:=0;
       MsgHdr^.JamHdr.MsgIdCrc:=-1;
       MsgHdr^.JamHdr.ReplyCrc:=-1;
       MsgHdr^.JamHdr.PwdCrc:=-1;
       MKMsgTo:='';
       MKMsgFrom:='';
       MKMsgSubj:='';
       FillChar(Orig,SizeOf(Orig),#0);
       FillChar(Dest,SizeOf(Dest),#0);
       MKMsgDate:=DateStr(GetDosDate);
       MKMsgTime:=TimeStr(GetDosDate);
    End;

    Function TJamMsgBase.MKMsgBaseExists: Boolean;
    Begin
       MKMsgBaseExists:=FileExist(MsgPath+'.JHR');
    End;

    Function TJamMsgBase.OpenMsgBase: Word;
    Var
       NumRead:Integer;

    Begin
       LockCount := 0;
       MKGetHighMsgNumber:=0;
       shOpenFile(HdrFile,MsgPath+'.JHR');
       If MKFileError=0 Then Begin
          shSeekFile(HdrFile,0);
          shRead(HdrFile,BaseHdr,SizeOf(BaseHdr),NumRead);
          MKGetHighMsgNumber:=BaseHdr.BaseMsgNum;
          If MKFileError<>0 then
             if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [OpenMsgBase] Error ('+IntToStr(MKFileError+1000)+')');
       End
       Else Begin
          if assigned(FOnStatus) then
             FOnStatus(self,True,'JAM Object [OpenMsgBase] Error ('+IntToStr(MKFileError)+')');
       End;
       shOpenFile(TxtFile,MsgPath+'.JDT');
       If MKFileError<>0 Then Begin
          if assigned(FOnStatus) then
             FOnStatus(self,True,'JAM Object [OpenMsgBase] Error ('+IntToStr(MKFileError+2000)+')');
       End;
       shOpenFile(IdxFile,MsgPath+'.JDX');
       If MKFileError<>0 Then Begin
          if assigned(FOnStatus) then
             FOnStatus(self,True,'JAM Object [OpenMsgBase] Error ('+IntToStr(MKFileError+3000)+')');
       End
       Else MKGetHighMsgNumber:=BaseHdr.BaseMsgNum+(FileSize(IdxFile) div Sizeof(JamIdx))-1;
       TxtBufStart:=-10;
       TxtRead:=0;
       OpenMsgBase:=MKFileError;
       FActive:=MKFileError=0;
    End;

    Procedure TJamMsgBase.SetActive(Value:Boolean);
    Begin
       If Value=FActive then Exit
       Else Begin
          If Value then OpenMsgBase
          Else CloseMsgBase;
       End;
    End;

    Function TJamMsgBase.CloseMsgBase: Word;
    Begin
       shCloseFile(HdrFile);
       If MKFileError<>0 then Begin
          if assigned(FOnStatus) then
             FOnStatus(self,True,'JAM Object [CloseMsgBase] Error ('+IntToStr(MKFileError)+')');
       End
       Else Begin
          shCloseFile(TxtFile);
          If MKFileError<>0 then Begin
             if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [CloseMsgBase] Error ('+IntToStr(MKFileError+1000)+')');
          End
          Else Begin
             shCloseFile(IdxFile);
             If MKFileError<>0 then Begin
                if assigned(FOnStatus) then
                   FOnStatus(self,True,'JAM Object [CloseMsgBase] Error ('+IntToStr(MKFileError+2000)+')');
             End;
          End;
       End;
       CloseMsgBase:=MKFileError;
       FActive:=Not (MKFileError=0);
    End;

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

    Begin
       CreateError:=0;
       i:=PosLastChar('\',MsgPath);
       If (I=3) and (MsgPath[2]=':') then I:=0;
       If (i>0) Then Begin
          MakePath(Copy(MsgPath,1,i));
          If Not DirExist(Copy(MsgPath,1,i)) Then Begin
             CreateError:=100;
             CreateMsgBase:=CreateError;
    {         ShowMessage('DirExist Failed on '+Copy(MsgPath,1,i));}
             Exit;
          End;
       End;
       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(MsgPath+'.JHR',TmpHdr^,SizeOf(TmpHdr^));
          If CreateError<>0 then
          if assigned(FOnStatus) then
          FOnStatus(self,True,'JAM Object [CreateMsgBase] Error ('+IntToStr(CreateError)+')');
          Dispose(TmpHdr);
          If CreateError=0 Then CreateError:=SaveFile(MsgPath+'.JLR',CreateError,0);
          If CreateError<>0 then
          if assigned(FOnStatus) then
          FOnStatus(self,True,'JAM Object [CreateMsgBase] Error ('+IntToStr(CreateError+1000)+')');
          If CreateError=0 Then CreateError:=SaveFile(MsgPath+'.JDT',CreateError,0);
          If CreateError<>0 then
          if assigned(FOnStatus) then
          FOnStatus(self,True,'JAM Object [CreateMsgBase] Error ('+IntToStr(CreateError+2000)+')');
          If CreateError=0 Then CreateError:=SaveFile(MsgPath+'.JDX',CreateError,0);
          If CreateError<>0 then
          if assigned(FOnStatus) then
          FOnStatus(self,True,'JAM Object [CreateMsgBase] Error ('+IntToStr(CreateError+3000)+')');
          If IoResult<>0 Then;
       End;
       CreateMsgBase:=CreateError;
    End;

    Procedure TJamMsgBase.SetMailType(Value: MsgMailType);
      Begin
      MailType := Value;
      End;

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

    Procedure TJamMsgBase.ReWriteHdr;
    Begin
      If LockMsgBase Then Begin
         Error:=ReadIdx;
         If Error<>0 then
            if assigned(FOnStatus) then
            FOnStatus(self,True,'JAM Object [ReWriteHDr] Error ('+IntToStr(Error)+')');
      End
      Else Error := 5;
      If (Error=0) and (JamIdx.HdrLoc>=0) Then Begin
         {$I-} shSeekFile(HdrFile,JamIdx.HdrLoc); {$I+}
         Error := MKFileError;
         If Error = 0 Then Begin
            {$I-} shWrite(HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr)); {$I+}
            Error := MKFileError;
            If Error<>0 then
            if assigned(FOnStatus) then
            FOnStatus(self,True,'JAM Object [ReWriteHDr] Error ('+IntToStr(Error+1000)+')');
         End
         Else
            if assigned(FOnStatus) then
            FOnStatus(self,True,'JAM Object [ReWriteHDr] Error ('+IntToStr(Error+2000)+')');

         If UnLockMsgBase Then;
      End
      Else Begin
         If JamIdx.HdrLoc<0 then
            if assigned(FOnStatus) then
            FOnStatus(self,True,'JAM Object [ReWriteHDr] Error (Bad HdrLoc)');
      End;
    End;

    Procedure TJamMsgBase.DeleteMsg;
    Begin
       If Not IsDeleted Then Begin
          If LockMsgBase Then Begin
             SetAttr1(Jam_Deleted,True);
             Dec(BaseHdr.ActiveMsgs);
             If ReadIdx<>0 then Begin
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [DeleteMsg] Error ('+IntToStr(MkFileError)+')');
             End
             Else Begin
                {$I-} shSeekFile(HdrFile,JamIdx.HdrLoc); {$I+}
                If MKFileError=0 then Begin
                {$I-} shWrite(HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr)); {$I+}
                If MKFileError<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [DeleteMsg] Error ('+IntToStr(MkFileError+2000)+')');
                End
                Else Begin
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [DeleteMsg] Error ('+IntToStr(MkFileError+1000)+')');
                End;
                Inc(BaseHdr.ModCounter);
                JamIdx.MsgToCrc:=-1;
                JamIdx.HdrLoc:=-1;
                If WriteIdx<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [DeleteMsg] Error ('+IntToStr(MkFileError+3000)+')');
             End;
             MKGetHighMsgNumber:=BaseHdr.BaseMsgNum+(FileSize(IdxFile) div Sizeof(JamIdx))-1;
             If UnLockMsgBase Then;
          End;
       End;
    End;

    Function TJamMsgBase.MKNumberOfMsgs:LongInt;
    Begin
       MKNumberOfMsgs:=BaseHdr.ActiveMsgs;
    End;

    Function TJamMsgBase.FindLastRead(Var LastFile: File; UNum: LongInt): LongInt;
      Const
        LastSize = 100;

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

      Var
        LastBuf: ^LastArray;
        LastError: Word;
        NumRead: Integer;
        Found: Boolean;
        i: Word;
        LastStart: LongInt;

      Begin
      FindLastRead := -1;
      Found := False;
      New(LastBuf);
    {$I-}  shSeekFile(LastFile, 0); {$I+}
      LastError := MKFILEERROR;
      While ((Not Eof(LastFile)) and (LastError = 0) And (Not Found)) Do
        Begin
        LastStart := FilePos(LastFile);
        {$I-} shRead(LastFile, LastBuf^, LastSize, NumRead); {$I+}
        LastError := MKFileError;
        For i := 1 to NumRead Do
          Begin
          If LastBuf^[i].UserNum = UNum Then
            Begin
            Found := True;
            FindLastRead := LastStart + i - 1;
            End;
          End;
        End;
      Dispose(LastBuf);
      End;

    Function TJamMsgBase.GetLastRead(UNum: LongInt): LongInt;
      Var
        RecNum: LongInt;
        LastFile: File;
        TmpLast: JamLastType;
        NumRead:Integer;

    Begin
       shAssign(LastFile,MsgPath+'.JLR');
       FileMode:=fmReadWrite+fmDenyNone;
       shReset(LastFile,SizeOf(JamLastType));
       RecNum:=FindLastRead(LastFile, UNum);
       GetLastRead:=0;
       If RecNum>=0 Then Begin
          shSeekFile(LastFile, RecNum);
          If MKFileError=0 Then Begin
             shRead(LastFile,TmpLast,1,NumRead);
             GetLastRead := TmpLast.HighRead;
          End;
       End;
       shCloseFile(LastFile);
    End;

    Procedure TJamMsgBase.SetLastRead(UNum: LongInt; LR: LongInt);
      Var
        RecNum: LongInt;
        LastFile: File;
        TmpLast: JamLastType;
        NumRead:Integer;

    Begin
       shAssign(LastFile,MsgPath+'.JLR');
       FileMode:=fmReadWrite+fmDenyNone;
       shReset(LastFile, SizeOf(JamLastType));
       RecNum := FindLastRead(LastFile, UNum);
       If RecNum >= 0 Then Begin
          shSeekFile(LastFile, RecNum);
          If MKFileError = 0 Then Begin
             shRead(LastFile, TmpLast, 1, NumRead);
             TmpLast.HighRead := LR;
             TmpLast.LastRead := LR;
             If MKFileError=0 Then shSeekFile(LastFile, RecNum);
             If MKFileError=0 Then shWrite(LastFile,TmpLast,1);
          End;
       End
       Else Begin
          TmpLast.UserNum := UNum;
          TmpLast.HighRead := Lr;
          TmpLast.NameCrc := UNum;
          TmpLast.LastRead := Lr;
           shSeekFile(LastFile,FileSize(LastFile));
          If MKFileError=0 Then shWrite(LastFile,TmpLast,1);
        End;
        shCloseFile(LastFile);
    End;

    Function TJamMsgBase.GetTxtPos: LongInt;
    Begin
       GetTxtPos:=TxtPos;
    End;

    Procedure TJamMsgBase.SetTxtPos(TP: LongInt);
    Begin
       TxtPos:=TP;
    End;

    Function TJamMsgBase.LockMsgBase: Boolean;
      Var
        LockError: Boolean;
        NumRead:Integer;

      Begin
      LockError := False;
          {LockError := shLock(HdrFile, 0, 1);}
    {      LockError:=LockFile(TFileRec(HdrFile).Handle, 0,0, 1,0);
          If LockError then ShowMessage('Lock Failed!');}
          If Not LockError Then Begin
          {$I-} shSeekFile(HdrFile,0); {$I+}
          LockError := MKFileError<>0;
          If MKFileError<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [Lock] Error ('+IntToStr(MkFileError)+')');
          End;
          If Not LockError Then Begin
          {$I-} shRead(HdrFile,BaseHdr,SizeOf(BaseHdr),NumRead); {$I+}
          LockError:=MKFileError<>0;
          If MKFileError<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [Lock] Error ('+IntToStr(MkFileError+1000)+')');
          End;
      Inc(LockCount);
      LockMsgBase := {LockError;} True;
      End;

    Function TJamMsgBase.UnLockMsgBase: Boolean;
      Var
        LockError: Boolean;

      Begin
      LockError := False;
      If LockCount > 0 Then Dec(LockCount);
      If LockCount = 0 Then Begin
        If Not LockError Then  Begin
    {      LockError := UnLockFile(TFileRec(HdrFile).Handle, 0,0, 1,0);
          If LockError then ShowMessage('UN-Lock Failed!');}
        End;
        If Not LockError Then  Begin
          {$I-} shSeekFile(HdrFile, 0); {$I+}
          LockError := MKFileError<>0;
          If MKFileError<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [UNLock] Error ('+IntToStr(MkFileError)+')');
        End;
        If Not LockError Then Begin
          {$I-} shWrite(HdrFile, BaseHdr, SizeOf(BaseHdr)); {$I+}
          LockError := MKFileError<>0;
          If MKFileError<>0 then
                if assigned(FOnStatus) then
                FOnStatus(self,True,'JAM Object [UNLock] Error ('+IntToStr(MkFileError+1000)+')');
          End;
        End;
      UnLockMsgBase := {LockError;} True;
      End;

    {SetSeeAlso/GetSeeAlso provided by 2:201/623@FidoNet Jonas@iis.bbs.bad.se}
    Procedure TJamMsgBase.SetNextSeeAlso(Value: LongInt);
      Begin
      MsgHdr^.JamHdr.ReplyNext := Value;
      End;

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

    Function TJamMsgBase.ReadIdx:Word;
    Var
       I:Integer;

    Begin
       {check idxfile - see if open!}
       I:=CurrMsgNum-BaseHdr.BaseMsgNum;
       {$I-} shSeekFile(IdxFile,(I*SizeOf(JamIdx)));
       shRead(IdxFile,JamIdx,SizeOf(JamIdx),I); {$I+}
       ReadIdx:=MKFileError;
    End;

    Function TJamMsgBase.WriteIdx:Word;
    Var
       I:Integer;

    Begin
       I:=CurrMsgNum-BaseHdr.BaseMsgNum;
       {$I-} shSeekFile(IdxFile,(I*SizeOf(JamIdx)));
       shWrite(IdxFile,JamIdx,SizeOf(JamIdx)); {$I+}
       WriteIdx:=MKFileError;
    End;

    Procedure TJamMsgBase.SetEcho(Value:Boolean);
    Begin
       {blah}
    End;

    Procedure Register;
    Begin
       RegisterComponents('Warpgroup',[TJamMsgBase]);
    End;

    End.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]