diff --git a/.gitattributes b/.gitattributes index cd7da1eeaa..b77e749175 100644 --- a/.gitattributes +++ b/.gitattributes @@ -760,6 +760,7 @@ fcl/inc/cachecls.pp svneol=native#text/plain fcl/inc/cgiapp.pp svneol=native#text/plain fcl/inc/contnrs.pp svneol=native#text/plain fcl/inc/custapp.pp svneol=native#text/plain +fcl/inc/dbugintf.pp svneol=native#text/plain fcl/inc/eventlog.pp svneol=native#text/plain fcl/inc/ezcgi.pp svneol=native#text/plain fcl/inc/felog.inc svneol=native#text/plain @@ -770,6 +771,7 @@ fcl/inc/gettext.pp svneol=native#text/plain fcl/inc/idea.pp svneol=native#text/plain fcl/inc/inifiles.pp svneol=native#text/plain fcl/inc/iostream.pp svneol=native#text/plain +fcl/inc/msgintf.pp svneol=native#text/plain fcl/inc/pipes.pp svneol=native#text/plain fcl/inc/process.pp svneol=native#text/plain fcl/inc/process.txt svneol=native#text/plain @@ -780,6 +782,7 @@ fcl/inc/resolve.pp svneol=native#text/plain fcl/inc/rtfdata.inc svneol=native#text/plain fcl/inc/rtfpars.pp svneol=native#text/plain fcl/inc/rttiutils.pp svneol=native#text/plain +fcl/inc/simpleipc.pp svneol=native#text/plain fcl/inc/ssockets.pp svneol=native#text/plain fcl/inc/streamex.pp svneol=native#text/plain fcl/inc/streamio.pp svneol=native#text/plain @@ -877,6 +880,8 @@ fcl/tests/b64test.pp svneol=native#text/plain fcl/tests/b64test2.pp svneol=native#text/plain fcl/tests/cachetest.pp svneol=native#text/plain fcl/tests/cfgtest.pp svneol=native#text/plain +fcl/tests/dbugsrv.pp svneol=native#text/plain +fcl/tests/debugtest.pp svneol=native#text/plain fcl/tests/doecho.pp svneol=native#text/plain fcl/tests/dparser.pp svneol=native#text/plain fcl/tests/dsockcli.pp svneol=native#text/plain @@ -893,6 +898,8 @@ fcl/tests/intl/restest.fr.po -text fcl/tests/intl/restest.nl.mo -text fcl/tests/intl/restest.nl.po -text fcl/tests/intl/resttest.po -text +fcl/tests/ipcclient.pp svneol=native#text/plain +fcl/tests/ipcserver.pp svneol=native#text/plain fcl/tests/isockcli.pp svneol=native#text/plain fcl/tests/isocksvr.pp svneol=native#text/plain fcl/tests/istream.pp svneol=native#text/plain @@ -943,6 +950,7 @@ fcl/unix/ezcgi.inc svneol=native#text/plain fcl/unix/pipes.inc svneol=native#text/plain fcl/unix/process.inc svneol=native#text/plain fcl/unix/resolve.inc svneol=native#text/plain +fcl/unix/simpleipc.inc svneol=native#text/plain fcl/win32/eventlog.inc svneol=native#text/plain fcl/win32/ezcgi.inc svneol=native#text/plain fcl/win32/fclel.mc -text @@ -953,6 +961,7 @@ fcl/win32/httpapp.pp svneol=native#text/plain fcl/win32/pipes.inc svneol=native#text/plain fcl/win32/process.inc svneol=native#text/plain fcl/win32/resolve.inc svneol=native#text/plain +fcl/win32/simpleipc.inc svneol=native#text/plain fcl/win32/syncobjs.pp svneol=native#text/plain fcl/win32/winreg.inc svneol=native#text/plain fcl/xml/Makefile svneol=native#text/plain diff --git a/fcl/Makefile b/fcl/Makefile index 3a17158e18..ef94174b08 100644 --- a/fcl/Makefile +++ b/fcl/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 1.9.8 [2005/04/10] # default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux BSDs = freebsd netbsd openbsd darwin UNIXs = linux $(BSDs) solaris qnx LIMIT83fs = go32v2 os2 emx watcom @@ -280,9 +280,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override TARGET_DIRS+=xml image db shedit passrc net fpcunit endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_DIRS+=xml image db shedit passrc net fpcunit -endif ifeq ($(FULL_TARGET),m68k-linux) override TARGET_DIRS+=xml image db shedit passrc net fpcunit endif @@ -334,35 +331,29 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override TARGET_DIRS+=xml image db shedit passrc net fpcunit endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_DIRS+=xml image db shedit passrc net fpcunit -endif ifeq ($(FULL_TARGET),arm-linux) override TARGET_DIRS+=xml image db shedit passrc net fpcunit endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_DIRS+=xml image db shedit passrc net fpcunit -endif ifeq ($(FULL_TARGET),i386-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 +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),i386-go32v2) 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 endif ifeq ($(FULL_TARGET),i386-win32) -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 resolve ssockets syncobjs +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 resolve ssockets syncobjs simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),i386-os2) 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 endif ifeq ($(FULL_TARGET),i386-freebsd) -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 ssockets resolve fpasync syncobjs +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 ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),i386-beos) 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 endif ifeq ($(FULL_TARGET),i386-netbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),i386-solaris) 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 @@ -374,7 +365,7 @@ ifeq ($(FULL_TARGET),i386-netware) 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 endif ifeq ($(FULL_TARGET),i386-openbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),i386-wdosx) 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 @@ -388,17 +379,14 @@ endif 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 -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 +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),m68k-freebsd) -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 ssockets resolve fpasync syncobjs +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 ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),m68k-netbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),m68k-amiga) 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 @@ -407,157 +395,142 @@ ifeq ($(FULL_TARGET),m68k-atari) 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 endif ifeq ($(FULL_TARGET),m68k-openbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),m68k-palmos) 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 endif ifeq ($(FULL_TARGET),powerpc-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 +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),powerpc-netbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),powerpc-macos) 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 endif ifeq ($(FULL_TARGET),powerpc-darwin) -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 ssockets resolve fpasync syncobjs +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 ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),powerpc-morphos) 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 endif ifeq ($(FULL_TARGET),sparc-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 +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),sparc-netbsd) -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 ssockets resolve fpasync +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 ssockets resolve fpasync simpleipc msgintf dbugintf endif ifeq ($(FULL_TARGET),sparc-solaris) 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 endif ifeq ($(FULL_TARGET),x86_64-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 +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),x86_64-freebsd) -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 ssockets resolve fpasync syncobjs -endif -ifeq ($(FULL_TARGET),x86_64-win64) -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 +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 ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf endif 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 -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 +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),i386-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-os2) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-beos) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-netware) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-emx) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry -endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_EXAMPLEDIRS+=tests @@ -604,9 +577,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override TARGET_EXAMPLEDIRS+=tests endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_EXAMPLEDIRS+=tests -endif ifeq ($(FULL_TARGET),m68k-linux) override TARGET_EXAMPLEDIRS+=tests endif @@ -658,15 +628,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override TARGET_EXAMPLEDIRS+=tests endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_EXAMPLEDIRS+=tests -endif ifeq ($(FULL_TARGET),arm-linux) override TARGET_EXAMPLEDIRS+=tests endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_EXAMPLEDIRS+=tests -endif ifeq ($(FULL_TARGET),i386-linux) override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio endif @@ -712,9 +676,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio endif -ifeq ($(FULL_TARGET),i386-wince) -override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio -endif ifeq ($(FULL_TARGET),m68k-linux) override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio endif @@ -766,15 +727,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio endif -ifeq ($(FULL_TARGET),x86_64-win64) -override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio -endif ifeq ($(FULL_TARGET),arm-linux) override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio endif -ifeq ($(FULL_TARGET),arm-wince) -override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio -endif override INSTALL_FPCPACKAGE=y ifeq ($(FULL_TARGET),i386-linux) override COMPILER_OPTIONS+=-S2 @@ -821,9 +776,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_OPTIONS+=-S2 -endif ifeq ($(FULL_TARGET),m68k-linux) override COMPILER_OPTIONS+=-S2 endif @@ -875,15 +827,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_OPTIONS+=-S2 -endif ifeq ($(FULL_TARGET),arm-linux) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_OPTIONS+=-S2 -endif ifeq ($(FULL_TARGET),i386-linux) override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc unix endif @@ -929,9 +875,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc -endif ifeq ($(FULL_TARGET),m68k-linux) override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc unix endif @@ -983,15 +926,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc unix endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc -endif ifeq ($(FULL_TARGET),arm-linux) override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc unix endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc -endif ifeq ($(FULL_TARGET),i386-linux) override COMPILER_SOURCEDIR+=$(OS_TARGET) inc endif @@ -1037,9 +974,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override COMPILER_SOURCEDIR+=$(OS_TARGET) inc endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_SOURCEDIR+=$(OS_TARGET) inc -endif ifeq ($(FULL_TARGET),m68k-linux) override COMPILER_SOURCEDIR+=$(OS_TARGET) inc endif @@ -1091,15 +1025,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override COMPILER_SOURCEDIR+=$(OS_TARGET) inc endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_SOURCEDIR+=$(OS_TARGET) inc -endif ifeq ($(FULL_TARGET),arm-linux) override COMPILER_SOURCEDIR+=$(OS_TARGET) inc endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_SOURCEDIR+=$(OS_TARGET) inc -endif ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) endif @@ -1982,13 +1910,6 @@ REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif -ifeq ($(FULL_TARGET),i386-wince) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifeq ($(FULL_TARGET),m68k-linux) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 @@ -2159,13 +2080,6 @@ REQUIRE_PACKAGES_POSTGRES=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_SQLITE=1 endif -ifeq ($(FULL_TARGET),x86_64-win64) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifeq ($(FULL_TARGET),arm-linux) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 @@ -2178,13 +2092,6 @@ REQUIRE_PACKAGES_POSTGRES=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_SQLITE=1 endif -ifeq ($(FULL_TARGET),arm-wince) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_RTL),) @@ -2494,7 +2401,7 @@ else FPCCPUOPT:= endif endif -override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPT+=-Xs $(FPCCPUOPT) -n override FPCOPTDEF+=RELEASE endif ifdef STRIP @@ -3112,15 +3019,6 @@ TARGET_DIRS_PASSRC=1 TARGET_DIRS_NET=1 TARGET_DIRS_FPCUNIT=1 endif -ifeq ($(FULL_TARGET),i386-wince) -TARGET_DIRS_XML=1 -TARGET_DIRS_IMAGE=1 -TARGET_DIRS_DB=1 -TARGET_DIRS_SHEDIT=1 -TARGET_DIRS_PASSRC=1 -TARGET_DIRS_NET=1 -TARGET_DIRS_FPCUNIT=1 -endif ifeq ($(FULL_TARGET),m68k-linux) TARGET_DIRS_XML=1 TARGET_DIRS_IMAGE=1 @@ -3274,15 +3172,6 @@ TARGET_DIRS_PASSRC=1 TARGET_DIRS_NET=1 TARGET_DIRS_FPCUNIT=1 endif -ifeq ($(FULL_TARGET),x86_64-win64) -TARGET_DIRS_XML=1 -TARGET_DIRS_IMAGE=1 -TARGET_DIRS_DB=1 -TARGET_DIRS_SHEDIT=1 -TARGET_DIRS_PASSRC=1 -TARGET_DIRS_NET=1 -TARGET_DIRS_FPCUNIT=1 -endif ifeq ($(FULL_TARGET),arm-linux) TARGET_DIRS_XML=1 TARGET_DIRS_IMAGE=1 @@ -3292,15 +3181,6 @@ TARGET_DIRS_PASSRC=1 TARGET_DIRS_NET=1 TARGET_DIRS_FPCUNIT=1 endif -ifeq ($(FULL_TARGET),arm-wince) -TARGET_DIRS_XML=1 -TARGET_DIRS_IMAGE=1 -TARGET_DIRS_DB=1 -TARGET_DIRS_SHEDIT=1 -TARGET_DIRS_PASSRC=1 -TARGET_DIRS_NET=1 -TARGET_DIRS_FPCUNIT=1 -endif ifdef TARGET_DIRS_XML xml_all: $(MAKE) -C xml all @@ -3661,9 +3541,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) TARGET_EXAMPLEDIRS_TESTS=1 endif -ifeq ($(FULL_TARGET),i386-wince) -TARGET_EXAMPLEDIRS_TESTS=1 -endif ifeq ($(FULL_TARGET),m68k-linux) TARGET_EXAMPLEDIRS_TESTS=1 endif @@ -3715,15 +3592,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) TARGET_EXAMPLEDIRS_TESTS=1 endif -ifeq ($(FULL_TARGET),x86_64-win64) -TARGET_EXAMPLEDIRS_TESTS=1 -endif ifeq ($(FULL_TARGET),arm-linux) TARGET_EXAMPLEDIRS_TESTS=1 endif -ifeq ($(FULL_TARGET),arm-wince) -TARGET_EXAMPLEDIRS_TESTS=1 -endif ifdef TARGET_EXAMPLEDIRS_TESTS tests_all: $(MAKE) -C tests all @@ -3798,3 +3669,4 @@ classes$(PPUEXT): $(COMPILER_UNITTARGETDIR) $(COMPILER) -Ficlasses -Ficlasses/$(OS_TARGET) classes/$(OS_TARGET)/classes.pp endif xmlreg.pp: avl_tree$(PPUEXT) xml +dbugintf$(PPUEXT): msgintf.pp simpleipc.pp diff --git a/fcl/Makefile.fpc b/fcl/Makefile.fpc index 6a8e5b2ce0..c4034bb55a 100644 --- a/fcl/Makefile.fpc +++ b/fcl/Makefile.fpc @@ -26,17 +26,17 @@ dirs=xml image db shedit passrc net fpcunit 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 -units_freebsd=process ssockets resolve fpasync syncobjs -units_darwin=process ssockets resolve fpasync syncobjs -units_netbsd=process ssockets resolve fpasync -units_openbsd=process ssockets resolve fpasync -units_linux=process resolve ssockets fpasync syncobjs -units_win32=process fileinfo resolve ssockets syncobjs +units_freebsd=process ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf +units_darwin=process ssockets resolve fpasync syncobjs simpleipc msgintf dbugintf +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_os2=resolve ssockets units_emx=resolve ssockets units_netware=resolve ssockets units_netwlibc=resolve ssockets syncobjs -rsts=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry +rsts=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc exampledirs=tests [compiler] @@ -76,3 +76,6 @@ endif # xmlreg needs the XML units, XML units depend on avl_tree xmlreg.pp: avl_tree$(PPUEXT) xml + +[rules] +dbugintf$(PPUEXT): msgintf.pp simpleipc.pp diff --git a/fcl/inc/dbugintf.pp b/fcl/inc/dbugintf.pp new file mode 100644 index 0000000000..84415ca7f8 --- /dev/null +++ b/fcl/inc/dbugintf.pp @@ -0,0 +1,245 @@ +{ + This file is part of the Free Component library. + Copyright (c) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + + Debugserver client interface, based on SimpleIPC + + 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. + + **********************************************************************} +{$mode objfpc} +{$h+} +unit dbugintf; + +interface + +uses + simpleipc, + msgintf, + classes; + +Type + TDebugLevel = (dlInformation,dlWarning,dlError); + +procedure SendBoolean(const Identifier: string; const Value: Boolean); +procedure SendDateTime(const Identifier: string; const Value: TDateTime); +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); +procedure SendDebug(const Msg: string); +procedure SendInteger(const Identifier: string; const Value: Integer); +procedure SendMethodEnter(const MethodName: string); +procedure SendMethodExit(const MethodName: string); +procedure SendSeparator; +procedure SendDebugFmt(const Msg: string; const Args: array of const); +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel); + +{ low-level routines } + +Procedure SendDebugMessage(Const Msg : TDebugMessage); +Function StartDebugServer : integer; +Procedure InitDebugClient; + +Const + SendError : String = ''; + +ResourceString + SProcessID = 'Process %s'; + SEntering = '> Entering '; + SExiting = '< Exiting '; + SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<'; + +implementation + +Uses SysUtils,process; + +Const + DmtInformation = lctInformation; + DmtWarning = lctWarning; + DmtError = lctError; + ErrorLevel : Array[TDebugLevel] of integer + = (dmtInformation,dmtWarning,dmtError); + +var + DebugClient : TSimpleIPCClient = nil; + MsgBuffer : TMemoryStream = Nil; + ServerID : Integer; + +Procedure WriteMessage(Const Msg : TDebugMessage); + +begin + MsgBuffer.Seek(0,soFrombeginning); + WriteDebugMessageToStream(MsgBuffer,Msg); + DebugClient.SendMessage(mtUnknown,MsgBuffer); +end; + + +procedure SendDebugMessage(Const Msg : TDebugMessage); + +begin + try + If (DebugClient=Nil) then + InitDebugClient; + WriteMessage(Msg); + except + On E : Exception do + SendError:=E.Message; + end; +end; + +procedure SendBoolean(const Identifier: string; const Value: Boolean); + +Const + Booleans : Array[Boolean] of string = ('False','True'); + +begin + SendDebugFmt('%s = %s',[Identifier,Booleans[value]]); +end; + +procedure SendDateTime(const Identifier: string; const Value: TDateTime); + +begin + SendDebugFmt('%s = %s',[Identifier,DateTimeToStr(Value)]); +end; + +procedure SendDebugEx(const Msg: string; MType: TDebugLevel); + +Var + Mesg : TDebugMessage; + +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=ErrorLevel[MTYpe]; + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendDebug(const Msg: string); + +Var + Mesg : TDebugMessage; +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=dmtInformation; + Mesg.Msg:=Msg; + SendDebugMessage(Mesg); +end; + +procedure SendInteger(const Identifier: string; const Value: Integer); + +begin + SendDebugFmt('%s = %d',[identifier,Value]); +end; + +procedure SendMethodEnter(const MethodName: string); + +begin + SendDebug(SEntering+MethodName); +end; + +procedure SendMethodExit(const MethodName: string); + +begin + SendDebug(SExiting+MethodName); +end; + +procedure SendSeparator; + +begin + SendDebug(SSeparator); +end; + +procedure SendDebugFmt(const Msg: string; const Args: array of const); + +Var + Mesg : TDebugMessage; + +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=dmtInformation; + Mesg.Msg:=Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel); + +Var + Mesg : TDebugMessage; + +begin + Mesg.MsgTimeStamp:=Now; + Mesg.MsgType:=ErrorLevel[mType]; + Mesg.Msg:=Format(Msg,Args); + SendDebugMessage(Mesg); +end; + +function StartDebugServer : Integer; + +begin + With TProcess.Create(Nil) do + Try + CommandLine:='debugserver'; + Execute; + Result:=ProcessID; + Finally + Free; + end; +end; + +procedure FreeDebugClient; + +Var + msg : TDebugMessage; + +begin + try + If (DebugClient<>Nil) and + (DebugClient.ServerRunning) then + begin + Msg.MsgType:=lctStop; + Msg.MsgTimeStamp:=Now; + Msg.Msg:=Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); + end; + FreeAndNil(MsgBuffer); + FreeAndNil(DebugClient); + except + end; +end; + +Procedure InitDebugClient; + +Var + msg : TDebugMessage; + I : Integer; + +begin + DebugClient:=TSimpleIPCClient.Create(Nil); + DebugClient.ServerID:=DebugServerID; + If not DebugClient.ServerRunning then + begin + ServerID:=StartDebugServer; + I:=0; + While (I<10) and not DebugClient.ServerRunning do + begin + Inc(I); + Sleep(100); + end; + end; + DebugClient.Connect; + MsgBuffer:=TMemoryStream.Create; + Msg.MsgType:=lctIdentify; + Msg.MsgTimeStamp:=Now; + Msg.Msg:=Format(SProcessID,[ApplicationName]); + WriteMessage(Msg); +end; + +Initialization + +Finalization + FreeDebugClient; +end. diff --git a/fcl/inc/msgintf.pp b/fcl/inc/msgintf.pp new file mode 100644 index 0000000000..0a9b0702b4 --- /dev/null +++ b/fcl/inc/msgintf.pp @@ -0,0 +1,102 @@ +{ + This file is part of the Free Component library. + Copyright (c) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + + Debugserver Client/Server common code. + + 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. + + **********************************************************************} +{$mode objfpc} +{$h+} +unit msgintf; + +interface + +uses Classes; + +Const + DebugServerID : String = 'fpcdebugserver'; + + lctStop = -1; + lctInformation = 0; + lctWarning = 1; + lctError = 2; + lctIdentify = 3; + +Type + TDebugMessage = Record + MsgType : Integer; + MsgTimeStamp : TDateTime; + Msg : String; + end; + +Procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); +Procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); +Function DebugMessageName(msgType : Integer) : String; + + +implementation + +resourcestring + SStop = 'Stop'; + SInformation = 'Information'; + SWarning = 'Warning'; + SError = 'Error'; + SIdentify = 'Identify'; + SUnknown = 'Unknown'; + +procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage); + +Var + MsgSize : Integer; + +begin + With AStream do + begin + ReadBuffer(Msg.MsgType,SizeOf(Integer)); + ReadBuffer(Msg.MsgTimeStamp,SizeOf(TDateTime)); + ReadBuffer(MsgSize,SizeOf(Integer)); + SetLength(Msg.Msg,MsgSize); + If (MsgSize<>0) then + ReadBuffer(Msg.msg[1],MsgSize); + end; +end; + +procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage); + +Var + MsgSize : Integer; + +begin + With AStream do + begin + WriteBuffer(Msg.MsgType,SizeOf(Integer)); + WriteBuffer(Msg.MsgTimeStamp,SizeOf(TDateTime)); + MsgSize:=Length(Msg.Msg); + WriteBuffer(MsgSize,SizeOf(Integer)); + WriteBuffer(Msg.msg[1],MsgSize); + end; +end; + +Function DebugMessageName(msgType : Integer) : String; + +begin + Case MsgType of + lctStop : Result:=SStop; + lctInformation : Result:=SInformation; + lctWarning : Result:=SWarning; + lctError : Result:=SError; + lctIdentify : Result:=SIdentify; + else + Result:=SUnknown; + end; +end; + +end. diff --git a/fcl/inc/simpleipc.pp b/fcl/inc/simpleipc.pp new file mode 100644 index 0000000000..289a7ddada --- /dev/null +++ b/fcl/inc/simpleipc.pp @@ -0,0 +1,415 @@ +{ + This file is part of the Free Component library. + Copyright (c) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + + Unit implementing 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. + + **********************************************************************} +unit simpleipc; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +Const + MsgVersion = 1; + +Type + + TMessageType = (mtUnknown,mtString); // For now + TMsgHeader = Packed record + Version : Byte; + msgType : TMessageType; + MsgLen : Integer; + end; + + TSimpleIPCServer = class; + TSimpleIPCClient = class; + + { TIPCServerComm } + + TIPCServerComm = Class(TObject) + Private + FOwner : TSimpleIPCServer; + Public + Constructor Create(AOwner : TSimpleIPCServer); virtual; + Property Owner : TSimpleIPCServer read FOwner; + Procedure StartServer; virtual; Abstract; + Procedure StopServer;virtual; Abstract; + Function PeekMessage(TimeOut : Integer) : Boolean;virtual; Abstract; + Function GetInstanceID : String; virtual; abstract; + Procedure ReadMessage ;virtual; Abstract; + Property InstanceID : String read GetInstanceID; + end; + TIPCServerCommClass = Class of TIPCServerComm; + + { TSimpleIPC } + TSimpleIPC = Class(TComponent) + Private + procedure SetActive(const AValue: Boolean); + procedure SetServerID(const AValue: String); + Protected + FBusy: Boolean; + FActive : Boolean; + FServerID : String; + Procedure DoError(Msg : String; Args : Array of const); + Procedure CheckInactive; + Procedure CheckActive; + Procedure Activate; virtual; abstract; + Procedure Deactivate; virtual; abstract; + Property Busy : Boolean Read FBusy; + Published + Property Active : Boolean Read FActive Write SetActive; + Property ServerID : String Read FServerID Write SetServerID; + end; + + { TSimpleIPCServer } + + TSimpleIPCServer = Class(TSimpleIPC) + private + FGlobal: Boolean; + FOnMessage: TNotifyEvent; + FMsgData : TStream; + function GetInstanceID: String; + function GetStringMessage: String; + procedure SetGlobal(const AValue: Boolean); + Protected + FIPCComm: TIPCServerComm; + Function CommClass : TIPCServerCommClass; virtual; + Procedure Activate; override; + Procedure Deactivate; override; + Procedure ReadMessage; + Public + Constructor Create(AOwner : TComponent); override; + Destructor destroy; override; + Procedure StartServer; + Procedure StopServer; + Function PeekMessage(TimeOut : Integer; DoReadMessage : Boolean): Boolean; + Property StringMessage : String Read GetStringMessage; + Procedure GetMessageData(Stream : TStream); + Property MsgData : TStream Read FMsgData; + Property InstanceID : String Read GetInstanceID; + Published + Property Global : Boolean Read FGlobal Write SetGlobal; + Property OnMessage : TNotifyEvent Read FOnMessage Write FOnMessage; + end; + + + { TIPCClientComm} + TIPCClientComm = Class(TObject) + private + FOwner: TSimpleIPCClient; + Public + Constructor Create(AOwner : TSimpleIPCClient); virtual; + Property Owner : TSimpleIPCClient read FOwner; + Procedure Connect; virtual; abstract; + Procedure Disconnect; virtual; abstract; + Function ServerRunning : Boolean; virtual; abstract; + Procedure SendMessage(MsgType : TMessageType; Stream : TStream);virtual;Abstract; + end; + TIPCClientCommClass = Class of TIPCClientComm; + + { TSimpleIPCClient } + TSimpleIPCClient = Class(TSimpleIPC) + Private + FServerInstance: String; + procedure SetServerInstance(const AValue: String); + Protected + FIPCComm : TIPCClientComm; + Procedure Activate; override; + Procedure Deactivate; override; + Function CommClass : TIPCClientCommClass; virtual; + Public + Constructor Create(AOwner : TComponent); override; + Destructor destroy; override; + Procedure Connect; + Procedure Disconnect; + Function ServerRunning : Boolean; + Procedure SendMessage(MsgType : TMessageType; Stream: TStream); + Procedure SendStringMessage(Msg : String); + Procedure SendStringmessageFmt(Msg : String; Args : Array of const); + Property ServerInstance : String Read FServerInstance Write SetServerInstance; + end; + + + EIPCError = Class(Exception); + +Var + DefaultIPCServerClass : TIPCServerCommClass = Nil; + DefaultIPCClientClass : TIPCClientCommClass = Nil; + +resourcestring + SErrServerNotActive = 'Server with ID %s is not active.'; + SErrActive = 'This operation is illegal when the server is active.'; + SErrInActive = 'This operation is illegal when the server is inactive.'; + + +implementation + +{ --------------------------------------------------------------------- + Include platform specific implementation. + Should implement the CommClass method of both server and client component, + as well as the communication class itself. + + This comes first, to allow the uses clause to be set. + --------------------------------------------------------------------- } + +{$i simpleipc.inc} + +{ --------------------------------------------------------------------- + TIPCServerComm + ---------------------------------------------------------------------} + +constructor TIPCServerComm.Create(AOwner: TSimpleIPCServer); +begin + FOwner:=AOWner; +end; + +{ --------------------------------------------------------------------- + TIPCClientComm + ---------------------------------------------------------------------} + +constructor TIPCClientComm.Create(AOwner: TSimpleIPCClient); +begin + FOwner:=AOwner; +end; + +{ --------------------------------------------------------------------- + TSimpleIPC + ---------------------------------------------------------------------} + +procedure TSimpleIPC.DoError(Msg: String; Args: array of const); +begin + Raise EIPCError.Create(Name+': '+Format(Msg,Args)); +end; + +procedure TSimpleIPC.CheckInactive; +begin + If Active then + DoError(SErrActive,[]); +end; + +procedure TSimpleIPC.CheckActive; +begin + If Not Active then + DoError(SErrInActive,[]); +end; + +procedure TSimpleIPC.SetActive(const AValue: Boolean); +begin + if (FActive<>AValue) then + begin + If AValue then + Activate + else + Deactivate; + end; +end; + +procedure TSimpleIPC.SetServerID(const AValue: String); +begin + if (FServerID<>AValue) then + begin + CheckInactive; + FServerID:=AValue + end; +end; + +{ --------------------------------------------------------------------- + TSimpleIPCServer + ---------------------------------------------------------------------} + +constructor TSimpleIPCServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FGlobal:=False; + FActive:=False; + FBusy:=False; + FMsgData:=TStringStream.Create(''); +end; + +destructor TSimpleIPCServer.destroy; +begin + Active:=False; + inherited destroy; +end; + +procedure TSimpleIPCServer.SetGlobal(const AValue: Boolean); +begin + if (FGlobal<>AValue) then + begin + CheckInactive; + FGlobal:=AValue; + end; +end; + +function TSimpleIPCServer.GetInstanceID: String; +begin + Result:=FIPCComm.InstanceID; +end; + + +function TSimpleIPCServer.GetStringMessage: String; +begin + Result:=TStringStream(FMsgData).DataString; +end; + + +procedure TSimpleIPCServer.StartServer; +begin + If (FServerID='') then + FServerID:=ApplicationName; + FIPCComm:=CommClass.Create(Self); + FIPCComm.StartServer; + FActive:=True; +end; + +procedure TSimpleIPCServer.StopServer; +begin + FIPCComm.StopServer; + FreeAndNil(FIPCComm); + FActive:=False; +end; + +function TSimpleIPCServer.PeekMessage(TimeOut: Integer; DoReadMessage: Boolean + ): Boolean; +begin + CheckActive; + FBusy:=True; + Try + Result:=FIPCComm.PeekMessage(Timeout); + Finally + FBusy:=False; + end; + If Result then + If DoReadMessage then + Readmessage; +end; + +procedure TSimpleIPCServer.ReadMessage; +begin + CheckActive; + FBusy:=True; + Try + FIPCComm.ReadMessage; + If Assigned(FOnMessage) then + FOnMessage(Self); + Finally + FBusy:=False; + end; +end; + +procedure TSimpleIPCServer.GetMessageData(Stream: TStream); +begin + Stream.CopyFrom(FMsgData,0); +end; + +procedure TSimpleIPCServer.Activate; +begin + StartServer; +end; + +procedure TSimpleIPCServer.Deactivate; +begin + StopServer; +end; + +{ --------------------------------------------------------------------- + TSimpleIPCClient + ---------------------------------------------------------------------} + +procedure TSimpleIPCClient.SetServerInstance(const AValue: String); +begin + CheckInactive; + FServerInstance:=AVAlue; +end; + +procedure TSimpleIPCClient.Activate; +begin + Connect; +end; + +procedure TSimpleIPCClient.Deactivate; +begin + DisConnect; +end; +constructor TSimpleIPCClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +end; + +destructor TSimpleIPCClient.destroy; +begin + Active:=False; + Inherited; +end; + +procedure TSimpleIPCClient.Connect; +begin + FIPCComm:=CommClass.Create(Self); + FIPCComm.Connect; + FActive:=True; +end; + +procedure TSimpleIPCClient.Disconnect; +begin + FIPCComm.DisConnect; + FreeAndNil(FIPCComm); + FActive:=False; +end; + +function TSimpleIPCClient.ServerRunning: Boolean; + +begin + If Assigned(FIPCComm) then + Result:=FIPCComm.ServerRunning + else + With CommClass.Create(Self) do + Try + Result:=ServerRunning; + finally + Free; + end; +end; + +procedure TSimpleIPCClient.SendMessage(MsgType : TMessageType; Stream: TStream); + +begin + CheckActive; + FBusy:=True; + Try + FIPCComm.SendMessage(MsgType,Stream); + Finally + FBusy:=False; + end; +end; + +procedure TSimpleIPCClient.SendStringMessage(Msg: String); + +Var + S : TStringStream; + +begin + S:=TStringStream.Create(Msg); + SendMessage(mtString,S); +end; + +procedure TSimpleIPCClient.SendStringmessageFmt(Msg: String; + Args: array of const); +begin + SendStringmessage(Format(Msg,Args)); +end; + +end. + diff --git a/fcl/tests/Makefile b/fcl/tests/Makefile index 263fa7198c..a532386fc5 100644 --- a/fcl/tests/Makefile +++ b/fcl/tests/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 1.9.8 [2005/04/10] # default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux BSDs = freebsd netbsd openbsd darwin UNIXs = linux $(BSDs) solaris qnx LIMIT83fs = go32v2 os2 emx watcom @@ -231,19 +231,19 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) ifeq ($(FULL_TARGET),i386-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),i386-go32v2) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs showver testproc testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs showver testproc testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),i386-os2) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs isockcli isocksvr testhres testnres testsres testrhre testrnre testrsre testur endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),i386-beos) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs @@ -275,14 +275,11 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs -endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),m68k-netbsd) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs @@ -300,7 +297,7 @@ ifeq ($(FULL_TARGET),m68k-palmos) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),powerpc-netbsd) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs @@ -309,13 +306,13 @@ ifeq ($(FULL_TARGET),powerpc-macos) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),powerpc-morphos) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),sparc-netbsd) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs @@ -324,19 +321,13 @@ ifeq ($(FULL_TARGET),sparc-solaris) override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs +override TARGET_PROGRAMS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testez tidea b64test b64test2 b64enc b64dec restest testz testz2 istream doecho testol testcont txmlreg testreg tstelcmd testapp testcgi testbs sockcli isockcli dsockcli socksvr isocksvr dsocksvr testhres testnres testsres testrhre testrnre testrsre testur ipcserver ipcclient debugtest dbugsrv endif override INSTALL_FPCPACKAGE=y ifeq ($(FULL_TARGET),i386-linux) @@ -384,9 +375,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_OPTIONS+=-S2 -endif ifeq ($(FULL_TARGET),m68k-linux) override COMPILER_OPTIONS+=-S2 endif @@ -438,15 +426,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_OPTIONS+=-S2 -endif ifeq ($(FULL_TARGET),arm-linux) override COMPILER_OPTIONS+=-S2 endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_OPTIONS+=-S2 -endif ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) endif @@ -1344,14 +1326,6 @@ REQUIRE_PACKAGES_PASJPEG=1 REQUIRE_PACKAGES_NETDB=1 REQUIRE_PACKAGES_LIBASYNC=1 endif -ifeq ($(FULL_TARGET),i386-wince) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_FCL=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifeq ($(FULL_TARGET),m68k-linux) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 @@ -1539,14 +1513,6 @@ REQUIRE_PACKAGES_POSTGRES=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_SQLITE=1 endif -ifeq ($(FULL_TARGET),x86_64-win64) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_FCL=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifeq ($(FULL_TARGET),arm-linux) REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_PASZLIB=1 @@ -1560,14 +1526,6 @@ REQUIRE_PACKAGES_POSTGRES=1 REQUIRE_PACKAGES_MYSQL=1 REQUIRE_PACKAGES_SQLITE=1 endif -ifeq ($(FULL_TARGET),arm-wince) -REQUIRE_PACKAGES_RTL=1 -REQUIRE_PACKAGES_PASZLIB=1 -REQUIRE_PACKAGES_FCL=1 -REQUIRE_PACKAGES_PASJPEG=1 -REQUIRE_PACKAGES_NETDB=1 -REQUIRE_PACKAGES_LIBASYNC=1 -endif ifdef REQUIRE_PACKAGES_RTL PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) ifneq ($(PACKAGEDIR_RTL),) @@ -1903,7 +1861,7 @@ else FPCCPUOPT:= endif endif -override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPT+=-Xs $(FPCCPUOPT) -n override FPCOPTDEF+=RELEASE endif ifdef STRIP diff --git a/fcl/tests/Makefile.fpc b/fcl/tests/Makefile.fpc index aad6379f80..e92b23d7c4 100644 --- a/fcl/tests/Makefile.fpc +++ b/fcl/tests/Makefile.fpc @@ -7,15 +7,19 @@ programs=stringl dparser fstream mstream list threads testrtf \ cfgtest xmldump htdump testez tidea \ b64test b64test2 b64enc b64dec restest testz testz2 \ istream doecho testol testcont txmlreg testreg tstelcmd \ - testapp testcgi testbs + testapp testcgi testbs programs_win32=showver testproc testhres testnres testsres testrhre \ - testrnre testrsre testur + testrnre testrsre testur ipcserver ipcclient debugtest \ + dbugsrv programs_linux=sockcli isockcli dsockcli socksvr isocksvr dsocksvr \ - testhres testnres testsres testrhre testrnre testrsre testur + testhres testnres testsres testrhre testrnre testrsre testur \ + ipcserver ipcclient debugtest dbugsrv programs_darwin=sockcli isockcli dsockcli socksvr isocksvr dsocksvr \ - testhres testnres testsres testrhre testrnre testrsre testur + testhres testnres testsres testrhre testrnre testrsre testur \ + ipcserver ipcclient debugtest dbugsrv programs_freebsd=sockcli isockcli dsockcli socksvr isocksvr dsocksvr \ - testhres testnres testsres testrhre testrnre testrsre testur + testhres testnres testsres testrhre testrnre testrsre testur \ + ipcserver ipcclient debugtest dbugsrv programs_os2=isockcli isocksvr testhres testnres testsres testrhre \ testrnre testrsre testur programs_emx=isockcli isocksvr testhres testnres testsres testrhre \ diff --git a/fcl/tests/README b/fcl/tests/README index 02fd66b29d..3dd97bdcb6 100644 --- a/fcl/tests/README +++ b/fcl/tests/README @@ -60,3 +60,6 @@ testur.pp Test of TURIParser class. (MVC) testapp.pp Test of TCustomApplication. (MVC) testcgi.pp Test of TCGIApplication class. (MVC) testbs.pp Test of TBufStream buffered stream (MVC) +ipcserver Server part of SimpleIPC unit test, console app (MVC) +ipcclient Client part of SimpleIPC unit test, console app (MVC) +testdebug Client part of dbugintf debugging info test (MVC) diff --git a/fcl/tests/dbugsrv.pp b/fcl/tests/dbugsrv.pp new file mode 100644 index 0000000000..f653ec8e82 --- /dev/null +++ b/fcl/tests/dbugsrv.pp @@ -0,0 +1,37 @@ +program dbugsrv; + +{$APPTYPE CONSOLE} + +uses + classes,SysUtils,simpleipc,msgintf; + +Var + Srv : TSimpleIPCServer; + S : String; + Msg : TDebugMessage; + +begin + Srv:=TSimpleIPCServer.Create(Nil); + Try + Srv.ServerID:=DebugServerID; + Srv.Global:=True; + Srv.Active:=True; + Srv.StartServer; + Writeln('Server started. Listening for debug messages'); + Repeat + If Srv.PeekMessage(1,True) then + begin + Srv.MsgData.Seek(0,soFrombeginning); + ReadDebugMessageFromStream(Srv.MsgData,MSg); + Write(FormatDateTime('hh:nn:ss.zzz',Msg.MsgTimeStamp),': '); + Write(DebugMessageName(MSg.MsgType):12,' '); + Writeln(Msg.Msg); + end + else + Sleep(10); + Until False; + Finally + Srv.Free; + end; +end. + diff --git a/fcl/tests/debugtest.pp b/fcl/tests/debugtest.pp new file mode 100644 index 0000000000..0ac2ba3c47 --- /dev/null +++ b/fcl/tests/debugtest.pp @@ -0,0 +1,31 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2003 by the Free Pascal development team + + Interactive test for debugserver. + + 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. + + **********************************************************************} +program testdebug; + +uses dbugintf; + +Var + S : String; + +begin + Repeat + Writeln('Enter message to send to debug server (STOP exits): '); + Write('> '); + Readln(S); + SendDebugEx(S,dlError); + If (SendError<>'') then + Writeln('Error : ',SendError); + Until (S='STOP'); +end. diff --git a/fcl/tests/ipcclient.pp b/fcl/tests/ipcclient.pp new file mode 100644 index 0000000000..4e00a37c58 --- /dev/null +++ b/fcl/tests/ipcclient.pp @@ -0,0 +1,19 @@ +{$mode objfpc} +{$h+} +program ipcclient; + +uses simpleipc; + +begin + With TSimpleIPCClient.Create(Nil) do + try + ServerID:='ipcserver'; + If (ParamCount>0) then + ServerInstance:=Paramstr(1); + Active:=True; + SendStringMessage('Testmessage from client'); + Active:=False; + finally + Free; + end; +end. diff --git a/fcl/tests/ipcserver.pp b/fcl/tests/ipcserver.pp new file mode 100644 index 0000000000..6029c5adaa --- /dev/null +++ b/fcl/tests/ipcserver.pp @@ -0,0 +1,33 @@ +program ipccerver; + +{$APPTYPE CONSOLE} + +uses + SysUtils, + simpleipc; + +Var + Srv : TSimpleIPCServer; + S : String; + +begin + Srv:=TSimpleIPCServer.Create(Nil); + Try + Srv.ServerID:='ipcserver'; + Srv.Global:=True; + Srv.StartServer; + Writeln('Server started. Listening for messages'); + Repeat + If Srv.PeekMessage(1,True) then + begin + S:=Srv.StringMessage; + Writeln('Received message : ',S); + end + else + Sleep(10); + Until CompareText(S,'stop')=0; + Finally + Srv.Free; + end; +end. + diff --git a/fcl/unix/simpleipc.inc b/fcl/unix/simpleipc.inc new file mode 100644 index 0000000000..25fc6ccc5c --- /dev/null +++ b/fcl/unix/simpleipc.inc @@ -0,0 +1,188 @@ +{ + This file is part of the Free Component library. + Copyright (c) 2005 by Michael Van Canneyt, member of + the Free Pascal development team + + Unix 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 baseunix; + +ResourceString + SErrFailedToCreatePipe = 'Failed to create named pipe: %s'; + SErrFailedToRemovePipe = 'Failed to remove named pipe: %s'; + +{ --------------------------------------------------------------------- + TPipeClientComm + ---------------------------------------------------------------------} + +Type + TPipeClientComm = Class(TIPCClientComm) + Private + FFileName: String; + FStream: TFileStream; + Public + Constructor Create(AOWner : TSimpleIPCClient); override; + Procedure Connect; override; + Procedure Disconnect; override; + Procedure SendMessage(MsgType : TMessageType; Stream : TStream); override; + Function ServerRunning : Boolean; override; + Property FileName : String Read FFileName; + Property Stream : TFileStream Read FStream; + end; + + +constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient); + +Var + D : String; + +begin + inherited Create(AOWner); + FFileName:=Owner.ServerID; + If (Owner.ServerInstance<>'') then + FFileName:=FFileName+'-'+Owner.ServerInstance; + D:='/tmp/'; // Change to something better later + FFileName:=D+FFileName; +end; + + +procedure TPipeClientComm.Connect; +begin + If Not ServerRunning then + Owner.DoError(SErrServerNotActive,[Owner.ServerID]); + FStream:=TFileStream.Create(FFileName,fmOpenReadWrite); +end; + +procedure TPipeClientComm.Disconnect; +begin + FreeAndNil(FStream); +end; + +procedure TPipeClientComm.SendMessage(MsgType : TMessagetype; Stream: TStream); + +Var + Hdr : TMsgHeader; + P,L,Count : Integer; + +begin + Hdr.Version:=MsgVersion; + Hdr.msgType:=mtString; + Hdr.MsgLen:=Stream.Size; + FStream.WriteBuffer(hdr,SizeOf(hdr)); + FStream.CopyFrom(Stream,0); +end; + +function TPipeClientComm.ServerRunning: Boolean; +begin + Result:=FileExists(FFileName); +end; + + +{ --------------------------------------------------------------------- + TPipeServerComm + ---------------------------------------------------------------------} + +Type + TPipeServerComm = Class(TIPCServerComm) + Private + FFileName: String; + FStream: TFileStream; + Public + Constructor Create(AOWner : TSimpleIPCServer); override; + Procedure StartServer; override; + Procedure StopServer; override; + Function PeekMessage(TimeOut : Integer) : Boolean; override; + Procedure ReadMessage ; override; + Function GetInstanceID : String;override; + Property FileName : String Read FFileName; + Property Stream : TFileStream Read FStream; + end; + +constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer); + +Var + D : String; + +begin + inherited Create(AOWner); + FFileName:=Owner.ServerID; + If Not Owner.Global then + FFileName:=FFileName+'-'+IntToStr(fpGetPID); + D:='/tmp/'; // Change to something better later + FFileName:=D+FFileName; +end; + + +procedure TPipeServerComm.StartServer; +begin + If not FileExists(FFileName) then + If (fpmkFifo(FFileName,438)<>0) then + Owner.DoError(SErrFailedToCreatePipe,[FFileName]); + FStream:=TFileStream.Create(FFileName,fmOpenReadWrite); +end; + +procedure TPipeServerComm.StopServer; +begin + FreeAndNil(FStream); + if Not DeleteFile(FFileName) then + Owner.DoError(SErrFailedtoRemovePipe,[FFileName]); +end; + +function TPipeServerComm.PeekMessage(TimeOut: Integer): Boolean; + +Var + FDS : TFDSet; + +begin + fpfd_zero(FDS); + fpfd_set(FStream.Handle,FDS); + Result:=fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0; +end; + +procedure TPipeServerComm.ReadMessage; + +Var + L,P,Count : Integer; + Hdr : TMsgHeader; + +begin + FStream.ReadBuffer(Hdr,SizeOf(Hdr)); + Count:=Hdr.MsgLen; + Owner.FMsgData.Seek(0,soFrombeginning); + Owner.FMsgData.CopyFrom(FStream,Count); +end; + +function TPipeServerComm.GetInstanceID: String; +begin + Result:=IntToStr(fpGetPID); +end; + +{ --------------------------------------------------------------------- + Set TSimpleIPCClient / TSimpleIPCServer defaults. + ---------------------------------------------------------------------} + +Function TSimpleIPCServer.CommClass : TIPCServerCommClass; + +begin + if (DefaultIPCServerClass<>Nil) then + Result:=DefaultIPCServerClass + else + Result:=TPipeServerComm; +end; + +function TSimpleIPCClient.CommClass: TIPCClientCommClass; +begin + if (DefaultIPCClientClass<>Nil) then + Result:=DefaultIPCClientClass + else + Result:=TPipeClientComm; +end; diff --git a/fcl/win32/simpleipc.inc b/fcl/win32/simpleipc.inc new file mode 100644 index 0000000000..1649b9d779 --- /dev/null +++ b/fcl/win32/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 : pchar = '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 : String; + FDataPushed : Boolean; + FUnction AllocateHWnd(Const aWindowName : String) : 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 : String 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 aWindowName: String): HWND; + +var + cls: TWndClass; + 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, + PChar(aWindowName), WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result=0) then + Owner.DoError(SErrFailedToCreateWindow,[aWindowName]); + 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,PChar(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,PChar(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; +