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
EndProcedurejo 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]