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