 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
 Verfasst am: 28.07.2007, 19:38 Titel: [openSource] tIRC |
 |
|
Ich darf euch nach langer Zeit mal wieder nen Release präsentiern, den ich einfach mal unter der GPL zur freien Weiterentwicklung hier reinstelle 
Er läuft unter Windows, und sollte auch unter Linux laufen.. und hat nat. noch kleine Bugs
Entstanden ist es, weil offenbar für Windows 95 kein Nicht-Shareware-IRC-Client existiert... und mIRC in 2 Tagen bei mir abläuft
Also warum nicht selbst mal was coden, wenn man schon zig IRC-Bots gebaut hat?
Nat. ist auch eine Kollisionsverhinderun drin, und steht standartmäßig auf dem deutschen FreeBASIC-Support-Channel
| Code: | /' 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 = "USER"+str(rnd* (2^32))
Pass = ""
Host = "chat.freenode.net"
Destination = "#freebasic.de"
ThreadCreate(@Listener, 0)
DoInit()
ReConnect()
SendText("JOIN "+Destination+NEWLINE)
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() |
|
|
| Nach oben |
|
 |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 28.07.2007, 19:52 Titel: |
|
|
| Zitat: | | sollte auch unter Linux laufen. |
Wenn ich richtig seh benutzt Du Winsock?
kann mich ja irren (bin halt windows benutzer  )
aber vielleicht solltest aus kompatibilitaet zu linux
lieber SDL oder was es sonst noch gibt nutzen...
und wieso so viele unnoetige 'Shareds' ?? ich hab in meinen Bot nicht eine einzige.... da blickt doch keiner mehr durch....
_________________
Zuletzt bearbeitet von Eternal_pain am 28.07.2007, 19:55, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 19:53 Titel: |
|
|
Dafür sind ja die PreCompiler-Anweisungen zu beginn...
Compilierts man unter Windows, wird WinSock verwandt, uter Linux halt BSD-Sockets...
MVXA vermeldet aber optische Probleme mit der Linux-Konsole  |
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 28.07.2007, 19:55 Titel: |
|
|
*hust* Das heißt Präprozessor. 
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 28.07.2007, 19:56 Titel: |
|
|
ok... hab ich uebersehen... 
_________________
|
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 19:56 Titel: |
|
|
Äh, ja, mein ich ja.
Was mich auch noch stört ist, dass das Prog zwar unter Win95 wie es soll arbeitet, allerdings nach ~10s mit einem Anwendungsfehler abstürzt... aber in Vollbild find ichs hübsch |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 28.07.2007, 19:58 Titel: |
|
|
da muss man seine Unterhaltungen wohl kurz halten ?? ein Frauen client ??
_________________
|
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 20:01 Titel: |
|
|
lol
ich hatte ja auch net die aktuellste Version getestet |
|
| Nach oben |
|
|
AndT
Anmeldungsdatum: 02.04.2007
Beiträge: 481
|
| Verfasst am: 28.07.2007, 20:03 Titel: |
|
|
Er verdient eine Steuerung per WinApi
_________________
Bis irgendwann... |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 28.07.2007, 20:03 Titel: |
|
|
einiges solltest durch 'select case' ersetzen... ich find da die textformatierung gar net ???
kamen die zeichen nicht als UTF-8 an ?
_________________
|
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 20:04 Titel: |
|
|
Ne, so spar ich mir aber die Floodingsperre
Zumal ich festgestellt hab, was den Absturz verursachte *g*
Ich darf nimmer "" machen - aber auch net schlimm, ist eh in den meisten Chans verboten |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 20:07 Titel: |
|
|
in einigen. Es gilt als "Anime"-Smily, und ist zB unerwünscht in #php / #php.de auf FreeNode, bzw. allen dazugehörigen im Webdeveloper-Ring.
Also hab ich da nen effektiven Schutz eingebaut ohne es zu merken
(Klappt aber bislang nur in Win95) |
|
| Nach oben |
|
|
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 28.07.2007, 21:30 Titel: |
|
|
Er hat doch dazu geschrieben, dass es ein Textmode-Client ist.
Und 'nen Konsolen-IRC-Clienten find ich voll cool.
Naja, soll mir egal sein...aber ich find's so gut, wie's jetzt ist.
_________________
Eine handvoll Glück reicht nie für zwei.
--
|
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 22:06 Titel: |
|
|
| Er bleibt definitiv Konsole... mir gefällts im Vollbild, und das Prog erfüllt seinen Zweck vollständig |
|
| Nach oben |
|
|
oiermann
Anmeldungsdatum: 28.12.2005
Beiträge: 90
Wohnort: Leutkirch
|
| Verfasst am: 28.07.2007, 22:11 Titel: |
|
|
Das gibt mir eix aus:
| Code: |
* net-irc/tirc
Available versions: ~0.54_alpha ~1.2
Homepage: http://home.mayn.de/jean-luc/alt/tirc/
Description: Tolken's IRC client
|
_________________
Ich bin keine Signatur, ich putz hier nur |
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 28.07.2007, 22:19 Titel: |
|
|
Das t steht bei mir aber für Tiny
(Obwohl, wie eine Suche ergibt, gibts auch schon TinyIRC... hmm) |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 29.07.2007, 08:57 Titel: |
|
|
| Sebastian hat Folgendes geschrieben: | | => FBP Projektvorstellung! |
ein Projekt dem ich mich gern anschliessen wuerd
_________________
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
