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/commdlg.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/flatsb.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
 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
 endif
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=jwawintype comconst

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

@@ -9,7 +9,7 @@ version=2.5.1
 [target]
 units=buildwinutilsbase
 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
 

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

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

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

@@ -18,8 +18,10 @@ unit comobj;
 
   interface
 
+{define DEBUG_COM}
+
     uses
-      Windows,Types,Variants,Sysutils,ActiveX;
+      Windows,Types,Variants,Sysutils,ActiveX,contnrs;
 
     type
       EOleError = class(Exception);
@@ -68,9 +70,16 @@ unit comobj;
 
       TFactoryProc = procedure(Factory: TComObjectFactory) of object;
 
+      { TComClassManager }
+
       TComClassManager = class(TObject)
+      private
+        fClassFactoryList: TObjectList;
+      public
         constructor Create;
         destructor Destroy; override;
+        procedure AddObjectFactory(factory: TComObjectFactory);
+        procedure RemoveObjectFactory(factory: TComObjectFactory);
         procedure ForEachFactory(ComServer: TComServerObject; FactoryProc: TFactoryProc);
         function GetFactoryFromClass(ComClass: TClass): TComObjectFactory;
         function GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
@@ -125,7 +134,8 @@ unit comobj;
 
       TComObjectFactory = class(TObject, IUnknown, IClassFactory, IClassFactory2)
       private
-        Next: TComObjectFactory;
+        FRefCount : Integer;
+        //Next: TComObjectFactory;
         FComServer: TComServerObject;
         FComClass: TClass;
         FClassID: TGUID;
@@ -134,7 +144,7 @@ unit comobj;
         FErrorIID: TGUID;
         FInstancing: TClassInstancing;
         FLicString: WideString;
-        FRegister: Longint;
+        //FRegister: Longint;
         FShowErrors: Boolean;
         FSupportsLicensing: Boolean;
         FThreadingModel: TThreadingModel;
@@ -242,7 +252,7 @@ unit comobj;
 implementation
 
     uses
-      ComConst,Ole2;
+      ComConst,Ole2, Registry;
 
     var
       Uninitializing : boolean;
@@ -452,34 +462,83 @@ implementation
 
     constructor TComClassManager.Create;
       begin
-        RunError(217);
+        fClassFactoryList := TObjectList.create(true);
       end;
 
 
     destructor TComClassManager.Destroy;
       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;
 
+    procedure TComClassManager.RemoveObjectFactory(
+          factory: TComObjectFactory);
+      begin
+        fClassFactoryList.Remove(factory);
+      end;
 
     procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
       FactoryProc: TFactoryProc);
+      var
+        i: Integer;
+        obj: TComObjectFactory;
       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;
 
 
     function TComClassManager.GetFactoryFromClass(ComClass: TClass
       ): TComObjectFactory;
+      var
+        i: Integer;
       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;
 
 
     function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID
       ): TComObjectFactory;
+      var
+        i: Integer;
       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;
 
 
@@ -622,43 +681,66 @@ implementation
 
     function TComObjectFactory.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
       begin
-        RunError(217);
+        if GetInterface(IID,Obj) then
+          Result:=S_OK
+        else
+          Result:=E_NOINTERFACE;
       end;
 
 
     function TComObjectFactory._AddRef: Integer; stdcall;
       begin
-        RunError(217);
+        Result:=InterlockedIncrement(FRefCount);
       end;
 
 
     function TComObjectFactory._Release: Integer; stdcall;
       begin
-        RunError(217);
+        Result:=InterlockedDecrement(FRefCount);
+        if Result=0 then
+          Self.Destroy;
       end;
 
 
     function TComObjectFactory.CreateInstance(const UnkOuter: IUnknown;
       const IID: TGUID; out Obj): HResult; stdcall;
+      var
+        comObject: TComObject;
       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;
 
 
     function TComObjectFactory.LockServer(fLock: BOOL): HResult; stdcall;
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('LockServer: ', fLock);
+{$endif}
         RunError(217);
       end;
 
 
     function TComObjectFactory.GetLicInfo(var licInfo: TLicInfo): HResult; stdcall;
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('GetLicInfo');
+{$endif}
         RunError(217);
       end;
 
 
     function TComObjectFactory.RequestLicKey(dwResrved: DWORD; out bstrKey: WideString): HResult; stdcall;
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('RequestLicKey');
+{$endif}
         RunError(217);
       end;
 
@@ -667,6 +749,9 @@ implementation
       const unkReserved: IUnknown; const iid: TIID; const bstrKey: WideString; out
       vObject): HResult; stdcall;
       begin
+{$ifdef DEBUG_COM}
+        WriteLn('CreateInstanceLic');
+{$endif}
         RunError(217);
       end;
 
@@ -676,20 +761,35 @@ implementation
       Description: string; Instancing: TClassInstancing;
       ThreadingModel: TThreadingModel);
       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;
 
 
     destructor TComObjectFactory.Destroy;
       begin
-        RunError(217);
+        ComClassManager.RemoveObjectFactory(Self);
+        //RunError(217);
       end;
 
 
     function TComObjectFactory.CreateComObject(const Controller: IUnknown
       ): TComObject;
       begin
-        RunError(217);
+{$ifdef DEBUG_COM}
+        WriteLn('TComObjectFactory.CreateComObject');
+{$endif}
+        Result := TComClass(FComClass).Create();
       end;
 
 
@@ -699,9 +799,70 @@ implementation
       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);
+      var
+        reg: TRegistry;
       begin
         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;
 
 
@@ -1087,8 +1248,14 @@ implementation
 
     constructor TTypedComObjectFactory.Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID;
       AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle);
+      var
+        TypedName, TypedDescription: WideString;
       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;
 
 
@@ -1100,6 +1267,9 @@ implementation
 
     procedure TTypedComObjectFactory.UpdateRegistry(Register: Boolean);
       begin
+        inherited UpdateRegistry(Register);
+        // 'TypeLib' = s '%LIBID%' missing ??? or does TComServer register it ?
+        //un/register typed library
         RunError(217);
       end;
 
@@ -1143,4 +1313,3 @@ finalization
     CoUninitialize;
 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.
+