home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUILLET / EMSI.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  8KB  |  371 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 426 of 457
  3. From : Brian Swanson                       1:123/419.0          08 Jul 93  12:14
  4. To   : Justin Shirk
  5. Subj : EMSI/UUCICO
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  > Does anyone have a working EMSI program written in
  8.  > Pascal that they could
  9.  > post?
  10.  
  11. I have written a small EMSI program, it's not very efficient, but it gives you
  12. an idea of how things work.  I just posted the CRC32 unit in another message,
  13. so look at the messages right before this one to get those procedures...}
  14.  
  15. Program EMSI;
  16. Uses Crt,Dos,CRC_32;
  17. Const
  18.    CR=#13;
  19.    Ident='**';
  20.    Port = 1;
  21.    BaudRate = 38400;
  22.  
  23. Var
  24.   S  : String;
  25.   C  : Char;
  26.   InKey,
  27.   OutKey : Char;
  28.   Once : Boolean;
  29.  
  30. Function Hexn(B: Byte) : Char;
  31. Begin
  32.   B:=B and 15;
  33.   If B > 9 then inc(b,7);
  34.   hexn:=chr(B+48);
  35. End;
  36.  
  37. Function HexB(B: Byte): String;
  38. Begin
  39.   HexB:=HexN(b shr 4) + hexn(b);
  40. End;
  41.  
  42. Function HexW(W: Word): String;
  43. Begin
  44.   HexW:=HexB(W Shr 8) + HexB(W);
  45. End;
  46.  
  47. Function HexL(L : LongInt): String;
  48. Begin
  49.   HexL:=HexW(L Shr 16) + HexW(L);
  50. End;
  51.  
  52. Function CRC16(S : String) : Word;
  53.  
  54. var
  55.   Sl                       : Byte Absolute S;
  56.   Count1                   : Byte;
  57.   Count2                   : Byte;
  58.  
  59.   CRC                      : LongInt;
  60.  
  61. begin
  62.   CRC := 0;
  63.  
  64.   For Count1 := 1 To Sl Do
  65.   Begin
  66.     CRC := (CRC XOR ( Ord(S[Count1]) SHL 8));
  67.     For Count2 := 1 To 8 Do
  68.       If (CRC And $8000) > 0 Then
  69.         CRC:=((CRC Shl 1) XOR $1021)
  70.       Else
  71.         CRC:=(CRC Shl 1);
  72.   End;
  73.   CRC16 :=(CRC And $FFFF);
  74. End;
  75.  
  76. Procedure SendChar(C : Char);
  77. Begin
  78.     TransmitChar(Port,C);
  79. End;
  80.  
  81. Procedure Send(S : String);
  82. Var
  83.   X : Integer;
  84.  
  85. Begin
  86.   For X:=1 to Length(s) Do
  87.     TransmitChar(Port,S[x]);
  88. End;
  89.  
  90. Procedure SendLn( S : String);
  91. Var
  92.   x : Integer;
  93. Begin
  94.   For X:=1 to Length(S) Do
  95.     TransmitChar(Port,S[x]);
  96.   TransmitChar(Port,CR);
  97. End;
  98.  
  99. Procedure Tipe(s : String);
  100. Begin
  101.   TextColor(14);
  102.   WriteLn;
  103.   WriteLn(S);
  104.   TextColor(15);
  105. End;
  106.  
  107. Procedure SendEMSI(a : String);
  108. Var
  109.   C : Word;
  110.   H,
  111.   S : String;
  112.  
  113. Begin
  114.   S:='EMSI_' + A;
  115.   C:=CRC16(S);
  116.   H:=HexW(C);
  117.   Send(IDENT + S);
  118.   SendLn(H);
  119. End;
  120.  
  121. Procedure SendHandshake;
  122. Var
  123.   S,
  124.   H,
  125.   L   : String;
  126.   A,
  127.   B,
  128.   C   : Word;
  129.  
  130. Begin
  131.   S:='{EMSI}{23:100/67}{}{8N1,PUA}{ZAP,ZMO,ARC,XMA}{15}{UnleadedMail}';
  132.   S:=S + '{1.0}{Beta-1}{IDENT}{[Swanson''s BBS][your Mind!]';
  133.   S:=S + '[Brian Swanson][1-901-373-3239][9600][XX,V32B,V42B]}';
  134.   L:=HexW(Length(s));
  135.   S:='EMSI_DAT    ' + S;
  136.   S[9]:=L[1];
  137.   S[10]:=L[2];
  138.   S[11]:=L[3];
  139.   S[12]:=L[4];
  140.   H:=HexW(CRC16(S));
  141.   Send(IDENT + S);
  142.   SendLn(H);
  143. End;
  144.  
  145. Function ReceiveEMSIDAT: Boolean;
  146. Var
  147.   S,
  148.   L,
  149.   InHex,
  150.   CalcHex : String;
  151.   X : Byte;
  152.  
  153. Begin
  154.   For X:=1 To 10 Do
  155.     S[X]:=ReceiveCharWithWait(Port);
  156.   If S='**EMSI_DAT' Then
  157.    Begin
  158.      L:='';
  159.      InKey:=ReceiveCharWithWait(Port);
  160.      L:=L + InKey;
  161.      InKey:=ReceiveCharWithWait(Port);
  162.      L:=L + InKey;
  163.      InKey:=ReceiveCharWithWait(Port);
  164.      L:=L + InKey;
  165.      InKey:=ReceiveCharWithWait(Port);
  166.      L:=L + InKey;
  167.      Tipe('Length Of Incoming EMSI_DAT is: '+L);
  168.      S:='';
  169.      InKey:=ReceiveCharWithWait(Port);
  170.      While InKey<>#13 Do
  171.       Begin
  172.         S:=S + InKey;
  173.         InKey:=ReceiveCharWithWait(Port);
  174.       End;
  175.      Tipe('Received:'+S);
  176.      InHex:=Copy(S,Length(s)-4,4);
  177.      S:='EMSI_DAT' + L + S;
  178.      CalcHex:=HexW(CRC16(S));
  179.      If InHex=CalcHex Then ReceiveEMSIDAT:=True
  180.       Else ReceiveEMSIDAT:=False;
  181.    End
  182.   Else
  183.    ReceiveEMSIDAT:=False;
  184.  
  185. End;
  186.  
  187. Function EMSICheck:Boolean;
  188. Begin
  189.   InKey:=ReceiveCharWithWait(Port);
  190.   If InKey='*' Then
  191.    Begin
  192.     InKey:=ReceiveCharWithWait(Port);
  193.     InKey:=Upcase(InKey);
  194.     If InKey='E' Then
  195.      Begin
  196.       InKey:=ReceiveCharWithWait(Port);
  197.       InKey:=UpCase(InKey);
  198.       If InKey='M' Then
  199.        Begin
  200.          InKey:=ReceiveCharWithWait(Port);
  201.          InKey:=Upcase(InKey);
  202.          If InKey='S' Then
  203.           Begin
  204.            InKey:=ReceiveCharWithWait(Port);
  205.            InKey:=Upcase(InKey);
  206.            If InKey='I' Then
  207.             Begin
  208.               EMSICheck:=True;
  209.             End
  210.            Else
  211.             Begin
  212.              EMSICheck:=False;
  213.              WriteChar(Inkey);
  214.            End;
  215.           End
  216.          Else
  217.            WriteChar(Inkey);
  218.        End
  219.       Else
  220.         WriteChar(Inkey);
  221.      End
  222.     Else
  223.      WriteChar(InKey);
  224.    End;
  225. End;
  226.  
  227. Function ReceiveEMSI(Var EMSI: String): Boolean;
  228. Var
  229.   S : String;
  230.   InHex,
  231.   CalcHex : String;
  232.   CRC : Word;
  233. Begin
  234.   If EMSICheck Then
  235.    Begin
  236.      S:='EMSI';
  237.      InHex:='';
  238.      InKey:=ReceiveCharWithWait(Port);
  239.      InKey:=Upcase(InKey);
  240.      S:=S + Inkey;
  241.      InKey:=ReceiveCharWithWait(Port);
  242.      InKey:=Upcase(InKey);
  243.      S:=S + Inkey;
  244.      InKey:=ReceiveCharWithWait(Port);
  245.      InKey:=Upcase(InKey);
  246.      S:=S + Inkey;
  247.      InKey:=ReceiveCharWithWait(Port);
  248.      InKey:=Upcase(InKey);
  249.      S:=S + Inkey;
  250.      InKey:=ReceiveCharWithWait(Port);
  251.      InKey:=Upcase(InKey);
  252.      InHex:=InHex + Inkey;
  253.      InKey:=ReceiveCharWithWait(Port);
  254.      InKey:=Upcase(InKey);
  255.      InHex:=InHex + Inkey;
  256.      InKey:=ReceiveCharWithWait(Port);
  257.      InKey:=Upcase(InKey);
  258.      InHex:=InHex + Inkey;
  259.      InKey:=ReceiveCharWithWait(Port);
  260.      InKey:=Upcase(InKey);
  261.      InHex:=InHex + Inkey;
  262.      InKey:=ReceiveCharWithWait(Port);
  263.      CalcHex:=HexW(CRC16(S));
  264.      If CalcHex<>InHex Then
  265.       Begin
  266.         ReceiveEMSI:=False;
  267.         EMSI:='';
  268.       End
  269.      Else
  270.       Begin
  271.         ReceiveEMSI:=True;
  272.         EMSI:=Copy(S,6,3);
  273.       End;
  274.    End
  275.   Else
  276.    ReceiveEMSI:=False;
  277. End;
  278.  
  279. Procedure StartEMSI;
  280. Var
  281.   Tries : Byte;
  282.   S : String;
  283.   Receive,
  284.   Sent : Boolean;
  285. Begin
  286.   Sent:=False;
  287.   SendEMSI('INQ');
  288.   SendEMSI('INQ');
  289.   SendLn('');
  290.   PurgeInput(Port);
  291.   Repeat
  292.     SendHandshake;
  293.     InKey:=ReceiveCharWithWait(Port);
  294.     If (InKey='*') Then
  295.      If ReceiveEMSI(S) Then
  296.       Begin
  297.         If S='ACK' Then
  298.          Begin
  299.            InKey:=ReceiveCharWithWait(Port);
  300.            If (InKey='*') Then
  301.             If ReceiveEMSI(S) Then
  302.              If S='ACK' Then
  303.               Begin
  304.                 Sent:=True;
  305.                 Tries:=0;
  306.                 Repeat
  307.                   If (Not Receive) And (Tries>0) Then
  308.                    Begin
  309.                      SendEMSI('NAK');
  310.                      If ReceiveEMSIDAT Then Receive:=True
  311.                       Else Tries:=Tries + 1;
  312.                    End;
  313.                   If (Not Receive) And (Tries<1) Then
  314.                    If ReceiveEMSIDAT Then Receive:=True
  315.                     Else Tries:=Tries + 1;
  316.                 Until (Receive) Or (Tries>6);
  317.                 If Tries>6 Then
  318.                  Begin
  319.                   Tipe('EMSI_DAT Receive Failed...Aborting');
  320.                   SetDTR(Port,FALSE);
  321.                   Halt(0);
  322.                  End;
  323.                 If Receive Then
  324.                  Begin
  325.                   SendEMSI('ACK');
  326.                   SendEMSI('ACK');
  327.                  End;
  328.               End
  329.          End;
  330.       End;
  331.   Until (Sent) And (Receive);
  332.  
  333. End;
  334.  
  335. Begin
  336.    If OpenFossil(Port) Then
  337.      Tipe('FOSSIL INITIALIZED');
  338.    SetBaudRate(Port,BaudRate);
  339.    Write('Phone Number:');
  340.    ReadLn(S);
  341.    SendLn('ATDT'+S);
  342.    Repeat
  343.     SendLn('');
  344.    Until CharsInBuf(Port);
  345.    OutKey:=#0;
  346.    While OutKey<>#27 Do
  347.     Begin
  348.       If Not KeyPressed And CharsInBuf(Port) Then
  349.        Begin
  350.          InKey:=ReceiveChar(Port);
  351.          WriteChar(InKey);
  352.          If (InKey='*') Then
  353.           If ReceiveEMSI(S) Then
  354.            Begin
  355.              If S='REQ' Then StartEMSI;
  356.            End;
  357.        End;
  358.      If Keypressed Then
  359.        OutKey:=ReadKey;
  360.     End;
  361. End.
  362.  
  363.  
  364. ---- Cut Here ----
  365.  
  366. This program goes as far as setting up the EMSI session, it does not however
  367. parse the received EMSI info from the remote system.....If you look at the
  368. function ReceiveEMSIDAT, at the point that it displays the contents of String
  369. S.  The remote systems EMSI_DAT is stored in string S, so all you have to do is
  370. parse it out to get the info.....If you need any other help concerning EMSI let
  371. me know....