{$X+,V-,B-}
program ShSAPs;

{ Testprogram for the nwSAP unit / NwTP 0.6 (c) 1993,1995 R.Spronk }

{ Dump all incoming SAP broadcasts on screen;
  Sends -no- packets; receiving packets only }

{ Demonstrates
  -The use of the Service Advertizing Protocol;
  -Asynchronous handling of receiving and processing
   (using 1 receive ESR and intermediate buffers   }

uses crt,nwMisc,nwIPX,nwSAP;

CONST SAPsocket=$0452;
      BUFSIZ=511;
      { May 'hang' your WS if more than 70 SAP broadcast were received
        in a short interval (a few ticks). Increase the BUFSIZ value. }

Type TSAPserver=record
                ObjType:word;
                Name   :array[1..48] of byte; { asciiz }
                Address:TinternetworkAddress;
                Hops   :word;
                end;

     TSAPresponse=record
                  ResponseType:word; { 0002 General server; 0004 nearest server }
                  ServerEntry:array[1..7] of TSAPserver;
                  end;

Type String48=string[48];
     Tservices=record
               InUseFlag  :Byte; { 0: not being accessed by other threads }
               TimeStamp :Word; { Ticks / max 60. minutes }
               ObjType:word;
               Name   :array[1..48] of byte; { asciiz }
               Address:TinternetworkAddress;
               Hops   :word;
               end;

Var ServBuf:array[0..BUFSIZ] of TServices;
    ECBServBufInd:word; { 0..BUFSIZ }
    ServBufInd   :word; { 0..BUFSIZ }

    StartTicks:Longint;

    PktCount:word;

Var ReceiveEcb    :Tecb;
    IpxHdr        :TipxHeader;
    socket        :word;
    IPXreceiveBuffer: array[1..546] of byte;
    SAPreceiveBuffer: TSAPresponse absolute IPXreceiveBuffer;

    ReceivedBufLen:word;
    PacketReceived:boolean;

    RecString     :string;

    NewStack:array[1..1024] of word;  { !! used by ESR }
    StackBottom:word;                 { !! used by ESR }
    ESRctr:byte;                      { !! used by SAP ESR }


{$F+}
Procedure SAPListenESRhandler(Var p:Tpecb);
begin
if SAPreceiveBuffer.Responsetype=$0200 { 0002 hi-lo: general server SAP reply }
 then begin
      ESRctr:=1;
      while (ESRctr<=7) and (SAPreceiveBuffer.ServerEntry[ESRctr].ObjType>$0000)
       do begin
          while ServBuf[ECBservBufInd].inUseFlag>0
           do begin
              inc(ECBServBufInd);
              ECBservBufInd:=ECBservBufInd and BUFSIZ;
              end;
          with SAPreceiveBuffer.ServerEntry[ESRctr]
           do begin
              Move(ObjType,ServBuf[ECBServBufInd].ObjType,SizeOf(TSAPserver));
              ObjType:=$0000; { To mark that the entry has been dealt with;
                                to 'clear' receive buffer }
              end;
          with ServBuf[ECBServBufInd]
           do begin
              IPXgetIntervalMarker(TimeStamp);
              InUseFlag:=$FF;
              end;
          inc(ESRctr);
          end;
      PacketReceived:=true;
      inc(PktCount);
      end;
IPXListenForPacket(ReceiveECB);
end;
{$F-}

{$F+}
Procedure SAPListenESR; assembler;
asm { ES:SI are the only valid registers when entering this procedure ! }
    mov dx, seg stackbottom
    mov ds, dx

    mov dx,ss  { setup of a new local stack }
    mov bx,sp  { ss:sp copied to dx:bx}
    mov ax,ds
    mov ss,ax
    mov sp,offset stackbottom
    push dx    { push old ss:sp on new stack }
    push bx

    push es    { push es:si on stack as local vars }
    push si
    mov  di,sp

    push ss    { push address of local ptr on stack }
    push di
    CALL SAPListenEsrHandler

    add sp,4   { skip stack ptr-copy }
    pop bx     { restore ss:sp from new stack }
    pop dx
    mov sp,bx
    mov ss,dx
end;
{$F-}


Var ServerName:string;

begin
IF NOT IpxInitialize
 then begin
      writeln('Ipx needs to be installed.');
      halt(1);
      end;
socket:=SAPSocket;
IF NOT IPXopenSocket(Socket,SHORT_LIVED_SOCKET)
 then begin
      writeln('IPXopenSocket returned error# ',nwIPX.result);
      halt(1);
      end;

PktCount:=0;
ECBservBufInd:=0;
PacketReceived:=False;
{ Empty receive buffer (ReceiveEcb.fragment[2].address^) }
FillChar(IPXreceiveBuffer,546,#0);

{ Setup ECB and IPX header }
IPXsetupListenECB(Addr(SAPListenESR),SAPsocket,@IPXreceiveBuffer,546,
                  IpxHdr,ReceiveEcb);

IPXListenForPacket(ReceiveECB);

ServBufInd:=0;
REPEAT

 WHILE (ServBufInd<512) and (NOT keypressed)
  do begin
     IPXrelinquishControl;

     IF ServBuf[ServBufInd].InUseFlag>0
      then begin
           with ServBuf[ServBufInd]
            do begin
               writeln('---------');
               writeln('BufIndex:',ServBufInd);
               writeln('Timestamp: ',HexStr(TimeStamp,4));
               writeln('ObjType  : ',HexStr(swap(ObjType),4));
               ZStrCopy(ServerName,name[1],48);
               writeln('ServerNm : ',ServerName);
               writeln('Address  : ',HexDumpStr(Address,24));
               writeln('Hops     : ',HexStr(swap(Hops),4));
               end;
           ServBuf[ServBufInd].InUseFlag:=0;
           end;

     inc(ServBufInd);ServBufInd:=ServBufInd and BUFSIZ;
     end;

UNTIL KeyPressed;

IF NOT IPXcloseSocket(SAPsocket)
 then writeln('IPXcloseSocket returned error# ',nwIPX.result);

end.