1

Option Explicit

     2

     3

Dim FSO

     4

Set FSO = CreateObject("Scripting.FileSystemObject")

     5

     6

Sub FindReplaceInFile(filename, to_find, replacement)

     7

	Dim file, data

     8

	Set file = FSO.OpenTextFile(filename, 1, 0, 0)

     9

	data = file.ReadAll

    10

	file.Close

    11

	data = Replace(data, to_find, replacement)

    12

	Set file = FSO.CreateTextFile(FileName, -1, 0)

    13

	file.Write data

    14

	file.Close

    15

End Sub

    16

    17

Sub UpdateFile(modified, revision, version, cur_date, filename)

    18

	FSO.CopyFile filename & ".in", filename

    19

	FindReplaceInFile filename, "@@MODIFIED@@", modified

    20

	FindReplaceInFile filename, "@@REVISION@@", revision

    21

	FindReplaceInFile filename, "@@VERSION@@", version

    22

	FindReplaceInFile filename, "@@DATE@@", cur_date

    23

End Sub

    24

    25

Sub UpdateFiles(version)

    26

	Dim WshShell, cur_date, modified, revision, oExec

    27

	Set WshShell = CreateObject("WScript.Shell")

    28

	cur_date = DatePart("D", Date) & "." & DatePart("M", Date) & "." & DatePart("YYYY", Date)

    29

	revision = 0

    30

	modified = 1

    31

	Select Case Mid(version, 1, 1)

    32

		Case "r" ' svn

    33

			revision = Mid(version, 2)

    34

			If InStr(revision, "M") Then

    35

				revision = Mid(revision, 1, InStr(revision, "M") - 1)

    36

				modified = 2

    37

			Else

    38

				modified = 0

    39

			End If

    40

			If InStr(revision, "-") Then

    41

				revision = Mid(revision, 1, InStr(revision, "-") - 1)

    42

			End If

    43

		Case "h" ' mercurial (hg)

    44

			Set oExec = WshShell.Exec("hg log -k " & Chr(34) & "svn" & Chr(34) & " -l 1 --template " & Chr(34) & "{desc}\n" & Chr(34) & " ../src")

    45

			If Err.Number = 0 Then

    46

				revision = Mid(OExec.StdOut.ReadLine(), 7)

    47

				revision = Mid(revision, 1, InStr(revision, ")") - 1)

    48

			End If

    49

		Case "g" ' git

    50

			Set oExec = WshShell.Exec("git log --pretty=format:%s --grep=" & Chr(34) & "^(svn r[0-9]*)" & Chr(34) & " -1 ../src")

    51

			if Err.Number = 0 Then

    52

				revision = Mid(oExec.StdOut.ReadLine(), 7)

    53

				revision = Mid(revision, 1, InStr(revision, ")") - 1)

    54

			End If

    55

	End Select

    56

    57

	UpdateFile modified, revision, version, cur_date, "../src/rev.cpp"

    58

	UpdateFile modified, revision, version, cur_date, "../src/ottdres.rc"

    59

End Sub

    60

    61

Function ReadRegistryKey(shive, subkey, valuename, architecture)

    62

	Dim hiveKey, objCtx, objLocator, objServices, objReg, Inparams, Outparams

    63

    64

	' First, get the Registry Provider for the requested architecture

    65

	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")

    66

	objCtx.Add "__ProviderArchitecture", architecture ' Must be 64 of 32

    67

	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")

    68

	Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)

    69

	Set objReg = objServices.Get("StdRegProv")

    70

    71

	' Check the hive and give it the right value

    72

	Select Case shive

    73

		Case "HKCR", "HKEY_CLASSES_ROOT"

    74

			hiveKey = &h80000000

    75

		Case "HKCU", "HKEY_CURRENT_USER"

    76

			hiveKey = &H80000001

    77

		Case "HKLM", "HKEY_LOCAL_MACHINE"

    78

			hiveKey = &h80000002

    79

		Case "HKU", "HKEY_USERS"

    80

			hiveKey = &h80000003

    81

		Case "HKCC", "HKEY_CURRENT_CONFIG"

    82

			hiveKey = &h80000005

    83

		Case "HKDD", "HKEY_DYN_DATA" ' Only valid for Windows 95/98

    84

			hiveKey = &h80000006

    85

		Case Else

    86

			MsgBox "Hive not valid (ReadRegistryKey)"

    87

	End Select

    88

    89

	Set Inparams = objReg.Methods_("GetStringValue").Inparameters

    90

	Inparams.Hdefkey = hiveKey

    91

	Inparams.Ssubkeyname = subkey

    92

	Inparams.Svaluename = valuename

    93

	Set Outparams = objReg.ExecMethod_("GetStringValue", Inparams,,objCtx)

    94

    95

	ReadRegistryKey = Outparams.SValue

    96

End Function

    97

    98

Function DetermineSVNVersion()

    99

	Dim WshShell, version, url, oExec, line

   100

	Set WshShell = CreateObject("WScript.Shell")

   101

	On Error Resume Next

   102

   103

	' Try TortoiseSVN

   104

	' Get the directory where TortoiseSVN (should) reside(s)

   105

	Dim sTortoise

   106

	' First, try with 32-bit architecture

   107

	sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 32)

   108

	If sTortoise = Nothing Then

   109

		' No 32-bit version of TortoiseSVN installed, try 64-bit version (doesn't hurt on 32-bit machines, it returns nothing or is ignored)

   110

		sTortoise = ReadRegistryKey("HKLM", "SOFTWARE\TortoiseSVN", "Directory", 64)

   111

	End If

   112

   113

	' If TortoiseSVN is installed, try to get the revision number

   114

	If sTortoise <> Nothing Then

   115

		Dim file

   116

		' Write some "magic" to a temporary file so we can acquire the svn revision/state

   117

		Set file = FSO.CreateTextFile("tsvn_tmp", -1, 0)

   118

		file.WriteLine "r$WCREV$$WCMODS?M:$"

   119

		file.WriteLine "$WCURL$"

   120

		file.Close

   121

		Set oExec = WshShell.Exec(sTortoise & "\bin\SubWCRev.exe ../src tsvn_tmp tsvn_tmp")

   122

		' Wait till the application is finished ...

   123

		Do

   124

			OExec.StdOut.ReadLine()

   125

		Loop While Not OExec.StdOut.atEndOfStream

   126

   127

		Set file = FSO.OpenTextFile("tsvn_tmp", 1, 0, 0)

   128

		version = file.ReadLine

   129

		url = file.ReadLine

   130

		file.Close

   131

   132

		Set file = FSO.GetFile("tsvn_tmp")

   133

		file.Delete

   134

	End If

   135

   136

	' Looks like there is no TortoiseSVN installed either. Then we don't know it.

   137

	If InStr(version, "$") Then

   138

		' Reset error and version

   139

		Err.Clear

   140

		version = "norev000"

   141

		' Do we have subversion installed? Check immediatelly whether we've got a modified WC.

   142

		Set oExec = WshShell.Exec("svnversion ../src")

   143

		If Err.Number = 0 Then

   144

			Dim modified

   145

			If InStr(OExec.StdOut.ReadLine(), "M") Then

   146

				modified = "M"

   147

			Else

   148

				modified = ""

   149

			End If

   150

   151

			' Set the environment to english

   152

			WshShell.Environment("PROCESS")("LANG") = "en"

   153

   154

			' And use svn info to get the correct revision and branch information.

   155

			Set oExec = WshShell.Exec("svn info ../src")

   156

			If Err.Number = 0 Then

   157

				Do

   158

					line = OExec.StdOut.ReadLine()

   159

					If InStr(line, "URL") Then

   160

						url = line

   161

					End If

   162

					If InStr(line, "Last Changed Rev") Then

   163

						version = "r" & Mid(line, 19) & modified

   164

					End If

   165

				Loop While Not OExec.StdOut.atEndOfStream

   166

			End If

   167

		End If

   168

	End If

   169

   170

	If version <> "norev000" Then

   171

		If InStr(url, "branches") Then

   172

			url = Mid(url, InStr(url, "branches") + 8)

   173

			url = Mid(url, 1, InStr(2, url, "/") - 1)

   174

			version = version & Replace(url, "/", "-")

   175

		End If

   176

	Else

   177

		' svn detection failed, reset error and try git

   178

		Err.Clear

   179

		Set oExec = WshShell.Exec("git rev-parse --verify --short=8 HEAD")

   180

		If Err.Number = 0 Then

   181

			version = "g" & oExec.StdOut.ReadLine()

   182

			Set oExec = WshShell.Exec("git diff-index --exit-code --quiet HEAD ../src")

   183

			Do While oExec.Status = 0 And Err.Number = 0

   184

			Loop

   185

			If Err.Number = 0 And oExec.ExitCode = 1 Then

   186

				version = version & "M"

   187

			End If

   188

   189

			Set oExec = WshShell.Exec("git symbolic-ref HEAD")

   190

			If Err.Number = 0 Then

   191

				line = oExec.StdOut.ReadLine()

   192

				line = Mid(line, InStrRev(line, "/")+1)

   193

				If line <> "master" Then

   194

					version = version & "-" & line

   195

				End If

   196

			End If

   197

		Else

   198

			' try mercurial (hg)

   199

			Err.Clear

   200

			Set oExec = WshShell.Exec("hg tip")

   201

			If Err.Number = 0 Then

   202

				version = "h" & Mid(OExec.StdOut.ReadLine(), 19, 8)

   203

				Set oExec = WshShell.Exec("hg status ../src")

   204

				If Err.Number = 0 Then

   205

					Do

   206

						line = OExec.StdOut.ReadLine()

   207

						If Mid(line, 1, 1) <> "?" Then

   208

							version = version & "M"

   209

							Exit Do

   210

						End If

   211

					Loop While Not OExec.StdOut.atEndOfStream

   212

				End If

   213

				Set oExec = WshShell.Exec("hg branch")

   214

				If Err.Number = 0 Then

   215

						line = OExec.StdOut.ReadLine()

   216

						If line <> "default" Then

   217

							version = version & "-" & line

   218

						End If

   219

				End If

   220

			End If

   221

		End If

   222

	End If

   223

   224

	DetermineSVNVersion = version

   225

End Function

   226

   227

Function IsCachedVersion(version)

   228

	Dim cache_file, cached_version

   229

	cached_version = ""

   230

	Set cache_file = FSO.OpenTextFile("../config.cache.version", 1, True, 0)

   231

	If Not cache_file.atEndOfStream Then

   232

		cached_version = cache_file.ReadLine()

   233

	End If

   234

	cache_file.Close

   235

   236

	If version <> cached_version Then

   237

		Set cache_file = fso.CreateTextFile("../config.cache.version", True)

   238

		cache_file.WriteLine(version)

   239

		cache_file.Close

   240

		IsCachedVersion = False

   241

	Else

   242

		IsCachedVersion = True

   243

	End If

   244

End Function

   245

   246

Dim version

   247

version = DetermineSVNVersion

   248

If Not (IsCachedVersion(version) And FSO.FileExists("../src/rev.cpp") And FSO.FileExists("../src/ottdres.rc")) Then

   249

	UpdateFiles version

   250

End If