paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 09:28:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Initial SimpleIPC implementation

Browse Source 
git-svn-id: trunk@985 -
This commit is contained in:
michael 2005-08-30 14:12:34 +00:00
parent 609f35b34c
commit 144088b14e
15 changed files with 1460 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

@ -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

236
fcl/Makefile
View File

@ -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

17
fcl/Makefile.fpc
View File

@ -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

245
fcl/inc/dbugintf.pp Normal file
View File

@ -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.

102
fcl/inc/msgintf.pp Normal file
View File

@ -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.

415
fcl/inc/simpleipc.pp Normal file
View File

@ -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.

70
fcl/tests/Makefile
View File

@ -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

14
fcl/tests/Makefile.fpc
View File

@ -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 \

3
fcl/tests/README
View File

@ -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)

37
fcl/tests/dbugsrv.pp Normal file
View File

@ -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.

31
fcl/tests/debugtest.pp Normal file
View File

@ -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.

19
fcl/tests/ipcclient.pp Normal file
View File

@ -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.

33
fcl/tests/ipcserver.pp Normal file
View File

@ -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.

188
fcl/unix/simpleipc.inc Normal file
View File

@ -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;

291
fcl/win32/simpleipc.inc Normal file
View File

@ -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;