home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / CEL141.ZIP / CEL141C.ZIP / TOOLKIT.ZIP / CHAT-SA.PAS next >
Pascal/Delphi Source File  |  1992-08-14  |  4KB  |  202 lines
  1. program ChatSa;   {Standalone Multinode Chat}
  2.  
  3. uses dos,crt,winttt5,fastttt5,gensubs;
  4.  
  5. type setuprec=record
  6.      nodechatpath:string[80];
  7.      forec,
  8.      backc:byte;
  9.      nodes:byte;
  10.      end;
  11.  
  12. type
  13.         NodeIDRec=record
  14.             Username:string[15];
  15.             ChatAvail:boolean;
  16.             ChatRequest:byte;
  17.             Activity:byte;
  18.             Update:longint;
  19.             end;
  20.  
  21.     ChatRec=record
  22.         node:byte;
  23.         who:string[30];
  24.         CurTalk:byte;
  25.         talk:array[1..10] of string[80];
  26.         end;
  27.  
  28. const
  29.   nodes=6;
  30.   forec=7;
  31.   backc=1;
  32.  
  33. var
  34.     Save1CVector: Procedure;
  35.     OldVector,
  36.     Eproc                : pointer;
  37.     TimePtr            : ^longint;
  38.   timeclicks  : Longint;
  39.   Last        : Longint;
  40.   LastLine    : Byte;
  41.   NodeChatPath: string;
  42.  
  43. procedure ListWhosOn;
  44. var    NodeFile:file of NodeIdRec;
  45.         NodeID:NodeIDRec;
  46.         cnt:byte;
  47.         Notice:string[80];
  48.     s:string;
  49. begin
  50.     {$I-}
  51.     assign(NodeFile,nodechatpath+'nodelist.nod');
  52.     reset(NodeFile);
  53.     if ioresult<>0 then begin
  54.         close(NodeFile);
  55.         exit;
  56.         end;
  57.     notice:='';
  58.     for cnt:=0 to 8 do begin
  59.         seek(nodefile,cnt);
  60.         read(NodeFile,NodeID);
  61.         if NodeID.Activity<>0 then begin
  62.         writeAT(4,cnt+2,forec,backc,'Node #'+strr(cnt)+' active at '+timestr(nodeid.update));
  63.             case NodeID.Activity of
  64.                 0:s:='Unknown           ';
  65.                 1:s:='Node Down         ';
  66.                 2:s:='Waiting for Call  ';
  67.                 3:s:='User logging on   ';
  68.                 4:s:='Main system       ';
  69.                 5:s:='In Sub-boards     ';
  70.                 6:s:='In Xfer Section   ';
  71.                 7:s:='Xfering Files     ';
  72.                 8:s:='Multinode Chat    ';
  73.                 9:s:='Sysop chat        ';
  74.         10:s:='New User Applying ';
  75.         11:s:='QWK Processor     ';
  76.         12:s:='Using a Door      ';
  77.                 end;
  78.             if nodeid.activity>3 then begin
  79.                 s:=s+'User : '+copy(nodeid.Username+spcpad,1,16);
  80.                 if nodeid.ChatRequest>0 then s:=s+'  Paging';
  81.                 end;
  82.         writeAT(34,cnt+2,forec,backc,s);
  83.             end;
  84.         end;
  85.     close(NodeFile);
  86. end;
  87.  
  88. procedure WriteTranscript(TransText:string);
  89. var    TransFile:Text;
  90. begin
  91.     {$I-}
  92.     assign(TransFile,'multchat.nd0');
  93.     append(TransFile);
  94.     if ioresult<>0 then
  95.         rewrite(TransFile);
  96.     writeln(TransFile,StripControl(TransText));
  97.     close(TransFile);
  98. end;
  99.  
  100. procedure CheckChat;
  101. var    ChatFile:File of ChatRec;
  102.         Chat:ChatRec;
  103.         Cnt,Count:byte;
  104. begin
  105.   Window(1,Nodes+3,22,80);
  106.   gotoxy(1,22);
  107.   writeln;
  108.   assign(ChatFile,NodeChatPath+'Chat.dat');
  109.   reset(Chatfile);
  110.   seek(chatfile,0);
  111.   read(chatfile,chat);
  112.     if (chat.curtalk>0) then begin
  113.         for count:=1 to chat.curtalk do begin
  114.             writeln(stripcontrol(chat.talk[count]));
  115.             WriteTranscript(chat.talk[count]);
  116.             end;
  117.  
  118.         chat.curtalk:=0;
  119.         seek(chatfile,0);
  120.         write(chatfile,chat);
  121.         end;
  122.     close(chatfile);
  123.   end;
  124.  
  125.  
  126. {$F+}
  127. procedure UpdateChat; interrupt;
  128. begin
  129.   if now>last then begin
  130.  
  131.     writecenter(1,backc,forec,'Node Status');
  132.   ListWhosOn;
  133.     writecenter(1,forec,backc,'Node Status');
  134.  
  135.   last:=now+2;
  136.   end;
  137. {    inline ($9C);}  {PUSHF}
  138. {    Save1CVector;}
  139. end;
  140. {$F-}
  141.  
  142. {$F+}
  143. procedure Exit_Proc;
  144. begin
  145.     SetIntVec($1C,addr(Save1CVector));
  146. end;
  147. {$F-}
  148.  
  149. procedure InitChatIsr;
  150. begin
  151.   Last:=0;
  152.     TimePtr:=ptr(0,$046c);
  153.     TimeClicks:=TimePtr^;
  154.     Eproc:=ExitProc;
  155.     ExitProc:=@Exit_Proc;
  156.     GetIntVec($1C,Addr(Save1CVector) );
  157.     SetIntVec($1C,Addr(UpdateChat) );
  158.     end;
  159.  
  160.  
  161. procedure DrawChatBox;
  162. begin
  163.     mkwin(1,1,79,nodes+2,forec,backc,1);
  164.     writecenter(1,forec,backc,'Node Status');
  165.   InitChatIsr;
  166. end;
  167.  
  168.  
  169. { get path locations }
  170. { draw chat lines }
  171. { draw data entry box }
  172. { isr - get data, update }
  173. { get chat data }
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184. begin
  185.   clrscr;
  186.   if paramcount>0 then
  187.     nodechatpath:=paramstr(1)
  188.   else
  189.     nodechatpath:='';
  190.   drawchatbox;
  191.   {do chat work}
  192.   readln;
  193. end.
  194.  
  195.  
  196.  
  197. (*
  198.     Chat-Standalone was begun, but never completed.  The system will
  199.     nicely monitor the line status of each node on the system, but does
  200.     not allow chatting
  201. *)
  202.