projects/determineversion.vbs
branchNewGRF_ports
changeset 10184 fcf5fb2548eb
parent 6871 5a9dc001e1ad
child 10991 d8811e327d12
equal deleted inserted replaced
10179:eec5a7dcbf61 10184:fcf5fb2548eb
    51 
    51 
    52 	UpdateFile revision, version, cur_date, "../src/rev.cpp"
    52 	UpdateFile revision, version, cur_date, "../src/rev.cpp"
    53 	UpdateFile revision, version, cur_date, "../src/ottdres.rc"
    53 	UpdateFile revision, version, cur_date, "../src/ottdres.rc"
    54 End Sub
    54 End Sub
    55 
    55 
       
    56 Function ReadRegistryKey(shive, subkey, valuename, architecture)
       
    57 	Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams
       
    58 
       
    59 	' First, get the Registry Provider for the requested architecture
       
    60 	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
       
    61 	objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32
       
    62 	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
       
    63 	Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
       
    64 	Set objReg = objServices.Get("StdRegProv")
       
    65 
       
    66 	' Check the hive and give it the right value
       
    67 	Select Case shive
       
    68 		Case "HKCR", "HKEY_CLASSES_ROOT"
       
    69 			hiveKey = &h80000000
       
    70 		Case "HKCU", "HKEY_CURRENT_USER"
       
    71 			hiveKey = &H80000001
       
    72 		Case "HKLM", "HKEY_LOCAL_MACHINE"
       
    73 			hiveKey = &h80000002
       
    74 		Case "HKU", "HKEY_USERS"
       
    75 			hiveKey = &h80000003
       
    76 		Case "HKCC", "HKEY_CURRENT_CONFIG"
       
    77 			hiveKey = &h80000005
       
    78 		Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98
       
    79 			hiveKey = &h80000006
       
    80 		Case Else
       
    81 			MsgBox "Hive not valid (ReadRegistryKey)"
       
    82 	End Select
       
    83 
       
    84 	Set Inparams = objReg.Methods_("GetStringValue").Inparameters
       
    85 	Inparams.Hdefkey = hiveKey
       
    86 	Inparams.Ssubkeyname = subkey
       
    87 	Inparams.Svaluename = valuename
       
    88 	Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)
       
    89 
       
    90 	ReadRegistryKey = Outparams.SValue
       
    91 End Function
       
    92 
    56 Function DetermineSVNVersion()
    93 Function DetermineSVNVersion()
    57 	Dim WshShell, version, url, oExec, line
    94 	Dim WshShell, version, url, oExec, line
    58 	Set WshShell = CreateObject("WScript.Shell")
    95 	Set WshShell = CreateObject("WScript.Shell")
    59 	On Error Resume Next
    96 	On Error Resume Next
    60 
    97 
    61 	' Try TortoiseSVN
    98 	' Try TortoiseSVN
    62 	' Get the directory where TortoiseSVN (should) reside(s)
    99 	' Get the directory where TortoiseSVN (should) reside(s)
    63 	Dim sTortoise
   100 	Dim sTortoise
    64 	sTortoise = WshShell.RegRead("HKLM\SOFTWARE\TortoiseSVN\Directory")
   101 	' First, try with 32-bit architecture
    65 
   102 	sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)
    66 	Dim file
   103 	If sTortoise = Nothing Then
    67 	' Write some "magic" to a temporary file so we can acquire the svn revision/state
   104 		' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)
    68 	Set file = FSO.CreateTextFile("tsvn_tmp", -1, 0)
   105 		sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)
    69 	file.WriteLine "r$WCREV$$WCMODS?M:$"
   106 	End If
    70 	file.WriteLine "$WCURL$"
   107 
    71 	file.Close
   108 	' If TortoiseSVN is installed, try to get the revision number
    72 	Set oExec = WshShell.Exec(sTortoise & "\bin\SubWCRev.exe ../src tsvn_tmp tsvn_tmp")
   109 	If sTortoise <> Nothing Then
    73 	' Wait till the application is finished ...
   110 		Dim file
    74 	Do
   111 		' Write some "magic" to a temporary file so we can acquire the svn revision/state
    75 		OExec.StdOut.ReadLine()
   112 		Set file = FSO.CreateTextFile("tsvn_tmp", -1, 0)
    76 	Loop While Not OExec.StdOut.atEndOfStream
   113 		file.WriteLine "r$WCREV$$WCMODS?M:$"
    77 
   114 		file.WriteLine "$WCURL$"
    78 	Set file = FSO.OpenTextFile("tsvn_tmp", 1, 0, 0)
   115 		file.Close
    79 	version = file.ReadLine
   116 		Set oExec = WshShell.Exec(sTortoise & "\bin\SubWCRev.exe ../src tsvn_tmp tsvn_tmp")
    80 	url = file.ReadLine
   117 		' Wait till the application is finished ...
    81 	file.Close
   118 		Do
    82 
   119 			OExec.StdOut.ReadLine()
    83 	Set file = FSO.GetFile("tsvn_tmp")
   120 		Loop While Not OExec.StdOut.atEndOfStream
    84 	file.Delete
   121 
       
   122 		Set file = FSO.OpenTextFile("tsvn_tmp", 1, 0, 0)
       
   123 		version = file.ReadLine
       
   124 		url = file.ReadLine
       
   125 		file.Close
       
   126 
       
   127 		Set file = FSO.GetFile("tsvn_tmp")
       
   128 		file.Delete
       
   129 	End If
    85 
   130 
    86 	' Looks like there is no TortoiseSVN installed either. Then we don't know it.
   131 	' Looks like there is no TortoiseSVN installed either. Then we don't know it.
    87 	If InStr(version, "$") Then
   132 	If InStr(version, "$") Then
    88 		' Reset error and version
   133 		' Reset error and version
    89 		Err.Clear
   134 		Err.Clear