!
! ********************************************************************
! *                                                                  *
! *  Copyright 2001 Compaq Computer Corporation                      *
! *                                                                  *
! *  Compaq and the Compaq logo are trademarks of Compaq Information *
! *  Technologies Group, L.P.                                        *
! *                                                                  *
! *  Confidential computer software. Valid license from Compaq       *
! *  required for possession, use or copying. Consistent with FAR    *
! *  12.211 and 12.212, Commercial Computer Software, Computer       *
! *  Software Documentation, and Technical Data for Commercial Items *
! *  are licensed to the U.S. Government under vendor's standard     *
! *  commercial license.                                             *
! *                                                                  *
! ********************************************************************
!

MODULE DFCOMTY
    !  The definitions in this module have been moved to DFWINTY
	!  Programs should no longer include this module
	use dfwinty, ONLY :         &
        GUID,                   &
        CLSCTX_INPROC_SERVER,   &
        CLSCTX_INPROC_HANDLER,  &
        CLSCTX_LOCAL_SERVER,    &
        CLSCTX_INPROC_SERVER16, &
        CLSCTX_ALL,             &
        CLSCTX_INPROC,          &
        CLSCTX_SERVER,          &
        VT_EMPTY,               &
        VT_NULL,                &
        VT_I2,                  &
        VT_I4,                  &
        VT_R4,                  &
        VT_R8,                  &
        VT_CY,                  &
        VT_DATE,                &
        VT_BSTR,                &
        VT_DISPATCH,            &
        VT_ERROR,               &
        VT_BOOL,                &
        VT_VARIANT,             &
        VT_UNKNOWN,             &
        VARIANT_UNION,          &
        VARIANT,                &
        VARIANT_BOOL_TRUE,      &
        VARIANT_BOOL_FALSE,     &
        OPTIONAL_VARIANT,       &
        SA_BOUNDS,              &
        VARIANT_NOVALUEPROP,    &
        VARIANT_ALPHABOOL,      &
        VARIANT_NOUSEROVERRIDE, &
        VARIANT_LOCALBOOL
END MODULE DFCOMTY
		
MODULE DFCOM
!dec$objcomment lib: "dfcom.lib"
!dec$objcomment lib: "ole32.lib"
!dec$objcomment lib: "uuid.lib"
!dec$objcomment lib: "oleaut32.lib"

	! IIDs	
      USE OLEAUT32	
	  USE DFWINTY
		TYPE (GUID), PARAMETER :: IID_IUnknown = &
			GUID(#00000000, #0000, #0000, &
			  CHAR('C0'X)//CHAR('00'X)//CHAR('00'X)//CHAR('00'X)// &
			  CHAR('00'X)//CHAR('00'X)//CHAR('00'X)//CHAR('46'X))
		TYPE (GUID), PARAMETER :: IID_IDispatch = &
			GUID(#00020400, #0000, #0000, &
			  CHAR('C0'X)//CHAR('00'X)//CHAR('00'X)//CHAR('00'X)// &
			  CHAR('00'X)//CHAR('00'X)//CHAR('00'X)//CHAR('46'X))

	! Initialization Routines
      INTERFACE 
	    SUBROUTINE COMINITIALIZE (status)
		!DEC$ ATTRIBUTES DEFAULT :: COMINITIALIZE
		  INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
	    END SUBROUTINE COMINITIALIZE
	    SUBROUTINE COMUNINITIALIZE ()
		!DEC$ ATTRIBUTES DEFAULT :: COMUNINITIALIZE
	    END SUBROUTINE COMUNINITIALIZE
	  END INTERFACE
    ! COMCREATEOBJECT generic interface
	  INTERFACE COMCREATEOBJECT
        SUBROUTINE COMCREATEOBJECTBYPROGID (prog_id, idispatch, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMCREATEOBJECTBYPROGID
          CHARACTER*(*), INTENT(IN)           :: prog_id 
		  !DEC$ ATTRIBUTES REFERENCE		  :: prog_id
          INTEGER*4,     INTENT(OUT)          :: idispatch 
		  !DEC$ ATTRIBUTES REFERENCE		  :: idispatch
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMCREATEOBJECTBYPROGID
        SUBROUTINE COMCREATEOBJECTBYGUID (clsid, clsctx, iid, iinterface, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMCREATEOBJECTBYGUID
		  USE DFCOMTY
          TYPE (GUID), INTENT(IN)			  :: clsid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: clsid
		  INTEGER*4,     INTENT(IN)			  :: clsctx
		  !DEC$ ATTRIBUTES VALUE			  :: clsctx
          TYPE (GUID), INTENT(IN)			  :: iid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iid
          INTEGER*4,     INTENT(OUT)          :: iinterface 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iinterface
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMCREATEOBJECTBYGUID
	  END INTERFACE
      
    ! COMGETACTIVEOBJECT generic interface
	  INTERFACE COMGETACTIVEOBJECT
        SUBROUTINE COMGETACTIVEOBJECTBYPROGID (prog_id, idispatch, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMGETACTIVEOBJECTBYPROGID
          CHARACTER*(*), INTENT(IN)           :: prog_id 
		  !DEC$ ATTRIBUTES REFERENCE		  :: prog_id
          INTEGER*4,     INTENT(OUT)          :: idispatch 
		  !DEC$ ATTRIBUTES REFERENCE		  :: idispatch
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMGETACTIVEOBJECTBYPROGID
        SUBROUTINE COMGETACTIVEOBJECTBYGUID (clsid, iid, iinterface, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMGETACTIVEOBJECTBYGUID
		  USE DFCOMTY
          TYPE (GUID), INTENT(IN)			  :: clsid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: clsid
          TYPE (GUID), INTENT(IN)			  :: iid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iid
          INTEGER*4,     INTENT(OUT)          :: iinterface 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iinterface
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMGETACTIVEOBJECTBYGUID
	  END INTERFACE
      INTERFACE 
      
        SUBROUTINE COMGETFILEOBJECT (filename, idispatch, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMGETFILEOBJECT
          CHARACTER*(*), INTENT(IN)           :: filename 
		  !DEC$ ATTRIBUTES REFERENCE		  :: filename
          INTEGER*4,     INTENT(OUT)          :: idispatch 
		  !DEC$ ATTRIBUTES REFERENCE		  :: idispatch
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMGETFILEOBJECT
		SUBROUTINE COMCLSIDFROMPROGID (prog_id, clsid, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMCLSIDFROMPROGID
		  USE DFCOMTY
          CHARACTER*(*), INTENT(IN)           :: prog_id 
		  !DEC$ ATTRIBUTES REFERENCE		  :: prog_id
          TYPE (GUID), INTENT(OUT)			  :: clsid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: clsid
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
		END SUBROUTINE
      
		SUBROUTINE COMCLSIDFROMSTRING (string, clsid, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMCLSIDFROMSTRING
		  USE DFCOMTY
          CHARACTER*(*), INTENT(IN)           :: string
		  !DEC$ ATTRIBUTES REFERENCE		  :: string
          TYPE (GUID), INTENT(OUT)			  :: clsid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: clsid
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
		END SUBROUTINE

		SUBROUTINE COMSTRINGFROMGUID (aguid, string, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMSTRINGFROMGUID
		  USE DFCOMTY
          TYPE (GUID), INTENT(IN)			  :: aguid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: aguid
          CHARACTER*(*), INTENT(OUT)          :: string
		  !DEC$ ATTRIBUTES REFERENCE		  :: string
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
		END SUBROUTINE

        LOGICAL*4 FUNCTION COMISEQUALGUID (guid1, guid2)
		!DEC$ ATTRIBUTES DEFAULT :: COMISEQUALGUID
		  USE DFCOMTY
          TYPE (GUID), INTENT(IN)			  :: guid1 
		  !DEC$ ATTRIBUTES REFERENCE		  :: guid1
          TYPE (GUID), INTENT(IN)			  :: guid2 
		  !DEC$ ATTRIBUTES REFERENCE		  :: guid2
		END FUNCTION
      
	! IUnknown member functions
        INTEGER*4 FUNCTION COMADDOBJECTREFERENCE (iunknown)
		!DEC$ ATTRIBUTES DEFAULT :: COMADDOBJECTREFERENCE
          INTEGER*4,     INTENT(IN)           :: iunknown 
		  !DEC$ ATTRIBUTES VALUE			  :: iunknown
        END FUNCTION COMADDOBJECTREFERENCE
        INTEGER*4 FUNCTION COMRELEASEOBJECT (iunknown)
		!DEC$ ATTRIBUTES DEFAULT :: COMRELEASEOBJECT
          INTEGER*4,     INTENT(IN)           :: iunknown 
		  !DEC$ ATTRIBUTES VALUE			  :: iunknown
        END FUNCTION COMRELEASEOBJECT
        SUBROUTINE COMQUERYINTERFACE (iunknown, iid, iinterface, status)
		!DEC$ ATTRIBUTES DEFAULT :: COMQUERYINTERFACE
		  USE DFCOMTY
          INTEGER*4,     INTENT(IN)           :: iunknown 
		  !DEC$ ATTRIBUTES VALUE			  :: iunknown
          TYPE (GUID), INTENT(IN)			  :: iid 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iid
          INTEGER*4,     INTENT(OUT)          :: iinterface 
		  !DEC$ ATTRIBUTES REFERENCE		  :: iinterface
          INTEGER*4,     INTENT(OUT)          :: status 
		  !DEC$ ATTRIBUTES REFERENCE		  :: status
        END SUBROUTINE COMQUERYINTERFACE
	  END INTERFACE
      
	CONTAINS
! Convenience routines for converting to/from BSTRs
		INTEGER*4 FUNCTION ConvertStringToBSTR(string)
          USE OLEAUT32	
		  USE DFNLS
	      CHARACTER*(*), INTENT(IN)			  :: string
		  INTEGER*4 bstr
		  INTEGER*4 length
		  INTEGER*2, ALLOCATABLE :: unistr(:)
		  ! First call to MBConvertMBToUnicode determines the length to allocate
		  ALLOCATE (unistr(0))
		  length = MBConvertMBToUnicode(string, unistr)
		  DEALLOCATE (unistr)
		  ! Special case for all spaces
		  IF (length < 0) THEN
			  ALLOCATE (unistr(2))
			  unistr(1) = #20	! Single space
			  unistr(2) = 0		! Null terminate
		  ELSE
			  ! Second call to MBConvertMBToUnicode does the conversion
			  ALLOCATE (unistr(length+1))
			  length = MBConvertMBToUnicode(string, unistr)
			  unistr(length+1) = 0		! Null terminate
		  END IF
		  bstr = SysAllocString(unistr)
		  DEALLOCATE (unistr)
		  ConvertStringToBSTR = bstr
		END FUNCTION ConvertStringToBSTR
		INTEGER*4 FUNCTION ConvertBSTRToString(bstr, string)
          USE OLEAUT32	
		  USE DFNLS
		  INTEGER*4, INTENT(IN)				  :: bstr
	      CHARACTER*(*), INTENT(OUT)		  :: string
		  INTEGER*4 length
		  length = SysStringLen(bstr)
		  ConvertBSTRToString = Convert(bstr, length, string)
		  CONTAINS
			INTEGER*4 FUNCTION Convert(bstr, length, string)
			  INTEGER*4, INTENT(IN)					  :: bstr
			  INTEGER*4, INTENT(IN)					  :: length
			  CHARACTER*(*), INTENT(OUT)			  :: string
			  INTEGER*2 :: unistr(length)
			  POINTER(p, unistr)
			  p = bstr
			  Convert = MBConvertUnicodeToMB(unistr, string)
			END FUNCTION Convert
		END FUNCTION ConvertBSTRToString
END MODULE DFCOM
