- How to connect the two computers (OLD and NEW) after booting the old notebook (bluetooth seems to be complicated, but using WLAN should be a simple job as both computers are in the same network segment)
- Using a hotkey on the NEW computer toogles between standard behaviour of mouse and keyboard and controlling the remote notebook
- The latter mode needs to scan all keyboard and mouse activities (on the NEW computer)...
- ...and suppress all inputs for the NEW computer and simulate them on the OLD computer
Keyboard & Mouse control
-
Michael Vogel
- Addict
- Posts: 2799
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Keyboard & Mouse control
My old notebook's keyboard is broken and I start thinking to control it using the keyboard of another notebook. Using a program like VNC does not work as expected (horrible video quality and refresh rate). So what about using Purebasic to do that job anyhow there are many questions now...
Re: Keyboard & Mouse control
You can check this: viewtopic.php?t=86113&hilit=remote
-
Michael Vogel
- Addict
- Posts: 2799
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Keyboard & Mouse control
Thanks, will have a look...
My first start are the following two pieces of code (the 'server' for my old notebook with the non working keyboard, the 'client' for the new one):
The client should automatically connect to the server and can switch between active and passive mode (tested only on one PC so maybe it doesn't work with two PC's). And there's no code for controlling the mouse and keyboard for now.
My first start are the following two pieces of code (the 'server' for my old notebook with the non working keyboard, the 'client' for the new one):
The client should automatically connect to the server and can switch between active and passive mode (tested only on one PC so maybe it doesn't work with two PC's). And there's no code for controlling the mouse and keyboard for now.
Code: Select all
; Define Server
#ApplicationTitle="·MYSVR·"
EnableExplicit
Structure AppType
Window.i
Icon.i; Network State
IconSize.i
IconArcs.i
DpiScale.i
ConnectionIn.i
ConnectionOut.i
PartnerIP.i
PartnerX.i
PartnerY.i
Quit.i
Retry.i
EndStructure
Global App.AppType
Enumeration
#SysTray
#Window
#Icon
#Font
#PopupMenu
#PopupQuit
EndEnumeration
; EndDefine
; Define Include Network & More
#ServerID= #Null
#ServerPort= 5004
#ClientPort= 5005
Structure ValueType
A.l
B.l
C.l
D.l
EndStructure
Structure MessageType
Type.l
StructureUnion
Record.l[4]
Values.ValueType
EndStructureUnion
Magic.l
EndStructure
Global Message.MessageType
#Magic=$12345678
Enumeration
#CmdUnknown
#CmdGetIP
#CmdSetIP
#CmdSetPassive
#CmdSetActive
#CmdMouseXY
#CmdMouseButton
#CmdKey
EndEnumeration
Enumeration
#StateNoNetwork
#StateIdle
#StateConnected
#StateActive
EndEnumeration
#Ticker= 5
#RepeatTimer= 1500; 15000 ~ 60s
#Undefined= -#True
#DpiBits= 12+SizeOf(Integer)
#DpiScale= 1<<#DpiBits
#DrawOpaque= $FF000000
#DrawMilky= $80000000
#DarkRed= $0000A0
#NiceGray= $D0D0D0
#NiceGreen= $35A77C
#NiceBlue= $D3C985
CompilerIf #PB_Compiler_Version>=600
Macro InitNetwork()
#True
EndMacro
CompilerEndIf
; EndDefine
Procedure ScaleUp(value)
ProcedureReturn (((value)*App\DpiScale)/#DpiScale)
EndProcedure
Procedure SysTrayIcon(mode)
Protected.s s,t
Protected.i ct,cb
With App
If \DpiScale=#Null
\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
\IconSize=ScaleUp(20)
\IconArcs=ScaleUp(3)
LoadFont(#Font,"Segoe UI",\IconSize*0.55,#PB_Font_Bold)
CreateImage(#Icon,\IconSize,\IconSize,32)
\Icon=#Undefined
EndIf
If mode<>\Icon
StartDrawing(ImageOutput(#Icon))
ct=#White
Select mode
Case #StateNoNetwork
ct=#Black
cb=#NiceGray
s="X"
t="No Network"
Case #StateIdle
ct=#Black
cb=#NiceBlue
s="I"
t="Idle"
Case #StateConnected
cb=#NiceGreen
s="C"
t="Connected"
Case #StateActive
cb=#DarkRed
s="A"
t="Active"
EndSelect
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,\IconSize,\IconSize,#Null)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawOpaque|cb)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_AlphaBlend)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawMilky)
DrawingFont(FontID(#Font))
DrawText((\IconSize-TextWidth(s))/2,(\IconSize-TextHeight(s)*1.1)/2,s,#DrawOpaque|ct,#Null)
StopDrawing()
If \Icon=#Undefined
AddSysTrayIcon(#SysTray,\Window,ImageID(#Icon))
Else
ChangeSysTrayIcon(#SysTray,ImageID(#Icon))
EndIf
SysTrayIconToolTip(#SysTray,"MyServer by Michael Vogel - "+t)
\Icon=mode
EndIf
EndWith
EndProcedure
Procedure InitServer()
If initNetwork()
If CreateNetworkServer(#ServerID,#ServerPort,#PB_Network_UDP)
SysTrayIcon(#StateIdle)
ProcedureReturn #True
EndIf
EndIf
App\Retry=#RepeatTimer/#Ticker
ProcedureReturn #Null
EndProcedure
Procedure ReadMessage()
With App
Message\Magic=#Null
ReceiveNetworkData(\ConnectionIn,@Message,SizeOf(Message))
ProcedureReturn Bool(Message\Magic=#Magic)
EndWith
EndProcedure
Procedure SendMessage(type,*Value.ValueType)
With App
If \ConnectionOut
Message\Type=type
If *Value
CopyMemory(*Value,@Message\Values,SizeOf(ValueType))
Else
FillMemory(@Message\Values,SizeOf(ValueType),#Null,#PB_Long)
EndIf
Message\Magic=#Magic
ProcedureReturn Bool(SendNetworkData(\ConnectionOut,@Message,SizeOf(Message))>=0)
Else
ProcedureReturn #Null
EndIf
EndWith
EndProcedure
; End of Include Network & More
Procedure Main()
With App
If FindWindow_(0,#ApplicationTitle)=0
\Window=OpenWindow(#Window,0,0,0,0,#ApplicationTitle,#PB_Window_Invisible)
AddWindowTimer(#Window,#Null,#Ticker)
SysTrayIcon(#StateNoNetwork)
CreatePopupMenu(#PopupMenu)
MenuItem(#PopupQuit,"Quit 'MyServer'...")
InitServer()
Repeat
Select WaitWindowEvent()
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_LeftDoubleClick
Case #PB_EventType_RightClick
\Quit=#True
Case #PB_EventType_LeftClick
DisplayPopupMenu(#PopupMenu,\Window)
EndSelect
Case #PB_Event_Timer
Select \Icon
Case #StateNoNetwork
If \Retry
\Retry-1
If \Retry=#Null
InitServer()
EndIf
EndIf
EndSelect
Case #PB_Event_Menu;#PB_Event_Gadget
Select EventGadget()
Case #PopupQuit
\Quit=#True
EndSelect
EndSelect
Select NetworkServerEvent(#ServerID)
Case #PB_NetworkEvent_Connect
Debug "CONN (never happens)"
Case #PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
Debug "MESS "+Str(Message\Type)+" "+Hex(Message\Values\A)+"."+Hex(Message\Values\B)+"."+Hex(Message\Values\C)+"."+Hex(Message\Values\D)
Select Message\Type
Case #CmdGetIP
\PartnerIP=GetClientIP(\ConnectionIn)
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ClientPort,#PB_Network_UDP)
If SendMessage(#CmdSetIP,#Null)
SysTrayIcon(#StateConnected)
EndIf
Case #CmdSetActive
\PartnerX=Message\Values\A
\PartnerY=Message\Values\B
SysTrayIcon(#StateActive)
Case #CmdSetPassive
SysTrayIcon(#StateConnected)
Case #CmdMouseXY
Debug "MOUSE "+Str(Message\Values\A)+" | "+Str(Message\Values\B)
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
Debug "DISC (never happens)"
EndSelect
Until \Quit
EndIf
EndWith
EndProcedure
Main()
Code: Select all
; Define Client
EnableExplicit
#ApplicationTitle="·MYCLT·"
#MonCode= 666
#MonControl= #MOD_CONTROL|#MOD_SHIFT
#MonKey= #VK_K
Structure AppType
Window.i
Icon.i; Network State
IconSize.i
IconArcs.i
DpiScale.i
ConnectionIn.i
ConnectionOut.i
PartnerIP.i
MouseX.i
MouseY.i
MouseButton.i
Quit.i
Retry.i
EndStructure
Global App.AppType
Enumeration
#SysTray
#Window
#Icon
#Font
#PopupMenu
#PopupToggle
#PopupQuit
EndEnumeration
; EndDefine
; Define Include Network & More
;#ServerID= #Null
#ServerPort= 5004
#ClientID= #Null
#ClientPort= 5005
Structure ValueType
A.l
B.l
C.l
D.l
EndStructure
Structure MessageType
Type.l
StructureUnion
Record.l[4]
Values.ValueType
EndStructureUnion
Magic.l
EndStructure
Global Message.MessageType
Global Value.ValueType
#Magic=$12345678
Enumeration
#CmdUnknown
#CmdGetIP
#CmdSetIP
#CmdSetPassive
#CmdSetActive
#CmdMouseXY
#CmdMouseButton
#CmdKey
EndEnumeration
Enumeration
#StateNoNetwork
#StateIdle
#StateConnected
#StateActive
EndEnumeration
#Ticker= 5
#RepeatTimer= 1500; 15000 ~ 60s
#Undefined= -#True
#DpiBits= 12+SizeOf(Integer)
#DpiScale= 1<<#DpiBits
#DrawOpaque= $FF000000
#DrawMilky= $80000000
#DarkRed= $0000A0
#NiceGray= $D0D0D0
#NiceGreen= $35A77C
#NiceBlue= $D3C985
CompilerIf #PB_Compiler_Version>=600
Macro InitNetwork()
#True
EndMacro
CompilerEndIf
Declare ReadMessage()
; EndDefine
Procedure ScaleUp(value)
ProcedureReturn (((value)*App\DpiScale)/#DpiScale)
EndProcedure
Procedure SysTrayIcon(mode)
Protected.s s,t
Protected.i ct,cb
With App
If \DpiScale=#Null
\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
\IconSize=ScaleUp(20)
\IconArcs=ScaleUp(3)
LoadFont(#Font,"Segoe UI",\IconSize*0.55,#PB_Font_Bold)
CreateImage(#Icon,\IconSize,\IconSize,32)
\Icon=#Undefined
EndIf
If mode<>\Icon
StartDrawing(ImageOutput(#Icon))
ct=#White
Select mode
Case #StateNoNetwork
ct=#Black
cb=#NiceGray
s="X"
t="No Network"
Case #StateIdle
ct=#Black
cb=#NiceBlue
s="N"
t="Not connected"
Case #StateConnected
cb=#NiceGreen
s="C"
t="Connected"
Case #StateActive
cb=#DarkRed
s="A"
t="Active"
EndSelect
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,\IconSize,\IconSize,#Null)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawOpaque|cb)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_AlphaBlend)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawMilky)
DrawingFont(FontID(#Font))
DrawText((\IconSize-TextWidth(s))/2,(\IconSize-TextHeight(s)*1.1)/2,s,#DrawOpaque|ct,#Null)
StopDrawing()
If \Icon=#Undefined
AddSysTrayIcon(#SysTray,\Window,ImageID(#Icon))
Else
ChangeSysTrayIcon(#SysTray,ImageID(#Icon))
EndIf
SysTrayIconToolTip(#SysTray,"My Client by Michael Vogel - "+t)
\Icon=mode
EndIf
EndWith
EndProcedure
Procedure SendUDPBroadcast(type,port)
Protected sock,one,bytes
Protected remote.sockaddr_in
sock=socket_(#AF_INET,#SOCK_DGRAM,#IPPROTO_IP)
If (sock=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
one=1
If (setsockopt_(sock,#SOL_SOCKET,#SO_BROADCAST,@one,SizeOf(one))=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
remote\sin_family=#AF_INET
remote\sin_port=htons_(port)
remote\sin_addr=#INADDR_BROADCAST
Message\Type=type
Message\Magic=#Magic
If (sendto_(sock,@Message,SizeOf(Message),0,@remote,SizeOf(remote))=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
closesocket_(sock)
ProcedureReturn #True
EndProcedure
Procedure InitServer()
If initNetwork()
If CreateNetworkServer(#ClientID,#ClientPort,#PB_Network_UDP)
SysTrayIcon(#StateIdle)
App\Retry=10
ProcedureReturn #True
EndIf
EndIf
App\Retry=#RepeatTimer/#Ticker
ProcedureReturn #Null
EndProcedure
Procedure InitConnection()
Protected timer
With App
If SendUDPBroadcast(#CmdGetIP,#ServerPort)
timer=GetTickCount_()+2000
Repeat
Delay(#Ticker)
If NetworkServerEvent()=#PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
If Message\Type=#CmdSetIP
\PartnerIP=GetClientIP(\ConnectionIn)
SysTrayIcon(#StateConnected)
DisableMenuItem(#PopupMenu,#PopupToggle,#Null)
ProcedureReturn #True
EndIf
EndIf
EndIf
Until GetTickCount_()>timer
EndIf
App\Retry=#RepeatTimer/#Ticker
EndWith
EndProcedure
Procedure ReadMessage()
With App
Message\Magic=#Null
ReceiveNetworkData(\ConnectionIn,@Message,SizeOf(Message))
ProcedureReturn Bool(Message\Magic=#Magic)
EndWith
EndProcedure
Procedure SendMessage(type,*Value.ValueType)
With App
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ServerPort,#PB_Network_UDP)
If \ConnectionOut
Message\Type=type
If *Value
CopyMemory(*Value,@Message\Values,SizeOf(ValueType))
Else
FillMemory(@Message\Values,SizeOf(ValueType),#Null,#PB_Long)
EndIf
Message\Magic=#Magic
ProcedureReturn Bool(SendNetworkData(\ConnectionOut,@Message,SizeOf(Message))>=0)
Else
ProcedureReturn #Null
EndIf
EndWith
EndProcedure
; End of Include Network & More
Procedure ToggleMode()
With App
Select \Icon
Case #StateConnected
Value\A=GetSystemMetrics_(#SM_CXSCREEN)
Value\B=GetSystemMetrics_(#SM_CYSCREEN)
Value\C=0
Value\D=0
If SendMessage(#CmdSetActive,@Value)
SysTrayIcon(#StateActive)
EndIf
Case #StateActive
If SendMessage(#CmdSetPassive,#Null)
SysTrayIcon(#StateConnected)
\MouseX=#Undefined
\MouseY=#Undefined
\MouseButton=#Undefined
EndIf
EndSelect
EndWith
EndProcedure
Procedure Main()
Protected Cursor.Point
With App
If FindWindow_(0,#ApplicationTitle)=0
\MouseX=#Undefined
\MouseY=#Undefined
\MouseButton=#Undefined
\Window=OpenWindow(#Window,0,0,0,0,#ApplicationTitle,#PB_Window_Invisible)
RegisterHotKey_(\Window,#MonCode,#MonControl,#MonKey)
AddWindowTimer(#Window,#Null,#Ticker)
SysTrayIcon(#StateNoNetwork)
CreatePopupMenu(#PopupMenu)
MenuItem(#PopupToggle,"Toggle Control"+#TAB$+"***")
MenuBar()
MenuItem(#PopupQuit,"Quit 'MyClient'...")
DisableMenuItem(#PopupMenu,#PopupToggle,#True)
InitServer()
Repeat
Select WaitWindowEvent()
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_LeftDoubleClick
Case #PB_EventType_RightClick
\Quit=#True
Case #PB_EventType_LeftClick
DisplayPopupMenu(#PopupMenu,\Window)
EndSelect
Case #PB_Event_Timer
Select \Icon
Case #StateNoNetwork,#StateIdle
If \Retry
\Retry-1
If \Retry=#Null
If \Icon=#StateNoNetwork
InitServer()
Else
InitConnection()
EndIf
EndIf
EndIf
EndSelect
Case #PB_Event_Menu;#PB_Event_Gadget
Select EventGadget()
Case #PopupToggle
ToggleMode()
Case #PopupQuit
\Quit=#True
EndSelect
Case #WM_HOTKEY
If EventwParam()=#MonCode
ToggleMode()
EndIf
EndSelect
If \Icon=#StateActive
GetCursorPos_(@Cursor)
If \MouseX<>Cursor\x Or \MouseY<>Cursor\y
\MouseX=Cursor\x
\MouseY=Cursor\y
Value\A=Cursor\x
Value\B=Cursor\y
SendMessage(#CmdMouseXY,@Value)
EndIf
EndIf
Select NetworkServerEvent()
Case #PB_NetworkEvent_Connect
Debug "CONN (never happens)"
Case #PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
Debug "MESS "+Str(Message\Type)+" "+Hex(Message\Values\A)+"."+Hex(Message\Values\B)+"."+Hex(Message\Values\C)+"."+Hex(Message\Values\D)
Select Message\Type
Case #CmdGetIP
\PartnerIP=GetClientIP(\ConnectionIn)
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ServerPort,#PB_Network_UDP)
If SendMessage(#CmdSetIP,#Null)
SysTrayIcon(#StateConnected)
EndIf
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
Debug "DISC (never happens)"
EndSelect
Until \Quit
EndIf
EndWith
EndProcedure
Main()
Re: Keyboard & Mouse control
maybe I can give you an idea how to do Keyboard and mouse handling on the receiving Laptop.
Windows proivedes an API called SendInputs() which integrates the data into the Keyboard and mouse stream.f
seems to be a nice remote control Project!
(an other idea: just use an external Keyboard USB or BlueTooth)
Windows proivedes an API called SendInputs() which integrates the data into the Keyboard and mouse stream.f
seems to be a nice remote control Project!
(an other idea: just use an external Keyboard USB or BlueTooth)
Re: Keyboard & Mouse control
Hello Michael,
in case you also want to use an external program for this task, I can highly recommend the software "Input Director" https://inputdirector.com/.
It shares mouse and keyboard events across multiple computers on the network and has many other nice features.
I operate all my 3 computers with just one keyboard and mouse with this great software.
in case you also want to use an external program for this task, I can highly recommend the software "Input Director" https://inputdirector.com/.
It shares mouse and keyboard events across multiple computers on the network and has many other nice features.
I operate all my 3 computers with just one keyboard and mouse with this great software.
PB 6.12 x64, OS: Win 11 24H2 x64, Desktopscaling: 150%, CPU: I7 12700 H, RAM: 32 GB, GPU: Intel(R) Iris(R) Xe Graphics | NVIDIA GeForce RTX 3070, User age in 2025: 57y
"Happiness is a pet." | "Never run a changing system!"
"Happiness is a pet." | "Never run a changing system!"
-
Michael Vogel
- Addict
- Posts: 2799
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Keyboard & Mouse control
Thanks for all your replies, I was using an external keyboard but the different key layouts were making me small again 
The InputDirector is BRILLIANT so I don't need to continue working on my solution
Anyhow here's an updated code which can control the mouse cursor position. There's also a change in broadcasting because my notebook's network is not the primary interface (see \BroadcastAddress in the Client code which is used for address\sin_addr in the procedure SendUDPBroadcast).
The InputDirector is BRILLIANT so I don't need to continue working on my solution
Anyhow here's an updated code which can control the mouse cursor position. There's also a change in broadcasting because my notebook's network is not the primary interface (see \BroadcastAddress in the Client code which is used for address\sin_addr in the procedure SendUDPBroadcast).
Code: Select all
; Define Network Client
EnableExplicit
#ApplicationTitle="·MYCLT·"
#MonCode= 666
#MonControl= #MOD_CONTROL|#MOD_SHIFT
#MonKey= #VK_K
Structure AppType
Window.i
BroadcastAddress.s
Icon.i; Network State
IconSize.i
IconArcs.i
DpiScale.i
ConnectionIn.i
ConnectionOut.i
PartnerIP.i
MouseX.i
MouseY.i
MouseButton.i
WindowX.i
WindowY.i
Quit.i
Retry.i
DeadTimer.i
EndStructure
Global App.AppType
Enumeration
#SysTray
#Window
#Icon
#Font
#PopupMenu
#PopupToggle
#PopupQuit
EndEnumeration
; EndDefine
; Define Include Network & More
;#ServerID= #Null
#ServerPort= 5004
#ClientID= #Null
#ClientPort= 5005
Structure ValueType
A.l
B.l
C.l
D.l
EndStructure
Structure MessageType
Type.l
StructureUnion
Record.l[4]
Values.ValueType
EndStructureUnion
Magic.l
EndStructure
Global Message.MessageType
Global Value.ValueType
#Magic=$12345678
Enumeration
#CmdUnknown
#CmdImAlive
#CmdBreak
#CmdGetIP
#CmdSetIP
#CmdSetPassive
#CmdSetActive
#CmdMouseXY
#CmdMouseButton
#CmdKey
EndEnumeration
Enumeration
#StateNoNetwork
#StateIdle
#StateConnected
#StateActive
EndEnumeration
#Ticker= 5
#RepeatTimer= 5000/#Ticker; 5000 ~ 10s
#AliveTimer= 500/#Ticker
#DeadTimer= #AliveTimer*3
#Undefined= -#True
#DpiBits= 12+SizeOf(Integer)
#DpiScale= 1<<#DpiBits
#DrawOpaque= $FF000000
#DrawMilky= $80000000
#DarkRed= $0000A0
#NiceGray= $D0D0D0
#NiceGreen= $35A77C
#NiceBlue= $D3C985
CompilerIf #PB_Compiler_Version>=600
Macro InitNetwork()
#True
EndMacro
CompilerEndIf
Declare ReadMessage()
; EndDefine
Procedure ScaleUp(value)
ProcedureReturn (((value)*App\DpiScale)/#DpiScale)
EndProcedure
Procedure SysTrayIcon(mode)
Protected.s s,t
Protected.i ct,cb
With App
If \DpiScale=#Null
\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
\IconSize=ScaleUp(20)
\IconArcs=ScaleUp(3)
LoadFont(#Font,"Segoe UI",\IconSize*0.55,#PB_Font_Bold)
CreateImage(#Icon,\IconSize,\IconSize,32)
\Icon=#Undefined
EndIf
If mode<>\Icon
DisableMenuItem(#PopupMenu,#PopupToggle,Bool(mode<#StateConnected))
StartDrawing(ImageOutput(#Icon))
ct=#White
Select mode
Case #StateNoNetwork
ct=#Black
cb=#NiceGray
s="X"
t="No Network"
Case #StateIdle
ct=#Black
cb=#NiceBlue
s="N"
t="Not connected"
Case #StateConnected
cb=#NiceGreen
s="C"
t="Connected"
\DeadTimer=#DeadTimer
Case #StateActive
cb=#DarkRed
s="A"
t="Active"
\DeadTimer=#DeadTimer
EndSelect
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,\IconSize,\IconSize,#Null)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawOpaque|cb)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_AlphaBlend)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawMilky)
DrawingFont(FontID(#Font))
DrawText((\IconSize-TextWidth(s))/2,(\IconSize-TextHeight(s)*1.1)/2,s,#DrawOpaque|ct,#Null)
StopDrawing()
If \Icon=#Undefined
AddSysTrayIcon(#SysTray,\Window,ImageID(#Icon))
Else
ChangeSysTrayIcon(#SysTray,ImageID(#Icon))
EndIf
SysTrayIconToolTip(#SysTray,"My Client by Michael Vogel - "+t)
\Icon=mode
EndIf
EndWith
EndProcedure
Procedure SendUDPBroadcast(type,ip.s,port)
Protected socket
Protected *ip
Protected address.sockaddr_in
socket=socket_(#AF_INET,#SOCK_DGRAM,#IPPROTO_IP)
If (socket<>#SOCKET_ERROR)
Protected one=1
;If (setsockopt_(socket,#SOL_SOCKET,#SO_BROADCAST,@one,SizeOf(one))=#SOCKET_ERROR)
; ProcedureReturn #Null
;EndIf
*ip=Ascii(ip)
address\sin_family= #AF_INET
address\sin_port= htons_(port)
address\sin_addr= inet_addr_(*ip)
;address\sin_addr= #INADDR_BROADCAST; sends to 'first' interface only
FreeMemory(*ip)
Message\Type=type
Message\Magic=#Magic
If (sendto_(socket,@Message,SizeOf(Message),0,@address,SizeOf(address))=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
closesocket_(socket)
EndIf
ProcedureReturn #True
EndProcedure
Procedure SendUDPBroadcastOld(type,port)
Protected sock,one,bytes
Protected remote.sockaddr_in
sock=socket_(#AF_INET,#SOCK_DGRAM,#IPPROTO_IP)
If (sock=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
one=1
If (setsockopt_(sock,#SOL_SOCKET,#SO_BROADCAST,@one,SizeOf(one))=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
remote\sin_family=#AF_INET
remote\sin_port=htons_(port)
remote\sin_addr=#INADDR_BROADCAST
Message\Type=type
Message\Magic=#Magic
If (sendto_(sock,@Message,SizeOf(Message),0,@remote,SizeOf(remote))=#SOCKET_ERROR)
ProcedureReturn #Null
EndIf
closesocket_(sock)
ProcedureReturn #True
EndProcedure
Procedure InitServer()
If initNetwork()
If CreateNetworkServer(#ClientID,#ClientPort,#PB_Network_UDP)
SysTrayIcon(#StateIdle)
App\Retry=10
ProcedureReturn #True
EndIf
EndIf
App\Retry=#RepeatTimer/#Ticker
ProcedureReturn #Null
EndProcedure
Procedure InitConnection()
Protected timer
With App
Debug "BROADCAST"
If SendUDPBroadcast(#CmdGetIP,\BroadcastAddress,#ServerPort)
timer=GetTickCount_()+2000
Repeat
Delay(#Ticker)
If NetworkServerEvent()=#PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
If Message\Type=#CmdSetIP
\PartnerIP=GetClientIP(\ConnectionIn)
SysTrayIcon(#StateConnected)
ProcedureReturn #True
EndIf
EndIf
EndIf
Until GetTickCount_()>timer
EndIf
App\Retry=#RepeatTimer/#Ticker
EndWith
EndProcedure
Procedure ReadMessage()
With App
Message\Magic=#Null
Message\Type=#Null
ReceiveNetworkData(\ConnectionIn,@Message,SizeOf(Message))
; Debug "DATA "+Str(Message\Type)+" "+Hex(Message\Values\A)+":"+Hex(Message\Values\B)+":"+Hex(Message\Values\C)+":"+Hex(Message\Values\D)
ProcedureReturn Bool(Message\Magic=#Magic)
EndWith
EndProcedure
Procedure SendMessage(type,*Value.ValueType)
With App
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ServerPort,#PB_Network_UDP)
If \ConnectionOut
Message\Type=type
If *Value
CopyMemory(*Value,@Message\Values,SizeOf(ValueType))
Else
FillMemory(@Message\Values,SizeOf(ValueType),#Null,#PB_Long)
EndIf
Message\Magic=#Magic
ProcedureReturn Bool(SendNetworkData(\ConnectionOut,@Message,SizeOf(Message))>=0)
Else
ProcedureReturn #Null
EndIf
EndWith
EndProcedure
; End of Include Network & More
Procedure ToggleMode()
With App
Select \Icon
Case #StateConnected
\WindowX=GetSystemMetrics_(#SM_CXSCREEN)
\WindowY=GetSystemMetrics_(#SM_CYSCREEN)
Value\A=\WindowX
Value\B=\WindowY
Value\C=0
Value\D=0
If SendMessage(#CmdSetActive,@Value)
SysTrayIcon(#StateActive)
;ResizeWindow(#Window,#PB_Ignore,#PB_Ignore,\WindowX,\WindowY)
;HideWindow(#Window,#Null)
;SetWindowLong_(WindowID(#Window),#GWL_EXSTYLE,GetWindowLong_(WindowID(#Window),#GWL_EXSTYLE)|#WS_EX_LAYERED)
;SetLayeredWindowAttributes_(WindowID(#Window), 0, (255*70)/100,#LWA_ALPHA)
Else
\Retry=10
SysTrayIcon(#StateIdle)
EndIf
Case #StateActive
If SendMessage(#CmdSetPassive,#Null)
SysTrayIcon(#StateConnected)
\MouseX=#Undefined
\MouseY=#Undefined
\MouseButton=#Undefined
HideWindow(#Window,#True)
Else
\Retry=10
SysTrayIcon(#StateIdle)
EndIf
EndSelect
EndWith
EndProcedure
Procedure Main()
Protected Cursor.Point
With App
If FindWindow_(0,#ApplicationTitle)=0
\BroadcastAddress="10.0.0.255"
\MouseX=#Undefined
\MouseY=#Undefined
\MouseButton=#Undefined
CreatePopupMenu(#PopupMenu)
MenuItem(#PopupToggle,"Toggle Control"+#TAB$+"Ctrl+Shift+K")
MenuBar()
MenuItem(#PopupQuit,"Quit 'MyClient'...")
\Window=OpenWindow(#Window,0,0,0,0,#ApplicationTitle,#PB_Window_Invisible)
RegisterHotKey_(\Window,#MonCode,#MonControl,#MonKey)
AddWindowTimer(#Window,#Null,#Ticker)
SysTrayIcon(#StateNoNetwork)
InitServer()
Repeat
Select WaitWindowEvent()
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_LeftDoubleClick
ToggleMode()
Case #PB_EventType_RightClick
\Quit=#True
Case #PB_EventType_LeftClick
DisplayPopupMenu(#PopupMenu,\Window)
EndSelect
Case #PB_Event_Timer
Select \Icon
Case #StateNoNetwork,#StateIdle
If \Retry
\Retry-1
If \Retry=#Null
If \Icon=#StateNoNetwork
InitServer()
Else
InitConnection()
EndIf
EndIf
EndIf
Case #StateConnected,#StateActive
\DeadTimer-1
If \DeadTimer<0
Debug "Server is dead..."
SysTrayIcon(#StateIdle)
\Retry=10
EndIf
EndSelect
Case #PB_Event_Menu;#PB_Event_Gadget
Select EventGadget()
Case #PopupToggle
ToggleMode()
Case #PopupQuit
\Quit=#True
EndSelect
Case #WM_HOTKEY
If EventwParam()=#MonCode
ToggleMode()
EndIf
Case #WM_MOUSEMOVE
Debug "*"
EndSelect
If \Icon=#StateActive
GetCursorPos_(@Cursor)
If \MouseX<>Cursor\x Or \MouseY<>Cursor\y
\MouseX=Cursor\x
\MouseY=Cursor\y
Value\A=Cursor\x
Value\B=Cursor\y
SendMessage(#CmdMouseXY,@Value)
EndIf
EndIf
Select NetworkServerEvent(#ClientID)
Case #PB_NetworkEvent_Connect
Debug "CONN (never happens)"
Case #PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
Debug "MESS "+Str(Message\Type)+" "+Hex(Message\Values\A)+":"+Hex(Message\Values\B)+":"+Hex(Message\Values\C)+":"+Hex(Message\Values\D)
Select Message\Type
Case #CmdImAlive
Debug "Server is alive"
\DeadTimer=#DeadTimer
Case #CmdBreak
If \Icon>#StateIdle
SysTrayIcon(#StateIdle)
\Retry=10
EndIf
Case #CmdGetIP
\PartnerIP=GetClientIP(\ConnectionIn)
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ServerPort,#PB_Network_UDP)
If SendMessage(#CmdSetIP,#Null)
SysTrayIcon(#StateConnected)
EndIf
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
Debug "DISC (never happens)"
EndSelect
Until \Quit
;If \Icon>#StateIdle
SendMessage(#CmdBreak,#Null)
;EndIf
EndIf
EndWith
EndProcedure
Main()
Code: Select all
; Define Network Server
#ApplicationTitle="·MYSVR·"
EnableExplicit
Structure AppType
Window.i
Icon.i; Network State
IconSize.i
IconArcs.i
DpiScale.i
ConnectionIn.i
ConnectionOut.i
PartnerIP.i
PartnerX.i
PartnerY.i
WindowX.i
WindowY.i
Quit.i
Retry.i
Alive.i
EndStructure
Global App.AppType
Enumeration
#SysTray
#Window
#Icon
#Font
#PopupMenu
#PopupQuit
EndEnumeration
; EndDefine
; Define Include Network & More
#ServerID= #Null
#ServerPort= 5004
#ClientPort= 5005
Structure ValueType
A.l
B.l
C.l
D.l
EndStructure
Structure MessageType
Type.l
StructureUnion
Record.l[4]
Values.ValueType
EndStructureUnion
Magic.l
EndStructure
Global Message.MessageType
#Magic=$12345678
Enumeration
#CmdUnknown
#CmdImAlive
#CmdBreak
#CmdGetIP
#CmdSetIP
#CmdSetPassive
#CmdSetActive
#CmdMouseXY
#CmdMouseButton
#CmdKey
EndEnumeration
Enumeration
#StateNoNetwork
#StateIdle
#StateConnected
#StateActive
EndEnumeration
#Ticker= 5
#RepeatTimer= 5000/#Ticker; 5000 ~ 10s
#AliveTimer= 500/#Ticker
#Undefined= -#True
#DpiBits= 12+SizeOf(Integer)
#DpiScale= 1<<#DpiBits
#DrawOpaque= $FF000000
#DrawMilky= $80000000
#DarkRed= $0000A0
#NiceGray= $D0D0D0
#NiceGreen= $35A77C
#NiceBlue= $D3C985
CompilerIf #PB_Compiler_Version>=600
Macro InitNetwork()
#True
EndMacro
CompilerEndIf
; EndDefine
Procedure ScaleUp(value)
ProcedureReturn (((value)*App\DpiScale)/#DpiScale)
EndProcedure
Procedure SysTrayIcon(mode)
Protected.s s,t
Protected.i ct,cb
With App
If \DpiScale=#Null
\DpiScale=GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)<<#DpiBits/96
\IconSize=ScaleUp(20)
\IconArcs=ScaleUp(3)
LoadFont(#Font,"Segoe UI",\IconSize*0.55,#PB_Font_Bold)
CreateImage(#Icon,\IconSize,\IconSize,32)
\Icon=#Undefined
EndIf
If mode<>\Icon
StartDrawing(ImageOutput(#Icon))
ct=#White
Select mode
Case #StateNoNetwork
ct=#Black
cb=#NiceGray
s="X"
t="No Network"
Case #StateIdle
ct=#Black
cb=#NiceBlue
s="I"
t="Idle"
Case #StateConnected
cb=#NiceGreen
s="C"
t="Connected"
Case #StateActive
cb=#DarkRed
s="A"
t="Active"
EndSelect
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,\IconSize,\IconSize,#Null)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawOpaque|cb)
DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_AlphaBlend)
RoundBox(0,0,\IconSize,\IconSize,\IconArcs,\IconArcs,#DrawMilky)
DrawingFont(FontID(#Font))
DrawText((\IconSize-TextWidth(s))/2,(\IconSize-TextHeight(s)*1.1)/2,s,#DrawOpaque|ct,#Null)
StopDrawing()
If \Icon=#Undefined
AddSysTrayIcon(#SysTray,\Window,ImageID(#Icon))
Else
ChangeSysTrayIcon(#SysTray,ImageID(#Icon))
EndIf
SysTrayIconToolTip(#SysTray,"MyServer by Michael Vogel - "+t)
\Icon=mode
EndIf
EndWith
EndProcedure
Procedure InitServer()
If InitNetwork()
If CreateNetworkServer(#ServerID,#ServerPort,#PB_Network_UDP)
SysTrayIcon(#StateIdle)
ProcedureReturn #True
EndIf
EndIf
App\Retry=#RepeatTimer/#Ticker
ProcedureReturn #Null
EndProcedure
Procedure ReadMessage()
With App
Message\Magic=#Null
ReceiveNetworkData(\ConnectionIn,@Message,SizeOf(Message))
; Debug "DATA "+Str(Message\Type)+" "+Hex(Message\Values\A)+"."+Hex(Message\Values\B)+"."+Hex(Message\Values\C)+"."+Hex(Message\Values\D)
ProcedureReturn Bool(Message\Magic=#Magic)
EndWith
EndProcedure
Procedure SendMessage(type,*Value.ValueType)
With App
\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ClientPort,#PB_Network_UDP)
If \ConnectionOut
Message\Type=type
If *Value
CopyMemory(*Value,@Message\Values,SizeOf(ValueType))
Else
FillMemory(@Message\Values,SizeOf(ValueType),#Null,#PB_Long)
EndIf
Message\Magic=#Magic
Debug "Send message "+type+" to "+IPString(\PartnerIP)
ProcedureReturn Bool(SendNetworkData(\ConnectionOut,@Message,SizeOf(Message))>=0)
Else
ProcedureReturn #Null
EndIf
EndWith
EndProcedure
; End of Include Network & More
Procedure Main()
With App
If FindWindow_(0,#ApplicationTitle)=0
\Window=OpenWindow(#Window,0,0,0,0,#ApplicationTitle,#PB_Window_Invisible)
AddWindowTimer(#Window,#Null,#Ticker)
SysTrayIcon(#StateNoNetwork)
CreatePopupMenu(#PopupMenu)
MenuItem(#PopupQuit,"Quit 'MyServer'...")
InitServer()
Repeat
Select WaitWindowEvent()
Case #PB_Event_SysTray
Select EventType()
Case #PB_EventType_LeftDoubleClick
Case #PB_EventType_RightClick
\Quit=#True
Case #PB_EventType_LeftClick
DisplayPopupMenu(#PopupMenu,\Window)
EndSelect
Case #PB_Event_Timer
Select \Icon
Case #StateNoNetwork
If \Retry
\Retry-1
If \Retry=#Null
InitServer()
EndIf
EndIf
Case #StateConnected,#StateActive
\Alive-1
If \Alive<=#Null
\Alive=#AliveTimer
SendMessage(#CmdImAlive,#Null)
EndIf
EndSelect
Case #PB_Event_Menu;#PB_Event_Gadget
Select EventGadget()
Case #PopupQuit
\Quit=#True
EndSelect
EndSelect
Select NetworkServerEvent(#ServerID)
Case #PB_NetworkEvent_Connect
Debug "CONN (never happens)"
Case #PB_NetworkEvent_Data
\ConnectionIn=EventClient()
If ReadMessage()
Debug "MESS "+Str(Message\Type)+" "+Hex(Message\Values\A)+":"+Hex(Message\Values\B)+":"+Hex(Message\Values\C)+":"+Hex(Message\Values\D)
Select Message\Type
Case #CmdGetIP
\PartnerIP=GetClientIP(\ConnectionIn)
;\ConnectionOut=OpenNetworkConnection(IPString(\PartnerIP),#ClientPort,#PB_Network_UDP)
If SendMessage(#CmdSetIP,#Null)
SysTrayIcon(#StateConnected)
EndIf
Case #CmdSetActive
\PartnerX=Message\Values\A
\PartnerY=Message\Values\B
\WindowX=GetSystemMetrics_(#SM_CXSCREEN)
\WindowY=GetSystemMetrics_(#SM_CYSCREEN)
SysTrayIcon(#StateActive)
Case #CmdSetPassive
SysTrayIcon(#StateConnected)
Case #CmdMouseXY
; Debug "MOUSE "+Str(Message\Values\A)+" | "+Str(Message\Values\B)
SetCursorPos_(MulDiv_(Message\Values\A,\WindowX,\PartnerX),MulDiv_(Message\Values\B,\WindowY,\PartnerX))
Case #CmdBreak
If \Icon>#StateIdle
SysTrayIcon(#StateIdle)
EndIf
EndSelect
EndIf
Case #PB_NetworkEvent_Disconnect
Debug "DISC (never happens)"
EndSelect
Until \Quit
If \Icon>#StateIdle
SendMessage(#CmdBreak,#Null)
EndIf
EndIf
EndWith
EndProcedure
Main()