Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
irc.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 28.08.2011 16:18:08 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts IRC.bi, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'#################################################################################################################
'IRC.bi - Simplyfid Internet Realy Chat Protocol include for freeBASIC
'#################################################################################################################
'Idee: 07.04.2010 - 00.29.58
'Autor: Martin Wiemann
'Copyright: /_\ DeltaLab's Germany - Experimental Computing
'-----------------------------------------------------------------------------------------------------------------
'Version: 1.00.0 - 07.04.2010
'#################################################################################################################
'Licence: Do What The Fuck U Want
'#################################################################################################################
'#################################################################################################################
'References:
'* IRC RFC: http://tools.ietf.org/html/rfc1459
'* IRC Client RFC: http://tools.ietf.org/html/rfc2812
'* 005 Problematics: http://www.irc.org/tech_docs/005.html
'* CTCP Protocol: http://www.irchelp.org/irchelp/rfc/ctcpspec.html
'* CTCP Protocol (DRAFT): http://www.invlogic.com/irc/ctcp.html
'* DCC Protocol: http://www.irchelp.org/irchelp/rfc/dccspec.html
'#################################################################################################################
#include once "TSNE_V3.bi"
'#################################################################################################################
Dim Shared IRC_Int_Debug as UByte = 0
'#################################################################################################################
Const RPL_WELCOME = 001
Const RPL_YOURHOST = 002
Const RPL_CREATED = 003
Const RPL_MYINFO = 004
Const RPL_PROTOCTL = 005
'Const RPL_BOUNCE = 5 (Wird ebenfalls verwendet, allerdings ist RPL_PROTOCTL in den meisten Server in Nutzung, anstelle von RPL_BOUNCE)
Const RPL_TRACELINK = 200
Const RPL_TRACECONNECTING = 201
Const RPL_TRACEHANDSHAKE = 202
Const RPL_TRACEUNKNOWN = 203
Const RPL_TRACEOPERATOR = 204
Const RPL_TRACEUSER = 205
Const RPL_TRACESERVER = 206
Const RPL_TRACESERVICE = 207
Const RPL_TRACENEWTYPE = 208
Const RPL_TRACECLASS = 209
Const RPL_STATSLINKINFO = 211
Const RPL_STATSCOMMANDS = 212
Const RPL_STATSCLINE = 213
Const RPL_STATSNLINE = 214
Const RPL_STATSILINE = 215
Const RPL_STATSKLINE = 216
Const RPL_STATSQLINE = 217
Const RPL_STATSYLINE = 218
Const RPL_ENDOFSTATS = 219
Const RPL_UMODEIS = 221
Const RPL_SQLINE_NICK = 222
Const RPL_SERVICEINFO = 231
Const RPL_ENDOFSERVICES = 232
Const RPL_SERVICE = 233
Const RPL_SERVLIST = 234
Const RPL_SERVLISTEND = 235
Const RPL_STATSLLINE = 241
Const RPL_STATSUPTIME = 242
Const RPL_STATSOLINE = 243
Const RPL_STATSHLINE = 244
Const RPL_STATSSLINE = 245
Const RPL_STATSXLINE = 247
Const RPL_STATSULINE = 248
Const RPL_STATSDEBUG = 249
Const RPL_STATSCONN = 250
Const RPL_LUSERCLIENT = 251
Const RPL_LUSEROP = 252
Const RPL_LUSERUNKNOWN = 253
Const RPL_LUSERCHANNELS = 254
Const RPL_LUSERME = 255
Const RPL_ADMINME = 256
Const RPL_ADMINLOC1 = 257
Const RPL_ADMINLOC2 = 258
Const RPL_ADMINEMAIL = 259
Const RPL_TRACELOG = 261
Const RPL_LOCALUSERS = 265
Const RPL_GLOBALUSERS = 266
Const RPL_SILELIST = 271
Const RPL_ENDOFSILELIST = 272
Const RPL_STATSDLINE = 275
Const RPL_HELPHDR = 290
Const RPL_HELPOP = 291
Const RPL_HELPTLR = 292
Const RPL_HELPHLP = 293
Const RPL_HELPFWD = 294
Const RPL_HELPIGN = 295
Const RPL_NONE = 300
Const RPL_AWAY = 301
Const RPL_USERHOST = 302
Const RPL_ISON = 303
Const RPL_TEXT = 304
Const RPL_UNAWAY = 305
Const RPL_NOWAWAY = 306
Const RPL_WHOISREGNICK = 307
Const RPL_WHOISADMIN = 308
Const RPL_WHOISSADMIN = 309
Const RPL_WHOISHELPOP = 310
Const RPL_WHOISUSER = 311
Const RPL_WHOISSERVER = 312
Const RPL_WHOISOPERATOR = 313
Const RPL_WHOWASUSER = 314
Const RPL_ENDOFWHO = 315
Const RPL_WHOISCHANOP = 316
Const RPL_WHOISIDLE = 317
Const RPL_ENDOFWHOIS = 318
Const RPL_WHOISCHANNELS = 319
Const RPL_LISTSTART = 321
Const RPL_LIST = 322
Const RPL_LISTEND = 323
Const RPL_CHANNELMODEIS = 324
Const RPL_CREATIONTIME = 329
Const RPL_NOTOPIC = 331
Const RPL_TOPIC = 332
Const RPL_TOPICWHOTIME = 333
Const RPL_LISTSYNTAX = 334
Const RPL_INVITING = 341
Const RPL_SUMMONING = 342
Const RPL_VERSION = 351
Const RPL_WHOREPLY = 352
Const RPL_NAMREPLY = 353
Const RPL_KILLDONE = 361
Const RPL_CLOSING = 362
Const RPL_CLOSEEND = 363
Const RPL_LINKS = 364
Const RPL_ENDOFLINKS = 365
Const RPL_ENDOFNAMES = 366
Const RPL_BANLIST = 367
Const RPL_ENDOFBANLIST = 368
Const RPL_ENDOFWHOWAS = 369
Const RPL_INFO = 371
Const RPL_MOTD = 372
Const RPL_INFOSTART = 373
Const RPL_ENDOFINFO = 374
Const RPL_MOTDSTART = 375
Const RPL_ENDOFMOTD = 376
Const RPL_YOUREOPER = 381
Const RPL_REHASHING = 382
Const RPL_YOURESERVICE = 383
Const RPL_MYPORTIS = 384
Const RPL_NOTOPERANYMORE = 385
Const RPL_TIME = 391
Const RPL_USERSSTART = 392
Const RPL_USERS = 393
Const RPL_ENDOFUSERS = 394
Const RPL_NOUSERS = 395
'-----------------------------------------------------------------------------------------------------------------
Const ERR_NOSUCHNICK = 401
Const ERR_NOSUCHSERVER = 402
Const ERR_NOSUCHCHANNEL = 403
Const ERR_CANNOTSENDTOCHAN = 404
Const ERR_TOOMANYCHANNELS = 405
Const ERR_WASNOSUCHNICK = 406
Const ERR_TOOMANYTARGETS = 407
Const ERR_NOSUCHSERVICE = 408
Const ERR_NOORIGIN = 409
Const ERR_NORECIPIENT = 411
Const ERR_NOTEXTTOSEND = 412
Const ERR_NOTOPLEVEL = 413
Const ERR_WILDTOPLEVEL = 414
Const ERR_UNKNOWNCOMMAND = 421
Const ERR_NOMOTD = 422
Const ERR_NOADMININFO = 423
Const ERR_FILEERROR = 424
Const ERR_NONICKNAMEGIVEN = 431
Const ERR_ERRONEUSNICKNAME = 432
Const ERR_NICKNAMEINUSE = 433
Const ERR_SERVICENAMEINUSE = 434
Const ERR_SERVICECONFUSED = 435
Const ERR_NICKCOLLISION = 436
Const ERR_BANNICKCHANGE = 437
Const ERR_NCHANGETOOFAST = 438
Const ERR_TARGETTOOFAST = 439
Const ERR_SERVICESDOWN = 440
Const ERR_USERNOTINCHANNEL = 441
Const ERR_NOTONCHANNEL = 442
Const ERR_USERONCHANNEL = 443
Const ERR_NOLOGIN = 444
Const ERR_SUMMONDISABLED = 445
Const ERR_USERSDISABLED = 446
Const ERR_NOTREGISTERED = 451
Const ERR_HOSTILENAME = 455
Const ERR_NEEDMOREPARAMS = 461
Const ERR_ALREADYREGISTRED = 462
Const ERR_NOPERMFORHOST = 463
Const ERR_PASSWDMISMATCH = 464
Const ERR_YOUREBANNEDCREEP = 465
Const ERR_YOUWILLBEBANNED = 466
Const ERR_KEYSET = 467
Const ERR_ONLYSERVERSCANCHANGE = 468
Const ERR_CHANNELISFULL = 471
Const ERR_UNKNOWNMODE = 472
Const ERR_INVITEONLYCHAN = 473
Const ERR_BANNEDFROMCHAN = 474
Const ERR_BADCHANNELKEY = 475
Const ERR_BADCHANMASK = 476
Const ERR_NEEDREGGEDNICK = 477
Const ERR_BANLISTFULL = 478
Const ERR_NOPRIVILEGES = 481
Const ERR_CHANOPRIVSNEEDED = 482
Const ERR_CANTKILLSERVER = 483
Const ERR_NOOPERHOST = 491
Const ERR_NOSERVICEHOST = 492
Const ERR_UMODEUNKNOWNFLAG = 501
Const ERR_USERSDONTMATCH = 502
Const ERR_SILELISTFULL = 511
Const ERR_TOOMANYWATCH = 512
Const ERR_NEEDPONG = 513
Const ERR_LISTSYNTAX = 521
'-----------------------------------------------------------------------------------------------------------------
Const RPL_LOGON = 600
Const RPL_LOGOFF = 601
Const RPL_WATCHOFF = 602
Const RPL_WATCHSTAT = 603
Const RPL_NOWON = 604
Const RPL_NOWOFF = 605
Const RPL_WATCHLIST = 606
Const RPL_ENDOFWATCHLIST = 607
'#################################################################################################################
Enum IRC_UserModeType_Enum
IRCUM_Unknown = 0
IRCUM_Away = 10 'a
IRCUM_LocalOperator = 11 'O
IRCUM_ServerNotice = 12 's
IRCUM_Invisible = 13 'i
IRCUM_Wallops = 14 'w
IRCUM_RegisteredNick = 15 'r
IRCUM_KillMessages = 16 'k
IRCUM_HiddenHostname = 17 'x
'special UnrealIRCd Usermodes
IRCUM_ServerAdmin = 20 'A
IRCUM_ServiceAdmin = 21 'a
IRCUM_BOT = 22 'B
IRCUM_CoAdmin = 23 'C
IRCUM_BadWordFilter = 24 'G
IRCUM_SendReadGlobLocOPs = 25 'g
IRCUM_HideIRCop = 26 'H
IRCUM_HelpOp = 27 'h
IRCUM_NetworkAdmin = 28 'N
IRCUM_GlobalOperator = 29 'o
IRCUM_HideChannelIn = 30 'p
IRCUM_OnlyQlineKick = 31 'q
IRCUM_OnlyRegUserPrivNoteReci = 32 'R
IRCUM_ServiceDeamon = 33 'S
IRCUM_ListenServerNotices = 34 's
IRCUM_NoCTCPs = 35 'T
IRCUM_ImUseVHost = 36 't
IRCUM_WebTVUser = 37 'V
IRCUM_InfectedDCCNotice = 38 'v
IRCUM_WhoisOnMeNotice = 39 'W
IRCUM_SSLClient = 40 'z
End Enum
'-----------------------------------------------------------------------------------------------------------------
Enum IRC_ChannelUserModeType_Enum
IRCCUMT_Unknown = 0
IRCCUMT_ChannelAdmin = 100 'a
IRCCUMT_ChannelFounder = 101 'q
IRCCUMT_ChannelOperator = 102 'o
IRCCUMT_ChannelHalfOperator = 103 'h
IRCCUMT_ChannelVoice = 104 'v
End Enum
'-----------------------------------------------------------------------------------------------------------------
Enum IRC_ChannelModeType_Enum
IRCCMT_Unknown = 0
'special UnrealIRCd Channelmodes
IRCCMT_OnlyAdminJoin = 20 'A
IRCCMT_NoANSIColor = 21 'c
IRCCMT_NoCTCP = 22 'C
IRCCMT_NoBadWord = 23 'G
IRCCMT_InviteOnly = 24 'i
IRCCMT_NoKNOCK = 25 'K
IRCCMT_OnlyRegTalkInChan = 26 'M
IRCCMT_Moderated = 27 'm
IRCCMT_NoNickChange = 28 'N
IRCCMT_NoOutsideMessages = 29 'n
IRCCMT_OnlyIRCops = 30 'O
IRCCMT_PrivateChannel = 31 'p
IRCCMT_OnlyULineServerCanKick = 32 'Q
IRCCMT_NeedRegUserToJoin = 33 'R
IRCCMT_StripsColors = 34 'S
IRCCMT_SecretChannel = 35 's
IRCCMT_OnlyChanOPSetTopic = 36 't
IRCCMT_NoNoticeForThisChannel = 37 'T
IRCCMT_Auditorium = 38 'u
IRCCMT_NoInvites = 39 'V
IRCCMT_OnlySSLUsersCanJoin = 40 'z
End Enum
'#################################################################################################################
Enum IRC_MessageType_Enum
IRCMT_Unknown = 0
IRCMT_Global = 1
IRCMT_Channel = 2
IRCMT_Private = 3
End Enum
'#################################################################################################################
Enum IRC_Return_Enum
IRCRE_Ready = 2
IRCRE_NoError = 1
IRCRE_Unknown = 0
IRCRE_OutOfSpace = -1000
IRCRE_RXBufferOverflow = -1001
IRCRE_Timeout = -1002
IRCRE_IRCIDnotFound = -1003
IRCRE_ParameterError = -1004
IRCRE_NicknameAlrightExist = -1005
IRCRE_AllNicknamesInUse = -1006
IRCRE_NoNickname = -1007
IRCRE_NoUsername = -1008
IRCRE_NoRealname = -1009
IRCRE_ChanTypeNotSupByServer = -1010
IRCRE_StringToLong = -1011
IRCRE_NotConnected = -1012
End Enum
'#################################################################################################################
Enum IRC_Callback_Enum
IRCC_Unknown = 0
IRCC_Connected = 1
IRCC_Disconnected = 2
IRCC_PING = 3
IRCC_PONG = 4
IRCC_ServerInfo = 5
IRCC_MOTD = 6
IRCC_Notice = 7
IRCC_Message = 8
IRCC_ModeUser = 9
IRCC_ModeUserChannel = 10
IRCC_Joined = 11
IRCC_Parted = 12
IRCC_Quit = 13
IRCC_Kick = 14
IRCC_Nick = 15
End Enum
'-----------------------------------------------------------------------------------------------------------------
Type IRC_Int_Callback_Type
Dummy as UByte
C_Connected as Sub (ByVal V_IRCID as UInteger)
C_Disconnected as Sub (ByVal V_IRCID as UInteger)
C_PING as Sub (ByVal V_IRCID as UInteger, ByVal V_Message as String)
C_PONG as Sub (ByVal V_IRCID as UInteger, ByVal V_Message as String)
C_ServerInfo as Sub (ByVal V_IRCID as UInteger, ByVal V_Servername as String, ByVal V_ServerVersion as String, ByVal V_SupportetUserModes as String, ByVal V_SupportetChannelModes as String)
C_MOTD as Sub (ByVal V_IRCID as UInteger, ByVal V_MOTD_Message as String)
C_Notice as Sub (ByVal V_IRCID as UInteger, ByVal V_MessageType as IRC_MessageType_Enum, ByVal V_FromChannel as String, ByVal V_FromNick as String, V_FromNickHost as String, V_Message as String)
C_Message as Sub (ByVal V_IRCID as UInteger, ByVal V_MessageType as IRC_MessageType_Enum, ByVal V_FromChannel as String, ByVal V_FromNick as String, V_FromNickHost as String, V_Message as String)
C_ModeUser as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_ModeSet as UByte, ByVal V_Mode as IRC_UserModeType_Enum, ByVal V_SetFromNick as String, ByVal V_SetToNick as String)
C_ModeUserChannel as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_ModeSet as UByte, ByVal V_Mode as IRC_ChannelUserModeType_Enum, ByVal V_SetFromNick as String, ByVal V_SetToNick as String, ByVal V_SetOnChannel as String)
C_Joined as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_Nick as String, ByVal V_NickHost as String, ByVal V_Channel as String)
C_Parted as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_Nick as String, ByVal V_NickHost as String, ByVal V_Channel as String, ByVal V_ExitMessage as String)
C_Quit as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_Nick as String, ByVal V_NickHost as String, ByVal V_ExitMessage as String)
C_Kick as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_FromNick as String, ByVal V_FromNickHost as String, ByVal V_KickedNick as String, ByVal V_Channel as String, ByVal V_KickMessage as String)
C_Nick as Sub (ByVal V_IRCID as UInteger, ByVal V_MyClient as UByte, ByVal V_FromNick as String, ByVal V_FromNickHost as String, ByVal V_NewNick as String)
End Type
'#################################################################################################################
Enum IRC_Option_Enum
IRCO_Unknown = 0
IRCO_AutoPong = 1
IRCO_AutoPing = 2
IRCO_NoCutMessages = 3
IRCO_NoBBCode = 4
IRCO_AutoCTCPFinger = 5
IRCO_AutoCTCPVersion = 6
IRCO_AutoCTCPUserInfo = 7
IRCO_AutoCTCPClientInfo = 8
IRCO_AutoCTCPPing = 7
IRCO_AutoCTCPTime = 9
End Enum
'-----------------------------------------------------------------------------------------------------------------
Type IRC_Int_Option_Type
V_AutoPONG as UByte
V_AutoPING as UByte
V_NoCutMessages as UByte
V_NoBBCode as UByte
V_AutoCTCPFinger as UByte
V_AutoCTCPVersion as UByte
V_AutoCTCPVersionText as String
V_AutoCTCPUserInfo as UByte
V_AutoCTCPUserInfoText as String
V_AutoCTCPClientInfo as UByte
V_AutoCTCPPing as UByte
V_AutoCTCPTime as UByte
End Type
'#################################################################################################################
Type IRC_Int_ServerInfo_MOTD_Type
V_Next as IRC_Int_ServerInfo_MOTD_Type Ptr
V_MOTD as String
End Type
'-----------------------------------------------------------------------------------------------------------------
Type IRC_Int_ServerInfo_Type
V_ServerName as String
V_ServerVersion as String
V_Networkname as String
V_MOTD_F as IRC_Int_ServerInfo_MOTD_Type Ptr
V_MOTD_L as IRC_Int_ServerInfo_MOTD_Type Ptr
V_UserModes as String
V_ChanModes as String
V_MaxChannels as UInteger
V_MaxLenNickname as UInteger
V_MaxLenChannelname as UInteger
V_MaxLenTopictext as UInteger
V_MaxLenKickMsg as UInteger
V_MaxLenAwayMsg as UInteger
V_MaxTargets as UInteger
V_MaxWatch as UInteger
V_MaxSilence as UInteger
V_MaxModes as UInteger
V_SupportNAMESX as UByte
V_SupportSAFELIST as UByte
V_SupportHCN as UByte
V_SupportWALLCHOPS as UByte
V_SupportChannelTypes as String
V_SupportEXCEPTS as UByte
V_SupportINVEX as UByte
V_SupportKNOCK as UByte
V_SupportMAP as UByte
V_SupportDCC as UByte
V_SupportUSERIP as UByte
V_UserModePrefixType as String
V_UserModePrefixShow as String
V_Casemapping as String
End Type
'-----------------------------------------------------------------------------------------------------------------
Type IRC_Int_Nickname_Type
V_Next as IRC_Int_Nickname_Type Ptr
V_Nickname as String
End Type
'-----------------------------------------------------------------------------------------------------------------
Type IRC_Int_Com_Type
V_Next as IRC_Int_Com_Type Ptr
V_Prev as IRC_Int_Com_Type Ptr
V_IRCID as UInteger
V_Host as String
V_Port as UShort
V_Callbacks as IRC_Int_Callback_Type
V_Options as IRC_Int_Option_Type
V_Username as String
V_Realname as String
V_Nickname_F as IRC_Int_Nickname_Type Ptr
V_Nickname_L as IRC_Int_Nickname_Type Ptr
T_State as IRC_Return_Enum
T_Auth as UByte
T_TSNEID as UInteger
T_Data as String
T_Nickname as String
T_ServerInfo as IRC_Int_ServerInfo_Type
End Type
'-----------------------------------------------------------------------------------------------------------------
Dim Shared IRC_Int_Com_F as IRC_Int_Com_Type Ptr
Dim Shared IRC_Int_Com_L as IRC_Int_Com_Type Ptr
Dim Shared IRC_Int_Com_Mutex as Any Ptr
Dim Shared IRC_Int_Com_IRCID as UInteger
'#################################################################################################################
Sub IRC_Int_Construct() Constructor
IRC_Int_Com_Mutex = MutexCreate()
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub IRC_Int_Destruct() Destructor
Dim TPtr as IRC_Int_Com_Type Ptr
MutexLock(IRC_Int_Com_Mutex)
TPtr = IRC_Int_Com_F
Do Until TPtr = 0
If TPtr->T_TSNEID <> 0 Then TSNE_Disconnect(TPtr->T_TSNEID)
TPtr = TPtr->V_Next
Loop
MutexUnLock(IRC_Int_Com_Mutex)
MutexLock(IRC_Int_Com_Mutex)
TPtr = IRC_Int_Com_F
Do Until TPtr = 0
If TPtr->T_TSNEID <> 0 Then TSNE_WaitClose(TPtr->T_TSNEID)
TPtr = TPtr->V_Next
Loop
MutexUnLock(IRC_Int_Com_Mutex)
Dim NPtr as IRC_Int_Nickname_Type Ptr
MutexLock(IRC_Int_Com_Mutex)
Do Until IRC_Int_Com_F = 0
IRC_Int_Com_L = IRC_Int_Com_F->V_Next
Do Until IRC_Int_Com_F->V_Nickname_F = 0
NPtr = IRC_Int_Com_F->V_Nickname_F->V_Next
DeAllocate(IRC_Int_Com_F->V_Nickname_F)
IRC_Int_Com_F->V_Nickname_F = NPtr
Loop
DeAllocate(IRC_Int_Com_F)
IRC_Int_Com_F = IRC_Int_Com_L
Loop
MutexUnLock(IRC_Int_Com_Mutex)
MutexDestroy(IRC_Int_Com_Mutex)
End Sub
'#################################################################################################################
Function IRC_Int_ComAdd(V_IRCID as UInteger) as IRC_Int_Com_Type Ptr
If IRC_Int_Com_L <> 0 Then
IRC_Int_Com_L->V_Next = CAllocate(SizeOf(IRC_Int_Com_Type))
If IRC_Int_Com_L->V_Next = 0 Then Return 0
IRC_Int_Com_L->V_Next->V_Prev = IRC_Int_Com_L
IRC_Int_Com_L = IRC_Int_Com_L->V_Next
Else
IRC_Int_Com_L = CAllocate(SizeOf(IRC_Int_Com_Type))
IRC_Int_Com_F = IRC_Int_Com_L
End If
With *IRC_Int_Com_L
.V_IRCID = V_IRCID
End With
Return IRC_Int_Com_L
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub IRC_Int_ComDel(V_IRCCom as IRC_Int_Com_Type Ptr)
If V_IRCCom->V_Next <> 0 Then V_IRCCom->V_Next->V_Prev = V_IRCCom->V_Prev
If V_IRCCom->V_Prev <> 0 Then V_IRCCom->V_Prev->V_Next = V_IRCCom->V_Next
If IRC_Int_Com_L = V_IRCCom Then IRC_Int_Com_L = V_IRCCom->V_Prev
If IRC_Int_Com_F = V_IRCCom Then IRC_Int_Com_F = V_IRCCom->V_Next
DeAllocate(V_IRCCom)
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub IRC_Int_ComClearUp(V_IRCCom as IRC_Int_Com_Type Ptr)
If V_IRCCom = 0 Then Exit Sub
With *V_IRCCom
.T_Nickname = ""
.T_TSNEID = 0
.T_State = IRCRE_NoError
End With
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function IRC_Int_ComGet_ByTSNEID(V_TSNEID as UInteger) as IRC_Int_Com_Type Ptr
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_Com_F
Do Until TPtr = 0
If TPtr->T_TSNEID = V_TSNEID Then Return TPtr
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_Int_ComGet_ByIRCID(V_IRCID as UInteger) as IRC_Int_Com_Type Ptr
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_Com_F
Do Until TPtr = 0
If TPtr->V_IRCID = V_IRCID Then Return TPtr
TPtr = TPtr->V_Next
Loop
Return 0
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_Int_GetFreeID() as UInteger
Dim TPtr as IRC_Int_Com_Type Ptr
Dim TID as UInteger
Do
IRC_Int_Com_IRCID += 1
TID = IRC_Int_Com_IRCID
TPtr = IRC_Int_Com_F
Do Until TPtr = 0
If TPtr->V_IRCID = TID Then TID = 0: Exit Do
TPtr = TPtr->V_Next
Loop
If TID <> 0 Then Return TID
Loop
End Function
'#################################################################################################################
Function IRC_GetReturnDesc(V_ReturnID as IRC_Return_Enum) as String
Select Case V_ReturnID
Case IRCRE_Ready : Return "Communication port ready!"
Case IRCRE_NoError : Return "No Error!"
Case IRCRE_Unknown : Return "Unknown Return Code! Maybe an unknown unexpected internal function error!"
Case IRCRE_OutOfSpace : Return "System Memory out of space!"
Case IRCRE_RXBufferOverflow : Return "RX Buffer overflow!"
Case IRCRE_Timeout : Return "Communication timeout!"
Case IRCRE_IRCIDnotFound : Return "The given IRC-ID was not found!"
Case IRCRE_ParameterError : Return "A given parameter was wrong!"
Case IRCRE_NicknameAlrightExist : Return "Nickname alright exist!"
Case IRCRE_AllNicknamesInUse : Return "All given Nicknames in use! Choose another nickname(s)!"
Case IRCRE_NoNickname : Return "No Nickname given!"
Case IRCRE_NoUsername : Return "No Username given!"
Case IRCRE_NoRealname : Return "No Realname given!"
Case IRCRE_ChanTypeNotSupByServer : Return "Given Channel Type not supported by selected server!"
Case IRCRE_StringToLong : Return "String is too long!"
Case IRCRE_NotConnected : Return "Not connected!"
Case Else : Return TSNE_GetGURUCode(V_ReturnID)
End Select
End Function
'#################################################################################################################
Function IRC_Get_Nick(V_NickHost as String) as String
Dim XPos as UInteger = InStr(1, V_NickHost, "!")
If XPos <= 0 Then Return V_NickHost
Return Left(V_NickHost, XPos - 1)
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_Get_Ident(V_NickHost as String) as String
Dim XPos as UInteger = InStr(1, V_NickHost, "@")
If XPos <= 0 Then Return ""
Return Mid(V_NickHost, XPos + 1)
End Function
'#################################################################################################################
'TIME = 1 TIME 1
'VERSION = 1 VERSION 1
'PING = 1 PING [space] <text> 1
'ACTION = 1 ACTION [space] <text> 1
'DCC CHAT = 1 DCC CHAT <?> <?> 1
'DCC SEND = 1 DCC SEND <filename> <?> <?> <?> 1
'Bold = 2 <text> 2
'Proportional = 17 <text> 17
'Grichisch = 18 <text> 18
'Revers = 22 <text> 22
'Unterstrichen = 31 <text> 31
'Farbe = 3 <code1>[,<code2>]<text> 3
Function IRC_MessageCleanup(V_TSNEID as UInteger, V_Options as IRC_Int_Option_Type, V_Call as IRC_Int_Callback_Type, ByRef V_MSG as String, V_OnlyCleanup as UByte = 1, V_BackTo as String = "") as String
If V_TSNEID = 0 Then Return ""
If V_MSG = "" Then Return ""
Dim DB1 as String
Dim DB2 as String
For X as UInteger = 1 to Len(V_MSG)
DB1 += V_MSG[X - 1] & " "
DB2 += V_MSG[X - 1] & "[" & Chr(V_MSG[X - 1]) & "] "
Next
Dim D as String = V_MSG
Dim O as String
Dim T as String
Dim XPos as UInteger
Dim C1 as String
Dim C2 as String
Dim CT as UByte
Dim CP as UInteger
Dim Y as UInteger
Dim TBoldC as UInteger
Dim TColorC as UInteger
Dim TProportionalC as UInteger
Dim TGrichC as UInteger
Dim TReverseC as UInteger
Dim TUnderlineC as UInteger
Dim TOverstrikeC as UInteger
Dim TItalicC as UInteger
Dim TSize as UInteger
Dim TSizeC as UInteger
If D[0] <> 1 Then
For X as UInteger = 1 to Len(D)
Select Case D[X - 1]
Case 3
T = Mid(D, X + 1)
C1 = "": C2 = "": CT = 0
For Y = 1 to 6
Select Case T[Y - 1]
Case 44 ',
C1 = Left(T, Y - 1)
CP = Y + 1
CT = 1
Case 48 to 57 '0-9
Case Else
If IRC_Int_Debug = 1 Then Print " * " & CP & " - " & Y
If CT = 0 Then
C1 = Left(T, Y - 1)
Else: C2 = Mid(T, CP, (Y - CP))
End If
X += (Y - 1)
Exit For
End Select
Next
If C1 <> "" Then
TColorC += 1: O += "[color=" & C1 & "," & C2 & "]"
Else: If TColorC > 0 Then TColorC -= 1: O += "[/color]"
End If
' Case 6
If "a" = "b" Then
Select Case UCase(Left(T, 1))
Case "B": If TBoldC = 0 Then TBoldC = 1: O += "[b]" Else TBoldC = 0: O += "[/b]"
Case "I": If TItalicC = 0 Then TItalicC = 1: O += "[i]" Else TItalicC = 0: O += "[/i]"
Case "U": If TUnderlineC = 0 Then TUnderlineC = 1: O += "[u]" Else TUnderlineC = 0: O += "[/u]"
Case "S": If TOverstrikeC = 0 Then TOverstrikeC = 1: O += "[o]" Else TOverstrikeC = 0: O += "[/o]"
Case "V": If TReverseC = 0 Then TReverseC = 1: O += "[r]" Else TReverseC = 0: O += "[/r]"
Case "F"
XPos = CUInt(Mid(T, 2, 1))
If XPos < 1 Then XPos = 1
If XPos > 4 Then XPos = 4
Select Case Left(T, 1)
Case "+": O += "[size=" & Str(XPos) & "]": TSizeC += 1
Case "-": O += "[size=-" & Str(XPos) & "]": TSizeC += 1
Case Else
XPos = CUInt(Mid(T, 1, 2))
If XPos > 72 Then XPos = 72
If XPos = 0 Then
For Y = 1 to TSizeC
O += "[/size]"
Next
TSizeC = 0
Else: TSize = XPos
End If
End Select
T = Mid(T, 3)
TSize += XPos
Case "N"
If TBoldC = 1 Then O += "[/b]"
If TItalicC = 1 Then O += "[/i]"
If TUnderlineC = 1 Then O += "[/u]"
If TOverstrikeC = 1 Then O += "[/o]"
If TReverseC = 1 Then O += "[/r]"
If TProportionalC = 1 Then O += "[/p]"
If TGrichC = 1 Then O += "[/g]"
For Y = 1 to TSizeC
O += "[/size]"
Next
End Select
End If
Case 2: If TBoldC = 0 Then TBoldC = 1: O += "[b]" Else TBoldC = 0: O += "[/b]"
Case 31: If TUnderlineC = 0 Then TUnderlineC = 1: O += "[u]" Else TUnderlineC = 0: O += "[/u]"
Case 22: If TReverseC = 0 Then TReverseC = 1: O += "[r]" Else TReverseC = 0: O += "[/r]"
Case 17: If TProportionalC = 0 Then TProportionalC = 1: O += "[p]" Else TProportionalC = 0: O += "[/p]"
Case 18: If TGrichC = 0 Then TGrichC = 1: O += "[g]" Else TGrichC = 0: O += "[/g]"
Case 4 to 8, 10 to 16, 19 to 21, 23 to 30
Case Else: O += Chr(D[X - 1])
End Select
Next
If TBoldC = 1 Then O += "[/b]"
If TItalicC = 1 Then O += "[/i]"
If TUnderlineC = 1 Then O += "[/u]"
If TOverstrikeC = 1 Then O += "[/o]"
If TReverseC = 1 Then O += "[/r]"
If TProportionalC = 1 Then O += "[/p]"
If TGrichC = 1 Then O += "[/g]"
For Y = 1 to TSizeC
O += "[/size]"
Next
Else
D = Mid(D, 2)
XPos = InStr(1, D, Chr(1))
If XPos > 0 Then
T = Left(D, XPos - 1)
XPos = InStr(1, T, " ")
Dim T1 as String
If XPos > 0 then
T1 = Mid(T, XPos + 1)
T = Left(T, XPos - 1)
End If
Select Case T
Case "FINGER"
If V_OnlyCleanup <> 0 Then Return ""
' If T <> "" Then If V_Options.V_AutoCTCPFinger = 1 Then TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "VERSION " & V_Options.V_AutoCTCPVersionText & Chr(1, 13, 10))
Case "VERSION"
If V_OnlyCleanup <> 0 Then Return ""
If V_Options.V_AutoCTCPVersion = 1 Then TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "VERSION " & V_Options.V_AutoCTCPVersionText & Chr(1, 13, 10))
Case "USERINFO"
If V_OnlyCleanup <> 0 Then Return ""
If V_Options.V_AutoCTCPUserInfo = 1 Then TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "USERINFO " & V_Options.V_AutoCTCPUserInfoText & Chr(1, 13, 10))
Case "CLIENTINFO"
If V_OnlyCleanup <> 0 Then Return ""
If V_Options.V_AutoCTCPClientInfo = 1 Then
Select Case T
Case ""
T1 = ""
If V_Options.V_AutoCTCPFinger = 1 Then T1 += "FINGER "
If V_Options.V_AutoCTCPVersion = 1 Then T1 += "VERSION "
If V_Options.V_AutoCTCPUserInfo = 1 Then T1 += "USERINFO "
If V_Options.V_AutoCTCPClientInfo = 1 Then T1 += "CLIENTINFO "
If V_Options.V_AutoCTCPPing = 1 Then T1 += "PING "
If V_Options.V_AutoCTCPTime = 1 Then T1 += "TIME "
If T1 <> "" Then T1 = "You can request help of the commands " & T1 & "by giving an argument to CLIENTINFO"
Case "FINGER": If V_Options.V_AutoCTCPFinger = 1 Then T1 = "FINGER is used to get a user's real name, and perhaps also the idle time of the user."
Case "VERSION": If V_Options.V_AutoCTCPVersion = 1 Then T1 = "VERSION is used to get information about the name of the other client and the version of it."
Case "USERINFO": If V_Options.V_AutoCTCPUserInfo = 1 Then T1 = "USERINFO is used to transmit a string which is settable by the user."
Case "CLIENTINFO": If V_Options.V_AutoCTCPClientInfo = 1 Then T1 = "CLIENTINFO with 0 arguments gives a list of known client query keywords. With 1 argument, a description of the client query keyword is returned."
Case "PING": If V_Options.V_AutoCTCPPing = 1 Then T1 = "PING is used to measure the time delay between clients on the IRC network."
Case "TIME": If V_Options.V_AutoCTCPTime = 1 Then T1 = "TIME queries are used to determine what time it is where another user's client is running."
Case Else: TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "CLIENTINFO " & T & " :Query is unknown" & T1 & Chr(1, 13, 10)): Return ""
End Select
TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "CLIENTINFO " & " :" & T1 & Chr(1, 13, 10))
End If
Case "PING"
If V_OnlyCleanup <> 0 Then Return ""
If T <> "" Then If V_Options.V_AutoCTCPPing = 1 Then TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "PING " & T1 & Chr(1, 13, 10))
Case "TIME"
If V_OnlyCleanup <> 0 Then Return ""
T = Format(Now(), "ddd mmm dd hh:nn:ss yyyy") & " ???"
If V_Options.V_AutoCTCPTime = 1 Then TSNE_Data_Send(V_TSNEID, "NOTICE " & V_BackTo & " :" & Chr(1) & "TIME " & T & Chr(1, 13, 10))
Case "URL"
If V_OnlyCleanup <> 0 Then Return ""
Case "EXT"
If V_OnlyCleanup <> 0 Then Return ""
Case "SCR"
If V_OnlyCleanup <> 0 Then Return ""
Case "DCC"
If V_OnlyCleanup <> 0 Then Return ""
If T = "" Then Return ""
XPos = InStr(1, T, " ")
If XPos = 0 Then Return ""
Select Case UCase(Left(T, XPos - 1))
Case "CHAT"
Case "XMIT"
Case "OFFER"
End Select
Case "XDCC"
If V_OnlyCleanup <> 0 Then Return ""
If T = "" Then Return ""
XPos = InStr(1, T, " ")
If XPos = 0 Then Return ""
Select Case UCase(Left(T, XPos - 1))
Case "LIST"
Case "SEND"
End Select
Case "ACTION": O = "[action]" & Mid(T, XPos + 1) & "[/action]"
End Select
End If
End If
Return O
End Function
'#################################################################################################################
Function IRC_Int_TranslateUserModeType(V_ServerVersion as String, V_Mode as String) as IRC_UserModeType_Enum
Select Case V_Mode
Case "a": Return IRCUM_Away
Case "O": Return IRCUM_LocalOperator
Case "s": Return IRCUM_ServerNotice
Case "i": Return IRCUM_Invisible
Case "w": Return IRCUM_Wallops
Case "r": Return IRCUM_RegisteredNick
Case "k": Return IRCUM_KillMessages
Case "x": Return IRCUM_HiddenHostname
Case Else
Dim XPos as UInteger = InStr(1, V_ServerVersion, ".")
If XPos > 0 Then
Select Case LCase(Left(V_ServerVersion, XPos - 1))
Case "unreal3"
Case "A": Return IRCUM_ServerAdmin
Case "a": Return IRCUM_ServiceAdmin
Case "B": Return IRCUM_BOT
Case "C": Return IRCUM_CoAdmin
Case "G": Return IRCUM_BadWordFilter
Case "g": Return IRCUM_SendReadGlobLocOPs
Case "H": Return IRCUM_HideIRCop
Case "h": Return IRCUM_HelpOp
Case "N": Return IRCUM_NetworkAdmin
Case "o": Return IRCUM_GlobalOperator
Case "p": Return IRCUM_HideChannelIn
Case "q": Return IRCUM_OnlyQlineKick
Case "R": Return IRCUM_OnlyRegUserPrivNoteReci
Case "S": Return IRCUM_ServiceDeamon
Case "s": Return IRCUM_ListenServerNotices
Case "T": Return IRCUM_NoCTCPs
Case "t": Return IRCUM_ImUseVHost
Case "V": Return IRCUM_WebTVUser
Case "v": Return IRCUM_InfectedDCCNotice
Case "W": Return IRCUM_WhoisOnMeNotice
Case "z": Return IRCUM_SSLClient
End Select
End If
End Select
Return IRCUM_Unknown
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_Int_TranslateUserChannelModeShow(V_ServerVersion as String, V_UserModePrefixType as String, V_UserModePrefixShow as String, V_Mode as String) as IRC_UserModeType_Enum
If V_Mode = "" Then Return IRCCUMT_Unknown
If Len(V_UserModePrefixType) <> Len(V_UserModePrefixShow) Then Return IRCCUMT_Unknown
For X as UInteger = 1 to Len(V_UserModePrefixShow)
If V_Mode = Mid(V_UserModePrefixShow, X, 1) Then
Select Case Mid(V_UserModePrefixType, X, 1)
Case "a": Return IRCCUMT_ChannelAdmin
Case "q": Return IRCCUMT_ChannelFounder
Case "o": Return IRCCUMT_ChannelOperator
Case "h": Return IRCCUMT_ChannelHalfOperator
Case "v": Return IRCCUMT_ChannelVoice
End Select
End If
Next
Return IRCCUMT_Unknown
End Function
'#################################################################################################################
Sub IRC_Int_Read_CMD(V_TSNEID as UInteger, V_CMD as String, V_Prefix as String, V_ParamD() as String, V_ParamC as UInteger, ByRef V_Text as String)
If IRC_Int_Debug = 1 Then Print " [LINE] >"; V_TSNEID; "<___>"; V_CMD; "<___>"; V_Prefix; "<___>"; V_Text; "<___"
For X as UInteger = 1 to V_ParamC
If IRC_Int_Debug = 1 Then Print " >"; V_ParamD(X); "<"
Next
If V_TSNEID = 0 Then Exit Sub
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
With *TPtr
Dim TIRCID as UInteger = .V_IRCID
Dim TCall as IRC_Int_Callback_Type = .V_Callbacks
Dim TOptions as IRC_Int_Option_Type = .V_Options
Dim XLocalNick as String = LCase(.T_Nickname)
Dim XHost as String = LCase(.V_Host)
Dim TServerInfo as IRC_Int_ServerInfo_Type = .T_ServerInfo
End With
MutexUnLock(IRC_Int_Com_Mutex)
Dim D as String
Dim T as String
Dim T1 as String
Dim X as UInteger
Dim XPos as UInteger
Dim XChanID as UInteger
Dim UID as UInteger
Dim XMA as UInteger
Dim XBStill as UByte
Dim NPtr as IRC_Int_Nickname_Type Ptr
Dim MPtr as IRC_Int_ServerInfo_MOTD_Type Ptr
Dim S as String
Select Case UCase(V_CMD)
Case "PING"
If TOptions.V_AutoPONG = 1 Then TSNE_Data_Send(V_TSNEID, "PONG :" & V_Text & Chr(13, 10))
If TCall.C_PING <> 0 Then TCall.C_PING(TIRCID, V_Text)
Case "PONG": If TCall.C_PONG <> 0 Then TCall.C_PONG(TIRCID, V_Text)
Case "JOIN"
XMA = 0
If LCase(IRC_Get_Nick(V_Prefix)) = XLocalNick Then XMA = 1
If TCall.C_Joined <> 0 Then TCall.C_Joined(TIRCID, XMA, IRC_Get_Nick(V_Prefix), V_Prefix, V_Text)
Case "PART"
If V_ParamC >= 1 Then
XMA = 0
If LCase(IRC_Get_Nick(V_Prefix)) = XLocalNick Then XMA = 1
If TCall.C_Parted <> 0 Then TCall.C_Parted(TIRCID, XMA, IRC_Get_Nick(V_Prefix), V_Prefix, V_ParamD(1), V_Text)
End If
Case "QUIT"
XMA = 0
If LCase(IRC_Get_Nick(V_Prefix)) = XLocalNick Then XMA = 1
If TCall.C_Quit <> 0 Then TCall.C_Quit(TIRCID, XMA, IRC_Get_Nick(V_Prefix), V_Prefix, V_Text)
Case "KICK"
If V_ParamC >= 2 Then
XMA = 0
If LCase(IRC_Get_Nick(V_Prefix)) = XLocalNick Then XMA = 1
If TCall.C_Kick <> 0 Then TCall.C_Kick(TIRCID, XMA, IRC_Get_Nick(V_Prefix), V_Prefix, V_ParamD(2), V_ParamD(1), V_Text)
End If
Case "MODE"
If TCall.C_ModeUser <> 0 Then
If V_ParamC <= 3 Then
If V_Text <> "" Then
T = Mid(V_Text, 2)
T1 = Left(V_Text, 1)
D = IRC_Get_Nick(V_Prefix)
Select Case T1
Case "+": XPos = 1
Case "-": XPos = 0
Case Else: Exit Sub
End Select
For X = 1 to Len(T)
TCall.C_ModeUser(TIRCID, 1, XPos, IRC_Int_TranslateUserModeType(TServerInfo.V_ServerVersion, Mid(T, X, 1)), D, D)
Next
End If
Exit Sub
End If
T = Mid(V_ParamD(2), 2)
T1 = Left(V_ParamD(2), 1)
D = IRC_Get_Nick(V_Prefix)
Select Case T1
Case "+": XPos = 1
Case "-": XPos = 0
Case Else: Exit Sub
End Select
For X = 1 to Len(T)
If V_ParamC - 1 < X Then Exit Sub
XMA = 0: If XLocalNick = V_ParamD(X + 2) Then XMA = 1
TCall.C_ModeUser(TIRCID, XMA, XPos, IRC_Int_TranslateUserModeType(TServerInfo.V_ServerVersion, Mid(T, X, 1)), V_ParamD(1), V_ParamD(X + 2))
Next
End If
Case "NICK"
XMA = 0
If LCase(IRC_Get_Nick(V_Prefix)) = XLocalNick Then XMA = 1
If TCall.C_Nick <> 0 Then TCall.C_Nick(TIRCID, XMA, IRC_Get_Nick(V_Prefix), V_Prefix, V_Text)
Case "NOTICE"
T = IRC_MessageCleanup(V_TSNEID, TOptions, TCall, V_Text, 0, IRC_Get_Nick(V_Prefix))
If T = "" Then Exit Sub
If TCall.C_Notice <> 0 Then
T1 = Left(V_ParamD(1), 1)
If T1 <> "$" Then
If TServerInfo.V_SupportChannelTypes = "" Then
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
TPtr->T_ServerInfo.V_SupportChannelTypes = "#"
TServerInfo.V_SupportChannelTypes = "#"
MutexUnLock(IRC_Int_Com_Mutex)
End If
For X = 1 to Len(TServerInfo.V_SupportChannelTypes)
If T1 = Mid(TServerInfo.V_SupportChannelTypes, X, 1) Then
TCall.C_Notice(TIRCID, IRCMT_Channel, V_ParamD(1), IRC_Get_Nick(V_Prefix), V_Prefix, T)
Exit Sub
End If
Next
TCall.C_Notice(TIRCID, IRCMT_Private, "", IRC_Get_Nick(V_Prefix), V_Prefix, T)
Else: TCall.C_Notice(TIRCID, IRCMT_Global, "", IRC_Get_Nick(V_Prefix), V_Prefix, T)
End If
End If
Case "PRIVMSG"
T = IRC_MessageCleanup(V_TSNEID, TOptions, TCall, V_Text, 0, IRC_Get_Nick(V_Prefix))
If T = "" Then Exit Sub
If TCall.C_Message <> 0 Then
T1 = Left(V_ParamD(1), 1)
If T1 <> "$" Then
If TServerInfo.V_SupportChannelTypes = "" Then
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
TPtr->T_ServerInfo.V_SupportChannelTypes = "#"
TServerInfo.V_SupportChannelTypes = "#"
MutexUnLock(IRC_Int_Com_Mutex)
End If
For X = 1 to Len(TServerInfo.V_SupportChannelTypes)
If T1 = Mid(TServerInfo.V_SupportChannelTypes, X, 1) Then
TCall.C_Message(TIRCID, IRCMT_Channel, V_ParamD(1), IRC_Get_Nick(V_Prefix), V_Prefix, T)
Exit Sub
End If
Next
TCall.C_Message(TIRCID, IRCMT_Private, "", IRC_Get_Nick(V_Prefix), V_Prefix, T)
Else: TCall.C_Message(TIRCID, IRCMT_Global, "", IRC_Get_Nick(V_Prefix), V_Prefix, T)
End If
End If
Case Else
Select Case Val(V_CMD)
Case RPL_WELCOME ' 001
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
' TPtr->T_State = IRCRE_Ready
MutexUnLock(IRC_Int_Com_Mutex)
Case RPL_YOURHOST ' 002
Case RPL_CREATED ' 003
Case RPL_MYINFO ' 004
If V_ParamC < 5 Then TSNE_Disconnect(V_TSNEID): Exit Sub
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
With TPtr->T_ServerInfo
.V_ServerName = V_ParamD(2)
.V_ServerVersion = V_ParamD(3)
.V_UserModes = V_ParamD(4)
.V_ChanModes = V_ParamD(5)
End With
Dim TSInfo as IRC_Int_ServerInfo_Type = TPtr->T_ServerInfo
MutexUnLock(IRC_Int_Com_Mutex)
With TSInfo
If TCall.C_ServerInfo <> 0 Then TCall.C_ServerInfo(TIRCID, .V_ServerName, .V_ServerVersion, .V_UserModes, .V_ChanModes)
End With
Case RPL_PROTOCTL ' 005
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
With TPtr->T_ServerInfo
For X = 1 to V_ParamC
Select Case UCase(V_ParamD(X))
Case "NAMESX": .V_SupportNAMESX = 1
Case "SAFELIST": .V_SupportSAFELIST = 1
Case "HCN": .V_SupportHCN = 1
Case "WALLCHOPS": .V_SupportWALLCHOPS = 1
Case "EXCEPTS": .V_SupportEXCEPTS = 1
Case "INVEX": .V_SupportINVEX = 1
Case Else
XPos = InStr(1, V_ParamD(X), "=")
If XPos > 0 Then
T = Mid(V_ParamD(X), XPos + 1)
Select Case UCase(Left(V_ParamD(X), XPos - 1))
Case "MAXCHANNELS": .V_MaxChannels = ValUInt(T)
Case "NICKLEN": .V_MaxLenNickname = ValUInt(T)
Case "CHANNELLEN": .V_MaxLenChannelname = ValUInt(T)
Case "TOPICLEN": .V_MaxLenTopictext = ValUInt(T)
Case "KICKLEN": .V_MaxLenKickMsg = ValUInt(T)
Case "AWAYLEN": .V_MaxLenAwayMsg = ValUInt(T)
Case "MAXTARGET": .V_MaxTargets = ValUInt(T)
Case "WATCH": .V_MaxWatch = ValUInt(T)
Case "SILENCE": .V_MaxSilence = ValUInt(T)
Case "MODES": .V_MaxModes = ValUInt(T)
Case "CHANTYPES": .V_SupportChannelTypes = T
Case "NETWORK": .V_Networkname = T
Case "CASEMAPPING": .V_Casemapping = T
Case "PREFIX"
XPos = InStr(1, T, ")")
If XPos > 0 Then
T1 = Mid(T, XPos + 1)
T = Left(T, XPos - 1)
If Left(T, 1) = "(" Then
.V_UserModePrefixType = Mid(T, 2)
.V_UserModePrefixShow = T1
End If
End If
Case "CMDS"
For Y as UInteger = 1 to Len(T)
XPos = InStr(1, T, ",")
If XPos > 0 Then
T1 = Left(T, XPos - 1)
T = Mid(T, XPos + 1)
Else: T1 = T: T = ""
End If
If T1 <> "" Then
Select Case UCase(T1)
Case "KNOCK": .V_SupportKNOCK = 1
Case "MAP": .V_SupportMAP = 1
Case "DCCALLOW": .V_SupportDCC = 1
Case "USERIP": .V_SupportUSERIP = 1
End Select
End If
Next
Case "TARGMAX"
For Y as UInteger = 1 to Len(T)
XPos = InStr(1, T, ",")
If XPos > 0 Then
T1 = Left(T, XPos - 1)
T = Mid(T, XPos + 1)
Else: T1 = T: T = ""
End If
If T1 <> "" Then
XPos = InStr(1, T1, ":")
If XPos > 0 Then
' Select Case UCase(Left(T1, XPos - 1))
'
' End Select
End If
End If
Next
End Select
End If
End Select
Next
End With
Dim TSInfo as IRC_Int_ServerInfo_Type = TPtr->T_ServerInfo
TPtr->T_State = IRCRE_Ready
MutexUnLock(IRC_Int_Com_Mutex)
'Case RPL_BOUNCE ' 005 (Wird ebenfalls verwendet, allerdings ist RPL_PROTOCTL in den meisten Server in Benutzung, anstelle von RPL_BOUNCE)
' If TOperU <> "" Then TSNE_Data_Send(V_TSNEID, "OPER " & TOperU & " " & TOperP & FBCRLF)
' If T <> "" Then TSNE_Data_Send(V_TSNEID, "PRIVMSG Nickserv :identify " & T & Chr(13, 10))
' PLI_Interface->TRESA_PLI_Event(TRESA_Event_COMReady, "IRC", "", , , , , , ConID)
Case RPL_TRACELINK ' 200
Case RPL_TRACECONNECTING ' 201
Case RPL_TRACEHANDSHAKE ' 202
Case RPL_TRACEUNKNOWN ' 203
Case RPL_TRACEOPERATOR ' 204
Case RPL_TRACEUSER ' 205
Case RPL_TRACESERVER ' 206
Case RPL_TRACESERVICE ' 207
Case RPL_TRACENEWTYPE ' 208
Case RPL_TRACECLASS ' 209
Case RPL_STATSLINKINFO ' 211
Case RPL_STATSCOMMANDS ' 212
Case RPL_STATSCLINE ' 213
Case RPL_STATSNLINE ' 214
Case RPL_STATSILINE ' 215
Case RPL_STATSKLINE ' 216
Case RPL_STATSQLINE ' 217
Case RPL_STATSYLINE ' 218
Case RPL_ENDOFSTATS ' 219
Case RPL_UMODEIS ' 221
Case RPL_SQLINE_NICK ' 222
Case RPL_SERVICEINFO ' 231
Case RPL_ENDOFSERVICES ' 232
Case RPL_SERVICE ' 233
Case RPL_SERVLIST ' 234
Case RPL_SERVLISTEND ' 235
Case RPL_STATSLLINE ' 241
Case RPL_STATSUPTIME ' 242
Case RPL_STATSOLINE ' 243
Case RPL_STATSHLINE ' 244
Case RPL_STATSSLINE ' 245
Case RPL_STATSXLINE ' 247
Case RPL_STATSULINE ' 248
Case RPL_STATSDEBUG ' 249
Case RPL_STATSCONN ' 250
Case RPL_LUSERCLIENT ' 251
Case RPL_LUSEROP ' 252
Case RPL_LUSERUNKNOWN ' 253
Case RPL_LUSERCHANNELS ' 254
Case RPL_LUSERME ' 255
Case RPL_ADMINME ' 256
Case RPL_ADMINLOC1 ' 257
Case RPL_ADMINLOC2 ' 258
Case RPL_ADMINEMAIL ' 259
Case RPL_TRACELOG ' 261
Case RPL_LOCALUSERS ' 265
Case RPL_GLOBALUSERS ' 266
Case RPL_SILELIST ' 271
Case RPL_ENDOFSILELIST ' 272
Case RPL_STATSDLINE ' 275
Case RPL_HELPHDR ' 290
Case RPL_HELPOP ' 291
Case RPL_HELPTLR ' 292
Case RPL_HELPHLP ' 293
Case RPL_HELPFWD ' 294
Case RPL_HELPIGN ' 295
Case RPL_NONE ' 300
Case RPL_AWAY ' 301
Case RPL_USERHOST ' 302
Case RPL_ISON ' 303
Case RPL_TEXT ' 304
Case RPL_UNAWAY ' 305
Case RPL_NOWAWAY ' 306
Case RPL_WHOISREGNICK ' 307
Case RPL_WHOISADMIN ' 308
Case RPL_WHOISSADMIN ' 309
Case RPL_WHOISHELPOP ' 310
Case RPL_WHOISUSER ' 311
Case RPL_WHOISSERVER ' 312
Case RPL_WHOISOPERATOR ' 313
Case RPL_WHOWASUSER ' 314
Case RPL_ENDOFWHO ' 315
Case RPL_WHOISCHANOP ' 316
Case RPL_WHOISIDLE ' 317
Case RPL_ENDOFWHOIS ' 318
Case RPL_WHOISCHANNELS ' 319
Case RPL_LISTSTART ' 321
Case RPL_LIST ' 322
Case RPL_LISTEND ' 323
Case RPL_CHANNELMODEIS ' 324
Case RPL_CREATIONTIME ' 329
Case RPL_NOTOPIC ' 331
Case RPL_TOPIC ' 332
Case RPL_TOPICWHOTIME ' 333
Case RPL_LISTSYNTAX ' 334
Case RPL_INVITING ' 341
Case RPL_SUMMONING ' 342
Case RPL_VERSION ' 351
Case RPL_WHOREPLY ' 352
Case RPL_NAMREPLY ' 353
D = V_Text
Do
XPos = InStr(1, D, " ")
If XPos > 0 Then
T = Left(D, XPos - 1): D = Mid(D, XPos + 1)
Else: T = D: D = ""
End If
T1 = ""
If T <> "" Then
For X = 1 to Len(TServerInfo.V_UserModePrefixShow)
If Left(T, 1) = Mid(TServerInfo.V_UserModePrefixShow, X, 1) Then
T1 = Left(T, 1)
T = Mid(T, 2)
Exit For
End If
Next
If XLocalNick <> LCase(T) Then If TCall.C_Joined <> 0 Then TCall.C_Joined(TIRCID, 0, T, "", V_ParamD(3))
If T1 <> "" Then If TCall.C_ModeUserChannel <> 0 Then TCall.C_ModeUserChannel(TIRCID, 0, 1, IRC_Int_TranslateUserChannelModeShow(TServerInfo.V_ServerVersion, TServerInfo.V_UserModePrefixType, TServerInfo.V_UserModePrefixShow, T1), IRC_Get_Nick(V_Prefix), T, V_ParamD(3))
End If
If D = "" Then Exit Do
Loop
Case RPL_KILLDONE ' 361
Case RPL_CLOSING ' 362
Case RPL_CLOSEEND ' 363
Case RPL_LINKS ' 364
Case RPL_ENDOFLINKS ' 365
Case RPL_ENDOFNAMES ' 366
Case RPL_BANLIST ' 367
Case RPL_ENDOFBANLIST ' 368
Case RPL_ENDOFWHOWAS ' 369
Case RPL_INFO ' 371
Case RPL_MOTD ' 372
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
With TPtr->T_ServerInfo
If .V_MOTD_L <> 0 Then
.V_MOTD_L->V_Next = CAllocate(SizeOf(IRC_Int_ServerInfo_MOTD_Type))
.V_MOTD_L = .V_MOTD_L->V_Next
Else
.V_MOTD_L = CAllocate(SizeOf(IRC_Int_ServerInfo_MOTD_Type))
.V_MOTD_F = .V_MOTD_L
End If
.V_MOTD_L->V_MOTD = V_Text
End With
MutexUnLock(IRC_Int_Com_Mutex)
Case RPL_INFOSTART ' 373
Case RPL_ENDOFINFO ' 374
Case RPL_MOTDSTART ' 375
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
With TPtr->T_ServerInfo
Do Until .V_MOTD_F = 0
.V_MOTD_L = .V_MOTD_F->V_Next
DeAllocate(.V_MOTD_F)
.V_MOTD_F = .V_MOTD_L
Loop
End With
MutexUnLock(IRC_Int_Com_Mutex)
Case RPL_ENDOFMOTD ' 376
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
T = ""
With TPtr->T_ServerInfo
MPtr = .V_MOTD_F
Do Until MPtr = 0
T += IRC_MessageCleanup(V_TSNEID, TOptions, TCall, MPtr->V_MOTD, 0, IRC_Get_Nick(V_Prefix)) & Chr(13, 10)
' T += MPtr->V_MOTD & Chr(13, 10)
MPtr = MPtr->V_Next
Loop
End With
MutexUnLock(IRC_Int_Com_Mutex)
If TCall.C_MOTD <> 0 Then TCall.C_MOTD(TIRCID, T)
Case RPL_YOUREOPER ' 381
' PLI_Interface->TRESA_PLI_Event(TRESA_Event_OperOK, "IRC", "", , , , , , ConID)
Case RPL_REHASHING ' 382
Case RPL_YOURESERVICE ' 383
Case RPL_MYPORTIS ' 384
Case RPL_NOTOPERANYMORE ' 385
Case RPL_TIME ' 391
Case RPL_USERSSTART ' 392
Case RPL_USERS ' 393
Case RPL_ENDOFUSERS ' 394
Case RPL_NOUSERS ' 395
'--------------------------------------------------------------------------------------------------------------
Case ERR_NOSUCHNICK ' 401
Case ERR_NOSUCHSERVER ' 402
Case ERR_NOSUCHCHANNEL ' 403
Case ERR_CANNOTSENDTOCHAN ' 404
Case ERR_TOOMANYCHANNELS ' 405
Case ERR_WASNOSUCHNICK ' 406
Case ERR_TOOMANYTARGETS ' 407
Case ERR_NOSUCHSERVICE ' 408
Case ERR_NOORIGIN ' 409
Case ERR_NORECIPIENT ' 411
Case ERR_NOTEXTTOSEND ' 412
Case ERR_NOTOPLEVEL ' 413
Case ERR_WILDTOPLEVEL ' 414
Case ERR_UNKNOWNCOMMAND ' 421
Case ERR_NOMOTD ' 422
Case ERR_NOADMININFO ' 423
Case ERR_FILEERROR ' 424
Case ERR_NONICKNAMEGIVEN ' 431
Case ERR_ERRONEUSNICKNAME ' 432
Case ERR_NICKNAMEINUSE ' 433
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
NPtr = TPtr->V_Nickname_F
S = LCase(TPtr->T_Nickname)
If S <> "" Then
Do Until NPtr = 0
If LCase(NPtr->V_Nickname) = S Then
If NPtr->V_Next = 0 Then
TPtr->T_State = IRCRE_AllNicknamesInUse
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
TPtr->T_Nickname = NPtr->V_Next->V_Nickname
Exit Do
End If
NPtr = NPtr->V_Next
Loop
Else: TPtr->T_Nickname = TPtr->V_Nickname_F->V_Nickname
End If
T1 = "NICK " & TPtr->T_Nickname
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Data_Send(V_TSNEID, T1 & Chr(13, 10))
' Con_Err_Add(V_ConID, "[IRC] Nickname bereits in Nutzung!")
Case ERR_SERVICENAMEINUSE ' 434
Case ERR_SERVICECONFUSED ' 435
Case ERR_NICKCOLLISION ' 436
Case ERR_BANNICKCHANGE ' 437
Case ERR_NCHANGETOOFAST ' 438
Case ERR_TARGETTOOFAST ' 439
Case ERR_SERVICESDOWN ' 440
Case ERR_USERNOTINCHANNEL ' 441
Case ERR_NOTONCHANNEL ' 442
Case ERR_USERONCHANNEL ' 443
Case ERR_NOLOGIN ' 444
Case ERR_SUMMONDISABLED ' 445
Case ERR_USERSDISABLED ' 446
Case ERR_NOTREGISTERED ' 451
Case ERR_HOSTILENAME ' 455
Case ERR_NEEDMOREPARAMS ' 461
Case ERR_ALREADYREGISTRED ' 462
Case ERR_NOPERMFORHOST ' 463
Case ERR_PASSWDMISMATCH ' 464
' PLI_Interface->TRESA_PLI_Event(TRESA_Event_OperFail, "IRC", "", , , , , , ConID)
Case ERR_YOUREBANNEDCREEP ' 465
Case ERR_YOUWILLBEBANNED ' 466
Case ERR_KEYSET ' 467
Case ERR_ONLYSERVERSCANCHANGE ' 468
Case ERR_CHANNELISFULL ' 471
Case ERR_UNKNOWNMODE ' 472
Case ERR_INVITEONLYCHAN ' 473
Case ERR_BANNEDFROMCHAN ' 474
Case ERR_BADCHANNELKEY ' 475
Case ERR_BADCHANMASK ' 476
Case ERR_NEEDREGGEDNICK ' 477
Case ERR_BANLISTFULL ' 478
Case ERR_NOPRIVILEGES ' 481
Case ERR_CHANOPRIVSNEEDED ' 482
Case ERR_CANTKILLSERVER ' 483
Case ERR_NOOPERHOST ' 491
' PLI_Interface->TRESA_PLI_Event(TRESA_Event_OperFail, "IRC", "", , , , , , ConID)
Case ERR_NOSERVICEHOST ' 492
Case ERR_UMODEUNKNOWNFLAG ' 501
Case ERR_USERSDONTMATCH ' 502
Case ERR_SILELISTFULL ' 511
Case ERR_TOOMANYWATCH ' 512
Case ERR_NEEDPONG ' 513
Case ERR_LISTSYNTAX ' 521
'--------------------------------------------------------------------------------------------------------------
Case RPL_LOGON ' 600
Case RPL_LOGOFF ' 601
Case RPL_WATCHOFF ' 602
Case RPL_WATCHSTAT ' 603
Case RPL_NOWON ' 604
Case RPL_NOWOFF ' 605
Case RPL_WATCHLIST ' 606
Case RPL_ENDOFWATCHLIST ' 607
End Select
End Select
End Sub
'#################################################################################################################
Sub IRC_Int_Read_Line(V_TSNEID as UInteger, V_Line as String)
Dim XCMD as String = V_Line
Dim XPos as UInteger
Dim XPrefix as String
Dim XParam as String
Dim XText as String
Dim DD() as String
Dim DC as UInteger
Dim DX as UInteger
Dim T as String
If Left(XCMD, 1) = ":" Then
XPos = InStr(1, XCMD, " ")
If XPos <= 0 Then Exit Sub
XPrefix = Trim(Mid(XCMD, 2, XPos - 2)): XCMD = Mid(XCMD, XPos + 1)
End If
XPos = InStr(1, XCMD, " :")
If XPos > 0 Then XText = Mid(XCMD, XPos + 2): XCMD = Trim(Left(XCMD, XPos - 1))
XPos = InStr(1, XCMD, " ")
If XPos > 0 Then
XParam = Trim(Mid(XCMD, XPos + 1))
XCMD = Trim(Left(XCMD, XPos - 1))
End if
Do
XPos = InStr(1, XParam, " ")
If XPos > 0 Then
T = Left(XParam, XPos - 1): XParam = Mid(XParam, XPos + 1)
Else: T = XParam: XParam = ""
End If
If T <> "" Then
DC += 1
If DC > DX Then DX += 4: Redim preserve DD(DX) as String
DD(DC) = T
End If
If XParam = "" Then Exit Do
Loop
'If IRC_Int_Debug = 1 Then Print " LINE: >" & XPrefix & "<___>" & XCMD & "<___>" & DC & "<___>" & XText & "<"
IRC_Int_Read_CMD(V_TSNEID, XCMD, XPrefix, DD(), DC, XText)
End Sub
'#################################################################################################################
Sub IRC_Int_TSNE_Disconnected(ByVal V_TSNEID as UInteger)
If IRC_Int_Debug = 1 Then Print " [INT] Disconnect"
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Exit Sub
Dim TCall as IRC_Int_Callback_Type = TPtr->V_Callbacks
Dim TIRCID as UInteger = TPtr->V_IRCID
MutexUnLock(IRC_Int_Com_Mutex)
If TCall.C_Disconnected <> 0 Then TCall.C_Disconnected(TIRCID)
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub IRC_Int_TSNE_Connected(ByVal V_TSNEID as UInteger)
If IRC_Int_Debug = 1 Then Print " [INT] Connect"
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
Dim T as String = "USER " & TPtr->V_Username & " 0 * :" & TPtr->V_Realname
Dim NPtr as IRC_Int_Nickname_Type Ptr = TPtr->V_Nickname_F
Dim S as String = LCase(TPtr->T_Nickname)
If S <> "" Then
Do Until NPtr = 0
If LCase(NPtr->V_Nickname) = S Then
If NPtr->V_Next = 0 Then
TPtr->T_State = IRCRE_AllNicknamesInUse
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Disconnect(V_TSNEID)
Exit Sub
End If
TPtr->T_Nickname = NPtr->V_Next->V_Nickname
Exit Do
End If
NPtr = NPtr->V_Next
Loop
Else: TPtr->T_Nickname = TPtr->V_Nickname_F->V_Nickname
End If
Dim T1 as String = "NICK " & TPtr->T_Nickname
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Data_Send(V_TSNEID, T & Chr(13, 10) & T1 & Chr(13, 10))
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub IRC_Int_TSNE_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
Dim TData as String = TPtr->T_Data & V_Data
TPtr->T_Data = ""
If Len(TData) > 100000 Then TPtr->T_State = IRCRE_RXBufferOverflow: MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
MutexUnLock(IRC_Int_Com_Mutex)
Dim T as String
Dim XPos as UInteger
Do
XPos = InStr(1, TData, Chr(10))
If XPos <= 0 Then Exit Do
T = Left(TData, XPos - 1)
If Right(T, 1) = Chr(13) Then T = Left(T, Len(T) - 1)
TData = Mid(TData, XPos + 1)
IRC_Int_Read_Line(V_TSNEID, T)
Loop
If TData <> "" Then
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByTSNEID(V_TSNEID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(V_TSNEID): Exit Sub
TPtr->T_Data = TData
MutexUnLock(IRC_Int_Com_Mutex)
End If
End Sub
'#################################################################################################################
Sub IRC_Int_Send_MSG(V_TSNEID as UInteger, V_Head as String, V_Text as String, V_NoCutting as UByte, V_NoBBC as UByte)
Dim TLineLen as UInteger = 500
Dim D as String = V_Text
Dim X as UInteger
Dim XPos as UInteger
Dim T as String
Dim T1 as String
Dim TTag as String
Dim TTagP1 as UInteger
Dim TTagPar as String
Dim TBoldC as UInteger
Dim TColorC as UInteger
Dim TProportionalC as UInteger
Dim TGrichC as UInteger
Dim TReverseC as UInteger
Dim TUnderlineC as UInteger
Dim TOverstrikeC as UInteger
Dim TItalicC as UInteger
Dim TSize as UInteger
Dim TSizeC as UInteger
Do
XPos = InStr(1, D, Chr(10))
If XPos > 0 Then
T = Left(D, XPos - 1)
If Right(T, 1) = Chr(13) Then T = Left(T, Len(T) - 1)
D = Mid(D, XPos + 1)
Else: T = D: D = ""
End If
Do
T1 = Left(T, TLineLen)
T = Mid(T, TLineLen + 1)
If T <> "" Then
For X = TLineLen to 1 Step -1
Select Case T1[X - 1]
Case 32, 33, 44, 46, 58, 59, 63, 124 'SPACE ! , . : ; ? |
T = Mid(T1, X + 1) & T
T1 = Trim(Left(T1, X))
Exit For
End Select
Next
Else: T1 = Trim(T1)
End If
For X = 1 to Len(T1)
Select Case T1[X - 1]
Case 91: TTagP1 = X '[
Case 93 ']
If TTagP1 > 0 Then
TTag = Mid(T1, TTagP1 + 1, X - TTagP1 - 1)
XPos = InStr(1, TTag, "=")
If XPos > 0 Then TTagPar = Mid(TTag, XPos + 1): TTag = Left(TTag, XPos - 1)
' Print "TAG >"; TTag; "<"
Select Case LCase(TTag)
Case "b" : T1 = Left(T1, TTagP1) & Chr(1) & "" & Chr(1) & Mid(T1, X) : TBoldC += 1
Case "/b" : T1 = Left(T1, TTagP1) & Chr(1) & "" & Chr(1) & Mid(T1, X) : If TBoldC > 0 Then TBoldC -= 1
Case "i" : TItalicC += 1
Case "/i" : If TItalicC > 0 Then TItalicC -= 1
Case "u" : TUnderlineC += 1
Case "/u" : If TUnderlineC > 0 Then TUnderlineC -= 1
Case "o" : TOverstrikeC += 1
Case "/o" : If TOverstrikeC > 0 Then TOverstrikeC -= 1
Case "r" : TReverseC += 1
Case "/r" : If TReverseC > 0 Then TReverseC -= 1
Case "g" : TGrichC += 1
Case "/g" : If TGrichC > 0 Then TGrichC -= 1
Case "p" : TProportionalC += 1
Case "/p" : If TProportionalC > 0 Then TProportionalC -= 1
End Select
End If
End Select
Next
TSNE_Data_Send(V_TSNEID, V_Head & T1 & Chr(13, 10))
If T = "" Then Exit Do
Loop
If D = "" Then Exit Do
Loop
End Sub
'#################################################################################################################
Function IRC_CreateProfil(ByRef R_IRCID as UInteger, ByRef V_Username as String, V_Realname as String) as IRC_Return_Enum
If V_Username = "" Then Return IRCRE_ParameterError
If V_Realname = "" Then Return IRCRE_ParameterError
For X as UInteger = 1 to Len(V_Username)
Select Case V_Username[X - 1]
Case 1 to 9, 11 to 12, 14 to 31, 33 to 63, 65 to 255 'user
Case Else: Return IRCRE_ParameterError
End Select
Next
For X as UInteger = 1 to Len(V_Realname)
Select Case V_Realname[X - 1]
Case 1 to 9, 11 to 12, 14 to 31, 33 to 57, 59 to 255 'tailing
Case 32 'space
Case 58 ':
Case Else: Return IRCRE_ParameterError
End Select
Next
MutexLock(IRC_Int_Com_Mutex)
Dim TID as UInteger = IRC_Int_GetFreeID
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComAdd(TID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_OutOfSpace
With *TPtr
.V_Username = V_Username
.V_Realname = V_Realname
.T_State = IRCRE_NoError
End With
MutexUnLock(IRC_Int_Com_Mutex)
R_IRCID = TID
Return IRCRE_NoError
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_AddNickname(ByRef R_IRCID as UInteger, ByRef V_Nickname as String) as IRC_Return_Enum
If V_Nickname = "" Then Return IRCRE_ParameterError
For X as UInteger = 1 to Len(V_Nickname)
Select Case V_Nickname[X - 1]
Case 45: If X = 1 Then Return IRCRE_ParameterError '-
Case 48 to 57: If X = 1 Then Return IRCRE_ParameterError 'numeric
Case 65 to 90, 97 to 122 'letter
Case 91 to 96, 123 to 125 'special
Case Else: Return IRCRE_ParameterError
End Select
Next
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(R_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
With *TPtr
Dim NPtr as IRC_Int_Nickname_Type Ptr = .V_Nickname_F
Dim S as String = LCase(V_Nickname)
Do Until NPtr = 0
If LCase(NPtr->V_Nickname) = S Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_NicknameAlrightExist
NPtr = NPtr->V_Next
Loop
If .V_Nickname_L <> 0 Then
.V_Nickname_L->V_Next = CAllocate(SizeOf(IRC_Int_Nickname_Type))
.V_Nickname_L = .V_Nickname_L->V_Next
Else
.V_Nickname_L = CAllocate(SizeOf(IRC_Int_Nickname_Type))
.V_Nickname_F = .V_Nickname_L
End If
.V_Nickname_L->V_Nickname = V_Nickname
End With
MutexUnLock(IRC_Int_Com_Mutex)
Return IRCRE_NoError
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_SetCallback(ByRef R_IRCID as UInteger, ByRef V_CallbackType as IRC_Callback_Enum, V_Callback as Any Ptr) as IRC_Return_Enum
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(R_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
With TPtr->V_Callbacks
Select Case V_CallbackType
Case IRCC_Connected : .C_Connected = V_Callback
Case IRCC_Disconnected : .C_Disconnected = V_Callback
Case IRCC_PING : .C_PING = V_Callback
Case IRCC_PONG : .C_PONG = V_Callback
Case IRCC_ServerInfo : .C_ServerInfo = V_Callback
Case IRCC_MOTD : .C_MOTD = V_Callback
Case IRCC_Notice : .C_Notice = V_Callback
Case IRCC_Message : .C_Message = V_Callback
Case IRCC_ModeUser : .C_ModeUser = V_Callback
Case IRCC_ModeUserChannel : .C_ModeUserChannel = V_Callback
Case IRCC_Joined : .C_Joined = V_Callback
Case IRCC_Parted : .C_Parted = V_Callback
Case IRCC_Quit : .C_Quit = V_Callback
Case IRCC_Kick : .C_Kick = V_Callback
Case IRCC_Nick : .C_Nick = V_Callback
Case Else: Return IRCRE_ParameterError
End Select
End With
MutexUnLock(IRC_Int_Com_Mutex)
Return IRCRE_NoError
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_SetOption(ByRef R_IRCID as UInteger, ByRef V_OptionType as IRC_Option_Enum, V_Value as UByte, V_SubValue as String = "") as IRC_Return_Enum
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(R_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
Dim XPos as UInteger
With TPtr->V_Options
Select Case V_OptionType
Case IRCO_AutoPong : .V_AutoPong = V_Value
Case IRCO_AutoPing : .V_AutoPing = V_Value
Case IRCO_NoCutMessages : .V_NoCutMessages = V_Value
Case IRCO_NoBBCode : .V_NoBBCode = V_Value
Case IRCO_AutoCTCPFinger : .V_AutoCTCPFinger = V_Value
Case IRCO_AutoCTCPVersion
If V_Value = 1 Then
If V_SubValue = "" Then Return IRCRE_ParameterError
XPos = InStr(1, V_SubValue, ":"): If XPos = 0 Then Return IRCRE_ParameterError
XPos = InStr(XPos + 1, V_SubValue, ":"): If XPos = 0 Then Return IRCRE_ParameterError
.V_AutoCTCPVersionText = V_SubValue
End if
.V_AutoCTCPVersion = V_Value
Case IRCO_AutoCTCPUserInfo
If V_Value = 1 Then
If V_SubValue = "" Then Return IRCRE_ParameterError
.V_AutoCTCPUserInfoText = V_SubValue
End if
.V_AutoCTCPUserInfo = V_Value
Case IRCO_AutoCTCPClientInfo : .V_AutoCTCPClientInfo = V_Value
Case IRCO_AutoCTCPPing : .V_AutoCTCPPing = V_Value
Case IRCO_AutoCTCPTime : .V_AutoCTCPTime = V_Value
Case Else: Return IRCRE_ParameterError
End Select
End With
MutexUnLock(IRC_Int_Com_Mutex)
Return IRCRE_NoError
End Function
'#################################################################################################################
Function IRC_Connect(ByRef V_IRCID as UInteger, ByRef V_Host as String, ByRef V_Port as UShort = 6667, ByRef V_TimeOut as UInteger = 60) as IRC_Return_Enum
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
If TPtr->V_Username = "" Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_NoUsername
If TPtr->V_Realname = "" Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_NoRealname
If TPtr->V_Nickname_F = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_NoNickname
Dim TCall as IRC_Int_Callback_Type = TPtr->V_Callbacks
Dim TSID as UInteger
Dim TRV as Integer = TSNE_Create_Client(TSID, V_Host, V_Port, @IRC_Int_TSNE_Disconnected, @IRC_Int_TSNE_Connected, @IRC_Int_TSNE_NewData, V_TimeOut)
If TRV <> TSNE_Const_NoError Then IRC_Int_ComClearUp(TPtr): MutexUnLock(IRC_Int_Com_Mutex): Return TRV
TPtr->T_TSNEID = TSID
MutexUnLock(IRC_Int_Com_Mutex)
Dim TTot as Double = Timer() + V_TimeOut
Do
If TTot < Timer() Then IRC_Int_ComClearUp(TPtr): MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_Timeout
If TSNE_IsClosed(TSID) = 1 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_Timeout
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then IRC_Int_ComClearUp(TPtr): MutexUnLock(IRC_Int_Com_Mutex): TSNE_Disconnect(TSID): Return IRCRE_Timeout
Select Case TPtr->T_State
Case IRCRE_Ready
TPtr->T_State = IRCRE_Ready
MutexUnLock(IRC_Int_Com_Mutex)
If TCall.C_Connected <> 0 Then TCall.C_Connected(V_IRCID)
Return IRCRE_NoError
Case IRCRE_NoError
Case IRCRE_Unknown
Case Else
Dim TState as IRC_Return_Enum = TPtr->T_State
IRC_Int_ComClearUp(TPtr)
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Disconnect(TSID)
Return TState
End Select
MutexUnLock(IRC_Int_Com_Mutex)
Sleep 10, 1
Loop
Return IRCRE_Ready
End Function
'#################################################################################################################
Function IRC_Disconnect(ByRef V_IRCID as UInteger) as IRC_Return_Enum
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
Dim TCall as IRC_Int_Callback_Type = TPtr->V_Callbacks
If TPtr->T_TSNEID = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_NotConnected
Dim TSID as UInteger = TPtr->T_TSNEID
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Disconnect(TSID)
Dim TTot as Double = Timer() + 60
Do
If TSNE_IsClosed(TSID) = 1 Then Return IRCRE_NoError
If Timer() > TTot Then Exit Do
Sleep 10, 1
Loop
Return IRCRE_Timeout
End Function
'#################################################################################################################
Function IRC_Join(ByRef V_IRCID as UInteger, ByRef V_Channelname as String) as IRC_Return_Enum
If V_Channelname = "" Then Return IRCRE_ParameterError
For X as UInteger = 1 to Len(V_Channelname)
Select Case V_Channelname[X - 1]
Case 1 to 7, 8 to 9, 11 to 12, 14 to 31, 33 to 43, 45 to 57, 59 to 255 'chanstring
Case Else: Return IRCRE_ParameterError
End Select
Next
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
If TPtr->T_ServerInfo.V_MaxLenChannelname < Len(IRCRE_ParameterError) Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_StringToLong
Dim TOk as UByte
With TPtr->T_ServerInfo
If .V_SupportChannelTypes = "" Then .V_SupportChannelTypes = "#"
For X as UInteger = 1 to Len(.V_SupportChannelTypes)
If Left(V_Channelname, 1) = Mid(.V_SupportChannelTypes, X, 1) Then
TOk = 1
Exit For
End If
Next
If TOk = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_ChanTypeNotSupByServer
End With
Dim TSID as UInteger = TPtr->T_TSNEID
MutexUnLock(IRC_Int_Com_Mutex)
TSNE_Data_Send(TSID, "JOIN " & V_Channelname & Chr(13, 10))
Return IRCRE_NoError
End Function
'#################################################################################################################
Function IRC_GetMyNick(ByRef V_IRCID as UInteger) as String
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return ""
Dim TNick as String = TPtr->T_Nickname
MutexUnLock(IRC_Int_Com_Mutex)
Return TNick
End Function
'-----------------------------------------------------------------------------------------------------------------
Function IRC_GetMyServer(ByRef V_IRCID as UInteger) as String
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return ""
Dim TServer as String = TPtr->T_ServerInfo.V_ServerName
MutexUnLock(IRC_Int_Com_Mutex)
Return TServer
End Function
'#################################################################################################################
Function IRC_SendMessage(ByRef V_IRCID as UInteger, ByRef V_Target as String, ByVal V_Message as String, ByVal V_NoCutMessages as UByte = 0, ByVal V_NoBBCode as UByte = 0) as IRC_Return_Enum
If V_Target = "" Then Return IRCRE_ParameterError
If V_Message = "" Then Return IRCRE_ParameterError
For X as UInteger = 1 to Len(V_Target)
Select Case V_Target[X - 1]
Case 45: If X = 1 Then Return IRCRE_ParameterError '-
Case 48 to 57: If X = 1 Then Return IRCRE_ParameterError 'numeric
Case 1 to 7, 8 to 9, 11 to 12, 14 to 31, 33 to 43, 45 to 57, 59 to 255 'chanstring
Case Else: Return IRCRE_ParameterError
End Select
Next
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
If (TPtr->T_ServerInfo.V_MaxLenChannelname < Len(V_Target)) and (TPtr->T_ServerInfo.V_MaxLenNickname < Len(V_Target)) Then
MutexUnLock(IRC_Int_Com_Mutex)
Return IRCRE_StringToLong
End If
Dim TSID as UInteger = TPtr->T_TSNEID
MutexUnLock(IRC_Int_Com_Mutex)
IRC_Int_Send_MSG(TSID, "PRIVMSG " & V_Target & " :", V_Message, V_NoCutMessages, V_NoBBCode)
Return IRCRE_NoError
End Function
'#################################################################################################################
Function IRC_SendNotice(ByRef V_IRCID as UInteger, ByRef V_Target as String, ByVal V_Message as String, ByVal V_NoCutMessages as UByte = 0, ByVal V_NoBBCode as UByte = 0) as IRC_Return_Enum
If V_Target = "" Then Return IRCRE_ParameterError
If V_Message = "" Then Return IRCRE_ParameterError
For X as UInteger = 1 to Len(V_Target)
Select Case V_Target[X - 1]
Case 45: If X = 1 Then Return IRCRE_ParameterError '-
Case 48 to 57: If X = 1 Then Return IRCRE_ParameterError 'numeric
Case 1 to 7, 8 to 9, 11 to 12, 14 to 31, 33 to 43, 45 to 57, 59 to 255 'chanstring
Case Else: Return IRCRE_ParameterError
End Select
Next
MutexLock(IRC_Int_Com_Mutex)
Dim TPtr as IRC_Int_Com_Type Ptr = IRC_Int_ComGet_ByIRCID(V_IRCID)
If TPtr = 0 Then MutexUnLock(IRC_Int_Com_Mutex): Return IRCRE_IRCIDnotFound
If (TPtr->T_ServerInfo.V_MaxLenChannelname < Len(V_Target)) and (TPtr->T_ServerInfo.V_MaxLenNickname < Len(V_Target)) Then
MutexUnLock(IRC_Int_Com_Mutex)
Return IRCRE_StringToLong
End If
Dim TSID as UInteger = TPtr->T_TSNEID
MutexUnLock(IRC_Int_Com_Mutex)
IRC_Int_Send_MSG(TSID, "NOTICE " & V_Target & " :", V_Message, V_NoCutMessages, V_NoBBCode)
Return IRCRE_NoError
End Function