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

{
  The following source uses the FIDONET unit which will follow in the next
message.. It is a modified version of the origionsl FIDOPAS archive: }

Unit FidoNet;

INTERFACE

Uses Dos,
     Crt,
     StrnTTT5,
     MiscTTT5;

Type
  NetMsg = record
    From,                            { Name of sender              }
    Too           : String[35];      { Name of receiver            }
    Subject       : String[71];      { Msg subject                 }
    DateTime      : String[19];      { Msg date/time, see below    }
    Times ,                          { Times message has been read }
    DestNode,                        { Destination node number     }
    OrgNode,                         { Originating node number     }
    Cost,                            { Cost - 0 if not supported   }
    OrgNet,                          { Originating net number      }
    DestNet       : word;            { Destination net number      }
    DateWritten,                     { Date/time written           }
    SentReceived  : longint;         { Date/time sent/rcvd         }
    ReplyTO,                         { # of next message in replys }
    Attr,                            { Message status bits         }
    NextReply     : word;            { Number of previous message  }
    AreaName   : String[20];         {AreaName (Only if Echomail)  }
  end;

Const
        _private    = $0001;
        _crash      = $0002;
        _received   = $0004;
        _sent       = $0008;
        _fileattach = $0010;
        _transit    = $0020;
        _orphan     = $0040;
        _killsent   = $0080;
        _local      = $0100;   { required on all locally entered messages! }
        _hold       = $0200;
        _direct     = $0400;
        _filereq    = $0800;
        _updatereq  = $8000;

      Status    : Array[1..12] Of String[3] = ('Jan','Feb','Mar','Apr',
                                               'May','Jun','Jul','Aug',
                                               'Sep','Oct','Nov','Dec');
Var Net    : NetMsg;

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;
Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);

IMPLEMENTATION

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.DateTime,19,' ')+#0
             + Chr(Lo(Net.Times))+Chr(Hi(Net.Times))
             + Chr(Lo(Net.DestNode))+Chr(Hi(Net.DestNode))
             + Chr(Lo(Net.OrgNode))+Chr(Hi(Net.OrgNode))
             + Chr(Lo(Net.Cost))+Chr(Hi(Net.Cost))
             + Chr(Lo(Net.OrgNet))+Chr(Hi(Net.OrgNet))
             + 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 file if it 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;   { 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 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);
End.

{ --------------------- DEMO PROGRAM -------------------------- }
Program Test;

Uses
  Crt,
  FidoNet,
  StrnTTT5;      {TechnoJocks Turbo Toolkit StrnTTT5 unit}

var
  NetPath   : String;

Procedure Create_NetMessage(FileName : String );
Var LastOne,i : Integer;
    Msg_Name  : String;
    Attrib    : Word;
    MsgFil,
    Inputfile : Text;
    Header,
    S         : String;

Begin
  Header   := '';
  S        := '';
  LastOne  := 0;
  Msg_Name := '';
  Attrib   := _Local + _Private;
  With Net DO Begin
    From      := 'Lucas Nealan';
    Too       := 'Anyone';
    Subject   := 'Testing the FidoNet Unit...';
    DateTime  := MsgDateStamp;
    Times     := 0;
    DestNode  := 0;
    OrgNode   := 100;
    Cost      := 0;
    OrgNet    := 31;
    DestNet   := 22;
    ReplyTo   := 0;
    Attr      := Attrib;
    NextReply := 0;
  End;
  Header := NetMessage;
  LastOne := LastMsgNum(NetPath);
  Inc(LastOne);
  Msg_Name := NetPath+'\'+Int_To_Str(LastOne)+'.MSG';
  Assign(MsgFil, Msg_Name );
  Rewrite(MsgFil);
  WriteLn(MsgFil,Header);
  Assign(InputFile, FileName);
  Reset(InputFile);
  WriteLn(MsgFil,#1'INTL 20:22/0 20:31/100');
  WriteLn(MsgFil,#1'PID Lucas'' *.MSG Util');
  WriteLn(MsgFil,^A'FLAGS DIR');
  While not Eof(InputFile) do begin
    ReadLn(InputFile,S);
    WriteLn(MsgFil,S);
  end;
  Flush(MsgFil);
  Close(MsgFil);
  Close(InputFile);
end;

begin
  ClrScr;
  WriteLn;
  WriteLn('Posting file: '+ParamStr(1));
  WriteLn;
  NetPath := 'D:\FD\NETMAIL';
  Create_NetMessage(ParamStr(1));
end.

  The INTL Kludge line is used to send messages through non standard network
zones (20 in this example).  For fido standard zone 1 you may specify just the
origin net and node as well as destination net and zone and it will default to
zone 1.  Also with the direct flag you may either use the _Direct in the status
or add your own FLAGS DIR kludge.

   Good luck!

                                        Lucas Nealan
                                      Real World Programming


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