home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mksmvp10.zip / MKMSGFID.PAS < prev    next >
Pascal/Delphi Source File  |  1997-09-24  |  38KB  |  1,506 lines
  1. Unit MKMsgFid;       {Fido *.Msg Unit}
  2.  
  3. {$I MKB.Def}
  4.  
  5. {
  6.      MKMsgFid - Copyright 1993, 1994 by Mark May - MK Software
  7.      You are free to use this code in your programs, however
  8.      it may not be included in Source/TPU function libraries
  9.      without my permission.
  10.  
  11.      Mythical Kingom Tech BBS (513)237-7737 HST/v32
  12.      FidoNet: 1:110/290
  13.      Rime: ->MYTHKING
  14.      You may also reach me at maym@dmapub.dma.org
  15. }
  16.  
  17.  
  18. {
  19.      Now handles message size only limited by disk space and
  20.      the maximum size of a longint, while using only a small
  21.      buffer for low memory usage with reasonable speed
  22. }
  23.  
  24. Interface
  25.  
  26. Uses MKGlobT, MKMsgAbs, MKFFile, Use32,
  27. {$IFDEF WINDOWS}
  28.   Strings, WinDos;
  29. {$ELSE}
  30.   Dos;
  31. {$ENDIF}
  32.  
  33.  
  34. Const MaxFidMsgArray = 4000;
  35. Const MaxFidMsgNum = (MaxFidMsgArray * 8) - 1;
  36.  
  37. Type FMsgType = Record
  38.   MsgFile: FFileObj;
  39.   TextCtr: LongInt;
  40.   MsgName: String[13];
  41.   TmpName: String[130];
  42.   TmpOpen: Boolean;
  43.   MsgOpen: Boolean;
  44.   Error: Word;
  45.   NetMailPath: String[128];
  46.   Dest: AddrType;
  47.   Orig: AddrType;
  48.   MsgStart: LongInt;
  49.   MsgEnd: LongInt;
  50.   MsgSize: LongInt;
  51.   DefaultZone: Word;
  52.   QDate: String[8];
  53.   QTime: String[5];
  54.   MsgDone: Boolean;
  55.   CurrMsg: LongInt;
  56.   SeekOver: Boolean;
  57.   {$IFDEF WINDOWS}
  58.   SR: TSearchRec;
  59.   {$ELSE}
  60.   SR: SearchRec;
  61.   {$ENDIF}
  62.   Name: String[35];
  63.   Handle: String[35];
  64.   MailType: MsgMailType;
  65.   MsgPresent: Array[0..MaxFidMsgArray] of Byte;
  66.   End;
  67.  
  68.  
  69. Type FidoMsgObj = Object (AbsMsgObj)
  70.   FM: ^FMsgType;
  71.   Constructor Init;                      {Initialize FidoMsgOut}
  72.   Destructor Done; Virtual; {Done FidoMsgOut}
  73.   Procedure RemoveTmp; {remove temporary file}
  74.   Procedure PutLong(L: LongInt; Position: LongInt); {Put long into msg}
  75.   Procedure PutWord(W: SmallWord; Position: LongInt);  {Put word into msg}
  76.   Procedure PutByte(B: Byte; Position: LongInt);  {Put byte into msg}
  77.   Function  GetByte(Position: LongInt): Byte; {Get byte from msg}
  78.   Procedure PutNullStr(St: String; Position: LongInt);  {Put string & null into msg}
  79.   Procedure SetMsgPath(St: String); Virtual; {Set netmail path}
  80.   Function  GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area}
  81.   Procedure SetDest(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Dest}
  82.   Procedure SetOrig(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Orig}
  83.   Procedure SetFrom(Name: String); Virtual; {Set message from}
  84.   Procedure SetTo(Name: String); Virtual; {Set message to}
  85.   Procedure SetSubj(Str: String); Virtual; {Set message subject}
  86.   Procedure SetCost(SCost: Word); Virtual; {Set message cost}
  87.   Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference}
  88.   Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also}
  89.   Procedure SetDate(SDate: String); Virtual; {Set message date}
  90.   Procedure SetTime(STime: String); Virtual; {Set message time}
  91.   Procedure SetLocal(LS: Boolean); Virtual; {Set local status}
  92.   Procedure SetRcvd(RS: Boolean); Virtual; {Set received status}
  93.   Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status}
  94.   Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status}
  95.   Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status}
  96.   Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status}
  97.   Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status}
  98.   Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status}
  99.   Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status}
  100.   Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status}
  101.   Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status}
  102.   Procedure DoString(Str: String); Virtual; {Add string to message text}
  103.   Procedure DoChar(Ch: Char); Virtual; {Add character to message text}
  104.   Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text}
  105.   Function  WriteMsg: Word; Virtual;
  106.   Procedure SetDefaultZone(DZ: Word); Virtual; {Set default zone to use}
  107.   Procedure LineStart; Virtual; {Internal use to skip LF, ^A}
  108.   Function  GetChar: Char; Virtual;
  109.   Procedure CheckZone(ZoneStr: String); Virtual;
  110.   Procedure CheckPoint(PointStr: String); Virtual;
  111.   Procedure CheckLine(TStr: String); Virtual;
  112.   Function  CvtDate: Boolean; Virtual;
  113.   Function  BufferWord(i: Word):Word; Virtual;
  114.   Function  BufferByte(i: Word):Byte; Virtual;
  115.   Function  BufferNullString(i: Word; Max: Word): String; Virtual;
  116.   Procedure MsgStartUp; Virtual; {set up msg for reading}
  117.   Function  EOM: Boolean; Virtual; {No more msg text}
  118.   Function  GetString(MaxLen: Word): String; Virtual; {Get wordwrapped string}
  119.   Function  WasWrap: Boolean; Virtual; {Last line was soft wrapped no CR}
  120.   Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seek msg number}
  121.   Procedure SeekNext; Virtual; {Find next matching msg}
  122.   Procedure SeekPrior; Virtual; {Seek prior matching msg}
  123.   Function  GetFrom: String; Virtual; {Get from name on current msg}
  124.   Function  GetTo: String; Virtual; {Get to name on current msg}
  125.   Function  GetSubj: String; Virtual; {Get subject on current msg}
  126.   Function  GetCost: Word; Virtual; {Get cost of current msg}
  127.   Function  GetDate: String; Virtual; {Get date of current msg}
  128.   Function  GetTime: String; Virtual; {Get time of current msg}
  129.   Function  GetRefer: LongInt; Virtual; {Get reply to of current msg}
  130.   Function  GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
  131.   Function  GetMsgNum: LongInt; Virtual; {Get message number}
  132.   Procedure GetOrig(Var Addr: AddrType); Virtual; {Get origin address}
  133.   Procedure GetDest(Var Addr: AddrType); Virtual; {Get destination address}
  134.   Function  IsLocal: Boolean; Virtual; {Is current msg local}
  135.   Function  IsCrash: Boolean; Virtual; {Is current msg crash}
  136.   Function  IsKillSent: Boolean; Virtual; {Is current msg kill sent}
  137.   Function  IsSent: Boolean; Virtual; {Is current msg sent}
  138.   Function  IsFAttach: Boolean; Virtual; {Is current msg file attach}
  139.   Function  IsReqRct: Boolean; Virtual; {Is current msg request receipt}
  140.   Function  IsReqAud: Boolean; Virtual; {Is current msg request audit}
  141.   Function  IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
  142.   Function  IsFileReq: Boolean; Virtual; {Is current msg a file request}
  143.   Function  IsRcvd: Boolean; Virtual; {Is current msg received}
  144.   Function  IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
  145.   Function  IsDeleted: Boolean; Virtual; {Is current msg deleted}
  146.   Function  IsEchoed: Boolean; Virtual; {Msg should be echoed}
  147.   Function  GetMsgLoc: LongInt; Virtual; {Msg location}
  148.   Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location}
  149.   Procedure YoursFirst(Name: String; Handle: String); Virtual; {Seek your mail}
  150.   Procedure YoursNext; Virtual; {Seek next your mail}
  151.   Function  YoursFound: Boolean; Virtual; {Message found}
  152.   Procedure StartNewMsg; Virtual;
  153.   Function  OpenMsgBase: Word; Virtual;
  154.   Function  CloseMsgBase: Word; Virtual;
  155.   Function  CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;
  156.   Function  SeekFound: Boolean; Virtual;
  157.   Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
  158.   Function  GetSubArea: Word; Virtual; {Get sub area number}
  159.   Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
  160.   Procedure DeleteMsg; Virtual; {Delete current message}
  161.   Function  NumberOfMsgs: LongInt; Virtual; {Number of messages}
  162.   Function  GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num}
  163.   Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read}
  164.   Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks}
  165.   Function  GetTxtPos: LongInt; Virtual; {Get indicator of msg text position}
  166.   Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position}
  167.   Function  MsgBaseExists: Boolean; Virtual;
  168.   Procedure Rescan;
  169.   Function  MsgExists(MsgNum: LongInt): Boolean;
  170.   End;
  171.  
  172.  
  173. Type FidoMsgPtr = ^FidoMsgObj;
  174.  
  175. Function MonthStr(MoNo: Byte): String; {Return 3 char month name for month num}
  176. Function MonthNum(St: String):Word;
  177.  
  178.  
  179. Implementation
  180.  
  181. Uses MKFile, MKString, MKDos;
  182.  
  183.  
  184. Const
  185.   PosArray: Array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);
  186.  
  187.  
  188. Constructor FidoMsgObj.Init;
  189.   Begin
  190.   New(FM);
  191.   If FM = Nil Then
  192.     Begin
  193.     Fail;
  194.     Exit;
  195.     End;
  196.   FM^.NetMailPath := '';
  197.   FM^.TextCtr := 190;
  198.   FM^.Dest.Zone := 0;
  199.   FM^.Orig.Zone := 0;
  200.   FM^.SeekOver := False;
  201.   FM^.DefaultZone := 1;
  202.   FM^.MsgFile.Init(4000);
  203.   FM^.TmpOpen := False;
  204.   FM^.MsgOpen := False;
  205.   End;
  206.  
  207.  
  208. Destructor FidoMsgObj.Done;
  209.   Begin
  210.   If FM^.MsgOpen Then
  211.     If FM^.MsgFile.CloseFile Then;
  212.   If FM^.TmpOpen Then
  213.     Begin
  214.     RemoveTmp;
  215.     End;
  216.   FM^.MsgFile.Done;
  217.   Dispose(FM);
  218.   End;
  219.  
  220.  
  221. Procedure FidoMsgObj.RemoveTmp;
  222.   Var
  223.     TmpFile: File;
  224.  
  225.   Begin
  226.   If FM^.MsgFile.CloseFile Then;
  227.   Assign(TmpFile, FM^.TmpName);
  228.   Erase(TmpFile);
  229.   If IoResult <> 0 Then;
  230.   FM^.TmpOpen := False;
  231.   End;
  232.  
  233.  
  234. Procedure FidoMsgObj.PutLong(L: LongInt; Position: LongInt);
  235.   Var
  236.     i: Integer;
  237.  
  238.   Begin
  239.   If FM^.MsgFile.SeekFile(Position) Then
  240.     If FM^.MsgFile.BlkWrite(L, SizeOf(LongInt)) Then;
  241.   End;
  242.  
  243.  
  244. Procedure FidoMsgObj.PutWord(W: SmallWord; Position: LongInt);
  245.   Begin
  246.   If FM^.MsgFile.SeekFile(Position) Then
  247.     If FM^.MsgFile.BlkWrite(W, SizeOf(SmallWord)) Then;
  248.   End;
  249.  
  250.  
  251. Procedure FidoMsgObj.PutByte(B: Byte; Position: LongInt);
  252.   Begin
  253.   If FM^.MsgFile.SeekFile(Position) Then
  254.     If FM^.MsgFile.BlkWrite(B, SizeOf(Byte)) Then;
  255.   End;
  256.  
  257.  
  258. Function FidoMsgObj.GetByte(Position: LongInt): Byte;
  259.   Var
  260.     B: Byte;
  261.     NumRead: Word;
  262.  
  263.   Begin
  264.   If FM^.MsgFile.SeekFile(Position) Then
  265.     If FM^.MsgFile.BlkRead(B, SizeOf(Byte), NumRead) Then;
  266.   GetByte := b;
  267.   End;
  268.  
  269.  
  270. Procedure FidoMsgObj.PutNullStr(St: String; Position: LongInt);
  271.   Var
  272.     i: Byte;
  273.  
  274.   Begin
  275.   i := 0;
  276.   If FM^.MsgFile.SeekFile(Position) Then
  277.     Begin
  278.     If FM^.MsgFile.BlkWrite(St[1], Length(St)) Then;
  279.     If FM^.MsgFile.BlkWrite(i, 1) Then;
  280.     End;
  281.   End;
  282.  
  283.  
  284. Procedure FidoMsgObj.SetMsgPath(St: String);
  285.   Begin
  286.   FM^.NetMailPath := Copy(St, 1, 110);
  287.   AddBackSlash(FM^.NetMailPath);
  288.   End;
  289.  
  290.  
  291. Function FidoMsgObj.GetHighMsgNum: LongInt;
  292.   Var
  293.   Highest: LongInt;
  294.   Cnt: LongInt;
  295.  
  296.   Begin
  297.   Cnt := MaxFidMsgArray;
  298.   While (Cnt > 0) and (FM^.MsgPresent[Cnt] = 0) Do
  299.     Dec(Cnt);
  300.   If Cnt < 0 Then
  301.     Highest := 0
  302.   Else
  303.     Begin
  304.     Highest := Cnt * 8;
  305.     If (FM^.MsgPresent[Cnt] and $80) <> 0 Then
  306.       Inc(Highest, 7)
  307.     Else If (FM^.MsgPresent[Cnt] and $40) <> 0 Then
  308.       Inc(Highest, 6)
  309.     Else If (FM^.MsgPresent[Cnt] and $20) <> 0 Then
  310.       Inc(Highest, 5)
  311.     Else If (FM^.MsgPresent[Cnt] and $10) <> 0 Then
  312.       Inc(Highest, 4)
  313.     Else If (FM^.MsgPresent[Cnt] and $08) <> 0 Then
  314.       Inc(Highest, 3)
  315.     Else If (FM^.MsgPresent[Cnt] and $04) <> 0 Then
  316.       Inc(Highest, 2)
  317.     Else If (FM^.MsgPresent[Cnt] and $02) <> 0 Then
  318.       Inc(Highest, 1)
  319.     End;
  320.   GetHighMsgNum := Highest;
  321.   End;
  322.  
  323.  
  324. Function MonthStr(MoNo: Byte): String;
  325.   Begin
  326.   Case MoNo of
  327.     01: MonthStr := 'Jan';
  328.     02: MonthStr := 'Feb';
  329.     03: MonthStr := 'Mar';
  330.     04: MonthStr := 'Apr';
  331.     05: MonthStr := 'May';
  332.     06: MonthStr := 'Jun';
  333.     07: MonthStr := 'Jul';
  334.     08: MonthStr := 'Aug';
  335.     09: MonthStr := 'Sep';
  336.     10: MonthStr := 'Oct';
  337.     11: MonthStr := 'Nov';
  338.     12: MonthStr := 'Dec';
  339.     Else
  340.       MonthStr := '???';
  341.     End;
  342.   End;
  343.  
  344.  
  345. Procedure FidoMsgObj.SetDest(Var Addr: AddrType);
  346.   Var
  347.     TmpChr: Char;
  348.  
  349.   Begin
  350.   FM^.Dest := Addr;
  351.   PutWord(Addr.Net, 174);
  352.   PutWord(Addr.Node, 166);
  353.   If ((Addr.Point <> 0) and (FM^.MailType = mmtNetmail)) Then
  354.     Begin
  355.     If ((FM^.TextCtr <> 190) And
  356.     (GetByte(FM^.TextCtr - 1) <> 13)) Then
  357.       DoChar(#13);
  358.     DoStringLn(#1 + 'TOPT ' + Long2Str(Addr.Point));
  359.     End;
  360.   If ((FM^.Orig.Zone <> 0) and (FM^.MailTYpe = mmtNetMail)) Then
  361.     Begin
  362.     If ((FM^.TextCtr <> 190) And
  363.     (GetByte(FM^.TextCtr - 1) <> 13)) Then
  364.       DoChar(#13);
  365.     DoStringLn(#1 + 'INTL ' + PointlessAddrStr(FM^.Dest) + ' ' +
  366.       PointlessAddrStr(FM^.Orig));
  367.     End;
  368.   End;
  369.  
  370.  
  371. Procedure FidoMsgObj.SetOrig(Var Addr: AddrType);
  372.   Begin
  373.   FM^.Orig := Addr;
  374.   PutWord(Addr.Net, 172);
  375.   PutWord(Addr.Node, 168);
  376.   If ((Addr.Point <> 0) and (FM^.MailType = mmtNetmail)) Then
  377.     Begin
  378.     If ((FM^.TextCtr <> 190) And
  379.     (GetByte(FM^.TextCtr - 1) <> 13)) Then
  380.       DoChar(#13);
  381.     DoStringLn(#1 + 'FMPT ' + Long2Str(Addr.Point));
  382.     End;
  383.   If ((FM^.Dest.Zone <> 0) and (FM^.MailType = mmtNetmail)) Then
  384.     Begin
  385.     If ((FM^.TextCtr <> 190) And
  386.     (GetByte(FM^.TextCtr - 1) <> 13)) Then
  387.       DoChar(#13);
  388.     DoStringLn(#1 + 'INTL ' + PointlessAddrStr(FM^.Dest) + ' ' +
  389.       PointlessAddrStr(FM^.Orig));
  390.     End;
  391.   End;
  392.  
  393.  
  394. Procedure FidoMsgObj.SetFrom(Name: String);
  395.   Begin
  396.   PutNullStr(Copy(Name, 1, 35),0);
  397.   End;
  398.  
  399.  
  400. Procedure FidoMsgObj.SetTo(Name: String);
  401.   Begin
  402.   PutNullStr(Copy(Name, 1, 35), 36);
  403.   End;
  404.  
  405.  
  406. Procedure FidoMsgObj.SetSubj(Str: String);
  407.   Begin
  408.   PutNullStr(Copy(Str, 1, 71), 72);
  409.   End;
  410.  
  411.  
  412. Procedure FidoMsgObj.SetCost(SCost: Word);
  413.   Begin
  414.   PutWord(SCost, 170);
  415.   End;
  416.  
  417.  
  418. Procedure FidoMsgObj.SetRefer(SRefer: LongInt);
  419.   Begin
  420.   PutWord(SRefer, 184);
  421.   End;
  422.  
  423.  
  424. Procedure FidoMsgObj.SetSeeAlso(SAlso: LongInt);
  425.   Begin
  426.   PutWord(SAlso, 188);
  427.   End;
  428.  
  429.  
  430. Procedure FidoMsgObj.SetDate(SDate: String);
  431.   Var
  432.     TempNum: Word;
  433.     Code: Word;
  434.     TmpStr: String[20];
  435.  
  436.   Begin
  437.   FM^.QDate := Copy(SDate,1,8);
  438.   Val(Copy(SDate,1,2),TempNum, Code);
  439.   TmpStr := Copy(SDate,4,2) + ' ' + MonthStr(TempNum) + ' ' +
  440.     Copy(SDate,7,2) + '  ';
  441.   For TempNum := 1 to 11 Do
  442.     PutByte(Ord(TmpStr[TempNum]), TempNum + 143);
  443.   End;
  444.  
  445.  
  446. Procedure FidoMsgObj.SetTime(STime: String);
  447.   Begin
  448.   FM^.QTime := Copy(STime,1,5);
  449.   PutNullStr(Copy(STime + ':00', 1, 8), 155);
  450.   End;
  451.  
  452.  
  453. Procedure FidoMsgObj.SetLocal(LS: Boolean);
  454.   Begin
  455.   If LS Then
  456.     PutByte(GetByte(187) or 1, 187)
  457.   Else
  458.     PutByte(GetByte(187) and (Not 1), 187);
  459.   End;
  460.  
  461.  
  462. Procedure FidoMsgObj.SetRcvd(RS: Boolean);
  463.   Begin
  464.   If RS Then
  465.     PutByte(GetByte(186) or 4, 186)
  466.   Else
  467.     PutByte(GetByte(186) and (not 4), 186);
  468.   End;
  469.  
  470.  
  471. Procedure FidoMsgObj.SetPriv(PS: Boolean);
  472.   Begin
  473.   If PS Then
  474.     PutByte(GetByte(186) or 1, 186)
  475.   Else
  476.     PutByte(GetByte(186) and (not 1), 186);
  477.   End;
  478.  
  479.  
  480. Procedure FidoMsgObj.SetCrash(SS: Boolean);
  481.   Begin
  482.   If SS Then
  483.     PutByte(GetByte(186) or 2, 186)
  484.   Else
  485.     PutByte(GetByte(186) and (not 2), 186);
  486.   End;
  487.  
  488.  
  489. Procedure FidoMsgObj.SetKillSent(SS: Boolean);
  490.   Begin
  491.   If SS Then
  492.     PutByte(GetByte(186) or 128, 186)
  493.   Else
  494.     PutByte(GetByte(186) and (Not 128), 186);
  495.   End;
  496.  
  497.  
  498. Procedure FidoMsgObj.SetSent(SS: Boolean);
  499.   Begin
  500.   If SS Then
  501.     PutByte(GetByte(186) or 8, 186)
  502.   Else
  503.     PutByte(GetByte(186) and (not 8), 186);
  504.   End;
  505.  
  506.  
  507. Procedure FidoMsgObj.SetFAttach(SS: Boolean);
  508.   Begin
  509.   If SS Then
  510.     PutByte(GetByte(186) or 16, 186)
  511.   Else
  512.     PutByte(GetByte(186) and (not 16), 186);
  513.   End;
  514.  
  515.  
  516. Procedure FidoMsgObj.SetReqRct(SS: Boolean);
  517.   Begin
  518.   If SS Then
  519.     PutByte(GetByte(187) or 16, 187)
  520.   Else
  521.     PutByte(GetByte(187) and (not 16), 187);
  522.   End;
  523.  
  524.  
  525. Procedure FidoMsgObj.SetReqAud(SS: Boolean);
  526.   Begin
  527.   If SS Then
  528.     PutByte(GetByte(187) or 64, 187)
  529.   Else
  530.     PutByte(GetByte(187) and (not 64), 187);
  531.   End;
  532.  
  533.  
  534. Procedure FidoMsgObj.SetRetRct(SS: Boolean);
  535.   Begin
  536.   If SS Then
  537.     PutByte(GetByte(187) or 32, 187)
  538.   Else
  539.     PutByte(GetByte(187) and (not 32), 187);
  540.   End;
  541.  
  542.  
  543. Procedure FidoMsgObj.SetFileReq(SS: Boolean);
  544.   Begin
  545.   If SS Then
  546.     PutByte(GetByte(187) or 8, 187)
  547.   Else
  548.     PutByte(GetByte(187) and (not 8), 187);
  549.   End;
  550.  
  551.  
  552. Procedure FidoMsgObj.DoString(Str: String);
  553.   Var
  554.     i: Word;
  555.  
  556.   Begin
  557.   i := 1;
  558.   While i <= Length(Str) Do
  559.     Begin
  560.     DoChar(Str[i]);
  561.     Inc(i);
  562.     End;
  563.   End;
  564.  
  565.  
  566. Procedure FidoMsgObj.DoChar(Ch: Char);
  567.   Begin
  568.   PutByte(Ord(Ch), FM^.TextCtr);
  569.   Inc(FM^.TextCtr);
  570.   End;
  571.  
  572.  
  573. Procedure FidoMsgObj.DoStringLn(Str: String);
  574.   Begin
  575.   DoString(Str);
  576.   DoChar(#13);
  577.   End;
  578.  
  579.  
  580. Function  FidoMsgObj.WriteMsg: Word;
  581.   Var
  582.     NetNum: Word;
  583.     TmpDate: LongInt;
  584.     {$IFDEF WINDOWS}
  585.     TmpDT: TDateTime;
  586.     {$ELSE}
  587.     TmpDT: DateTime;
  588.     {$ENDIF}
  589.     TmpFile: File;
  590.     Code: LongInt;
  591.  
  592.   Begin
  593.   DoChar(#0);
  594.   PutLong(GetDosDate, 180);
  595.   TmpDT.Year := Str2Long(Copy(FM^.QDate,7,2));
  596.   If TmpDT.Year > 79 Then
  597.     Inc(TmpDT.Year, 1900)
  598.   Else
  599.     Inc(TmpDT.Year, 2000);
  600.   TmpDT.Month := Str2Long(Copy(FM^.QDate,1,2));
  601.   TmpDT.Day := Str2Long(Copy(FM^.QDate,4,2));
  602.   TmpDt.Hour := Str2Long(Copy(FM^.QTime,1,2));
  603.   TmpDt.Min := Str2Long(Copy(FM^.QTime, 4,2));
  604.   TmpDt.Sec := 0;
  605.   PackTime(TmpDT, TmpDate);
  606.   PutLong(TmpDate, 176);
  607.   NetNum := GetHighMsgNum + 1;
  608.   If FileExist(FM^.NetMailPath + Long2Str(NetNum) + '.Msg') Then
  609.     Begin
  610.     Rescan;
  611.     NetNum := GetHighMsgNum + 1;
  612.     End;
  613.   Code := NetNum shr 3; {div by 8 to get byte position}
  614.   FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[NetNum and 7];
  615.   If FM^.TmpOpen Then
  616.     Begin
  617.     If FM^.MsgFile.CloseFile Then
  618.       Begin
  619.       Assign(TmpFile, FM^.TmpName);
  620.       Rename(TmpFile, FM^.NetMailPath + Long2Str(NetNum) + '.Msg')
  621.       End;
  622.     End;
  623.   WriteMsg := IoResult;
  624.   FM^.CurrMsg := NetNum;
  625.   End;
  626.  
  627.  
  628. Procedure FidoMsgObj.SetDefaultZone(DZ: Word); {Set default zone to use}
  629.   Begin
  630.   FM^.DefaultZone := DZ;
  631.   End;
  632.  
  633.  
  634. Procedure FidoMsgObj.LineStart;
  635.   Begin
  636.   If GetByte(FM^.TextCtr) = 10 Then
  637.     Inc(FM^.TextCtr);
  638.   If GetByte(FM^.TextCtr) = 1 Then
  639.     Inc(FM^.TextCtr);
  640.   End;
  641.  
  642.  
  643. Function FidoMsgObj.GetChar: Char;
  644.   Begin
  645.   If ((FM^.TextCtr >= FM^.MsgSize) Or (GetByte(FM^.TextCtr) = 0)) Then
  646.     Begin
  647.     GetChar := #0;
  648.     FM^.MsgDone := True;
  649.     End
  650.   Else
  651.     Begin
  652.     GetChar := Chr(GetByte(FM^.TextCtr));
  653.     Inc(FM^.TextCtr);
  654.     End;
  655.   End;
  656.  
  657.  
  658. Procedure FidoMsgObj.CheckZone(ZoneStr: String);
  659.   Var
  660.     DestZoneStr: String;
  661.     Code: Word;
  662.  
  663.   Begin
  664.   If (Upper(Copy(ZoneStr,1,4)) = 'INTL') Then
  665.     Begin
  666.     DestZoneStr := ExtractWord(ZoneStr, 2);
  667.     DestZoneStr := StripBoth(DestZoneStr, ' ');
  668.     DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
  669.     Val(DestZoneStr, FM^.Dest.Zone, Code);
  670.     DestZoneStr := ExtractWord(ZoneStr,3);
  671.     DestZoneStr := StripBoth(DestZoneStr, ' ');
  672.     DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
  673.     Val(DestZoneStr, FM^.Orig.Zone, Code);
  674.     End;
  675.   End;
  676.  
  677.  
  678. Procedure FidoMsgObj.CheckPoint(PointStr: String);
  679.   Var
  680.     DestPointStr: String;
  681.     Code: Word;
  682.     Temp: Word;
  683.  
  684.   Begin
  685.   If (Upper(Copy(PointStr,1,4)) = 'TOPT') Then
  686.     Begin
  687.     DestPointStr := ExtractWord(PointStr, 2);
  688.     DestPointStr := StripBoth(DestPointStr, ' ');
  689.     Val(DestPointStr, Temp, Code);
  690.     If Code = 0 Then
  691.       FM^.Dest.Point := Temp;
  692.     End;
  693.   If (Upper(Copy(PointStr,1,4)) = 'FMPT') Then
  694.     Begin
  695.     DestPointStr := ExtractWord(PointStr, 2);
  696.     DestPointStr := StripBoth(DestPointStr, ' ');
  697.     Val(DestPointStr, Temp, Code);
  698.     If Code = 0 Then
  699.       FM^.Orig.Point := Temp;
  700.     End;
  701.   End;
  702.  
  703.  
  704. Function MonthNum(St: String):Word;
  705.   Begin
  706.   ST := Upper(St);
  707.   MonthNum := 0;
  708.   If St = 'JAN' Then MonthNum := 01;
  709.   If St = 'FEB' Then MonthNum := 02;
  710.   If St = 'MAR' Then MonthNum := 03;
  711.   If St = 'APR' Then MonthNum := 04;
  712.   If St = 'MAY' Then MonthNum := 05;
  713.   If St = 'JUN' Then MonthNum := 06;
  714.   If St = 'JUL' Then MonthNum := 07;
  715.   If St = 'AUG' Then MonthNum := 08;
  716.   If St = 'SEP' Then MonthNum := 09;
  717.   If St = 'OCT' Then MonthNum := 10;
  718.   If St = 'NOV' Then MonthNum := 11;
  719.   If St = 'DEC' Then MonthNum := 12;
  720.   End;
  721.  
  722.  
  723. Function FidoMsgObj.CvtDate: Boolean;
  724.   Var
  725.     MoNo: Word;
  726.     TmpStr: String;
  727.     i: Word;
  728.     MsgDt: String[25];
  729.  
  730.   Begin
  731.   MsgDt := BufferNullString(144, 20);
  732.   MsgDt := PadRight(MsgDt,' ', 20);
  733.   CvtDate := True;
  734.   If MsgDt[3] = ' ' Then
  735.     Begin {Fido or Opus}
  736.     If MsgDt[11] = ' ' Then
  737.       Begin {Fido DD MON YY  HH:MM:SSZ}
  738.       FM^.QTime := Copy (MsgDT,12,5);
  739.       TmpStr := Long2Str(MonthNum(Copy(MsgDt,4,3)));
  740.       If Length(TmpStr) = 1 Then
  741.         TmpStr := '0' + TmpStr;
  742.       FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
  743.       End
  744.     Else
  745.       Begin {Opus DD MON YY HH:MM:SS}
  746.       FM^.QTime := Copy(MsgDT,11,5);
  747.       TmpStr := Long2Str(MonthNum(Copy(MsgDt,4,3)));
  748.       If Length(TmpStr) = 1 Then
  749.         TmpStr := '0' + TmpStr;
  750.       FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
  751.       End;
  752.     End
  753.   Else
  754.     Begin
  755.     If MsgDT[4] = ' ' Then
  756.       Begin {SeaDog format DOW DD MON YY HH:MM}
  757.       FM^.QTime := Copy(MsgDT,15,5);
  758.       TmpStr := Long2Str(MonthNum(Copy(MsgDT,8,3)));
  759.       If Length(TmpStr) = 1 Then
  760.         TmpStr := '0' + TmpStr;
  761.       FM^.QDate := TmpStr + '-' + Copy(MsgDT,5,2) + '-' + Copy (MsgDt,12,2);
  762.       End
  763.     Else
  764.       Begin
  765.       If MsgDT[3] = '-' Then
  766.         Begin {Wierd format DD-MM-YYYY HH:MM:SS}
  767.         FM^.QTime := Copy(MsgDt,12,5);
  768.         FM^.QDate := Copy(MsgDt,4,3) + Copy (MsgDt,1,3) + Copy (MsgDt,9,2);
  769.         End
  770.       Else
  771.         Begin  {Bad Date}
  772.         CvtDate := False;
  773.         End;
  774.       End;
  775.     End;
  776.   For i := 1 to 5 Do
  777.     If FM^.QTime[i] = ' ' Then
  778.       FM^.QTime[i] := '0';
  779.   For i := 1 to 8 Do
  780.     If FM^.QDate[i] = ' ' Then
  781.       FM^.QDate[i] := '0';
  782.   If Length(FM^.QDate) <> 8 Then
  783.     CvtDate := False;
  784.   If Length(FM^.QTime) <> 5 Then
  785.     CvtDate := False;
  786.   End;
  787.  
  788.  
  789. Function FidoMsgObj.BufferWord(i: Word):Word;
  790.   Begin
  791.   BufferWord := BufferByte(i) + (BufferByte(i + 1) shl 8);
  792.   End;
  793.  
  794.  
  795. Function FidoMsgObj.BufferByte(i: Word):Byte;
  796.   Begin
  797.   BufferByte := GetByte(i);
  798.   End;
  799.  
  800.  
  801. Function FidoMsgObj.BufferNullString(i: Word; Max: Word): String;
  802.   Var
  803.     Ctr: Word;
  804.     CurrPos: Word;
  805.  
  806.   Begin
  807.   BufferNullString := '';
  808.   Ctr := i;
  809.   CurrPos := 0;
  810.   While ((CurrPos < Max) and (GetByte(Ctr) <> 0)) Do
  811.     Begin
  812.     Inc(CurrPos);
  813.     BufferNullString[CurrPos] := Chr(GetByte(Ctr));
  814.     Inc(Ctr);
  815.     End;
  816.   BufferNullString[0] := Chr(CurrPos);
  817.   End;
  818.  
  819.  
  820. Procedure FidoMsgObj.CheckLine(TStr: String);
  821.   Begin
  822.   If TStr[1] = #10 Then
  823.     TStr := Copy(TStr,2,255);
  824.   If TStr[1] = #01 Then
  825.     TStr := Copy(TStr,2,255);
  826.   CheckZone(TStr);
  827.   CheckPoint(TStr);
  828.   End;
  829.  
  830.  
  831. Procedure FidoMsgObj.MsgStartUp;
  832.   Var
  833.     TStr: String;
  834.     TmpChr: Char;
  835.     NumRead: Word;
  836.  
  837.   Begin
  838.   If FM^.MsgOpen Then
  839.     If FM^.MsgFile.CloseFile Then
  840.       FM^.MsgOpen := False;
  841.   If FM^.TmpOpen Then
  842.     RemoveTmp;
  843.   LastSoft := False;
  844.   If FileExist (FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.MSG') Then
  845.     FM^.Error := 0
  846.   Else
  847.     FM^.Error := 200;
  848.   If FM^.Error = 0 Then
  849.     Begin
  850.     If Not FM^.MsgFile.OpenFile(FM^.NetMailPath + Long2Str(FM^.CurrMsg) +
  851.     '.Msg',  fmReadWrite + fmDenyNone) Then FM^.Error := 1000;
  852.     End;
  853.   If FM^.Error = 0 Then
  854.     FM^.MsgOpen := True;
  855.   FM^.MsgDone := False;
  856.   FM^.MsgSize := FM^.MsgFile.RawSize;
  857.   FM^.MsgEnd := 0;
  858.   FM^.MsgStart := 190;
  859.   FM^.Dest.Zone := FM^.DefaultZone;
  860.   FM^.Dest.Point := 0;
  861.   FM^.Orig.Zone := FM^.DefaultZone;
  862.   FM^.Orig.Point := 0;
  863.   FM^.Orig.Net := BufferWord(172);
  864.   FM^.Orig.Node := BufferWord(168);
  865.   FM^.Dest.Net := BufferWord(174);
  866.   FM^.Dest.Node := BufferWord(166);
  867.   FM^.TextCtr := FM^.MsgStart;
  868.   If FM^.Error = 0 Then
  869.     Begin
  870.     If Not CvtDate Then
  871.       Begin
  872.       FM^.QDate := '09-06-89';
  873.       FM^.QTime := '19:76';
  874.       End;
  875.     TStr := GetString(128);
  876.     CheckLine(TStr);
  877.     If FM^.MsgFile.SeekFile(FM^.TextCtr) Then
  878.       If FM^.MsgFile.BlkRead(TmpChr, 1, NumRead) Then;
  879.     While ((FM^.MsgEnd = 0) and (FM^.TextCtr <= FM^.MsgSize)) Do
  880.       Begin
  881.       Case TmpChr Of
  882.         #0: FM^.MsgEnd := FM^.TextCtr;
  883.         #13: Begin
  884.           Inc(FM^.TextCtr);
  885.           TStr := GetString(128);
  886.           CheckLine(TStr);
  887.           If Length(TStr) > 0 Then
  888.             Dec(FM^.TextCtr);
  889.           End;
  890.         Else
  891.           Begin
  892.           Inc(FM^.TextCtr);
  893.           If FM^.MsgFile.BlkRead(TmpChr, 1, NumRead) Then;
  894.           End;
  895.         End;
  896.       End;
  897.     If FM^.MsgEnd = 0 Then
  898.       FM^.MsgEnd := FM^.MsgSize;
  899.     FM^.MsgSize := FM^.MsgEnd;
  900.     FM^.MsgStart := 190;
  901.     FM^.TextCtr := FM^.MsgStart;
  902.     FM^.MsgDone := False;
  903.     LastSoft := False;
  904.     End;
  905.   End;
  906.  
  907.  
  908. Procedure FidoMsgObj.MsgTxtStartUp;
  909.   Begin
  910.   FM^.MsgStart := 190;
  911.   FM^.TextCtr := FM^.MsgStart;
  912.   FM^.MsgDone := False;
  913.   LastSoft := False;
  914.   End;
  915.  
  916.  
  917. Function FidoMsgObj.GetString(MaxLen: Word): String;
  918.   Var
  919.     WPos: LongInt;
  920.     WLen: Byte;
  921.     StrDone: Boolean;
  922.     TxtOver: Boolean;
  923.     StartSoft: Boolean;
  924.     CurrLen: LongInt;
  925.     PPos: LongInt;
  926.     TmpCh: Char;
  927.     TmpStr: String;
  928.     NumRead: Word;
  929.     StrCtr: LongInt;
  930.  
  931.   Begin
  932.   If MaxLen > 254 Then
  933.     MaxLen := 254;
  934.   StrDone := False;
  935.   CurrLen := 0;
  936.   PPos := FM^.TextCtr;
  937.   WPos := 0;
  938.   WLen := 0;
  939.   StartSoft := LastSoft;
  940.   LastSoft := True;
  941.   If (FM^.TextCtr >= FM^.MsgSize) Then
  942.     Begin
  943.     TmpStr := #0;
  944.     TmpCh := #0;
  945.     FM^.MsgDone := True;
  946.     End
  947.   Else
  948.     Begin
  949.     If FM^.MsgFile.SeekFile(FM^.TextCtr) Then
  950.       If FM^.MsgFile.BlkRead(TmpStr[1], 255, NumRead) Then;
  951.     TmpStr[0] := Chr(NumRead);
  952.     TmpCh := TmpStr[1];
  953.     End;
  954.   StrCtr := 1;
  955.   { **1 TmpCh := GetChar; }
  956.   While ((Not StrDone) And (CurrLen < MaxLen) And (Not FM^.MsgDone)) Do
  957.     Begin
  958.     Case TmpCh of
  959.       #$00:;
  960.       #$0d: Begin
  961.             StrDone := True;
  962.             LastSoft := False;
  963.             End;
  964.       #$8d:;
  965.       #$0a:;
  966.       #$20: Begin
  967.             If ((CurrLen <> 0) or (Not StartSoft)) Then
  968.               Begin
  969.               Inc(CurrLen);
  970.               WLen := CurrLen;
  971.               GetString[CurrLen] := TmpCh;
  972.               WPos := FM^.TextCtr + StrCtr;
  973.               End
  974.             Else
  975.               StartSoft := False;
  976.             End;
  977.       Else
  978.         Begin
  979.         Inc(CurrLen);
  980.         GetString[CurrLen] := TmpCh;
  981.         End;
  982.       End;
  983.     If Not StrDone Then
  984.       Begin
  985.       Inc(StrCtr);
  986.       TmpCh := TmpStr[StrCtr];
  987.       If StrCtr > Length(TmpStr) Then
  988.         Begin
  989.         TmpCh := #0;
  990.         StrDone := True;
  991.         End
  992.       {** 1 TmpCh := GetChar;}
  993.       End;
  994.     End;
  995.   FM^.TextCtr := FM^.TextCtr + StrCtr;
  996.   If StrDone Then
  997.     Begin
  998.     GetString[0] := Chr(CurrLen);
  999.     End
  1000.   Else
  1001.     If FM^.MsgDone Then
  1002.       Begin
  1003.       GetString[0] := Chr(CurrLen);
  1004.       End
  1005.     Else
  1006.       Begin
  1007.       If WLen = 0 Then
  1008.         Begin
  1009.         GetString[0] := Chr(CurrLen);
  1010.         Dec(FM^.TextCtr);
  1011.         End
  1012.       Else
  1013.         Begin
  1014.         GetString[0] := Chr(WLen);
  1015.         FM^.TextCtr := WPos;
  1016.         End;
  1017.       End;
  1018.   End;
  1019.  
  1020.  
  1021. Function FidoMsgObj.EOM: Boolean;
  1022.   Begin
  1023.   EOM := FM^.MsgDone;
  1024.   End;
  1025.  
  1026.  
  1027. Function FidoMsgObj.WasWrap: Boolean;
  1028.   Begin
  1029.   WasWrap := LastSoft;
  1030.   End;
  1031.  
  1032.  
  1033. Function FidoMsgObj.GetFrom: String; {Get from name on current msg}
  1034.   Begin
  1035.   GetFrom := BufferNullString(0, 35);
  1036.   End;
  1037.  
  1038.  
  1039. Function FidoMsgObj.GetTo: String; {Get to name on current msg}
  1040.   Begin
  1041.   GetTo := BufferNullString(36,35);
  1042.   End;
  1043.  
  1044.  
  1045. Function FidoMsgObj.GetSubj: String; {Get subject on current msg}
  1046.   Begin
  1047.   GetSubj := BufferNullString(72,71);
  1048.   End;
  1049.  
  1050.  
  1051. Function FidoMsgObj.GetCost: Word; {Get cost of current msg}
  1052.   Begin
  1053.   GetCost := BufferWord(170);
  1054.   End;
  1055.  
  1056.  
  1057. Function FidoMsgObj.GetDate: String; {Get date of current msg}
  1058.   Begin
  1059.   GetDate := FM^.QDate;
  1060.   End;
  1061.  
  1062.  
  1063. Function FidoMsgObj.GetTime: String; {Get time of current msg}
  1064.   Begin
  1065.   GetTime := FM^.QTime;
  1066.   End;
  1067.  
  1068.  
  1069. Function FidoMsgObj.GetRefer: LongInt; {Get reply to of current msg}
  1070.   Begin
  1071.   GetRefer := BufferWord(184);
  1072.   End;
  1073.  
  1074.  
  1075. Function FidoMsgObj.GetSeeAlso: LongInt; {Get see also of current msg}
  1076.   Begin
  1077.   GetSeeAlso := BufferWord(188);
  1078.   End;
  1079.  
  1080.  
  1081. Function FidoMsgObj.GetMsgNum: LongInt; {Get message number}
  1082.   Begin
  1083.   GetMsgNum := FM^.CurrMsg;
  1084.   End;
  1085.  
  1086.  
  1087. Procedure FidoMsgObj.GetOrig(Var Addr: AddrType); {Get origin address}
  1088.   Begin
  1089.   Addr := FM^.Orig;
  1090.   End;
  1091.  
  1092.  
  1093. Procedure FidoMsgObj.GetDest(Var Addr: AddrType); {Get destination address}
  1094.   Begin
  1095.   Addr := FM^.Dest;
  1096.   End;
  1097.  
  1098.  
  1099. Function FidoMsgObj.IsLocal: Boolean; {Is current msg local}
  1100.   Begin
  1101.   IsLocal := ((GetByte(187) and 001) <> 0);
  1102.   End;
  1103.  
  1104.  
  1105. Function FidoMsgObj.IsCrash: Boolean; {Is current msg crash}
  1106.   Begin
  1107.   IsCrash := ((GetByte(186) and 002) <> 0);
  1108.   End;
  1109.  
  1110.  
  1111. Function FidoMsgObj.IsKillSent: Boolean; {Is current msg kill sent}
  1112.   Begin
  1113.   IsKillSent := ((GetByte(186) and 128) <> 0);
  1114.   End;
  1115.  
  1116.  
  1117. Function FidoMsgObj.IsSent: Boolean; {Is current msg sent}
  1118.   Begin
  1119.   IsSent := ((GetByte(186) and 008) <> 0);
  1120.   End;
  1121.  
  1122.  
  1123. Function FidoMsgObj.IsFAttach: Boolean; {Is current msg file attach}
  1124.   Begin
  1125.   IsFAttach := ((GetByte(186) and 016) <> 0);
  1126.   End;
  1127.  
  1128.  
  1129. Function FidoMsgObj.IsReqRct: Boolean; {Is current msg request receipt}
  1130.   Begin
  1131.   IsReqRct := ((GetByte(187) and 016) <> 0);
  1132.   End;
  1133.  
  1134.  
  1135. Function FidoMsgObj.IsReqAud: Boolean; {Is current msg request audit}
  1136.   Begin
  1137.   IsReqAud := ((GetByte(187) and 064) <> 0);
  1138.   End;
  1139.  
  1140.  
  1141. Function FidoMsgObj.IsRetRct: Boolean; {Is current msg a return receipt}
  1142.   Begin
  1143.   IsRetRct := ((GetByte(187) and 032) <> 0);
  1144.   End;
  1145.  
  1146.  
  1147. Function FidoMsgObj.IsFileReq: Boolean; {Is current msg a file request}
  1148.   Begin
  1149.   IsFileReq := ((GetByte(187) and 008) <> 0);
  1150.   End;
  1151.  
  1152.  
  1153. Function FidoMsgObj.IsRcvd: Boolean; {Is current msg received}
  1154.   Begin
  1155.   IsRcvd := ((GetByte(186) and 004) <> 0);
  1156.   End;
  1157.  
  1158.  
  1159. Function FidoMsgObj.IsPriv: Boolean; {Is current msg priviledged/private}
  1160.   Begin
  1161.   IsPriv := ((GetByte(186) and 001) <> 0);
  1162.   End;
  1163.  
  1164.  
  1165. Function FidoMsgObj.IsDeleted: Boolean; {Is current msg deleted}
  1166.   Begin
  1167.   IsDeleted := Not FileExist (FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.MSG');
  1168.   End;
  1169.  
  1170.  
  1171. Function FidoMsgObj.IsEchoed: Boolean; {Is current msg echoed}
  1172.   Begin
  1173.   IsEchoed := True;
  1174.   End;
  1175.  
  1176.  
  1177. Procedure FidoMsgObj.SeekFirst(MsgNum: LongInt); {Start msg seek}
  1178.   Begin
  1179.   FM^.CurrMsg := MsgNum - 1;
  1180.   SeekNext;
  1181.   End;
  1182.  
  1183.  
  1184. Procedure FidoMsgObj.SeekNext; {Find next matching msg}
  1185.   Begin
  1186.   Inc(FM^.CurrMsg);
  1187.   While ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg <= MaxFidMsgNum)) Do
  1188.     Inc(FM^.CurrMsg);
  1189.   If Not MsgExists(FM^.CurrMsg) Then
  1190.     FM^.CurrMsg := 0;
  1191.   End;
  1192.  
  1193.  
  1194. Procedure FidoMsgObj.SeekPrior;
  1195.   Begin
  1196.   Dec(FM^.CurrMsg);
  1197.   While ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg > 0)) Do
  1198.     Dec(FM^.CurrMsg);
  1199.   End;
  1200.  
  1201.  
  1202. Function FidoMsgObj.SeekFound: Boolean;
  1203.   Begin
  1204.   SeekFound := FM^.CurrMsg <> 0;
  1205.   End;
  1206.  
  1207.  
  1208. Function FidoMsgObj.GetMsgLoc: LongInt; {Msg location}
  1209.   Begin
  1210.   GetMsgLoc := GetMsgNum;
  1211.   End;
  1212.  
  1213.  
  1214. Procedure FidoMsgObj.SetMsgLoc(ML: LongInt); {Msg location}
  1215.   Begin
  1216.   FM^.CurrMsg := ML;
  1217.   End;
  1218.  
  1219.  
  1220. Procedure FidoMsgObj.YoursFirst(Name: String; Handle: String);
  1221.   Begin
  1222.   FM^.Name := Upper(Name);
  1223.   FM^.Handle := Upper(Handle);
  1224.   FM^.CurrMsg := 0;
  1225.   YoursNext;
  1226.   End;
  1227.  
  1228.  
  1229. Procedure FidoMsgObj.YoursNext;
  1230.   Var
  1231.     FoundDone: Boolean;
  1232.  
  1233.   Begin
  1234.   FoundDone := False;
  1235.   SeekFirst(FM^.CurrMsg + 1);
  1236.   While ((FM^.CurrMsg <> 0) And (Not FoundDone)) Do
  1237.     Begin
  1238.     MsgStartUp;
  1239.     If ((Upper(GetTo) = FM^.Name) Or (Upper(GetTo) = FM^.Handle)) Then
  1240.       FoundDone := True;
  1241.     If IsRcvd Then FoundDone := False;
  1242.     If Not FoundDone Then
  1243.       SeekNext;
  1244.     If Not SeekFound Then
  1245.       FoundDone := True;
  1246.     End;
  1247.   End;
  1248.  
  1249.  
  1250. Function FidoMsgObj.YoursFound: Boolean;
  1251.   Begin
  1252.   YoursFound := SeekFound;
  1253.   End;
  1254.  
  1255.  
  1256. Procedure FidoMsgObj.StartNewMsg;
  1257.   Var
  1258.     Tmp: Array[0..189] of Char;
  1259.  
  1260.   Begin
  1261.   FM^.Error := 0;
  1262.   FM^.TextCtr := 190;
  1263.   FM^.Dest.Zone := 0;
  1264.   FM^.Orig.Zone := 0;
  1265.   FM^.Dest.Point := 0;
  1266.   FM^.Orig.Point := 0;
  1267.   If FM^.TmpOpen Then
  1268.     RemoveTmp
  1269.   Else
  1270.     Begin
  1271.     If FM^.MsgOpen Then
  1272.       Begin
  1273.       If FM^.MsgFile.CloseFile Then
  1274.         FM^.MsgOpen := False;
  1275.       End;
  1276.     End;
  1277.   FM^.TmpName := GetTempName(FM^.NetMailPath);
  1278.   If Length(FM^.TmpName) > 0 Then
  1279.     Begin
  1280.     If FM^.MsgFile.OpenFile(FM^.TmpName, fmReadWrite + fmDenyNone) Then
  1281.       Begin
  1282.       FM^.TmpOpen := True;
  1283.       End
  1284.     Else
  1285.       FM^.Error := 1002;
  1286.     End
  1287.   Else
  1288.     FM^.Error := 1001;
  1289.   FillChar(Tmp, SizeOf(Tmp), #0);
  1290.   If FM^.MsgFile.SeekFile(0) Then;
  1291.   If FM^.MsgFile.BlkWrite(Tmp, SizeOf(Tmp)) Then;
  1292.   End;
  1293.  
  1294.  
  1295. Function FidoMsgObj.OpenMsgBase: Word;
  1296.   Begin
  1297.   Rescan;
  1298.   If MsgBaseExists Then
  1299.     OpenMsgBase := 0
  1300.   Else
  1301.     OpenMsgBase := 500;
  1302.   End;
  1303.  
  1304.  
  1305. Function FidoMsgObj.CloseMsgBase: Word;
  1306.   Begin
  1307.   CloseMsgBase := 0;
  1308.   End;
  1309.  
  1310.  
  1311. Function FidoMsgObj.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
  1312.   Begin
  1313.   If MakePath(FM^.NetMailPath) Then
  1314.     CreateMsgBase := 0
  1315.   Else
  1316.     CreateMsgBase := 1;
  1317.   End;
  1318.  
  1319.  
  1320. Procedure FidoMsgObj.SetMailType(MT: MsgMailType);
  1321.   Begin
  1322.   FM^.MailType := Mt;
  1323.   End;
  1324.  
  1325.  
  1326. Function FidoMsgObj.GetSubArea: Word;
  1327.   Begin
  1328.   GetSubArea := 0;
  1329.   End;
  1330.  
  1331.  
  1332. Procedure FidoMsgObj.ReWriteHdr;
  1333.   Begin
  1334.   { Not needed, rewrite is automatic when updates are done }
  1335.   End;
  1336.  
  1337.  
  1338. Procedure FidoMsgObj.DeleteMsg;
  1339.   Var
  1340.     TmpFile: File;
  1341.     Code: LongInt;
  1342.  
  1343.   Begin
  1344.   If FM^.MsgOpen Then
  1345.     If FM^.MsgFile.CloseFile Then
  1346.       FM^.MsgOpen := False;
  1347.   Assign(TmpFile, FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.MSG');
  1348.   Erase(TmpFile);
  1349.   Code := FM^.CurrMsg shr 3; {div by 8 to get byte position}
  1350.   FM^.MsgPresent[Code] := FM^.MsgPresent[Code] and
  1351.     Not (PosArray[FM^.CurrMsg and 7]);
  1352.   If IoResult <> 0 Then;
  1353.   End;
  1354.  
  1355.  
  1356. Function FidoMsgObj.NumberOfMsgs: LongInt;
  1357.   Var
  1358.   Cnt: Word;
  1359.   Active: LongInt;
  1360.  
  1361.   Begin
  1362.   Active := 0;
  1363.   For Cnt := 0 To MaxFidMsgArray Do
  1364.     Begin
  1365.     If FM^.MsgPresent[Cnt] <> 0 Then
  1366.       Begin
  1367.       If (FM^.MsgPresent[Cnt] and $80) <> 0 Then
  1368.         Inc(Active);
  1369.       If (FM^.MsgPresent[Cnt] and $40) <> 0 Then
  1370.         Inc(Active);
  1371.       If (FM^.MsgPresent[Cnt] and $20) <> 0 Then
  1372.         Inc(Active);
  1373.       If (FM^.MsgPresent[Cnt] and $10) <> 0 Then
  1374.         Inc(Active);
  1375.       If (FM^.MsgPresent[Cnt] and $08) <> 0 Then
  1376.         Inc(Active);
  1377.       If (FM^.MsgPresent[Cnt] and $04) <> 0 Then
  1378.         Inc(Active);
  1379.       If (FM^.MsgPresent[Cnt] and $02) <> 0 Then
  1380.         Inc(Active);
  1381.       If (FM^.MsgPresent[Cnt] and $01) <> 0 Then
  1382.         Inc(Active);
  1383.       End;
  1384.     End;
  1385.   NumberOfMsgs := Active;
  1386.   End;
  1387.  
  1388.  
  1389. Function FidoMsgObj.GetLastRead(UNum: LongInt): LongInt;
  1390.   Var
  1391.     LRec: Word;
  1392.  
  1393.   Begin
  1394.   If ((UNum + 1) * SizeOf(LRec)) >
  1395.   SizeFile(FM^.NetMailPath + 'LastRead') Then
  1396.     GetLastRead := 0
  1397.   Else
  1398.     Begin
  1399.     If LoadFilePos(FM^.NetMailPath + 'LastRead', LRec, SizeOf(LRec),
  1400.     UNum * SizeOf(LRec)) = 0 Then
  1401.       GetLastRead := LRec
  1402.     Else
  1403.       GetLastRead := 0;
  1404.     End;
  1405.   End;
  1406.  
  1407.  
  1408. Procedure FidoMsgObj.SetLastRead(UNum: LongInt; LR: LongInt);
  1409.   Var
  1410.     LRec: Word;
  1411.     Status: Word;
  1412.  
  1413.   Begin
  1414.   If ((UNum + 1) * SizeOf(LRec)) >
  1415.   SizeFile(FM^.NetMailPath + 'LastRead') Then
  1416.     Begin
  1417.     Status := ExtendFile(FM^.NetMailPath + 'LastRead',
  1418.     (UNum + 1) * SizeOf(LRec));
  1419.     End;
  1420.   If LoadFilePos(FM^.NetMailPath + 'LastRead', LRec, SizeOf(LRec),
  1421.   UNum * SizeOf(LRec)) = 0 Then
  1422.     Begin
  1423.     LRec := LR;
  1424.     Status := SaveFilePos(FM^.NetMailPath + 'LastRead', LRec, SizeOf(LRec),
  1425.     UNum * SizeOf(LRec));
  1426.     End;
  1427.   End;
  1428.  
  1429.  
  1430. Function FidoMsgObj.GetTxtPos: LongInt;
  1431.   Begin
  1432.   GetTxtPos := FM^.TextCtr;
  1433.   End;
  1434.  
  1435.  
  1436. Procedure FidoMsgObj.SetTxtPos(TP: LongInt);
  1437.   Begin
  1438.   FM^.TextCtr := TP;
  1439.   End;
  1440.  
  1441.  
  1442. Function FidoMsgObj.MsgBaseExists: Boolean;
  1443.   Begin
  1444.   MsgBaseExists := FileExist(FM^.NetMailPath + 'Nul');
  1445.   End;
  1446.  
  1447.  
  1448. Procedure FidoMsgObj.Rescan;
  1449.   Var
  1450.   {$IFDEF WINDOWS}
  1451.     SR: TSearchRec;
  1452.     TStr: Array[0..128] of Char;
  1453.   {$ELSE}
  1454.     SR: SearchRec;
  1455.   {$ENDIF}
  1456.   TmpName: String[13];
  1457.   TmpNum: Word;
  1458.   Code: Word;
  1459.  
  1460.  
  1461.   Begin
  1462.   FillChar(FM^.MsgPresent, SizeOf(FM^.MsgPresent), 0);
  1463.   {$IFDEF WINDOWS}
  1464.   StrPCopy(TStr, FM^.NetMailPath + '*.MSG');
  1465.   FindFirst(TStr, faReadOnly + faArchive, SR);
  1466.   {$ELSE}
  1467.   FindFirst(FM^.NetMailPath + '*.MSG', ReadOnly + Archive, SR);
  1468.   {$ENDIF}
  1469.   While DosError = 0 Do
  1470.     Begin
  1471.     {$IFDEF WINDOWS}
  1472.     TmpName :=  StrPas(SR.Name);
  1473.     {$ELSE}
  1474.     TmpName := SR.Name;
  1475.     {$ENDIF}
  1476.     Val(Copy(TmpName, 1,  Pos('.', TmpName) - 1), TmpNum, Code);
  1477.     If ((Code = 0) And (TmpNum > 0)) Then
  1478.       Begin
  1479.       If TmpNum <= MaxFidMsgNum Then
  1480.         Begin
  1481.         Code := TmpNum shr 3; {div by 8 to get byte position}
  1482.         FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[TmpNum and 7];
  1483.         End;
  1484.       End;
  1485.     FindNext(SR);
  1486.     End;
  1487.   End;
  1488.  
  1489.  
  1490. Function FidoMsgObj.MsgExists(MsgNum: LongInt): Boolean;
  1491.   Var
  1492.     Code: LongInt;
  1493.  
  1494.   Begin
  1495.   If ((MsgNum > 0) and (MsgNum <= MaxFidMsgNum)) Then
  1496.     Begin
  1497.     Code := MsgNum shr 3;
  1498.     MsgExists := (FM^.MsgPresent[Code] and PosArray[MsgNum and 7]) <> 0;
  1499.     End
  1500.   Else
  1501.     MsgExists := False;
  1502.   End;
  1503.  
  1504.  
  1505. End.
  1506.