home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / LANTAS.ZIP / NCBTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-02  |  1.8 KB  |  73 lines
  1. PROGRAM NCB_Test;
  2.  
  3. USES CRT,DOS,NCB;
  4.  
  5. VAR  NCB_Result : Byte;
  6.      Send_Block : _NCB;
  7.      Recv_Block : _NCB;
  8.      Number     : Byte;
  9.  
  10.      Message    : String;
  11.      Key        : Char;
  12.      Buffer     : String;
  13.  
  14. PROCEDURE UsrProc; ASSEMBLER;
  15. ASM
  16.    NOP
  17.    IRET
  18. END;
  19.  
  20. BEGIN
  21.    NCB_CLEAR_BLOCK(Send_Block);
  22.  
  23.    IF (ParamStr(1) = 'ONE') THEN
  24.    NCB_Result := NCB_ADD_NAME(Send_Block,'ONE','TWO')
  25.    ELSE
  26.    NCB_Result := NCB_ADD_NAME(Send_Block,'TWO','ONE');
  27.  
  28.    { You can assign an asterix (*) as second name. The ADD_NAME-function
  29.      has wildcard-facility !!! }
  30.  
  31.    Message := 'TEST-MESSAGE USING NETBIOS...';
  32.  
  33.    IF (NCB_Result IN [00,18]) THEN
  34.    BEGIN
  35.      Number := Send_Block.NCB_NUM;
  36.  
  37.  
  38.      REPEAT
  39.        ClrScr;
  40.        WriteLn('Our name-number is : ',Number);
  41.        WriteLn;
  42.        WriteLn('Press S to send Message, L for Listening or Q to Quit...');
  43.  
  44.        Key := UpCase(ReadKey);
  45.        CASE Key OF
  46.          'L' : BEGIN
  47.                  WriteLn('I''m listening for a message...');
  48.                  NCB_Result := NCB_RECV_DATAGRAM(Send_Block,Seg(Buffer),Ofs(Buffer),255,Addr(UsrProc));
  49.                  IF (NCB_Result = 00) THEN
  50.                  BEGIN
  51.                    GotoXY(1,24); WriteLn(Buffer);
  52.                    Delay(2000);
  53.                  END;
  54.                END;
  55.          'S' : BEGIN
  56.                  NCB_Result := NCB_SEND_DATAGRAM(Send_Block,Seg(Message),Ofs(Message),Length(Message)+1);
  57.                  WriteLn('Message Sended...RETCODE = ',NCB_Result);
  58.                  Delay(2000);
  59.                END;
  60.        END;
  61.      UNTIL Key = 'Q';
  62.      NCB_Result := NCB_HANG_UP(Send_Block);
  63.    END;
  64.  
  65.    NCB_Result := NCB_DELETE_NAME(Send_Block);
  66.  
  67.    IF (NCB_Result = NRC_GOODRET) THEN
  68.    WriteLn('Session successfully released...') ELSE
  69.    WriteLn('Releasing Session failed...');
  70. END.
  71.  
  72.  
  73.