home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / chat / phone.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-07-13  |  14.5 KB  |  427 lines
  1. program phone;
  2. uses
  3.     IPXUNIT, crt;
  4. const
  5.      Socket           =  $5678;                   { I/O Socket Number}
  6. var
  7.    EcbSend, EcbRead   :  Ecb;                     { Definition of ECBs        }
  8.    SendIpxHeader,
  9.    ReadIpxHeader      :  IpxHeader;               { Definition of IPX Headers }
  10.    SendData, ReadData :  array [1..5] of byte;    { Data area of packets      }
  11.    ConNbrRec          :  ConNbrArr;               { Connection Number Struc   }
  12.    NetNod             :  NetWrkAdr;               { Structure for InterNetwork
  13.                                                     addresses                 }
  14.    LocalTarget        :  NodType;                 { Node Address              }
  15.    I                  :  word;
  16.    readflg            :  boolean;                 { Flag to signal received
  17.                                                     packets                   }
  18.    myx,myy,rx,ry      :  byte;                    {  ViewPorts cursor position}
  19. {-----------------------------------------------------------------------------}
  20. {$F+$S-}                                          {Far proc, No stack checking}
  21. Procedure EsrHandler;
  22. begin
  23.      inline($06                                     { push  es                }
  24.            /$1f                                     { pop   ds                }
  25.            );
  26.      readflg:=true;
  27. end;
  28. {-----------------------------------------------------------------------------}
  29. procedure ZeroHeader(var Header : IpxHeader);
  30. var
  31.    Hseg, Hofs,i : word;
  32. begin
  33.      Hseg:=seg(Header);
  34.      Hofs:=ofs(Header);
  35.      for i:=0 to sizeof(Header)-1 do mem[Hseg:Hofs+i]:=0;
  36. end;
  37. {-----------------------------------------------------------------------------}
  38. procedure ZeroEcb(var EcbBlk : Ecb);
  39. var
  40.    Hseg, Hofs,i : word;
  41. begin
  42.      Hseg:=seg(EcbBlk);
  43.      Hofs:=ofs(EcbBlk);
  44.      for i:=0 to sizeof(EcbBlk)-1 do mem[Hseg:Hofs+i]:=0;
  45. end;
  46. {-----------------------------------------------------------------------------}
  47. procedure Send;
  48. var
  49.    i   :  word;
  50. begin
  51.      ZeroHeader(SendIpxHeader);                              {Clear IPX Header}
  52.      with SendIpxHeader do
  53.        begin
  54.          PacketType:=IPX_PACKET_TYPE;                        {Assign Pack Type}
  55.          Destination.NetworkNumber:=NetNod.NetworkNumber;    {Fill in Internet}
  56.          Destination.NodeAddress  :=NetNod.NodeAddress;      {address         }
  57.          DestinationSocket:=Swap(Socket);                    {Fill in DSOCKET }
  58.        end;
  59.      ZeroEcb(ECbSend);                                       {Clear Ecb       }
  60.      with EcbSend do
  61.        begin
  62.          SocketNumber:=Swap(Socket);                         {Fill in Socket, }
  63.          for i:=1 to 6 do
  64.              ImmediateAddress[i]:=LocalTarget[i];            {Immediate Addr, }
  65.          FragmentCount:=2;                                   {And fragments   }
  66.          FragmentDescriptor[1].Adr:=Addr  (SendIpxHeader);
  67.          FragmentDescriptor[1].Len:=sizeof(SendIpxHeader);
  68.          FragmentDescriptor[2].Adr:=Addr  (SendData);
  69.          FragmentDescriptor[2].Len:=sizeof(SendData);
  70.        end;
  71.      IpxSendPacket(EcbSend);                                 { Send packet    }
  72. end;
  73. {-----------------------------------------------------------------------------}
  74. procedure Listen;
  75. begin
  76.      ZeroHeader(ReadIpxHeader);                              {Clear IPX Header}
  77.  
  78.      ZeroEcb(EcbRead);                                       {Clear Ecb       }
  79.      with EcbRead do
  80.        begin
  81.          EventServiceRoutine:=addr(EsrHandler);              {Establish ESR   }
  82.          SocketNumber:=Swap(Socket);                         {Fill in socket, }
  83.          FragmentCount:=2;                                   {and fragments   }
  84.          FragmentDescriptor[1].Adr:=Addr  (ReadIpxHeader);
  85.          FragmentDescriptor[1].Len:=sizeof(ReadIpxHeader);
  86.          FragmentDescriptor[2].Adr:=Addr  (ReadData);
  87.          FragmentDescriptor[2].Len:=sizeof(ReadData);
  88.        end;
  89.      IpxReadPacket(EcbRead);
  90. end;
  91. {-----------------------------------------------------------------------------}
  92. function TestConnection : boolean;
  93. var
  94.    i : byte;
  95. begin
  96.      TestConnection:=TRUE;
  97.      for i:=1 to 6 do
  98.        begin
  99.          if ReadIpxHeader.Source.NodeAddress[i] <>
  100.             SendIpxHeader.Destination.NodeAddress[i]
  101.             then TestConnection:=FALSE;
  102.        end;
  103. end;
  104. {-----------------------------------------------------------------------------}
  105. procedure HandShake;
  106. const
  107.      Progress  :  array [1..4] of char = ('/','─','\','|');
  108. var
  109.    Cnt         :  integer;
  110.    message     :  string;
  111.    ConInfoRec  :  ConnInfo;
  112.    i           :  byte;
  113.    x,y         :  byte;
  114.    ptr, car    :  byte;
  115.    h, m,s,hund :  Word;
  116.    ConnUp      :  boolean;
  117.    UserID      :  string;
  118. begin
  119.      UserID:=paramstr(1);
  120.      for i:=1 to Length(UserID) do UserID[i]:=upcase(UserID[i]);
  121.      Writeln('Calling User ',UserID);
  122.      Write('Press <ESC> to cancel [ ]');
  123.      x:=wherex-2; y:=wherey;
  124.      Userinfo(LocalConnectionNumber,ConInfoRec);
  125.      Message:='User ';
  126.      Cnt:=1;
  127.      while ConInfoRec.ObjectName[Cnt] <> 0 do
  128.        begin
  129.          message:=message+chr(ConInfoRec.ObjectName[Cnt]);
  130.          inc(Cnt);
  131.        end;
  132.      Message:=Message+' is phoning you........... [';
  133.      Message:=Message+Time+']';
  134.      Cnt:=0; Ptr:=1;
  135.  
  136.      SendMessage(ConNbrRec.Connections[1],message);
  137.      Listen;
  138.      car:=$ff;
  139.      ConnUp:=False;
  140.      repeat
  141.        gotoxy(x,y);
  142.        write(Progress[ptr]);
  143.        inc(ptr);
  144.        if ptr > 4 then
  145.          begin
  146.            ptr:=1;
  147.            SendData[1]:=LocalConnectionNumber;
  148.            Send;
  149.          end;
  150.        inc(Cnt);
  151.        if Cnt = 30 then
  152.          begin
  153.            SendMessage(ConNbrRec.Connections[1],message);
  154.            Cnt:=0;
  155.          end;
  156.        delay(1000);
  157.        if readflg then
  158.          begin
  159.               if not TestConnection then
  160.                  begin
  161.                    readflg:=false;
  162.                    Listen;
  163.                  end
  164.               else ConnUp:=TRUE;
  165.          end;
  166.        if keypressed then car:=ord(readkey);
  167.      until (car = $1b) or ConnUp;
  168.      if car = $1b then
  169.        begin
  170.          Writeln;
  171.          Write('Wait...');
  172.          Delay(5000);
  173.          SendData[1]:=$1b;
  174.          Send;
  175.          message:='The user phoning you canceled the call... ['+Time+']';
  176.          SendMessage(ConNbrRec.Connections[1],message);
  177.          IpxDeleteSocket(Socket);
  178.          halt(1);
  179.        end;
  180.      Writeln;
  181.      Write('User ',Paramstr(1),' answered your call......!');
  182.      delay(1200);
  183.      ReadFlg:=false;
  184. end;
  185. {-----------------------------------------------------------------------------}
  186. procedure MyWindow;
  187. begin
  188.      Window(1,5,80,12);
  189.      gotoxy(myx,myy);
  190. end;
  191. {-----------------------------------------------------------------------------}
  192. procedure RemoteWindow;
  193. begin
  194.      Window(1,17,80,24);
  195.      gotoxy(rx,ry);
  196. end;
  197. {-----------------------------------------------------------------------------}
  198. procedure InitWindows;
  199. var
  200.    i          :  integer;
  201.    LocalNode  :  NetWrkAdr;
  202.    ConInfoRec :  ConnInfo;
  203. begin
  204.      ClrScr;
  205.      myx:=1; myy:=1;
  206.      rx:=1;  ry:=1;
  207.      gotoxy(1,1);
  208.      write('╔'); for i:=2 to 79 do write('═'); write('╗');
  209.      write('║'); for i:=2 to 79 do write(' '); write('║');
  210.      write('╚'); for i:=2 to 79 do write('═'); write('╝');
  211.  
  212.      GetInternetAddress(LocalConnectionNumber,LocalNode);
  213.      UserInfo(LocalConnectionNumber,ConInfoRec);
  214.      gotoxy(3,2);
  215.      Write('User: ');
  216.      for i:=1 to 10 do write(chr(ConInfoRec.ObjectName[i]));
  217.      Write(' ░ Node: ');
  218.      for i:=1 to 6 do
  219.        begin
  220.          WriteHexByte(LocalNode.NodeAddress[i]);
  221.          if i <> 6 then write('.');
  222.        end;
  223.      Write(' ░ Net: ');
  224.      for i:=1 to 4 do
  225.        begin
  226.          WriteHexByte(LocalNode.NetworkNumber[i]);
  227.          if i <> 4 then write ('.');
  228.        end;
  229.      Write(' ░ Connection: '); write(LocalConnectionNumber);
  230.  
  231.      gotoxy(1,13);
  232.      write('╔'); for i:=2 to 79 do write('═'); write('╗');
  233.      write('║'); for i:=2 to 79 do write(' '); write('║');
  234.      write('╚'); for i:=2 to 79 do write('═'); write('╝');
  235.  
  236.      UserInfo(ConNbrRec.Connections[1],ConInfoRec);
  237.      gotoxy(3,14);
  238.      Write('User: ');
  239.      for i:=1 to 10 do write(chr(ConInfoRec.ObjectName[i]));
  240.      Write(' ░ Node: ');
  241.      for i:=1 to 6 do
  242.        begin
  243.          WriteHexByte(NetNod.NodeAddress[i]);
  244.          if i <> 6 then write('.');
  245.        end;
  246.      Write(' ░ Net: ');
  247.      for i:=1 to 4 do
  248.        begin
  249.          WriteHexByte(NetNod.NetworkNumber[i]);
  250.          if i <> 4 then write ('.');
  251.        end;
  252.      Write(' ░ Connection: '); write(ConNbrRec.Connections[1]);
  253.  
  254.      gotoxy(26,25);
  255.      Write('▒▒▒▓▓▓ Phone Utility ▓▓▓▒▒▒');
  256.      gotoxy(1,1);
  257.      RemoteWindow;
  258.      MyWindow;
  259.      HighVideo;
  260. end;
  261. {-----------------------------------------------------------------------------}
  262. procedure Talk;
  263. begin
  264.      InitWindows;
  265.      Listen;
  266.      repeat
  267.            if keypressed then
  268.              begin
  269.                   MyWindow;
  270.                   SendData[1]:=ord(Readkey);
  271.                   if SendData[1]=13 then writeln
  272.                   else write(chr(SendData[1]));
  273.                   myx:=wherex; myy:=wherey;
  274.                   send;
  275.              end;
  276.            if readflg then
  277.              begin
  278.                   If TestConnection then
  279.                     begin
  280.                        RemoteWindow;
  281.                        if ReadData[1]=13 then writeln
  282.                        else write(chr(ReadData[1]));
  283.                        rx:=wherex; ry:=wherey;
  284.                     end;
  285.                   readflg:=false;
  286.                   Listen;
  287.              end;
  288.      until (ReadData[1]=$1b) or (SendData[1]=$1b);
  289.      SendData[1]:=$1b; send;
  290.      IpxDeleteSocket(Socket);
  291.      Writeln; Writeln;
  292.      writeln('<Hanging Up...........>');
  293.      Delay(3000);
  294.      Window(1,1,80,25);
  295.      LowVideo;
  296.      gotoxy(80,25);
  297. end;
  298. {-----------------------------------------------------------------------------}
  299. procedure Setup;
  300. begin
  301.      readflg:=false;
  302.      if not IpxPresent then writeln('IPX Not Installed');
  303.      if not IpxCreateSocket(Socket) then writeln('Error Opening Socket');
  304. end;
  305. {-----------------------------------------------------------------------------}
  306. procedure CallUser;
  307. begin
  308.      GetInternetAddress(ConNbrRec.Connections[1],NetNod);
  309.      GetLocalTarget(NetNod,Socket,LocalTarget);
  310.      HandShake;
  311.      Talk;
  312. end;
  313. {-----------------------------------------------------------------------------}
  314.  
  315. procedure Process_Input_Command;
  316. var
  317.    ConNbr  :  byte;
  318.    Code    :  integer;
  319.    UserID  :  String;
  320.    i       :  integer;
  321. begin
  322.      UserID:=paramstr(1);
  323.      for i:=1 to length(UserID) do UserID[i]:=upcase(UserID[i]);
  324.      Case ParamCount of
  325.          0  : begin
  326.                 Listen;
  327.                 Delay(6000);
  328.                 If not readflg then
  329.                   begin
  330.                        Writeln;
  331.                        Writeln('Nobody is Calling you..........');
  332.                        IpxDeleteSocket(Socket);
  333.                        halt(1);
  334.                   end
  335.                 else
  336.                   begin
  337.                        readflg:=false;
  338.                        ConNbrRec.Connections[1]:=ReadData[1];
  339.                        GetInternetAddress(ConNbrRec.Connections[1],NetNod);
  340.                        GetLocalTarget(NetNod,Socket,LocalTarget);
  341.                        SendData[1]:=LocalConnectionNumber;
  342.                        Send;
  343.                        Talk;
  344.                   end;
  345.               end;
  346.  
  347.          1  : begin
  348.                 GetConnections(UserID,ConNbrRec);
  349.                 if ConNbrRec.Count = 0 then
  350.                   begin
  351.                     Writeln;
  352.                     Writeln('User ID not available......');
  353.                     IpxDeleteSocket(Socket);
  354.                     halt(1);
  355.                   end;
  356.                 if (ConNbrRec.Count = 1) and
  357.                    (ConNbrRec.Connections[1] =  LocalConnectionNumber) then
  358.                   begin
  359.                     Writeln;
  360.                     Writeln('Phoning YourSelf ????');
  361.                     IpxDeleteSocket(Socket);
  362.                     halt(1);
  363.                   end;
  364.                 if ConNbrRec.Count = 1 then CallUser
  365.                 else
  366.                   begin
  367.                        Writeln;
  368.                        Writeln('User ',Paramstr(1),' has multiple sessions');
  369.                        Writeln('Please specify Connection Number..........');
  370.                        IpxDeleteSocket(Socket);
  371.                        halt(1);
  372.                   end;
  373.               end;
  374.          2  : begin
  375.                 val(paramstr(2),ConNbr,Code);
  376.                 if code <> 0 then
  377.                   begin
  378.                     Writeln;
  379.                     Writeln('Invalid Connection Number Entered.....');
  380.                     halt(1);
  381.                   end;
  382.                 GetConnections(UserID,ConNbrRec);
  383.                 if ConNbrRec.Count = 0 then
  384.                   begin
  385.                     Writeln;
  386.                     Writeln('User ID not available......');
  387.                     IpxDeleteSocket(Socket);
  388.                     halt(1);
  389.                   end;
  390.                 for code:=1 to ConNbrRec.Count do
  391.                   begin
  392.                     if ConNbrRec.Connections[code] = ConNbr then
  393.                        ConNbrRec.Connections[1]:=ConNbr;
  394.                   end;
  395.                 if (ConNbrRec.Connections[1] =  LocalConnectionNumber) then
  396.                   begin
  397.                     Writeln;
  398.                     Writeln('Phoning YourSelf ????');
  399.                     IpxDeleteSocket(Socket);
  400.                     halt(1);
  401.                   end;
  402.                 if ConNbrRec.Connections[1] = ConNbr then CallUser
  403.                 else
  404.                   begin
  405.                     Writeln;
  406.                     Writeln('Connection: ',paramstr(2),' does not exist');
  407.                     IpxDeleteSocket(Socket);
  408.                     halt(1);
  409.                   end;
  410.               end;
  411.          else
  412.               begin
  413.                 Writeln;
  414.                 Writeln;
  415.                 Writeln('Phone Utility Command Syntax: ');
  416.                 Writeln;
  417.                 Writeln('Phone [[UserId] [Connection Number]]');
  418.                 halt(1);
  419.               end;
  420.      end; {Case}
  421. end;
  422. {-----------------------------------------------------------------------------}
  423. {-----------------------------------------------------------------------------}
  424. begin
  425.      Setup;
  426.      Process_Input_Command;
  427. end.