home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / bbs_mail / mpi100.arj / MPI.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-20  |  5KB  |  219 lines
  1. program MPI;
  2. uses Parse;
  3. var
  4.   NetHex    :  array[1..4] of char;
  5.   NetNum    :  array[1..4] of longint;
  6.   NodeHex   :  array[1..4] of char;
  7.   NodeNum   :  array[1..4] of longint;
  8.   MatrixNum :  string;
  9.   Line      :  string;
  10.   Str1      :  string;
  11.   Str2      :  string;
  12.   Str3      :  string;
  13.   FType     :  string;
  14.   Lnt1      :  longint;
  15.   Lnt2      :  longint;
  16.   A         :  integer;
  17.   code      :  word;
  18.   TempNet   :  word;
  19.   TempNode  :  word;
  20.   Count     :  shortint;
  21.   OkFile    :  boolean;
  22.   Archive   :  boolean;
  23.  
  24. const
  25.   Version   :  string[5] = '1.00a';
  26.   Net       :  word = 0;
  27.   Node      :  word = 0;
  28.   Processed :  boolean = False;
  29.  
  30.  
  31. function AllCaps(S:string)  :  string;
  32.   var
  33.     S2   :  string;
  34.     T    :  integer;
  35.   begin
  36.   for T := 1 to Length(S) do
  37.   S2[T] := UpCase(S[T]);
  38.   S2[0] := S[0];
  39.   AllCaps := S2;
  40.   end;
  41.  
  42.  
  43. procedure TestExt;
  44.   begin
  45.   OkFile := False;
  46.   Archive := False;
  47.   Term[2] := AllCaps(Term[2]);
  48.   if Term[2] = 'FLO' then
  49.     begin
  50.     FType := ' Regular Attach  ';
  51.     OkFile := True;
  52.     end;
  53.   if Term[2] = 'CLO' then
  54.     begin
  55.     FType := ' Crash Attach    ';
  56.     OkFile := True;
  57.     end;
  58.   if Term[2] = 'HLO' then
  59.     begin
  60.     FType := ' Hold Attach     ';
  61.     OkFile := True;
  62.     end;
  63.   if Term[2] = 'DLO' then
  64.     begin
  65.     FType := ' Direct Attach   ';
  66.     OkFile := True;
  67.     end;
  68.   if Term[2] = 'OUT' then
  69.     begin
  70.     FType := ' Regular Bundle  ';
  71.     OkFile := True;
  72.     end;
  73.   if Term[2] = 'CUT' then
  74.     begin
  75.     FType := ' Crash Bundle    ';
  76.     OkFile := True;
  77.     end;
  78.   if Term[2] = 'HUT' then
  79.     begin
  80.     FType := ' Hold Bundle     ';
  81.     OkFile := True;
  82.     end;
  83.   if Term[2] = 'DUT' then
  84.     begin
  85.     FType := ' Direct Bundle   ';
  86.     OkFile := True;
  87.     end;
  88.   if Term[2] = 'REQ' then
  89.     begin
  90.     FType := ' File Request    ';
  91.     OkFile := True;
  92.     end;
  93.   if Copy(Term[2],1,2) = 'MO' then
  94.     begin
  95.     FType := ' Compressed PKT  ';
  96.     if ParamCount = 2 then OkFile := True;
  97.     Archive := True;
  98.     end;
  99.   if Copy(Term[2],1,2) = 'TU' then
  100.     begin
  101.     FType := ' Compressed PKT  ';
  102.     if ParamCount = 2 then OkFile := True;
  103.     Archive := True;
  104.     end;
  105.   if Copy(Term[2],1,2) = 'WE' then
  106.     begin
  107.     FType := ' Compressed PKT  ';
  108.     if ParamCount = 2 then OkFile := True;
  109.     Archive := True;
  110.     end;
  111.   if Copy(Term[2],1,2) = 'TH' then
  112.     begin
  113.     FType := ' Compressed PKT  ';
  114.     if ParamCount = 2 then OkFile := True;
  115.     Archive := True;
  116.     end;
  117.   if Copy(Term[2],1,2) = 'FR' then
  118.     begin
  119.     FType := ' Compressed PKT  ';
  120.     if ParamCount = 2 then OkFile := True;
  121.     Archive := True;
  122.     end;
  123.   if Copy(Term[2],1,2) = 'SA' then
  124.     begin
  125.     FType := ' Compressed PKT  ';
  126.     if ParamCount = 2 then OkFile := True;
  127.     Archive := True;
  128.     end;
  129.   if Copy(Term[2],1,2) = 'SU' then
  130.     begin
  131.     FType := 'Compressed PKT  ';
  132.     if ParamCount = 2 then OkFile := True;
  133.     Archive := True;
  134.     end;
  135.   end;
  136.  
  137. procedure NodeCode;
  138.   begin
  139.   TempNet  := Net;
  140.   TempNode := Node;
  141.   Str1 := AllCaps(Copy(Term[1],1,8));
  142.   for Count := 1 to 4 do
  143.     begin
  144.     NetHex[Count]  := Str1[Count];
  145.     NodeHex[Count] := Str1[Count+4];
  146.     Val(NetHex[Count],NetNum[Count],code);
  147.     Val(NodeHex[Count],NodeNum[Count],code);
  148.     case NetHex[Count] of
  149.       'A' :  NetNum[Count] := 10;
  150.       'B' :  NetNum[Count] := 11;
  151.       'C' :  NetNum[Count] := 12;
  152.       'D' :  NetNum[Count] := 13;
  153.       'E' :  NetNum[Count] := 14;
  154.       'F' :  NetNum[Count] := 15;
  155.       end; {case NetHex[Count]}
  156.     case NodeHex[Count] of
  157.       'A' :  NodeNum[Count] := 10;
  158.       'B' :  NodeNum[Count] := 11;
  159.       'C' :  NodeNum[Count] := 12;
  160.       'D' :  NodeNum[Count] := 13;
  161.       'E' :  NodeNum[Count] := 14;
  162.       'F' :  NodeNum[Count] := 15;
  163.       end; {case NodeHex[Count]}
  164.     end;
  165.   Lnt1  := (NetNum[1]*4096)+(NetNum[2]*256)+(NetNum[3]*16)+NetNum[4];
  166.   Lnt2 := (NodeNum[1]*4096)+(NodeNum[2]*256)+(NodeNum[3]*16)+NodeNum[4];
  167.   if Archive then
  168.     begin
  169.     Dec(TempNet,Lnt1);
  170.     Lnt1 := TempNet;
  171.     Dec(TempNode,Lnt2);
  172.     Lnt2 := TempNode;
  173.     end;
  174.   Str(Lnt1,Str2);
  175.   Str(Lnt2,Str3);
  176.   MatrixNum := Str2+'/'+Str3;
  177.   while Length(MatrixNum)<12 do MatrixNum := MatrixNum + #32;
  178.   end;
  179.  
  180.  
  181.  
  182. begin
  183. Writeln('Message Packet Identifier, version ',Version);
  184. Writeln('Placed in the public domain by Bill Auclair, FidoNet 1:141/545');
  185. Writeln('---------------------------------------------------------------');
  186. if ParamCount = 2 then
  187.   begin
  188.   Val(ParamStr(1),Net,code);
  189.   Val(ParamStr(2),Node,code);
  190.   end;
  191. repeat
  192. Readln(Input,Line);
  193. if Line <> '' then
  194.   begin
  195.   Parseln(Line);
  196.   if Pos('.',Term[1])>0 then
  197.     begin
  198.     Term[5] := Term[4];
  199.     Term[4] := Term[3];
  200.     Term[3] := Term[2];
  201.     Term[2] := Copy(Term[1],(Pos('.',Term[1])+1),3);
  202.     Term[1] := Copy(Term[1],1,8);
  203.     end;
  204.   TestExt;
  205.   if (OkFile=True) and (Length(Term[1])=8) then
  206.     begin
  207.     Processed := True;
  208.     NodeCode;
  209.     while Length(Term[3])<9 do Term[3] := #32+Term[3];
  210.     while Length(Term[4])<8 do Term[4] := Term[4]+#32;
  211.     while Length(Term[5])<6 do Term[5] := Term[5]+#32;
  212.     Writeln(Term[1],'.',Term[2],' ',Term[3],'  ',Term[4],' ',Term[5],' ',
  213.     FType,'for ',MatrixNum);
  214.     end;
  215.   end;
  216. until Eof(Input);
  217. if not Processed then Writeln('No qualified files to process');
  218. end.
  219.