IRC Souvenir,souvenir ...

[falsam]

Internet Relay Chat ou IRC (en français, « discussion relayée par Internet ») est un protocole de communication textuelle sur Internet. Il sert à la communication instantanée principalement sous la forme de discussions en groupe par l’intermédiaire des canaux de discussion, mais peut aussi être utilisé pour de la communication de un à un. Il peut par ailleurs être utilisé pour faire du transfert de fichier.

Pure Basic posséde son IRC et vous trouverez un code de DarkDragon remis à jour avec la version 4.51 et plus. N"hésitez pas à tester ce code

Code : Tout sélectionner

; Author: DarkDragon - 06. November 2004
; Updated For PB 4.00 by Andre
; Updated For PB 4.60+ by Falsam 
;
; OS: Windows

Enumeration
  #MainForm
  #Chat
  #Messages
  #Names
EndEnumeration

InitNetwork() 

Global ConnectionID.l 
Global NewList RecText.s() 

Global Channel.s = "#purebasic" 
Global Server.s = "irc.freenode.net" 
Global Port.i=6667

Procedure IRCConnect(Server.s, Port.l) 
  Connection = OpenNetworkConnection(Server, Port) 
  If Connection <> 0 
    ConnectionID = Connection 
  EndIf 
  ProcedureReturn Connection 
EndProcedure 

Procedure IRCUseConnection(Connection) 
  ConnectionID = Connection 
EndProcedure 

Procedure IRCLogin(Server.s, Name.s, Pass.s) 
  SendNetworkString(ConnectionID, "USER "+ReplaceString(Name, " ", "_")+" localhost "+Server+" http://www.bradan.net/"+Chr(13)+Chr(10)) 
  SendNetworkString(ConnectionID, "NICK "+ReplaceString(Name, " ", "_")+Chr(13)+Chr(10)) 
  If Pass <> "" 
    SendNetworkString(ConnectionID, "PRIVMSG NickServ :IDENTIFY "+Pass+Chr(13)+Chr(10)) 
  EndIf 
EndProcedure 

Procedure IRCChangeNick(Name.s) 
  SendNetworkString(ConnectionID, "NICK "+ReplaceString(Name, " ", "_")+Chr(13)+Chr(10)  ) 
EndProcedure 

Procedure IRCJoin(Channel.s, Server.s) 
  SendNetworkString(ConnectionID, "JOIN "+Channel+Chr(13)+Chr(10)) 
EndProcedure 

Procedure IRCLeave(Channel.s) 
  SendNetworkString(ConnectionID, "PART "+Channel+Chr(13)+Chr(10)) 
EndProcedure 

Procedure IRCSendText(Channel.s, Text.s) 
  SendNetworkString(ConnectionID, "PRIVMSG "+Channel+" :"+Text+Chr(13)+Chr(10)) 
EndProcedure 

Procedure IRCSend(Text.s) 
  SendNetworkString(ConnectionID, Text+Chr(13)+Chr(10)) 
EndProcedure 

Procedure.s IRCGetFrom(Str.s) 
  Start = FindString(Str.s, ":", 0)+1 
  Stop = FindString(Str.s, "!~", Start) 
  ProcedureReturn Mid(Str.s, Start, Stop-Start) 
EndProcedure 

Procedure.s IRCGetTo(Str.s) 
  Start = FindString(Str.s, "PRIVMSG", 2)+Len("PRIVMSG")+1 
  Stop = FindString(Str.s, ":", Start)-1 
  ProcedureReturn Mid(Str.s, Start, Stop-Start) 
EndProcedure 

Procedure.s IRCGetPingMsg(Str.s) 
  Start = FindString(Str.s, ":", 0)+1 
  Stop = Len(Str.s)+1 
  ProcedureReturn Mid(Str.s, Start, Stop-Start) 
EndProcedure 

Procedure.s IRCGetLine() 
  If NetworkClientEvent(ConnectionID) = 2 
    LastElement(RecText()) 
    *Buffer = AllocateMemory(1024) 
    ReceiveNetworkData(ConnectionID, *Buffer, 1024) 
    txt.s = PeekS(*Buffer, -1, #PB_UTF8) 
    FreeMemory(*Buffer) 
    ReplaceString(txt, Chr(13), Chr(10)) 
    ReplaceString(txt, Chr(10)+Chr(10), Chr(10)) 
    For k=1 To CountString(txt, Chr(10)) 
      Line.s = RemoveString(RemoveString(StringField(txt, k, Chr(10)), Chr(10)), Chr(13)) 
      If Line <> "" 
        If FindString(UCase(Line), "PING", 0) Or FindString(UCase(Line), "VERSION", 0) 
          SendNetworkString(ConnectionID, ReplaceString(Line, "PING :", "PONG :", 0)+Chr(13)+Chr(10)) 
        Else 
          AddElement(RecText()) 
          RecText() = Line.s 
        EndIf 
      EndIf 
    Next 
  EndIf 
  If ListSize(RecText()) > 0 
    FirstElement(RecText()) 
    txt.s = RecText() 
    DeleteElement(RecText()) 
    ProcedureReturn txt 
  EndIf 
EndProcedure 

Procedure.s IRCGetText(Str.s) 
  Start = FindString(Str.s, ":", FindString(Str.s, "PRIVMSG", 2)+Len("PRIVMSG")) 
  ProcedureReturn Right(Str, Len(Str)-Start) 
EndProcedure 

Procedure.f IRCPing(Server.s, Timeout) 
  *Buffer = AllocateMemory(1024) 
  SendNetworkString(ConnectionID, "PING "+Server+Chr(13)+Chr(10)) 
  Time = ElapsedMilliseconds() 
  While NetworkClientEvent(ConnectionID) <> 2
    Delay(1)
    If ElapsedMilliseconds()-Time > Timeout 
      Break 
    EndIf
  Wend 
  
  If ElapsedMilliseconds()-Time <= Timeout 
    T = ElapsedMilliseconds()-Time 
    ReceiveNetworkData(ConnectionID, *Buffer, 1024) 
    FreeMemory(*Buffer) 
    ProcedureReturn T/1000 
  Else 
    ProcedureReturn -1 
  EndIf 
EndProcedure 

Procedure IRCDisconnect(Msg.s) ;Closes the current connection 
  SendNetworkString(ConnectionID, "QUIT "+Msg.s+Chr(13)+Chr(10)) 
  CloseNetworkConnection(ConnectionID) 
EndProcedure 

;Liste des noms
Procedure.s IRCEnumNames(Channel.s) ;Enumerates all names in the channel 
  SendNetworkString(ConnectionID, "NAMES "+Channel+Chr(13)+Chr(10)) 
  *Buffer = AllocateMemory(1024) 
  While NetworkClientEvent(ConnectionID) <> 2 : Delay(1) : Wend 
  ReceiveNetworkData(ConnectionID, *Buffer, 1024) 
  txt.s = PeekS(*Buffer, -1, #PB_UTF8) 
  FreeMemory(*Buffer) 
  Start = FindString(txt, Channel.s, 0)+Len(Channel.s)+2 
  Stop = FindString(txt, Chr(10), 0) 
  ProcedureReturn Mid(txt.s, Start, Stop-Start) 
EndProcedure 

;Redimensionnement de la fenetre principale de l'application
Procedure ResizeWin() 
  ResizeGadget(#Chat, 10, WindowHeight(0)-30, WindowWidth(0)-20, 20) 
  ResizeGadget(#Messages, 10, 10, WindowWidth(0)-170, WindowHeight(0)-50) 
  ResizeGadget(#Names, WindowWidth(0)-160, 10, 150, WindowHeight(0)-50) 
EndProcedure 

;Create the GUI 
If OpenWindow(#Mainform, 216, 0, 450, 300, "IRC "+Channel, #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SystemMenu | #PB_Window_TitleBar) 
  StringGadget(#Chat, 10, 270, 430, 20, "", #ES_MULTILINE) ;The Input 
  ListViewGadget(#Messages, 10, 10, 280, 250) ;Messages 
  ListViewGadget(#Names, 290, 10, 150, 250) ;Names 
EndIf 

Nick.s = InputRequester("Nickname", "Give your Nickname:", "Your NickName") 

IRCConnect(Server.s, Port) 
IRCLogin(Server.s, Nick.s, "") 
IRCJoin(Channel.s, Server.s) 

Names.s = IRCEnumNames(Channel.s)

Repeat 
  Line.s = IRCGetLine() ;Get a messageline 
  If Line <> "" 
    If IRCGetFrom(Line) <> "" 
    
    ClearGadgetItems(#Names) 
    Names.s = IRCEnumNames(Channel.s) 
    Login = 1 
    
    For k=1 To CountString(Names, " ") ;List the Names 
      Cur.s = StringField(Names, k, " ") 
      Debug cur
      If Len(Cur) > 1 
        AddGadgetItem(#Names, -1, Cur) 
      EndIf 
    Next 
    
    If UCase(IRCGetTo(Line)) <> UCase(Channel.s) 
      AddGadgetItem(#Messages, -1, "<"+IRCGetFrom(Line)+" To "+IRCGetTo(Line)+"> "+IRCGetText(Line)) 
    Else 
      AddGadgetItem(#Messages, -1, "<"+IRCGetFrom(Line)+"> "+IRCGetText(Line)) 
    EndIf   
  Else 
    AddGadgetItem(#Messages, -1, Line)  
  EndIf 
    
    SetGadgetState(#Messages, CountGadgetItems(#Messages)-1)   
  Else   
    If Login = 1 And ElapsedMilliseconds()-LastPing > 15000 
      Ping.f = IRCPing(Server.s, 5000) 
      SetWindowTitle(#MainForm, "IRC "+Channel+"  Ping: "+StrF(Ping, 2)) 
      LastPing = ElapsedMilliseconds() 
    EndIf 
  EndIf 
   
  Event = WindowEvent() 
  Select Event 
    Case 0 
      Delay(20) 
      
    Case #PB_Event_SizeWindow 
      ResizeWin() 
      
    Case #PB_Event_Gadget 
      Select EventGadget() 
        Case #Names 
          If EventType() = #PB_EventType_LeftDoubleClick 
            Msg.s = GetGadgetItemText(#Names, GetGadgetState(#Names), 0) 
            If Left(Msg, 1) = "@" 
              Msg = Right(Msg, Len(Msg)-1) 
            EndIf 
            SetGadgetText(#Chat, GetGadgetText(1)+"/msg "+Msg+" ") 
            SetActiveGadget(#Chat) 
          EndIf 
          
        Case #Chat 
          If EventType() = #PB_EventType_ReturnKey And GetGadgetText(#Chat) <> "" 
            If Left(GetGadgetText(#Chat), 1) = "/" 
            AllParams.s = Right(GetGadgetText(#Chat), Len(GetGadgetText(#Chat))-FindString(GetGadgetText(#Chat), " ", 0)) 
            Param1.s = StringField(GetGadgetText(#Chat), 2, " ") 
            Param2.s = Right(AllParams.s, Len(AllParams.s)-FindString(AllParams.s, " ", 1)) 
            Select LCase(StringField(GetGadgetText(1), 1, " ")) 
              Case "/msg" 
                IRCSendText(Param1, Param2) 
                AddGadgetItem(#Messages, -1, "<"+Nick+" To "+Param1+"> "+Param2) 
              Case "/join" 
                IRCJoin(Param1, Server) 
              Default 
                IRCSend(Right(GetGadgetText(#Chat), Len(GetGadgetText(1))-1)) 
                AddGadgetItem(#Messages, -1, "<"+Nick+"> "+AllParams.s) 
            EndSelect 
            Else 
            IRCSendText(Channel.s, GetGadgetText(1)) 
            AddGadgetItem(#Messages, -1, "<"+Nick+"> "+GetGadgetText(#Chat)) 
            EndIf 
            SetGadgetText(#Chat, "") 
            SetGadgetState(#Messages, CountGadgetItems(#Messages)-1) 
          EndIf 
      EndSelect 
  EndSelect 
Until Event = #PB_Event_CloseWindow 
IRCDisconnect("Bye") 
End

[venom]

Merci du partage falsam
Sympa comme code





@++

[Fig]

Ca fonctionne encore ce code ? Je n'ai aucune erreur mais des caractères chinois partout... Probleme avec l'unicode nan ?

Je cherche à intégrer un chat dans un prog pb sans utiliser une bdd (car mon hébergeur va péter un plomb si je fais ça).
Ca me parait une bonne solution si c'est encore fonctionnel avec Pb 5.44.

[falsam]

Les joies de l'unicode ma petite lucette.

Le code est à jour pour fonctionner avec la version 5.60.

Ligne 86 et 147 - Ajout de l'option #PB_UTF8

Code : Tout sélectionner

txt.s = PeekS(*Buffer, -1, #PB_UTF8) 

[Fig]

Merci infiniment !

[falsam]

La liste des utilisateurs met un peu de temps à s'afficher.

Le code est à mon avis à remettre au gout du jour avec la dernière version de PureBasic.

Attention aux tests, #purebasic n'est pas un channel de test

[Fig]

Oui j'ai bien compris. (note que si d'autres forumeurs passent pas là, je ne veux pas être tenu pour responsable...)

J'invite les utilisateurs à essayer le chan #test plutôt.

C'est quoi Bradan.net ?

Bon, j'ai remis au propre et en ordre, viré le superflu et j'ai fait une petite librairie, c'est parfait comme ça.

[JohnJohnsonSHERMAN]

De mon coté je peux me connecter mais pas envoyer quoi que ce soit.... Sans doute une éniéme inculture de ma part