  ! This software DSBUILD.F90 is part of the Compaq Visual Fortran kit.
  !
  ! This software is provided as an example that demonstrates a particular
  ! feature/function of the licensed product. The software is not intended to
  ! provide a complete solution to any application problem but rather is provided
  ! as a teaching mechanism.
  ! 
  ! Users may incorporate any part of this sample into their own source after 
  ! making appropriate changes to make it suitable for the intended application.

  ! This sample program uses OLE Automation to drive Microsoft Developer 
  ! Studio to rebuild a project configuration.
  ! The Automation interfaces defined in DSAPPA.F90 are taken from 
  !  ..\DevStudio\SharedIDE\Bin\devshl.dll.
  ! The Automation interfaces defined in DSBLDA.F90 are taken from 
  !  ..\DevStudio\SharedIDE\Bin\IDE\devbld.pkg.
  !
  ! This program is invoked with the following command line:
  !	dsbuild project.dsw configuration
  !
  !		project.dsw   - file specification of the project file
  !		configuration -	name of the configuration to rebuild
  !
  ! Any arguments not provided on the command line will be prompted for.
  !
	  
    PROGRAM DSBUILD
	  USE DFLIB
	  USE DFWIN
	  USE DSAPPA
	  USE DSBLDA, AVOID_DUPS => IGenericDocument_Close
	  USE DSBOBJS
	  USE DFCOMTY
	  USE DFCOM
	  USE DFAUTO
      IMPLICIT NONE                       

	! Command line arguments
	  CHARACTER (LEN = MAX_PATH) :: dswfile
	  CHARACTER (LEN = 256) :: configuration
	  CHARACTER (LEN = 2048) :: currentConfig
	
	! Variables
	  INTEGER*4 status
	  INTEGER*4 status2
	  INTEGER*4 index 
	  INTEGER*4 count 

	! Variant arguments
	  TYPE (VARIANT) :: vInt
	  TYPE (VARIANT) :: vConfig

	! Determine if program arguments have been specified on the command line
	! If not, prompt the user
	  IF (NARGS() > 1) THEN
		  CALL GETARG(1_2, dswfile)
	  ELSE
		  PRINT '(A25)', ' Enter project file name:'
		  READ 	(*,*) dswfile
	  END IF

	  IF (NARGS() > 2) THEN
		  CALL GETARG(2_2, configuration)
	  ELSE
		  PRINT '(A26)', ' Enter configuration name:'
		  READ 	(*,*) configuration
	  END IF

	! Initialize object pointers;  This is necessary in order for the
	! program to release all objects when it is done
	  CALL COMINITIALIZE(status)
	  CALL INITOBJECTS()

	! Create a Developer Studio Application object, make it visible, and
	! get the Configurations object
      CALL COMCREATEOBJECT ("MSDev.Application", dsappl, status)
	  CALL Check_Status(status, " Unable to create Microsoft Developer Studio object")
      status = AUTOSETPROPERTY(dsappl, "Visible", .TRUE.)
	  dsdocs = IApplication_GetDocuments(dsappl, status)
	  CALL Check_Status(status, " Unable to get Documents object")
	  dsdoc = IDocuments_Open(dsdocs, dswfile, $STATUS=status)
	  CALL Check_Status(status, " Unable to open project file")
      status = AUTOGETPROPERTY(dsappl, "ActiveProject", dsproject, VT_DISPATCH)
	  CALL Check_Status(status, " Unable to get project object")
      status = AUTOGETPROPERTY(dsproject, "Configurations", dsconfigs, VT_DISPATCH)
	  CALL Check_Status(status, " Unable to get configurations object")
 	  count = IConfigurations_GetCount(dsconfigs, status)

	! Loop thru the Configurations until we find on with the name we want
	  DO index = 1, count
		  CALL VariantInit(vInt)
		  vInt%VT = VT_I4
		  vInt%VU%LONG_VAL = index
		  dsconfig = IConfigurations_Item(dsconfigs, vInt, status)
		  IF (status == 0) THEN
				currentConfig = IConfiguration_GetName(dsconfig, status2)
				IF (currentConfig == configuration) THEN
					EXIT
				END IF
				status2 = COMRELEASEOBJECT(dsconfig)
				dsconfig = 0
		  END IF
	  END DO

	  IF (dsconfig == 0) THEN
		  WRITE (*, '(" Unable to find configuration; Aborting")')
		  CALL EXIT(-1)
	  END IF

	! Rebuild All
	  CALL VariantInit(vConfig)
      vConfig%VT = VT_DISPATCH
      vConfig%VU%PTR_VAL = dsconfig
	  CALL IApplication_RebuildAll(dsappl, vConfig, $STATUS=status)
	  CALL Check_Status(status, " Rebuild All failed")

	! Exit Developer Studio
	  CALL IApplication_Quit(dsappl)
	  CALL RELEASEOBJECTS()
	  CALL COMUNINITIALIZE()

    END PROGRAM

	SUBROUTINE Check_Status(olestatus, errorMsg)
	  USE DSBOBJS
      IMPLICIT NONE                       

	  INTEGER*4 olestatus
	  CHARACTER (LEN = *) :: errorMsg

	  IF (olestatus >= 0) THEN
		  RETURN
	  END IF

	! Error handling code
	  CALL RELEASEOBJECTS()
	  WRITE (*, '(A, "; OLE error status = 0x", Z8.8, "; Aborting")') TRIM(errorMsg), olestatus
	  CALL SLEEPQQ(5000)
	  CALL EXIT(-1)

    END SUBROUTINE
