[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]

    {
    From: S0730076@let.rug.nl (ill)

    I wrote a chatbox with one of those ipx units. Pretty standard but funny
    because you can send the other guy screentrashes and beeps and buzzes etc.

    I dare not post it here cause Timo is gonna flame me with that standard
    'don't post any binaries' file so mail me if you want it. I'll include
    source from the main file here, but you can't compile it without some
    other units I'm afraid.
    }

    {$R+}
    uses ipx, crt,ill,win, novell, strings;

    const
         receive_socket = $7713;
         send_socket = $6613;
         starty = 7;
         maxy = 9;
         maxlen = 77;
         versie = 'Nag 0.81';

    procedure abort(message:string);
    begin
         writeln(message);
         halt(1);
    end;

    var
       i                          : byte;
       x,y,xx                     : word;
       connection_number          : word;
       network_number             : networkNumber;
       network_node               : networkNode;
       receive_ecb,send_ecb       : ECB;
       receive_header,send_header : IPXHeader;
       send_message, receive_message : MessageSTR;
       done                        : boolean;
       message,naam                : string;
       code, station               : integer;
       InStrings                   : array[1..maxy] of string[maxlen];
       blinking          : boolean;

    procedure info(txt : string);
    begin
     txt := 'Ä'+txt +
    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'
     writeline(copy(txt,1,78), 1, 16, black, lightgray);
    end;
    procedure writeInStrings;
    var q: integer;
        col : word;
    begin
    col := lightgray;
    if blinking then col := col + blink;
    for q := 1 to maxy do
         writeline(InStrings[q], 1, q + starty-1,col, black);
    end;

    procedure wipe;
    var q : integer;
    begin
    blinking := false;
    info('Your screen is being wiped');
    for q := 1 to maxy do
    begin
        inStrings[q] :=
    '
    ';
    writeInstrings;
    clrscr;
    x := 0;
    y := 1;
    end;
    end;

    procedure shit(ki : keytype; var shitty : char);
    begin
         shitty := #0;
         case ki of
              f1 : begin
                       info('Sending BUZZ to '+paramstr(1));
                       shitty := #201;
                  end;
              f2 :   begin
                         info('Sending BEEP to '+paramstr(1));
                         shitty := #202;
                    end;
              f3 : begin
                       info('Sending FLASH to '+paramstr(1));
                       shitty := #203;
                  end;
              f4: begin
                      info('Calling '+paramstr(1)+' a sucker');
                      shitty := #204;
                 end;
             f5: begin
                      info('Blinking your text on '+paramstr(1)+'''s screen');
                      shitty := #205;
                 end;
             f6: begin
                      info('Trashing the other guy''s screen');
                      shitty := #206;
                 end;
              f10: wipe;

         end;
    end;

    procedure flash;
    var q : integer;
    begin
         info('The other guy is making your screen flash!');
    for q := 1 to 10 do
    begin
         open_win(1,1,80,24, white, white);
         delay(10);
         close_win;
    end;
    end;

    procedure init;
    begin
      if paramcount < 1 then abort('Usage: Nag <username>');
      if not IPXinstalled then abort('IPX not loaded');
      connection_number := Get1stConnectionNumber(paramstr(1));
      if connection_number = 0 then abort(paramstr(1) + ' not found. ');
      if GetInternetAddress(connection_number,network_number,network_node)
        <> 0 then abort(paramstr(1) + 'network error.');
      IpxCloseSocket(send_socket);
      if IPXOpenSocket(send_socket) <> 0 then abort('Socket error.');
      IPXCloseSocket(receive_socket);
      if IPXOpenSocket(receive_socket) <> 0 then abort('Socket error.');
      done := false;
      zeroecb(receive_ecb);
      zeroecb(send_ecb);
      y := 1;
      xx := 1;
      getstation(station,code);
      getuser(station, naam, code);
      message := naam + ' wants to nag. Type Nag '+naam;
      send_message_to_username(paramstr(1), message, code);
      wipe;
    end;

    procedure funkysound;
    var q : integer;
    begin
         info('Receiving birdnoise');
         q := 3000;
         while q > 20 do
         begin
              sound(q);
              delay(1);
              dec(q,100);
         end;
         nosound;
    end;

    procedure trash;
    var q,x,y : word;
    begin
         randomize;
         for q := 1 to 50 do
         begin
             x := random(76)+2;
             y := random(25-starty) + starty;
             fastwrite(x,y,'#',x, y);
             sound(8000);
             delay(1);
             nosound;
         end;
    end;

    procedure receive_shit(i : integer);
    begin
         case i - 200 of
              1 : begin info(paramstr(1)+' is buzzing');
                  sound(50); delay(500); nosound; end;
              2 : funkysound;
              3 : flash;
              4 : info('SUCKER!');
              5 : blinking := true;
              6 : trash;
          end;
    end;

    procedure receive;
    var q : integer;
    begin
    if (receive_ecb.completion_code = 0) and (receive_ecb.in_use = 0) then
    begin
         IPXReceive(receive_ecb, receive_header, receive_socket,
                @receive_message, sizeof(receive_message));
          if (receive_message < #210) and (receive_message > #200) then
          begin
             receive_shit(ord(receive_message[1]));
             exit;
          end;

          if (receive_message = chr(8)) then
          begin
               InStrings[y][x] := ' ';
               if x > 0 then
                  dec(x);
          end else
               begin
                   inc(x);

                  if receive_message <> chr(13)  then
                        InStrings[y][x] := receive_message[1];
                  if (receive_message = chr(13)) or (x >= maxlen) then
                   begin
                        inc(y);
                        x := 0;
                   end;
                   if y =  maxy then
                   begin
                        y := maxy - 1;
                        x := 0;
                        for q := 1 to maxy - 1 do
                            instrings[q] := instrings[q+1]+
    '                                                                            ';
                   end;
              end;
              writeInStrings;
      end;
    end;

    procedure send;
    var special : boolean;
        skey    : keytype;
        r, sr       : char;
    begin
         inkey(special, skey,r);
         if ord(r) > 200 then
            exit;
         shit(skey, sr);
         if (sr = #0) and (special) and (skey <> cr) and (skey <> bksp)
            and (skey <> esc) then
                exit;
              if sr = #0 then
              begin
                  send_message := r;
                  write(send_message);
              end
              else
                  send_message := sr;
              if send_message = #8 then
              begin
                   write(' ');
                   write(chr(8));
              end;
              if send_message = #13 then writeln;
              IPXSend(network_number, network_node, receive_socket, @send_message,
                  length(send_message)+1, send_ecb,  send_header, send_socket);
              if (send_message = chr(27)) or (receive_message= chr(27)) then
              done := true;
    end;

    begin
     ini_win;
      open_win(1,1,80,24,black,black);
      init;
      receive;
      x := 0;
      clrscr;
     open_win(1,starty,80,24, lightgray, black);
     open_win(1,17,80,24, black, lightgray);
     info(versie+' 1995 Willem van de Vis   Esc to quit.');
     writeline('F1 buzz F2 bird F3 flash F4 sucker F5 blink F6 trash F10 clear',
                   2, starty-1, black, lightgray);

     textcolor(black);
      repeat
        receive;
      IPXRelinquishControl;
      if keypressed then
       send;
     until done;
     IPXCloseSocket(send_socket);
     IPXCloseSocket(receive_socket);
     end_win;
     writeln('no more nagging.');
    end.

[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]