{MKMsgFid - Fido *.Msg Unit
Copyright 1993-1994 by Mark May (1:110/290;maym@dmapub.dma.org)
Changes (c) 1999-2000 by Andre Grueneberg (2:2411/525;andre@grueneberg.de)
Changes (c) 1999 by Vadim Rumyantsev (2:5030/48.4)
Changes (c) 1998-2000 by Bernhard R. Link (2:2476/841.64;brl@gmx.de)
Changes (c) 2001 by Oliver Kopp (2:2471/1464;olly98@users.sourceforge.net)
****************************************************************************
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
****************************************************************************}

(* $Id: mkmsgfid.pas,v 1.10 2001/06/04 19:27:37 olly98 Exp $ *)

Unit MKMsgFid;

{$I platform.inc}
{$I mkglobal.inc}

{
     Now handles message size only limited by disk space and
     the maximum size of a longint, while using only a small
     buffer for low memory usage with reasonable speed
}

Interface

Uses MKMsgAbs, MKFFile, FtnAddr, uDate, aString,
{$IFDEF VIRTUALPASCAL}
  use32,
  VpSysLow, // wegen FindFirst in MsgBaseExists
{$ENDIF}
{$IFDEF WINDOWS}
  Strings, WinDos;
{$ELSE}
  Dos;
{$ENDIF}


Const MaxFidMsgArray = {$IFNDEF VirtualPascal}4000{$ELSE}128*1024{$ENDIF};
Const MaxFidMsgNum = (MaxFidMsgArray * 8) - 1;

Type FMsgType = Record
  MsgFile: FFileObj;
  TextCtr: LongInt;
  MsgName: String[13];
  TmpName: String[130];
  TmpOpen: Boolean;
  MsgOpen: Boolean;
  Error: Word;
  NetMailPath: String[128];
  Dest: AddrType;
  Orig: AddrType;
  MsgStart: LongInt;
  MsgEnd: LongInt;
  MsgSize: LongInt;
  DefaultZone: System.Word;
  QDate: String[8]; {DD-MM-YY}
  QTime: String[8]; {HH:MM:SS}
  MsgDone: Boolean;
  CurrMsg: LongInt; {=0 = no valid Message}
  SeekOver: Boolean;
  {$IFDEF WINDOWS}
  SR: TSearchRec;
  {$ELSE}
  SR: SearchRec;
  {$ENDIF}
  Name: String[35];
  Handle: String[35];
  MailType: MsgMailType;
  MsgPresent: Array[0..MaxFidMsgArray] of Byte;
  End;


Type FidoMsgObj = Object (AbsMsgObj)
  FM: ^FMsgType;

  Constructor Init;                      {Initialize FidoMsgOut}
  Destructor Done; Virtual; {Done FidoMsgOut}


(* handling with the whole messagebase *)
  Function  OpenMsgBase: Word; Virtual;
  Function  CloseMsgBase: Word; virtual;
  Function  CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;

  Procedure SetMsgBasePath(Const St: OpenString); Virtual;
  Procedure SetMsgBaseType(MT: MsgMailType); Virtual; {Set message base type}
  Procedure SetMsgBaseDefaultZone(DZ: Word); Virtual; {Set default zone to use}

  Function  MsgBaseExists: Boolean; Virtual;

  Function  LockMsgBase: Boolean; virtual;
  Function  UnLockMsgBase: Boolean; virtual;

  Function  NumberOfMsgs: LongInt; Virtual; {Number of messages}

(* handling with msgs *)
  Function  GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area}

  Function  KillMsg(MsgNum: LongInt):Integer; virtual;

  Function  GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num}
  Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read}

  (*
    Notes:
      Reload is not evaluated
  *)
  Function  SeekFirst(MsgNum: LongInt;Reload:Boolean): Boolean; Virtual; {Seek msg number}

  Function  SeekNext: Boolean; Virtual; {Find next matching msg}
  Function  SeekPrior: Boolean; Virtual; {Seek prior matching msg}

  (*
     YoursFirst and YoursNext aren't implemented, because the routines from MkMsgAbs do their job well
  *)

  Function  GetMsgNum: LongInt; Virtual; {Get message number}

  Function  GetTxtPos: LongInt; Virtual; {Get indicator of msg text position}
  Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position}

  Function  MsgStartUp: Boolean; Virtual; {set up msg for reading}
  Function  MsgTxtStartUp: Boolean; Virtual; {Do message text start up tasks}

  Function  GetChar: Char; Virtual;

  Function  EOM: Boolean; Virtual; {No more msg text}

  Function  GetSubj: TString; Virtual; {Get subject on current msg}
  Function  GetFromName: TString; Virtual; {Get from name on current msg}
  Function  GetFromAddr: TFtnAddr; Virtual; {Get origin address}
  Function  GetToName: TString; Virtual; {Get to name on current msg}
  Function  GetToAddr: TFtnAddr; Virtual; {Get destination address}

  Function  GetDateTime:TDateTimeStr; virtual;

  Function  GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
  Function  GetRefer: LongInt; Virtual; {Get reply to of current msg}

  Function  GetCost: Word; Virtual; {Get cost of current msg}

  (* f/a *)
  Function  IsFAttach: Boolean; Virtual; {Is current msg file attach}
  Function  IsFileReq: Boolean; Virtual; {Is current msg a file request}

  (* attributes *)
  Function  IsCrash: Boolean; Virtual; {Is current msg crash}
  Function  IsDeleted: Boolean; Virtual; {Is current msg deleted}
  Function  IsEchoed: Boolean; Virtual; {Msg should be echoed}
  Function  IsLocal: Boolean; Virtual; {Is current msg local}
  Function  IsFwd: Boolean; Virtual; {Is current msg in transit}
  Function  IsHold: Boolean; virtual; {Is current msg ist on hold, always returns FALSE}
  Function  IsKillSent: Boolean; Virtual; {Is current msg kill sent}
  Function  IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
  Function  IsRcvd: Boolean; Virtual; {Is current msg received}
  Function  IsReqAud: Boolean; Virtual; {Is current msg request audit}
  Function  IsReqRct: Boolean; Virtual; {Is current msg request receipt}
  Function  IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
  Function  IsSent: Boolean; Virtual; {Is current msg sent}

(* writing a message *)
  (*
    Returns:
      Always TRUE - even if something gone wrong
  *)
  Function  StartNewMsg: Boolean; Virtual;
  Function  WriteMsg: Word; Virtual;
  Function  ReWriteHdr: Word; Virtual; {Rewrite msg header after changes, always returns 0}

  (* writing the text *)
  Procedure DoChar(Ch: Char); Virtual; {Add character to message text}
  Procedure DoKludgeLn(const Str: OpenString); Virtual; {Add ^A kludge line to msg}

  (* sender, receipient, subject *)
  Procedure SetSubj(Const Str: OpenString); Virtual; {Set message subject}
  Procedure SetFromName(Const Name: OpenString); Virtual; {Set message from}
  Procedure SetFromAddr(Const Addr: TFtnAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
  Procedure SetToName(Const Name: OpenString); Virtual; {Set message to}
  Procedure SetToAddr(Const Addr: TFtnAddr); Virtual; {Set Zone/Net/Node/Point for Dest}

  (* date and time *)
  Procedure SetDateTime(const s:TDateTimeStr);virtual;

  (* links to other messages *)
  Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also}
  Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference}

  Procedure SetCost(SCost: Word); Virtual; {Set message cost}

  (* f/a *)
  Procedure SetFAttach(St: Boolean); Virtual; {Set file attach status}
  Procedure SetFileReq(St: Boolean); Virtual; {Set file request status}

  (* other attributes *)
  Procedure SetCrash(St: Boolean); Virtual; {Set crash netmail status}
  Procedure SetEcho(ES: Boolean); virtual;
  Procedure SetLocal(LS: Boolean); Virtual; {Set local status}
  Procedure SetFwd(St: Boolean); Virtual; {Set in transit status}
  Procedure SetHold(St: Boolean); virtual; {Set file hold status, does nothing}
  Procedure SetKillSent(St: Boolean); Virtual; {Set kill/sent netmail status}
  Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status}
  Procedure SetRcvd(RS: Boolean); Virtual; {Set received status}
  Procedure SetReqAud(St: Boolean); Virtual; {Set request audit status}
  Procedure SetReqRct(St: Boolean); Virtual; {Set request receipt status}
  Procedure SetRetRct(St: Boolean); Virtual; {Set return receipt status}
  Procedure SetSent(St: Boolean); Virtual; {Set sent netmail status}


(* new *)
  Procedure RemoveTmp; {remove temporary file}
  Procedure PutLong(L: LongInt; Position: LongInt); {Put long into msg}
  Procedure PutWord(W: System.Word; Position: LongInt);  {Put word into msg}
  Procedure PutByte(B: Byte; Position: LongInt);  {Put byte into msg}
  Function  GetByte(Position: LongInt): Byte; {Get byte from msg}
  Procedure PutNullStr(St: String; Position: LongInt);  {Put string & null into msg}

  Procedure LineStart; Virtual; {Internal use to skip LF, ^A}

  Procedure CheckZone(Const ZoneStr: String); Virtual;
  Procedure CheckPoint(Const PointStr: String); Virtual;
  Procedure CheckLine(TStr: String); Virtual;
  Function  CvtDate: Boolean; Virtual;
  Function  BufferWord(i: Word):System.Word; Virtual;
  Function  BufferByte(i: Word):Byte; Virtual;
  Function  BufferNullString(i: Word; Max: Word): String; Virtual;
  Function  GetMsgLoc: LongInt; Virtual; {Msg location}
  Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location}
  Procedure Rescan;
  Function  MsgExists(MsgNum: LongInt): Boolean;
  End;


Type FidoMsgPtr = ^FidoMsgObj;

// new names, idea by brl
     tMKFido = FidoMsgObj;
     PMKFido = ^tMKFido;


Function MonthNum(St: String):Word;


Implementation

Uses uFiles, uString;


Const
  PosArray: Array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);


Constructor FidoMsgObj.Init;
  Begin
  New(FM);
  If FM = Nil Then
    Begin
    Fail;
    Exit;
    End;
  FM^.NetMailPath := '';
  FM^.TextCtr := 190;
  FM^.Dest.Zone := 0; {0 means "not set"}
  FM^.Orig.Zone := 0;
  FM^.SeekOver := False;
  FM^.DefaultZone := 1;
  FM^.MsgFile.Init(4000);
  FM^.TmpOpen := False;
  FM^.MsgOpen := False;
  End;


Destructor FidoMsgObj.Done;
  Begin
  If FM^.MsgOpen Then
    If FM^.MsgFile.CloseFile Then;
  If FM^.TmpOpen Then
    Begin
    RemoveTmp;
    End;
  FM^.MsgFile.Done;
  Dispose(FM);
  End;


Procedure FidoMsgObj.RemoveTmp;
  Var
    TmpFile: File;

  Begin
  If FM^.MsgFile.CloseFile Then;
  Assign(TmpFile, FM^.TmpName);
  Erase(TmpFile);
  If IoResult <> 0 Then;
  FM^.TmpOpen := False;
  End;


Procedure FidoMsgObj.PutLong(L: LongInt; Position: LongInt);
  Begin
  If FM^.MsgFile.SeekFile(Position) Then
    If FM^.MsgFile.BlkWrite(L, SizeOf(LongInt)) Then;
  End;


Procedure FidoMsgObj.PutWord(W: System.Word; Position: LongInt);
  Begin
  If FM^.MsgFile.SeekFile(Position) Then
    If FM^.MsgFile.BlkWrite(W, SizeOf(System.Word)) Then;
  End;


Procedure FidoMsgObj.PutByte(B: Byte; Position: LongInt);
  Begin
  If FM^.MsgFile.SeekFile(Position) Then
    If FM^.MsgFile.BlkWrite(B, SizeOf(Byte)) Then;
  End;


Function FidoMsgObj.GetByte(Position: LongInt): Byte;
  Var
    B: Byte;
    NumRead: Word;

  Begin
  If FM^.MsgFile.SeekFile(Position) Then
    If FM^.MsgFile.BlkRead(B, SizeOf(Byte), NumRead) Then;
  GetByte := b;
  End;


Procedure FidoMsgObj.PutNullStr(St: String; Position: LongInt);
  Var
    i: Byte;

  Begin
  i := 0;
  If FM^.MsgFile.SeekFile(Position) Then
    Begin
    If FM^.MsgFile.BlkWrite(St[1], Length(St)) Then;
    If FM^.MsgFile.BlkWrite(i, 1) Then;
    End;
  End;


Procedure FidoMsgObj.SetMsgBasePath(Const St: OpenString);
  Begin
  FM^.NetMailPath := Copy(St, 1, 110);
  AddBackSlash(FM^.NetMailPath);
  End;


Function FidoMsgObj.GetHighMsgNum: LongInt;
  Var
  Highest: LongInt;
  Cnt: LongInt;

  Begin
  Cnt := MaxFidMsgArray;
  While (Cnt > 0) and (FM^.MsgPresent[Cnt] = 0) Do
    Dec(Cnt);
  If Cnt < 0 Then
    Highest := 0
  Else
    Begin
    Highest := Cnt * 8;
    If (FM^.MsgPresent[Cnt] and $80) <> 0 Then
      Inc(Highest, 7)
    Else If (FM^.MsgPresent[Cnt] and $40) <> 0 Then
      Inc(Highest, 6)
    Else If (FM^.MsgPresent[Cnt] and $20) <> 0 Then
      Inc(Highest, 5)
    Else If (FM^.MsgPresent[Cnt] and $10) <> 0 Then
      Inc(Highest, 4)
    Else If (FM^.MsgPresent[Cnt] and $08) <> 0 Then
      Inc(Highest, 3)
    Else If (FM^.MsgPresent[Cnt] and $04) <> 0 Then
      Inc(Highest, 2)
    Else If (FM^.MsgPresent[Cnt] and $02) <> 0 Then
      Inc(Highest)
    End;
  GetHighMsgNum := Highest;
  End;


Procedure FidoMsgObj.SetToAddr(Const Addr: TFtnAddr);
  Begin
  FM^.Dest := Addr;
  PutWord(Addr.Net, 174);
  PutWord(Addr.Node, 166);
  If ((Addr.Point <> 0) and (FM^.MailType = mtNetmail)) Then
    Begin
    If ((FM^.TextCtr <> 190) And
    (GetByte(FM^.TextCtr - 1) <> 13)) Then
      DoChar(#13);
    DoStringLn(#1'TOPT ' + LongToStr(Addr.Point));
    End;
  If ((FM^.Orig.Zone <> 0) and (FM^.MailType = mtNetMail)) Then
    Begin
    If ((FM^.TextCtr <> 190) And
    (GetByte(FM^.TextCtr - 1) <> 13)) Then
      DoChar(#13);
    DoStringLn(#1'INTL ' + PointlessAddrStr(FM^.Dest) + ' ' +
      PointlessAddrStr(FM^.Orig));
    End;
  End;


Procedure FidoMsgObj.SetFromAddr(Const Addr: TFtnAddr);
  Begin
  FM^.Orig := Addr;
  PutWord(Addr.Net, 172);
  PutWord(Addr.Node, 168);
  If ((Addr.Point <> 0) and (FM^.MailType = mtNetmail)) Then
    Begin
    If ((FM^.TextCtr <> 190) And
    (GetByte(FM^.TextCtr - 1) <> 13)) Then
      DoChar(#13);
    DoStringLn(#1'FMPT ' + LongToStr(Addr.Point));
    End;
  If ((FM^.Dest.Zone <> 0) and (FM^.MailType = mtNetmail)) Then
    Begin
    If ((FM^.TextCtr <> 190) And
    (GetByte(FM^.TextCtr - 1) <> 13)) Then
      DoChar(#13);
    DoStringLn(#1'INTL ' + PointlessAddrStr(FM^.Dest) + ' ' +
      PointlessAddrStr(FM^.Orig));
    End;
  End;


Procedure FidoMsgObj.SetFromName(Const Name: OpenString);
  Begin
  PutNullStr(Copy(Name, 1, 35),0);
  End;


Procedure FidoMsgObj.SetToName(Const Name: OpenString);
  Begin
  PutNullStr(Copy(Name, 1, 35), 36);
  End;


Procedure FidoMsgObj.SetSubj(Const Str: OpenString);
  Begin
  PutNullStr(Copy(Str, 1, 71), 72);
  End;


Procedure FidoMsgObj.SetCost(SCost: Word);
  Begin
  PutWord(SCost, 170);
  End;


Procedure FidoMsgObj.SetRefer(SRefer: LongInt);
  Begin
  PutWord(SRefer, 184);
  End;


Procedure FidoMsgObj.SetSeeAlso(SAlso: LongInt);
  Begin
  PutWord(SAlso, 188);
  End;

procedure FidoMsgObj.SetDateTime(const s:TDateTimeStr);

var
  DateStr : string;

begin
  DateStr:=CutForPkt(s);

  {store in internal structs}
  FM^.QDate:=Copy(DateStr,1,9);
  FM^.QTime:=Copy(DateStr,12,8);

  {write it into the file}
  PutNullStr(DateStr, 144);
end;

Procedure FidoMsgObj.SetLocal(LS: Boolean);
  Begin
  If LS Then
    PutByte(GetByte(187) or 1, 187)
  Else
    PutByte(GetByte(187) and (Not 1), 187);
  End;


Procedure FidoMsgObj.SetRcvd(RS: Boolean);
  Begin
  If RS Then
    PutByte(GetByte(186) or 4, 186)
  Else
    PutByte(GetByte(186) and (not 4), 186);
  End;


Procedure FidoMsgObj.SetPriv(PS: Boolean);
  Begin
  If PS Then
    PutByte(GetByte(186) or 1, 186)
  Else
    PutByte(GetByte(186) and (not 1), 186);
  End;


Procedure FidoMsgObj.SetCrash(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(186) or 2, 186)
  Else
    PutByte(GetByte(186) and (not 2), 186);
  End;


Procedure FidoMsgObj.SetKillSent(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(186) or 128, 186)
  Else
    PutByte(GetByte(186) and (Not 128), 186);
  End;


Procedure FidoMsgObj.SetSent(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(186) or 8, 186)
  Else
    PutByte(GetByte(186) and (not 8), 186);
  End;


Procedure FidoMsgObj.SetFAttach(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(186) or 16, 186)
  Else
    PutByte(GetByte(186) and (not 16), 186);
  End;


Procedure FidoMsgObj.SetReqRct(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(187) or 16, 187)
  Else
    PutByte(GetByte(187) and (not 16), 187);
  End;


Procedure FidoMsgObj.SetReqAud(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(187) or 64, 187)
  Else
    PutByte(GetByte(187) and (not 64), 187);
  End;


Procedure FidoMsgObj.SetRetRct(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(187) or 32, 187)
  Else
    PutByte(GetByte(187) and (not 32), 187);
  End;


Procedure FidoMsgObj.SetFileReq(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(187) or 8, 187)
  Else
    PutByte(GetByte(187) and (not 8), 187);
  End;


Procedure FidoMsgObj.DoChar(Ch: Char);
  Begin
  PutByte(Ord(Ch), FM^.TextCtr);
  Inc(FM^.TextCtr);
  End;

Procedure FidoMsgObj.DoKludgeLn(const Str: OpenString);
var
  workStr: string;
begin
  workStr:=Str;
  If workStr[1]<>#1 Then begin
    workStr := #1 + workStr;
  end;
  If (UpString(Copy(workStr,2,5))='TOPT ') Or
     (UpString(Copy(workStr,2,5))='INTL ') Or
     (UpString(Copy(workStr,2,5))='FMPT ') Then
    Exit;
  DoStringLn(workStr);
  End;


Function  FidoMsgObj.WriteMsg: Word;
  Var
    NetNum: Word;
    TmpDate: LongInt;
    {$IFDEF WINDOWS}
    TmpDT: TDateTime;
    {$ELSE}
    TmpDT: DateTime;
    {$ENDIF}
    TmpFile: File;
    Code: LongInt;

  Begin
  DoChar(#0);
  PutLong(GetDosDate, 180);
  TmpDT.Year := StrToLong(Copy(FM^.QDate,7,2));
  If TmpDT.Year > 79 Then
    Inc(TmpDT.Year, 1900)
  Else
    Inc(TmpDT.Year, 2000);
  TmpDT.Month := StrToLong(Copy(FM^.QDate,1,2));
  TmpDT.Day := StrToLong(Copy(FM^.QDate,4,2));
  TmpDt.Hour := StrToLong(Copy(FM^.QTime,1,2));
  TmpDt.Min := StrToLong(Copy(FM^.QTime, 4,2));
  TmpDt.Sec := StrToLong(Copy(FM^.QTime, 7,2));
  PackTime(TmpDT, TmpDate);
  PutLong(TmpDate, 176);
  NetNum := GetHighMsgNum + 1;
  If FileExist(FM^.NetMailPath + LongToStr(NetNum) + '.msg') Then
    Begin
    Rescan;
    NetNum := GetHighMsgNum + 1;
    End;
  Code := NetNum shr 3; {div by 8 to get byte position}
  FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[NetNum and 7];
  If FM^.TmpOpen Then
    Begin
    If FM^.MsgFile.CloseFile Then
      Begin
      Assign(TmpFile, FM^.TmpName);
      Rename(TmpFile, FM^.NetMailPath + LongToStr(NetNum) + '.msg')
      End;
    End;
  WriteMsg := IoResult;
  FM^.CurrMsg := NetNum;
  End;


Procedure FidoMsgObj.SetMsgBaseDefaultZone(DZ: Word); {Set default zone to use}
  Begin
  FM^.DefaultZone := DZ;
  End;


Procedure FidoMsgObj.LineStart;
  Begin
  If GetByte(FM^.TextCtr) = 10 Then
    Inc(FM^.TextCtr);
  If GetByte(FM^.TextCtr) = 1 Then
    Inc(FM^.TextCtr);
  End;


Function FidoMsgObj.GetChar: Char;
  Begin
  If ((FM^.TextCtr >= FM^.MsgSize) Or (GetByte(FM^.TextCtr) = 0)) Then
    Begin
    GetChar := #0;
    FM^.MsgDone := True;
    End
  Else
    Begin
    GetChar := Chr(GetByte(FM^.TextCtr));
    Inc(FM^.TextCtr);
    End;
  End;


Procedure FidoMsgObj.CheckZone(Const ZoneStr: String);
  Var
    DestZoneStr: String;
    Code: Word;

  Begin
  If (UpString(Copy(ZoneStr,1,4)) = 'INTL') Then
    Begin
    DestZoneStr := ExtractWord(ZoneStr, 2);
    DestZoneStr := TrimStr(DestZoneStr);
    DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
    Val(DestZoneStr, FM^.Dest.Zone, Code);
    DestZoneStr := ExtractWord(ZoneStr,3);
    DestZoneStr := TrimStr(DestZoneStr);
    DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
    Val(DestZoneStr, FM^.Orig.Zone, Code);
    End
  else
  If (FM^.Orig.Zone=0) and (UpString(Copy(ZoneStr,1,5)) = 'MSGID') then
    Begin
    DestZoneStr := ExtractWord(ZoneStr, 2);
    DestZoneStr := TrimStr(DestZoneStr);
    DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
    Val(DestZoneStr, FM^.Orig.Zone, Code);
    End;
  End;


Procedure FidoMsgObj.CheckPoint(Const PointStr: String);
  Var
    DestPointStr: String;
    Code: Word;
    Temp: Word;

  Begin
  If (UpString(Copy(PointStr,1,4)) = 'TOPT') Then
    Begin
    DestPointStr := ExtractWord(PointStr, 2);
    DestPointStr := TrimStr(DestPointStr);
    Val(DestPointStr, Temp, Code);
    If Code = 0 Then
      FM^.Dest.Point := Temp;
    End;
  If (UpString(Copy(PointStr,1,4)) = 'FMPT') Then
    Begin
    DestPointStr := ExtractWord(PointStr, 2);
    DestPointStr := TrimStr(DestPointStr);
    Val(DestPointStr, Temp, Code);
    If Code = 0 Then
      FM^.Orig.Point := Temp;
    End;
  End;


Function MonthNum(St: String):Word;
  Begin
  ST := UpString(St);
       If St = 'JAN' Then MonthNum := 01
  Else If St = 'FEB' Then MonthNum := 02
  Else If St = 'MAR' Then MonthNum := 03
  Else If St = 'APR' Then MonthNum := 04
  Else If St = 'MAY' Then MonthNum := 05
  Else If St = 'JUN' Then MonthNum := 06
  Else If St = 'JUL' Then MonthNum := 07
  Else If St = 'AUG' Then MonthNum := 08
  Else If St = 'SEP' Then MonthNum := 09
  Else If St = 'OCT' Then MonthNum := 10
  Else If St = 'NOV' Then MonthNum := 11
  Else If St = 'DEC' Then MonthNum := 12
  Else MonthNum:=0;
  End;


Function FidoMsgObj.CvtDate: Boolean;
  Var
    {MoNo: Word; isn't used}
    TmpStr: String;
    i: Word;
    MsgDt: String[25];

  Begin
  MsgDt := BufferNullString(144, 20);
  MsgDt := PadRight(MsgDt,' ', 20);
  CvtDate := True;
  If MsgDt[3] = ' ' Then
    Begin {Fido or Opus}
    If MsgDt[11] = ' ' Then
      Begin {Fido DD MON YY  HH:MM:SSZ}
      FM^.QTime := Copy (MsgDT,12,8);
      TmpStr := LongToStr(MonthNum(Copy(MsgDt,4,3)));
      If Length(TmpStr) = 1 Then
        TmpStr := '0' + TmpStr;
      FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
      End
    Else
      Begin {Opus DD MON YY HH:MM:SS}
      FM^.QTime := Copy(MsgDT,11,8);
      TmpStr := LongToStr(MonthNum(Copy(MsgDt,4,3)));
      If Length(TmpStr) = 1 Then
        TmpStr := '0' + TmpStr;
      FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
      End;
    End
  Else
    Begin
    If MsgDT[4] = ' ' Then
      Begin {SeaDog format DOW DD MON YY HH:MM}
      FM^.QTime := Copy(MsgDT,15,5)+':00';
      TmpStr := LongToStr(MonthNum(Copy(MsgDT,8,3)));
      If Length(TmpStr) = 1 Then
        TmpStr := '0' + TmpStr;
      FM^.QDate := TmpStr + '-' + Copy(MsgDT,5,2) + '-' + Copy (MsgDt,12,2);
      End
    Else
      Begin
      If MsgDT[3] = '-' Then
        Begin {Wierd format DD-MM-YYYY HH:MM:SS}
        FM^.QTime := Copy(MsgDt,12,8);
        FM^.QDate := Copy(MsgDt,4,3) + Copy (MsgDt,1,3) + Copy (MsgDt,9,2);
        End
      Else
        Begin  {Bad Date}
        CvtDate := False;
        End;
      End;
    End;
  For i := 1 to 8 Do
    If FM^.QTime[i] = ' ' Then
      FM^.QTime[i] := '0';
  For i := 1 to 8 Do
    If FM^.QDate[i] = ' ' Then
      FM^.QDate[i] := '0';
  If Length(FM^.QDate) <> 8 Then
    CvtDate := False;
  If Length(FM^.QTime) <> 8 Then
    CvtDate := False;
  End;


Function FidoMsgObj.BufferWord(i: Word):System.Word;
  Begin
  BufferWord := BufferByte(i) + (BufferByte(i + 1) shl 8);
  End;


Function FidoMsgObj.BufferByte(i: Word):Byte;
  Begin
  BufferByte := GetByte(i);
  End;


Function FidoMsgObj.BufferNullString(i: Word; Max: Word): String;
  Var
    Ctr: Word;
    CurrPos: Word;

  Begin
  BufferNullString := '';
  Ctr := i;
  CurrPos := 0;
  While ((CurrPos < Max) and (GetByte(Ctr) <> 0)) Do
    Begin
    Inc(CurrPos);
    BufferNullString[CurrPos] := Chr(GetByte(Ctr));
    Inc(Ctr);
    End;
  BufferNullString[0] := Chr(CurrPos);
  End;


Procedure FidoMsgObj.CheckLine(TStr: String);
  Begin
  If TStr[1] = #10 Then
    TStr := Copy(TStr,2,255);
  If TStr[1] = #01 Then
    TStr := Copy(TStr,2,255);
  CheckZone(TStr);
  CheckPoint(TStr);
  End;


Function FidoMsgObj.MsgStartUp: Boolean;
  Var
    TStr: String;
    TmpChr: Char;
    NumRead: Word;

  Begin
  If FM^.MsgOpen Then
    If FM^.MsgFile.CloseFile Then
      FM^.MsgOpen := False;
  If FM^.TmpOpen Then
    RemoveTmp;
  LastSoft := False;
  If FileExist (FM^.NetMailPath + LongToStr(FM^.CurrMsg) + '.msg') Then
    FM^.Error := 0
  Else
    FM^.Error := 200;
  If FM^.Error = 0 Then
    Begin
    If Not FM^.MsgFile.OpenFile(FM^.NetMailPath + LongToStr(FM^.CurrMsg) +
    '.msg',  fmReadWrite + fmDenyNone) Then FM^.Error := 1000;
    End;
  If FM^.Error = 0 Then
    FM^.MsgOpen := True;
  FM^.MsgDone := False;
  FM^.MsgSize := FM^.MsgFile.RawSize;
  FM^.MsgEnd := 0;
  FM^.MsgStart := 190;
  FM^.Dest.Zone := FM^.DefaultZone;
  FM^.Dest.Point := 0;
  FM^.Orig.Zone := FM^.DefaultZone;
  FM^.Orig.Point := 0;
  FM^.Orig.Net := BufferWord(172);
  FM^.Orig.Node := BufferWord(168);
  FM^.Dest.Net := BufferWord(174);
  FM^.Dest.Node := BufferWord(166);
  FM^.TextCtr := FM^.MsgStart;
  If FM^.Error = 0 Then Begin
    If Not CvtDate Then
      Begin
      FM^.QDate := '01-01-98';
      FM^.QTime := '00:00:00';
      End;
    TStr := GetString(128);
    CheckLine(TStr);
    dec (FM^.TextCtr);
    If FM^.MsgFile.SeekFile(FM^.TextCtr) Then
      If FM^.MsgFile.BlkRead(TmpChr, 1, NumRead) Then;
    While ((FM^.MsgEnd = 0) and (FM^.TextCtr <= FM^.MsgSize)) Do Begin
      Case TmpChr Of
        #0: FM^.MsgEnd := FM^.TextCtr;
        #13: Begin
          Inc(FM^.TextCtr);
          TStr := GetString(128);
          CheckLine(TStr);
          If Length(TStr) > 0 Then
            Dec(FM^.TextCtr);
        End;
        Else Begin
          Inc(FM^.TextCtr);
          If FM^.MsgFile.BlkRead(TmpChr, 1, NumRead) Then;
        End;
      End;
    End;
    If FM^.MsgEnd = 0 Then
      FM^.MsgEnd := FM^.MsgSize;
    FM^.MsgSize := FM^.MsgEnd;
    FM^.MsgStart := 190;
    FM^.TextCtr := FM^.MsgStart;
    FM^.MsgDone := False;
    LastSoft := False;
    If FM^.Dest.Zone=0 Then
      FM^.Dest.Zone := FM^.Orig.Zone;
    SubjectOfs := 0;
    MsgStartup:=True;
  end else begin
    MsgStartup:=False;
  end;

  End;


Function  FidoMsgObj.MsgTxtStartUp: Boolean;
  Begin
  FM^.MsgStart := 190;
  FM^.TextCtr := FM^.MsgStart;
  FM^.MsgDone := False;
  LastSoft := False;
  MsgTxtStartup:=True;
  End;


Function FidoMsgObj.EOM: Boolean;
  Begin
  EOM := FM^.MsgDone;
  End;



Function FidoMsgObj.GetFromName: TString; {Get from name on current msg}
  Begin
  GetFromName := BufferNullString(0, 35);
  End;


Function FidoMsgObj.GetToName: TString; {Get to name on current msg}
  Begin
  GetToName := BufferNullString(36,35);
  End;


Function FidoMsgObj.GetSubj: String; {Get subject on current msg}
  Begin
  GetSubj := BufferNullString(72,71);
  End;


Function FidoMsgObj.GetCost: Word; {Get cost of current msg}
  Begin
  GetCost := BufferWord(170);
  End;

Function  FidoMsgObj.GetDateTime:TDateTimeStr;
begin
  GetDateTime:=Convert_MMDDYYTime_To_DateTimeStr(FM^.QDate, FM^.QTime);
End;


Function FidoMsgObj.GetRefer: LongInt; {Get reply to of current msg}
  Begin
  GetRefer := BufferWord(184);
  End;


Function FidoMsgObj.GetSeeAlso: LongInt; {Get see also of current msg}
  Begin
  GetSeeAlso := BufferWord(188);
  End;


Function FidoMsgObj.GetMsgNum: LongInt; {Get message number}
  Begin
  GetMsgNum := FM^.CurrMsg;
  End;


Function FidoMsgObj.GetFromAddr: TFtnAddr; {Get origin address}
  Begin
  GetFromAddr := FM^.Orig;
  End;


Function FidoMsgObj.GetToAddr: TFtnAddr; {Get destination address}
  Begin
  GetToAddr := FM^.Dest;
  End;


Function FidoMsgObj.IsLocal: Boolean; {Is current msg local}
  Begin
  IsLocal := ((GetByte(187) and 001) <> 0);
  End;


Function FidoMsgObj.IsCrash: Boolean; {Is current msg crash}
  Begin
  IsCrash := ((GetByte(186) and 002) <> 0);
  End;


Function FidoMsgObj.IsKillSent: Boolean; {Is current msg kill sent}
  Begin
  IsKillSent := ((GetByte(186) and 128) <> 0);
  End;


Function FidoMsgObj.IsSent: Boolean; {Is current msg sent}
  Begin
  IsSent := ((GetByte(186) and 008) <> 0);
  End;


Function FidoMsgObj.IsFAttach: Boolean; {Is current msg file attach}
  Begin
  IsFAttach := ((GetByte(186) and 016) <> 0);
  End;


Function FidoMsgObj.IsReqRct: Boolean; {Is current msg request receipt}
  Begin
  IsReqRct := ((GetByte(187) and 016) <> 0);
  End;


Function FidoMsgObj.IsReqAud: Boolean; {Is current msg request audit}
  Begin
  IsReqAud := ((GetByte(187) and 064) <> 0);
  End;


Function FidoMsgObj.IsRetRct: Boolean; {Is current msg a return receipt}
  Begin
  IsRetRct := ((GetByte(187) and 032) <> 0);
  End;


Function FidoMsgObj.IsFileReq: Boolean; {Is current msg a file request}
  Begin
  IsFileReq := ((GetByte(187) and 008) <> 0);
  End;


Function FidoMsgObj.IsRcvd: Boolean; {Is current msg received}
  Begin
  IsRcvd := ((GetByte(186) and 004) <> 0);
  End;


Function FidoMsgObj.IsPriv: Boolean; {Is current msg priviledged/private}
  Begin
  IsPriv := ((GetByte(186) and 001) <> 0);
  End;


Function FidoMsgObj.IsDeleted: Boolean; {Is current msg deleted}
  Begin
  IsDeleted := Not FileExist (FM^.NetMailPath + LongToStr(FM^.CurrMsg) + '.msg');
  End;


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


Function FidoMsgObj.SeekFirst(MsgNum: LongInt;Reload:Boolean): Boolean; {Start msg seek}
  Begin
  FM^.CurrMsg := Pred (MsgNum);
  SeekFirst:=SeekNext;
  End;


Function FidoMsgObj.SeekNext: Boolean; {Find next matching msg}
  Begin
  Inc(FM^.CurrMsg);
  while ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg <= MaxFidMsgNum)) do begin
    Inc(FM^.CurrMsg);
  end;
  If Not MsgExists(FM^.CurrMsg) Then begin
    FM^.CurrMsg := 0;
    SeekNext:=False;
  end else begin
    SeekNext:=True;
  end;
  End;


Function FidoMsgObj.SeekPrior: Boolean;
  Begin
  Dec(FM^.CurrMsg);
  While ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg > 0)) Do
    Dec(FM^.CurrMsg);
  SeekPrior:=MsgExists(FM^.CurrMsg);
  End;

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


Procedure FidoMsgObj.SetMsgLoc(ML: LongInt); {Msg location}
  Begin
  FM^.CurrMsg := ML;
  End;

Function  FidoMsgObj.StartNewMsg: Boolean;
  Var
    Tmp: Array[0..189] of Char;

  Begin
  FM^.Error := 0;
  FM^.TextCtr := 190;
  FM^.Dest.Zone := 0;
  FM^.Orig.Zone := 0;
  FM^.Dest.Point := 0;
  FM^.Orig.Point := 0;
  If FM^.TmpOpen Then
    RemoveTmp
  Else
    Begin
    If FM^.MsgOpen Then
      Begin
      If FM^.MsgFile.CloseFile Then
        FM^.MsgOpen := False;
      End;
    End;
  FM^.TmpName := GetTempName(FM^.NetMailPath);
  If Length(FM^.TmpName) > 0 Then
    Begin
    If FM^.MsgFile.OpenFile(FM^.TmpName, fmReadWrite + fmDenyNone) Then
      Begin
      FM^.TmpOpen := True;
      End
    Else
      FM^.Error := 1002;
    End
  Else
    FM^.Error := 1001;
  FillChar(Tmp, SizeOf(Tmp), #0);
  If FM^.MsgFile.SeekFile(0) Then;
  If FM^.MsgFile.BlkWrite(Tmp, SizeOf(Tmp)) Then;
  SubjectOfs := 0;
  StartNewMsg:=True;
  End;


Function FidoMsgObj.OpenMsgBase: Word;
  Begin
  Rescan;
  If MsgBaseExists Then
    OpenMsgBase := 0
  Else
    OpenMsgBase := 500;
  End;


Function FidoMsgObj.CloseMsgBase: Word;
  Begin
  CloseMsgBase := 0;
  End;


Function FidoMsgObj.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
  Begin
  If MakePath(FM^.NetMailPath) Then
    CreateMsgBase := 0
  Else
    CreateMsgBase := 1;
  End;


Procedure FidoMsgObj.SetMsgBaseType(MT: MsgMailType);
  Begin
  FM^.MailType := Mt;
  End;


Function FidoMsgObj.ReWriteHdr: Word;
Begin
  ReWriteHdr:=0;
  { Not needed, rewrite is automatic when updates are done }
End;


Function FidoMsgObj.KillMsg(MsgNum : LongInt): Integer;
Var
   Code: LongInt;
   Success: Boolean;

Begin
  if MsgNum=GetMsgNum then begin
    If FM^.MsgOpen Then
      If FM^.MsgFile.CloseFile Then
        FM^.MsgOpen := False;
  end;

  Success:=EraseFile(FM^.NetMailPath + LongToStr(MsgNum) + '.msg');

  if Success then begin
    Code := MsgNum shr 3; {div by 8 to get byte position}
    FM^.MsgPresent[Code] := FM^.MsgPresent[Code] and
      Not (PosArray[MsgNum and 7]);
     KillMsg:=0;
  end else begin
     KillMsg:=-1;
  end;
End;

Function FidoMsgObj.NumberOfMsgs: LongInt;
  Var
  Cnt: Word;
  Active: LongInt;

  Begin
  Active := 0;
  For Cnt := 0 To MaxFidMsgArray Do
    Begin
    If FM^.MsgPresent[Cnt] <> 0 Then
      Begin
      If (FM^.MsgPresent[Cnt] and $80) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $40) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $20) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $10) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $08) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $04) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $02) <> 0 Then
        Inc(Active);
      If (FM^.MsgPresent[Cnt] and $01) <> 0 Then
        Inc(Active);
      End;
    End;
  NumberOfMsgs := Active;
  End;


Function FidoMsgObj.GetLastRead(UNum: LongInt): LongInt;
  Var
    LRec: Word;
    LRName: String;

  Begin
  LRName:=FM^.NetMailPath + 'LastRead';
  If ((UNum + 1) * SizeOf(LRec)) >
  SizeFile(LRName) Then
    GetLastRead := 0
  Else
    Begin
    If LoadFilePos(LRName, LRec, SizeOf(LRec),
    UNum * SizeOf(LRec)) = 0 Then
      GetLastRead := LRec
    Else
      GetLastRead := 0;
    End;
  End;


Procedure FidoMsgObj.SetLastRead(UNum: LongInt; LR: LongInt);
  Var
    LRec: Word;
    Status: Word;
    LRName: String;

  Begin
  LRName:=FM^.NetMailPath + 'LastRead';
  If ((UNum + 1) * SizeOf(LRec)) >
  SizeFile(LRName) Then
    Begin
    Status := ExtendFile(LRName, (UNum + 1) * SizeOf(LRec));
    End;
  If LoadFilePos(LRName, LRec, SizeOf(LRec),
  UNum * SizeOf(LRec)) = 0 Then
    Begin
    LRec := LR;
    Status := SaveFilePos(LRName, LRec, SizeOf(LRec),
    UNum * SizeOf(LRec));
    End else begin
       Status:=1;
    end;
    FM^.Error:=Status;
  End;


Function FidoMsgObj.GetTxtPos: LongInt;
  Begin
  GetTxtPos := FM^.TextCtr;
  End;


Procedure FidoMsgObj.SetTxtPos(TP: LongInt);
  Begin
  FM^.TextCtr := TP;
  End;


{$IFDEF VIRTUALPASCAL}
Function FidoMsgObj.MsgBaseExists: Boolean;
var
  SR   : VpSysLow.TOSSearchRec;
  Found: Boolean;

  PPath: PChar;
  Path : string;
  Begin
    Path:=FM^.NetMailPath+'.'#00; // Der Pfad endet nun mit "\." und ist auch 0-terminiert
    PPath:=@Path[1]; // Pointer richtig setzen - [0] = Laengenangabe
    Found:=(SysFindFirst(PPath, $1037, SR, true)=0); // $1000 = must be directory, $37 = alle Attribute
    SysFindClose(SR);
    MsgBaseExists := Found;
  End;
{$ELSE}
Function FidoMsgObj.MsgBaseExists: Boolean;
  Begin
  MsgBaseExists := FileExist(FM^.NetMailPath + 'Nul');
  End;
{$ENDIF}

Procedure FidoMsgObj.Rescan;
  Var
  {$IFDEF WINDOWS}
    SR: TSearchRec;
    TStr: Array[0..128] of Char;
  {$ELSE}
    SR: SearchRec;
  {$ENDIF}
  TmpName: String[13];
  TmpNum: Word;
  Code: Word;


  Begin
  FillChar(FM^.MsgPresent, SizeOf(FM^.MsgPresent), 0);
  {$IFDEF WINDOWS}
  StrPCopy(TStr, FM^.NetMailPath + '*.msg');
  FindFirst(TStr, faReadOnly + faArchive, SR);
  {$ELSE}
  FindFirst(FM^.NetMailPath + '*.msg', ReadOnly + Archive, SR);
  {$ENDIF}
  While DosError = 0 Do
    Begin
    {$IFDEF WINDOWS}
    TmpName :=  StrPas(SR.Name);
    {$ELSE}
    TmpName := SR.Name;
    {$ENDIF}
    Val(Copy(TmpName, 1,  Pos('.', TmpName) - 1), TmpNum, Code);
    If ((Code = 0) And (TmpNum > 0)) Then
      Begin
      If TmpNum <= MaxFidMsgNum Then
        Begin
        Code := TmpNum shr 3; {div by 8 to get byte position}
        FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[TmpNum and 7];
        End;
      End;
    FindNext(SR);
    End;
  {$IFDEF VirtualPascal}
  FindClose(SR);
  {$ENDIF}
  End;


Function FidoMsgObj.MsgExists(MsgNum: LongInt): Boolean;
  Var
    Code: LongInt;

  Begin
  If ((MsgNum > 0) and (MsgNum <= MaxFidMsgNum)) Then
    Begin
    Code := MsgNum shr 3;
    MsgExists := (FM^.MsgPresent[Code] and PosArray[MsgNum and 7]) <> 0;
    End
  Else
    MsgExists := False;
  End;

Procedure FidoMsgObj.SetFwd(St: Boolean);
  Begin
  If St Then
    PutByte(GetByte(186) or 032, 186)
  Else
    PutByte(GetByte(186) and (not 032), 186);
  End;

Function FidoMsgObj.IsFwd: Boolean;
  Begin
  IsFwd := ((GetByte(186) and 032) <> 0);
  End;

(* only stubs, because these functions have to be implemented by this object *)

Function FidoMsgObj.IsHold: Boolean;
  Begin
     IsHold := false;
  End;

Procedure FidoMsgObj.SetHold(ST : Boolean);
begin
end;

function FidoMsgObj.LockMsgBase: Boolean;
begin
   LockMsgBase:=true;
end;

function FidoMsgObj.UnLockMsgBase: Boolean;
begin
   UnLockMsgBase:=true;
end;

Procedure FidoMsgObj.SetEcho(ES :  Boolean);
begin
end;

End.