Browse Source

* Comobj and comserv enhancements by mspiller, #14822 (which also bears relevance to 10569,14807)

git-svn-id: trunk@13876 -
marco 16 years ago
parent
commit
3f75bea982

+ 1 - 0
.gitattributes

@@ -5059,6 +5059,7 @@ packages/winunits-base/src/comconst.pp svneol=native#text/plain
 packages/winunits-base/src/commctrl.pp svneol=native#text/plain
 packages/winunits-base/src/commctrl.pp svneol=native#text/plain
 packages/winunits-base/src/commdlg.pp svneol=native#text/plain
 packages/winunits-base/src/commdlg.pp svneol=native#text/plain
 packages/winunits-base/src/comobj.pp svneol=native#text/plain
 packages/winunits-base/src/comobj.pp svneol=native#text/plain
+packages/winunits-base/src/comserv.pp svneol=native#text/plain
 packages/winunits-base/src/dwmapi.pp svneol=native#text/plain
 packages/winunits-base/src/dwmapi.pp svneol=native#text/plain
 packages/winunits-base/src/flatsb.pp svneol=native#text/plain
 packages/winunits-base/src/flatsb.pp svneol=native#text/plain
 packages/winunits-base/src/htmlhelp.pp svneol=native#text/plain
 packages/winunits-base/src/htmlhelp.pp svneol=native#text/plain

+ 59 - 59
packages/winunits-base/Makefile

@@ -1,5 +1,5 @@
 #
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/09/26]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/10/16]
 #
 #
 default: all
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -441,178 +441,178 @@ ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_UNITS+=buildwinutilsbase
 override TARGET_UNITS+=buildwinutilsbase
 endif
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-win32)
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-beos)
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netware)
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-emx)
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-wince)
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-linux)
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-wince)
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-gba)
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-nds)
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+override TARGET_IMPLICITUNITS+=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 endif
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=jwawintype comconst
 override TARGET_RSTS+=jwawintype comconst

+ 1 - 1
packages/winunits-base/Makefile.fpc

@@ -9,7 +9,7 @@ version=2.5.1
 [target]
 [target]
 units=buildwinutilsbase
 units=buildwinutilsbase
 implicitunits=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver \
 implicitunits=flatsb winver mmsystem comobj comconst commdlg commctrl ole2 activex shellapi shlobj oleserver \
-               shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils
+	shfolder richedit imagehlp wininet uxtheme dwmapi multimon htmlhelp winutils comserv
 
 
 examples=examples
 examples=examples
 
 

+ 1 - 1
packages/winunits-base/src/buildwinutilsbase.pp

@@ -23,7 +23,7 @@ interface
 uses
 uses
     flatsb, winver, mmsystem, comconst, commctrl, comobj, commdlg,
     flatsb, winver, mmsystem, comconst, commctrl, comobj, commdlg,
     ole2, activex, shellapi, shlobj, oleserver,  shfolder, richedit,
     ole2, activex, shellapi, shlobj, oleserver,  shfolder, richedit,
-    imagehlp, wininet, uxtheme, dwmapi, multimon, htmlhelp, winutils;
+    imagehlp, wininet, uxtheme, dwmapi, multimon, htmlhelp, winutils,comserv;
 
 
 implementation
 implementation
 
 

+ 187 - 18
packages/winunits-base/src/comobj.pp

@@ -18,8 +18,10 @@ unit comobj;
 
 
   interface
   interface
 
 
+{define DEBUG_COM}
+
     uses
     uses
-      Windows,Types,Variants,Sysutils,ActiveX;
+      Windows,Types,Variants,Sysutils,ActiveX,contnrs;
 
 
     type
     type
       EOleError = class(Exception);
       EOleError = class(Exception);
@@ -68,9 +70,16 @@ unit comobj;
 
 
       TFactoryProc = procedure(Factory: TComObjectFactory) of object;
       TFactoryProc = procedure(Factory: TComObjectFactory) of object;
 
 
+      { TComClassManager }
+
       TComClassManager = class(TObject)
       TComClassManager = class(TObject)
+      private
+        fClassFactoryList: TObjectList;
+      public
         constructor Create;
         constructor Create;
         destructor Destroy; override;
         destructor Destroy; override;
+        procedure AddObjectFactory(factory: TComObjectFactory);
+        procedure RemoveObjectFactory(factory: TComObjectFactory);
         procedure ForEachFactory(ComServer: TComServerObject; FactoryProc: TFactoryProc);
         procedure ForEachFactory(ComServer: TComServerObject; FactoryProc: TFactoryProc);
         function GetFactoryFromClass(ComClass: TClass): TComObjectFactory;
         function GetFactoryFromClass(ComClass: TClass): TComObjectFactory;
         function GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
         function GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
@@ -125,7 +134,8 @@ unit comobj;
 
 
       TComObjectFactory = class(TObject, IUnknown, IClassFactory, IClassFactory2)
       TComObjectFactory = class(TObject, IUnknown, IClassFactory, IClassFactory2)
       private
       private
-        Next: TComObjectFactory;
+        FRefCount : Integer;
+        //Next: TComObjectFactory;
         FComServer: TComServerObject;
         FComServer: TComServerObject;
         FComClass: TClass;
         FComClass: TClass;
         FClassID: TGUID;
         FClassID: TGUID;
@@ -134,7 +144,7 @@ unit comobj;
         FErrorIID: TGUID;
         FErrorIID: TGUID;
         FInstancing: TClassInstancing;
         FInstancing: TClassInstancing;
         FLicString: WideString;
         FLicString: WideString;
-        FRegister: Longint;
+        //FRegister: Longint;
         FShowErrors: Boolean;
         FShowErrors: Boolean;
         FSupportsLicensing: Boolean;
         FSupportsLicensing: Boolean;
         FThreadingModel: TThreadingModel;
         FThreadingModel: TThreadingModel;
@@ -242,7 +252,7 @@ unit comobj;
 implementation
 implementation
 
 
     uses
     uses
-      ComConst,Ole2;
+      ComConst,Ole2, Registry;
 
 
     var
     var
       Uninitializing : boolean;
       Uninitializing : boolean;
@@ -452,34 +462,83 @@ implementation
 
 
     constructor TComClassManager.Create;
     constructor TComClassManager.Create;
       begin
       begin
-        RunError(217);
+        fClassFactoryList := TObjectList.create(true);
       end;
       end;
 
 
 
 
     destructor TComClassManager.Destroy;
     destructor TComClassManager.Destroy;
       begin
       begin
-        RunError(217);
+        fClassFactoryList.Free;
+      end;
+
+    procedure TComClassManager.AddObjectFactory(factory: TComObjectFactory);
+      begin
+{$ifdef DEBUG_COM}
+        WriteLn('AddObjectFactory: ', GUIDToString(factory.FClassID), ' ', factory.FClassName);
+{$endif}
+        fClassFactoryList.Add(factory);
       end;
       end;
 
 
+    procedure TComClassManager.RemoveObjectFactory(
+          factory: TComObjectFactory);
+      begin
+        fClassFactoryList.Remove(factory);
+      end;
 
 
     procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
     procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
       FactoryProc: TFactoryProc);
       FactoryProc: TFactoryProc);
+      var
+        i: Integer;
+        obj: TComObjectFactory;
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('ForEachFactory');
+{$endif}
+        for i := 0 to fClassFactoryList.Count - 1 do
+        begin
+          obj := TComObjectFactory(fClassFactoryList[i]);
+          if obj.ComServer = ComServer then
+            FactoryProc(obj);
+        end;
       end;
       end;
 
 
 
 
     function TComClassManager.GetFactoryFromClass(ComClass: TClass
     function TComClassManager.GetFactoryFromClass(ComClass: TClass
       ): TComObjectFactory;
       ): TComObjectFactory;
+      var
+        i: Integer;
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('GetFactoryFromClass: ', ComClass.ClassName);
+{$endif}
+        for i := 0 to fClassFactoryList.Count - 1 do
+        begin
+          Result := TComObjectFactory(fClassFactoryList[i]);
+          if ComClass = Result.ComClass then
+            Exit();
+        end;
+        Result := nil;
       end;
       end;
 
 
 
 
     function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID
     function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID
       ): TComObjectFactory;
       ): TComObjectFactory;
+      var
+        i: Integer;
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('GetFactoryFromClassID: ', GUIDToString(ClassId));
+{$endif}
+        for i := 0 to fClassFactoryList.Count - 1 do
+        begin
+          Result := TComObjectFactory(fClassFactoryList[i]);
+          if IsEqualGUID(ClassID, Result.ClassID) then
+            Exit();
+        end;
+{$ifdef DEBUG_COM}
+        WriteLn('GetFactoryFromClassID not found: ', GUIDToString(ClassId));
+{$endif}
+        Result := nil;
       end;
       end;
 
 
 
 
@@ -622,43 +681,66 @@ implementation
 
 
     function TComObjectFactory.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
     function TComObjectFactory.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
       begin
       begin
-        RunError(217);
+        if GetInterface(IID,Obj) then
+          Result:=S_OK
+        else
+          Result:=E_NOINTERFACE;
       end;
       end;
 
 
 
 
     function TComObjectFactory._AddRef: Integer; stdcall;
     function TComObjectFactory._AddRef: Integer; stdcall;
       begin
       begin
-        RunError(217);
+        Result:=InterlockedIncrement(FRefCount);
       end;
       end;
 
 
 
 
     function TComObjectFactory._Release: Integer; stdcall;
     function TComObjectFactory._Release: Integer; stdcall;
       begin
       begin
-        RunError(217);
+        Result:=InterlockedDecrement(FRefCount);
+        if Result=0 then
+          Self.Destroy;
       end;
       end;
 
 
 
 
     function TComObjectFactory.CreateInstance(const UnkOuter: IUnknown;
     function TComObjectFactory.CreateInstance(const UnkOuter: IUnknown;
       const IID: TGUID; out Obj): HResult; stdcall;
       const IID: TGUID; out Obj): HResult; stdcall;
+      var
+        comObject: TComObject;
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('CreateInstance: ', GUIDToString(IID));
+{$endif}
+        comObject := CreateComObject(UnkOuter);
+        if comObject.GetInterface(IID, Obj) then
+          Result := S_OK
+        else
+          Result := E_NOINTERFACE;
       end;
       end;
 
 
 
 
     function TComObjectFactory.LockServer(fLock: BOOL): HResult; stdcall;
     function TComObjectFactory.LockServer(fLock: BOOL): HResult; stdcall;
       begin
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('LockServer: ', fLock);
+{$endif}
         RunError(217);
         RunError(217);
       end;
       end;
 
 
 
 
     function TComObjectFactory.GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
     function TComObjectFactory.GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
       begin
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('GetLicInfo');
+{$endif}
         RunError(217);
         RunError(217);
       end;
       end;
 
 
 
 
     function TComObjectFactory.RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
     function TComObjectFactory.RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
       begin
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('RequestLicKey');
+{$endif}
         RunError(217);
         RunError(217);
       end;
       end;
 
 
@@ -667,6 +749,9 @@ implementation
       const unkReserved: IUnknown; const iid: TIID; const bstrKey: WideString; out
       const unkReserved: IUnknown; const iid: TIID; const bstrKey: WideString; out
       vObject): HResult; stdcall;
       vObject): HResult; stdcall;
       begin
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('CreateInstanceLic');
+{$endif}
         RunError(217);
         RunError(217);
       end;
       end;
 
 
@@ -676,20 +761,35 @@ implementation
       Description: string; Instancing: TClassInstancing;
       Description: string; Instancing: TClassInstancing;
       ThreadingModel: TThreadingModel);
       ThreadingModel: TThreadingModel);
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('TComObjectFactory.Create');
+{$endif}
+        FRefCount := 1;
+        FClassID := ClassID;
+        FThreadingModel := ThreadingModel;
+        FDescription := Description;
+        FClassName := Name;
+        FComServer := ComServer;
+        FComClass := ComClass;
+        FInstancing := Instancing;;
+        ComClassManager.AddObjectFactory(Self);
       end;
       end;
 
 
 
 
     destructor TComObjectFactory.Destroy;
     destructor TComObjectFactory.Destroy;
       begin
       begin
-        RunError(217);
+        ComClassManager.RemoveObjectFactory(Self);
+        //RunError(217);
       end;
       end;
 
 
 
 
     function TComObjectFactory.CreateComObject(const Controller: IUnknown
     function TComObjectFactory.CreateComObject(const Controller: IUnknown
       ): TComObject;
       ): TComObject;
       begin
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('TComObjectFactory.CreateComObject');
+{$endif}
+        Result := TComClass(FComClass).Create();
       end;
       end;
 
 
 
 
@@ -699,9 +799,70 @@ implementation
       end;
       end;
 
 
 
 
+(* Copy from Sample.RGS (http://www.codeproject.com/KB/atl/RegistryMap.aspx)
+HKCR
+{
+    %PROGID%.%VERSION% = s '%DESCRIPTION%'
+    {
+        CLSID = s '%CLSID%'
+    }
+    %PROGID% = s '%DESCRIPTION%'
+    {
+        CLSID = s '%CLSID%'
+        CurVer = s '%PROGID%.%VERSION%'
+    }
+    NoRemove CLSID
+    {
+        ForceRemove %CLSID% = s '%DESCRIPTION%'
+        {
+            ProgID = s '%PROGID%.%VERSION%'
+            VersionIndependentProgID = s '%PROGID%'
+            ForceRemove 'Programmable'
+            InprocServer32 = s '%MODULE%'
+            {
+                val ThreadingModel = s '%THREADING%'
+            }
+            'TypeLib' = s '%LIBID%'
+        }
+    }
+}
+*)
+
     procedure TComObjectFactory.UpdateRegistry(Register: Boolean);
     procedure TComObjectFactory.UpdateRegistry(Register: Boolean);
+      var
+        reg: TRegistry;
       begin
       begin
         RunError(217);
         RunError(217);
+
+        //todo: finish this
+        if Register then
+        begin
+          reg := TRegistry.Create;
+          reg.RootKey := HKEY_CLASSES_ROOT;
+          reg.OpenKey(FClassName + '.1', True);
+          reg.WriteString('', Description);
+          reg.WriteString('CLSID', GUIDToString(ClassID));
+          reg.CloseKey;
+
+          reg.OpenKey(FClassName, True);
+          reg.WriteString('', Description);
+          reg.WriteString('CLSID', GUIDToString(ClassID));
+          reg.WriteString('CurVer', FClassName + '.1');
+          reg.CloseKey;
+
+          reg.OpenKey('CLSID\' + GUIDToString(ClassID), True);
+          reg.WriteString('', Description);
+          reg.WriteString('ProgID', FClassName);
+          reg.WriteString('VersionIndependentProgID', FClassName);
+          reg.WriteString('InprocServer32', 'MODULENAME');
+          reg.CloseKey;
+
+          reg.Free;
+
+        end;
+        //This should be in typedcomobject
+        //reg.WriteString('TypeLib', FClassName);
+
       end;
       end;
 
 
 
 
@@ -1087,8 +1248,14 @@ implementation
 
 
     constructor TTypedComObjectFactory.Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID;
     constructor TTypedComObjectFactory.Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID;
       AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle);
       AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle);
+      var
+        TypedName, TypedDescription: WideString;
       begin
       begin
-        RunError(217);
+        //TDB get name and description from typelib (check if this is a valid guid)
+        OleCheck(AComServer.GetTypeLib.GetTypeInfoOfGuid(AClassID, FClassInfo));
+        //bug FPC 0010569 - http://msdn2.microsoft.com/en-us/library/ms221396(VS.85).aspx
+        OleCheck(FClassInfo.GetDocumentation(-1, TypedName, TypedDescription, PLongWord(nil)^, PWideString(nil)^));
+        inherited Create(AComServer, TypedComClass, AClassID, TypedName, TypedDescription, AInstancing, AThreadingModel);
       end;
       end;
 
 
 
 
@@ -1100,6 +1267,9 @@ implementation
 
 
     procedure TTypedComObjectFactory.UpdateRegistry(Register: Boolean);
     procedure TTypedComObjectFactory.UpdateRegistry(Register: Boolean);
       begin
       begin
+        inherited UpdateRegistry(Register);
+        // 'TypeLib' = s '%LIBID%' missing ??? or does TComServer register it ?
+        //un/register typed library
         RunError(217);
         RunError(217);
       end;
       end;
 
 
@@ -1143,4 +1313,3 @@ finalization
     CoUninitialize;
     CoUninitialize;
 end.
 end.
 
 
-

+ 266 - 0
packages/winunits-base/src/comserv.pp

@@ -0,0 +1,266 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2006 by Florian Klaempfl
+    member of the Free Pascal development team.
+
+    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+}
+{$inline on}
+unit comserv;
+
+interface
+
+uses
+  Classes, SysUtils, comobj, ActiveX;
+
+{define DEBUG_COM}
+
+//according to doc
+// * ComServer Variable
+// * DllCanUnloadNow Routine
+// * DllGetClassObject Routine
+// * DllRegisterServer Routine
+// * DllUnregisterServer Routine
+// * TComServer Class
+
+//TODO Fix this
+const
+  CLASS_E_CLASSNOTAVAILABLE = -1;
+  SELFREG_E_CLASS = -2;
+
+type
+
+  { TComServer }
+
+  TComServer = class(TComServerObject)
+  private
+    fCountObject: Integer;
+    fCountFactory: Integer;
+  protected
+    function CountObject(Created: Boolean): Integer; override;
+    function CountFactory(Created: Boolean): Integer; override;
+    function GetHelpFileName: string; override;
+    function GetServerFileName: string; override;
+    function GetServerKey: string; override;
+    function GetServerName: string; override;
+    function GetStartSuspended: Boolean; override;
+    function GetTypeLib: ITypeLib; override;
+    procedure SetHelpFileName(const Value: string); override;
+
+
+    procedure RegisterServerFactory(Factory: TComObjectFactory);
+    procedure UnregisterServerFactory(Factory: TComObjectFactory);
+  public
+    constructor Create;
+    function CanUnloadNow: Boolean;
+    procedure RegisterServer;
+    procedure UnRegisterServer;
+  end;
+
+var
+  ComServer: TComServer = nil;
+
+//http://msdn.microsoft.com/en-us/library/ms690368%28VS.85%29.aspx
+//If the function succeeds, the return value is S_OK. Otherwise, it is S_FALSE.
+function DllCanUnloadNow: HResult; stdcall;
+
+
+//S_OK - The object was retrieved successfully.
+//CLASS_E_CLASSNOTAVAILABLE - The DLL does not support the class (object definition).
+function DllGetClassObject(const rclsid: REFIID {should be REFCLSID}; const riid: REFIID; out ppv: Pointer): HResult; stdcall;
+
+//S_OK - The registry entries were created successfully.
+//SELFREG_E_TYPELIB - The server was unable to complete the registration of all the type libraries used by its classes.
+//SELFREG_E_CLASS - The server was unable to complete the registration of all the object classes.
+function DllRegisterServer: HResult; stdcall;
+
+//S_OK - The registry entries were deleted successfully.
+//S_FALSE - Unregistration of this server's known entries was successful, but other entries still exist for this server's classes.
+//SELFREG_E_TYPELIB - The server was unable to remove the entries of all the type libraries used by its classes.
+//SELFREG_E_CLASS - The server was unable to remove the entries of all the object classes.
+function DllUnregisterServer: HResult; stdcall;
+
+implementation
+
+function DllCanUnloadNow: HResult; stdcall;
+begin
+{$ifdef DEBUG_COM}
+  WriteLn('DllCanUnloadNow called');
+{$endif}
+  if ComServer.CanUnloadNow then
+    Result := S_OK
+  else
+    Result := S_FALSE;
+{$ifdef DEBUG_COM}
+    WriteLn('DllCanUnloadNow return: ', Result);
+{$endif}
+end;
+
+{
+    //FROM MSDN (Error messages are different in MSDN.DllGetClassObject)
+
+    HRESULT hres = E_OUTOFMEMORY;
+    *ppvObj = NULL;
+
+    CClassFactory *pClassFactory = new CClassFactory(rclsid);
+    if (pClassFactory != NULL)   {
+        hRes = pClassFactory->QueryInterface(riid, ppvObj);
+        pClassFactory->Release();
+    }
+    return hRes;
+}
+
+function DllGetClassObject(const rclsid: REFIID {should be REFCLSID}; const riid: REFIID; out ppv: Pointer): HResult; stdcall;
+var
+  factory: TComObjectFactory;
+begin
+{$ifdef DEBUG_COM}
+  WriteLn('DllGetClassObject called: ', GUIDToString(rclsid), ' ', GUIDToString(riid));
+{$endif}
+
+  factory := ComClassManager.GetFactoryFromClassID(rclsid);
+  if factory = nil then
+    Result := CLASS_E_CLASSNOTAVAILABLE
+  else
+  begin
+    if factory.GetInterface(riid,ppv) then
+      Result := S_OK
+    else
+      Result := CLASS_E_CLASSNOTAVAILABLE;
+{$ifdef DEBUG_COM}
+    WriteLn('DllGetClassObject return: ', Result);
+{$endif}
+  end;
+end;
+
+function DllRegisterServer: HResult; stdcall;
+begin
+{$ifdef DEBUG_COM}
+  WriteLn('DllRegisterServer called');
+{$endif}
+  try
+    ComServer.RegisterServer;
+    Result := S_OK;
+  except
+    Result := SELFREG_E_CLASS;
+  end;
+
+end;
+
+function DllUnregisterServer: HResult; stdcall;
+begin
+{$ifdef DEBUG_COM}
+  WriteLn('DllUnregisterServer called');
+{$endif}
+  try
+    ComServer.UnregisterServer;
+    Result := S_OK;
+  except
+    Result := SELFREG_E_CLASS;
+  end;
+end;
+
+{ TComServer }
+
+function TComServer.CountObject(Created: Boolean): Integer;
+begin
+  if Created then
+    InterLockedIncrement(fCountObject)
+  else
+    InterLockedDecrement(fCountObject);
+end;
+
+function TComServer.CountFactory(Created: Boolean): Integer;
+begin
+  if Created then
+    InterLockedIncrement(fCountFactory)
+  else
+    InterLockedDecrement(fCountFactory);
+end;
+
+function TComServer.GetHelpFileName: string;
+begin
+  RunError(217);
+end;
+
+function TComServer.GetServerFileName: string;
+begin
+  RunError(217);
+end;
+
+function TComServer.GetServerKey: string;
+begin
+  RunError(217);
+end;
+
+function TComServer.GetServerName: string;
+begin
+  RunError(217);
+end;
+
+function TComServer.GetStartSuspended: Boolean;
+begin
+  RunError(217);
+end;
+
+function TComServer.GetTypeLib: ITypeLib;
+begin
+  RunError(217);
+end;
+
+procedure TComServer.SetHelpFileName(const Value: string);
+begin
+  RunError(217);
+end;
+
+procedure TComServer.RegisterServerFactory(Factory: TComObjectFactory);
+begin
+  Factory.UpdateRegistry(True);
+end;
+
+procedure TComServer.UnregisterServerFactory(Factory: TComObjectFactory);
+begin
+  Factory.UpdateRegistry(false);
+end;
+
+constructor TComServer.Create;
+begin
+  fCountFactory := 0;
+  fCountObject := 0;
+end;
+
+function TComServer.CanUnloadNow: Boolean;
+begin
+  Result := False;
+end;
+
+procedure TComServer.RegisterServer;
+begin
+  ComClassManager.ForEachFactory(self, @RegisterServerFactory);
+end;
+
+procedure TComServer.UnRegisterServer;
+begin
+  ComClassManager.ForEachFactory(self, @UnregisterServerFactory);
+end;
+
+initialization
+{$ifdef DEBUG_COM}
+  WriteLn('comserv initialization begin');
+{$endif}
+  ComServer := TComServer.Create;
+{$ifdef DEBUG_COM}
+  WriteLn('comserv initialization end');
+{$endif}
+finalization
+  ComServer.Free;
+end.
+