home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 April / CHIP_CD_2005-04.iso / software / netv / NVinst.exe / $INSTDIR / Scripts / Terminal / irc.nvs < prev    next >
Encoding:
Text File  |  2005-02-22  |  5.0 KB  |  246 lines
  1. program Terminal_IRC;
  2. var evnt,i,j,r,con:integer;
  3.     s,s1,s2,s3,s4,peertrg,peernick,peermsg:string;
  4.     ch:char;
  5.     v1,v2,tmi:integer;
  6.     fclr,bclr:integer;
  7.     datetime:TDateTime;
  8.  
  9. function getcolor(x:integer):integer;
  10. begin
  11. case x of
  12. 0:result:=$ffffff;
  13. 1:result:=$000000;
  14. 2:result:=$800000;
  15. 3:result:=$008000;
  16. 4:result:=$0000ff;
  17. 5:result:=$000040;
  18. 6:result:=$800080;
  19. 7:result:=$000080;
  20. 8:result:=$00ffff;
  21. 9:result:=$00ff00;
  22. 10:result:=$808000;
  23. 11:result:=$ffff00;
  24. 12:result:=$ff0000;
  25. 13:result:=$ff00ff;
  26. 14:result:=$808080;
  27. 15:result:=$c0c0c0;
  28. end;
  29. end;
  30.  
  31. procedure writestr(ts:string;clr:integer);
  32. var i,j,c,bld,und:integer;
  33.     s,ss,cs,fs,bs:string;
  34. begin
  35. textcolor(clr);textbackground(bclr);textfont(0);bld:=0;und:=0;
  36. s:=ts;
  37.  
  38. cs:='1234567890';
  39. repeat
  40. c:=0;
  41.  
  42. i:=pos(chr($1f),s);
  43. if(i<>0)then
  44. begin
  45. ss:=copy(s,1,i-1);
  46. write(ss);
  47. delete(s,1,i);
  48. if(und=0)then begin und:=1;j:=j or 4; end
  49.          else begin und:=0;j:=0; end;
  50. if(bld=1)then j:=j or 1;
  51. textfont(j);
  52. c:=1;
  53. end;
  54.  
  55. i:=pos(chr($02),s);
  56. if(i<>0)then
  57. begin
  58. ss:=copy(s,1,i-1);
  59. write(ss);
  60. delete(s,1,i);
  61. if(bld=0)then begin bld:=1;j:=1;end
  62.          else begin bld:=0;j:=0;end;
  63. if(und=1)then j:=j or 4;
  64. textfont(j);
  65. c:=1;
  66. end;
  67.  
  68. i:=pos(chr($03),s);
  69. if(i<>0)then
  70. begin
  71. ss:=copy(s,1,i-1);
  72. write(ss);
  73. delete(s,1,i);
  74.  
  75. fs:='';bs:='';i:=1;
  76.  
  77. if(length(s)>0)then
  78. begin
  79. while((i<length(s))and(pos(s[i],cs)<>0))do i:=i+1;
  80. fs:=copy(s,1,i-1);
  81. delete(s,1,i-1);
  82.  
  83. if(pos(',',s)=1)then
  84. begin
  85. delete(s,1,1);i:=1;
  86. while((i<length(s))and(pos(s[i],cs)<>0))do i:=i+1;
  87.  
  88. bs:=copy(s,1,i-1);
  89. delete(s,1,i-1);
  90. end;
  91. end;
  92. if(fs<>'')then   
  93. begin
  94. textcolor(getcolor(strtoint(fs)));
  95. if(bs<>'')then
  96. begin
  97. textbackground(getcolor(strtoint(bs)));
  98. end;
  99. end else
  100. begin
  101. textcolor(clr);textbackground(bclr);
  102. end;
  103. c:=1;
  104. end;
  105.  
  106.  
  107.  
  108. until c=0;
  109.  
  110. writeln(s);
  111. end;
  112.  
  113.  
  114.  
  115. begin                         
  116.  
  117. tmi:=0;
  118. fclr:=$00FF00;
  119. bclr:=$000000;
  120. setstatus('IRC terminal connected to '+nv_remoteip+':'+inttostr(nv_port));
  121. textbackground(bclr);textcolor(fclr);
  122. textfont(0);setoemcp(0);setlinelength(105);
  123. clrscr;s:='';
  124.  
  125. delay(3000);
  126. send('USER Enter you user ident here'+chr(13)+chr(10));
  127. send('NICK Script'+inttostr(random(1000))+chr(13)+chr(10));
  128. {send('JOIN #software'+chr(13)+chr(10));}
  129. repeat
  130. evnt:=waitevent(v1,v2);
  131. if evnt=1 then
  132. begin
  133. s:=s+recv;
  134. while(pos(chr(13),s)<>0)do
  135. begin
  136. j:=pos(chr(13),s);
  137. s2:=copy(s,1,j-1);
  138. delete(s,1,j);
  139. if(pos(chr(10),s)=1)then delete(s,1,1);
  140.  
  141. s1:=lowercase(s2);con:=0;
  142.  
  143. s4:=s2;
  144. if(pos('ping',s1)=1)then begin
  145. if(s2[2]='i')then s2[2]:='o'
  146.             else s2[2]:='O';
  147. s2:=s2+chr(13)+chr(10);
  148. send(s2);
  149. textcolor(fclr);textbackground(bclr);textfont(0);
  150. writeln('PING? PONG!');
  151. con:=1;
  152. end;
  153.  
  154.  
  155. j:=pos('!',s2);
  156. if((pos(':',s2)=1)and(j<>0))then begin
  157. peernick:=copy(s2,2,j-2);
  158. delete(s2,1,j);
  159. j:=pos(' ',s2);
  160. if(j<>0)then delete(s2,1,j);
  161. s1:=lowercase(s2);
  162. j:=pos('privmsg',s1);
  163. if(j=1)then begin
  164. j:=pos(' :',s2);
  165. if(j<>0)then 
  166. begin
  167. peertrg:=copy(s2,9,j-9);
  168. delete(s2,1,j+1);
  169. end;
  170. peermsg:=s2;
  171. if(lowercase(peermsg)=(chr(1)+'version'+chr(1)))then
  172. begin
  173. send('NOTICE '+peernick+' :'+chr(1)+'VERSION mIRC v0.12 running on NET-CP/M [ZX Spectrum - compatible, 4.75Mhz/48Kb RAM 16Kb ROM]'+chr(1)+chr(13)+chr(10));
  174. textcolor(fclr);textbackground(bclr);textfont(0);
  175. writeln('VERSION->'+peernick);
  176. con:=1;
  177. end else
  178. if(lowercase(peermsg)=(chr(1)+'finger'+chr(1)))then
  179. begin
  180. send('NOTICE '+peernick+' :'+chr(1)+'FINGER Ooops. No finger found!'+chr(1)+chr(13)+chr(10));
  181. textcolor(fclr);textbackground(bclr);textfont(0);
  182. writeln('FINGER->'+peernick);
  183. con:=1;
  184. end else
  185. if(lowercase(peermsg)=(chr(1)+'time'+chr(1)))then
  186. begin
  187. datetime:=now;
  188. if(tmi=0)then send('NOTICE '+peernick+' :'+chr(1)+'TIME Time.... Hmmm.. Sorry but I forget my family watch at home :-(!'+chr(1)+chr(13)+chr(10));
  189. if(tmi=1)then send('NOTICE '+peernick+' :'+chr(1)+'TIME Today is '+DateToStr(now)+'. Isn''t it?!'+chr(1)+chr(13)+chr(10));
  190. tmi:=tmi+1;if(tmi=2)then tmi:=0;
  191. textcolor(fclr);textbackground(bclr);textfont(0);
  192. writeln('TIME_'+inttostr(tmi)+'->'+peernick);
  193. con:=1;
  194. end else
  195. if(pos(chr(1)+'ping',lowercase(peermsg))=1)then
  196. begin
  197. send('NOTICE '+peernick+' :'+peermsg+chr(13)+chr(10));
  198. textcolor(fclr);textbackground(bclr);textfont(0);
  199. writeln('PING->'+peernick);
  200. con:=1;
  201. end else
  202. begin
  203.  
  204. if(pos('#',peertrg)=1)then writestr('['+peernick+'->'+peertrg+'] '+peermsg,$008000)
  205.                       else writestr('['+peernick+'->'+peertrg+'] '+peermsg,$00FF00);
  206. con:=1;
  207. end;
  208. end;
  209. end;
  210.  
  211.  
  212. if(con=0)then writestr(s4,$808080);
  213.  
  214.  
  215. end;
  216.  
  217. end;
  218.  
  219.  
  220. if evnt=5 then
  221. begin
  222. s:=chr(v2);
  223. if(v2=13)then s:=s+chr(10);
  224. send(s);
  225. end;
  226.  
  227. if evnt=6 then
  228. begin
  229. s1:='';s2:='';
  230. i:=getinputtext(s1,s2);
  231. for j:=1 to length(s2) do
  232. if(s2[j]=' ')then s2[j]:=chr($a0);
  233.  
  234. if(v2<>0)then begin s3:=s1+s2; setinputtext(2,'');end
  235.          else begin s3:=s1; setinputtext(1,'');end;
  236. writestr(s3,$ffff00);
  237. if(i and 1)<>0 then s3:=s3+chr(13)+chr(10);
  238. send(s3);
  239. end;
  240.  
  241.  
  242. until evnt=0;
  243.  
  244.  
  245. end.
  246.