*========================================================================================
* VSSProject.Prg
*
* Updates the information in the Visual FoxPro project. It automati-
* cally updates the working folder to be the same as the project's
* directory. It also changes the VSS project to which the project is
* attached. You must run this tool in any of the following circum-
* stances:
*
* - You want to attach the PJX file to a different VSS database, for
*   example, because you work on a different size without being able
*   to check in to the master database regularily.
*
* - You copied the PJX file into a different directory.
*
* - You changed the project tree in VSS.
*
* - You got a copy of the current project from a fellow and want to
*   use the new PJX files instead of letting VFP re-create it. This
*   is an important issue, if your projects consists of dozens of
*   PJX files.
*
*----------------------------------------------------------------------------------------
* SYNTAX
*
*  VSSProject( "<PJX-Project>", "<VSS-Project>", @cMessage, tcDatabase )
*
*  If you specify a cMessage parameter, the message is returned in
*  case of an error. Otherwise, it's displayed in a messagebox. You
*  can use this option for batch processing. cMessage must be 
*  initialized as a string
*
*  This program returns an error number, if something went wrong. 
*  Please see the code for specific numbers.
*
*  tcDatabase is only available for VFP 8 or higher. It defines the directory that
*  contains the SrcSafe.INI file. VFP 8 added this parameter to support multiple data-
*  bases. If you omit the parameter in VFP 8, the existing database is retained. If no
*  database is specified, a VFP 7 compliant VSS record is generated.
*
*  For SourceOffSite the database parameter is a string with the following syntax:
*
*  MyServer:8888:C:\VSS\SrcSafe.Ini
*
*  Where "MyServer" is the name of the SOS server, "8888" is the SOS server port and
*  "C:\VSS\SrcSafe.INI" is the location of the VSS database on the server.
*
*  tcProvider specifies the registry key of the SCC provider. It can also be one of
*  the predefined values that are automatically expanded:
*
*    "SOS": Software\SourceOffSite\SourceOffsite
*    "VSS": Software\Microsoft\SourceSafe
*
*  If no provider is specified, the existing provider is retained. If a new SCCDATA
*  record should be generated, the provider must be specified.
*
*  If tlNew is set to .T., the project is connected to VSS, even if the project hasn't
*  yet been attached to VSS.
*
*----------------------------------------------------------------------------------------
* SAMPLES
*
* a) Update a project that you recevied from your colleague:
*
*    VSSProject( "D:\Projects\CoolApp4\CoolApp.Pjx", "$/CoolApp/4.0" )
*
*
* b) Add a project to SOS where the files have already been added to the database
*
*    VSSProject( ;
*       "D:\Projects\CoolApp4\CoolApp.Pjx", ;
*       "$/CoolApp/4.0", ;
*       , ;
*       "Server:8888:C:\VSS\SrcSafe.ini", ;
*       "SOS", ;
*       .T. ;
*   )
*
*
* c) Add a project to VSS where the files have already been added to the database.
*
*    VSSProject( ;
*       "D:\Projects\CoolApp4\CoolApp.Pjx", ;
*       "$/CoolApp/4.0", ;
*       , ;
*       "C:\VSS", ;
*       "VSS", ;
*       .T. ;
*   )
*
*
* d) Move a project from VSS to SOS
*
*    VSSProject( ;
*       "D:\Projects\CoolApp4\CoolApp.Pjx", ;
*       "$/CoolApp/4.0", ;
*       , ;
*       "Server:8888:C:\VSS\SrcSafe.ini", ;
*       "SOS", ;
*   )
*
*----------------------------------------------------------------------------------------
* HISTORY
*
* 2004-10Oct-22  Added support for VFP 8 and VFP 9
* 2005-03Mar-08  Fixed an issue when creating a new entry for SOS
*
*========================================================================================
LParameter tcPJXProject, tcVSSProject, rcMsg, tcDataBase, tcProvider, tlNew

	*-----------------------------------------------------------------
	* Verify the VFP Project parameter
	*-----------------------------------------------------------------
	Local lcPJX
	If VarType(m.tcPJXProject) # "C"
		Return SCCError("PJX file must be specified.",@rcMsg,1)
	Endif
	lcPJX = ForceExt( Alltrim(m.tcPJXProject), "PJX" )
	If not File(m.lcPJX)
		Return SCCError( ;
			"Project '"+m.lcPJX+"' does not exist.", @rcMsg, 2 ;
		)
	Endif
	
	*-----------------------------------------------------------------
	* Verify the VSS project parameter
	*-----------------------------------------------------------------
	Local lcVSS
	If VarType(m.tcVSSProject) # "C"
		Return SCCError("VSS project must be specified.",@rcMsg,3)
	Endif
	lcVSS = Upper(Alltrim(m.tcVSSProject))
	If not Left(m.lcVSS,2) == "$/"
		lcVSS = "$/" + m.lcVSS
	EndIf
	
	*--------------------------------------------------------------------------------------
	* Verify tcProvider parameter
	*--------------------------------------------------------------------------------------
	Local lcProvider
	If not Empty(m.tcProvider)
		Do case
		Case Upper(Alltrim(m.tcProvider)) == "SOS"
			lcProvider = "Software\SourceOffSite\SourceOffsite"
		Case Upper(Alltrim(m.tcProvider)) == "VSS"
			lcProvider = "Software\Microsoft\SourceSafe"
		Otherwise
			lcProvider = m.tcProvider
		endcase		
	EndIf
				
	*--------------------------------------------------------------------------------------
	* Open the Visual FoxPro project file. If the project hasn't been added to SourceSafe, 
	* we display a message, unless the tlNew parameter is .T.
	*--------------------------------------------------------------------------------------
	Local lnSelect, lnOK, lcError, lnError, lcSCCDATA
	lnSelect = Select()
	lnOK = 0
	Select 0
	lnError = 0
	lcError = On( "Error" )
	On Error lnError = Error()
	Use (m.lcPJX) Again Shared
	On Error &lcError
	If m.lnError > 0
		lnOK = 4
		SCCError( "Cannot open project file", @rcMsg )
	Endif
	If m.lnOK == 0
		lcSCCDATA = SCCDATA
		If Empty(m.lcSCCData) and not m.tlNew
			lnOK = 5
			SCCError( "Project not under version control.", @rcMsg )
		Endif
		If not InList( Len(m.lcSCCData), 1048, 1308 )
			If m.tlNew
				If Empty(m.lcProvider)
					lnOK = 7
					SCCError( "New SCCDATA record requires provider" )
				else
					If Vartype(m.tcDataBase) == "C"
						* VFP 8 comaptible, version 3.0
						lcSCCDATA = Chr(3) + Replicate(Chr(0),1307)
					Else
						* VFP 7 compatible, verssion 2.0
						lcSCCDATA = Chr(2) + Replicate(Chr(0),1047)
					EndIf
				EndIf
			Else
				lnOK = 6
				SCCError( "VSS info record corrupt.", @rcMsg )
			EndIf
		Endif
	Endif
	
	*-----------------------------------------------------------------
	* Get the name of the VSS project. We only replace it when it 
	* differs, because this string contains one piece of information
	* that we can't find out: The filename of the PJM file within the
	* VSS database. VFP can work just fine without this particular
	* peice, but why remove it if it's not necessary?
	*-----------------------------------------------------------------
	Local lcVSSProject, lcVSSProjectName, lnLength, lcVSSPJM
	If m.lnOK == 0
		lcVSSProject = SCCExtract( m.lcSCCDATA, 9, 260 )
		lnLength = At(",",m.lcVSSProject) - 3
		If m.lnLength <= 0
			lcVSSProjectName = ""
			lcVSSPJM = ""
		Else
			lcVSSProjectName = SubStr(m.lcVSSProject,2,m.lnLength)
			lcVSSPJM = Right( ;
				m.lcVSSProject, ;
				Len(m.lcVSSProject) - m.lnLength - 3 ;
			)
		Endif
		If m.tlNew or not Upper(m.lcVSSProjectName) == m.lcVSS
			If Vartype(m.tcProvider) == "C" and m.tcProvider == "SOS"
				lcSCCDATA = Stuff( ;
					m.lcSCCDATA, ;
					9, ;
					260, ;
					Padr( m.lcVSS, 260, Chr(0) ) ;
				)
			else
				lcSCCDATA = Stuff( ;
					m.lcSCCDATA, ;
					9, ;
					260, ;
					Padr( ["]+m.lcVSS+[",], 260, Chr(0) ) ;
				)
			EndIf
		Endif
	Endif
	
	*-----------------------------------------------------------------
	* Change the name of the project file and the working folder.
	*-----------------------------------------------------------------
	If m.lnOK == 0
		lcSCCDATA = Stuff( ;
			m.lcSCCDATA, ;
			529, ;
			260, ;
			Padr(Dbf(),260,Chr(0)) ;
		)
		lcSCCDATA = Stuff( ;
			m.lcSCCDATA, ;
			789, ;
			260, ;
			Padr(JustPath(Dbf()),260,Chr(0)) ;
		)
	EndIf
	
	*--------------------------------------------------------------------------------------
	* If this is a VFP 8 compatible record and a database has been specified, we update the
	* database, too.
	*--------------------------------------------------------------------------------------
	If m.lnOK == 0
		If Vartype(m.tcDataBase) == "C" and Len(m.lcSCCDATA) == 1308
			lcSCCDATA = Stuff( ;
				m.lcSCCDATA, ;
				1049, ;
				260, ;
				Padr(m.tcDataBase,260,Chr(0)) ;
			)
		EndIf
	EndIf 
	
	*--------------------------------------------------------------------------------------
	* If a provider has been specified, we update the provider entry, as well.
	*--------------------------------------------------------------------------------------
	If not Empty(m.lcProvider)
		lcSCCDATA = Stuff( ;
			m.lcSCCDATA, ;
			269, ;
			260, ;
			Padr(m.lcProvider,260,Chr(0)) ;
		)
	EndIf
	
	*-----------------------------------------------------------------
	* Write back the new SCCDATA record and clean up.
	*-----------------------------------------------------------------
	If m.lnOK == 0
		Replace next 1 SCCData with m.lcSCCDATA
	Endif
	Use
	Select (m.lnSelect)
	
Return m.lnOK


*====================================================================
* Extracts a string out of the binary structure in SCCDATA.
*====================================================================
Procedure SCCExtract
LParameter tcSCCData, tnPos, tnLength

	*-----------------------------------------------------------------
	* Get the string out of the SCCDATA field
	*-----------------------------------------------------------------
	Local lcString
	If Len(m.tcSCCData) < m.tnPos+m.tnLength-1
		lcString = ""
	Else
		lcString = SubStr( m.tcSCCData, m.tnPos, m.tnLength )
	Endif
	
	*-----------------------------------------------------------------
	* Strings in SCCDATA are filled with CHR(0). Because the first 
	* CHR(0) character terminates the string, there might potentially
	* be non-sense characters after that. I've not yet seen this, but
	* I'm rather careful.
	*-----------------------------------------------------------------
	Local lnPos
	lnPos = At( Chr(0), m.lcString )
	If m.lnPos > 0
		lcString = Left( m.lcString, m.lnPos-1 )
	Endif
	
Return m.lcString


*====================================================================
* Either displays a message or stores the message in the variable
* that is passed by reference.
*====================================================================
Procedure SCCError
LParameter tcError, tnCode, rcMessage

	If VarType(m.rcMessage) == "C"
		rcMessage = m.tcError
	Else
		MessageBox( m.tcError, 16, "VSSProj.Prg" )
	Endif
	
Return m.tnCode