From cd202915847036e89f4fe6b9059fbad77dd003e7 Mon Sep 17 00:00:00 2001 From: oro06 Date: Mon, 26 Dec 2005 15:20:04 +0000 Subject: [PATCH] +arm/wince more fcl units : simpleipc git-svn-id: trunk@2053 - --- .gitattributes | 1 + fcl/Makefile | 4 +- fcl/Makefile.fpc | 2 +- fcl/wince/simpleipc.inc | 291 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 295 insertions(+), 3 deletions(-) create mode 100644 fcl/wince/simpleipc.inc diff --git a/.gitattributes b/.gitattributes index f54095a02b..7ceaa0fb62 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1044,6 +1044,7 @@ fcl/wince/ezcgi.inc svneol=native#text/plain fcl/wince/fileinfo.pp svneol=native#text/plain fcl/wince/pipes.inc svneol=native#text/plain fcl/wince/process.inc svneol=native#text/plain +fcl/wince/simpleipc.inc svneol=native#text/plain fcl/xml/Makefile svneol=native#text/plain fcl/xml/Makefile.fpc svneol=native#text/plain fcl/xml/README -text diff --git a/fcl/Makefile b/fcl/Makefile index f8a0ea319d..9e1a01d98d 100644 --- a/fcl/Makefile +++ b/fcl/Makefile @@ -392,7 +392,7 @@ ifeq ($(FULL_TARGET),i386-netwlibc) override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex resolve ssockets syncobjs endif ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process fileinfo +override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process fileinfo simpleipc endif ifeq ($(FULL_TARGET),m68k-linux) override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf @@ -452,7 +452,7 @@ ifeq ($(FULL_TARGET),arm-linux) override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process fileinfo +override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process fileinfo simpleipc endif ifeq ($(FULL_TARGET),powerpc64-linux) override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf diff --git a/fcl/Makefile.fpc b/fcl/Makefile.fpc index 6c13361739..0e1d8d4930 100644 --- a/fcl/Makefile.fpc +++ b/fcl/Makefile.fpc @@ -33,7 +33,7 @@ units_netbsd=process ssockets resolve fpasync simpleipc msgintf dbugintf units_openbsd=process ssockets resolve fpasync simpleipc msgintf dbugintf units_linux=process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf units_win32=process fileinfo resolve ssockets syncobjs simpleipc msgintf dbugintf -units_wince=process fileinfo +units_wince=process fileinfo simpleipc units_os2=resolve ssockets units_emx=resolve ssockets units_netware=resolve ssockets diff --git a/fcl/wince/simpleipc.inc b/fcl/wince/simpleipc.inc new file mode 100644 index 0000000000..a323f876ac --- /dev/null +++ b/fcl/wince/simpleipc.inc @@ -0,0 +1,291 @@ +{ + This file is part of the Free Component library. + Copyright (c) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + + Windows implementation of one-way IPC between 2 processes + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +uses Windows,messages; + +Const + MsgWndClassName : pwidechar = 'FPCMsgWindowCls'; + +Resourcestring + SErrFailedToRegisterWindowClass = 'Failed to register message window class'; + SErrFailedToCreateWindow = 'Failed to create message window %s'; + +var + MsgWindowClass: TWndClass = ( + style: 0; + lpfnWndProc: Nil; + cbClsExtra: 0; + cbWndExtra: 0; + hInstance: 0; + hIcon: 0; + hCursor: 0; + hbrBackground: 0; + lpszMenuName: nil; + lpszClassName: Nil); + +{ --------------------------------------------------------------------- + TWinMsgServerComm + ---------------------------------------------------------------------} + +Type + TWinMsgServerComm = Class(TIPCServerComm) + Private + FHWND : HWND; + FWindowName : Widestring; + FDataPushed : Boolean; + Function AllocateHWnd(const cwsWindowName : widestring) : HWND; + Public + Constructor Create(AOwner : TSimpleIPCServer); override; + procedure ReadMsgData(var Msg: TMsg); + Procedure StartServer; override; + Procedure StopServer; override; + Function PeekMessage(TimeOut : Integer) : Boolean; override; + Procedure ReadMessage ; override; + Function GetInstanceID : String;override; + Property WindowName : WideString Read FWindowName; + end; + + +function MsgWndProc(HWindow: HWnd; Message, WParam, LParam: Longint): Longint;stdcall; + +Var + I : TWinMsgServerComm; + Msg : TMsg; + +begin + Result:=0; + If (Message=WM_COPYDATA) then + begin + I:=TWinMsgServerComm(GetWindowLong(HWindow,GWL_USERDATA)); + If (I<>NIl) then + begin + Msg.Message:=Message; + Msg.WParam:=WParam; + Msg.LParam:=LParam; + I.ReadMsgData(Msg); + I.FDataPushed:=True; + If Assigned(I.Owner.OnMessage) then + I.Owner.ReadMessage; + Result:=1; + end + end + else + Result:=DefWindowProc(HWindow,Message,WParam,LParam); +end; + + +function TWinMsgServerComm.AllocateHWnd(const cwsWindowName: Widestring): HWND; + +var + cls: LPWNDCLASS; + isreg : Boolean; + +begin + Pointer(MsgWindowClass.lpfnWndProc):=@MsgWndProc; + MsgWindowClass.hInstance := HInstance; + MsgWindowClass.lpszClassName:=MsgWndClassName; + isreg:=GetClassInfo(HInstance,MsgWndClassName,cls); + if not isreg then + if (Windows.RegisterClass(MsgWindowClass)=0) then + Owner.DoError(SErrFailedToRegisterWindowClass,[]); + Result:=CreateWindowEx(WS_EX_TOOLWINDOW, MsgWndClassName, + PWidechar(cwsWindowName), WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result=0) then + Owner.DoError(SErrFailedToCreateWindow,[cwsWindowName]); + SetWindowLong(Result,GWL_USERDATA,Longint(Self)); +end; + +constructor TWinMsgServerComm.Create(AOWner: TSimpleIPCServer); +begin + inherited Create(AOWner); + FWindowName:=Owner.ServerID; + If not Owner.Global then + FWindowName:=FWindowName+'_'+InstanceID; +end; + +procedure TWinMsgServerComm.StartServer; + +begin + FHWND:=AllocateHWND(FWindowName); +end; + +procedure TWinMsgServerComm.StopServer; +begin + DestroyWindow(FHWND); + FHWND:=0; +end; + +function TWinMsgServerComm.PeekMessage(TimeOut: Integer): Boolean; + +Var + Msg : Tmsg; + B : Boolean; + R : DWORD; + +begin + Result:=FDataPushed; + If Result then + Exit; + B:=Windows.PeekMessage(Msg, FHWND, 0, 0, PM_NOREMOVE); + If not B then + // No message yet. Wait for a message to arrive available within specified time. + begin + if (TimeOut=0) then + TimeOut:=Integer(INFINITE); + R:=MsgWaitForMultipleObjects(1,FHWND,False,TimeOut,QS_SENDMESSAGE); + B:=(R<>WAIT_TIMEOUT); + end; + If B then + Repeat + B:=Windows.PeekMessage(Msg, FHWND, 0, 0, PM_NOREMOVE); + if B then + begin + Result:=(Msg.Message=WM_COPYDATA); + // Remove non WM_COPY messages from Queue + if not Result then + GetMessage(@Msg,FHWND,0,0); + end; + Until Result or (not B); +end; + +procedure TWinMsgServerComm.ReadMsgData(var Msg: TMsg); + +Var + CDS : PCopyDataStruct; + +begin + CDS:=PCopyDataStruct(Msg.Lparam); + Owner.FMsgData.Seek(0,soFrombeginning); + Owner.FMsgData.WriteBuffer(CDS^.lpData^,CDS^.cbData); +end; + +procedure TWinMsgServerComm.ReadMessage; + +Var + Msg : TMsg; + +begin + If FDataPushed then + FDataPushed:=False + else + If Windows.PeekMessage(Msg, FHWND, 0, 0, PM_REMOVE) then + if (Msg.Message=WM_COPYDATA) then + ReadMsgData(Msg); +end; + +function TWinMsgServerComm.GetInstanceID: String; +begin + Result:=IntToStr(HInstance); +end; + +{ --------------------------------------------------------------------- + TWinMsgClientComm + ---------------------------------------------------------------------} + +Type + TWinMsgClientComm = Class(TIPCClientComm) + Private + FWindowName: String; + FHWND : HWnd; + Public + Constructor Create(AOWner : TSimpleIPCClient); override; + Procedure Connect; override; + Procedure Disconnect; override; + Procedure SendMessage(MsgType : TMessageType; Stream : TStream); override; + Function ServerRunning : Boolean; override; + Property WindowName : String Read FWindowName; + end; + + +constructor TWinMsgClientComm.Create(AOWner: TSimpleIPCClient); +begin + inherited Create(AOWner); + FWindowName:=Owner.ServerID; + If (Owner.ServerInstance<>'') then + FWindowName:=FWindowName+'_'+Owner.ServerInstance; +end; + +procedure TWinMsgClientComm.Connect; +begin + FHWND:=FindWindow(MsgWndClassName,Pwidechar(FWindowName)); + If (FHWND=0) then + Owner.DoError(SErrServerNotActive,[Owner.ServerID]); +end; + +procedure TWinMsgClientComm.Disconnect; +begin + FHWND:=0; +end; + +procedure TWinMsgClientComm.SendMessage(MsgType: TMessageType; Stream: TStream + ); +Var + CDS : TCopyDataStruct; + Data,FMemstr : TMemorySTream; + +begin + If Stream is TMemoryStream then + begin + Data:=TMemoryStream(Stream); + FMemStr:=Nil + end + else + begin + FMemStr:=TMemoryStream.Create; + Data:=FMemstr; + end; + Try + If Assigned(FMemStr) then + begin + FMemStr.CopyFrom(Stream,0); + FMemStr.Seek(0,soFromBeginning); + end; + CDS.lpData:=Data.Memory; + CDS.cbData:=Data.Size; + Windows.SendMessage(FHWnd,WM_COPYDATA,0,Integer(@CDS)); + Finally + FreeAndNil(FMemStr); + end; +end; + +function TWinMsgClientComm.ServerRunning: Boolean; +begin + Result:=FindWindow(MsgWndClassName,PWidechar(FWindowName))<>0; +end; + +{ --------------------------------------------------------------------- + Set TSimpleIPCClient / TSimpleIPCServer defaults. + ---------------------------------------------------------------------} + + +Function TSimpleIPCServer.CommClass : TIPCServerCommClass; + +begin + if (DefaultIPCServerClass<>Nil) then + Result:=DefaultIPCServerClass + else + Result:=TWinMsgServerComm; +end; + +Function TSimpleIPCClient.CommClass : TIPCClientCommClass; + +begin + if (DefaultIPCClientClass<>Nil) then + Result:=DefaultIPCClientClass + else + Result:=TWinMsgClientComm; +end; +