home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / ECO_EMSI.INC < prev    next >
Encoding:
Text File  |  1992-09-21  |  7.2 KB  |  212 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   ECO-Mail was Conceived, Designed and Written     ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII BY EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22.  
  23.  
  24.  
  25.   function crc16(s: ar1024): word;  { by kevin cooney }
  26.   var
  27.     crc  : longint;
  28.     t, r :    byte;
  29.     l    :    word;
  30.  
  31.   begin
  32.     crc := 0; l := __len1024(s);
  33.     for t := 1 to l do begin
  34.       crc := (crc xor (ord(s[t]) shl 8));
  35.       for r := 1 to 8 do if (crc and $8000)>0 then
  36.         crc := ((crc shl 1) xor $1021) else crc := (crc shl 1);
  37.     end;
  38.     crc16 := (crc and $ffff);
  39.   end;
  40.  
  41.  
  42.  
  43.  
  44.   procedure send1024(put: ar1024);
  45.   var i : word;
  46.   begin
  47.     i := 1;
  48.     if fossil then while (put[i] <> #0) and (i < 1024) do begin
  49.       fos_write_(comport, put[i]); inc(i)
  50.     end else while (put[i] <> #0) and (i < 1024) do begin
  51.       async_send(put[i]); inc(i)
  52.     end
  53.   end;
  54.  
  55.   
  56.  
  57.   procedure comwait;
  58.   begin
  59.     if fossil then repeat until fos_avail_(comport) else
  60.       repeat until async_buffer_check;
  61.   end;
  62.  
  63.  
  64.  
  65.   function comreceive(var c: char): boolean;
  66.   begin
  67.     if fossil then begin
  68.       if fos_avail_(comport) then begin
  69.         comreceive := true; c := fos_receive_(comport);
  70.       end else comreceive := false;
  71.     end else comreceive := async_receive(c);
  72.   end;
  73.  
  74.  
  75.  
  76.   procedure putemsi;
  77.   var
  78.     i    :   byte;
  79.     ch   :   char;
  80.     res  : string;
  81.     pp   :   word;
  82.     pack : ar1024;
  83.  
  84.   begin
  85.     writeln('° Writing EMSI-enquiry...');
  86.     if debugmode then __logapp('Writing EMSI-enquiry...');
  87.     __clr1024(pack); __app1024(pack, emsi_inq + #13); send1024(pack);
  88.     
  89.     __clr1024(pack);
  90.     __app1024(pack, 'EMSI_DAT');
  91.     __app1024(pack, length_emsi_dat);
  92.     __app1024(pack, emsi_dat);
  93.     crc := hex(crc16(pack));
  94.  
  95.     __clr1024(pack);
  96.     __app1024(pack, '**EMSI_DAT');
  97.     __app1024(pack, length_emsi_dat);
  98.     __app1024(pack, emsi_dat);
  99.     __app1024(pack, crc + #13);
  100.     send1024(pack);
  101.  
  102.     comwait;
  103.     repeat
  104.       inc(tries); res := '';
  105.       while (
  106.         comreceive(ch) and not(pos(emsi_req, __up(res)) > 0)
  107.       ) do begin
  108.         res := res + ch; delay(12);
  109.         if debugmode then write(ch);
  110.         capturewrite(ch);
  111.         ch := #00;
  112.       end;
  113.     until (pos(emsi_req, __up(res)) > 0) or (tries = maxemsitries);
  114.  
  115.     if res <> '' then __logapp('Response to inquiry: ' + res);
  116.     if (pos(emsi_req, __up(res)) > 0) then begin
  117.       res := '';
  118.       if debugmode then begin
  119.         writeln('° Yonder site has acknowledged receipt of EMSI_INQ');
  120.         __logapp('Yonder site has acknowledged receipt of EMSI_INQ');
  121.       end;
  122.     end else begin
  123.       writeln('! Host system failed to acknowledge the inquiry sequence.');
  124.       __logapp('Host system failed to acknowledge the inquiry sequence.');
  125.       if fossil then fos_hangup_(comport) else hangup232; __eos;
  126.       { send_modem_command(modem_hang_up); absorb232response(false, tmp); }
  127.     end;
  128.  
  129.     writeln('° Sending EMSI data...');
  130.     if debugmode then __logapp('Sending EMSI data...');
  131.     tries := 0;
  132.  
  133.     __clr1024(pack); __app1024(pack, emsi_inq + #13); send1024(pack);
  134.  
  135.     __clr1024(pack); __app1024(pack, 'EMSI_DAT'); __app1024(pack, length_emsi_dat);
  136.     __app1024(pack, emsi_dat); crc := hex(crc16(pack));
  137.     __clr1024(pack); __app1024(pack, '**EMSI_DAT');
  138.     __app1024(pack, length_emsi_dat); __app1024(pack, emsi_dat); 
  139.     __app1024(pack, crc + #13); send1024(pack);
  140.  
  141.     comwait;
  142.     repeat
  143.       inc(tries); res := ''; ch := #00;
  144.       while comreceive(ch) and (ch <> '*') do begin
  145.         if debugmode then write(ch); capturewrite(ch);
  146.       end;
  147.       ch := '*'; res := '*';
  148.       comwait;
  149.       while (
  150.         comreceive(ch) and not(pos(emsi_ack, __up(res)) > 0)
  151.       ) do begin
  152.         res := addtolast20(res, ch); delay(12);
  153.         if debugmode then write(ch);
  154.         capturewrite(ch);
  155.         ch := #00;
  156.       end;
  157.     until (pos(emsi_ack, __up(res)) > 0) or (tries >= maxemsitries);
  158.     if (res <> '') then __logapp('Response to EMSI data (Acq?): ' + res);
  159.  
  160.     if tries >= maxemsitries then begin
  161.       writeln('Host system failed to acknowledge the EMSI_DAT packet.');
  162.       __logapp('Host system failed to acknowledge the EMSI_DAT packet.');
  163.       if fossil then fos_hangup_(comport) else hangup232; __eos;
  164.     end else begin
  165.       writeln('° Boss has acknowledged receipt of EMSI_DAT');
  166.       __logapp('Boss has acknowledged receipt of EMSI_DAT');
  167.     end; 
  168.  
  169.     temp := '*';                                    { read in '**EMSI_DAT' }
  170.     repeat comreceive(ch); capturewrite(ch) until (ch = '*');
  171.     repeat
  172.       if comreceive(ch) then temp := temp + ch;
  173.       capturewrite(ch);
  174.     until(pos('**EMSI_DAT', temp) > 0);
  175.     pp := 8;                                     { no '**' }
  176.     pack[1] := 'E'; pack[2] := 'M'; pack[3] := 'S'; pack[4] := 'I';
  177.     pack[5] := '_'; pack[6] := 'D'; pack[7] := 'A'; pack[8] := 'T';
  178.     len := '';                              { read in the length   }
  179.  
  180.     for loop := 1 to 4 do begin
  181.       delay(12); if comreceive(ch) then len := len + ch;
  182.       inc(pp); pack[pp] := ch; capturewrite(ch);
  183.     end;
  184.  
  185.     len_rec_emsi_dat := hex2dec(len);
  186.  
  187.     if debugmode then begin
  188.       writeln('Length of DAT: (', len, ') ', len_rec_emsi_dat, '.');
  189.       __logapp('Length of DAT: (' + len + ') ' + __num(len_rec_emsi_dat) + '.');
  190.     end;
  191.     packet := '';
  192.     for loop := 1 to len_rec_emsi_dat do begin   { read in the packet   }
  193.       delay(12); comreceive(ch); inc(pp); pack[pp] := ch; capturewrite(ch);
  194.     end;
  195.     crc := '';                                   { read in the crc      }
  196.     for loop := 1 to 4 do begin
  197.       delay(12); comreceive(ch); crc := crc + ch; capturewrite(ch);
  198.     end;
  199.  
  200.     if hex(crc16(pack)) <> crc then begin
  201.       writeln('! The recieved EMSI_DAT is corrupt!!!!');
  202.       __logapp('The recieved EMSI_DAT is corrupt!!!!');
  203.     end;
  204.  
  205.     __clr1024(pack); __app1024(pack, emsi_ack + #13); send1024(pack);
  206.   end; { EMSI mode }
  207.  
  208.  
  209.  
  210.  
  211.  
  212.