Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
tIRC - Tiny IRC-Client (von PMedia)
| Uploader: |  Mao |
| Datum/Zeit: | 29.07.2007 19:27:17 |
/' tIRC => TinyIRC
a SMALL IRC-Client for Windows and Linux
written in 2007 by PMedia <pmedia@gmx.net>
licensed under GPL
uses substr and replace from ytwinky (ytwinky.freebasic.de)
Changelog:
1.0 (PMedia):
· Language: German / English-Mix ;)
· First Version
ToDo:
· Langfiles?
· really NC-Like Interface (NC = Norton Commander)
. Easier Configuration
· fix the Bug with the BackSpace-Key
'/
Includes:
#ifdef __FB_WIN32__
#include once "win/winsock2.bi"
#else
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/unistd.bi"
#endif
Defines:
#define newline chr(13) + chr(10)
Declares:
Declare Function SubStr(byVal Liste As String, byVal Trenner As String, byVal Stelle As Long) As String
Declare Function Replace(byVal Text As String, byVal Suche As String, byVal ErsetzeMit As String) As String
Declare Function RecvText() As String
Declare Function resolveHost ( Byref hostname As String ) As Integer
Declare Sub Listener()
Declare Sub Reconnect()
Declare Sub SendText(sendbuffer As String)
Declare Sub DoInit()
Declare Sub DoShutdown()
Variables:
Dim Shared socket As socket
Dim Shared nick As String
Dim Shared pass As String
Dim Shared host As String
Dim Shared s As String
Dim Shared saccess As Integer
Dim Shared ip As Integer
Dim Shared sa As sockaddr_in
Dim Shared Message As String
Dim Shared MsgMode As Integer
Dim Shared MsgChg As Integer
Dim Shared InpBuff As String
Dim Shared KeyIn As String
Dim Shared LastLine As Integer
Dim Shared Destination As String
#define newline chr(13) + chr(10)
SubsAndFunctions:
Sub Listener()
Do
s = ""
Do
s += recvText()
Loop Until Instr(s, newline)
saccess = 1
Do
Sleep 5
Loop Until saccess = 0
Loop Until Inkey = Chr(255) + "k"
End Sub
Sub ReConnect()
If socket <> 0 Then
closesocket( socket )
End If
ip = resolveHost( host )
If( ip = 0 ) Then
Print "resolveHost(): invalid address"
End 1
End If
socket = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
If( socket = 0 ) Then
Print "openSocket(): Something went wrong"
End 1
End If
sa.sin_port = htons( 6667 )
sa.sin_family = AF_INET
sa.sin_addr.S_addr = ip
If ( connect( socket, cast( PSOCKADDR, @sa ), Len( sa )) = SOCKET_ERROR ) Then
Print "connect(): Something went wrong"
closesocket( socket )
End 1
End If
SendText("NICK " + NICK + NEWLINE + "USER " + NICK + " 0 0 *:" + NICK + NEWLINE)
If pass <> "" Then sendtext("PRIVMSG NickServ :IDENTIFY " + pass + NEWLINE)
SendText("PRIVMSG nickserv :set unfiltered on" + NEWLINE)
End Sub
Sub SendText(sendbuffer As String)
If( send( socket, sendBuffer, Len( sendBuffer ), 0 ) = SOCKET_ERROR ) Then
Print "send(): Something went wrong"
closesocket( socket )
End 1
End If
End Sub
Function RecvText() As String
Dim recvbuffer As Zstring * 2
Dim bytes As Integer
bytes = recv( socket, recvBuffer, 1, 0 )
recvbuffer[bytes] = 0
Return RecvBuffer
End Function
Sub doInit
#ifdef __FB_WIN32__
'' init winsock
Dim wsaData As WSAData
If( WSAStartup( MAKEWORD( 1, 1 ), @wsaData ) <> 0 ) Then
Print "Error: WSAStartup failed"
End 1
End If
#Endif
End Sub
Sub doShutdown
#ifdef __FB_WIN32__
'' quit winsock
WSACleanup
#Endif
End Sub
Function resolveHost ( Byref hostname As String ) As Integer
Dim ia As in_addr
Dim hostentry As hostent Ptr
'' check if it's an ip address
ia.S_addr = inet_addr( hostname )
If ( ia.S_addr = INADDR_NONE ) Then
'' if not, assume it's a name, resolve it
hostentry = gethostbyname( hostname )
If ( hostentry = 0 ) Then
Exit Function
End If
Function = *cast( Integer Ptr, *hostentry->h_addr_list )
Else
'' just return the address
Function = ia.S_addr
End If
End Function
Function SubStr(byVal Liste As String, byVal Trenner As String, byVal Stelle As Long) As String
Dim As Long Aktuell=0, Ooops, ltr=Len(Trenner), Vorige=1, Gefunden
If Stelle=0 Or Liste="" Or Trenner="" Or Instr(Liste, Trenner)=0 Then Return ""
Do
Ooops=Gefunden
Gefunden=Instr(Gefunden+1, Liste, Trenner)
Aktuell-=Gefunden<>0
If Aktuell=Stelle-1 Then Vorige=Gefunden+ltr
If Aktuell=Stelle Then Exit Do
Loop Until Gefunden=0
If Stelle>Aktuell Then Return Mid(Liste, IIF(Stelle-Aktuell>1, Len(Liste)+1, Ooops+ltr)) &Chr(0)
Return Mid(Liste, Vorige, Gefunden-Vorige)
End Function
Function Replace(byVal Text As String, byVal Suche As String, byVal ErsetzeMit As String) As String
Dim s As String=Text, i As Long
While Instr(s, Suche)
i=Instr(s, Suche)
s=Left(s, i-1) &ErsetzeMit &Mid(s, i+Len(Suche))
Wend
Return s
End Function
Main:
Randomize Timer
Nick = "PMedau" '"USER"+str(rnd* (2^32))
Pass = ""
Host = "chat.freenode.net"
Destination = "#freebasic.de"
ThreadCreate(@Listener, 0)
DoInit()
ReConnect()
SendText("JOIN "+Destination+NEWLINE)
Width 80, 25
Locate 1, 17
color 8,0
Print chr(32, 176, 177, 178 , 219);
color 7,8
Print chr(176, 177, 178 , 219);
color 15,7
Print chr(176, 177, 178 , 219);
Color 0,15
Print " PMedia TinyIRC 1.0 " ;
color 15,7
Print Chr(219, 178, 177, 176);
color 7,8
Print Chr(219, 178, 177, 176);
color 8,0
Print Chr(219, 178, 177, 176)
locate 25,1
Color 0,3
print "Enter=Send"+chr(219)+"F1=Notice"+Chr(219)+"F2=Message"+Chr(219)+"F3=Join"+Chr(219)+"F4=Destination"+CHR(219)+"F5=NICK"+CHR(219)+"ESC=Exit";
Color 15,10
MsgChg = 1
Do
View Print 2 to 24
Locate LastLine,1
if saccess = 1 then
s = replace(s,Newline, "")
if mid(s, 1,1) <> ":" then s = ":" + s
If Instr(replace(s, ":" + substr(s, ":", 2)+":", ""),Nick) Then
Beep
End If
if substr(substr(ucase(s), ":", 2)," ",2) = "PRIVMSG" Then
'SendText("PRIVMSG #FREEBASIC.DE :" + s + NEWLINE)
Color 15,0
Print "<"+substr(substr(substr(s, ":", 2)," ",1),"!",1) + "@" + substr(substr(s, ":", 2)," ",3) + "> ";
Color 7,0
Print replace(s, ":" + substr(s, ":", 2)+":", "")
LastLine = CSRLIN
Elseif substr(substr(ucase(s), ":", 2)," ",2) = "NOTICE" Then
'SendText("PRIVMSG #FREEBASIC.DE :" + s + NEWLINE)
Color 7,0
Print "<"+substr(substr(substr(s, ":", 2)," ",1),"!",1) + "@" + substr(substr(s, ":", 2)," ",3) + "> ";
Color 8,0
Print replace(s, ":" + substr(s, ":", 2)+":", "")
LastLine = CSRLIN
ElseIf substr(substr(ucase(s), ":", 2)," ",2) = "NICK" Then
View Print 2 to 24
Locate LastLine,1
Color 10,0
Print substr(substr(substr(s, ":", 2)," ",1),"!",1) + " is now known as " + replace(s, ":" + substr(s, ":", 2)+":", "")
LastLine = CSRLIN
ElseIf substr(substr(ucase(s), ":", 2)," ",2) = "KICK" Then
View Print 2 to 24
Locate LastLine,1
Color 12,0
Print substr(substr(substr(s, ":", 2)," ",1),"!",1) + " kicked "+substr(substr(s, ":", 2)," ",4)+" from "+substr(substr(s, ":", 2)," ",3)+" (reason: " + replace(s, ":" + substr(s, ":", 2)+":", "")+")"
LastLine = CSRLIN
Elseif substr(substr(ucase(s), ":", 2)," ",2) = "PING" Then
Color 8,0
Print "PING"
SendText("PONG "+NEWLINE)
End IF
saccess = 0
End If
sleep 5
View Print 1 to 25
If MsgChg = 1 then
Locate 24,1,0
Color 15,0
If MsgMode = 0 then
Print "PRIVMSG";
ElseIf MsgMode = 1 then
Print "NOTICE";
ElseIf MsgMode = 2 then
Print "Join";
ElseIf MsgMode = 3 then
Print "Destination";
ElseIf MsgMode = 4 then
Print "NICK";
End If
Color 7,0
Print ":";
'Ich weiß, ich bin Faul:
If MsgMode = 0 then
If Len(InpBuff) < Len("PrivMsg:") then
COlor 15,0
Print InpBuff + Space(79 - Len("PrivMsg:") - Len(InpBuff))
else
COlor 15,0
Print right(InpBuff, 79-Len("PrivMsg:"))
End If
ElseIf MsgMode = 1 then
If Len(InpBuff) < Len("Notice:") then
COlor 15,0
Print InpBuff + Space(79 - Len("Notice:") - Len(InpBuff))
else
COlor 15,0
Print right(InpBuff, 79-Len("Notice:"))
End If
ElseIf MsgMode = 2 then
If Len(InpBuff) < Len("Join:") then
COlor 15,0
Print InpBuff + Space(79 - Len("Join:") - Len(InpBuff))
else
COlor 15,0
Print right(InpBuff, 79-Len("Join:"))
End If
ElseIf MsgMode = 3 then
If Len(InpBuff) < Len("Destination:") then
COlor 15,0
Print InpBuff + Space(79 - Len("Destination:") - Len(InpBuff))
else
COlor 15,0
Print right(InpBuff, 79-Len("Destination:"))
End If
ElseIf MsgMode = 4 then
If Len(InpBuff) < Len("Nick:") then
COlor 15,0
Print InpBuff + Space(79 - Len("Nick:") - Len(InpBuff))
else
COlor 15,0
Print right(InpBuff, 79-Len("Nick:"))
End If
End If
MsgChg = 0
End If
KeyIn = Inkey
If KeyIn = Chr(255, Asc("k")) then
elseif keyin = Chr(13) then
If MsgMode = 0 then
SendText("PRIVMSG "+Destination+" :"+InpBuff+NEWLINE)
View Print 2 to 24
Locate LastLine,1
Color 10,0
Print "<"+Nick + "@" + Destination + "> ";
Color 2,0
Print InpBuff
LastLine = CSRLIN
ElseIf MsgMode = 1 then
SendText("NOTICE "+Destination+" :"+InpBuff+NEWLINE)
View Print 2 to 24
Locate LastLine,1
Color 9,0
Print "<"+Nick + "@" + Destination + "> ";
Color 8,0
Print InpBuff
LastLine = CSRLIN
ElseIf MsgMode = 2 then
SendText("JOIN "+InpBuff+NEWLINE)
Destination = InpBuff
View Print 2 to 24
Locate LastLine,1
Color 10,0
Print Nick + " joined " + Destination
LastLine = CSRLIN
ElseIf MsgMode = 3 then
Destination = InpBuff
ElseIf MsgMode = 4 then
Nick = InpBuff
SendText("NICK "+Nick+NEWLINE)
End If
InpBuff = ""
MsgMode = 0
MsgChg = 1
ElseIf KeyIn = Chr(255, Asc(";")) then 'F1
MsgMode = 0
MsgChg = 1
ElseIf KeyIn = Chr(255, Asc("<")) then 'F2
MsgMode = 1
MsgChg = 1
ElseIf KeyIn = Chr(255, Asc("=")) then 'F3
MsgMode = 2
MsgChg = 1
ElseIf KeyIn = Chr(255, Asc(">")) then 'F4
MsgMode = 3
MsgChg = 1
ElseIf KeyIn = Chr(255, 63) then 'F5
MsgMode = 4
MsgChg = 1
ElseiF KeyIn = Chr(8) then
InpBuff = Left(InpBuff, Len(InpBuff)-1)
MsgChg = 1
ElseIf Instr(KeyIn,ANY Chr(01, 02, 03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,255)) Then
'Nix da... diese Zeichen gibts nicht für kleine Spinner *g*
'aber für Debug isses scho ganz nett:
'print Asc(Mid(KeyIn,1,1))
'print Asc(Mid(KeyIn,2,1))
Else
InpBuff += KeyIn
MsgChg = 1
End If
Loop Until instr(ucase(Message),"QUIT") OR KeyIn = Chr(255) + "k" OR KeyIn = Chr(27)
SendText("QUIT tIRC - written in FreeBASIC:"+NEWLINE)
sleep 10
doshutdown()