Contributor: KELLY DROWN
{
> Do anyone have code for extracting a message from a pkt file? I realy
> need something that does it. OOP or non OOP doesn't matter.
Well, I found this searching my HDD. Its quite old and not written by me,
but I think this should do it. When not, start digging on FTSC*.* files
(don't remember the exact one)
}
Unit FidoNet; { Beta Copy - Rev 6/5/89 - Tested 6/20/89 Ver. 0.31 }
{ FIDONET UNIT by Kelly Drown, Copyright (C)1988,89-LCP }
{ All rights reserved }
{ If you use this unit in your own programming, I ask }
{ only that you give me credit in your documentation. }
{ I ask this instead of money. All of the following code }
{ is covered under the copyright of Laser Computing Co. }
{ and may be used in your own programming provided the }
{ terms above have been satisfactorily met. }
INTERFACE
Uses Dos,
Crt,
StrnTTT5, { TechnoJocks Turbo Toolkit v5.0 }
MiscTTT5;
Type
NetMsg = Record { NetMessage Record Structure }
From,
Too : String[35];
Subject : String[71];
Date : String[19];
TimesRead,
DestNode,
OrigNode,
Cost,
OrigNet,
DestNet,
ReplyTo,
Attr,
NextReply : Word;
AreaName : String[20];
End;
PktHeader = Record { Packet Header of Packet }
OrigNode,
DestNode,
Year,
Month,
Day,
Hour,
Minute,
Second,
Baud,
OrigNet,
DestNet : Word;
End;
PktMessage = Record { Packet Header of each individual message }
OrigNode,
DestNode,
OrigNet,
DestNet,
Attr,
Cost : Word;
Date : String[19];
Too : String[35];
From : String[35];
Subject : String[71];
AreaName : String[20];
End;
ArchiveName = Record { Internal Record Structure used for }
MyNet, { determining the name of of an echomail }
MyNode, { archive. i.e. 00FA1FD3.MO1 }
HisNet,
HisNode : Word;
End;
Const { Attribute Flags }
_Private = $0001;
_Crash = $0002;
_Recvd = $0004;
_Sent = $0008;
_File = $0010;
_Forward = $0020; { Also know as In-Transit }
_Orphan = $0040;
_KillSent = $0080;
_Local = $0100;
_Hold = $0200;
_Freq = $0800;
Status : Array[1..12] Of String[3] = ('Jan','Feb','Mar','Apr','May',
'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
Var Net : NetMsg;
PH : PktHeader;
PM : PktMessage;
ArcN : ArchiveName;
Function PacketName : String;
Function PacketMessage : String;
Function PacketHeader : String;
Function NetMessage : String;
Function GetPath(Var FName : String) : Boolean;
Function GetNet(GN : String) : String;
Function GetNode(GN : String) : String;
Function MsgDateStamp : String;
Function LastMsgNum( _NetPath : String ) : Integer;
Function Hex (n : word) : String;
Function ArcName : String;
Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
IMPLEMENTATION
{-------------------------------------------------------------------------}
Function PacketName : String;
{ Creates and returns a unique Packet name }
Var h,m,s,hs : Word;
yr,mo,da,dow : Word;
WrkStr : String;
Begin
WrkStr := '';
GetTime(h,m,s,hs);
GetDate(yr,mo,da,dow);
WrkStr := PadRight(Int_To_Str(da),2,'0')
+PadRight(Int_To_Str(h),2,'0')
+PadRight(Int_To_Str(m),2,'0')
+PadRight(Int_To_Str(s),2,'0');
PacketName := WrkStr + '.PKT';
End;
{-------------------------------------------------------------------------}
Function PacketMessage : String;
{ Returns a Packet message header }
Var Hdr : String;
Begin
Hdr := '';
Hdr := #2#0 { Type #2 packets... Type #1 is obsolete }
+Chr(Lo(PM.OrigNode))+Chr(Hi(PM.OrigNode))
+Chr(Lo(PM.DestNode))+Chr(Hi(PM.DestNode))
+Chr(Lo(PM.OrigNet))+Chr(Hi(PM.OrigNet))
+Chr(Lo(PM.DestNet))+Chr(Hi(PM.DestNet))
+Chr(Lo(PM.Attr))+Chr(Hi(PM.Attr))
+Chr(Lo(PM.Cost))+Chr(Hi(PM.Cost))
+PM.Date+#0
+PM.Too+#0
+PM.From+#0
+PM.Subject+#0
+Upper(PM.AreaName);
PacketMessage := Hdr;
End;
{-------------------------------------------------------------------------}
Function PacketHeader : String;
{ Returns a Packet Header String }
Var Hdr : String;
Begin
Hdr := '';
Hdr := Chr(Lo(PH.OrigNode))+Chr(Hi(PH.OrigNode))
+Chr(Lo(PH.DestNode))+Chr(Hi(PH.DestNode))
+Chr(Lo(PH.Year))+Chr(Hi(PH.Year))
+Chr(Lo(PH.Month))+Chr(Hi(PH.Month))
+Chr(Lo(PH.Day))+Chr(Hi(PH.Day))
+Chr(Lo(PH.Hour))+Chr(Hi(PH.Hour))
+Chr(Lo(PH.Minute))+Chr(Hi(PH.Minute))
+Chr(Lo(PH.Second))+Chr(Hi(PH.Second))
+Chr(Lo(PH.Baud))+Chr(Hi(PH.Baud))
+#2#0
+Chr(Lo(PH.OrigNet))+Chr(Hi(PH.OrigNet))
+Chr(Lo(PH.DestNet))+Chr(Hi(PH.DestNet))
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 { Null Field Fill Space }
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
PacketHeader := Hdr;
End;
{-------------------------------------------------------------------------}
Function NetMessage : String;
{ Returns a NetMessage header string }
Var Hdr : String;
Begin
Hdr := '';
Hdr := PadLeft(Net.From,36,#0);
Hdr := Hdr + PadLeft(Net.Too,36,#0)
+ PadLeft(Net.Subject,72,#0)
+ PadRight(Net.Date,19,' ')+#0
+ Chr(Lo(Net.TimesRead))+Chr(Hi(Net.TimesRead))
+ Chr(Lo(Net.DestNode))+Chr(Hi(Net.DestNode))
+ Chr(Lo(Net.OrigNode))+Chr(Hi(Net.OrigNode))
+ Chr(Lo(Net.Cost))+Chr(Hi(Net.Cost))
+ Chr(Lo(Net.OrigNet))+Chr(Hi(Net.OrigNet))
+ Chr(Lo(Net.DestNet))+Chr(Hi(Net.DestNet))
+ #0#0#0#0#0#0#0#0
+ Chr(Lo(Net.ReplyTo))+Chr(Hi(Net.ReplyTo))
+ Chr(Lo(Net.Attr))+Chr(Hi(Net.Attr))
+ Chr(Lo(Net.NextReply))+Chr(Hi(Net.NextReply))
+ Upper(Net.AreaName);
NetMessage := Hdr;
End;
{-------------------------------------------------------------------------}
Function GetPath(Var FName : String) : Boolean;
{ Returns the FULL Path and filename for a filename if the file }
{ is found in the path. }
Var Str1,Str2 : String;
NR : Byte;
HomeDir : String;
Begin
HomeDir := FExpand(FName);
If Exist(HomeDir) Then Begin
FName := HomeDir;
GetPath := True;
Exit;
End;
Str1 := GetEnv('PATH');
For NR := 1 to Length(Str1) DO IF Str1[NR] = ';' Then Str1[NR] := ' ';
For NR := 1 to WordCnt(Str1) DO
Begin
Str2 := ExtractWords(NR,1,Str1)+'\'+FName;
IF Exist(Str2) Then Begin
FName := Str2;
GetPath := True;
Exit;
End;
End;
GetPath := False;
End;
{-------------------------------------------------------------------------}
Function MsgDateStamp : String; { Creates Fido standard- 01 Jan 89 21:05:18 }
Var h,m,s,hs : Word; { Standard message header time/date stamp }
y,mo,d,dow : Word;
Tmp,
o1,o2,o3 : String;
Begin
o1 := '';
o2 := '';
o3 := '';
tmp := '';
GetDate(y,mo,d,dow);
GetTime(h,m,s,hs);
o1 := PadRight(Int_To_Str(d),2,'0');
o2 := Status[mo];
o3 := Last(2,Int_To_Str(y));
Tmp := Concat( o1,' ',o2,' ',o3,' ');
o1 := PadRight(Int_To_Str(h),2,'0');
o2 := PadRight(Int_To_Str(m),2,'0');
o3 := PadRight(Int_To_Str(s),2,'0');
Tmp := Tmp + Concat(o1,':',o2,':',o3);
MsgDateStamp := Tmp;
End;
{-------------------------------------------------------------------------}
Function MsgToNum( Fnm : String ) : Integer; { Used Internally by LastMsgNum }
Var p : Byte;
Begin
p := Pos('.',Fnm);
Fnm := First(p-1,Fnm);
MsgToNum := Str_To_Int(Fnm);
End;
{-------------------------------------------------------------------------}
Function LastMsgNum( _NetPath : String ) : Integer;
{ Returns the highest numbered xxx.MSG in NetPath directory }
Var
_Path : String;
Temp1,
Temp2 : String;
Len : Byte;
DxirInf : SearchRec;
Num,
Num1 : Integer;
Begin
Num := 0;
Num1 := 0;
Temp1 := '';
Temp2 := '';
_Path := '';
_Path := _NetPath + '\*.MSG';
FindFirst( _Path, Archive, DxirInf );
While DosError = 0 DO
Begin
Temp1 := DxirInf.Name;
Num1 := MsgToNum(Temp1);
IF Num1 > Num Then Num := Num1;
FindNext(DxirInf);
End;
IF Num = 0 Then Num := 1;
LastMsgNum := Num;
End;
{-------------------------------------------------------------------------}
Function Hex(N : Word) : String;
{ Converts an integer or word to it's Hex equivelent }
Var
L : string[16];
BHi,
BLo : byte;
Begin
L := '0123456789abcdef';
BHi := Hi(n);
BLo := Lo(n);
Hex := copy(L,succ(BHi shr 4),1) +
copy(L,succ(BHi and 15),1) +
copy(L,succ(BLo shr 4),1) +
copy(L,succ(BLo and 15),1);
End;
{-------------------------------------------------------------------------}
Function ArcName : String;
{ Returns the proper name of an echomail archive }
Var C1,C2 : LongInt;
Begin
C1 := 0; C2 := 0;
C1 := ArcN.MyNet - ArcN.HisNet;
C2 := ArcN.MyNode - ArcN.HisNode;
If C1 < 0 Then C1 := 65535 + C1;
If C2 < 0 Then C2 := 65535 + C2;
ArcName := Hex(C1) + Hex(C2);
End;
{-------------------------------------------------------------------------}
Function GetNet( GN : String ) : String;
{ Returns the NET portion of a Net/Node string }
Var P : Byte;
Begin
P := Pos('/',GN);
GetNet := First(P-1,GN);
End;
{-------------------------------------------------------------------------}
Function GetNode( GN : String ) : String;
{ Returns the NODE portion of a Net/Node string }
Var P : Byte;
Begin
P := Pos('/',GN);
GetNode := Last(Length(GN)-P,GN);
End;
{-------------------------------------------------------------------------}
Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
{ Expands a list of short form node numbers to thier proper }
{ Net/Node representations. Example: }
{ The string: 170/100 101 102 5 114/12 15 17 166/225 226 }
{ Would return: 170/100 170/101 170/102 170/5 114/12 114/15 etc.. }
Var Net,NetNode : String[10];
HoldStr,
WS1 : String;
N1 : Integer;
Begin
Net := '';
NetNode := '';
HoldStr := '';
WS1 := '';
N1 := 0;
TotalNumber := 0;
TotalNumber := WordCnt(List);
For N1 := 1 to TotalNumber DO Begin
WS1 := ExtractWords(N1,1,List);
IF Pos('/',WS1) <> 0 Then Begin Net := GetNet(WS1)+'/'; NetNode := WS1;
End ELSE NetNode := Net+WS1;
HoldStr := HoldStr + ' ' + Strip('A',' ',NetNode);
End;
End;
{-------------------------------------------------------------------------}
Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
{ Returns NET and NODE as words from a Net/Node string }
Var WStr : String[6];
Begin
Wstr := GetNet(NetNode);
Net := Str_To_Int(Wstr);
Wstr := GetNode(NetNode);
Node := Str_To_Int(Wstr);
End;
{-------------------------------------------------------------------------}
Begin
{ Initialize the data structures }
FillChar(Net,SizeOf(Net),#0);
FillChar(PM,SizeOf(PM),#0);
FillChar(PH,SizeOf(PH),#0);
FillChar(ArcN,SizeOf(ArcN),#0);
End. {Unit}