[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
Unit MKMsgFido32; {Fido Object *.Msg Unit}
///////////////////////////////////////////////////////////////////////////////
// MKMsgFIDO32 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;
Const
Version='9.19.97';
MaxFidMsgArray=4000;
MaxFidMsgNum=(MaxFidMsgArray*8)-1;
Type
MsgMailType = (mtNormal, mtEchoMail, mtNetMail);
TFidoMsgBase = Class(TComponent)
private
LastSoft:Boolean;
FActive:Boolean;
TextCtr:LongInt;
MsgPath:String;
MsgPathExists:Boolean;
LastPath:String;
MKMsgFrom:String;
MKMsgTo:String;
MKMsgSubj:String;
MKMsgDate:String;
MKMsgTime:String;
TmpName:String; {now is the msg text in ram!}
TmpOpen:Boolean;
MsgFile:File;
Error:Word;
{ NetMailPath:String;}
Dest:AddrType;
Orig:AddrType;
MsgStart:LongInt;
MsgEnd:LongInt;
MsgDone:Boolean;
CurrMsg:LongInt;
SeekOver:Boolean;
YoursName:String;
YoursHandle:String;
MailType:MsgMailType;
MsgPresent:Array[0..MaxFidMsgArray] of Byte;
MKMsgReplyTo:Longint;
MkMsgFlagLow:Byte;
MkMsgFlagHigh:Byte;
MkMsgNextReply:Longint;
MkMsgCost:Word;
MsgOpen:Boolean;
Function MsgExists(MsgNum:LongInt):Boolean;
Procedure CheckLine(TStr: String);
Procedure Rescan(S:String);
Function MKGetHighMsgNumber:Longint; Virtual;
Procedure SetCost(Value:Word); Virtual;
Function GetCost:Word; 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 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 Rescan;
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 MkMsgReplyTo write MkMsgReplyTo;
property HdrSeeAlso: LongInt read MkMsgNextReply write MkMsgNextReply;
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 HdrAttrPrivate:Boolean read IsRcvd write SetPriv;
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;
property EndOfMsgText:Boolean read MsgDone;
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 CurrMsg;
property NumberOfMsgs: LongInt read MkNumberofMsgs;
End;
Procedure Register;
Implementation
Uses
SysUtils,
MKFile32,
MKString32;
Const
PosArray: Array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);
Type
NetMsg=RECORD
FromUser : ARRAY[1..36] OF Char;
ToUser : ARRAY[1..36] OF Char;
subj : ARRAY[1..72] OF Char;
dateTime : ARRAY[1..20] OF Char; { 01 Jan 86 02:34:56 }
timesRead : Word;
destNode : Word;
origNode : Word;
cost : Word;
origNet : Word;
destNet : Word;
destZone : Word; { optional; was sentTime }
origZone : Word; { optional; was sentTime }
destPoint : Word; { optional; was readTime }
origPoint : Word; { optional; was readTime }
replyTo : Word;
flag1 : Byte;
flag2 : Byte;
nextReply : Word;
End;
Constructor TFidoMsgBase.Create(AOwner:TComponent);
Begin
Inherited Create(AOwner);
MsgPathFileName:='';
TextCtr:=0;
FillChar(Dest,Sizeof(Dest),#0);
FillChar(Orig,Sizeof(Orig),#0);
SeekOver:=False;
TmpOpen:=False;
TmpName:='';
LastPath:='';
MsgPath:='';
LastSoft:=False;
FActive:=False;
MKMsgFrom:='Noone';
MKMsgTo:='Noone';
MKMsgSubj:='MsgBase Not Active yet';
MKMsgDate:='mm-dd-yy';
MKMsgTime:='hh:mm';
End;
Destructor TFidoMsgBase.Destroy;
Begin
If TmpOpen Then TmpName:='';
End;
{Procedure TFidoMsgBase.PutLong(L: LongInt; Position: LongInt);
Var
i: Integer;
Begin
If FM^.MsgFile.SeekFile(Position) Then
If FM^.MsgFile.BlkWrite(L, SizeOf(LongInt)) Then;
End;
Procedure TFidoMsgBase.PutWord(W: Word; Position: LongInt);
Begin
If FM^.MsgFile.SeekFile(Position) Then
If FM^.MsgFile.BlkWrite(W, SizeOf(Word)) Then;
End;
Procedure TFidoMsgBase.PutByte(B: Byte; Position: LongInt);
Begin
If FM^.MsgFile.SeekFile(Position) Then
If FM^.MsgFile.BlkWrite(B, SizeOf(Byte)) Then;
End;
Function TFidoMsgBase.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 TFidoMsgBase.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; }
Function TFidoMsgBase.MKGetHighMsgNumber: LongInt;
Var
Highest: LongInt;
Cnt: LongInt;
Begin
Cnt:=MaxFidMsgArray;
While (Cnt>0) and (MsgPresent[Cnt]=0) Do Dec(Cnt);
If Cnt<0 Then Highest:=0
Else Begin
Highest:=Cnt*8;
If (MsgPresent[Cnt] and $80)<>0 Then Inc(Highest,7)
Else If (MsgPresent[Cnt] and $40)<>0 Then Inc(Highest,6)
Else If (MsgPresent[Cnt] and $20)<>0 Then Inc(Highest,5)
Else If (MsgPresent[Cnt] and $10)<>0 Then Inc(Highest,4)
Else If (MsgPresent[Cnt] and $08)<>0 Then Inc(Highest,3)
Else If (MsgPresent[Cnt] and $04)<>0 Then Inc(Highest,2)
Else If (MsgPresent[Cnt] and $02)<>0 Then Inc(Highest,1)
End;
MkGetHighMsgNumber:=Highest;
End;
Function MonthStr(MoNo: Byte): String;
Begin
Case MoNo of
01: MonthStr := 'Jan';
02: MonthStr := 'Feb';
03: MonthStr := 'Mar';
04: MonthStr := 'Apr';
05: MonthStr := 'May';
06: MonthStr := 'Jun';
07: MonthStr := 'Jul';
08: MonthStr := 'Aug';
09: MonthStr := 'Sep';
10: MonthStr := 'Oct';
11: MonthStr := 'Nov';
12: MonthStr := 'Dec';
Else
MonthStr := '???';
End;
End;
Procedure TFidoMsgBase.SetLocal(Value:Boolean);
Begin
If Value then MKMsgFlagHigh:=MKMsgFlagHigh or 1
Else MKMsgFlagHigh:=MKMsgFlagHigh and (Not 1);
End;
Procedure TFidoMsgBase.SetRcvd(Value:Boolean);
Begin
If Value Then MKMsgFlagLow:=MKMsgFlagLow or 4
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 4);
End;
Procedure TFidoMsgBase.SetPriv(Value:Boolean);
Begin
If Value Then MKMsgFlagLow:=MKMsgFlagLow or 1
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 1);
End;
Procedure TFidoMsgBase.SetCrash(Value:Boolean);
Begin
If Value Then MKMsgFlagLow:=MKMsgFlagLow or 2
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 2);
End;
Procedure TFidoMsgBase.SetKillSent(Value:Boolean);
Begin
If Value Then MKMsgFlagLow:=MKMsgFlagLow or 128
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 128);
End;
Procedure TFidoMsgBase.SetSent(Value:Boolean);
Begin
If Value then MKMsgFlagLow:=MKMsgFlagLow or 8
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 8);
End;
Procedure TFidoMsgBase.SetFAttach(Value:Boolean);
Begin
If Value Then MKMsgFlagLow:=MKMsgFlagLow or 16
Else MKMsgFlagLow:=MKMsgFlagLow and (Not 16);
End;
Procedure TFidoMsgBase.SetReqRct(Value:Boolean);
Begin
If Value Then MKMsgFlagHigh:=MKMsgFlagHigh or 16
Else MKMsgFlagHigh:=MKMsgFlagHigh and (Not 16);
End;
Procedure TFidoMsgBase.SetReqAud(Value:Boolean);
Begin
If Value Then MKMsgFlagHigh:=MKMsgFlagHigh or 64
Else MKMsgFlagHigh:=MKMsgFlagHigh and (Not 64);
End;
Procedure TFidoMsgBase.SetRetRct(Value:Boolean);
Begin
If Value Then MKMsgFlagHigh:=MKMsgFlagHigh or 32
Else MKMsgFlagHigh:=MKMsgFlagHigh and (Not 32);
End;
Procedure TFidoMsgBase.SetFileReq(Value:Boolean);
Begin
If Value Then MKMsgFlagHigh:=MKMsgFlagHigh or 8
Else MKMsgFlagHigh:=MKMsgFlagHigh and (Not 8);
End;
Procedure TFidoMsgBase.DoString(Str:String);
Begin
TmpName:=TmpName+Str;
If TextCtr<>Length(TmpName) then TextCtr:=Length(TmpName);
End;
Procedure TFidoMsgBase.DoChar(Ch:Char);
Begin
TmpName:=TmpName+Ch;
If TextCtr<>Length(TmpName) then TextCtr:=Length(TmpName);
End;
Procedure TFidoMsgBase.DoStringLn(Str:String);
Begin
DoString(Str);
DoChar(#13);
End;
Function TFidoMsgBase.WriteMsg:Word;
Var
NetNum:Word;
Begin
DoChar(#0);
NetNum:=GetHighMsgNum+1;
While FileExist(MsgPath+Long2Str(NetNum)+'.Msg') do Begin {loop jic!}
LastPath:='';
Rescan(MsgPath);
NetNum:=GetHighMsgNum+1;
End;
MsgPresent[NetNum shr 3]:=MsgPresent[NetNum shr 3] or PosArray[NetNum and 7];
If ((Dest.Point<>0) and (MailType=mtNetmail)) Then
TmpName:=#1+'TOPT '+Long2Str(Dest.Point)+#13+TmpName;
If ((Orig.Zone<>0) and (MailType=mtNetMail)) Then
TmpName:=#1+'INTL '+PointlessAddrStr(Dest)+' '+PointlessAddrStr(Orig)+
#13+TmpName;
If ((Orig.Point<>0) and (MailType=mtNetmail)) Then
TmpName:=#1+'FMPT '+Long2Str(Dest.Point)+#13+TmpName;
If ((Dest.Zone<>0) and (MailType=mtNetmail)) Then
TmpName:=#1+'INTL '+PointlessAddrStr(Dest)+' '+
PointlessAddrStr(Orig)+#13+TmpName;
AssignFile(MsgFile,MsgPath+Long2Str(NetNum)+'.Msg');
{$I-} Rewrite(MsgFile,1);
MsgOpen:=True;
RewriteHdr;
Seek(MsgFile,190);
BlockWrite(MsgFile,TmpName[1],Length(TmpName));
CloseFile(MsgFile);
{$I+}
MsgOpen:=False;
Error:=IOResult;
TmpName:='';
TmpOpen:=False;
WriteMsg:=Error;
CurrMsg:=NetNum;
End;
Function TFidoMsgBase.GetChar:Char;
Var
Ch:Char;
Begin
If TextCtr<1 then TextCtr:=1;
If (TextCtr>Length(TmpName)) then Ch:=#0
Else Begin
Ch:=TmpName[TextCtr];
Inc(TextCtr);
End;
MsgDone:=Ch=#0;
GetChar:=Ch;
End;
Function MonthNum(St: String):Word;
Begin
ST := Upper(St);
MonthNum := 0;
If St = 'JAN' Then MonthNum := 01;
If St = 'FEB' Then MonthNum := 02;
If St = 'MAR' Then MonthNum := 03;
If St = 'APR' Then MonthNum := 04;
If St = 'MAY' Then MonthNum := 05;
If St = 'JUN' Then MonthNum := 06;
If St = 'JUL' Then MonthNum := 07;
If St = 'AUG' Then MonthNum := 08;
If St = 'SEP' Then MonthNum := 09;
If St = 'OCT' Then MonthNum := 10;
If St = 'NOV' Then MonthNum := 11;
If St = 'DEC' Then MonthNum := 12;
End;
{
Function TFidoMsgBase.BufferWord(i: Word):Word;
Begin
BufferWord := BufferByte(i) + (BufferByte(i + 1) shl 8);
End;
Function TFidoMsgBase.BufferByte(i: Word):Byte;
Begin
BufferByte := GetByte(i);
End;
Function TFidoMsgBase.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 TFidoMsgBase.CheckLine(TStr:String);
Var
TmpStr:String;
Begin
If TStr[1]=#10 Then Delete(TStr,1,1);
If TStr[1]=#01 Then Delete(TStr,1,1);
If (Upper(Copy(TStr,1,4))='INTL') Then Begin
TmpStr:=StripBoth(ExtractWord(TStr,2),' ');
Dest.Zone:=Str2Long(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=StripBoth(ExtractWord(TStr,3),' ');
Orig.Zone:=Str2Long(Copy(TmpStr,1,Pos(':',TmpStr)-1));
End;
If (Upper(Copy(TStr,1,4))='TOPT') Then
Dest.Point:=Str2Long(StripBoth(ExtractWord(TStr,2),' '));
If (Upper(Copy(TStr,1,4))='FMPT') Then
Orig.Point:=Str2Long(StripBoth(ExtractWord(TStr,2),' '));
End;
Procedure TFidoMsgBase.MsgStartUp;
Var
TStr:String;
NumRead:Integer;
NetRec:NetMsg;
Function Az2Str(Str: String; MaxLen: Byte): String; {Convert asciiz to string}
Var
i: Word;
TmpStr: String;
Begin
SetLength(TmpStr,MaxLen);
Move(Str[1], TmpStr[1], MaxLen);
i := Pos(#0, TmpStr);
If i > 0 Then TmpStr:=Copy(TmpStr,1,i-1);
Az2Str := TmpStr;
End;
Function CvtDate:Boolean;
Var
TmpStr:String;
i:Word;
Begin
MKMsgtime:='';
If MKMsgDate[3]=' ' Then Begin {Fido or Opus}
If MKMsgDate[11]=' ' Then Begin {Fido DD MON YY HH:MM:SSZ}
MKMsgTime:=Copy(MKMsgDate,12,5);
TmpStr:=Long2Str(MonthNum(Copy(MKMsgDate,4,3)));
End
Else Begin {Opus DD MON YY HH:MM:SS}
MKMsgTime:=Copy(MKMsgDaTe,11,5);
TmpStr:=Long2Str(MonthNum(Copy(MKMsgDate,4,3)));
End;
If Length(TmpStr)=1 Then TmpStr:='0'+TmpStr;
MKMsgDate:=TmpStr+'-'+Copy(MKMsgDaTe,1,2)+'-'+Copy(MKMsgDate,8,2);
End
Else Begin
If MKMsgDaTe[4]=' ' Then Begin {SeaDog format DOW DD MON YY HH:MM}
MKMsgTime:=Copy(MKMsgDaTe,15,5);
TmpStr:=Long2Str(MonthNum(Copy(MKMsgDaTe,8,3)));
If Length(TmpStr)=1 Then TmpStr:='0'+TmpStr;
MKMsgDate:=TmpStr+'-'+Copy(MKMsgDaTe,5,2)+'-'+Copy(MKMsgDate,12,2);
End
Else Begin
If MKMsgDaTe[3]='-' Then Begin {Wierd format DD-MM-YYYY HH:MM:SS}
MKMsgTime:=Copy(MKMsgDate,12,5);
MKMsgDate:=Copy(MKMsgDate,4,3)+Copy(MKMsgDate,1,3)+Copy(MKMsgDate,9,2);
End;
End;
End;
CvtDate:=MKMsgTime<>'';
If MKMsgTime<>'' then Begin
For i:=1 to 5 Do
If MKMsgTime[i]=' ' Then MKMsgTime[i]:='0';
For i:=1 to 8 Do
If MKMsgDate[i]=' ' Then MKMsgDate[i]:='0';
If Length(MKMsgDate)<>8 Then CvtDate:=False;
If Length(MKMsgTime)<>5 Then CvtDate:=False;
End;
End;
Begin
MsgDone:=True;
If TmpOpen Then TmpName:='';
LastSoft:=False;
MsgEnd:=0;
TextCtr:=1;
If FileExist(MsgPath+Long2Str(CurrMsg)+'.MSG') Then Begin
AssignFile(MsgFile,MsgPath+Long2Str(CurrMsg)+'.MSG');
{$I-} Reset(MsgFile,1); {$I+}
Error:=IOResult;
FillChar(NetRec,Sizeof(NetRec),#0);
If Error=0 then Begin
MsgDone:=False;
{$I-} BlockRead(MsgFile,NetRec,Sizeof(NetRec),NumRead); {$I+}
Error:=IOResult;
TextCtr:=0;
SetLength(TStr,35);
Move(NetRec.FromUser,TStr[1],35);
MKMsgFrom:=Az2Str(TStr,35);
Move(NetRec.ToUser,TStr[1],35);
MKMsgTo:=Az2Str(TStr,35);
SetLength(TStr,72);
Move(NetRec.Subj,TStr[1],71);
MKMsgSubj:=Az2Str(TStr,72);
SetLength(TStr,20);
Move(NetRec.DateTime,TStr[1],20);
MKMsgDate:=PadRight(Az2Str(TStr,20),' ',20);
{timesRead : Word; (unused!)}
Dest.Node:=NetRec.destNode;
Orig.Node:=NetRec.origNode;
MKMsgcost:=NetRec.Cost;
Orig.Net:=NetRec.origNet;
Dest.Net:=NetRec.destNet;
Dest.Zone:=NetRec.destZone;
Orig.Zone:=NetRec.origZone;
Dest.Point:=NetRec.destPoint;
Orig.Point:=NetRec.origPoint;
MkMsgReplyTo:=NetRec.replyTo;
MkMsgFlagLow:=NetRec.flag1;
MKMsgFlagHigh:=NetRec.flag2;
MKMsgNextReply:=NetRec.nextReply;
If Error=0 then Begin
If Not CvtDate then Begin
MKMsgDate:='05-29-97';
MKMsgTime:='19:21'
End;
While Not Eof(MsgFile) do Begin
SetLength(TmpName,FileSize(MsgFile)-190);
{$I-} BlockRead(MsgFile,TmpName[1],Length(TmpName),NumRead); {$I+}
Error:=IOResult;
End;
TextCtr:=1;
While not MsgDone do CheckLine(GetString(128));
End;
MsgEnd:=Length(TmpName);
CloseFile(MsgFile);
MsgTxtStartUp;
End;
End
Else Error:=200;
If Error<>0 then CurrMsg:=0;
End;
Procedure TFidoMsgBase.MsgTxtStartUp;
Begin
MsgStart:=1;
TextCtr:=MsgStart;
MsgDone:=False;
LastSoft:=False;
End;
Function TFidoMsgBase.GetString(MaxLen:Word):String;
Var
StrCtr:Integer;
TmpStr:String;
Junk:String;
Begin
If TextCtr<1 then TextCtr:=1;
If (TextCtr>MsgEnd) Then Begin
TmpStr:=#0;
MsgDone:=True;
End
Else Begin
SetLength(TmpStr,Min(MaxLen,(Length(TmpName)-TextCtr)+1));
Move(TmpName[TextCtr],TmpStr[1],Length(TmpStr));
StrCtr:=Pos(#13,TmpStr);
If (StrCtr=0) then TmpStr:=WWrap(TmpStr,MaxLen,Junk)
Else TmpStr:=Copy(TmpStr,1,StrCtr-1);
LastSoft:=StrCtr=0;
If Pos(#$8D,TmpStr)>0 then Begin {soft return detected!}
StrCtr:=Pos(#$8D,TmpStr);
TmpStr:=Copy(TmpStr,1,StrCtr-1);
LastSoft:=True;
End;
TextCtr:=TextCtr+Length(TmpStr)+1;
StrCtr:=0;
While StrCtr<Length(TmpStr) do Begin
Inc(StrCtr);
If TmpStr[StrCtr]=#10 then Delete(TmpStr,StrCtr,1);
End;
End;
GetString:=TmpStr;
End;
Function TFidoMsgBase.IsLocal:Boolean; {Is current msg local}
Begin
IsLocal:=((MKMsgFlagHigh and 001)<>0);
End;
Function TFidoMsgBase.IsCrash:Boolean; {Is current msg crash}
Begin
IsCrash:=((MKMsgFlagLow and 002)<>0);
End;
Function TFidoMsgBase.IsKillSent:Boolean; {Is current msg kill sent}
Begin
IsKillSent:=((MKMsgFlagLow and 128)<>0);
End;
Function TFidoMsgBase.IsSent:Boolean; {Is current msg sent}
Begin
IsSent:=((MKMsgFlagLow and 008)<>0);
End;
Function TFidoMsgBase.IsFAttach:Boolean; {Is current msg file attach}
Begin
IsFAttach:=((MKMsgFlagLow and 016)<>0);
End;
Function TFidoMsgBase.IsReqRct:Boolean; {Is current msg request receipt}
Begin
IsReqRct:=((MKMsgFlagHigh and 016)<>0);
End;
Function TFidoMsgBase.IsReqAud:Boolean; {Is current msg request audit}
Begin
IsReqAud:=((MKMsgFlagHigh and 064)<>0);
End;
Function TFidoMsgBase.IsRetRct:Boolean; {Is current msg a return receipt}
Begin
IsRetRct:=((MKMsgFlagHigh and 032)<>0);
End;
Function TFidoMsgBase.IsFileReq:Boolean; {Is current msg a file request}
Begin
IsFileReq:=((MKMsgFlagHigh and 008)<>0);
End;
Function TFidoMsgBase.IsRcvd:Boolean; {Is current msg received}
Begin
IsRcvd:=((MKMsgFlagLow and 004)<>0);
End;
Function TFidoMsgBase.IsPriv:Boolean; {Is current msg priviledged/private}
Begin
IsPriv:=((MKMsgFlagLow and 001)<>0);
End;
Function TFidoMsgBase.IsDeleted:Boolean; {Is current msg deleted}
Begin
IsDeleted:=Not FileExist(MsgPath+Long2Str(CurrMsg)+'.MSG');
End;
Function TFidoMsgBase.IsEchoed:Boolean; {Is current msg echoed}
Begin
IsEchoed:=True;
End;
Procedure TFidoMsgBase.SeekFirst(MsgNum:LongInt); {Start msg seek}
Begin
CurrMsg:=MsgNum-1;
If CurrMsg<0 then CurrMsg:=0;
SeekNext;
End;
Procedure TFidoMsgBase.SeekNext; {Find next matching msg}
Begin
Inc(CurrMsg);
While ((Not MsgExists(CurrMsg)) and (CurrMsg<=MaxFidMsgNum)) Do Inc(CurrMsg);
If Not MsgExists(CurrMsg) Then CurrMsg:=0;
End;
Procedure TFidoMsgBase.SeekPrior;
Begin
Dec(CurrMsg);
While ((Not MsgExists(CurrMsg)) and (CurrMsg > 0)) Do Dec(CurrMsg);
End;
Function TFidoMsgBase.GetMsgLoc: LongInt; {Msg location}
Begin
GetMsgLoc:=CurrMsg;
End;
Procedure TFidoMsgBase.SetMsgLoc(ML: LongInt); {Msg location}
Begin
CurrMsg:=ML;
End;
Function TFidoMsgBase.MKSeekFound:Boolean;
Begin
MKSeekFound:=CurrMsg<>0;
End;
Procedure TFidoMsgBase.YoursFirst(Name: String; Handle: String);
Begin
YoursName:=Upper(Name);
YoursHandle:=Upper(Handle);
CurrMsg:=0;
YoursNext;
End;
Procedure TFidoMsgBase.YoursNext;
Var
FoundDone:Boolean;
Begin
FoundDone := False;
SeekFirst(CurrMsg+1);
While ((CurrMsg<>0) And (Not FoundDone)) Do Begin
MsgStartUp;
FoundDone:=((Upper(HdrTo)=YoursName) Or (Upper(HdrTo)=YoursHandle));
If IsRcvd Then FoundDone:=False;
If Not FoundDone Then SeekNext;
If Not SeekFound Then FoundDone:=True;
End;
End;
Function TFidoMsgBase.MKYoursFound:Boolean;
Begin
MKYoursFound:=SeekFound;
End;
Procedure TFidoMsgBase.StartNewMsg;
Begin
Error:=0;
TextCtr:=0;
FillChar(Dest,Sizeof(Dest),#0);
FillChar(Dest,Sizeof(Orig),#0);
TmpOpen:=True;
TmpName:='';
MKMsgDate := DateStr(GetDosDate);
MKMsgTime := TimeStr(GetDosDate);
End;
Function TFidoMsgBase.OpenMsgBase:Word;
Begin
Rescan(MsgPath);
FActive:=MsgBaseExists;
If FActive then OpenMsgBase:=0
Else OpenMsgBase:=500;
End;
Procedure TFidoMsgBase.SetActive(Value:Boolean);
Begin
If Factive=Value then Exit
Else If Value then OpenMsgBase
Else CloseMsgBase;
End;
Function TFidoMsgBase.CloseMsgBase: Word;
Begin
CloseMsgBase:=0;
FActive:=False;
End;
Function TFidoMsgBase.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
Begin
If MakePath(MsgPathFileName) Then CreateMsgBase:=0
Else CreateMsgBase:=1;
End;
Procedure TFidoMsgBase.SetMailType(Value:MsgMailType);
Begin
MailType:=Value;
End;
Function TFidoMsgBase.GetSubArea:Word;
Begin
GetSubArea:=0;
End;
Procedure TFidoMsgBase.ReWriteHdr;
Var
NetRec:NetMsg;
TmpNum:Byte;
TmpStr:String;
{ OldSeek:Longint;}
Begin
FillChar(NetRec,Sizeof(NetRec),#0);
TmpNum:=Str2Long(Copy(MKMsgDate,1,2));
TmpStr:=Copy(MKMsgDate,4,2)+' '+MonthStr(TmpNum)+' '+Copy(MKMsgDate,7,2)+' ';
With NetRec do Begin
Move(MKMsgFrom[1],FromUser,Length(MKMsgFrom));
Move(MKMsgTo[1],toUser,Length(MKMsgTo));
Move(MKMsgSubj[1],subj,Length(MKMsgSubj));
Move(TmpStr[1],DateTime,Length(TmpStr));
TimesRead:=0;
DestNode:=Dest.Node;
OrigNode:=Orig.Node;
Cost:=MKMsgCost;
origNet:=Orig.Net;
destNet:=Dest.Net;
destZone:=Dest.Zone;
origZone:=Orig.Zone;
destPoint:=Dest.Point;
origPoint:=Orig.Point;
replyTo:=MKMsgReplyTo;
flag1:=MkMsgFlagLow;
flag2:=MkMsgFlagHigh;
nextReply:=MkMsgNextReply;
End;
{ OldSeek:=FilePos(MsgFile);}
If Not MsgOpen then Begin
AssignFile(MsgFile,MsgPath+Long2Str(CurrMsg)+'.Msg');
{$I-} Reset(MsgFile,1); {$I-}
End;
{$I-} Seek(MsgFile,0);
BlockWrite(MsgFile,NetRec,Sizeof(NetRec));
Seek(MsgFile,0); {$I+}
If Not MsgOpen then CloseFile(MsgFile);
If IOResult<>0 then {absorb};
End;
Procedure TFidoMsgBase.DeleteMsg;
Begin
DeleteFile(PChar(MsgPath+Long2Str(CurrMsg)+'.MSG'));
MsgPresent[CurrMsg shr 3]:=MsgPresent[CurrMsg shr 3] and Not (PosArray[CurrMsg and 7]);
End;
Function TFidoMsgBase.MKNumberOfMsgs:LongInt;
Var
Cnt:Word;
Active:LongInt;
Begin
Active:=0;
For Cnt:=0 To MaxFidMsgArray Do Begin
If MsgPresent[Cnt]<>0 Then Begin
If (MsgPresent[Cnt] and $80)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $40)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $20)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $10)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $08)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $04)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $02)<>0 Then Inc(Active);
If (MsgPresent[Cnt] and $01)<>0 Then Inc(Active);
End;
End;
MKNumberOfMsgs:=Active;
End;
Function TFidoMsgBase.GetLastRead(UNum:LongInt):LongInt;
Var
LRec:Word;
Begin
If ((UNum+1)*SizeOf(LRec))>SizeFile(MsgPath+'LastRead') Then GetLastRead:=0
Else Begin
If LoadFilePos(MsgPath+'LastRead',LRec,SizeOf(LRec),UNum*SizeOf(LRec))=0 Then
GetLastRead:=LRec
Else GetLastRead:=0;
End;
End;
Procedure TFidoMsgBase.SetLastRead(UNum:LongInt;LR:LongInt);
Var
LRec: Word;
Begin
If ((UNum+1)*SizeOf(LRec))>SizeFile(MsgPath+'LastRead') Then
ExtendFile(MsgPath+'LastRead',(UNum+1)*SizeOf(LRec));
If LoadFilePos(MsgPath+'LastRead',LRec,SizeOf(LRec),UNum*SizeOf(LRec))=0 Then Begin
LRec:=LR;
SaveFilePos(MsgPath+'LastRead',LRec,SizeOf(LRec),UNum*SizeOf(LRec));
End;
End;
Function TFidoMsgBase.GetTxtPos: LongInt;
Begin
GetTxtPos:=TextCtr;
End;
Procedure TFidoMsgBase.SetTxtPos(TP:LongInt);
Begin
TextCtr:=TP;
End;
Function TFidoMsgBase.MKMsgBaseExists:Boolean;
Begin
Rescan(MsgPath); {jic}
MKMsgBaseExists:=MsgPathExists;
End;
Procedure TFidoMsgBase.Rescan(S:String);
Var
SR: TSearchRec;
TmpNum:Word;
Code:Word;
DosError:Integer;
Begin
MsgPath:=WithBackSlash(S);
If MsgPath=LastPath then Exit;
LastPath:=MsgPath;
FillChar(MsgPresent,SizeOf(MsgPresent),0);
DosError:=FindFirst(MsgPath+'*.MSG',faReadOnly+faArchive,SR);
MsgPathExists:=False;
While DosError=0 Do Begin
TmpNum:=Str2Long(Copy(SR.Name,1,Pos('.',SR.Name)-1));
If TmpNum>0 Then Begin
MsgPathExists:=True;
If TmpNum<=MaxFidMsgNum Then Begin
Code:=TmpNum shr 3; {div by 8 to get byte position}
MsgPresent[Code]:=MsgPresent[Code] or PosArray[TmpNum and 7];
End;
End;
DosError:=FindNext(SR);
End;
FindClose(SR);
End;
Function TFidoMsgBase.MsgExists(MsgNum:LongInt):Boolean;
Begin
If ((MsgNum > 0) and (MsgNum <= MaxFidMsgNum)) Then
MsgExists:=(MsgPresent[MsgNum shr 3] and PosArray[MsgNum and 7])<>0
Else MsgExists:=False;
End;
Function TFidoMsgBase.GetNextSeeAlso:LongInt;
Begin
GetNextSeeAlso:=MKMsgNextReply;
End;
Procedure TFidoMsgBase.SetNextSeeAlso(Value:LongInt);
Begin
MKMsgNextReply:=Value;
End;
Procedure TFidoMsgBase.SetCost(Value:Word);
Begin
MKMsgCost:=Value;
End;
Function TFidoMsgBase.GetCost:Word;
Begin
GetCost:=MKMsgCost;
End;
Function TFidoMsgBase.LockMsgBase:Boolean;
Begin
LockMsgbase:=True;
End;
Function TFidoMsgBase.UnLockMsgBase:Boolean;
Begin
UnLockMsgbase:=True;
End;
Procedure TFidoMsgBase.SetEcho(Value:Boolean);
Begin
{Not Needed!}
End;
Procedure TFidoMsgBase.DoKludgeLn(Str:String);
Begin
DoString(#1+Str);
End;
Procedure Register;
Begin
RegisterComponents('Warpgroup',[TFidoMsgBase]);
End;
End.
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]