home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / chat10.zip / CHAT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-05  |  7KB  |  235 lines
  1. uses use32, sock, os2base, os2def, crt, strings, strstf;
  2.  
  3. type
  4.   userrec = record
  5.     nick: string;
  6.     socket: integer;
  7.     host: string;
  8.   end;
  9.  
  10. const
  11.   maxusers = 50;
  12.  
  13. var
  14.   lsock, csock: integer;
  15.   server, client: sockaddr_in;
  16.   threadid, i: integer;
  17.   li: longint;
  18.   chatport: ushort;
  19.   c: char;
  20.   csema: hmtx;
  21.   user: array[1..maxusers] of userrec;
  22.   numusers: byte;
  23.   ip: phostent;
  24.   s: string;
  25.   topic: string;
  26.  
  27. function pad(p, p1: string; spaces: integer): string;
  28. var
  29.   i: integer;
  30. begin
  31.   for i:=length(p) to spaces do
  32.     p:=p+' ';
  33.   p:=p+p1;
  34.   pad:=p;
  35. end;
  36.  
  37. procedure sendtoall(s: string);
  38. var i: integer;
  39. begin
  40.   dosrequestmutexsem(csema, sem_Indefinite_Wait);
  41.   for i:=1 to numusers do
  42.     sendstring(user[i].socket, s+crlf);
  43.   dosreleasemutexsem(csema);
  44. end;
  45.  
  46. procedure addnick(sock: integer; nick: string);
  47. var i: integer;
  48. begin
  49.   for i:=1 to numusers do
  50.     if user[i].socket = sock then user[i].nick:=nick;
  51. end;
  52.  
  53. procedure delnick(nick: string);
  54. var i, j: integer;
  55. begin
  56.   for i:=1 to numusers do
  57.     if scmp(user[i].nick, nick) then
  58.       begin
  59.         for j:=i+1 to numusers do
  60.           move(user[j], user[j-1], sizeof(user[j]));
  61.       end;
  62.   dec(numusers);
  63.   for i:=numusers+1 to maxusers do
  64.     fillchar(user[i], sizeof(user[i]), #0);
  65. end;
  66.  
  67. function checkuser(nick: string): boolean;
  68. var i: integer;
  69. begin
  70.   for i:=1 to numusers do
  71.     if scmp(nick, user[i].nick) then
  72.       begin
  73.         checkuser:=true;
  74.         exit;
  75.       end else checkuser:=false;
  76. end;
  77.  
  78. function cleanstr(s: string): string;
  79. var
  80.   i: integer;
  81.   s1: string;
  82. begin
  83.   while pos(#8, s)>0 do delete(s, pos(#8, s)-1, 2);
  84.   while pos(#127, s)>0 do delete(s, pos(#8, s)-1, 2);
  85.   s1:='';
  86.   for i:=1 to length(s) do
  87.     if s[i] in [' '..'~'] then s1:=s1+s[i];
  88.   cleanstr:=s1;
  89. end;
  90.  
  91. function chat(p: pointer): integer;
  92. var
  93.   nick: string;
  94.   chatsock: integer;
  95.   buf: array[1..512] of char;
  96.   buflen, i: integer;
  97.   dead, gotnick: boolean;
  98.   s, cmd: string;
  99. begin
  100.   chatsock:=integer(p^);
  101.   sendstring(chatsock, 'Welcome to dink''s chatter!'+crlf);
  102.   gotnick:=false;
  103.   sendstring(chatsock, 'input your name: ');
  104.   repeat
  105.     if getstr(chatsock, @buf, 250, dead) then
  106.       begin
  107.         s:=cleanstr(truncstr(strpas(@buf)));
  108.         if length(s)>20 then
  109.           begin
  110.             sendstring(chatsock, 'YEESH!  keep it under 20 characters.'+crlf);
  111.             sendstring(chatsock, 'input your name: ');
  112.           end else
  113.         if length(s)=0 then
  114.           begin
  115.             sendstring(chatsock, 'You must enter SOMETHING!'+crlf);
  116.             sendstring(chatsock, 'input your name: ');
  117.           end else
  118.         if checkuser(s)=false then
  119.           begin
  120.             nick:=s;
  121.             addnick(chatsock, nick);
  122.             gotnick:=true;
  123.           end else
  124.           begin
  125.             sendstring(chatsock, 'Someone is allready using that name!'+crlf);
  126.             sendstring(chatsock, 'input your name: ');
  127.           end;
  128.       end else dossleep(1);
  129.   until gotnick or dead;
  130.   if dead then
  131.     begin
  132.       str(chatsock, s);
  133.       delnick('new'+s);
  134.       soclose(chatsock);
  135.       exit;
  136.     end;
  137.   sendtoall('* '+nick+' Has entered the chatter!');
  138.   sendstring(chatsock, 'Type /help to get... help!'+crlf);
  139.   if topic<>'' then sendstring(chatsock, 'The topic is: '+topic+crlf);
  140.   repeat
  141.     if getstr(chatsock, @buf, 250, dead) then
  142.       begin
  143.         s:=cleanstr(truncstr(strpas(@buf)));
  144.         if s[1]='/' then
  145.           begin
  146.             delete(s, 1, 1);
  147.             cmd:=token(' ', s);
  148.             s:=truncstr(s);
  149.             if scmp('WHO', cmd) then
  150.               begin
  151.                 sendstring(chatsock, 'User Listing'+crlf+'------------'+crlf);
  152.                 for i:=1 to numusers do
  153.                   sendstring(chatsock, pad(user[i].nick, '('+user[i].host+')', 20)+crlf);
  154.                 sendstring(chatsock, '------------'+crlf);
  155.               end else
  156.             if scmp('QUIT', cmd) or scmp('BYE', cmd) or scmp('EXIT', cmd) then
  157.               begin
  158.                 sendstring(chatsock, 'Cya later..'+crlf);
  159.                 dead:=true;
  160.               end else
  161.             if scmp('HELP', cmd) or scmp('?', cmd) then
  162.               begin
  163.                 sendstring(chatsock, 'Available commands:'+crlf);
  164.                 sendstring(chatsock, '  /who   - display whos currently online'+crlf);
  165.                 sendstring(chatsock, '  /topic - change the topic'+crlf);
  166.                 sendstring(chatsock, '  /bye   - get outta here!'+crlf);
  167.                 sendstring(chatsock, '-------------------'+crlf);
  168.               end else
  169.             if scmp('TOPIC', cmd) or scmp('T', cmd) then
  170.               begin
  171.                 if s<>'' then
  172.                   begin
  173.                     topic:=s;
  174.                     sendtoall('* '+nick+' Has changed the topic to: '+topic);
  175.                   end else sendstring(chatsock, 'usage: /topic <the topic>'+crlf);
  176.               end else
  177.                 sendstring(chatsock, 'Thats not a command!  Try /help'+crlf);
  178.           end else
  179.         if (s<>'') then sendtoall('<'+nick+'> '+s);
  180.       end else dossleep(1);
  181.   until dead=true;
  182.   sendtoall('* '+nick+' Has now left the building!');
  183.   soclose(chatsock);
  184.   delnick(nick);
  185. end;
  186.  
  187. begin
  188.   if paramcount=0 then
  189.     begin
  190.       writeln('usage: chat.exe <port>');
  191.       halt;
  192.     end;
  193.   val(paramstr(1), i, li);
  194.   if li=0 then chatport:=i else
  195.     begin
  196.       writeln('port specified on command line is invalid!');
  197.       writeln('use a number between 1024 and 64738.');
  198.       halt;
  199.     end;
  200.   lsock:=socket(af_inet, sock_stream, 0);
  201.   fillchar(server, sizeof(server), #0);
  202.   server.sin_family:=af_inet;
  203.   server.sin_port:=htons(chatport);
  204.   server.sin_addr.s_addr:=inaddr_any;
  205.   if (bind(lsock, server, sizeof(server))<>0) then
  206.     begin
  207.       psock_errno('bind()');
  208.       halt;
  209.     end;
  210.   listen(lsock, 5);
  211.  
  212.   fillchar(user, sizeof(user), #0);
  213.   numusers:=0;
  214.   topic:='';
  215.   doscreatemutexsem(nil, csema, 0, False);
  216.  
  217.   writeln('chat server active on port ', chatport);
  218.   writeln('hit ctrl-c to quit.');
  219.  
  220.   i:=sizeof(client);
  221.   repeat
  222.     csock:=accept(lsock, client, i);
  223.     inc(numusers);
  224.     user[numusers].socket:=csock;
  225.     user[numusers].host:=inet_ntos(client.sin_addr.s_addr);
  226.     str(csock, s);
  227.     user[numusers].nick:='new'+s;
  228.     ip := gethostbyaddr(@client.sin_addr.s_addr, sizeof(ulong), AF_INET);
  229.     if ip<>nil then user[numusers].host:=strpas(ip^.h_name);
  230.  
  231.     BeginThread(nil, 20*1024, chat, @csock, create_Ready, threadid);
  232.   until 1=2;
  233. end.
  234.  
  235.