! ErrorInfo.f90

! This module contains the COM interfaces ICreateErrorInfo,
! ISupportErrorInfo and IErrorInfo

	MODULE ErrorInfo
		USE DFWINTY
		USE DFCOM
		IMPLICIT NONE
	

		! IIDs		
		TYPE (GUID), PARAMETER :: IID_IErrorInfo = &
			GUID(#1CF2B120, #547D, #101B, &
			  CHAR('8E'X)//CHAR('65'X)//CHAR('08'X)//CHAR('00'X)// &
			  CHAR('2B'X)//CHAR('2B'X)//CHAR('D1'X)//CHAR('19'X))
		TYPE (GUID), PARAMETER :: IID_ICreateErrorInfo = &
			GUID(#22F03340, #547D, #101B, &
			  CHAR('8E'X)//CHAR('65'X)//CHAR('08'X)//CHAR('00'X)// &
			  CHAR('2B'X)//CHAR('2B'X)//CHAR('D1'X)//CHAR('19'X))
		TYPE (GUID), PARAMETER :: IID_ISupportErrorInfo = &
			GUID(#DF0B3D60, #548F, #101B, &
			  CHAR('8E'X)//CHAR('65'X)//CHAR('08'X)//CHAR('00'X)// &
			  CHAR('2B'X)//CHAR('2B'X)//CHAR('D1'X)//CHAR('19'X))

		! Interfaces

		! ICreateErrorInfo
		INTERFACE
  			INTEGER*4 FUNCTION ICreateErrorInfo_SetDescription($OBJECT, szDescription)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szDescription	! Unsupported type
				!DEC$ ATTRIBUTES VALUE	:: szDescription
			!DEC$ ATTRIBUTES STDCALL :: ICreateErrorInfo_SetDescription
			END FUNCTION ICreateErrorInfo_SetDescription
		END INTERFACE
		POINTER(ICreateErrorInfo_SetDescription_PTR, ICreateErrorInfo_SetDescription)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION ICreateErrorInfo_SetGUID($OBJECT, rguid)
				USE dfwinty
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(IN)	:: rguid	
				!DEC$ ATTRIBUTES REFERENCE	:: rguid
			!DEC$ ATTRIBUTES STDCALL :: ICreateErrorInfo_SetGUID
			END FUNCTION ICreateErrorInfo_SetGUID
		END INTERFACE
		POINTER(ICreateErrorInfo_SetGUID_PTR, ICreateErrorInfo_SetGUID)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION ICreateErrorInfo_SetHelpContext($OBJECT, dwHelpContext)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER*4, INTENT(IN)	:: dwHelpContext	! Unsigned
				!DEC$ ATTRIBUTES VALUE	:: dwHelpContext
			!DEC$ ATTRIBUTES STDCALL :: ICreateErrorInfo_SetHelpContext
			END FUNCTION ICreateErrorInfo_SetHelpContext
		END INTERFACE
		POINTER(ICreateErrorInfo_SetHelpContext_PTR, ICreateErrorInfo_SetHelpContext)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION ICreateErrorInfo_SetHelpFile($OBJECT, szHelpFile)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szHelpFile	! Unsupported type
				!DEC$ ATTRIBUTES VALUE	:: szHelpFile
			!DEC$ ATTRIBUTES STDCALL :: ICreateErrorInfo_SetHelpFile
			END FUNCTION ICreateErrorInfo_SetHelpFile
		END INTERFACE
		POINTER(ICreateErrorInfo_SetHelpFile_PTR, ICreateErrorInfo_SetHelpFile)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION ICreateErrorInfo_SetSource($OBJECT, szSource)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szSource	! Unsupported type
				!DEC$ ATTRIBUTES VALUE	:: szSource
			!DEC$ ATTRIBUTES STDCALL :: ICreateErrorInfo_SetSource
			END FUNCTION ICreateErrorInfo_SetSource
		END INTERFACE
		POINTER(ICreateErrorInfo_SetSource_PTR, ICreateErrorInfo_SetSource)	! routine pointer

		! ISupportErrorInfo
		INTERFACE
  			INTEGER*4 FUNCTION ISupportErrorInfo_InterfaceSupportsErrorInfo($OBJECT, riid)
				!USE AToI_TYPES
				USE DFWINTY
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(IN)	:: riid	
				!DEC$ ATTRIBUTES REFERENCE	:: riid
			!DEC$ ATTRIBUTES STDCALL :: ISupportErrorInfo_InterfaceSupportsErrorInfo
			END FUNCTION ISupportErrorInfo_InterfaceSupportsErrorInfo
		END INTERFACE
		POINTER(ISupportErrorInfo_InterfaceSupportsErrorInfo_PTR, ISupportErrorInfo_InterfaceSupportsErrorInfo)	! routine pointer

		! IErrorInfo
		INTERFACE
  			INTEGER*4 FUNCTION IErrorInfo_GetDescription($OBJECT, pBstrDescription)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(OUT)	:: pBstrDescription	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrDescription
			!DEC$ ATTRIBUTES STDCALL :: IErrorInfo_GetDescription
			END FUNCTION IErrorInfo_GetDescription
		END INTERFACE
		POINTER(IErrorInfo_GetDescription_PTR, IErrorInfo_GetDescription)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION IErrorInfo_GetGUID($OBJECT, pGUID)
				USE dfwinty
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(OUT)	:: pGUID	
				!DEC$ ATTRIBUTES REFERENCE	:: pGUID
			!DEC$ ATTRIBUTES STDCALL :: IErrorInfo_GetGUID
			END FUNCTION IErrorInfo_GetGUID
		END INTERFACE
		POINTER(IErrorInfo_GetGUID_PTR, IErrorInfo_GetGUID)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION IErrorInfo_GetHelpContext($OBJECT, pdwHelpContext)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER*4, INTENT(OUT)	:: pdwHelpContext	! Unsigned
				!DEC$ ATTRIBUTES REFERENCE	:: pdwHelpContext
			!DEC$ ATTRIBUTES STDCALL :: IErrorInfo_GetHelpContext
			END FUNCTION IErrorInfo_GetHelpContext
		END INTERFACE
		POINTER(IErrorInfo_GetHelpContext_PTR, IErrorInfo_GetHelpContext)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION IErrorInfo_GetHelpFile($OBJECT, pBstrHelpFile)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(OUT)	:: pBstrHelpFile	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrHelpFile
			!DEC$ ATTRIBUTES STDCALL :: IErrorInfo_GetHelpFile
			END FUNCTION IErrorInfo_GetHelpFile
		END INTERFACE
		POINTER(IErrorInfo_GetHelpFile_PTR, IErrorInfo_GetHelpFile)	! routine pointer
		INTERFACE
  			INTEGER*4 FUNCTION IErrorInfo_GetSource($OBJECT, pBstrSource)
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(OUT)	:: pBstrSource	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrSource
			!DEC$ ATTRIBUTES STDCALL :: IErrorInfo_GetSource
			END FUNCTION IErrorInfo_GetSource
		END INTERFACE
		POINTER(IErrorInfo_GetSource_PTR, IErrorInfo_GetSource)	! routine pointer


		! Module Procedures
		CONTAINS

			! ICreateErrorInfo
  			INTEGER*4 FUNCTION $ICreateErrorInfo_SetDescription($OBJECT, szDescription)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ICreateErrorInfo_SetDescription
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szDescription	! Unsupported type
				!DEC$ ATTRIBUTES REFERENCE	:: szDescription
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 20	! Add routine table offset
				ICreateErrorInfo_SetDescription_PTR = $VTBL
				$RETURN = ICreateErrorInfo_SetDescription($OBJECT, szDescription)
				$ICreateErrorInfo_SetDescription = $RETURN
			END FUNCTION $ICreateErrorInfo_SetDescription
  			INTEGER*4 FUNCTION $ICreateErrorInfo_SetGUID($OBJECT, rguid)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ICreateErrorInfo_SetGUID
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(IN)	:: rguid	
				!DEC$ ATTRIBUTES REFERENCE	:: rguid
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 12	! Add routine table offset
				ICreateErrorInfo_SetGUID_PTR = $VTBL
				$RETURN = ICreateErrorInfo_SetGUID($OBJECT, rguid)
				$ICreateErrorInfo_SetGUID = $RETURN
			END FUNCTION $ICreateErrorInfo_SetGUID
  			INTEGER*4 FUNCTION $ICreateErrorInfo_SetHelpContext($OBJECT, dwHelpContext)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ICreateErrorInfo_SetHelpContext
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER*4, INTENT(IN)	:: dwHelpContext	! Unsigned
				!DEC$ ATTRIBUTES REFERENCE	:: dwHelpContext
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 28	! Add routine table offset
				ICreateErrorInfo_SetHelpContext_PTR = $VTBL
				$RETURN = ICreateErrorInfo_SetHelpContext($OBJECT, dwHelpContext)
				$ICreateErrorInfo_SetHelpContext = $RETURN
			END FUNCTION $ICreateErrorInfo_SetHelpContext
  			INTEGER*4 FUNCTION $ICreateErrorInfo_SetHelpFile($OBJECT, szHelpFile)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ICreateErrorInfo_SetHelpFile
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szHelpFile	! Unsupported type
				!DEC$ ATTRIBUTES REFERENCE	:: szHelpFile
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 24	! Add routine table offset
				ICreateErrorInfo_SetHelpFile_PTR = $VTBL
				$RETURN = ICreateErrorInfo_SetHelpFile($OBJECT, szHelpFile)
				$ICreateErrorInfo_SetHelpFile = $RETURN
			END FUNCTION $ICreateErrorInfo_SetHelpFile
  			INTEGER*4 FUNCTION $ICreateErrorInfo_SetSource($OBJECT, szSource)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ICreateErrorInfo_SetSource
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: szSource	! Unsupported type
				!DEC$ ATTRIBUTES REFERENCE	:: szSource
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 16	! Add routine table offset
				ICreateErrorInfo_SetSource_PTR = $VTBL
				$RETURN = ICreateErrorInfo_SetSource($OBJECT, szSource)
				$ICreateErrorInfo_SetSource = $RETURN
			END FUNCTION $ICreateErrorInfo_SetSource

			! ISupportErrorInfo
  			INTEGER*4 FUNCTION $ISupportErrorInfo_InterfaceSupportsErrorInfo($OBJECT, riid)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $ISupportErrorInfo_InterfaceSupportsErrorInfo
				USE DFWINTY
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(IN)	:: riid	
				!DEC$ ATTRIBUTES REFERENCE	:: riid
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 12	! Add routine table offset
				ISupportErrorInfo_InterfaceSupportsErrorInfo_PTR = $VTBL
				$RETURN = ISupportErrorInfo_InterfaceSupportsErrorInfo($OBJECT, riid)
				$ISupportErrorInfo_InterfaceSupportsErrorInfo = $RETURN
			END FUNCTION $ISupportErrorInfo_InterfaceSupportsErrorInfo

			! IErrorInfo
  			INTEGER*4 FUNCTION $IErrorInfo_GetDescription($OBJECT, pBstrDescription)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $IErrorInfo_GetDescription
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				CHARACTER*(*), INTENT(OUT)	:: pBstrDescription	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrDescription
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				INTEGER(INT_PTR_KIND()) $BSTR_pBstrDescription    ! BSTR
				INTEGER*4 $STATUS
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 20	! Add routine table offset
				IErrorInfo_GetDescription_PTR = $VTBL
				$RETURN = IErrorInfo_GetDescription($OBJECT, $BSTR_pBstrDescription)
				$STATUS = ConvertBSTRToString($BSTR_pBstrDescription, pBstrDescription)
				CALL SysFreeString($BSTR_pBstrDescription)
				$IErrorInfo_GetDescription = $RETURN
			END FUNCTION $IErrorInfo_GetDescription
  			INTEGER*4 FUNCTION $IErrorInfo_GetGUID($OBJECT, pGUID)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $IErrorInfo_GetGUID
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				TYPE (GUID), INTENT(OUT)	:: pGUID	
				!DEC$ ATTRIBUTES REFERENCE	:: pGUID
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 12	! Add routine table offset
				IErrorInfo_GetGUID_PTR = $VTBL
				$RETURN = IErrorInfo_GetGUID($OBJECT, pGUID)
				$IErrorInfo_GetGUID = $RETURN
			END FUNCTION $IErrorInfo_GetGUID
  			INTEGER*4 FUNCTION $IErrorInfo_GetHelpContext($OBJECT, pdwHelpContext)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $IErrorInfo_GetHelpContext
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				INTEGER*4, INTENT(OUT)	:: pdwHelpContext	! Unsigned
				!DEC$ ATTRIBUTES REFERENCE	:: pdwHelpContext
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 28	! Add routine table offset
				IErrorInfo_GetHelpContext_PTR = $VTBL
				$RETURN = IErrorInfo_GetHelpContext($OBJECT, pdwHelpContext)
				$IErrorInfo_GetHelpContext = $RETURN
			END FUNCTION $IErrorInfo_GetHelpContext
  			INTEGER*4 FUNCTION $IErrorInfo_GetHelpFile($OBJECT, pBstrHelpFile)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $IErrorInfo_GetHelpFile
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				CHARACTER*(*), INTENT(OUT)	:: pBstrHelpFile	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrHelpFile
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				INTEGER(INT_PTR_KIND()) $BSTR_pBstrHelpFile    ! BSTR
				INTEGER*4 $STATUS
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 24	! Add routine table offset
				IErrorInfo_GetHelpFile_PTR = $VTBL
				$RETURN = IErrorInfo_GetHelpFile($OBJECT, $BSTR_pBstrHelpFile)
				$STATUS = ConvertBSTRToString($BSTR_pBstrHelpFile, pBstrHelpFile)
				CALL SysFreeString($BSTR_pBstrHelpFile)
				$IErrorInfo_GetHelpFile = $RETURN
			END FUNCTION $IErrorInfo_GetHelpFile
  			INTEGER*4 FUNCTION $IErrorInfo_GetSource($OBJECT, pBstrSource)
				!DEC$ ATTRIBUTES DLLEXPORT	:: $IErrorInfo_GetSource
				IMPLICIT NONE
	
				INTEGER(INT_PTR_KIND()), INTENT(IN)	:: $OBJECT	 ! Object Pointer
				!DEC$ ATTRIBUTES VALUE	:: $OBJECT
				CHARACTER*(*), INTENT(OUT)	:: pBstrSource	! BSTR
				!DEC$ ATTRIBUTES REFERENCE	:: pBstrSource
				INTEGER*4 $RETURN
				INTEGER(INT_PTR_KIND()) $VTBL			! Interface Function Table
				POINTER($VPTR, $VTBL)
				INTEGER(INT_PTR_KIND()) $BSTR_pBstrSource    ! BSTR
				INTEGER*4 $STATUS
				$VPTR = $OBJECT			! Interface Function Table
				$VPTR = $VTBL + 16	! Add routine table offset
				IErrorInfo_GetSource_PTR = $VTBL
				$RETURN = IErrorInfo_GetSource($OBJECT, $BSTR_pBstrSource)
				$STATUS = ConvertBSTRToString($BSTR_pBstrSource, pBstrSource)
				CALL SysFreeString($BSTR_pBstrSource)
				$IErrorInfo_GetSource = $RETURN
			END FUNCTION $IErrorInfo_GetSource
	END MODULE
