Just Like A Lan Chat [v:0.1b]

Anwendungen, Tools, Userlibs und anderes nützliches.
IcedCoffee
Beiträge: 115
Registriert: 09.07.2005 12:11
Wohnort: Fürstenwald [Internat], Berlin[wen keine lust auf Internat], Wildau[Einfamilienhaus]
Kontaktdaten:

Just Like A Lan Chat [v:0.1b]

Beitrag von IcedCoffee »

Moin

ich habe mal einen kleinen chat programmiert
also der befindet sich noch in der beta version da ich ihn noch nicht 'richtig' testen konnte

Code: Alles auswählen

Declare Open_Main_Window()
;-------------------------------------
Declare WindProc()
Declare ClientProc()
Declare ServerProc()
;-------------------------------------
Declare.s GetMyIP()
Declare.s GetIPbyClientID(ClientID)
Declare SendToAll(Text.s)
Declare.s ReceiveNetworkString(ClientID)
;-------------------------------------
Structure Client
  ClientID.l
  ClientIP.s
  ClientNick.s
EndStructure
NewList SerClients.Client()
Global ClientThreadID.b
Global ServerThreadID.b
Global ConID.l
;-------------------------------------
Enumeration
  #Main_Window
EndEnumeration
Enumeration
  #To_IP
  #IPAddress
  #with_the_Port_Con
  #Port_Con
  #Conect
  #or
  #Create_Server
  #with_the_Port_Ser
  #Port_Ser
  #Join
  #the_Chat_with_the_nick_mame
  #Nick
  #Chat
  #Text
  #Send
  #Klappe
EndEnumeration
Procedure Open_Main_Window()
  If OpenWindow(#Main_Window, 390, 256, 525, 454,  #PB_Window_SystemMenu | #PB_Window_TitleBar , "JLALC - (c) by IcedCoffee")
    If CreateGadgetList(WindowID())
      TextGadget(#To_IP, 60, 10, 30, 15, "to IP :")
      IPAddressGadget(#IPAddress, 90, 5, 115, 20)
      TextGadget(#with_the_Port_Con, 210, 10, 65, 15, "with the Port :")
      StringGadget(#Port_Con, 275, 5, 40, 20, "", #PB_String_Numeric)
      SetGadgetText(#Port_Con,"6499")
      SendMessage_(GadgetID(#Port_Con), #EM_LIMITTEXT, 5, 0)
      ButtonGadget(#Conect, 5, 5, 50, 20, "Conect")
      TextGadget(#or, 320, 10, 15, 15, "or")
      ButtonGadget(#Create_Server, 335, 5, 75, 20, "Create Server")
      TextGadget(#with_the_Port_Ser, 415, 10, 65, 15, "with the Port :")
      StringGadget(#Port_Ser, 480, 5, 40, 20, "", #PB_String_Numeric)
      SetGadgetText(#Port_Ser,"6499")
      SendMessage_(GadgetID(#Port_Ser), #EM_LIMITTEXT, 5, 0)
      ButtonGadget(#Join, 5, 25, 35, 20, "Join")
      TextGadget(#the_Chat_with_the_nick_mame, 45, 30, 140, 15, "the Chat with the nick mame :")
      StringGadget(#Nick, 190, 25, 95, 20, "")
      SendMessage_(GadgetID(#Nick), #EM_LIMITTEXT, 12, 0)
      ListViewGadget(#Chat, 5, 45, 515, 385)
      LoadFont(0, "Lucida Console", 8, #PB_Font_Underline)
      SetGadgetFont(#Chat, FontID())
      StringGadget(#Text, 5, 430, 420, 20, "")
      SetGadgetFont(#Text, FontID())
      ButtonGadget(#Send, 425, 430, 95, 20, "Send")
      ;ButtonGadget(#Klappe, 500, 430, 20, 20, "\/")
      ProcedureReturn 1
    Else
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
Procedure WindProc()
  Nick.s = ""
  InitNetwork()
  Open_Main_Window()
  AddKeyboardShortcut(#Main_Window, #PB_Shortcut_Return, 757) 
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case #Conect 
            If ClientThreadID = 0
              ClientThreadID = CreateThread(@ClientProc(), 0)
            Else
              If MessageRequester("JLALC - Message","You would to left the server?",#PB_MessageRequester_YesNo) = 6
                KillThread(ClientThreadID)
                ClientThreadID = CreateThread(@ClientProc(), 0)
              EndIf
            EndIf
          Case #Create_Server 
            If ServerThreadID = 0
              ServerThreadID = CreateThread(@ServerProc(), 0)
            Else
              If MessageRequester("JLALC - Message","You would to close the server?",#PB_MessageRequester_YesNo) = 6
                KillThread(ServerThreadID)
                ServerThreadID = CreateThread(@ServerProc(), 0)
              EndIf
            EndIf
          Case #Send
            If ServerThreadID <> 0
              If LTrim(GetGadgetText(#Text)) <> ""
                If Nick <> ""
                  AddGadgetItem(#Chat, -1,FormatDate("%hh:%ii:%ss", Date())+" < "+Nick+" >"+GetGadgetText(#Text))
                  SetGadgetState(#Chat, CountGadgetItems(#Chat)-1)
                  SendToAll(FormatDate("%hh:%ii:%ss", Date())+" < "+Nick+" >"+GetGadgetText(#Text))
                  SetGadgetText(#Text, "")
                Else
                  MessageRequester("JLALC - Message", "You are Donn't has Send your Nick name")
                EndIf
              Else
                MessageRequester("JLALC - Message", "Please write a Text")
              EndIf
            ElseIf ClientThreadID <> 0
              If LTrim(GetGadgetText(#Text)) <> ""
                If Nick <> ""
                  SendNetworkString(ConID, Nick+" >"+GetGadgetText(#Text))
                  SetGadgetText(#Text, "")
                Else
                  MessageRequester("JLALC - Message", "You are Donn't has Send your Nick name")
                EndIf
              Else
                MessageRequester("JLALC - Message", "Please write a Text")
              EndIf
            Else
              MessageRequester("JLALC - Message", "You are Donn't Connect to a Server")
            EndIf
          Case #Join
            If ServerThreadID <> 0
              If GetGadgetText(#Nick) <> ""
                Nick = GetGadgetText(#Nick)
                MessageRequester("JLALC - Message", "Your Nick is "+GetGadgetText(#Nick))
              Else
                MessageRequester("JLALC - Message", "Please write a Text into thx Nick gadget")
              EndIf
            ElseIf ClientThreadID <> 0
              If GetGadgetText(#Nick) <> ""
                Nick = GetGadgetText(#Nick)
                MessageRequester("JLALC - Message", "Your Nick is "+GetGadgetText(#Nick))
              Else
                MessageRequester("JLALC - Message", "Please write a Text into thx Nick gadget")
              EndIf
            EndIf
        EndSelect
      Case #PB_Event_Menu 
        If EventMenuID() = 757      
          If ServerThreadID <> 0 And LTrim(GetGadgetText(#Text)) <> "" And Nick <> ""
            AddGadgetItem(#Chat, -1,FormatDate("%hh:%ii:%ss", Date())+" < "+Nick+" >"+GetGadgetText(#Text))
            SetGadgetState(#Chat, CountGadgetItems(#Chat)-1)
            SendToAll(FormatDate("%hh:%ii:%ss", Date())+" < "+Nick+" >"+GetGadgetText(#Text))
            SetGadgetText(#Text, "")
          ElseIf ClientThreadID <> 0 And LTrim(GetGadgetText(#Text)) <> "" And Nick <> ""
            SendNetworkString(ConID, Nick+" >"+GetGadgetText(#Text))
            SetGadgetText(#Text, "")
          EndIf
        EndIf
      Case #PB_Event_CloseWindow : End
    EndSelect
  ForEver
EndProcedure

WindProc()
;-------------------------------------
Procedure ClientProc()
  ConID = OpenNetworkConnection(GetGadgetText(#IPAddress), Val(GetGadgetText(#Port_Con)))
  If ConID
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| The "+Chr($93)+"Just Like A Lan Chat"+Chr($94)+" Client                        ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| Version: 0.1b                                            ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| Copyright © 2005 by IcedCoffee                           ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, " The Time is "+FormatDate("%hh:%ii:%ss", Date())+"                                             ")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "")
    Repeat
      Select NetworkClientEvent(ConID)
        Case 0 : Delay(5)
        Case 2
          AddGadgetItem(#Chat, -1, ReceiveNetworkString(ConID))
          SetGadgetState(#Chat, CountGadgetItems(#Chat)-1)
      EndSelect
    ForEver
  Else
    MessageRequester("JLALC - Error", "Cann't OpenNetworkConnection()")
    ClientThreadID = 0
  EndIf
EndProcedure

Procedure ServerProc()
  NetworkString.s
  If CreateNetworkServer(Val(GetGadgetText(#Port_Ser)))
    MessageRequester("JLALC - Message", "You have create a Network Server")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| The "+Chr($93)+"Just Like A Lan Chat"+Chr($94)+" Client                        ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| Version: 0.1b                                            ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "|||| Copyright © 2005 by IcedCoffee                           ||||")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, " The Server IP: "+GetMyIP()+"                                     ")
    AddGadgetItem(#Chat, -1, " The Server Port: "+GetGadgetText(#Port_Ser)+"                                            ")
    AddGadgetItem(#Chat, -1, " The Time is "+FormatDate("%hh:%ii:%ss", Date())+"                                             ")
    AddGadgetItem(#Chat, -1, " -----------------------------------------------------------------")
    AddGadgetItem(#Chat, -1, "")
    Repeat
      Select NetworkServerEvent()
        Case 0 : Delay(2)
        Case 1
          AddElement(SerClients())
          SerClients()\ClientID = NetworkClientID()
          SerClients()\ClientIP = GetIPbyClientID(SerClients()\ClientID)
          AddGadgetItem(#Chat, -1, "> New Client (IP:"+SerClients()\ClientIP+" ID:"+Str(SerClients()\ClientID)+")")
          SendToAll("> New Client (IP:"+SerClients()\ClientIP+" ID:"+Str(SerClients()\ClientID)+")")
        Case 2
          NetworkString = ReceiveNetworkString(NetworkClientID())
          AddGadgetItem(#Chat, -1,FormatDate("%hh:%ii:%ss", Date())+" < "+NetworkString)
          SendToAll(FormatDate("%hh:%ii:%ss", Date())+" < "+NetworkString)
        Case 4
          ClientID = NetworkClientID()
          ResetList(SerClients())
          While NextElement(SerClients())
            If SerClients()\ClientID = ClientID
              AddGadgetItem(#Chat, -1, "> Client left (IP:"+SerClients()\ClientIP+" ID:"+Str(SerClients()\ClientID)+")")
              SetGadgetState(#Chat, CountGadgetItems(#Chat)-1)
              SendToAll("> Client left (IP:"+SerClients()\ClientIP+" ID:"+Str(SerClients()\ClientID)+")")
              DeleteElement(SerClients())
              Break
            EndIf
          Wend 
      EndSelect
    ForEver
  Else
    MessageRequester("JLALC - Error", "Cann't CreateNetworkServer("+GetGadgetText(#Port_Ser)+")")
    ServerThreadID = 0
  EndIf
EndProcedure
;-------------------------------------
Procedure.s GetMyIP()
  Structure IPINFO
    dwAddr.l
    dwIndex.l
    dwBCastAddr.l
    dwReasmSize.l
    unused1.l
    unused2.l
  EndStructure
  Structure MIB_IPADDRTABLE
    dwEntries.l
    mIPInfo.IPINFO[2]
  EndStructure
  
  Ret.l
  GetIpAddrTable_(0 , @Ret, 0)
  GetIpAddrTable_(@IpTable.MIB_IPADDRTABLE , @Ret, 1)
  ProcedureReturn IPString(IpTable\mIPInfo[1]\dwAddr)
EndProcedure
Procedure.s GetIPbyClientID(ClientID)
  Structure IPType
    Reserved.w
    Port.w
    StructureUnion
      IPLong.l
      IP.b[4]
    EndStructureUnion
    Zeros.l[2]
  EndStructure
  
  remotip.s
  s = SizeOf(IPType)
  res = getpeername_(ClientID, @IP.IPType, @s)
  If res = 0
    remotip = StrU(IP\IP[0], #Byte)+"."+StrU(IP\IP[1], #Byte)+"."+StrU(IP\IP[2], #Byte)+"."+StrU(IP\IP[3], #Byte)
  Else
    remotip = ""
  EndIf
  ProcedureReturn remotip
EndProcedure
Procedure SendToAll(Text.s)
  ResetList(SerClients())
  While NextElement(SerClients())
    SendNetworkString(SerClients()\ClientID, Text)
  Wend
EndProcedure

Procedure.s ReceiveNetworkString(ClientID)
  Protected Puffergroesse.l, *MemoryID.l, Laenge.l, Temp.s
  Puffergroesse = 8192
  *MemoryID = AllocateMemory(Puffergroesse)
  If *MemoryID
    Repeat
      Laenge = ReceiveNetworkData(ClientID, *MemoryID, Puffergroesse)
      Temp + PeekS(*MemoryID, Puffergroesse)
    Until Laenge < Puffergroesse
    FreeMemory(*MemoryID)
  EndIf
  ProcedureReturn Temp
EndProcedure
[das müssten 304 Zeilen sein]

jo das ist mein werk. zwei tage arbeit. und immer noch nicht das geschafft was ich schaffen wollte

aber egal ich nuss jetzt ins internat und wollte das ding vorher noch veröffentlichen
also ich hatte auch leider noch keine zeit das ding in eine gute English form zu bringen aber vll kan mir einer die arbeit abnehmen [plz]

errors bitte malden!!! da das program nächste woche im schulnetz eingesetzt wird
[wenn kaputt geht bin ich dran schuld]
glubschi90
Beiträge: 274
Registriert: 04.09.2004 01:43
Wohnort: Würzburg

Beitrag von glubschi90 »

Nachdem ich einen Server sertsllt habe und ich die MessageBNox weggeklickt habe...

Invalid Memory-Adress at line 85...
da ist aber nix mit Memory...
(Der Debugger halt... :| )

Hab auch keine Zeit jetzt nach dem Fehler zu suchen, wollte's nur sagen :wink: :)
PureBasic 4.30
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Invalid Memory-Adress at line 85...
Wo denn? Bei mir kommt kein Error!

Der einzige fehler ist, ich erstelle einen Server und connecte auf mcih selbst drauf! (Connect to 127.0.0.1)

Wenn ich das Programm ein 2. Mal aufmache und übers Netzwerk reinkommen will gehts nicht!

Cant OpenNetworkConnection (oder so)

wenn kaputt geht bin ich dran schuld
kaputtmachen kannst du eigentlich nichts, es sei denn du löschst mit PB mutwillig Dateien oder so..
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
IcedCoffee
Beiträge: 115
Registriert: 09.07.2005 12:11
Wohnort: Fürstenwald [Internat], Berlin[wen keine lust auf Internat], Wildau[Einfamilienhaus]
Kontaktdaten:

Beitrag von IcedCoffee »

Der einzige fehler ist, ich erstelle einen Server und connecte auf mcih selbst drauf!
THX
bei mir kommt zwar kein error aber das muss ich auch noch weg machen
also so das es nicht geht weil eigentlch ist das ja sin loss :-]

kaputtmachen kannst du eigentlich nichts
ja eigentlich
ich beschweifel ja auch das ich da was kaputt mache
aber wen dan ist der lehrer sauer weil er hat das netz eingerichtet und das hat angeblich viel arbeit gemacht [glaube ich auch [viele gute sachen sind deaktivirt]]
IcedCoffee
Beiträge: 115
Registriert: 09.07.2005 12:11
Wohnort: Fürstenwald [Internat], Berlin[wen keine lust auf Internat], Wildau[Einfamilienhaus]
Kontaktdaten:

Beitrag von IcedCoffee »

Moin

ich habe das proggram jetzt getestet und habe ein problem
ich bekomme mein IP nicht mit GetMyIP()
also müsste das problem an der funktion GetIpAddrTable() ligen
und das tut es auch also ich habe hier ein Win2000 SP4
und das OS unterstützt die funktion nicht

also kann mir einer dem gefallen tun und das program noch mal mit ExamineIPAddresses() und NextIPAddress() "Kompilieren" und auf eine webspace hoch laden [plz plz]
Antworten