Posted: Mon Jun 26, 2006 7:23 am
I disagree. The team has fixed hundreds of bugs since PB v4.0 beta 1 was released, and they continue to fix them as they arise. Often, when bugs are reported and you never see a "fixed." reply, it's because the problem was a result of weak coding and not a flaw in PureBasic.Anden wrote:Sorry, but posting a bug report is like yelling in a black hole in this case ...
Try the following example, which sets up four server ports on four threads and sends the position of a different colored dot on each port. The server-window dots move with the mouse, and all four dots on the client window read their position from the network. If you notice something strange happening, be sure to let me know:Anden wrote:Multithreading/Multiconnections are not really possible (strange things will happen if you try)
Code: Select all
; Program 1 - Run this first
;
; Then run program 2
;
; Then click in this program's window and move the mouse around
Global FirstPort = 6832
InitSprite():InitMouse()
Structure mousemessage
x.l
y.l
send.l
EndStructure
Global Dim connection(4)
Global Dim *mousemsg.mousemessage(4)
Procedure SendMouse1(thread) ; sends the red dot
Repeat
If *mousemsg(thread)\send
*mousemsg(thread)\x = MouseX()
*mousemsg(thread)\y = MouseY()
If connection(thread)
SendNetworkData(connection(1), *mousemsg(thread), 512)
*mousemsg(thread)\send = #False
EndIf
Else
Delay(1)
EndIf
ForEver
EndProcedure
Procedure SendMouse2(thread) ; sends the green dot
Repeat
If *mousemsg(thread)\send
*mousemsg(thread)\x = MouseX()+32
*mousemsg(thread)\y = MouseY()
If connection(thread)
SendNetworkData(connection(thread), *mousemsg(thread), 512)
*mousemsg(thread)\send = #False
EndIf
Else
Delay(1)
EndIf
ForEver
EndProcedure
Procedure SendMouse3(thread) ; sends the yellow dot
Repeat
If *mousemsg(thread)\send
*mousemsg(thread)\x = MouseX()
*mousemsg(thread)\y = MouseY()+32
If connection(thread)
SendNetworkData(connection(thread), *mousemsg(thread), 512)
*mousemsg(thread)\send = #False
EndIf
Else
Delay(1)
EndIf
ForEver
EndProcedure
Procedure SendMouse4(thread) ; sends the blue dot
Repeat
If *mousemsg(thread)\send
*mousemsg(thread)\x = MouseX()+32
*mousemsg(thread)\y = MouseY()+32
If connection(thread)
SendNetworkData(connection(thread), *mousemsg(thread), 512)
*mousemsg(thread)\send = #False
EndIf
Else
Delay(1)
EndIf
ForEver
EndProcedure
screencolor = GetSysColor_(#COLOR_BTNFACE)
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0)
End
EndIf
If CreateNetworkServer(1, FirstPort) And CreateNetworkServer(2, FirstPort+1) And CreateNetworkServer(3, FirstPort+2) And CreateNetworkServer(4, FirstPort+3)
OpenWindow(0,0,200,500,500,"Right-clicking this window ends both programs...")
StickyWindow(0,1)
OpenWindowedScreen(WindowID(0),0,0,500,500,0,0,0)
Dim clr(4):clr(1)=#Red:clr(2)=#Green:clr(3)=#Yellow:clr(4)=#Blue
For i = 1 To 4
CreateSprite(i,32,32)
StartDrawing(SpriteOutput(i))
Box(0,0,32,32,screencolor)
Circle(15,15,16,clr(i))
StopDrawing()
Next
ClearScreen(screencolor)
StartDrawing(ScreenOutput())
DrawText(180,245,"Run the client now...",#Black,screencolor)
StopDrawing()
FlipBuffers()
cc=0
While cc < 4
SEvent = NetworkServerEvent()
If SEvent = 1
cc+1
connection(cc) = EventClient()
EndIf
If WaitWindowEvent(1) = #WM_RBUTTONDOWN
End
EndIf
Wend
For i=1 To 4 : *mousemsg(i) = AllocateMemory(512) : Next
CreateThread(@SendMouse1(), 1)
CreateThread(@SendMouse2(), 2)
CreateThread(@SendMouse3(), 3)
CreateThread(@SendMouse4(), 4)
Repeat
While WindowEvent():Wend
ClearScreen(screencolor)
ExamineMouse()
If MouseDeltaX() Or MouseDeltaY()
For i = 1 To 4
*mousemsg(i)\send = #True
*mousemsg(i)\x = MouseX()
*mousemsg(i)\y = MouseY()
Next
EndIf
DisplaySprite(1,MouseX(),MouseY())
DisplaySprite(2,MouseX()+32,MouseY())
DisplaySprite(3,MouseX(),MouseY()+32)
DisplaySprite(4,MouseX()+32,MouseY()+32)
FlipBuffers()
If MouseButton(#PB_MouseButton_Right)
quit=1
EndIf
Delay(1)
Until Quit
killmsg.l = 999
SendNetworkData(connection(1), @killmsg, 512)
Else
MessageRequester("Error", "Can't create the servers! (ports in use ?)")
EndIf
EndCode: Select all
If FindWindow_(0,"Right-clicking this window ends both programs...") = 0
MessageRequester("OOPS!","Run the server program first please",0)
End
EndIf
Global FirstPort = 6832
Global Dim Connection(4)
If InitNetwork()=0 Or InitSprite()=0
MessageRequester("Error", "Can't run the program", 0)
End
EndIf
Global Dim sprite.Point(4)
Global *buffer = AllocateMemory(512)
Global *mousemsg.point = *buffer
sprite(1)\x = 0 : sprite(1)\y = 0
sprite(2)\x = 32 : sprite(2)\y = 0
sprite(3)\x = 0 : sprite(3)\y = 32
sprite(4)\x = 32 : sprite(4)\y = 32
For i = 1 To 4
While Not connection(i)
Connection(i) = OpenNetworkConnection("127.0.0.1", FirstPort-1 + i)
Delay(1)
Wend
Next
OpenWindow(0,550,200,500,500,"Click in the first window, then move the mouse around...")
OpenWindowedScreen(WindowID(0),0,0,500,500,0,0,0)
Dim clr(4):clr(1)=#Red:clr(2)=#Green:clr(3)=#Yellow:clr(4)=#Blue
For i = 1 To 4
CreateSprite(i,32,32)
StartDrawing(SpriteOutput(i))
Box(0,0,32,32,GetSysColor_(#COLOR_BTNFACE))
Circle(15,15,16,clr(i))
StopDrawing()
Next
Repeat
While WindowEvent():Wend
delaying=#True ; only delay if no network events to deal with
For i = 1 To 4
If NetworkClientEvent(Connection(i)) = #PB_NetworkEvent_Data
result=ReceiveNetworkData(Connection(i), *buffer, 512)
If PeekL(*buffer)=999 : End : EndIf
sprite(i)\x = *mousemsg\x
sprite(i)\y = *mousemsg\y
delaying=#False
EndIf
Next
ClearScreen(GetSysColor_(#COLOR_BTNFACE))
For i=1 To 4 : DisplaySprite(i,sprite(i)\x,sprite(i)\y) : Next
FlipBuffers()
If delaying
Delay(1)
EndIf
Until quit
End 
)
), that seems to be reliable for machines with 512 MB main memory installed (and Win 2k/XP).