home *** CD-ROM | disk | FTP | other *** search
- program Terminal_IRC;
- var evnt,i,j,r,con:integer;
- s,s1,s2,s3,s4,peertrg,peernick,peermsg:string;
- ch:char;
- v1,v2,tmi:integer;
- fclr,bclr:integer;
- datetime:TDateTime;
-
- function getcolor(x:integer):integer;
- begin
- case x of
- 0:result:=$ffffff;
- 1:result:=$000000;
- 2:result:=$800000;
- 3:result:=$008000;
- 4:result:=$0000ff;
- 5:result:=$000040;
- 6:result:=$800080;
- 7:result:=$000080;
- 8:result:=$00ffff;
- 9:result:=$00ff00;
- 10:result:=$808000;
- 11:result:=$ffff00;
- 12:result:=$ff0000;
- 13:result:=$ff00ff;
- 14:result:=$808080;
- 15:result:=$c0c0c0;
- end;
- end;
-
- procedure writestr(ts:string;clr:integer);
- var i,j,c,bld,und:integer;
- s,ss,cs,fs,bs:string;
- begin
- textcolor(clr);textbackground(bclr);textfont(0);bld:=0;und:=0;
- s:=ts;
-
- cs:='1234567890';
- repeat
- c:=0;
-
- i:=pos(chr($1f),s);
- if(i<>0)then
- begin
- ss:=copy(s,1,i-1);
- write(ss);
- delete(s,1,i);
- if(und=0)then begin und:=1;j:=j or 4; end
- else begin und:=0;j:=0; end;
- if(bld=1)then j:=j or 1;
- textfont(j);
- c:=1;
- end;
-
- i:=pos(chr($02),s);
- if(i<>0)then
- begin
- ss:=copy(s,1,i-1);
- write(ss);
- delete(s,1,i);
- if(bld=0)then begin bld:=1;j:=1;end
- else begin bld:=0;j:=0;end;
- if(und=1)then j:=j or 4;
- textfont(j);
- c:=1;
- end;
-
- i:=pos(chr($03),s);
- if(i<>0)then
- begin
- ss:=copy(s,1,i-1);
- write(ss);
- delete(s,1,i);
-
- fs:='';bs:='';i:=1;
-
- if(length(s)>0)then
- begin
- while((i<length(s))and(pos(s[i],cs)<>0))do i:=i+1;
- fs:=copy(s,1,i-1);
- delete(s,1,i-1);
-
- if(pos(',',s)=1)then
- begin
- delete(s,1,1);i:=1;
- while((i<length(s))and(pos(s[i],cs)<>0))do i:=i+1;
-
- bs:=copy(s,1,i-1);
- delete(s,1,i-1);
- end;
- end;
- if(fs<>'')then
- begin
- textcolor(getcolor(strtoint(fs)));
- if(bs<>'')then
- begin
- textbackground(getcolor(strtoint(bs)));
- end;
- end else
- begin
- textcolor(clr);textbackground(bclr);
- end;
- c:=1;
- end;
-
-
-
- until c=0;
-
- writeln(s);
- end;
-
-
-
- begin
-
- tmi:=0;
- fclr:=$00FF00;
- bclr:=$000000;
- setstatus('IRC terminal connected to '+nv_remoteip+':'+inttostr(nv_port));
- textbackground(bclr);textcolor(fclr);
- textfont(0);setoemcp(0);setlinelength(105);
- clrscr;s:='';
-
- delay(3000);
- send('USER Enter you user ident here'+chr(13)+chr(10));
- send('NICK Script'+inttostr(random(1000))+chr(13)+chr(10));
- {send('JOIN #software'+chr(13)+chr(10));}
- repeat
- evnt:=waitevent(v1,v2);
- if evnt=1 then
- begin
- s:=s+recv;
- while(pos(chr(13),s)<>0)do
- begin
- j:=pos(chr(13),s);
- s2:=copy(s,1,j-1);
- delete(s,1,j);
- if(pos(chr(10),s)=1)then delete(s,1,1);
-
- s1:=lowercase(s2);con:=0;
-
- s4:=s2;
- if(pos('ping',s1)=1)then begin
- if(s2[2]='i')then s2[2]:='o'
- else s2[2]:='O';
- s2:=s2+chr(13)+chr(10);
- send(s2);
- textcolor(fclr);textbackground(bclr);textfont(0);
- writeln('PING? PONG!');
- con:=1;
- end;
-
-
- j:=pos('!',s2);
- if((pos(':',s2)=1)and(j<>0))then begin
- peernick:=copy(s2,2,j-2);
- delete(s2,1,j);
- j:=pos(' ',s2);
- if(j<>0)then delete(s2,1,j);
- s1:=lowercase(s2);
- j:=pos('privmsg',s1);
- if(j=1)then begin
- j:=pos(' :',s2);
- if(j<>0)then
- begin
- peertrg:=copy(s2,9,j-9);
- delete(s2,1,j+1);
- end;
- peermsg:=s2;
- if(lowercase(peermsg)=(chr(1)+'version'+chr(1)))then
- begin
- 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));
- textcolor(fclr);textbackground(bclr);textfont(0);
- writeln('VERSION->'+peernick);
- con:=1;
- end else
- if(lowercase(peermsg)=(chr(1)+'finger'+chr(1)))then
- begin
- send('NOTICE '+peernick+' :'+chr(1)+'FINGER Ooops. No finger found!'+chr(1)+chr(13)+chr(10));
- textcolor(fclr);textbackground(bclr);textfont(0);
- writeln('FINGER->'+peernick);
- con:=1;
- end else
- if(lowercase(peermsg)=(chr(1)+'time'+chr(1)))then
- begin
- datetime:=now;
- 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));
- if(tmi=1)then send('NOTICE '+peernick+' :'+chr(1)+'TIME Today is '+DateToStr(now)+'. Isn''t it?!'+chr(1)+chr(13)+chr(10));
- tmi:=tmi+1;if(tmi=2)then tmi:=0;
- textcolor(fclr);textbackground(bclr);textfont(0);
- writeln('TIME_'+inttostr(tmi)+'->'+peernick);
- con:=1;
- end else
- if(pos(chr(1)+'ping',lowercase(peermsg))=1)then
- begin
- send('NOTICE '+peernick+' :'+peermsg+chr(13)+chr(10));
- textcolor(fclr);textbackground(bclr);textfont(0);
- writeln('PING->'+peernick);
- con:=1;
- end else
- begin
-
- if(pos('#',peertrg)=1)then writestr('['+peernick+'->'+peertrg+'] '+peermsg,$008000)
- else writestr('['+peernick+'->'+peertrg+'] '+peermsg,$00FF00);
- con:=1;
- end;
- end;
- end;
-
-
- if(con=0)then writestr(s4,$808080);
-
-
- end;
-
- end;
-
-
- if evnt=5 then
- begin
- s:=chr(v2);
- if(v2=13)then s:=s+chr(10);
- send(s);
- end;
-
- if evnt=6 then
- begin
- s1:='';s2:='';
- i:=getinputtext(s1,s2);
- for j:=1 to length(s2) do
- if(s2[j]=' ')then s2[j]:=chr($a0);
-
- if(v2<>0)then begin s3:=s1+s2; setinputtext(2,'');end
- else begin s3:=s1; setinputtext(1,'');end;
- writestr(s3,$ffff00);
- if(i and 1)<>0 then s3:=s3+chr(13)+chr(10);
- send(s3);
- end;
-
-
- until evnt=0;
-
-
- end.
-