IdIRC.pas 144 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10227: IdIRC.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:43:38 PM czhower
  13. }
  14. unit IdIRC;
  15. {
  16. TIRCClient component for Borland Delphi 5.0 or above
  17. by Steve 'Sly' Williams ([email protected])
  18. ported to Indy by Daaron Dwyer ([email protected])
  19. File: IRCClient.pas
  20. Version: 1.06
  21. Objects: TIRCClient, TUser, TUsers, TChannel, TChannels, TIdIRCReplies
  22. Requires: Indy9
  23. Provides a simple, high-level interface to the IRC network. Set the
  24. properties and write event handlers for the events you wish to respond to.
  25. Any events that do not have a specific event handler will continue normal
  26. processing (ie. reply to a request, ignore a message, etc).
  27. I have tried to keep the TIRCClient object as independent as possible from
  28. the user interface implementation. This is so the user interface is not
  29. constrained by any inherent limitations placed upon it by the implementation
  30. of the TIRCClient object itself, thus leaving the user interface to be as
  31. standard or as non-standard as the designer wishes.
  32. This is a non-visual component, and should be placed either on the main form
  33. or in a data module, where all units can easily access the component.
  34. The command numerics and server operation are based on RFC1459, the original
  35. specification for IRC. Any change from the specification is due to the
  36. differences that have been noted from practical experience. There may be
  37. some IRC networks that operate differently and therefore do not operate with
  38. this TIRCClient object in the correct manner. If you do have any information
  39. that would make the TIRCClient object more compatible with current or planned
  40. IRC networks, then e-mail me so that I may add these features to the next
  41. release.
  42. History:
  43. 1.00 Initial release
  44. 1.01 1/03/1999
  45. - Changed SocketDataAvailable to handle lines ending with either CRLF
  46. (within spec) or a single LF (breaks spec). It seems a few servers
  47. break the rules. Also added check for a non-zero Error parameter.
  48. 1.02 5/04/1999
  49. - Added SocksServer and SocksPort properties as requested by Joe
  50. ([email protected]).
  51. 1.03 13/05/1999
  52. - Moved the creation of the TWSocket to the overridden Loaded
  53. procedure to get rid of the annoying "A device attached to the
  54. system is not functioning" error when recompiling the package.
  55. 1.04 28/11/1999
  56. - If Suppress in the OnRaw event was set to True, the User object
  57. would not have been released.
  58. - Uncommented the OnJoin and OnPart events. Not sure why I had them
  59. commented out.
  60. 1.05 02/12/1999
  61. - Fixed the Replies property and made it published. The TIdIRCReplies
  62. object had to descend from TPersistent, not TObject. Oops.
  63. - Fixed the Client property of TUser, TUsers, TChannel and TChannels.
  64. Made a forward declaration of TIRCClient and used that as the type.
  65. 1.06 25/05/2000
  66. - Fixed TUsers.Destroy and TChannels.Destroy. The list items were not
  67. being deleted after the objects were freed. Silly error on my part.
  68. 1.061 27/07/2001 - Daaron Dwyer ([email protected])
  69. - Modified component to use Indy TCPClient control rather than ICS
  70. 1.062 10/11/2001 - J. Peter Mugaas
  71. - added ACmd Integer parameter to TIdIRCOnSystem as suggested by Andrew P.Rybin
  72. - added Channel to OnNames event as suggested by Sven Orro
  73. TUser object
  74. -------------------------------------
  75. Properties:
  76. Nick The user's nickname.
  77. Address The full address of the user.
  78. Count Count of the number of objects referencing this
  79. user. This user is removed when the reference
  80. count drops to zero.
  81. Data A reference to an object defined by the client.
  82. Usually references the message window for this user.
  83. Methods:
  84. Say Send a message to this user.
  85. TUsers object
  86. -------------------------------------
  87. Properties:
  88. none
  89. Methods:
  90. Add Increments the reference count for this user. If the
  91. user does not exist, then a new user is created with
  92. a reference count of one. Returns the TUser object
  93. for the user.
  94. Remove Decrement the reference count for this user. The
  95. user is only deleted if the reference count becomes
  96. zero.
  97. Address Return the address of a specified nick.
  98. Find Returns the index of the user if the nick is found.
  99. Get Returns the user object if the nick is found.
  100. Nick Change the nick of an existing user.
  101. TChannel object
  102. -------------------------------------
  103. Properties:
  104. Name Channel name.
  105. Topic Current topic of the channel (if set).
  106. Mode Set of channel modes.
  107. Limit Set if a limit is set to the number of users in a
  108. channel.
  109. Key Set if a password key is set for the channel.
  110. ModeChange True if mode changes are being compiled.
  111. Data A reference to an object defined by the client.
  112. Usually references the message window for this
  113. channel.
  114. Methods:
  115. Say Send a message to the channel.
  116. Part Part the channel.
  117. Kick Kick a nick from the channel.
  118. Topic Set the channel topic.
  119. BeginMode Compile but do not send mode changes until the
  120. EndMode method is called.
  121. EndMode Compile all mode changes since BeginMode and send to
  122. the server.
  123. Op Give a user channel operator status.
  124. Deop Remove channel operator status from a user.
  125. Voice Give a voice to a user in a moderated channel.
  126. Devoice Remove the voice from a user in a moderated channel.
  127. Ban Ban a user from the channel.
  128. Unban Remove a ban from the channel.
  129. TopicChanged Call to change the topic without sending a topic
  130. command (ie. when another user changes the topic).
  131. ModeChanged Call to change the channel mode without sending a
  132. mode command (ie. when another user changes the
  133. mode).
  134. LimitChanged Call to change the channel limit without sending a
  135. mode command (ie. when another user changes the
  136. limit).
  137. KeyChanged Call to change the channel key without sending a
  138. mode command (ie. when another user changes the
  139. key).
  140. AddUser Add a user to the channel.
  141. RemoveUser Remove a user from the channel.
  142. TChannels object
  143. -------------------------------------
  144. Properties:
  145. none
  146. Methods:
  147. Add Add a new channel to the list.
  148. Remove Remove a channel from the list.
  149. Find Find a channel name, if it exists.
  150. Get Returns the channel object for the name given.
  151. TIRCClient component
  152. -------------------------------------
  153. Design-time properties:
  154. Nick The primary nick to be used. Defaults to 'Nick'.
  155. AltNick Another nick to use if the primary nick is already
  156. in use. Defaults to 'OtherNick'.
  157. UserName Your username (for the system you are using).
  158. RealName The information you want displayed in your whois
  159. response.
  160. Server Address of the IRC server to connect to.
  161. Port Server port number to connect to. Defaults to
  162. '6667'.
  163. Password Password to connect (if required).
  164. UserMode Set of user modes. Defaults to an empty set.
  165. umInvisible, umOperator, umServerNotices, umWallops.
  166. SocksServer Address of the SOCKS server to connect through.
  167. SocksPort Port number of the SOCKS server to connect through.
  168. Run-time properties:
  169. Connected Returns True if currently connected to the IRC
  170. network.
  171. Away Set to True if you are marked as away.
  172. Notify List of nicknames/addresses to be notified of when
  173. they join/leave IRC.
  174. State The current connection state.
  175. Channels The list of channel objects.
  176. Replies
  177. Finger Standard CTCP reply for FINGER requests.
  178. Version Standard CTCP reply for VERSION requests.
  179. UserInfo Standard CTCP reply for USERINFO requests.
  180. ClientInfo Standard CTCP reply for CLIENTINFO requests.
  181. Events:
  182. OnConnect Connected to the IRC network.
  183. OnDisconnect Disconnected from the IRC network.
  184. OnChannelMessage Received a channel message.
  185. OnChannelNotice Received a channel notice.
  186. OnChannelAction Received a channel action.
  187. OnPrivateMessage Received a private message.
  188. OnPrivateNotice Received a private notice.
  189. OnPrivateAction Received a private action.
  190. OnJoin A user joined a channel.
  191. OnJoined You joined a channel.
  192. OnPart A user parted a channel.
  193. OnParted You parted a channel.
  194. OnKick A user kicked another user from a channel.
  195. OnKicked You were kicked from a channel by a user.
  196. OnNickChange A user changed their nick.
  197. OnNickChanged Your nick was changed.
  198. OnTopic The topic of the channel was changed.
  199. OnQuit A user quit IRC.
  200. OnNames Received a list of names of people in a channel.
  201. OnInvite A user has invited you to a channel.
  202. OnInviting You invited a user to a channel.
  203. OnPingPong Received a server ping (PONG response sent
  204. automatically).
  205. OnError Error message from server.
  206. OnAway Received an away message for a user.
  207. OnNowAway You are marked as being away.
  208. OnUnAway You are no longer marked as being away.
  209. OnWallops Received a wallops message.
  210. OnSystem Any response from the server not handled by a
  211. specific event handler.
  212. OnRaw Every command from the IRC server goes through this
  213. handler first. Normal processing can be suppressed
  214. by setting the Suppress parameter to True.
  215. OnOp A user was oped in a channel.
  216. OnDeop A user was deoped in a channel.
  217. OnBan A user was banned in a channel.
  218. OnUnban A user was unbanned in a channel.
  219. OnVoice A user was given a voice in a channel.
  220. OnDevoice A user's voice was taken away in a channel.
  221. OnChannelMode The channel mode was changed.
  222. OnChannelModeChanged Called after the channel mode change has been parsed
  223. and the mode was changed.
  224. OnUserMode Your user mode was changed.
  225. OnUserModeChanged Called after the user mode change has been parsed
  226. and the mode was changed.
  227. OnKill A user was killed.
  228. OnUnknownCommand An unknown command was received from the server.
  229. OnStateChange Called when the current state of the IRC connection
  230. changes.
  231. OnSend Called for every command sent to the IRC server.
  232. Useful for displaying in a raw output window.
  233. OnReceive Called for every command is received from the IRC
  234. server. Useful for displaying in a raw output
  235. window.
  236. OnNicksInUse Called during the registration process when both Nick
  237. and AltNick are in use.
  238. OnSocketError An error occurred in the TCP/IP socket.
  239. OnNoTopic There is no topic for this channel.
  240. OnChannelMode The channel mode is now set.
  241. OnLinks Results from a /LINK command
  242. OnList Results from a /LIST command
  243. The following CTCP query event handlers can suppress the standard response by
  244. setting the Suppress parameter to True.
  245. OnCTCPQuery A user sent you a CTCP query.
  246. OnCTCPReply Received a reply from a CTCP query.
  247. Events to be added later:
  248. OnOped You were oped in a channel.
  249. OnDeoped You were deoped in a channel.
  250. OnBanned You were banned in a channel.
  251. OnUnbanned You were unbanned in a channel.
  252. OnVoiced You were given a voice in a channel.
  253. OnDevoiced Your voice was taken away in a channel.
  254. OnKilled You were killed.
  255. OnNotify A person on your notify list has joined IRC.
  256. OnDenotify A person on your notify list has left IRC.
  257. OnLag Update on the current lag time.
  258. DCC events to be added later
  259. OnChat Someone wants to initiate a DCC chat.
  260. OnChatClosed The DCC chat was closed.
  261. OnFileReceive Someone wants to send you a file.
  262. OnFileReceived The file was received successfully.
  263. OnFileSend A file is offered to someone.
  264. OnFileSent The file was sent successfully.
  265. OnFileError There was an error during file transfer.
  266. OnDCC General DCC event handler.
  267. *TEMPDCC EVENTS UNTIL ABOVE ARE DONE*:
  268. OnDCCChat Someone wants to DCC Chat
  269. OnDCCSend Someone wants to Send you a File Via DCC
  270. OnDCCResume Someone is requesting a DCC File RESUME
  271. OnDCCAccept Someone has ACCEPTED your DCC File RESUME request
  272. Set the Accept parameter to True to accept the DCC. Set the Resume
  273. parameter to True to resume a DCC file transfer. Set the Filename parameter
  274. to the full path and name of the place to store the received file.
  275. Methods:
  276. Connect Connect to the IRC network.
  277. Disconnect Force a disconnect from the IRC network.
  278. Raw Send the command directly to the IRC server.
  279. Say Send a message to a user/channel.
  280. Notice Send a notice to a user/channel.
  281. Join Join channel/s with given key/s.
  282. Part Part channel/s with an optional reason (if supported
  283. by the IRC server).
  284. Kick Kick a person from a channel.
  285. Quit Quit the IRC network.
  286. CTCP Send a CTCP command to a user/channel.
  287. CTCPReply Send a reply to a CTCP command.
  288. IsChannel Returns True if the name is a channel name.
  289. IsOp Returns True if the user has operator status.
  290. IsVoice Returns True if the user has a voice.
  291. MatchHostmask Returns True if the address matches the hostmask.
  292. GetTopic Get the topic for the specified channel.
  293. SetTopic Set the topic for the specifiec channel.
  294. Methods to be added later:
  295. Ban Ban hostmask/s from a channel.
  296. Unban Unban hostmask/s from a channel.
  297. Op Op nick/s in a channel.
  298. Deop Deop nick/s in a channel.
  299. Voice Give a voice to nick/s.
  300. Devoice Take voice from nick/s.
  301. Invite Invite someone to a channel.
  302. DCCChat Initiate a DCC chat.
  303. DCCSend Initiate a DCC send of a file.
  304. }
  305. interface
  306. uses
  307. Classes, IdAssignedNumbers, IdBaseComponent, IdComponent, IdTCPConnection,
  308. IdException, IdTCPClient, IdThread, IdStack, IdGlobal;
  309. const
  310. { Numerics as defined in RFC1459. }
  311. RPL_TRACELINK = 200 ; { Link <version & debug level> <destination> <next server> }
  312. RPL_TRACECONNECTING = 201 ; { Try. <class> <server> }
  313. RPL_TRACEHANDSHAKE = 202 ; { H.S. <class> <server> }
  314. RPL_TRACEUNKNOWN = 203 ; { ???? <class> [<client IP address in dot form>] }
  315. RPL_TRACEOPERATOR = 204 ; { Oper <class> <nick> }
  316. RPL_TRACEUSER = 205 ; { User <class> <nick> }
  317. RPL_TRACESERVER = 206 ; { Serv <class> <int>S <int>C <server> <nick!user|*!*>@<host|server> }
  318. RPL_TRACENEWTYPE = 208 ; { <newtype> 0 <client name> }
  319. RPL_STATSLINKINFO = 211 ; { <linkname> <sendq> <sent messages> <sent bytes> <received messages> <received bytes> <time open> }
  320. RPL_STATSCOMMANDS = 212 ; { <command> <count> }
  321. RPL_STATSCLINE = 213 ; { C <host> * <name> <port> <class> }
  322. RPL_STATSNLINE = 214 ; { N <host> * <name> <port> <class> }
  323. RPL_STATSILINE = 215 ; { I <host> * <host> <port> <class> }
  324. RPL_STATSKLINE = 216 ; { K <host> * <username> <port> <class> }
  325. RPL_STATSYLINE = 218 ; { Y <class> <ping frequency> <connect frequency> <max sendq> }
  326. RPL_ENDOFSTATS = 219 ; { <stats letter> :End of /STATS report }
  327. RPL_UMODEIS = 221 ; { <user mode string> }
  328. RPL_STATSLLINE = 241 ; { L <hostmask> * <servername> <maxdepth> }
  329. RPL_STATSUPTIME = 242 ; { :Server Up %d days %d:%02d:%02d }
  330. RPL_STATSOLINE = 243 ; { O <hostmask> * <name> }
  331. RPL_STATSHLINE = 244 ; { H <hostmask> * <servername> }
  332. RPL_LUSERCLIENT = 251 ; { :There are <integer> users and <integer> invisible on <integer> servers }
  333. RPL_LUSEROP = 252 ; { <integer> :operator(s) online }
  334. RPL_LUSERUNKNOWN = 253 ; { <integer> :unknown connection(s) }
  335. RPL_LUSERCHANNELS = 254 ; { <integer> :channels formed }
  336. RPL_LUSERME = 255 ; { :I have <integer> clients and <integer> servers }
  337. RPL_ADMINME = 256 ; { <server> :Administrative info }
  338. RPL_ADMINLOC1 = 257 ; { :<admin info> }
  339. RPL_ADMINLOC2 = 258 ; { :<admin info> }
  340. RPL_ADMINEMAIL = 259 ; { :<admin info> }
  341. RPL_TRACELOG = 261 ; { File <logfile> <debug level> }
  342. RPL_NONE = 300 ; { Dummy reply number. Not used. }
  343. RPL_AWAY = 301 ; { <nick> :<away message> }
  344. RPL_USERHOST = 302 ; { :[<reply><space><reply>] }
  345. RPL_ISON = 303 ; { :[<nick> <space><nick>] }
  346. RPL_UNAWAY = 305 ; { :You are no longer marked as being away }
  347. RPL_NOWAWAY = 306 ; { :You have been marked as being away }
  348. RPL_WHOISUSER = 311 ; { <nick> <user> <host> * :<real name> }
  349. RPL_WHOISSERVER = 312 ; { <nick> <server> :<server info> }
  350. RPL_WHOISOPERATOR = 313 ; { <nick> :is an IRC operator }
  351. RPL_WHOWASUSER = 314 ; { <nick> <user> <host> * :<real name> }
  352. RPL_ENDOFWHO = 315 ; { <name> :End of /WHO list }
  353. RPL_WHOISIDLE = 317 ; { <nick> <integer> :seconds idle }
  354. RPL_ENDOFWHOIS = 318 ; { <nick> :End of /WHOIS list }
  355. RPL_WHOISCHANNELS = 319 ; { <nick> :[@|+]<channel><space> }
  356. RPL_LISTSTART = 321 ; { Channel :Users Name }
  357. RPL_LIST = 322 ; { <channel> <# visible> :<topic> }
  358. RPL_LISTEND = 323 ; { :End of /LIST }
  359. RPL_CHANNELMODEIS = 324 ; { <channel> <mode> <mode params> }
  360. RPL_NOTOPIC = 331 ; { <channel> :No topic is set }
  361. RPL_TOPIC = 332 ; { <channel> :<topic> }
  362. RPL_INVITING = 341 ; { <channel> <nick> }
  363. RPL_SUMMONING = 342 ; { <user> :Summoning user to IRC }
  364. RPL_VERSION = 351 ; { <version>.<debuglevel> <server> :<comments> }
  365. RPL_WHOREPLY = 352 ; { <channel> <user> <host> <server> <nick> <H|G>[*][@|+] :<hopcount> <real name> }
  366. RPL_NAMREPLY = 353 ; { <channel> :[[@|+]<nick> [[@|+]<nick> [...]]] }
  367. RPL_LINKS = 364 ; { <mask> <server> :<hopcount> <server info> }
  368. RPL_ENDOFLINKS = 365 ; { <mask> :End of /LINKS list }
  369. RPL_ENDOFNAMES = 366 ; { <channel> :End of /NAMES list }
  370. RPL_BANLIST = 367 ; { <channel> <banid> }
  371. RPL_ENDOFBANLIST = 368 ; { <channel> :End of channel ban list }
  372. RPL_ENDOFWHOWAS = 369 ; { <nick> :End of WHOWAS }
  373. RPL_INFO = 371 ; { :<string> }
  374. RPL_MOTD = 372 ; { :- <text> }
  375. RPL_ENDOFINFO = 374 ; { :End of /INFO list }
  376. RPL_MOTDSTART = 375 ; { ":- <server> Message of the day -," }
  377. RPL_ENDOFMOTD = 376 ; { :End of /MOTD command }
  378. RPL_YOUREOPER = 381 ; { :You are now an IRC operator }
  379. RPL_REHASHING = 382 ; { <config file> :Rehashing }
  380. RPL_TIME = 391 ; { }
  381. RPL_USERSSTART = 392 ; { :UserID Terminal Host }
  382. RPL_USERS = 393 ; { :%-8s %-9s %-8s }
  383. RPL_ENDOFUSERS = 394 ; { :End of users }
  384. RPL_NOUSERS = 395 ; { :Nobody logged in }
  385. ERR_NOSUCHNICK = 401 ; { <nickname> :No such nick/channel }
  386. ERR_NOSUCHSERVER = 402 ; { <server name> :No such server }
  387. ERR_NOSUCHCHANNEL = 403 ; { <channel name> :No such channel }
  388. ERR_CANNOTSENDTOCHAN = 404 ; { <channel name> :Cannot send to channel }
  389. ERR_TOOMANYCHANNELS = 405 ; { <channel name> :You have joined too many channels }
  390. ERR_WASNOSUCHNICK = 406 ; { <nickname> :There was no such nickname }
  391. ERR_TOOMANYTARGETS = 407 ; { <target> :Duplicate recipients. No message delivered }
  392. ERR_NOORIGIN = 409 ; { :No origin specified }
  393. ERR_NORECIPIENT = 411 ; { :No recipient given (<command>) }
  394. ERR_NOTEXTTOSEND = 412 ; { :No text to send }
  395. ERR_NOTOPLEVEL = 413 ; { <mask> :No toplevel domain specified }
  396. ERR_WILDTOPLEVEL = 414 ; { <mask> :Wildcard in toplevel domain }
  397. ERR_UNKNOWNCOMMAND = 421 ; { <command> :Unknown command }
  398. ERR_NOMOTD = 422 ; { :MOTD File is missing }
  399. ERR_NOADMININFO = 423 ; { <server> :No administrative info available }
  400. ERR_FILEERROR = 424 ; { :File error doing <file op> on <file> }
  401. ERR_NONICKNAMEGIVEN = 431 ; { :No nickname given }
  402. ERR_ERRONEUSNICKNAME = 432 ; { <nick> :Erroneus nickname }
  403. ERR_NICKNAMEINUSE = 433 ; { <nick> :Nickname is already in use }
  404. ERR_NICKCOLLISION = 436 ; { <nick> :Nickname collision KILL }
  405. ERR_USERNOTINCHANNEL = 441 ; { <nick> <channel> :They aren't on that channel } {Do not Localize}
  406. ERR_NOTONCHANNEL = 442 ; { <channel> :You're not on that channel } {Do not Localize}
  407. ERR_USERONCHANNEL = 443 ; { <user> <channel> :is already on channel }
  408. ERR_NOLOGIN = 444 ; { <user> :User not logged in }
  409. ERR_SUMMONDISABLED = 445 ; { :SUMMON has been disabled }
  410. ERR_USERSDISABLED = 446 ; { :USERS has been disabled }
  411. ERR_NOTREGISTERED = 451 ; { :You have not registered }
  412. ERR_NEEDMOREPARAMS = 461 ; { <command> :Not enough parameters }
  413. ERR_ALREADYREGISTRED = 462 ; { :You may not reregister }
  414. ERR_NOPERMFORHOST = 463 ; { :Your host isn't among the privileged } {Do not Localize}
  415. ERR_PASSWDMISMATCH = 464 ; { :Password incorrect }
  416. ERR_YOUREBANNEDCREEP = 465 ; { :You are banned from this server }
  417. ERR_KEYSET = 467 ; { <channel> :Channel key already set }
  418. ERR_CHANNELISFULL = 471 ; { <channel> :Cannot join channel (+l) }
  419. ERR_UNKNOWNMODE = 472 ; { <char> :is unknown mode char to me }
  420. ERR_INVITEONLYCHAN = 473 ; { <channel> :Cannot join channel (+i) }
  421. ERR_BANNEDFROMCHAN = 474 ; { <channel> :Cannot join channel (+b) }
  422. ERR_BADCHANNELKEY = 475 ; { <channel> :Cannot join channel (+k) }
  423. ERR_NOPRIVILEGES = 481 ; { :Permission Denied- You're not an IRC operator } {Do not Localize}
  424. ERR_CHANOPRIVSNEEDED = 482 ; { <channel> :You're not channel operator } {Do not Localize}
  425. ERR_CANTKILLSERVER = 483 ; { :You cant kill a server! }
  426. ERR_NOOPERHOST = 491 ; { :No O-lines for your host }
  427. ERR_UMODEUNKNOWNFLAG = 501 ; { :Unknown MODE flag }
  428. ERR_USERSDONTMATCH = 502 ; { :Cant change mode for other users }
  429. type
  430. { TIdIRCUser }
  431. TIdIRC = class;
  432. //TODO: This needs to be a TCollecitonItem
  433. TIdIRCUser = class(TCollectionItem)
  434. protected
  435. FClient: TIdIRC;
  436. FNick: String;
  437. FAddress: String;
  438. FData: TObject;
  439. FReason: String;
  440. public
  441. Count: Integer;
  442. constructor Create(AClient: TIdIRC; ANick, AAddress: String); reintroduce;
  443. destructor Destroy; override;
  444. procedure Say(AMsg: String);
  445. property Nick: String read FNick write FNick;
  446. property Address: String read FAddress write FAddress;
  447. property Data: TObject read FData write FData;
  448. property Reason: String read FReason write FReason;
  449. end;
  450. { TIdIRCUsers }
  451. TIdIRCSortCompareUsers = procedure (Sender :TObject;
  452. AItem1, AItem2 : TIdIRCUser; var AResult : Integer);
  453. //TODO: This needs to be a TCollection
  454. TIdIRCUsers = class(TCollection)
  455. protected
  456. FClient: TIdIRC;
  457. FOnSortCompareUsers : TIdIRCSortCompareUsers;
  458. procedure SetItem ( Index: Integer; const Value: TIdIRCUser );
  459. function GetItem(Index: Integer): TIdIRCUser;
  460. public
  461. constructor Create(AClient: TIdIRC);
  462. destructor Destroy; override;
  463. function Add(ANick, AAddress: String): TIdIRCUser;
  464. procedure Remove(AUser: TIdIRCUser);
  465. function Address(ANick: String): String;
  466. function Find(ANick: String; var AIndex: Integer): Boolean;
  467. function Get(ANick: String): TIdIRCUser;
  468. procedure Nick(AFromNick, AToNick: String);
  469. procedure Sort;
  470. property Items[Index: Integer] : TIdIRCUser read GetItem write SetItem;
  471. property OnSortCompareUsers : TIdIRCSortCompareUsers
  472. read FOnSortCompareUsers write FOnSortCompareUsers;
  473. end;
  474. { TChannel }
  475. TIdIRCChangeType = (ctNone, ctAdd, ctSubtract);
  476. TIdIRCChannelMode = (cmPrivate, cmSecret, cmInviteOnly, cmOpsSetTopic,
  477. cmNoExternalMessages, cmModerated, cmUserLimit, cmKey);
  478. TIdIRCChannelModes = Set of TIdIRCChannelMode;
  479. TIdIRCCloseType = (ctReset, ctPart, ctKick);
  480. TIdIRCChannelUpdateType = (cuMode, cuTopic, cuUser, cuNames, cuNick, cuJoin,
  481. cuPart, cuKick, cuQuit);
  482. TIdIRCOnChannelUpdate = procedure (Sender: TObject; AUpdateType:
  483. TIdIRCChannelUpdateType; AUser: TIdIRCUser; AInfo: Integer) of object;
  484. //TODO: This needs to be a TCollectionItem
  485. TIdIRCChannel = class(TCollectionItem)
  486. protected
  487. FClient: TIdIRC;
  488. FName: String;
  489. FTopic: String;
  490. FMode: TIdIRCChannelModes;
  491. FLimit: Integer;
  492. FKey: String;
  493. FNames: TStringList;
  494. FBans: TStringList;
  495. FActive: Boolean;
  496. FData: TObject;
  497. FModeChange: Boolean;
  498. ModeOptions: String;
  499. ModeParams: String;
  500. ChangeType: TIdIRCChangeType;
  501. FCloseType: TIdIRCCloseType;
  502. FOnChannelUpdate: TIdIRCOnChannelUpdate;
  503. procedure SetTopic(AValue: String);
  504. procedure SetMode(AValue: TIdIRCChannelModes);
  505. procedure SetLimit(AValue: Integer);
  506. procedure SetKey(AValue: String);
  507. function GetModeString: String;
  508. public
  509. constructor Create(AClient: TIdIRC; AName: String); reintroduce;
  510. destructor Destroy; override;
  511. procedure Say(AMsg: String);
  512. procedure Part(AReason: String);
  513. procedure Kick(ANick, AReason: String);
  514. procedure BeginMode;
  515. procedure EndMode;
  516. procedure Op(ANick: String);
  517. procedure Deop(ANick: String);
  518. procedure Voice(ANick: String);
  519. procedure Devoice(ANick: String);
  520. procedure Ban(AHostmask: String);
  521. procedure Unban(AHostmask: String);
  522. procedure TopicChanged(ATopic: String);
  523. procedure ModeChanged(AMode: TIdIRCChannelModes);
  524. procedure LimitChanged(ALimit: Integer);
  525. procedure KeyChanged(AKey: String);
  526. function AddUser(ANick, AAddress: String): TIdIRCUser;
  527. procedure RemoveUser(AUser: TIdIRCUser);
  528. function HasUser(ANick: String): Boolean;
  529. function Find(ANick: String; var AIndex: Integer): Boolean;
  530. procedure GotOp(AUser: TIdIRCUser);
  531. procedure GotDeop(AUser: TIdIRCUser);
  532. procedure GotVoice(AUser: TIdIRCUser);
  533. procedure GotDevoice(AUser: TIdIRCUser);
  534. procedure ChangedNick(AUser: TIdIRCUser; ANewNick: String);
  535. procedure Joined(AUser: TIdIRCUser);
  536. procedure Parted(AUser: TIdIRCUser);
  537. procedure Kicked(AUser: TIdIRCUser);
  538. procedure Quit(AUser: TIdIRCUser);
  539. property Name: String read FName;
  540. property Topic: String read FTopic write SetTopic;
  541. property Mode: TIdIRCChannelModes read FMode write SetMode;
  542. property Limit: Integer read FLimit write SetLimit;
  543. property Key: String read FKey write SetKey;
  544. property ModeChange: Boolean read FModeChange;
  545. property ModeString: String read GetModeString;
  546. property Names: TStringList read FNames;
  547. property Bans: TStringList read FBans;
  548. property Active: Boolean read FActive write FActive;
  549. property CloseType: TIdIRCCloseType read FCloseType write FCloseType;
  550. property Data: TObject read FData write FData;
  551. property OnChannelUpdate: TIdIRCOnChannelUpdate read FOnChannelUpdate write FOnChannelUpdate;
  552. end;
  553. { TIdIRCChannels }
  554. TIdIRCSortCompareChanels = procedure (Sender :TObject; AItem1, AItem2 : TIdIRCChannel; var AResult : Integer);
  555. //TODO: This needs to be a TCollection
  556. TIdIRCChannels = class(TCollection)
  557. protected
  558. FClient: TIdIRC;
  559. FOnSortCompareChanels : TIdIRCSortCompareChanels;
  560. function GetItem(Index:Integer): TIdIRCChannel;
  561. procedure SetItem ( Index: Integer; const Value: TIdIRCChannel );
  562. public
  563. constructor Create(AClient: TIdIRC); reintroduce;
  564. destructor Destroy; override;
  565. function Add(AName: String): TIdIRCChannel;
  566. procedure Remove(AName: String);
  567. function Find(AName: String; var AIndex: Integer): Boolean;
  568. function Get(AName: String): TIdIRCChannel;
  569. procedure ChangedNick(AUser: TIdIRCUser; ANewNick: String);
  570. procedure Quit(AUser: TIdIRCUser);
  571. public
  572. procedure Sort; virtual;
  573. property Items[Index: Integer] : TIdIRCChannel read GetItem write SetItem;
  574. end;
  575. { TIdIRCReplies }
  576. TIdIRCReplies = class(TPersistent)
  577. protected
  578. FFinger: String;
  579. FVersion: String;
  580. FUserInfo: String;
  581. FClientInfo: String;
  582. public
  583. constructor Create;
  584. procedure Assign(Source: TPersistent); override;
  585. published
  586. property Finger: String read FFinger write FFinger;
  587. property Version: String read FVersion write FVersion;
  588. property UserInfo: String read FUserInfo write FUserInfo;
  589. property ClientInfo: String read FClientInfo write FClientInfo;
  590. end;
  591. { TIdIRCReadThread }
  592. TIdIRCReadThread = class(TIdThread)
  593. protected
  594. FClient: TIdIRC;
  595. FRecvData: string;
  596. procedure Run; override;
  597. public
  598. constructor Create(AClient: TIdIRC); reintroduce;
  599. end;
  600. { TIdIRC }
  601. TIdIRCUserMode = (umInvisible, umOperator, umServerNotices, umWallops);
  602. TIdIRCUserModes = Set of TIdIRCUserMode;
  603. TIdIRCState = (csDisconnect, csDisconnected, csConnecting, csLoggingOn, csConnected);
  604. TIdIRCUpdateType = (utTopic, utMode, utNicks);
  605. TIdIRCOnMessage = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; Content: String) of object;
  606. TIdIRCOnJoin = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel) of object;
  607. TIdIRCOnJoined = procedure (Sender: TObject; AChannel: TIdIRCChannel) of object;
  608. TIdIRCOnPart = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel) of object;
  609. TIdIRCOnParted = procedure (Sender: TObject; AChannel: TIdIRCChannel) of object;
  610. TIdIRCOnKick = procedure (Sender: TObject; AUser, AVictim: TIdIRCUser; AChannel: TIdIRCChannel) of object;
  611. TIdIRCOnKicked = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel) of object;
  612. TIdIRCOnNickChange = procedure (Sender: TObject; AUser: TIdIRCUser; ANewNick: String) of object;
  613. TIdIRCOnTopic = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; const AChanName, ATopic : String) of object;
  614. TIdIRCOnQuit = procedure (Sender: TObject; AUser: TIdIRCUser) of object;
  615. TIdIRCOnNames = procedure (Sender: TObject; AUsers : TIdIRCUsers; AChannel: TIdIRCChannel) of object;
  616. TIdIRCOnInvite = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: String) of object;
  617. TIdIRCOnError = procedure (Sender: TObject; AUser: TIdIRCUser; ANumeric, AError: String) of object;
  618. TIdIRCOnAway = procedure (Sender: TObject; AUser: TIdIRCUser) of object;
  619. TIdIRCOnWallops = procedure (Sender: TObject; AUser: TIdIRCUser; AContent: String) of object;
  620. TIdIRCOnSystem = procedure (Sender: TObject; AUser: TIdIRCUser; ACmdCode: Integer; ACommand, AContent: String) of object;
  621. TIdIRCOnRaw = procedure (Sender: TObject; AUser: TIdIRCUser; ACommand, AContent: String;
  622. var Suppress: Boolean) of object;
  623. TIdIRCOnOp = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; ATarget: TIdIRCUser) of object;
  624. TIdIRCOnBan = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; AHostmask: String) of object;
  625. TIdIRCOnChannelMode = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel; AChanName: String; AModes: String) of object;
  626. TIdIRCOnChannelModeChanged = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel) of object;
  627. TIdIRCOnUserMode = procedure (Sender: TObject; AModes: String) of object;
  628. TIdIRCOnInviting = procedure (Sender: TObject; ANick, AChannel: String) of object;
  629. TIdIRCOnKill = procedure (Sender: TObject; User: TIdIRCUser; AVictim, AReason: String) of object;
  630. TIdIRCOnUnknownCommand = procedure (Sender: TObject; AUser: TIdIRCUser; ACommand, AContent: String) of object;
  631. TIdIRCOnCTCPQuery = procedure (Sender: TObject; User: TIdIRCUser; AChannel: TIdIRCChannel;
  632. Command, Args: String; var ASuppress: Boolean) of object;
  633. TIdIRCOnCTCPReply = procedure (Sender: TObject; AUser: TIdIRCUser; AChannel: TIdIRCChannel;
  634. Command, Args: String) of object;
  635. TIdIRCOnSend = procedure (Sender: TObject; ACommand: String) of object;
  636. TIdIRCOnNicksInUse = procedure (Sender: TObject; var ANick: String) of object;
  637. TIdIRCOnSocketError = procedure (Sender: TObject; ASocket, AMsg: String) of object;
  638. TIdIRCOnNoTopic = procedure (Sender: TObject; AChannel: TIdIRCChannel; AContent: String) of object;
  639. TIdIRCOnAwayChange = procedure (Sender: TObject; AContent: String) of object;
  640. TIdIRCOnNickChanged = procedure (Sender: TObject; AOldNick: String) of object;
  641. TIdIRCOnDCCChat = procedure(Sender: TObject; ANick, AIp, APort: String) of object;
  642. TIdIRCOnDCCSend = procedure(Sender: TObject; ANick, AIp, APort, AFileName, AFileSize: String) of object;
  643. TIdIRCOnDCCResume = procedure(Sender: TObject; ANick, APort, AFileName, APosition: String) of object;
  644. TIdIRCOnDCCAccept = procedure(Sender: TObject; ANick, APort, AFileName, APosition: String) of object;
  645. TIdIRCOnLinks = procedure(Sender: TObject; AMask, AServer, AHopCount, AServerInfo: String) of object;
  646. TIdIRCOnList = procedure(Sender: TObject; AChans: TStringList; APosition: Integer; ALast: Boolean) of object;
  647. // TIdIRCOnChannelMode = procedure (Sender: TObject; Nick, Address, Channel: String) of object;
  648. TIdIRC = class(TIdTCPClient)
  649. protected
  650. { Property fields }
  651. FNick: String;
  652. FAltNick: String;
  653. FUsername: String;
  654. FRealName: String;
  655. FServer: String;
  656. //FPort: Integer;
  657. FPassword: String;
  658. FUserMode: TIdIRCUserModes;
  659. FAway: Boolean;
  660. FNotify: TStringList;
  661. FReplies: TIdIRCReplies;
  662. FState: TIdIRCState;
  663. FCurrentNick: String;
  664. FData: TObject;
  665. { Event handlers }
  666. FOnMessage: TIdIRCOnMessage;
  667. FOnNotice: TIdIRCOnMessage;
  668. FOnAction: TIdIRCOnMessage;
  669. FOnConnect: TNotifyEvent;
  670. FOnDisconnect: TNotifyEvent;
  671. FOnJoin: TIdIRCOnJoin;
  672. FOnJoined: TIdIRCOnJoined;
  673. FOnPart: TIdIRCOnPart;
  674. FOnParted: TIdIRCOnParted;
  675. FOnKick: TIdIRCOnKick;
  676. FOnKicked: TIdIRCOnKicked;
  677. FOnNickChange: TIdIRCOnNickChange;
  678. FOnNickChanged: TIdIRCOnNickChanged;
  679. FOnTopic: TIdIRCOnTopic;
  680. FOnQuit: TIdIRCOnQuit;
  681. FOnNames: TIdIRCOnNames;
  682. FOnInvite: TIdIRCOnInvite;
  683. FOnPingPong: TNotifyEvent;
  684. FOnError: TIdIRCOnError;
  685. FOnAway: TIdIRCOnAway;
  686. FOnNowAway: TIdIRCOnAwayChange;
  687. FOnUnAway: TIdIRCOnAwayChange;
  688. FOnWallops: TIdIRCOnWallops;
  689. FOnSystem: TIdIRCOnSystem;
  690. FOnRaw: TIdIRCOnRaw;
  691. FOnOp: TIdIRCOnOp;
  692. FOnDeop: TIdIRCOnOp;
  693. FOnBan: TIdIRCOnBan;
  694. FOnUnban: TIdIRCOnBan;
  695. FOnVoice: TIdIRCOnOp;
  696. FOnDevoice: TIdIRCOnOp;
  697. FOnChannelMode: TIdIRCOnChannelMode;
  698. FOnChannelModeChanged: TIdIRCOnChannelModeChanged;
  699. FOnUserMode: TIdIRCOnUserMode;
  700. FOnUserModeChanged: TNotifyEvent;
  701. FOnInviting: TIdIRCOnInviting;
  702. FOnKill: TIdIRCOnKill;
  703. FOnUnknownCommand: TIdIRCOnUnknownCommand;
  704. FOnCTCPQuery: TIdIRCOnCTCPQuery;
  705. FOnCTCPReply: TIdIRCOnCTCPReply;
  706. FOnStateChange: TNotifyEvent;
  707. FOnSend: TIdIRCOnSend;
  708. FOnReceive: TIdIRCOnSend;
  709. FOnNicksInUse: TIdIRCOnNicksInUse;
  710. FOnSocketError: TIdIRCOnSocketError;
  711. FOnNoTopic: TIdIRCOnNoTopic;
  712. FOnDCCChat: TIdIRCOnDCCChat;
  713. FOnDCCSend: TIdIRCOnDCCSend;
  714. FOnDCCResume: TIdIRCOnDCCResume;
  715. FOnDCCAccept: TIdIRCOnDCCAccept;
  716. FOnLinks: TIdIRCOnLinks;
  717. FOnList: TIdIRCOnList;
  718. // FOnChannelMode: TIdIRCOnChannelMode;
  719. FOnChannelUpdate: TIdIRCOnChannelUpdate;
  720. { Other fields }
  721. FList: TStringList;
  722. FListLast: Integer;
  723. Token: TStringList;
  724. FullCommand: String;
  725. SenderNick: String;
  726. SenderAddress: String;
  727. Command: String;
  728. Content: String;
  729. FChannels: TIdIRCChannels;
  730. FUsers: TIdIRCUsers;
  731. FUser: TIdIRCUser;
  732. FIRCThread: TIdIRCReadThread;
  733. { Socket }
  734. FBuffer: String;
  735. { Socket event handlers }
  736. procedure SocketDataAvailable;
  737. //procedure SocketSessionClosed(Sender: TObject);
  738. //procedure SocketSessionConnected(Sender: TObject);
  739. { Property methods }
  740. procedure SetNick(AValue: String);
  741. function GetNick: String;
  742. procedure SetAltNick(AValue: String);
  743. procedure SeTIdIRCUsername(AValue: String);
  744. procedure SetRealName(AValue: String);
  745. procedure SetPassword(AValue: String);
  746. procedure SeTIdIRCUserMode(AValue: TIdIRCUserModes);
  747. procedure SeTIdIRCReplies(AValue: TIdIRCReplies);
  748. //procedure SetServer(Value: String);
  749. //procedure SetPort(Value: Integer);
  750. //function GetConnected: Boolean;
  751. //function GetLocalHost: String;
  752. //function GetLocalIPAddr: String;
  753. //procedure SetSocksServer(Value: String);
  754. //procedure SetSocksPort(Value: String);
  755. { Other methods }
  756. procedure SeTIdIRCState(AState: TIdIRCState);
  757. procedure TokenizeCommand;
  758. function MatchCommand: Integer;
  759. procedure ParseCommand;
  760. function MatchDCC(ADCC: String): Integer;
  761. function MatchCTCP(ACTCP: String): Integer;
  762. procedure ParseDCC(ADCC: String);
  763. procedure ParseCTCPQuery;
  764. procedure ParseCTCPReply;
  765. function ParseChannelModeChange(AChannelToken: Integer): Boolean;
  766. function ParseUserModeChange: Boolean;
  767. public
  768. constructor Create(AOwner: TComponent); override;
  769. destructor Destroy; override;
  770. procedure Loaded; override;
  771. procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
  772. procedure Disconnect(AForce: Boolean); reintroduce; overload;
  773. function IsChannel(AChannel: String): Boolean;
  774. function IsOp(ANick: String): Boolean;
  775. function IsVoice(ANick: String): Boolean;
  776. function MatchHostmask(AAddress, AHostmask: PChar): Boolean;
  777. procedure Raw(ALine: String);
  778. procedure Say(ATarget, AMsg: String);
  779. procedure Notice(ATarget, AMsg: String);
  780. procedure Action(ATarget, AMsg: String);
  781. procedure CTCPQuery(ATarget, ACommand, AParameters: String);
  782. procedure CTCPReply(ATarget, ACTCP, AReply: String);
  783. procedure Join(AChannels : String; const AKeys: String =''); {Do not Localize}
  784. procedure Part(AChannels : String; const AReason: String = ''); {Do not Localize}
  785. procedure Kick(AChannel, ANick, AReason: String);
  786. procedure Quit(AReason: String);
  787. procedure Mode(AChannel, AModes : String; const AParams: String = ''); {Do not Localize}
  788. procedure GetTopic(AChannel: String);
  789. procedure SetTopic(AChannel, ATopic: String);
  790. procedure SetAwayMessage(AMsg: String);
  791. procedure ClearAwayMessage;
  792. function GetModeString: String;
  793. { Public properties }
  794. //property Connected: Boolean read GetConnected;
  795. property Away: Boolean read FAway;
  796. property Notify: TStringList read FNotify write FNotify;
  797. property State: TIdIRCState read FState;
  798. property Channels: TIdIRCChannels read FChannels;
  799. property Users: TIdIRCUsers read FUsers;
  800. property IRCThread: TIdIRCReadThread read FIRCThread;
  801. //property LocalHost: String read GetLocalHost;
  802. //property LocalIPAddr: String read GetLocalIPAddr;
  803. //property Data: TObject read FData write FData;
  804. published
  805. { Published properties }
  806. property Nick: String read GetNick write SetNick;
  807. property AltNick: String read FAltNick write SetAltNick;
  808. property Username: String read FUsername write SeTIdIRCUsername;
  809. property RealName: String read FRealName write SetRealName;
  810. //property Server: String read FServer write SetServer;
  811. //property Port: Integer read FPort write SetPort;
  812. property Port default IdPORT_IRC;
  813. property Password: String read FPassword write SetPassword;
  814. property Replies: TIdIRCReplies read FReplies write SeTIdIRCReplies;
  815. property UserMode: TIdIRCUserModes read FUserMode write SeTIdIRCUserMode;
  816. //property SocksServer: String read FSocksServer write SetSocksServer;
  817. //property SocksPort: String read FSocksPort write SetSocksPort;
  818. { Published events }
  819. property OnMessage: TIdIRCOnMessage read FOnMessage write FOnMessage;
  820. property OnNotice: TIdIRCOnMessage read FOnNotice write FOnNotice;
  821. property OnAction: TIdIRCOnMessage read FOnAction write FOnAction;
  822. property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
  823. property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
  824. property OnJoin: TIdIRCOnJoin read FOnJoin write FOnJoin;
  825. property OnJoined: TIdIRCOnJoined read FOnJoined write FOnJoined;
  826. property OnPart: TIdIRCOnPart read FOnPart write FOnPart;
  827. property OnParted: TIdIRCOnParted read FOnParted write FOnParted;
  828. property OnKick: TIdIRCOnKick read FOnKick write FOnKick;
  829. property OnKicked: TIdIRCOnKicked read FOnKicked write FOnKicked;
  830. property OnNickChange: TIdIRCOnNickChange read FOnNickChange write FOnNickChange;
  831. property OnNickChanged: TIdIRCOnNickChanged read FOnNickChanged write FOnNickChanged;
  832. property OnTopic: TIdIRCOnTopic read FOnTopic write FOnTopic;
  833. property OnQuit: TIdIRCOnQuit read FOnQuit write FOnQuit;
  834. property OnNames: TIdIRCOnNames read FOnNames write FOnNames;
  835. property OnInvite: TIdIRCOnInvite read FOnInvite write FOnInvite;
  836. property OnPingPong: TNotifyEvent read FOnPingPong write FOnPingPong;
  837. property OnError: TIdIRCOnError read FOnError write FOnError;
  838. property OnAway: TIdIRCOnAway read FOnAway write FOnAway;
  839. property OnNowAway: TIdIRCOnAwayChange read FOnNowAway write FOnNowAway;
  840. property OnUnAway: TIdIRCOnAwayChange read FOnUnAway write FOnUnAway;
  841. property OnWallops: TIdIRCOnWallops read FOnWallops write FOnWallops;
  842. property OnSystem: TIdIRCOnSystem read FOnSystem write FOnSystem;
  843. property OnRaw: TIdIRCOnRaw read FOnRaw write FOnRaw;
  844. property OnOp: TIdIRCOnOp read FOnOp write FOnOp;
  845. property OnDeop: TIdIRCOnOp read FOnDeop write FOnDeop;
  846. property OnBan: TIdIRCOnBan read FOnBan write FOnBan;
  847. property OnUnban: TIdIRCOnBan read FOnUnban write FOnUnban;
  848. property OnVoice: TIdIRCOnOp read FOnVoice write FOnVoice;
  849. property OnDevoice: TIdIRCOnOp read FOnDevoice write FOnDevoice;
  850. property OnChannelMode: TIdIRCOnChannelMode read FOnChannelMode write FOnChannelMode;
  851. property OnChannelModeChanged: TIdIRCOnChannelModeChanged read FOnChannelModeChanged write FOnChannelModeChanged;
  852. property OnUserMode: TIdIRCOnUserMode read FOnUserMode write FOnUserMode;
  853. property OnUserModeChanged: TNotifyEvent read FOnUserModeChanged write FOnUserModeChanged;
  854. property OnInviting: TIdIRCOnInviting read FOnInviting write FOnInviting;
  855. property OnKill: TIdIRCOnKill read FOnKill write FOnKill;
  856. property OnUnknownCommand: TIdIRCOnUnknownCommand read FOnUnknownCommand write FOnUnknownCommand;
  857. property OnCTCPQuery: TIdIRCOnCTCPQuery read FOnCTCPQuery write FOnCTCPQuery;
  858. property OnCTCPReply: TIdIRCOnCTCPReply read FOnCTCPReply write FOnCTCPReply;
  859. property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  860. property OnSend: TIdIRCOnSend read FOnSend write FOnSend;
  861. property OnReceive: TIdIRCOnSend read FOnReceive write FOnReceive;
  862. property OnNicksInUse: TIdIRCOnNicksInUse read FOnNicksInUse write FOnNicksInUse;
  863. property OnSocketError: TIdIRCOnSocketError read FOnSocketError write FOnSocketError;
  864. property OnNoTopic: TIdIRCOnNoTopic read FOnNoTopic write FOnNoTopic;
  865. property OnDCCChat: TIdIRCOnDCCChat read FOnDCCChat write FOnDCCChat;
  866. property OnDCCSend: TIdIRCOnDCCSend read FOnDCCSend write FOnDCCSend;
  867. property OnDCCResume: TIdIRCOnDCCResume read FOnDCCResume write FOnDCCResume;
  868. property OnDCCAccept: TIdIRCOnDCCAccept read FOnDCCAccept write FOnDCCAccept;
  869. property OnLinks: TIdIRCOnLinks read FOnLinks write FOnLinks;
  870. property OnList: TIdIRCOnList read FOnList write FOnList;
  871. // property OnChannelMode: TIdIRCOnChannelMode read FOnChannelMode write FOnChannelMode;
  872. property OnChannelUpdate: TIdIRCOnChannelUpdate read FOnChannelUpdate write FOnChannelUpdate;
  873. End;//TIdIRC
  874. const
  875. { RFC1459 specifies 15 as the maximum token count in any one line. }
  876. { I changed this to 30, becuase 15 causes problems on servers that don't stick to RFC - MRE - 4/16/02}
  877. IdIrcMinTokenCount: Byte = 30;
  878. implementation
  879. uses
  880. IdResourceStrings,
  881. SysUtils;
  882. const
  883. { Responses from the server that do not appear as a numeric. }
  884. Commands: Array [0..12] of String = ('PRIVMSG', 'NOTICE', 'JOIN', 'PART', 'KICK', 'MODE', {Do not Localize}
  885. 'NICK', 'QUIT', 'INVITE', 'KILL', 'PING', 'WALLOPS', 'TOPIC'); {Do not Localize}
  886. { Standard CTCP queries and replies. }
  887. CTCPs: Array [0..9] of String = ('ACTION', 'SOUND', 'PING', 'FINGER', 'USERINFO', 'VERSION', {Do not Localize}
  888. 'CLIENTINFO', 'TIME', 'ERROR', 'DCC'); {Do not Localize}
  889. { Standard DCC queries and replies. }
  890. DCCs: Array [0..3] of String = ('SEND', 'CHAT', 'RESUME', 'ACCEPT');
  891. { The characters for the channel modes. In the same order as TIdIRCChannelModes. }
  892. ChannelModeChars: array [0..7] of Char = ('p', 's', 'i', 't', 'n', 'm', 'l', 'k'); {Do not Localize}
  893. { The characters for the user modes. In the same order as TIdIRCUserModes. }
  894. UserModeChars: array [0..3] of Char = ('i', 'o', 's', 'w'); {Do not Localize}
  895. { Default CTCP Version and ClientInfo replies (just a bit of advertising if
  896. the client coder forgets to specify any other values). }
  897. IRCChannelPrefixes = ['&','#','+','!']; {do not translate} {Do not Localize}
  898. { Register the component TIdIRC in Delphi. }
  899. { //////////////////////////////////////////////////////////////////////////// }
  900. { TIdIRCUser }
  901. { //////////////////////////////////////////////////////////////////////////// }
  902. { Create a new user in our list. }
  903. constructor TIdIRCUser.Create(AClient: TIdIRC; ANick, AAddress: String);
  904. begin
  905. inherited Create( AClient.Users );
  906. FClient := AClient;
  907. FNick := ANick;
  908. FAddress := AAddress;
  909. FData := nil;
  910. FReason := ''; {Do not Localize}
  911. Count := 1;
  912. end;
  913. { Delete the user from our list. }
  914. destructor TIdIRCUser.Destroy;
  915. begin
  916. inherited Destroy;
  917. end;
  918. { Send a private message to the user. }
  919. procedure TIdIRCUser.Say(AMsg: String);
  920. begin
  921. FClient.Say(FNick, AMsg);
  922. end;
  923. { //////////////////////////////////////////////////////////////////////////// }
  924. { TIdIRCUsers }
  925. { //////////////////////////////////////////////////////////////////////////// }
  926. { Create the list of users. }
  927. constructor TIdIRCUsers.Create(AClient: TIdIRC);
  928. begin
  929. inherited Create (TIdIRCUser);
  930. FClient := AClient;
  931. end;
  932. { Delete the list of users. }
  933. destructor TIdIRCUsers.Destroy;
  934. begin
  935. inherited Destroy;
  936. end;
  937. procedure TIdIRCUsers.SetItem ( Index: Integer; const Value: TIdIRCUser );
  938. begin
  939. inherited SetItem (Index, Value);
  940. end;
  941. {inherited GetItem for our items property}
  942. function TIdIRCUsers.GetItem(Index: Integer): TIdIRCUser;
  943. begin
  944. Result := TIdIRCUser( inherited GetItem(Index));
  945. end;
  946. { Increments the reference count for the user. If the user does not exist,
  947. then a new user is created with a reference count of one. If the user
  948. already exists, the address is updated. Returns the user object. }
  949. function TIdIRCUsers.Add(ANick, AAddress: String): TIdIRCUser;
  950. var
  951. Index: Integer;
  952. begin
  953. if Find(ANick, Index) then
  954. { The user already exists, so increment the reference count. }
  955. begin
  956. Result := Items[Index];
  957. if (AAddress <> '') and (Result.Address <> AAddress) then {Do not Localize}
  958. begin
  959. Result.Address := AAddress;
  960. end;
  961. Inc(Result.Count);
  962. end
  963. else
  964. { Create a new user with a reference count of one. }
  965. begin
  966. Result := TIdIRCUser.Create(FClient, ANick, AAddress);
  967. end;
  968. end;
  969. { Decrement the reference count for this user. If the reference count becomes
  970. zero, then delete the user object and remove the nick from the list (if the
  971. nick in the list refers to the same user object). }
  972. procedure TIdIRCUsers.Remove(AUser: TIdIRCUser);
  973. var
  974. Index: Integer;
  975. begin
  976. Dec(AUser.Count);
  977. if AUser.Count = 0 then
  978. begin
  979. if Find(AUser.Nick, Index) and ((Items[Index] as TIdIRCUser) = AUser) then
  980. begin
  981. Items[Index].Free;
  982. end;
  983. end;
  984. end;
  985. { Returns the address for the specified nick, if available. }
  986. function TIdIRCUsers.Address(ANick: String): String;
  987. var
  988. Index: Integer;
  989. begin
  990. Result := ''; {Do not Localize}
  991. if Find(ANick, Index) then
  992. begin
  993. Result := Items[Index].Address;
  994. end;
  995. end;
  996. { Searches for the given nick. Returns True and the index number of the nick
  997. if found. }
  998. function TIdIRCUsers.Find(ANick: String; var AIndex: Integer): Boolean;
  999. begin
  1000. { Need a case-insensitive search. So it has to be done manually, I guess. }
  1001. Result := False;
  1002. AIndex := 0;
  1003. while AIndex < Count do
  1004. begin
  1005. Result := AnsiCompareText(ANick, Items[AIndex].FNick) = 0;
  1006. if Result then
  1007. begin
  1008. Exit;
  1009. end;
  1010. Inc(AIndex);
  1011. end;
  1012. { Search failed, so Index is set to -1. }
  1013. AIndex := -1;
  1014. end;
  1015. { Returns the user object for the given nick. If the nick is not found, then
  1016. it returns nil. }
  1017. function TIdIRCUsers.Get(ANick: String): TIdIRCUser;
  1018. var
  1019. Index: Integer;
  1020. begin
  1021. Result := nil;
  1022. if Find(ANick, Index) then
  1023. begin
  1024. Result := Items[Index];
  1025. end;
  1026. end;
  1027. {sort user list}
  1028. procedure TIdIRCUsers.Sort;
  1029. {I found this procedure at:
  1030. http://groups.google.com/groups?q=Sort+TCollection&start=30&hl=en&safe=off&rnum=35&selm=904181166%40f761.n5030.z2.FidoNet.ftn
  1031. and it seems to look good.}
  1032. function DoCompare(AItem1, AItem2 : TIdIRCUser) : Integer;
  1033. begin
  1034. if Assigned(FOnSortCompareUsers) then
  1035. begin
  1036. FOnSortCompareUsers(Self,AItem1, AItem2, Result);
  1037. end
  1038. else
  1039. begin
  1040. Result := 0;
  1041. end;
  1042. end;
  1043. procedure SwapItems(i, j : Integer);
  1044. var
  1045. T : TIdIRCUser;
  1046. begin
  1047. T := Items[i];
  1048. Items[i] := Items[j];
  1049. Items[j] := T;
  1050. end;
  1051. procedure SortItems(iStart, iEnd : Integer);
  1052. var
  1053. i, j : Integer;
  1054. Med : TIdIRCUser;
  1055. begin
  1056. while iStart < iEnd do
  1057. begin
  1058. i := iStart;
  1059. j := iEnd;
  1060. if iStart = iEnd-1 then
  1061. begin
  1062. if DoCompare(Items[iStart], Items[iEnd]) > 0 then
  1063. begin
  1064. SwapItems(iStart, iEnd);
  1065. end;
  1066. Break;
  1067. end;
  1068. Med := Items[(i + j) div 2];
  1069. repeat
  1070. while DoCompare(Items[i], Med) < 0 do
  1071. begin
  1072. Inc(i);
  1073. end;
  1074. while DoCompare(Items[j], Med) > 0 do
  1075. begin
  1076. Dec(j);
  1077. end;
  1078. if i <= j then
  1079. begin
  1080. SwapItems(i, j);
  1081. Inc(i);
  1082. Dec(j);
  1083. end;
  1084. until i > j;
  1085. if j-iStart > iEnd-i then
  1086. begin
  1087. SortItems(i, iEnd);
  1088. iEnd := j;
  1089. end
  1090. else
  1091. begin
  1092. SortItems(iStart, j);
  1093. iStart := i;
  1094. end;
  1095. end;
  1096. end;
  1097. begin
  1098. if Count > 0 then
  1099. begin
  1100. SortItems(0, Count - 1);
  1101. end;
  1102. end;
  1103. { Changes the user's nick. } {Do not Localize}
  1104. procedure TIdIRCUsers.Nick(AFromNick, AToNick: String);
  1105. var
  1106. Index: Integer;
  1107. User: TIdIRCUser;
  1108. begin
  1109. if Find(AFromNick, Index) then
  1110. begin
  1111. User := Items[Index];
  1112. User.Nick := AToNick;
  1113. {I'm leaving this all commented because I'm not sure if it is needed or not due
  1114. to some comments made by the author}
  1115. { items[Index].Free;
  1116. if Find(AToNick, Index) then
  1117. { The ToNick already exists (probably from the previous user having quit
  1118. IRC and a query window is still open), so replace the existing user
  1119. object with the new user object.}
  1120. { FNickList.Objects[Index] := User
  1121. else
  1122. { Add the user to the list with the new nick. }
  1123. { begin
  1124. Index := FNickList.Add(AToNick);
  1125. FNickList.Objects[Index] := User;
  1126. end; }
  1127. end;
  1128. end;
  1129. { Purge the users list. }
  1130. { //////////////////////////////////////////////////////////////////////////// }
  1131. { TIdIRCChannel }
  1132. { //////////////////////////////////////////////////////////////////////////// }
  1133. { Create a new channel in the channel list. }
  1134. constructor TIdIRCChannel.Create(AClient: TIdIRC; AName: String);
  1135. begin
  1136. inherited Create(AClient.FChannels);
  1137. FClient := AClient;
  1138. FName := AName;
  1139. FTopic := ''; {Do not Localize}
  1140. FMode := [];
  1141. FLimit := 0;
  1142. FKey := ''; {Do not Localize}
  1143. FNames := TStringList.Create;
  1144. FBans := TStringList.Create;
  1145. FModeChange := False;
  1146. FActive := False;
  1147. FCloseType := ctReset;
  1148. FData := nil;
  1149. { Attach the event handler for channel updates. }
  1150. FOnChannelUpdate := FClient.OnChannelUpdate;
  1151. end;
  1152. { Delete a channel from the channel list. }
  1153. destructor TIdIRCChannel.Destroy;
  1154. begin
  1155. FNames.Free;
  1156. FBans.Free;
  1157. inherited Destroy;
  1158. end;
  1159. { Set the topic of the channel. }
  1160. procedure TIdIRCChannel.SetTopic(AValue: String);
  1161. begin
  1162. FClient.SetTopic(FName, AValue);
  1163. end;
  1164. { Compile a mode command to change the mode of the channel. }
  1165. procedure TIdIRCChannel.SetMode(AValue: TIdIRCChannelModes);
  1166. var
  1167. Element: TIdIRCChannelMode;
  1168. Difference: TIdIRCChannelModes;
  1169. TempOptions: String;
  1170. begin
  1171. TempOptions := ''; {Do not Localize}
  1172. { If no difference in modes, then exit. }
  1173. if FMode = AValue then
  1174. begin
  1175. Exit;
  1176. end;
  1177. { Calculate which modes have been removed. }
  1178. Difference := FMode - AValue;
  1179. if Difference <> [] then
  1180. begin
  1181. if ChangeType <> ctSubtract then
  1182. begin
  1183. TempOptions := TempOptions + '-'; {Do not Localize}
  1184. ChangeType := ctSubtract;
  1185. end;
  1186. for Element := cmPrivate to cmKey do
  1187. begin
  1188. if Element in Difference then
  1189. begin
  1190. TempOptions := TempOptions + ChannelModeChars[Ord(Element)];
  1191. end;
  1192. end;
  1193. end;
  1194. { Calculate which modes have been added. }
  1195. Difference := AValue - FMode;
  1196. if Difference <> [] then
  1197. begin
  1198. if ChangeType <> ctAdd then
  1199. begin
  1200. TempOptions := TempOptions + '+'; {Do not Localize}
  1201. ChangeType := ctAdd;
  1202. end;
  1203. { Will not add Limit or Key modes. These must be added with the Limit and
  1204. Key properties. }
  1205. for Element := cmPrivate to cmKey do
  1206. begin
  1207. if (Element <> cmUserLimit) and (Element <> cmKey) then
  1208. begin
  1209. if Element in Difference then
  1210. begin
  1211. TempOptions := TempOptions + ChannelModeChars[Ord(Element)];
  1212. end;
  1213. end;
  1214. end;
  1215. end;
  1216. { If compiling mode changes. }
  1217. if FModeChange then
  1218. begin
  1219. { Add the mode change. }
  1220. ModeOptions := ModeOptions + TempOptions;
  1221. end
  1222. { Send the mode change immediately. }
  1223. else
  1224. begin
  1225. FClient.Mode(FName, TempOptions, ''); {Do not Localize}
  1226. end;
  1227. end;
  1228. procedure TIdIRCChannel.SetLimit(AValue: Integer);
  1229. begin
  1230. { If compiling mode changes. }
  1231. if FModeChange then
  1232. begin
  1233. { If the change type needs to be modified. }
  1234. if ChangeType <> ctAdd then
  1235. begin
  1236. ModeOptions := ModeOptions + '+'; {Do not Localize}
  1237. ChangeType := ctAdd;
  1238. end;
  1239. { Add the mode change. }
  1240. ModeOptions := ModeOptions + 'l'; {Do not Localize}
  1241. { If there are already some parameters, then add a space separator. }
  1242. if ModeParams <> '' then {Do not Localize}
  1243. begin
  1244. ModeParams := ModeParams + ' '; {Do not Localize}
  1245. end;
  1246. { Add the parameter. }
  1247. ModeParams := ModeParams + Format('%s', [FLimit]); {Do not Localize}
  1248. end
  1249. { Send the mode change immediately. }
  1250. else
  1251. begin
  1252. FClient.Mode(FName, '+l', Format('%s', [FLimit])); {Do not Localize}
  1253. end;
  1254. end;
  1255. procedure TIdIRCChannel.SetKey(AValue: String);
  1256. begin
  1257. { If compiling mode changes. }
  1258. if FModeChange then
  1259. begin
  1260. { If the change type needs to be modified. }
  1261. if ChangeType <> ctAdd then
  1262. begin
  1263. ModeOptions := ModeOptions + '+'; {Do not Localize}
  1264. ChangeType := ctAdd;
  1265. end;
  1266. { Add the mode change. }
  1267. ModeOptions := ModeOptions + 'k'; {Do not Localize}
  1268. { If there are already some parameters, then add a space separator. }
  1269. if ModeParams <> '' then {Do not Localize}
  1270. begin
  1271. ModeParams := ModeParams + ' '; {Do not Localize}
  1272. end;
  1273. { Add the parameter. }
  1274. ModeParams := ModeParams + FKey;
  1275. end
  1276. { Send the mode change immediately. }
  1277. else
  1278. begin
  1279. FClient.Mode(FName, '+k', FKey); {Do not Localize}
  1280. end;
  1281. end;
  1282. { Send a message to the channel. }
  1283. procedure TIdIRCChannel.Say(AMsg: String);
  1284. begin
  1285. FClient.Say(FName, AMsg);
  1286. end;
  1287. { Part the channel. }
  1288. procedure TIdIRCChannel.Part(AReason: String);
  1289. begin
  1290. FClient.Part(FName, AReason);
  1291. end;
  1292. { Kick a person from the channel. }
  1293. procedure TIdIRCChannel.Kick(ANick, AReason: String);
  1294. begin
  1295. FClient.Kick(FName, ANick, AReason);
  1296. end;
  1297. { Begin compiling all subsequent mode changes into one mode command. }
  1298. procedure TIdIRCChannel.BeginMode;
  1299. begin
  1300. ModeOptions := ''; {Do not Localize}
  1301. ModeParams := ''; {Do not Localize}
  1302. ChangeType := ctNone;
  1303. FModeChange := True;
  1304. end;
  1305. { Send all compiled mode changes as one mode command. }
  1306. procedure TIdIRCChannel.EndMode;
  1307. begin
  1308. { If no mode changes have been compiled, then do not send the command. }
  1309. if ModeOptions <> '' then {Do not Localize}
  1310. begin
  1311. FClient.Mode(FName, ModeOptions, ModeParams);
  1312. end;
  1313. FModeChange := False;
  1314. end;
  1315. { Give a user channel operator status. }
  1316. procedure TIdIRCChannel.Op(ANick: String);
  1317. begin
  1318. { If compiling mode changes. }
  1319. if FModeChange then
  1320. begin
  1321. { If the change type needs to be modified. }
  1322. if ChangeType <> ctAdd then
  1323. begin
  1324. ModeOptions := ModeOptions + '+'; {Do not Localize}
  1325. ChangeType := ctAdd;
  1326. end;
  1327. { Add the mode change. }
  1328. ModeOptions := ModeOptions + 'o'; {Do not Localize}
  1329. { If there are already some parameters, then add a space separator. }
  1330. if ModeParams <> '' then {Do not Localize}
  1331. begin
  1332. ModeParams := ModeParams + ' '; {Do not Localize}
  1333. end;
  1334. { Add the parameter. }
  1335. ModeParams := ModeParams + ANick;
  1336. end
  1337. { Send the mode change immediately. }
  1338. else
  1339. begin
  1340. FClient.Mode(FName, '+o', ANick); {Do not Localize}
  1341. end;
  1342. end;
  1343. { Remove channel operator status from a user. }
  1344. procedure TIdIRCChannel.Deop(ANick: String);
  1345. begin
  1346. { If compiling mode changes. }
  1347. if FModeChange then
  1348. begin
  1349. { If the change type needs to be modified. }
  1350. if ChangeType <> ctSubtract then
  1351. begin
  1352. ModeOptions := ModeOptions + '-'; {Do not Localize}
  1353. ChangeType := ctSubtract;
  1354. end;
  1355. { Add the mode change. }
  1356. ModeOptions := ModeOptions + 'o'; {Do not Localize}
  1357. { If there are already some parameters, then add a space separator. }
  1358. if ModeParams <> '' then {Do not Localize}
  1359. begin
  1360. ModeParams := ModeParams + ' '; {Do not Localize}
  1361. end;
  1362. { Add the parameter. }
  1363. ModeParams := ModeParams + ANick;
  1364. end
  1365. { Send the mode change immediately. }
  1366. else
  1367. begin
  1368. FClient.Mode(FName, '-o', ANick); {Do not Localize}
  1369. end;
  1370. end;
  1371. { Give a user a voice in a moderated channel. }
  1372. procedure TIdIRCChannel.Voice(ANick: String);
  1373. begin
  1374. { If compiling mode changes. }
  1375. if FModeChange then
  1376. begin
  1377. { If the change type needs to be modified. }
  1378. if ChangeType <> ctAdd then
  1379. begin
  1380. ModeOptions := ModeOptions + '+'; {Do not Localize}
  1381. ChangeType := ctAdd;
  1382. end;
  1383. { Add the mode change. }
  1384. ModeOptions := ModeOptions + 'v'; {Do not Localize}
  1385. { If there are already some parameters, then add a space separator. }
  1386. if ModeParams <> '' then {Do not Localize}
  1387. begin
  1388. ModeParams := ModeParams + ' '; {Do not Localize}
  1389. end;
  1390. { Add the parameter. }
  1391. ModeParams := ModeParams + ANick;
  1392. end
  1393. { Send the mode change immediately. }
  1394. else
  1395. begin
  1396. FClient.Mode(FName, '+v', ANick); {Do not Localize}
  1397. end;
  1398. end;
  1399. { Remove the voice from a user in a moderated channel. }
  1400. procedure TIdIRCChannel.Devoice(ANick: String);
  1401. begin
  1402. { If compiling mode changes. }
  1403. if FModeChange then
  1404. begin
  1405. { If the change type needs to be modified. }
  1406. if ChangeType <> ctSubtract then
  1407. begin
  1408. ModeOptions := ModeOptions + '-'; {Do not Localize}
  1409. ChangeType := ctSubtract;
  1410. end;
  1411. { Add the mode change. }
  1412. ModeOptions := ModeOptions + 'v'; {Do not Localize}
  1413. { If there are already some parameters, then add a space separator. }
  1414. if ModeParams <> '' then {Do not Localize}
  1415. begin
  1416. ModeParams := ModeParams + ' '; {Do not Localize}
  1417. end;
  1418. { Add the parameter. }
  1419. ModeParams := ModeParams + ANick;
  1420. end
  1421. { Send the mode change immediately. }
  1422. else
  1423. begin
  1424. FClient.Mode(FName, '-v', ANick); {Do not Localize}
  1425. end;
  1426. end;
  1427. { Ban a user from the channel. }
  1428. procedure TIdIRCChannel.Ban(AHostmask: String);
  1429. begin
  1430. { If compiling mode changes. }
  1431. if FModeChange then
  1432. begin
  1433. { If the change type needs to be modified. }
  1434. if ChangeType <> ctAdd then
  1435. begin
  1436. ModeOptions := ModeOptions + '+'; {Do not Localize}
  1437. ChangeType := ctAdd;
  1438. end;
  1439. { Add the mode change. }
  1440. ModeOptions := ModeOptions + 'b'; {Do not Localize}
  1441. { If there are already some parameters, then add a space separator. }
  1442. if ModeParams <> '' then {Do not Localize}
  1443. begin
  1444. ModeParams := ModeParams + ' '; {Do not Localize}
  1445. end;
  1446. { Add the parameter. }
  1447. ModeParams := ModeParams + AHostmask;
  1448. end
  1449. { Send the mode change immediately. }
  1450. else
  1451. begin
  1452. FClient.Mode(FName, '+b', AHostmask); {Do not Localize}
  1453. end;
  1454. end;
  1455. { Remove the ban from the channel. }
  1456. procedure TIdIRCChannel.Unban(AHostmask: String);
  1457. begin
  1458. { If compiling mode changes. }
  1459. if FModeChange then
  1460. begin
  1461. { If the change type needs to be modified. }
  1462. if ChangeType <> ctSubtract then
  1463. begin
  1464. ModeOptions := ModeOptions + '-'; {Do not Localize}
  1465. ChangeType := ctSubtract;
  1466. end;
  1467. { Add the mode change. }
  1468. ModeOptions := ModeOptions + 'b'; {Do not Localize}
  1469. { If there are already some parameters, then add a space separator. }
  1470. if ModeParams <> '' then {Do not Localize}
  1471. begin
  1472. ModeParams := ModeParams + ' '; {Do not Localize}
  1473. end;
  1474. { Add the parameter. }
  1475. ModeParams := ModeParams + AHostmask;
  1476. end
  1477. { Send the mode change immediately. }
  1478. else
  1479. begin
  1480. FClient.Mode(FName, '-b', AHostmask); {Do not Localize}
  1481. end;
  1482. end;
  1483. { Call to change the topic without sending a topic command. }
  1484. procedure TIdIRCChannel.TopicChanged(ATopic: String);
  1485. begin
  1486. if FTopic <> ATopic then
  1487. begin
  1488. FTopic := ATopic;
  1489. end;
  1490. if Assigned(FOnChannelUpdate) then
  1491. begin
  1492. FOnChannelUpdate(Self, cuTopic, nil, 0);
  1493. end;
  1494. end;
  1495. { Call to change the channel mode without sending a mode command. }
  1496. procedure TIdIRCChannel.ModeChanged(AMode: TIdIRCChannelModes);
  1497. begin
  1498. if FMode <> AMode then
  1499. begin
  1500. FMode := AMode;
  1501. end;
  1502. if Assigned(FOnChannelUpdate) then
  1503. begin
  1504. FOnChannelUpdate(Self, cuMode, nil, 0);
  1505. end;
  1506. end;
  1507. { Call to change the channel limit without sending a mode command. }
  1508. procedure TIdIRCChannel.LimitChanged(ALimit: Integer);
  1509. begin
  1510. if FLimit <> ALimit then
  1511. begin
  1512. FLimit := ALimit;
  1513. end;
  1514. if Assigned(FOnChannelUpdate) then
  1515. begin
  1516. FOnChannelUpdate(Self, cuMode, nil, 0);
  1517. end;
  1518. end;
  1519. { Call to change the channel key without sending a mode command. }
  1520. procedure TIdIRCChannel.KeyChanged(AKey: String);
  1521. begin
  1522. if FKey <> AKey then
  1523. begin
  1524. FKey := AKey;
  1525. end;
  1526. if Assigned(FOnChannelUpdate) then
  1527. begin
  1528. FOnChannelUpdate(Self, cuMode, nil, 0);
  1529. end;
  1530. end;
  1531. { Return a string representation of the channel mode. }
  1532. function TIdIRCChannel.GetModeString: String;
  1533. var
  1534. Element: TIdIRCChannelMode;
  1535. begin
  1536. { Only bother if there are actually modes to show. }
  1537. if FMode <> [] then
  1538. begin
  1539. Result := '+'; {Do not Localize}
  1540. { Add all mode characters. }
  1541. for Element := cmPrivate to cmKey do
  1542. begin
  1543. if Element in FMode then
  1544. begin
  1545. Result := Result + ChannelModeChars[Ord(Element)];
  1546. end;
  1547. end;
  1548. { Add limit if present. }
  1549. if cmUserLimit in FMode then
  1550. begin
  1551. Result := Format('%s %d', [Result, FLimit]); {Do not Localize}
  1552. end;
  1553. { Add key if present. }
  1554. if cmKey in FMode then
  1555. begin
  1556. Result := Format('%s %s', [Result, FKey]); {Do not Localize}
  1557. end
  1558. end
  1559. else
  1560. begin
  1561. Result := ''; {Do not Localize}
  1562. end;
  1563. end;
  1564. { Add a new user to the channel. }
  1565. function TIdIRCChannel.AddUser(ANick, AAddress: String): TIdIRCUser;
  1566. var
  1567. IsOp, HasVoice: Boolean;
  1568. Attributes, Index: Integer;
  1569. begin
  1570. { Op and Voice status are declared by @ and + symbols. If a person has voice
  1571. only, then the + is placed before the nick. If the person has ops, then the
  1572. @ symbol is placed before the nick. If the person has ops and voice (rather
  1573. pointless, but can happen) then the @ goes in front and the + goes at the
  1574. end. }
  1575. IsOp := (Length(ANick)>0) and (ANick[1] = '@'); {Do not Localize}
  1576. Attributes := 0;
  1577. if IsOp then
  1578. begin
  1579. Attributes := Attributes + 1;
  1580. ANick := Copy(ANick, 2, Length(ANick) - 1);
  1581. HasVoice := (Length(ANick)>0) and (ANick[Length(ANick)] = '+'); {Do not Localize}
  1582. if HasVoice then
  1583. begin
  1584. Attributes := Attributes + 2;
  1585. ANick := Copy(ANick, 1, Length(ANick) - 1);
  1586. end;
  1587. end
  1588. else
  1589. begin
  1590. HasVoice := (Length(ANick)>0) and (ANick[1] = '+'); {Do not Localize}
  1591. if HasVoice then
  1592. begin
  1593. Attributes := Attributes + 2;
  1594. ANick := Copy(ANick, 2, Length(ANick) - 1);
  1595. end;
  1596. end;
  1597. Result := nil;
  1598. { If the nick already exists, don't add. } {Do not Localize}
  1599. if not Find(ANick, Index) then
  1600. begin
  1601. { Add this user to the list. }
  1602. Result := FClient.Users.Add(ANick, AAddress);
  1603. FNames.AddObject(ANick, Pointer(Attributes));
  1604. end;
  1605. end;
  1606. { Remove a user from the channel. }
  1607. procedure TIdIRCChannel.RemoveUser(AUser: TIdIRCUser);
  1608. var
  1609. Index: Integer;
  1610. begin
  1611. if Find(AUser.Nick, Index) then
  1612. begin
  1613. FNames.Delete(Index);
  1614. { Release the user object. }
  1615. FClient.Users.Remove(AUser);
  1616. end;
  1617. end;
  1618. { Returns True if the user is in the channel. }
  1619. function TIdIRCChannel.HasUser(ANick: String): Boolean;
  1620. var
  1621. Index: Integer;
  1622. begin
  1623. Result := Find(ANick, Index);
  1624. end;
  1625. { Search for a nick in the channel. }
  1626. function TIdIRCChannel.Find(ANick: String; var AIndex: Integer): Boolean;
  1627. begin
  1628. { Need a case-insensitive search. So it has to be done manually, I guess. }
  1629. Result := False;
  1630. AIndex := 0;
  1631. while AIndex < FNames.Count do
  1632. begin
  1633. Result := AnsiCompareText(ANick, FNames[AIndex]) = 0;
  1634. if Result then
  1635. begin
  1636. Exit;
  1637. end;
  1638. Inc(AIndex);
  1639. end;
  1640. { Search failed, so Index is set to -1. }
  1641. AIndex := -1;
  1642. end;
  1643. { User got op status. }
  1644. procedure TIdIRCChannel.GotOp(AUser: TIdIRCUser);
  1645. var
  1646. Index, Attr: Integer;
  1647. begin
  1648. { No user object, so fail. }
  1649. if AUser = nil then
  1650. begin
  1651. Exit;
  1652. end;
  1653. { Check if the user is in this channel. }
  1654. if Find(AUser.Nick, Index) then
  1655. begin
  1656. { Add the op flag. }
  1657. Attr := Integer(FNames.Objects[Index]) or 1;
  1658. FNames.Objects[Index] := Pointer(Attr);
  1659. { Tell the world we changed this user's status. } {Do not Localize}
  1660. if Assigned(FOnChannelUpdate) then
  1661. begin
  1662. FOnChannelUpdate(Self, cuUser, AUser, Attr);
  1663. end;
  1664. end;
  1665. end;
  1666. { User lost op status. }
  1667. procedure TIdIRCChannel.GotDeop(AUser: TIdIRCUser);
  1668. var
  1669. Index, Attr: Integer;
  1670. begin
  1671. { No user object, so fail. }
  1672. if AUser = nil then
  1673. begin
  1674. Exit;
  1675. end;
  1676. { Check Aif the user is in this channel. }
  1677. if Find(AUser.Nick, Index) then
  1678. begin
  1679. { Remove the op flag. }
  1680. Attr := Integer(FNames.Objects[Index]) and (not 1);
  1681. FNames.Objects[Index] := Pointer(Attr);
  1682. { Tell the world we changed this user's status. } {Do not Localize}
  1683. if Assigned(FOnChannelUpdate) then
  1684. begin
  1685. FOnChannelUpdate(Self, cuUser, AUser, Attr);
  1686. end;
  1687. end;
  1688. end;
  1689. { User got voice status. }
  1690. procedure TIdIRCChannel.GotVoice(AUser: TIdIRCUser);
  1691. var
  1692. Index, Attr: Integer;
  1693. begin
  1694. { No user object, so fail. }
  1695. if AUser = nil then
  1696. begin
  1697. Exit;
  1698. end;
  1699. { Check if the user is in this channel. }
  1700. if Find(AUser.Nick, Index) then
  1701. begin
  1702. { Add the voice flag. }
  1703. Attr := Integer(FNames.Objects[Index]) or 2;
  1704. FNames.Objects[Index] := Pointer(Attr);
  1705. { Tell the world we changed this user's status. } {Do not Localize}
  1706. if Assigned(FOnChannelUpdate) then
  1707. begin
  1708. FOnChannelUpdate(Self, cuUser, AUser, Attr);
  1709. end;
  1710. end;
  1711. end;
  1712. { User lost voice status. }
  1713. procedure TIdIRCChannel.GotDevoice(AUser: TIdIRCUser);
  1714. var
  1715. Index, Attr: Integer;
  1716. begin
  1717. { No user object, so fail. }
  1718. if AUser = nil then
  1719. begin
  1720. Exit;
  1721. end;
  1722. { Check if the user is in this channel. }
  1723. if Find(AUser.Nick, Index) then
  1724. begin
  1725. { Remove the voice flag. }
  1726. Attr := Integer(FNames.Objects[Index]) and (not 2);
  1727. FNames.Objects[Index] := Pointer(Attr);
  1728. { Tell the world we changed this user's status. } {Do not Localize}
  1729. if Assigned(FOnChannelUpdate) then
  1730. begin
  1731. FOnChannelUpdate(Self, cuUser, AUser, Attr);
  1732. end;
  1733. end;
  1734. end;
  1735. { User changed nick. }
  1736. procedure TIdIRCChannel.ChangedNick(AUser: TIdIRCUser; ANewNick: String);
  1737. var
  1738. Index: Integer;
  1739. begin
  1740. { No user object, so fail. }
  1741. if AUser = nil then
  1742. begin
  1743. Exit;
  1744. end;
  1745. { Check if the user is in this channel. }
  1746. if Find(AUser.Nick, Index) then
  1747. begin
  1748. FNames[Index] := ANewNick;
  1749. { Tell the world this user changed nick. }
  1750. if Assigned(FOnChannelUpdate) then
  1751. begin
  1752. FOnChannelUpdate(Self, cuNick, AUser, Index);
  1753. end;
  1754. end;
  1755. end;
  1756. { User joined. }
  1757. procedure TIdIRCChannel.Joined(AUser: TIdIRCUser);
  1758. var
  1759. Index: Integer;
  1760. begin
  1761. { No user object, so fail. }
  1762. if AUser = nil then
  1763. begin
  1764. Exit;
  1765. end;
  1766. { Check if the user is in this channel. }
  1767. if Find(AUser.Nick, Index) then
  1768. begin
  1769. Exit;
  1770. end;
  1771. { Add to the names list. }
  1772. Index := FNames.AddObject(AUser.Nick, Pointer(0));
  1773. { Tell the world this user joined. }
  1774. if Assigned(FOnChannelUpdate) then
  1775. begin
  1776. FOnChannelUpdate(Self, cuJoin, AUser, Index);
  1777. end;
  1778. end;
  1779. { User parted. }
  1780. procedure TIdIRCChannel.Parted(AUser: TIdIRCUser);
  1781. var
  1782. Index: Integer;
  1783. begin
  1784. { No user object, so fail. }
  1785. if AUser = nil then
  1786. begin
  1787. Exit;
  1788. end;
  1789. { Check if the user is in this channel. }
  1790. if Find(AUser.Nick, Index) then
  1791. begin
  1792. { Tell the world this user quit. }
  1793. if Assigned(FOnChannelUpdate) then
  1794. begin
  1795. FOnChannelUpdate(Self, cuPart, AUser, Index);
  1796. end;
  1797. { Remove from the names list. }
  1798. FNames.Delete(Index);
  1799. end;
  1800. end;
  1801. { User was kicked. }
  1802. procedure TIdIRCChannel.Kicked(AUser: TIdIRCUser);
  1803. var
  1804. Index: Integer;
  1805. begin
  1806. { No user object, so fail. }
  1807. if AUser = nil then
  1808. begin
  1809. Exit;
  1810. end;
  1811. { Check if the user is in this channel. }
  1812. if Find(AUser.Nick, Index) then
  1813. begin
  1814. { Tell the world this user was kicked. }
  1815. if Assigned(FOnChannelUpdate) then
  1816. begin
  1817. FOnChannelUpdate(Self, cuKick, AUser, Index);
  1818. end;
  1819. { Remove from the names list. }
  1820. FNames.Delete(Index);
  1821. end;
  1822. end;
  1823. { User quit. }
  1824. procedure TIdIRCChannel.Quit(AUser: TIdIRCUser);
  1825. var
  1826. Index: Integer;
  1827. begin
  1828. { No user object, so fail. }
  1829. if AUser = nil then
  1830. begin
  1831. Exit;
  1832. end;
  1833. { Check if the user is in this channel. }
  1834. if Find(AUser.Nick, Index) then
  1835. begin
  1836. { Tell the world this user quit. }
  1837. if Assigned(FOnChannelUpdate) then
  1838. begin
  1839. FOnChannelUpdate(Self, cuQuit, AUser, Index);
  1840. end;
  1841. { Remove from the names list. }
  1842. FNames.Delete(Index);
  1843. end;
  1844. end;
  1845. { //////////////////////////////////////////////////////////////////////////// }
  1846. { TIdIRCChannels }
  1847. { //////////////////////////////////////////////////////////////////////////// }
  1848. { Create the list of channels. }
  1849. constructor TIdIRCChannels.Create(AClient: TIdIRC);
  1850. begin
  1851. inherited Create(TIdIRCChannel);
  1852. FClient := AClient;
  1853. end;
  1854. { Delete the list of channels. }
  1855. destructor TIdIRCChannels.Destroy;
  1856. begin
  1857. inherited Destroy;
  1858. end;
  1859. { Add a new channel. If channel of this name exists, delete the previous
  1860. channel object and create a new object. Returns the channel object. }
  1861. function TIdIRCChannels.Add(AName: String): TIdIRCChannel;
  1862. var
  1863. Index: Integer;
  1864. begin
  1865. { Object of this name already exists, so delete it. }
  1866. if Find(AName, Index) then
  1867. begin
  1868. Items[Index].Free;
  1869. end;
  1870. { Create new channel object and add it. }
  1871. Result := TIdIRCChannel.Create(FClient, AName);
  1872. end;
  1873. { Remove a channel. }
  1874. procedure TIdIRCChannels.Remove(AName: String);
  1875. var
  1876. Index: Integer;
  1877. begin
  1878. if Find(AName, Index) then
  1879. begin
  1880. Items[Index].Free;
  1881. end;
  1882. end;
  1883. { Search for a specific channel name, and return the index if found. }
  1884. function TIdIRCChannels.Find(AName: String; var AIndex: Integer): Boolean;
  1885. begin
  1886. { Need a case-insensitive search. So it has to be done manually, I guess. }
  1887. Result := False;
  1888. AIndex := 0;
  1889. while AIndex < Count do
  1890. begin
  1891. Result := AnsiCompareText(AName, Items[AIndex].Name) = 0;
  1892. if Result then
  1893. begin
  1894. Exit;
  1895. end;
  1896. Inc(AIndex);
  1897. end;
  1898. { Search failed, so Index is set to -1. }
  1899. AIndex := -1;
  1900. end;
  1901. { Return the channel object for the name given. If the channel name is not
  1902. found, then it returns nil. }
  1903. function TIdIRCChannels.Get(AName: String): TIdIRCChannel;
  1904. var
  1905. Index: Integer;
  1906. begin
  1907. Result := nil;
  1908. if Find(AName, Index) then
  1909. begin
  1910. Result := GetItem(Index);
  1911. end;
  1912. end;
  1913. {inherited SetItem for our items property}
  1914. procedure TIdIRCChannels.SetItem ( Index: Integer; const Value: TIdIRCChannel );
  1915. begin
  1916. inherited SetItem (Index, Value);
  1917. end;
  1918. {inherited GetItem for our items property}
  1919. function TIdIRCChannels.GetItem(Index: Integer): TIdIRCChannel;
  1920. begin
  1921. Result := TIdIRCChannel( inherited GetItem(Index));
  1922. end;
  1923. { A user changed nick, so go through all channels and notify of the change. }
  1924. procedure TIdIRCChannels.ChangedNick(AUser: TIdIRCUser; ANewNick: String);
  1925. var
  1926. Index: Integer;
  1927. begin
  1928. for Index := 0 to Count - 1 do
  1929. begin
  1930. GetItem(Index).ChangedNick(AUser, ANewNick);
  1931. end;
  1932. end;
  1933. { A user quit, so go through all channels and notify of the quit. }
  1934. procedure TIdIRCChannels.Quit(AUser: TIdIRCUser);
  1935. var
  1936. Index: Integer;
  1937. begin
  1938. for Index := 0 to Count - 1 do
  1939. begin
  1940. GetItem(Index).Quit(AUser);
  1941. end;
  1942. end;
  1943. { //////////////////////////////////////////////////////////////////////////// }
  1944. { TIdIRCReplies }
  1945. { //////////////////////////////////////////////////////////////////////////// }
  1946. constructor TIdIRCReplies.Create;
  1947. begin
  1948. inherited Create;
  1949. FFinger := ''; {Do not Localize}
  1950. FVersion := ''; {Do not Localize}
  1951. FUserInfo := ''; {Do not Localize}
  1952. FClientInfo := ''; {Do not Localize}
  1953. end;
  1954. procedure TIdIRCReplies.Assign(Source: TPersistent);
  1955. begin
  1956. if Source is TIdIRCReplies then
  1957. begin
  1958. FFinger := TIdIRCReplies(Source).Finger;
  1959. FVersion := TIdIRCReplies(Source).Version;
  1960. FUserInfo := TIdIRCReplies(Source).UserInfo;
  1961. FClientInfo := TIdIRCReplies(Source).ClientInfo;
  1962. end;
  1963. end;
  1964. { //////////////////////////////////////////////////////////////////////////// }
  1965. { TIdIRC }
  1966. { //////////////////////////////////////////////////////////////////////////// }
  1967. constructor TIdIRC.Create(AOwner: TComponent);
  1968. var
  1969. Index: Integer;
  1970. begin
  1971. inherited Create(AOwner);
  1972. FList := TStringList.Create;
  1973. FNotify := TStringList.Create;
  1974. FReplies := TIdIRCReplies.Create;
  1975. with FReplies do
  1976. begin
  1977. Finger := ''; {Do not Localize}
  1978. Version := RSIRCClientVersion;
  1979. UserInfo := ''; {Do not Localize}
  1980. ClientInfo := Format(RSIRCClientInfo,[RSIRCClientVersion]);
  1981. end;
  1982. FNick := RSIRCNick; {Do not Localize}
  1983. FAltNick := RSIRCAltNick; {Do not Localize}
  1984. FUserName := RSIRCUserName; {Do not Localize}
  1985. FRealName := RSIRCRealName; {Do not Localize}
  1986. FServer := ''; {Do not Localize}
  1987. Port := IdPORT_IRC;
  1988. FUserMode := [];
  1989. FState := csDisconnected;
  1990. FCurrentNick := ''; {Do not Localize}
  1991. FData := nil;
  1992. { The following objects only needed during run-time. }
  1993. if not (csDesigning in ComponentState) then
  1994. begin
  1995. Token := TStringList.Create;
  1996. FChannels := TIdIRCChannels.Create(Self);
  1997. FUsers := TIdIRCUsers.Create(Self);
  1998. { Create a list of up to MinTokenCount tokens with a null string. }
  1999. for Index := 0 to IdIrcMinTokenCount - 1 do
  2000. begin
  2001. Token.Add(''); {Do not Localize}
  2002. end;
  2003. end;
  2004. end;
  2005. destructor TIdIRC.Destroy;
  2006. begin
  2007. { Free all allocated objects. }
  2008. if not (csDesigning in ComponentState) then
  2009. begin
  2010. { If still connected, the leave gracefully. }
  2011. if Connected then
  2012. begin
  2013. Disconnect(True);
  2014. end;
  2015. Token.Free;
  2016. FChannels.Free;
  2017. FUsers.Free;
  2018. end;
  2019. FList.Free;
  2020. FNotify.Free;
  2021. FReplies.Free;
  2022. inherited Destroy;
  2023. end;
  2024. procedure TIdIRC.Loaded;
  2025. begin
  2026. inherited Loaded;
  2027. end;
  2028. { Data has arrived at the socket. }
  2029. procedure TIdIRC.SocketDataAvailable;
  2030. begin
  2031. { Get all the data that we received and add it to the end of the current
  2032. buffer. }
  2033. if fState = csDisconnected then
  2034. begin
  2035. exit;
  2036. end;
  2037. FBuffer := IRCThread.FRecvData;
  2038. FullCommand := FBuffer;
  2039. if Length(FBuffer) > 0 then begin
  2040. { Pass to the raw receive event handler. }
  2041. if Assigned(FOnReceive) then begin
  2042. FOnReceive(Self, FBuffer);
  2043. end;
  2044. { Process the received command. }
  2045. ParseCommand;
  2046. end;
  2047. end;
  2048. { Connect to the IRC server. }
  2049. procedure TIdIRC.Connect;
  2050. var LOurAddr : String;
  2051. LServerAddr : String;
  2052. begin
  2053. { If already connected or in the process of connecting, the force a
  2054. disconnect. }
  2055. if Connected then
  2056. begin
  2057. Disconnect(TRUE);
  2058. end;
  2059. { Clear the channel and user lists. }
  2060. FChannels.Clear;
  2061. FUsers.Clear;
  2062. { Get a user object for ourselves. }
  2063. FUser := FUsers.Add(FNick, ''); {Do not Localize}
  2064. { Set the current nick. }
  2065. FCurrentNick := FNick;
  2066. { Set the current state. }
  2067. SeTIdIRCState(csConnecting);
  2068. { Set the properties of the socket and start the connection process. }
  2069. inherited Connect;
  2070. SeTIdIRCState(csLoggingOn);
  2071. try
  2072. if Assigned(FOnConnect) then begin
  2073. OnConnect(SELF);
  2074. end;
  2075. if Connected then begin
  2076. FIRCThread := TIdIRCReadThread.Create(SELF);
  2077. end;
  2078. //we let the user override the IP address if they need to use the BoundIP
  2079. //property (that may be needed for some multihorned computers on more than
  2080. //one network.
  2081. if (Length(BoundIP)>0) then
  2082. begin
  2083. LOurAddr := BoundIP;
  2084. end
  2085. else
  2086. begin
  2087. LOurAddr := GStack.LocalAddress;
  2088. end;
  2089. //we want to let the user override the Server parameter with their own if they
  2090. //want. Otherwise, just use our local address.
  2091. if (Length(FServer)>0) then
  2092. begin
  2093. LServerAddr := FServer;
  2094. end
  2095. else
  2096. begin
  2097. LServerAddr := LOurAddr;
  2098. end;
  2099. { If there is a password supplied, then send it first. }
  2100. if FPassword <> '' then {Do not Localize}
  2101. begin
  2102. Raw(Format('PASS %s', [FPassword])); {Do not Localize}
  2103. end;
  2104. { Send the nick and user information. }
  2105. Raw(Format('NICK %s', [FNick])); {Do not Localize}
  2106. Raw(Format('USER %s %s %s :%s', [FUsername, LOurAddr, LServerAddr, FRealName])); {Do not Localize}
  2107. // SeTIdIRCState(csConnected);
  2108. except
  2109. on E: EIdSocketError do
  2110. raise EComponentError.Create(RSIRCCanNotConnect);
  2111. end;
  2112. end;
  2113. { Force a disconnect from the IRC server. }
  2114. procedure TIdIRC.Disconnect(AForce: Boolean);
  2115. begin
  2116. { Close the connection. }
  2117. if (FState <> csConnected) and (AForce<>TRUE) then
  2118. begin
  2119. exit;
  2120. end;
  2121. { Release our user object. }
  2122. FUsers.Remove(FUser);
  2123. SeTIdIRCState(csDisconnect);
  2124. if Assigned(FOnDisconnect) then
  2125. begin
  2126. FOnDisconnect(self);
  2127. end;
  2128. if Assigned(IRCThread) then begin
  2129. // TODO: FreeOnTerminate:=FALSE; .Terminate; FreeAndNIL()
  2130. IRCThread.Terminate;
  2131. end;
  2132. inherited Disconnect;
  2133. SeTIdIRCState(csDisconnected);
  2134. if Assigned(FOnDisconnected) then
  2135. begin
  2136. FOnDisconnected(Self);
  2137. end;
  2138. end;
  2139. { Send a command to the server. }
  2140. procedure TIdIRC.Raw(ALine: String);
  2141. begin
  2142. { Send the string directly to the server without processing. Line is
  2143. terminated by CR-LF pair. }
  2144. if Connected then
  2145. begin
  2146. WriteLn(Aline+#13#10);
  2147. if Assigned(FOnSend) then
  2148. begin
  2149. FOnSend(Self, ALine);
  2150. end;
  2151. end
  2152. else
  2153. begin
  2154. if Assigned(FOnError) then
  2155. begin
  2156. FOnError(Self, nil, '', RSIRCNotConnected); {Do not Localize}
  2157. end;
  2158. end;
  2159. end;
  2160. { Send a message to the specified target (channel or user). }
  2161. procedure TIdIRC.Say(ATarget, AMsg: String);
  2162. begin
  2163. Raw(Format('PRIVMSG %s :%s', [ATarget, AMsg])); {Do not Localize}
  2164. end;
  2165. { Send a notice to the specified target (channel or user). }
  2166. procedure TIdIRC.Notice(ATarget, AMsg: String);
  2167. begin
  2168. Raw(Format('NOTICE %s :%s', [ATarget, AMsg])); {Do not Localize}
  2169. end;
  2170. { Send an action (just a wrapper for a CTCP query). }
  2171. procedure TIdIRC.Action(ATarget, AMsg: String);
  2172. begin
  2173. CTCPQuery(ATarget, 'ACTION', AMsg); {Do not Localize}
  2174. end;
  2175. { Send a CTCP request to the specifed target (channel or user). }
  2176. procedure TIdIRC.CTCPQuery(ATarget, ACommand, AParameters: String);
  2177. begin
  2178. Say(ATarget, Format(#1'%s %s'#1, [Uppercase(ACommand), AParameters])); {Do not Localize}
  2179. end;
  2180. { Send a CTCP reply to the specified target (primarily a user, but could be a
  2181. channel). }
  2182. procedure TIdIRC.CTCPReply(ATarget, ACTCP, AReply: String);
  2183. begin
  2184. Notice(ATarget, Format(#1'%s %s'#1, [ACTCP, AReply])); {Do not Localize}
  2185. end;
  2186. { Join the channels, using the keys supplied. Channels and Keys are comma-
  2187. separated lists of channel names and keys for those channels that require
  2188. a key. }
  2189. procedure TIdIRC.Join(AChannels : String; const AKeys: String = ''); {Do not Localize}
  2190. begin
  2191. if Length(AKeys) <> 0 then
  2192. begin
  2193. Raw(Format('JOIN %s %s', [AChannels, AKeys])) {Do not Localize}
  2194. end
  2195. else
  2196. begin
  2197. Raw(Format('JOIN %s', [AChannels])); {Do not Localize}
  2198. end;
  2199. end;
  2200. { Part the channels, using the given reason (if the server supports part
  2201. messages). Channels is a comma-separated list of channel names to part. }
  2202. procedure TIdIRC.Part(AChannels : String; const AReason: String = ''); {Do not Localize}
  2203. begin
  2204. if Length(AReason) <> 0 then
  2205. begin
  2206. Raw(Format('PART %s :%s', [AChannels, AReason])) {Do not Localize}
  2207. end
  2208. else
  2209. begin
  2210. Raw(Format('PART %s', [AChannels])); {Do not Localize}
  2211. end;
  2212. end;
  2213. { Kick a person from a channel. }
  2214. procedure TIdIRC.Kick(AChannel, ANick, AReason: String);
  2215. begin
  2216. Raw(Format('KICK %s %s :%s', [AChannel, ANick, AReason])); {Do not Localize}
  2217. end;
  2218. { Quit IRC. }
  2219. procedure TIdIRC.Quit(AReason: String);
  2220. begin
  2221. Raw(Format('QUIT :%s', [AReason])); {Do not Localize}
  2222. end;
  2223. { Set the mode of a channel. }
  2224. procedure TIdIRC.Mode(AChannel, AModes : String; const AParams: String = ''); {Do not Localize}
  2225. begin
  2226. if AParams = '' then {Do not Localize}
  2227. begin
  2228. Raw(Format('MODE %s %s', [AChannel, AModes])) {Do not Localize}
  2229. end
  2230. else
  2231. begin
  2232. Raw(Format('MODE %s %s %s', [AChannel, AModes, AParams])); {Do not Localize}
  2233. end;
  2234. end;
  2235. { Return True if connected, or in the process of connecting. }
  2236. {
  2237. function TIdIRC.GetConnected: Boolean;
  2238. begin
  2239. Result := FState <> csDisconnected;
  2240. end;
  2241. }
  2242. { Send the TOPIC command to retrieve the current topic and nick of the person
  2243. who set the topic for the specified channel. }
  2244. procedure TIdIRC.GetTopic(AChannel: String);
  2245. begin
  2246. Raw(Format('TOPIC %s', [AChannel])); {Do not Localize}
  2247. end;
  2248. { Set the topic of the specified channel to the string Topic. }
  2249. procedure TIdIRC.SetTopic(AChannel, ATopic: String);
  2250. begin
  2251. Raw(Format('TOPIC %s :%s', [AChannel, ATopic])); {Do not Localize}
  2252. end;
  2253. { Set an away message. }
  2254. procedure TIdIRC.SetAwayMessage(AMsg: String);
  2255. begin
  2256. Raw(Format('AWAY %s', [AMsg])); {Do not Localize}
  2257. end;
  2258. { Clear the away message. }
  2259. procedure TIdIRC.ClearAwayMessage;
  2260. begin
  2261. Raw('AWAY'); {Do not Localize}
  2262. end;
  2263. { Return the Nick property. }
  2264. function TIdIRC.GetNick: String;
  2265. begin
  2266. if Connected then
  2267. begin
  2268. Result := FCurrentNick
  2269. end
  2270. else
  2271. begin
  2272. Result := FNick;
  2273. end;
  2274. end;
  2275. { Return the local host name. }
  2276. {
  2277. function TIdIRC.GetLocalHost: String;
  2278. begin
  2279. Result := LocalHost;
  2280. end;
  2281. }
  2282. { Return the local IP address. }
  2283. {
  2284. function TIdIRC.GetLocalIPAddr: String;
  2285. begin
  2286. Result := FSocket.BoundIP;
  2287. end;
  2288. }
  2289. { Change the user's nick. } {Do not Localize}
  2290. procedure TIdIRC.SetNick(AValue: String);
  2291. begin
  2292. { Only allow direct change if not connected... }
  2293. if not Connected then
  2294. begin
  2295. if FNick <> AValue then
  2296. begin
  2297. FNick := AValue;
  2298. end;
  2299. end
  2300. else
  2301. begin
  2302. { else send a NICK command and only change the nick if the command is
  2303. successful }
  2304. Raw(Format('NICK %s', [AValue])); {Do not Localize}
  2305. end;
  2306. end;
  2307. { Change the user's alternative nick. } {Do not Localize}
  2308. procedure TIdIRC.SetAltNick(AValue: String);
  2309. begin
  2310. if FAltNick <> AValue then
  2311. begin
  2312. FAltNick := AValue;
  2313. end;
  2314. end;
  2315. { Change the user's username. } {Do not Localize}
  2316. procedure TIdIRC.SeTIdIRCUsername(AValue: String);
  2317. begin
  2318. if FUsername <> AValue then
  2319. begin
  2320. FUsername := AValue;
  2321. end;
  2322. end;
  2323. { Change the user's real name. } {Do not Localize}
  2324. procedure TIdIRC.SetRealName(AValue: String);
  2325. begin
  2326. if FRealName <> AValue then
  2327. begin
  2328. FRealName := AValue;
  2329. end;
  2330. end;
  2331. { Change the password for the server . }
  2332. procedure TIdIRC.SetPassword(AValue: String);
  2333. begin
  2334. if FPassword <> AValue then
  2335. begin
  2336. FPassword := AValue;
  2337. end;
  2338. end;
  2339. { Change the user's mode. } {Do not Localize}
  2340. procedure TIdIRC.SeTIdIRCUserMode(AValue: TIdIRCUserModes);
  2341. begin
  2342. { Only allow direct change if not connected... }
  2343. if not Connected then
  2344. begin
  2345. if FUserMode <> AValue then
  2346. begin
  2347. FUserMode := AValue;
  2348. end;
  2349. end
  2350. else
  2351. { else send a mode change command and only change the user mode if the
  2352. command is successful }
  2353. begin
  2354. { Only modify the values that have actually changed }
  2355. { FIXME: Needs to be completed. }
  2356. end;
  2357. end;
  2358. { Set the CTCP replies. }
  2359. procedure TIdIRC.SeTIdIRCReplies(AValue: TIdIRCReplies);
  2360. begin
  2361. { Copy the given TIdIRCReplies object to the internal object. }
  2362. FReplies.Assign(AValue);
  2363. end;
  2364. { Change the current state. }
  2365. procedure TIdIRC.SeTIdIRCState(AState: TIdIRCState);
  2366. begin
  2367. if AState <> FState then
  2368. begin
  2369. FState := AState;
  2370. if Assigned(FOnStateChange) then
  2371. begin
  2372. FOnStateChange(Self);
  2373. end;
  2374. end;
  2375. end;
  2376. { Split into SenderNick, SenderAddress, Command, Content and separate Tokens. }
  2377. procedure TIdIRC.TokenizeCommand;
  2378. var
  2379. Index: Integer;
  2380. Count: Integer;
  2381. begin
  2382. { Set the values to null strings. }
  2383. SenderNick := ''; {Do not Localize}
  2384. SenderAddress := ''; {Do not Localize}
  2385. Command := ''; {Do not Localize}
  2386. Content := ''; {Do not Localize}
  2387. { Extract the sender of the message first if it is present. }
  2388. if (Length(FullCommand)>0) and (FullCommand[1] = ':') then {Do not Localize}
  2389. begin
  2390. Index := Pos(' ', FullCommand); {Do not Localize}
  2391. SenderAddress := Copy(FullCommand, 2, Index - 2);
  2392. FullCommand := Copy(FullCommand, Index + 1, 512);
  2393. { Copy the full address to the first token. }
  2394. Token[0] := SenderAddress;
  2395. { See if the address contains a nick as well. }
  2396. Index := Pos('!', SenderAddress); {Do not Localize}
  2397. if Index > 0 then
  2398. begin
  2399. { Extract the nick from the address. }
  2400. SenderNick := Copy(SenderAddress, 1, Index - 1);
  2401. SenderAddress := Copy(SenderAddress, Index + 1, 512);
  2402. end;
  2403. end
  2404. else
  2405. begin
  2406. { Make the first token a null string. }
  2407. Token[0] := ''; {Do not Localize}
  2408. end;
  2409. { Extract the command. }
  2410. Index := Pos(' ', FullCommand); {Do not Localize}
  2411. Command := Copy(FullCommand, 1, Index - 1);
  2412. FullCommand := Copy(FullCommand, Index + 1, 512);
  2413. { Copy the Command to the second token. }
  2414. Token[1] := Command;
  2415. { Extract the rest of the arguments into Content and Token. }
  2416. Content := FullCommand;
  2417. Count := 2;
  2418. while Length(FullCommand) > 0 do
  2419. begin
  2420. { If the argument is prefixed by a semi-colon, then the rest of the line is
  2421. treated as one argument. }
  2422. if (Length(FullCommand)>0) and (FullCommand[1] = ':') then {Do not Localize}
  2423. begin
  2424. Token[Count] := Copy(FullCommand, 2, Length(FullCommand) - 1);
  2425. FullCommand := ''; {Do not Localize}
  2426. end
  2427. else
  2428. begin
  2429. Index := Pos(' ', FullCommand); {Do not Localize}
  2430. if Index > 0 then
  2431. begin
  2432. { Copy the argument and remove it from the string. }
  2433. Token[Count] := Copy(FullCommand, 1, Index - 1);
  2434. { Remove that token and process the remaining string. }
  2435. FullCommand := Copy(FullCommand, Index + 1, 512);
  2436. end
  2437. else
  2438. begin
  2439. { Must be the last argument, so copy the entire remaining string. }
  2440. Token[Count] := Copy(FullCommand, 1, 512);
  2441. FullCommand := ''; {Do not Localize}
  2442. end;
  2443. end;
  2444. Inc(Count);
  2445. end;
  2446. { Fill any empty tokens with a null string. }
  2447. for Index := Count to IdIrcMinTokenCount - 1 do
  2448. begin
  2449. Token[Index] := ''; {Do not Localize}
  2450. end;
  2451. end;
  2452. { Attempt to match the given command with one of a list of commands. If a
  2453. match is found, then the index of that command is returned, else the return
  2454. value is -1. }
  2455. function TIdIRC.MatchCommand: Integer;
  2456. var
  2457. Index: Integer;
  2458. begin
  2459. Index := 0;
  2460. Result := -1;
  2461. while (Result < 0) and (Index <= High(Commands)) do
  2462. begin
  2463. if Command = Commands[Index] then
  2464. begin
  2465. Result := Index;
  2466. end;
  2467. Inc(Index);
  2468. end;
  2469. end;
  2470. { Parse the string and call any appropriate event handlers. }
  2471. procedure TIdIRC.ParseCommand;
  2472. var
  2473. CommandNumber: Integer;
  2474. Suppress: Boolean;
  2475. Index: Integer;
  2476. Channel: TIdIRCChannel;
  2477. User, Target: TIdIRCUser;
  2478. lcTemp : String;
  2479. begin
  2480. { Break up the command into its tokens. }
  2481. TokenizeCommand;
  2482. { Get a reference to a user object for the sender. }
  2483. User := FUsers.Add(SenderNick, SenderAddress);
  2484. { If an OnRaw event handler is assigned, then call it. }
  2485. if Assigned(FOnRaw) then
  2486. begin
  2487. Suppress := False;
  2488. FOnRaw(Self, User, Command, Content, Suppress);
  2489. { If the user set Suppress to True, then stop processing for this string. }
  2490. if Suppress then
  2491. begin
  2492. { Fixed 28/11/99. If Suppress was set to True, the User object would not
  2493. have been released. }
  2494. FUsers.Remove(User);
  2495. Exit;
  2496. end;
  2497. end;
  2498. { Try to match a numeric command. If not a valid numeric command, then
  2499. returns -1. }
  2500. CommandNumber := StrToIntDef(Command, -1);
  2501. if CommandNumber > -1 then
  2502. begin
  2503. case CommandNumber of
  2504. 1, { 001 }
  2505. 2, { 002 }
  2506. 3, { 003 }
  2507. 4: { 004 }
  2508. begin
  2509. { Apparently these are the first messages sent back from
  2510. the server, so set the Server to the address of the
  2511. sender of these messages. This is the actual address
  2512. of the server we are on. }
  2513. FServer := SenderAddress;
  2514. { Set state to connected. May need this elsewhere too. }
  2515. SeTIdIRCState(csConnected);
  2516. if Assigned(FOnSystem) then
  2517. begin
  2518. FOnSystem(Self, User, CommandNumber,'WELCOME', Content); {Do not Localize}
  2519. end;
  2520. end;
  2521. 6, {NOT NAMED IN RFC2812 - /MAP LINE}
  2522. 7: {NOT NAMED IN RFC2812 - END of /MAP}
  2523. if Assigned(FOnSystem) then
  2524. begin
  2525. FOnSystem(Self, User, CommandNumber,'MAP', Format('%s', [Token[3]]));
  2526. end;
  2527. RPL_TRACELINK, { 200 }
  2528. RPL_TRACECONNECTING, { 201 }
  2529. RPL_TRACEHANDSHAKE, { 202 }
  2530. RPL_TRACEUNKNOWN, { 203 }
  2531. RPL_TRACEOPERATOR, { 204 }
  2532. RPL_TRACEUSER, { 205 }
  2533. RPL_TRACESERVER, { 206 }
  2534. RPL_TRACENEWTYPE: { 208 }
  2535. if Assigned(FOnSystem) then
  2536. begin
  2537. FOnSystem(Self, User, CommandNumber,'TRACE', Content); {Do not Localize}
  2538. end;
  2539. RPL_STATSLINKINFO, { 211 }
  2540. RPL_STATSCOMMANDS, { 212 }
  2541. RPL_STATSCLINE, { 213 }
  2542. RPL_STATSNLINE, { 214 }
  2543. RPL_STATSILINE, { 215 }
  2544. RPL_STATSKLINE, { 216 }
  2545. RPL_STATSYLINE: { 218 }
  2546. if Assigned(FOnSystem) then
  2547. begin
  2548. FOnSystem(Self, User, CommandNumber,'STATS', Content); {Do not Localize}
  2549. end;
  2550. RPL_ENDOFSTATS: { 219 }
  2551. if Assigned(FOnSystem) then
  2552. begin
  2553. FOnSystem(Self, User, CommandNumber,'STATS', Format('%s %s', [Token[3], Token[4]])); {Do not Localize}
  2554. end;
  2555. RPL_UMODEIS: { 221 }
  2556. if Assigned(FOnSystem) then
  2557. begin
  2558. FOnSystem(Self, User, CommandNumber,'UMODE', Format('%s %s', [Token[2], Token[3]])); {Do not Localize}
  2559. end;
  2560. RPL_STATSLLINE, { 241 }
  2561. RPL_STATSUPTIME, { 242 }
  2562. RPL_STATSOLINE, { 243 }
  2563. RPL_STATSHLINE: { 244 }
  2564. if Assigned(FOnSystem) then
  2565. begin
  2566. FOnSystem(Self, User, CommandNumber,'STATS', Content); {Do not Localize}
  2567. end;
  2568. 250, {NOT NAMED IN RFC2812 - Highest Connection Count}
  2569. RPL_LUSERCLIENT, { 251 }
  2570. RPL_LUSEROP, { 252 }
  2571. RPL_LUSERUNKNOWN, { 253 }
  2572. RPL_LUSERCHANNELS, { 254 }
  2573. RPL_LUSERME: { 255 }
  2574. if Assigned(FOnSystem) then
  2575. begin
  2576. FOnSystem(Self, User, CommandNumber,'LUSER', Format('%s %s',[Token[3], Token[4]])); {Do not Localize}
  2577. end;
  2578. RPL_ADMINME, { 256 }
  2579. RPL_ADMINLOC1, { 257 }
  2580. RPL_ADMINLOC2, { 258 }
  2581. RPL_ADMINEMAIL: { 259 }
  2582. if Assigned(FOnSystem) then
  2583. begin
  2584. FOnSystem(Self, User, CommandNumber,'ADMIN', Content); {Do not Localize}
  2585. end;
  2586. RPL_TRACELOG: { 261 }
  2587. if Assigned(FOnSystem) then
  2588. begin
  2589. FOnSystem(Self, User, CommandNumber,'TRACE', Content); {Do not Localize}
  2590. end;
  2591. 265, {NOT NAMED IN RFC2812 - Current Local Users}
  2592. 266: {NOT NAMED IN RFC2812 - Current Global Users}
  2593. if Assigned(FOnSystem) then
  2594. begin
  2595. FOnSystem(Self, User, CommandNumber,'LUSER', Token[3]); {Do not Localize}
  2596. end;
  2597. RPL_AWAY: { 301 }
  2598. begin
  2599. { Store the away reason in the user object. }
  2600. User.Reason := Token[4];
  2601. if Assigned(FOnAway) then
  2602. begin
  2603. FOnAway(Self, User);
  2604. end;
  2605. end;
  2606. RPL_USERHOST: { 302 }
  2607. if Assigned(FOnSystem) then
  2608. begin
  2609. FOnSystem(Self, User, CommandNumber,'USERHOST', Token[3]);
  2610. end;
  2611. RPL_ISON: { 303 }
  2612. { Check to see if this is a response to a notify request. }
  2613. { FIXME: Needs to be implemented. }
  2614. { Not a notify request response, so just output as received. }
  2615. if Assigned(FOnSystem) then
  2616. begin
  2617. FOnSystem(Self, User, CommandNumber,'ISON', Token[2]); {Do not Localize}
  2618. end;
  2619. RPL_UNAWAY: { 305 }
  2620. begin
  2621. FAway := False;
  2622. if Assigned(FOnUnAway) then
  2623. begin
  2624. FOnUnAway(Self, Token[3]);
  2625. end;
  2626. end;
  2627. RPL_NOWAWAY: { 306 }
  2628. begin
  2629. FAway := True;
  2630. if Assigned(FOnNowAway) then
  2631. begin
  2632. FOnNowAway(Self, Token[3]);
  2633. end;
  2634. end;
  2635. 307: { :server 307 yournick whoisnick :is a registered and identified nick }
  2636. if Assigned(FOnSystem) then
  2637. begin
  2638. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s %s', [Token[3], Token[4]])); {Do not Localize}
  2639. end;
  2640. RPL_WHOISUSER: { 311 }
  2641. if Assigned(FOnSystem) then
  2642. begin
  2643. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s is %s@%s %s %s', [Token[3], Token[4], Token[5], Token[6], Token[7]])); {Do not Localize}
  2644. end;
  2645. RPL_WHOISSERVER: { 312 }
  2646. if Assigned(FOnSystem) then
  2647. begin
  2648. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s is using %s %s', [Token[3], Token[4], Token[5]])); {Do not Localize}
  2649. end;
  2650. RPL_WHOISOPERATOR: { 313 }
  2651. if Assigned(FOnSystem) then
  2652. begin
  2653. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s %s', [Token[3], Token[4]])); {Do not Localize}
  2654. end;
  2655. RPL_WHOWASUSER: { 314 }
  2656. if Assigned(FOnSystem) then
  2657. begin
  2658. FOnSystem(Self, User, CommandNumber,'WHOWAS', Format('%s was %s@%s %s %s', [Token[3], Token[4], Token[5], Token[6], Token[7]])); {Do not Localize}
  2659. end;
  2660. RPL_ENDOFWHO: { 315 }
  2661. if Assigned(FOnSystem) then
  2662. begin
  2663. FOnSystem(Self, User, CommandNumber,'WHO', Format('%s :%s', [Token[3], Token[4]])); {Do not Localize}
  2664. end;
  2665. RPL_WHOISIDLE: { 317 }
  2666. if Assigned(FOnSystem) then
  2667. begin
  2668. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s has been idle %s seconds, signed on at %s', [Token[3], Token[4], Token[5]])); {Do not Localize}
  2669. end;
  2670. RPL_ENDOFWHOIS: { 318 }
  2671. if Assigned(FOnSystem) then
  2672. begin
  2673. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s :%s', [Token[3], Token[4]])); {Do not Localize}
  2674. end;
  2675. RPL_WHOISCHANNELS: { 319 }
  2676. if Assigned(FOnSystem) then
  2677. begin
  2678. FOnSystem(Self, User, CommandNumber,'WHOIS', Format('%s is on %s', [Token[3], Token[4]])); {Do not Localize}
  2679. end;
  2680. RPL_LISTSTART: { 321 }
  2681. begin
  2682. if Assigned(FOnList) then
  2683. begin
  2684. FList.Clear;
  2685. FListLast:= 0;
  2686. FOnList(Self, FList, 0, False);
  2687. end;
  2688. if Assigned(FOnSystem) then
  2689. begin
  2690. FOnSystem(Self, User, CommandNumber,'LIST', 'Start of LIST'); {Do not Localize}
  2691. end;
  2692. end;
  2693. RPL_LIST: { 322 }
  2694. if Assigned(FOnList) then
  2695. begin
  2696. FList.Add(Format('%s %s %s', [Token[3], Token[4], Token[5]]));
  2697. if (FList.Count - FListLast = 40) then //SOMEONE MAY WANT TO SET THIS NUMBER!
  2698. begin
  2699. FOnList(Self, FList, FListLast, False);
  2700. FListLast:= FList.Count - 1;
  2701. end;
  2702. end;
  2703. RPL_LISTEND: { 323 }
  2704. begin
  2705. if Assigned(FOnSystem) then
  2706. begin
  2707. FOnSystem(Self, User, CommandNumber,'LIST', Token[3]); {Do not Localize}
  2708. end;
  2709. if Assigned(FOnList) then
  2710. begin
  2711. FOnList(Self, FList, FListLast, True);
  2712. FList.Clear;
  2713. FListLast:= 0;
  2714. end;
  2715. end;
  2716. RPL_CHANNELMODEIS: { 324 }
  2717. { :sender 324 nick channel +mode [param[ param]] }
  2718. begin
  2719. { Can safely call this function, because there should be
  2720. no +/-b, +/-o or +/-v modes (therefore the events
  2721. OnBan, OnUnban, OnOp, OnDeop, OnVoice and OnDevoice
  2722. will not get called). }
  2723. lcTemp:= Token[4];
  2724. for Index:= 5 to Token.Count - 1 do
  2725. begin
  2726. if Token[Index] <> '' then
  2727. begin
  2728. lcTemp:= lcTemp + ' ' + Token[Index];
  2729. end;
  2730. end;
  2731. if Assigned(FOnChannelMode) then
  2732. begin
  2733. FOnChannelMode(Self, nil, FChannels.Get(Token[3]), Token[3], lcTemp);
  2734. end;
  2735. ParseChannelModeChange(3);
  2736. { FOnChannelMode(Sender, SenderNick, SenderAddress,
  2737. Channel) }
  2738. // if Assigned(FOnChannelMode) then
  2739. // FOnChannelMode(Self, SenderNick, SenderAddress, Token[3]);
  2740. end;
  2741. 329: { 329 }
  2742. { :sender 329 nick channel time }
  2743. begin
  2744. if Assigned(FOnSystem) then
  2745. FOnSystem(Self, User, CommandNumber, Command, Content);
  2746. end;
  2747. RPL_NOTOPIC: { 331 }
  2748. begin
  2749. { Set topic in channel object. }
  2750. Channel := FChannels.Get(Token[3]);
  2751. if Channel <> nil then
  2752. begin
  2753. Channel.TopicChanged(''); {Do not Localize}
  2754. { FOnNoTopic(Sender, Channel) }
  2755. if Assigned(FOnNoTopic) then
  2756. FOnNoTopic(Self, Channel, Token[4]);
  2757. end;
  2758. end;
  2759. RPL_TOPIC: { 332 }
  2760. begin
  2761. { Set topic in channel object. }
  2762. Channel := FChannels.Get(Token[3]);
  2763. if Channel <> nil then
  2764. begin
  2765. Channel.TopicChanged(Token[4]);
  2766. { FOnTopic(Sender, User, Channel) }
  2767. end;
  2768. if Assigned(FOnTopic) then
  2769. begin
  2770. FOnTopic(Self, User, Channel, Token[3],Token[4]);
  2771. end;
  2772. end;
  2773. RPL_INVITING: { 341 }
  2774. if Assigned(FOnInviting) then
  2775. begin
  2776. FOnInviting(Self, Token[3], Token[4]);
  2777. end;
  2778. RPL_SUMMONING: { 342 }
  2779. if Assigned(FOnSystem) then
  2780. begin
  2781. FOnSystem(Self, User, CommandNumber,'SUMMON', Format('%s has been summoned', [Token[2]])); {Do not Localize}
  2782. end;
  2783. RPL_VERSION: { 351 }
  2784. if Assigned(FOnSystem) then
  2785. begin
  2786. FOnSystem(Self, User, CommandNumber,'VERSION', Format('%s %s %s', [Token[3], Token[4], Token[5]])); {Do not Localize}
  2787. end;
  2788. RPL_WHOREPLY: { 352 }
  2789. if Assigned(FOnSystem) then
  2790. begin
  2791. FOnSystem(Self, User, CommandNumber,'WHO', Token[2]); {Do not Localize}
  2792. end;
  2793. RPL_NAMREPLY: { 353 }
  2794. { :sender 353 nick = channel :[name[ name...]] }
  2795. begin
  2796. if Assigned(FOnSystem) then
  2797. begin
  2798. FOnSystem(Self, User, CommandNumber,'NAMES', Format('%s :%s', [Token[4], Token[5]])); {Do not Localize}
  2799. end;
  2800. { Scan through names and add to channel. }
  2801. Channel := FChannels.Get(Token[4]);
  2802. if Channel <> nil then
  2803. begin
  2804. while Length(Token[5]) > 0 do
  2805. begin
  2806. Index := Pos(' ', Token[5]); {Do not Localize}
  2807. if Index > 0 then
  2808. begin
  2809. Channel.AddUser(Copy(Token[5], 1, Index - 1), ''); {Do not Localize}
  2810. Token[5] := Copy(Token[5], Index + 1, 512);
  2811. end
  2812. else
  2813. begin
  2814. Channel.AddUser(Token[5], ''); {Do not Localize}
  2815. Token[5] := ''; {Do not Localize}
  2816. end;
  2817. end;
  2818. { Inform of a change in the channel info. }
  2819. if Assigned(Channel.OnChannelUpdate) then
  2820. Channel.OnChannelUpdate(Channel, cuNames, nil, 0);
  2821. end;
  2822. end;
  2823. RPL_LINKS: { 364 }
  2824. if Assigned(FOnLinks) then
  2825. begin
  2826. lcTemp:= Token[5];
  2827. FOnLinks(Self, Token[4], Token[3], COPY(lcTemp, 1, POS(' ', lcTemp) - 1), COPY(lcTemp, POS(' ', lcTemp) + 1, Length(lcTemp)));
  2828. end;
  2829. RPL_ENDOFLINKS: { 365 }
  2830. if Assigned(FOnSystem) then
  2831. begin
  2832. FOnSystem(Self, User, CommandNumber,'LINKS', Format('%s %s', [Token[3], Token[4]])); {Do not Localize}
  2833. end;
  2834. RPL_ENDOFNAMES: { 366 }
  2835. begin
  2836. Channel := FChannels.Get(Token[3]);
  2837. if Assigned(FOnSystem) then
  2838. begin
  2839. FOnSystem(Self, User, CommandNumber,'NAMES', Format('%s :%s', [Token[3], Token[4]])); {Do not Localize}
  2840. end;
  2841. if Assigned(FOnNames) then
  2842. begin
  2843. FOnNames(Self,fUsers,Channel);
  2844. end;
  2845. end;
  2846. RPL_BANLIST: { 367 }
  2847. if Assigned(FOnSystem) then
  2848. begin
  2849. FOnSystem(Self, User, CommandNumber,'BANS', Format('%s %s', [Token[2], Token[3]])); {Do not Localize}
  2850. end;
  2851. RPL_ENDOFBANLIST: { 368 }
  2852. if Assigned(FOnSystem) then
  2853. begin
  2854. FOnSystem(Self, User, CommandNumber,'BANS', Format('%s :%s', [Token[2], Token[3]])); {Do not Localize}
  2855. end;
  2856. RPL_ENDOFWHOWAS: { 369 }
  2857. if Assigned(FOnSystem) then
  2858. begin
  2859. FOnSystem(Self, User, CommandNumber,'WHOWAS', Format('%s :%s', [Token[3], Token[4]])); {Do not Localize}
  2860. end;
  2861. RPL_INFO: { 371 }
  2862. if Assigned(FOnSystem) then
  2863. begin
  2864. FOnSystem(Self, User, CommandNumber,'INFO', Token[2]); {Do not Localize}
  2865. end;
  2866. RPL_MOTD: { 372 }
  2867. if Assigned(FOnSystem) then
  2868. begin
  2869. FOnSystem(Self, User, CommandNumber,'MOTD', Token[3]); {Do not Localize}
  2870. end;
  2871. RPL_ENDOFINFO: { 374 }
  2872. if Assigned(FOnSystem) then
  2873. begin
  2874. FOnSystem(Self, User, CommandNumber,'INFO', Token[2]); {Do not Localize}
  2875. end;
  2876. RPL_MOTDSTART: { 375 }
  2877. begin
  2878. { Set state to connected. May need this elsewhere too. }
  2879. SeTIdIRCState(csConnected);
  2880. if Assigned(FOnSystem) then
  2881. begin
  2882. FOnSystem(Self, User, CommandNumber,'MOTD', Token[3]); {Do not Localize}
  2883. end;
  2884. end;
  2885. RPL_ENDOFMOTD: { 376 }
  2886. if Assigned(FOnSystem) then
  2887. begin
  2888. FOnSystem(Self, User, CommandNumber,'MOTD', Token[3]); {Do not Localize}
  2889. end;
  2890. RPL_YOUREOPER: { 381 }
  2891. if Assigned(FOnSystem) then
  2892. begin
  2893. FOnSystem(Self, User, CommandNumber,'OPER', Token[2]); {Do not Localize}
  2894. end;
  2895. RPL_REHASHING: { 382 }
  2896. if Assigned(FOnSystem) then
  2897. begin
  2898. FOnSystem(Self, User, CommandNumber,'REHASH', Format('%s :%s', [Token[2], Token[3]])); {Do not Localize}
  2899. end;
  2900. RPL_TIME: { 391 }
  2901. if Assigned(FOnSystem) then
  2902. begin
  2903. if UpperCase(Token[0]) = UpperCase(Token[3]) then
  2904. begin
  2905. FOnSystem(Self, User, CommandNumber,'TIME', Format('%s :%s', [Token[0], Token[4]]))
  2906. end
  2907. else
  2908. begin
  2909. FOnSystem(Self, User, CommandNumber,'TIME', Format('%s :%s', [Token[0], Token[3]]));
  2910. end;
  2911. end;
  2912. RPL_USERSSTART: { 392 }
  2913. if Assigned(FOnSystem) then
  2914. begin
  2915. FOnSystem(Self, User, CommandNumber,'USERS', Token[2]); {Do not Localize}
  2916. end;
  2917. RPL_USERS: { 393 }
  2918. if Assigned(FOnSystem) then
  2919. begin
  2920. FOnSystem(Self, User, CommandNumber,'USERS', Token[2]); {Do not Localize}
  2921. end;
  2922. RPL_ENDOFUSERS: { 394 }
  2923. if Assigned(FOnSystem) then
  2924. begin
  2925. FOnSystem(Self, User, CommandNumber,'USERS', Token[2]); {Do not Localize}
  2926. end;
  2927. RPL_NOUSERS: { 395 }
  2928. if Assigned(FOnSystem) then
  2929. begin
  2930. FOnSystem(Self, User, CommandNumber,'USERS', Token[2]); {Do not Localize}
  2931. end;
  2932. { All responses from 401 to 502 are errors. }
  2933. ERR_NOSUCHNICK.. { 401 }
  2934. ERR_USERSDONTMATCH: { 502 }
  2935. begin
  2936. { Call the general error handler. }
  2937. if Assigned(FOnError) then
  2938. begin
  2939. FOnError(Self, User, Command, Content);
  2940. end;
  2941. { ERR_NICKNAMEINUSE special case for registration
  2942. process. }
  2943. { FIXME: Need to update own user object with chosen nick. }
  2944. if (CommandNumber >= ERR_NONICKNAMEGIVEN) and (CommandNumber <= ERR_NICKNAMEINUSE) and (FState = csLoggingOn) then
  2945. begin
  2946. { Try the AltNick. }
  2947. if FCurrentNick = FNick then
  2948. begin
  2949. FCurrentNick:= FAltNick;
  2950. end
  2951. { Tried the AltNick, so ask the user for another one. }
  2952. else
  2953. begin
  2954. if FCurrentNick = FAltNick then
  2955. begin
  2956. if Assigned(FOnNicksInUse) then
  2957. FOnNicksInUse(Self, FCurrentNick)
  2958. else
  2959. FCurrentNick := ''; {Do not Localize}
  2960. end;
  2961. end;
  2962. { If there is another nick to try, send it. }
  2963. if FCurrentNick <> '' then {Do not Localize}
  2964. begin
  2965. SetNick(FCurrentNick);
  2966. end
  2967. else
  2968. begin
  2969. Disconnect(True);
  2970. end;
  2971. end;
  2972. end;
  2973. 614: { :server 614 yournick :whoisnick (host.net) is using modes: +modes }
  2974. if Assigned(FOnSystem) then
  2975. begin
  2976. FOnSystem(Self, User, CommandNumber,'WHOIS', Token[3]); {Do not Localize}
  2977. end;
  2978. else
  2979. begin
  2980. if Assigned(FOnUnknownCommand) then
  2981. begin
  2982. FOnUnknownCommand(Self, User, Command, Content);
  2983. end;
  2984. end;
  2985. end;
  2986. end
  2987. else
  2988. begin
  2989. { Try to match with a text command. }
  2990. CommandNumber := MatchCommand;
  2991. if CommandNumber > -1 then
  2992. begin
  2993. case CommandNumber of
  2994. 0:
  2995. { PRIVMSG nick/#channel :message }
  2996. { Check for CTCP query. }
  2997. if (Token[3] <> '') AND (Token[3][1] = #1) then
  2998. begin
  2999. ParseCTCPQuery;
  3000. end
  3001. else
  3002. begin
  3003. if Assigned(FOnMessage) then
  3004. begin
  3005. FOnMessage(Self, User, FChannels.Get(Token[2]), Token[3]);
  3006. end;
  3007. end;
  3008. 1:
  3009. { NOTICE nick/#channel :message }
  3010. { Check for CTCP reply. }
  3011. if (Token[3] <> '') and (Token[3][1] = #1) then
  3012. begin
  3013. ParseCTCPReply;
  3014. end
  3015. else
  3016. begin
  3017. if Assigned(FOnNotice) then
  3018. begin
  3019. FOnNotice(Self, User, FChannels.Get(Token[2]), Token[3]);
  3020. end;
  3021. end;
  3022. 2:
  3023. { JOIN #channel }
  3024. if SenderNick = FCurrentNick then
  3025. begin
  3026. { Add the channel object to the channel list, and set it as
  3027. active. }
  3028. Channel := FChannels.Add(Token[2]);
  3029. Channel.Active := True;
  3030. { Need to send a MODE query so we can get the channel mode. }
  3031. Mode(Token[2], '', ''); {Do not Localize}
  3032. if Assigned(FOnJoined) then
  3033. begin
  3034. FOnJoined(Self, Channel);
  3035. end;
  3036. end
  3037. else
  3038. begin
  3039. { Add the new user to the channel object. }
  3040. Channel := FChannels.Get(Token[2]);
  3041. Channel.Joined(User);
  3042. if Assigned(FOnJoin) then
  3043. begin
  3044. FOnJoin(Self, User, Channel);
  3045. end;
  3046. end;
  3047. 3:
  3048. { PART #channel }
  3049. begin
  3050. { Store the part reason in the user object. }
  3051. User.Reason := Token[3];
  3052. if SenderNick = FCurrentNick then
  3053. begin
  3054. { Mark the channel object as inactive. }
  3055. Channel := FChannels.Get(Token[2]);
  3056. Channel.Active := False;
  3057. Channel.CloseType := ctPart;
  3058. if Assigned(FOnParted) then
  3059. begin
  3060. FOnParted(Self, Channel);
  3061. end;
  3062. FChannels.Remove(Token[2]);
  3063. end
  3064. else
  3065. begin
  3066. Channel := FChannels.Get(Token[2]);
  3067. Channel.Parted(User);
  3068. if Assigned(FOnPart) then
  3069. FOnPart(Self, User, Channel);
  3070. end;
  3071. end;
  3072. 4:
  3073. { KICK #channel target :reason }
  3074. begin
  3075. { Store the kick reason in the user object. }
  3076. User.Reason := Token[4];
  3077. if Token[3] = FCurrentNick then
  3078. begin
  3079. { Mark the channel object as inactive. }
  3080. Channel := FChannels.Get(Token[2]);
  3081. Channel.Active := False;
  3082. Channel.CloseType := ctKick;
  3083. if Assigned(FOnKicked) then
  3084. begin
  3085. FOnKicked(Self, User, Channel);
  3086. end;
  3087. FChannels.Remove(Token[2]);
  3088. end
  3089. else
  3090. begin
  3091. Channel := FChannels.Get(Token[2]);
  3092. Target := FUsers.Add(Token[3], ''); {Do not Localize}
  3093. { Copy the kick reason to the target's user object. } {Do not Localize}
  3094. Target.Reason := User.Reason;
  3095. if Assigned(FOnKick) then
  3096. begin
  3097. FOnKick(Self, User, Target, Channel);
  3098. end;
  3099. Channel.Kicked(Target);
  3100. FUsers.Remove(Target);
  3101. end;
  3102. end;
  3103. 5:
  3104. { MODE nick/#channel +/-modes parameters... }
  3105. if IsChannel(Token[2]) then
  3106. { Channel mode change }
  3107. begin
  3108. if FChannels.Find(Token[2], Index) then
  3109. begin
  3110. lcTemp:= Token[3];
  3111. for Index:= 4 to Token.Count - 1 do
  3112. begin
  3113. //TODO: This could be better as noted in BUg report 531202
  3114. //but it does work on a temporary basis. This is necessary as there
  3115. //is more than one entry for User Modes
  3116. if Token[Index] <> '' then
  3117. begin
  3118. lcTemp:= lcTemp + ' ' + Token[Index];
  3119. end;
  3120. end;
  3121. if Assigned(FOnChannelMode) then
  3122. begin
  3123. FOnChannelMode(Self, FUsers.Get(SenderNick), FChannels.Get(Token[2]), Token[2], lcTemp);
  3124. end;
  3125. ParseChannelModeChange(2);
  3126. // if ParseChannelModeChange(2) then
  3127. // if Assigned(FOnChannelModeChanged) then
  3128. // with FChannels.Get(Token[2]) do
  3129. // FOnChannelModeChanged(Self, SenderNick, SenderAddress, Token[2], Mode, Limit, Key);
  3130. end;
  3131. end
  3132. else
  3133. { User mode change }
  3134. begin
  3135. if Token[2] = FCurrentNick then
  3136. begin
  3137. if Assigned(FOnUserMode) then
  3138. begin
  3139. FOnUserMode(Self, Token[3]);
  3140. end;
  3141. if ParseUserModeChange then
  3142. begin
  3143. if Assigned(FOnUserModeChanged) then
  3144. begin
  3145. FOnUserModeChanged(Self);
  3146. end;
  3147. end;
  3148. end;
  3149. end;
  3150. 6:
  3151. { NICK newnick }
  3152. begin
  3153. if (SenderNick = FCurrentNick) then
  3154. begin
  3155. lcTemp:= FCurrentNick;
  3156. FCurrentNick := Token[2];
  3157. if Assigned(FOnNickChanged) then
  3158. begin
  3159. FOnNickChanged(Self, lcTemp);
  3160. end;
  3161. end
  3162. else
  3163. begin
  3164. if Assigned(FOnNickChange) then
  3165. begin
  3166. FOnNickChange(Self, User, Token[2]);
  3167. end;
  3168. end;
  3169. { Go through all channels and inform of the nick change. }
  3170. FChannels.ChangedNick(User, Token[2]);
  3171. { Apply the new nick. }
  3172. User.Nick := Token[2];
  3173. end;
  3174. 7:
  3175. { QUIT :reason }
  3176. begin
  3177. { Store the quit reason. }
  3178. User.Reason := Token[2];
  3179. if Assigned(FOnQuit) then
  3180. begin
  3181. FOnQuit(Self, User);
  3182. end;
  3183. { Go through all channels and inform of the quit. }
  3184. FChannels.Quit(User);
  3185. end;
  3186. 8:
  3187. { INVITE nick :#channel }
  3188. if Assigned(FOnInvite) then
  3189. begin
  3190. FOnInvite(Self, User, Token[3]);
  3191. end;
  3192. 9:
  3193. { KILL nick :reason }
  3194. if Assigned(FOnKill) then
  3195. begin
  3196. FOnKill(Self, User, Token[2], Token[3]);
  3197. end;
  3198. 10:
  3199. { PING server }
  3200. begin
  3201. { Send the PONG response }
  3202. Raw(Format('PONG :%s', [Token[2]])); {Do not Localize}
  3203. if Assigned(FOnPingPong) then
  3204. begin
  3205. FOnPingPong(Self);
  3206. end;
  3207. end;
  3208. 11:
  3209. { WALLOPS :message }
  3210. if Assigned(FOnWallops) then
  3211. begin
  3212. FOnWallops(Self, User, Token[2]);
  3213. end;
  3214. 12:
  3215. {TOPIC}
  3216. begin
  3217. Channel := fChannels.Get(Token[2]);
  3218. if Channel <> nil then
  3219. begin
  3220. Channel.TopicChanged(Token[3]);
  3221. if Assigned(FOnTopic) then
  3222. begin
  3223. FOnTopic(Self, User, Channel, Channel.Name, Token[3]);
  3224. end;
  3225. end;
  3226. end;
  3227. end;
  3228. end
  3229. else
  3230. { Unknown command from server }
  3231. begin
  3232. if Assigned(FOnUnknownCommand) then
  3233. begin
  3234. FOnUnknownCommand(Self, User, Command, Content);
  3235. end;
  3236. end;
  3237. end;
  3238. { Release the sender user object. }
  3239. FUsers.Remove(User);
  3240. end;
  3241. { Attempt to match the given DCC command with one of a list of DCC commands.
  3242. If a match is found, then the index of that command is returned, else the
  3243. return value is -1. }
  3244. function TIdIRC.MatchDCC(ADCC: String): Integer;
  3245. var
  3246. Index: Integer;
  3247. begin
  3248. Index := 0;
  3249. Result := -1;
  3250. while (Result < 0) and (Index <= High(DCCs)) do
  3251. begin
  3252. if ADCC = DCCs[Index] then
  3253. begin
  3254. Result := Index;
  3255. end;
  3256. Inc(Index);
  3257. end;
  3258. end;
  3259. { Attempt to match the given CTCP command with one of a list of CTCP commands.
  3260. If a match is found, then the index of that command is returned, else the
  3261. return value is -1. }
  3262. function TIdIRC.MatchCTCP(ACTCP: String): Integer;
  3263. var
  3264. Index: Integer;
  3265. begin
  3266. Index := 0;
  3267. Result := -1;
  3268. while (Result < 0) and (Index <= High(CTCPs)) do
  3269. begin
  3270. if ACTCP = CTCPs[Index] then
  3271. begin
  3272. Result := Index;
  3273. end;
  3274. Inc(Index);
  3275. end;
  3276. end;
  3277. { Parse a DCC query and call the appropriate event handlers. }
  3278. procedure TIdIRC.ParseDCC(ADCC: String);
  3279. var
  3280. DCCToken: TStringList;
  3281. begin
  3282. DCCToken:= TStringList.Create;
  3283. ADCC:= ADCC + ' ';
  3284. while POS(' ', ADCC) > 0 do
  3285. begin
  3286. DCCToken.Add(COPY(ADCC, 1, POS(' ', ADCC) -1));
  3287. DELETE(ADCC, 1, POS(' ', ADCC));
  3288. end;
  3289. case MatchDCC(DCCToken[0]) of
  3290. 0:
  3291. {SEND}
  3292. begin
  3293. if Assigned(FOnDCCSend) then
  3294. begin
  3295. FOnDCCSend(Self, SenderNick, DCCToken[2], DCCToken[3], DCCToken[1], DCCToken[4]);
  3296. end;
  3297. end;
  3298. 1:
  3299. {CHAT}
  3300. begin
  3301. if Assigned(FOnDCCChat) then
  3302. begin
  3303. FOnDCCChat(Self, SenderNick, DCCToken[2], DCCToken[3]);
  3304. end;
  3305. end;
  3306. 2:
  3307. {RESUME}
  3308. begin
  3309. if Assigned(FOnDCCResume) then
  3310. begin
  3311. FOnDCCResume(Self, SenderNick, DCCToken[2], DCCToken[1], DCCToken[3]);
  3312. end;
  3313. end;
  3314. 3:
  3315. {ACCEPT}
  3316. begin
  3317. if Assigned(FOnDCCAccept) then
  3318. begin
  3319. FOnDCCAccept(Self, SenderNick, DCCToken[2], DCCToken[1], DCCToken[3]);
  3320. end;
  3321. end;
  3322. end;
  3323. DCCToken.Free;
  3324. end;
  3325. { Parse a CTCP query and call the appropriate event handlers. }
  3326. procedure TIdIRC.ParseCTCPQuery;
  3327. var
  3328. CTCP, Args: String;
  3329. Index, L: Integer;
  3330. User: TIdIRCUser;
  3331. Suppress: Boolean;
  3332. begin
  3333. L := Length(Token[3]);
  3334. Index := Pos(' ', Token[3]); {Do not Localize}
  3335. if Index > 0 then
  3336. begin
  3337. { CTCP command plus parameters. }
  3338. CTCP := Copy(Token[3], 2, Index - 2);
  3339. Args := Copy(Token[3], Index + 1, L - Index - 1);
  3340. end
  3341. else
  3342. begin
  3343. { No parameters. }
  3344. CTCP := Copy(Token[3], 2, L - 2);
  3345. Args := ''; {Do not Localize}
  3346. end;
  3347. Suppress := False;
  3348. User := FUsers.Add(SenderNick, SenderAddress);
  3349. case MatchCTCP(CTCP) of
  3350. -1:
  3351. { Unknown CTCP query. }
  3352. begin
  3353. if Assigned(FOnCTCPQuery) then
  3354. begin
  3355. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3356. { Suppressing an unknown CTCP query has no meaning, so ignore the
  3357. Suppress variable. }
  3358. end;
  3359. end;
  3360. 0:
  3361. { ACTION }
  3362. begin
  3363. if Assigned(FOnAction) then
  3364. FOnAction(Self, User, FChannels.Get(Token[2]), Args);
  3365. end;
  3366. 1:
  3367. { SOUND }
  3368. begin
  3369. if Assigned(FOnCTCPQuery) then
  3370. begin
  3371. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3372. end;
  3373. { Suppressing an CTCP SOUND query has no meaning, so ignore the
  3374. Suppress variable. }
  3375. end;
  3376. 2:
  3377. { PING }
  3378. begin
  3379. if Assigned(FOnCTCPQuery) then
  3380. begin
  3381. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3382. end;
  3383. { Suppress the standard PING response if requested. }
  3384. if not Suppress then
  3385. begin
  3386. CTCPReply(SenderNick, CTCP, Args);
  3387. end;
  3388. end;
  3389. 3:
  3390. { FINGER }
  3391. begin
  3392. if Assigned(FOnCTCPQuery) then
  3393. begin
  3394. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3395. end;
  3396. { Suppress the standard FINGER response if requested. }
  3397. if not Suppress then
  3398. begin
  3399. CTCPReply(SenderNick, CTCP, Replies.Finger);
  3400. end;
  3401. end;
  3402. 4:
  3403. { USERINFO }
  3404. begin
  3405. if Assigned(FOnCTCPQuery) then
  3406. begin
  3407. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3408. end;
  3409. { Suppress the standard USERINFO response if requested. }
  3410. if not Suppress then
  3411. begin
  3412. CTCPReply(SenderNick, CTCP, Replies.UserInfo);
  3413. end;
  3414. end;
  3415. 5:
  3416. { VERSION }
  3417. begin
  3418. if Assigned(FOnCTCPQuery) then
  3419. begin
  3420. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3421. end;
  3422. { Suppress the standard VERSION response if requested. }
  3423. if not Suppress then
  3424. begin
  3425. CTCPReply(SenderNick, CTCP, Replies.Version);
  3426. end;
  3427. end;
  3428. 6:
  3429. { CLIENTINFO }
  3430. begin
  3431. if Assigned(FOnCTCPQuery) then
  3432. begin
  3433. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3434. end;
  3435. { Suppress the standard CLIENTINFO response if requested. }
  3436. if not Suppress then
  3437. begin
  3438. CTCPReply(SenderNick, CTCP, Replies.ClientInfo);
  3439. end;
  3440. end;
  3441. 7:
  3442. { TIME }
  3443. begin
  3444. if Assigned(FOnCTCPQuery) then
  3445. begin
  3446. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3447. end;
  3448. { Suppress the standard TIME response if requested. }
  3449. if not Suppress then
  3450. begin
  3451. CTCPReply(SenderNick, CTCP, Format(RSIRCTimeIsNow, [DateTimeToStr(Now)])); {Do not Localize}
  3452. end;
  3453. end;
  3454. 8:
  3455. { ERROR }
  3456. begin
  3457. if Assigned(FOnCTCPQuery) then
  3458. begin
  3459. FOnCTCPQuery(Self, User, FChannels.Get(Token[2]), CTCP, Args, Suppress);
  3460. end;
  3461. end;
  3462. 9:
  3463. { DCC }
  3464. begin
  3465. ParseDCC(Args);
  3466. end;
  3467. end;
  3468. { Release the user object. }
  3469. FUsers.Remove(User);
  3470. end;
  3471. { Parse a CTCP reply and call the appropriate event handlers. }
  3472. procedure TIdIRC.ParseCTCPReply;
  3473. var
  3474. CTCP, Args: String;
  3475. Index, L: Integer;
  3476. User: TIdIRCUser;
  3477. begin
  3478. L := Length(Token[3]);
  3479. Index := Pos(' ', Token[3]); {Do not Localize}
  3480. if Index > 0 then
  3481. begin
  3482. { CTCP command plus parameters. }
  3483. CTCP := Copy(Token[3], 2, Index - 2);
  3484. Args := Copy(Token[3], Index + 1, L - Index - 1);
  3485. end
  3486. else
  3487. begin
  3488. { No parameters. }
  3489. CTCP := Copy(Token[3], 2, L - 2);
  3490. Args := ''; {Do not Localize}
  3491. end;
  3492. User := FUsers.Add(SenderNick, SenderAddress);
  3493. case MatchCTCP(CTCP) of
  3494. -1..8:
  3495. begin
  3496. if Assigned(FOnCTCPReply) then
  3497. begin
  3498. FOnCTCPReply(Self, User, FChannels.Get(Token[2]), CTCP, Args);
  3499. end;
  3500. end;
  3501. 9:
  3502. { DCC }
  3503. begin
  3504. { FIXME: To be completed. }
  3505. end;
  3506. end;
  3507. { Release the user object. }
  3508. FUsers.Remove(User);
  3509. end;
  3510. { Evaluate the channel mode change command. }
  3511. function TIdIRC.ParseChannelModeChange(AChannelToken: Integer): Boolean;
  3512. var
  3513. i: Integer;
  3514. j: Integer;
  3515. Channel: TIdIRCChannel;
  3516. User, Target: TIdIRCUser;
  3517. ChangeType: TIdIRCChangeType;
  3518. NewChannelMode: TIdIRCChannelModes;
  3519. begin
  3520. Result := False;
  3521. ChangeType := ctAdd;
  3522. Channel := FChannels.Get(Token[AChannelToken]);
  3523. if Channel = nil then
  3524. begin
  3525. Exit;
  3526. end;
  3527. User := FUsers.Get(SenderNick);
  3528. NewChannelMode := Channel.Mode;
  3529. j := AChannelToken + 2; { Token 4 is the first parameter }
  3530. for i := 1 to Length(Token[AChannelToken + 1]) do
  3531. case Token[AChannelToken + 1][i] of
  3532. '+': {Do not Localize}
  3533. { Add mode. }
  3534. ChangeType := ctAdd;
  3535. '-': {Do not Localize}
  3536. { Remove mode. }
  3537. ChangeType := ctSubtract;
  3538. 'b': {Do not Localize}
  3539. { Set/Remove channel ban. }
  3540. if ChangeType = ctAdd then
  3541. begin
  3542. if Assigned(FOnBan) then
  3543. begin
  3544. FOnBan(Self, User, Channel, Token[j]);
  3545. end;
  3546. Inc(j);
  3547. end
  3548. else
  3549. begin
  3550. if Assigned(FOnUnban) then
  3551. begin
  3552. FOnUnban(Self, User, Channel, Token[j]);
  3553. end;
  3554. Inc(j);
  3555. end;
  3556. 'i': {Do not Localize}
  3557. { Invite only channel. }
  3558. if ChangeType = ctAdd then
  3559. begin
  3560. NewChannelMode := NewChannelMode + [cmInviteOnly];
  3561. end
  3562. else
  3563. begin
  3564. NewChannelMode := NewChannelMode - [cmInviteOnly];
  3565. end;
  3566. 'k': {Do not Localize}
  3567. { Set/Remove channel key. }
  3568. if ChangeType = ctAdd then
  3569. begin
  3570. NewChannelMode := NewChannelMode + [cmKey];
  3571. Channel.KeyChanged(Token[j]);
  3572. Inc(j);
  3573. end
  3574. else
  3575. begin
  3576. NewChannelMode := NewChannelMode - [cmKey];
  3577. Channel.KeyChanged(''); {Do not Localize}
  3578. end;
  3579. 'l': {Do not Localize}
  3580. { Set/Remove user limit. }
  3581. if ChangeType = ctAdd then
  3582. begin
  3583. NewChannelMode := NewChannelMode + [cmUserLimit];
  3584. Channel.LimitChanged(StrToIntDef(Token[j], 0));
  3585. Inc(j);
  3586. end
  3587. else
  3588. begin
  3589. NewChannelMode := NewChannelMode - [cmUserLimit];
  3590. Channel.LimitChanged(0);
  3591. end;
  3592. 'm': {Do not Localize}
  3593. { Moderated channel. }
  3594. if ChangeType = ctAdd then
  3595. begin
  3596. NewChannelMode := NewChannelMode + [cmModerated]
  3597. end
  3598. else
  3599. begin
  3600. NewChannelMode := NewChannelMode - [cmModerated];
  3601. end;
  3602. 'n': {Do not Localize}
  3603. { No External Messages. }
  3604. if ChangeType = ctAdd then
  3605. begin
  3606. NewChannelMode := NewChannelMode + [cmNoExternalMessages]
  3607. end
  3608. else
  3609. begin
  3610. NewChannelMode := NewChannelMode - [cmNoExternalMessages];
  3611. end;
  3612. 'o': {Do not Localize}
  3613. { Give or take operator priviliges. }
  3614. begin
  3615. Target := FUsers.Get(Token[j]);
  3616. if ChangeType = ctAdd then
  3617. begin
  3618. if Assigned(FOnOp) then
  3619. begin
  3620. FOnOp(Self, User, Channel, Target);
  3621. end;
  3622. { Update the attributes. }
  3623. Channel.GotOp(Target);
  3624. Inc(j);
  3625. end
  3626. else
  3627. begin
  3628. if Assigned(FOnDeop) then
  3629. begin
  3630. FOnDeop(Self, User, Channel, FUsers.Get(Token[j]));
  3631. end;
  3632. { Update the attributes. }
  3633. Channel.GotDeop(Target);
  3634. Inc(j);
  3635. end;
  3636. end;
  3637. 'p': {Do not Localize}
  3638. { Private channel. }
  3639. if ChangeType = ctAdd then
  3640. begin
  3641. NewChannelMode := NewChannelMode + [cmPrivate]
  3642. end
  3643. else
  3644. begin
  3645. NewChannelMode := NewChannelMode - [cmPrivate];
  3646. end;
  3647. 's': {Do not Localize}
  3648. { Secret channel. }
  3649. if ChangeType = ctAdd then
  3650. NewChannelMode := NewChannelMode + [cmSecret]
  3651. else
  3652. NewChannelMode := NewChannelMode - [cmSecret];
  3653. 't': {Do not Localize}
  3654. { Only operators set topic. }
  3655. if ChangeType = ctAdd then
  3656. begin
  3657. NewChannelMode := NewChannelMode + [cmOpsSetTopic]
  3658. end
  3659. else
  3660. begin
  3661. NewChannelMode := NewChannelMode - [cmOpsSetTopic];
  3662. end;
  3663. 'v': {Do not Localize}
  3664. { Give or take a voice on a moderated channel. }
  3665. begin
  3666. Target := FUsers.Get(Token[j]);
  3667. if ChangeType = ctAdd then
  3668. begin
  3669. if Assigned(FOnVoice) then
  3670. begin
  3671. FOnVoice(Self, User, Channel, Target);
  3672. end;
  3673. { Update the attributes. }
  3674. Channel.GotVoice(Target);
  3675. Inc(j);
  3676. end
  3677. else
  3678. begin
  3679. if Assigned(FOnDevoice) then
  3680. begin
  3681. FOnDevoice(Self, User, Channel, Target);
  3682. end;
  3683. { Update the attributes. }
  3684. Channel.GotDevoice(Target);
  3685. Inc(j);
  3686. end;
  3687. end;
  3688. end;
  3689. Result := (Channel.Mode <> NewChannelMode);
  3690. if Result then
  3691. begin
  3692. Channel.ModeChanged(NewChannelMode);
  3693. end;
  3694. end;
  3695. { Evaluate user mode change. }
  3696. function TIdIRC.ParseUserModeChange: Boolean;
  3697. var
  3698. i: Integer;
  3699. ChangeType: TIdIRCChangeType;
  3700. NewUserMode: TIdIRCUserModes;
  3701. begin
  3702. ChangeType := ctAdd;
  3703. NewUserMode := FUserMode;
  3704. for i := 1 to Length(Token[3]) do
  3705. begin
  3706. if (Length(Token[3])>0) then
  3707. begin
  3708. case Token[3][i] of
  3709. '+': {Do not Localize}
  3710. { Add mode. }
  3711. ChangeType := ctAdd;
  3712. '-': {Do not Localize}
  3713. { Remove mode. }
  3714. ChangeType := ctSubtract;
  3715. 'i': {Do not Localize}
  3716. { Invisible. }
  3717. if ChangeType = ctAdd then
  3718. begin
  3719. NewUserMode := NewUserMode + [umInvisible]
  3720. end
  3721. else
  3722. begin
  3723. NewUserMode := NewUserMode - [umInvisible];
  3724. end;
  3725. 'o': {Do not Localize}
  3726. { IRC Operator. }
  3727. if ChangeType = ctAdd then
  3728. begin
  3729. NewUserMode := NewUserMode + [umOperator]
  3730. end
  3731. else
  3732. begin
  3733. NewUserMode := NewUserMode - [umOperator];
  3734. end;
  3735. 's': {Do not Localize}
  3736. { Receive server notices. }
  3737. if ChangeType = ctAdd then
  3738. begin
  3739. NewUserMode := NewUserMode + [umServerNotices]
  3740. end
  3741. else
  3742. begin
  3743. NewUserMode := NewUserMode - [umServerNotices];
  3744. end;
  3745. 'w': {Do not Localize}
  3746. { Receive wallops. }
  3747. if ChangeType = ctAdd then
  3748. begin
  3749. NewUserMode := NewUserMode + [umWallops]
  3750. end
  3751. else
  3752. begin
  3753. NewUserMode := NewUserMode - [umWallops];
  3754. end;
  3755. end;
  3756. end;
  3757. end;
  3758. Result := (FUserMode <> NewUserMode);
  3759. if Result then
  3760. begin
  3761. FUserMode := NewUserMode;
  3762. end;
  3763. end;
  3764. { Return True if the string Channel is a channel name. }
  3765. function TIdIRC.IsChannel(AChannel: String): Boolean;
  3766. begin
  3767. Result := (Length(AChannel)>0) and (AChannel[1] in IRCChannelPrefixes);
  3768. end;
  3769. { Return True if the string Nick is a channel operator. }
  3770. function TIdIRC.IsOp(ANick: String): Boolean;
  3771. begin
  3772. Result := (Length(Nick)>0) and (Nick[1] = '@'); {Do not Localize}
  3773. end;
  3774. { Return True if the string Nick has a voice. }
  3775. function TIdIRC.IsVoice(ANick: String): Boolean;
  3776. begin
  3777. Result := (Length(Nick)>0) and (Nick[Length(Nick)] = '+'); {Do not Localize}
  3778. end;
  3779. { Returns True if the address matches the hostmask. Uses a recursive method
  3780. to perform the check. }
  3781. function TIdIRC.MatchHostmask(AAddress, AHostmask: PChar): Boolean;
  3782. begin
  3783. if StrComp(AHostmask, '*') = 0 then {Do not Localize}
  3784. begin
  3785. Result := True;
  3786. end
  3787. else
  3788. begin
  3789. if (AAddress^ = #0) and (AHostmask^ <> #0) then
  3790. begin
  3791. Result := False;
  3792. end
  3793. else
  3794. begin
  3795. if (AAddress^ = #0) then
  3796. begin
  3797. Result := True;
  3798. end
  3799. else
  3800. case AHostmask^ of
  3801. '*': {Do not Localize}
  3802. if MatchHostmask(AAddress, AHostmask + 1) then
  3803. begin
  3804. Result := True;
  3805. end
  3806. else
  3807. begin
  3808. Result := MatchHostmask(AAddress + 1, AHostmask);
  3809. end;
  3810. '?': {Do not Localize}
  3811. Result := MatchHostmask(AAddress + 1, AHostmask + 1);
  3812. else
  3813. if AAddress^ = AHostmask^ then
  3814. begin
  3815. Result := MatchHostmask(AAddress + 1, AHostmask + 1)
  3816. end
  3817. else
  3818. begin
  3819. Result := False;
  3820. end;
  3821. end;
  3822. end;
  3823. end;
  3824. end;
  3825. { Return a string representation of the user mode. }
  3826. function TIdIRC.GetModeString: String;
  3827. var
  3828. Element: TIdIRCUserMode;
  3829. begin
  3830. { Only bother if there are actually modes to show. }
  3831. if FUserMode <> [] then
  3832. begin
  3833. Result := '+'; {Do not Localize}
  3834. { Add all mode characters. }
  3835. for Element := umInvisible to umWallops do
  3836. begin
  3837. if Element in FUserMode then
  3838. begin
  3839. Result := Result + UserModeChars[Ord(Element)];
  3840. end;
  3841. end;
  3842. end
  3843. else
  3844. begin
  3845. Result := ''; {Do not Localize}
  3846. end;
  3847. end;
  3848. constructor TIdIRCReadThread.Create(AClient: TIdIRC);
  3849. begin
  3850. inherited Create(False);
  3851. FClient := AClient;
  3852. FreeOnTerminate := True;
  3853. end;
  3854. procedure TIdIRCReadThread.Run;
  3855. begin
  3856. FRecvData := FClient.ReadLn;
  3857. Synchronize(FClient.SocketDataAvailable);
  3858. FClient.CheckForDisconnect;
  3859. end;
  3860. procedure TIdIRCChannels.Sort;
  3861. {I found this procedure at:
  3862. http://groups.google.com/groups?q=Sort+TCollection&start=30&hl=en&safe=off&rnum=35&selm=904181166%40f761.n5030.z2.FidoNet.ftn
  3863. and it seems to look good.}
  3864. function DoCompare(AItem1, AItem2 : TIdIRCChannel) : Integer;
  3865. begin
  3866. if Assigned(FOnSortCompareChanels) then
  3867. begin
  3868. FOnSortCompareChanels(Self,AItem1, AItem2, Result);
  3869. end
  3870. else
  3871. begin
  3872. Result := 0;
  3873. end;
  3874. end;
  3875. procedure SwapItems(i, j : Integer);
  3876. var
  3877. T : TIdIRCChannel;
  3878. begin
  3879. T := Items[i];
  3880. Items[i] := Items[j];
  3881. Items[j] := T;
  3882. end;
  3883. procedure SortItems(iStart, iEnd : Integer);
  3884. var
  3885. i, j : Integer;
  3886. Med : TIdIRCChannel;
  3887. begin
  3888. while iStart < iEnd do
  3889. begin
  3890. i := iStart;
  3891. j := iEnd;
  3892. if iStart = iEnd-1 then
  3893. begin
  3894. if DoCompare(Items[iStart], Items[iEnd]) > 0 then
  3895. begin
  3896. SwapItems(iStart, iEnd);
  3897. end;
  3898. Break;
  3899. end;
  3900. Med := Items[(i + j) div 2];
  3901. repeat
  3902. while DoCompare(Items[i], Med) < 0 do
  3903. begin
  3904. Inc(i);
  3905. end;
  3906. while DoCompare(Items[j], Med) > 0 do
  3907. begin
  3908. Dec(j);
  3909. end;
  3910. if i <= j then
  3911. begin
  3912. SwapItems(i, j);
  3913. Inc(i);
  3914. Dec(j);
  3915. end;
  3916. until i > j;
  3917. if j-iStart > iEnd-i then
  3918. begin
  3919. SortItems(i, iEnd);
  3920. iEnd := j;
  3921. end
  3922. else
  3923. begin
  3924. SortItems(iStart, j);
  3925. iStart := i;
  3926. end;
  3927. end;
  3928. end;
  3929. begin
  3930. if Count > 0 then
  3931. begin
  3932. SortItems(0, Count - 1);
  3933. end;
  3934. end;
  3935. end.