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

    {
    > 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}

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