Files @ r20790:1c40c83d41c6
Branch filter:

Location: cpp/openttd-patchpack/source/projects/determineversion.vbs

frosch
(svn r25834) -Codechange: Use NUM_OBJECTS_PER_GRF instead of NUM_OBJECTS to properly distinguish limits per NewGRF and limits of the pool.
-Change: [NewGRF] Lower the limit of object types per NewGRF from 256 to 255 to prevent usage of ID 0xFF in Action3, and thus allowing it to become an extended byte somewhen.
Option Explicit

' $Id$
'
' This file is part of OpenTTD.
' OpenTTD is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2.
' OpenTTD 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.
' See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with OpenTTD. If not, see <http://www.gnu.org/licenses/>.

Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")

Sub FindReplaceInFile(filename, to_find, replacement)
	Dim file, data
	Set file = FSO.OpenTextFile(filename, 1, 0, 0)
	data = file.ReadAll
	file.Close
	data = Replace(data, to_find, replacement)
	Set file = FSO.CreateTextFile(filename, -1, 0)
	file.Write data
	file.Close
End Sub

Sub UpdateFile(modified, revision, version, cur_date, filename)
	FSO.CopyFile filename & ".in", filename
	FindReplaceInFile filename, "!!MODIFIED!!", modified
	FindReplaceInFile filename, "!!REVISION!!", revision
	FindReplaceInFile filename, "!!VERSION!!", version
	FindReplaceInFile filename, "!!DATE!!", cur_date
End Sub

Sub UpdateFiles(version)
	Dim modified, revision, cur_date
	cur_date = DatePart("D", Date) & "." & DatePart("M", Date) & "." & DatePart("YYYY", Date)

	If InStr(version, Chr(9)) Then
		revision = Mid(version, InStr(version, Chr(9)) + 1)
		modified = Mid(revision, InStr(revision, Chr(9)) + 1)
		revision = Mid(revision, 1, InStr(revision, Chr(9)) - 1)
		modified = Mid(modified, 1, InStr(modified, Chr(9)) - 1)
		version  = Mid(version, 1, InStr(version, Chr(9)) - 1)
	Else
		revision = 0
		modified = 1
	End If

	UpdateFile modified, revision, version, cur_date, "../src/rev.cpp"
	UpdateFile modified, revision, version, cur_date, "../src/os/windows/ottdres.rc"
End Sub

Function ReadRegistryKey(shive, subkey, valuename, architecture)
	Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams

	' First, get the Registry Provider for the requested architecture
	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
	objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32
	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
	Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
	Set objReg = objServices.Get("StdRegProv")

	' Check the hive and give it the right value
	Select Case shive
		Case "HKCR", "HKEY_CLASSES_ROOT"
			hiveKey = &h80000000
		Case "HKCU", "HKEY_CURRENT_USER"
			hiveKey = &H80000001
		Case "HKLM", "HKEY_LOCAL_MACHINE"
			hiveKey = &h80000002
		Case "HKU", "HKEY_USERS"
			hiveKey = &h80000003
		Case "HKCC", "HKEY_CURRENT_CONFIG"
			hiveKey = &h80000005
		Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98
			hiveKey = &h80000006
		Case Else
			MsgBox "Hive not valid (ReadRegistryKey)"
	End Select

	Set Inparams = objReg.Methods_("GetStringValue").Inparameters
	Inparams.Hdefkey = hiveKey
	Inparams.Ssubkeyname = subkey
	Inparams.Svaluename = valuename
	Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)

	ReadRegistryKey = Outparams.SValue
End Function

Function DetermineSVNVersion()
	Dim WshShell, version, branch, modified, revision, clean_rev, url, oExec, line, hash
	Set WshShell = CreateObject("WScript.Shell")
	On Error Resume Next

	revision = 0

	' Try TortoiseSVN
	' Get the directory where TortoiseSVN (should) reside(s)
	Dim sTortoise
	' First, try with 32-bit architecture
	sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)
	If sTortoise = "" Or IsNull(sTortoise) Then
		' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)
		sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)
	End If

	' If TortoiseSVN is installed, try to get the revision number
	If sTortoise <> "" Then
		Dim SubWCRev
		Set SubWCRev = WScript.CreateObject("SubWCRev.object")
		SubWCRev.GetWCInfo FSO.GetAbsolutePathName("../"), 0, 0
		revision = SubWCRev.Revision
		version = "r" & revision
		modified = 0
		if SubWCRev.HasModifications then modified = 2
		url = SubWCRev.Url
	End If

	' Looks like there is no TortoiseSVN installed either. Then we don't know it.
	If revision = 0 Then
		' Reset error and version
		Err.Clear
		version = "norev000"
		modified = 0

		' Set the environment to english
		WshShell.Environment("PROCESS")("LANG") = "en"

		' Do we have subversion installed? Check immediatelly whether we've got a modified WC.
		Set oExec = WshShell.Exec("svnversion ../")
		If Err.Number = 0 Then
			' Wait till the application is finished ...
			Do While oExec.Status = 0
			Loop

			line = OExec.StdOut.ReadLine()
			If line <> "exported" Then
				If InStr(line, "M") Then
					modified = 2
				End If

				' And use svn info to get the correct revision and branch information.
				Set oExec = WshShell.Exec("svn info ../")
				If Err.Number = 0 Then
					Do
						line = OExec.StdOut.ReadLine()
						If InStr(line, "URL") Then
							url = line
						End If
						If InStr(line, "Last Changed Rev") Then
							revision = Mid(line, 19)
							version = "r" & revision
						End If
					Loop While Not OExec.StdOut.atEndOfStream
				End If ' Err.Number = 0
			End If ' line <> "exported"
		End If ' Err.Number = 0
	End If ' InStr(version, "$")

	If version <> "norev000" Then
		If InStr(url, "branches") Then
			branch = Mid(url, InStr(url, "branches/") + 9)
		End If
		If InStr(url, "tags") Then
			version = Mid(url, InStr(url, "tags/") + 5)
		End If
	Else ' version <> "norev000"
		' svn detection failed, reset error and try git
		Err.Clear
		Set oExec = WshShell.Exec("git rev-parse --verify HEAD")
		If Err.Number = 0 Then
			' Wait till the application is finished ...
			Do While oExec.Status = 0
			Loop

			If oExec.ExitCode = 0 Then
				hash = oExec.StdOut.ReadLine()
				version = "g" & Mid(hash, 1, 8)
				' Make sure index is in sync with disk
				Set oExec = WshShell.Exec("git update-index --refresh")
				If Err.Number = 0 Then
					' StdOut and StdErr share a 4kB buffer so prevent it from filling up as we don't care about the output
					oExec.StdOut.Close
					oExec.StdErr.Close
					' Wait till the application is finished ...
					Do While oExec.Status = 0
						WScript.Sleep 10
					Loop
				End If
				Set oExec = WshShell.Exec("git diff-index --exit-code --quiet HEAD ../")
				If Err.Number = 0 Then
					' Wait till the application is finished ...
					Do While oExec.Status = 0
					Loop

					If oExec.ExitCode = 1 Then
						modified = 2
					End If ' oExec.ExitCode = 1

					Set oExec = WshShell.Exec("git symbolic-ref HEAD")
					If Err.Number = 0 Then
						line = oExec.StdOut.ReadLine()
						line = Mid(line, InStrRev(line, "/") + 1)
						If line <> "master" Then
							branch = line
						End If ' line <> "master"
					End If ' Err.Number = 0

					Set oExec = WshShell.Exec("git log --pretty=format:%s --grep=" & Chr(34) & "^(svn r[0-9]*)" & Chr(34) & " -1")
					if Err.Number = 0 Then
						revision = Mid(oExec.StdOut.ReadLine(), 7)
						revision = Mid(revision, 1, InStr(revision, ")") - 1)
					End If ' Err.Number = 0
					If revision = "" Then
						' No revision? Maybe it is a custom git-svn clone
						' Reset error number as WshShell.Exec will not do that on success
						Err.Clear
						Set oExec = WshShell.Exec("git log --pretty=format:%b --grep=" & Chr(34) & "git-svn-id:.*@[0-9]*" & Chr(34) & " -1")
						If Err.Number = 0 Then
							revision = oExec.StdOut.ReadLine()
							revision = Mid(revision, InStr(revision, "@") + 1)
							revision = Mid(revision, 1, InStr(revision, " ") - 1)
						End If ' Err.Number = 0
					End If ' revision = ""

					' Check if a tag is currently checked out
					Err.Clear
					Set oExec = WshShell.Exec("git name-rev --name-only --tags --no-undefined HEAD")
					If Err.Number = 0 Then
						' Wait till the application is finished ...
						Do While oExec.Status = 0
						Loop
						If oExec.ExitCode = 0 Then
							version = oExec.StdOut.ReadLine()
							If Right(version, 2) = "^0" Then
								version = Left(version, Len(version) - 2)
							End If
							branch = ""
						End If ' oExec.ExitCode = 0
					End If ' Err.Number = 0
				End If ' Err.Number = 0
			End If ' oExec.ExitCode = 0
		End If ' Err.Number = 0

		If version = "norev000" Then
			' git detection failed, reset error and try mercurial (hg)
			Err.Clear
			Set oExec = WshShell.Exec("hg id -i")
			If Err.Number = 0 Then
				' Wait till the application is finished ...
				Do While oExec.Status = 0
				Loop

				If oExec.ExitCode = 0 Then
					line = OExec.StdOut.ReadLine()
					hash = Left(line, 12)
					version = "h" & Mid(hash, 1, 8)

					' Check if a tag is currently checked out
					Err.Clear
					Set oExec = WshShell.Exec("hg id -t")
					If Err.Number = 0 Then
						line = oExec.StdOut.ReadLine()
						If Len(line) > 0 And Right(line, 3) <> "tip" Then
							version = line
							branch = ""
						End If ' Len(line) > 0 And Right(line, 3) <> "tip"
					End If ' Err.Number = 0

					Err.Clear
					Set oExec = WshShell.Exec("hg status ../")
					If Err.Number = 0 Then
						Do
							line = OExec.StdOut.ReadLine()
							If Len(line) > 0 And Mid(line, 1, 1) <> "?" Then
								modified = 2
								Exit Do
							End If ' Len(line) > 0 And Mid(line, 1, 1) <> "?"
						Loop While Not OExec.StdOut.atEndOfStream

						Set oExec = WshShell.Exec("hg branch")
						If Err.Number = 0 Then
							line = OExec.StdOut.ReadLine()
							If line <> "default" Then
								branch = line
							End If ' line <> "default"
						End If ' Err.Number = 0

						Set oExec = WshShell.Exec("hg log -f -k " & Chr(34) & "(svn r" & Chr(34) & " -l 1 --template " & Chr(34) & "{desc|firstline}\n" & Chr(34) & " --cwd ../")
						If Err.Number = 0 Then
							line = oExec.StdOut.ReadLine()
							If Left(line, 6) = "(svn r" Then
								revision = Mid(line, 7)
								revision = Mid(revision, 1, InStr(revision, ")") - 1)
							End If 'Left(line, 6) = "(svn r"
						End If ' Err.Number = 0

						If revision = "" Then
							' No rev? Maybe it is a custom hgsubversion clone
							Err.Clear
							Set oExec = WshShell.Exec("hg parent --template=" & Chr(34) & "{svnrev}" & Chr(34))
							If Err.Number = 0 Then
								revision = oExec.StdOut.ReadLine()
							End If ' Err.Number = 0
						End If ' revision = ""
					End If ' Err.Number = 0
				End If ' oExec.ExitCode = 0
			End If ' Err.Number = 0
		End If ' version = "norev000"
	End If ' version <> "norev000"

	If version = "norev000" And FSO.FileExists("../.ottdrev") Then
		Dim rev_file
		Set rev_file = FSO.OpenTextFile("../.ottdrev", 1, True, 0)
		DetermineSVNVersion = rev_file.ReadLine()
		rev_file.Close()
	Else
		If modified = 2 Then
			version = version & "M"
		End If

		clean_rev = version
		If branch <> "" Then
			version = version & "-" & branch
		End If

		If version <> "norev000" Then
			DetermineSVNVersion = version & Chr(9) & revision & Chr(9) & modified & Chr(9) & clean_rev
		Else
			DetermineSVNVersion = version
		End If
	End If
End Function

Function IsCachedVersion(ByVal version)
	Dim cache_file, cached_version
	cached_version = ""
	Set cache_file = FSO.OpenTextFile("../config.cache.version", 1, True, 0)
	If Not cache_file.atEndOfStream Then
		cached_version = cache_file.ReadLine()
	End If
	cache_file.Close

	If InStr(version, Chr(9)) Then
		version = Mid(version, 1, Instr(version, Chr(9)) - 1)
	End If

	If version <> cached_version Then
		Set cache_file = fso.CreateTextFile("../config.cache.version", True)
		cache_file.WriteLine(version)
		cache_file.Close
		IsCachedVersion = False
	Else
		IsCachedVersion = True
	End If
End Function

Function CheckFile(filename)
	CheckFile = FSO.FileExists(filename)
	If CheckFile Then CheckFile = (FSO.GetFile(filename).DateLastModified >= FSO.GetFile(filename & ".in").DateLastModified)
End Function

Dim version
version = DetermineSVNVersion
If Not (IsCachedVersion(version) And CheckFile("../src/rev.cpp") And CheckFile("../src/os/windows/ottdres.rc")) Then
	UpdateFiles version
End If