Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for holidays.hta

(view source code of holidays.hta as plain text) 

  1. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
  2. <html>
  3. <head>
  4. <title>Holidays Calculator</title>
  5. <HTA:APPLICATION
  6. 	APPLICATIONNAME="Holidays Calculator"
  7. 	ID="Holidays"
  8. 	VERSION="3.12"
  9. 	BORDER="thin"
  10. 	INNERBORDER="no"
  11. 	SCROLL="no"
  12. 	SINGLEINSTANCE="yes"
  13. 	WINDOWSTATE="maximize"/>
  14.  
  15. <style type="text/css">
  1. .Group
  2. {
  3. 	border: 1px solid gray;
  4. 	padding: 12px 25px 12px 25px;
  5. }
  6.  
  7. a
  8. {
  9. 	color: blue;
  10. }
  11.  
  12. body
  13. {
  14. 	color: white;
  15. 	background-color: #00FFFF;
  16. 	font-family: arial, sans-serif;
  17. 	font-size: 12pt;
  18. 	margin: 0;
  19. 	padding: 10px;
  20. 	filter: progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0080FF', EndColorStr='#00FFFF')"
  21. }
  22.  
  23. input.Button
  24. {
  25. 	width: 10em;
  26. 	height: 2em;
  27. }
  28.  
  29. table
  30. {
  31. 	border: 0 none;
  32. 	width: 90%;
  33. }
  34.  
  35. td.Content
  36. {
  37. 	width: 35%;
  38. }
  39.  
  40. td.Control
  41. {
  42. 	width: 20%;
  43. 	text-align: right;
  44. }
  45.  
  46. td.Spacer
  47. {
  48. 	width: 5%;
  49. }
  1. </style>
  2.  
  3. </head>
  4.  
  5. <script language="VBScript">
  1.  
  2. Option Explicit
  3.  
  4. Dim blnUpdate
  5. Dim intLocale, intUpdateSize, intVerMsgSize, intWindowHeight, intWindowWidth
  6. Dim objCaptions, objIE, objSettings
  7. Dim strArguments, strCmdLine, strScriptName
  8.  
  9. Const CopyRights = "©"
  10.  
  11. Const ForAppending = 8
  12. Const ForReading   = 1
  13. Const ForWriting   = 2
  14.  
  15. Const TristateFalse      =  0
  16. Const TristateMixed      = -2
  17. Const TristateTrue       = -1
  18. Const TristateUseDefault = -2
  19.  
  20. Set objIE = CreateObject( "InternetExplorer.Application" )
  21.  
  22. blnUpdate       = False
  23. intLocale       =    0
  24. intUpdateSize   =    0
  25. intVerMsgSize   =    0
  26. intWindowHeight =  680
  27. intWindowWidth  = 1024
  28. strScriptName   = Self.location.pathname
  29. strCmdLine      = Holidays.CommandLine
  30. If Left( strCmdLine, 1 ) = Chr(34) Then
  31. 	strArguments = Trim( Mid( strCmdLine, Len( strScriptName ) + 3 ) )
  32. Else
  33. 	strArguments = Trim( Mid( strCmdLine, Len( strScriptName ) + 1 ) )
  34. End If
  35.  
  36.  
  37. ' Use variables for captions, to allow easy translation
  38. Set objCaptions = CreateObject( "Scripting.Dictionary" )
  39. objCaptions.Add "Ascension", "Ascension"
  40. objCaptions.Add "BlameSomeoneElseDay", "Blame Someone Else Day"
  41. objCaptions.Add "Christmas", "Christmas"
  42. objCaptions.Add "ColumbusDay", "Columbus Day"
  43. objCaptions.Add "Copy", "Copy"
  44. objCaptions.Add "Copied", "Copied"
  45. objCaptions.Add "Download", "Download"
  46. objCaptions.Add "Easter", "Easter"
  47. objCaptions.Add "GoodFriday", "Good Friday"
  48. objCaptions.Add "GroundhogDay", "Groundhog Day"
  49. objCaptions.Add "Halloween", "Halloween"
  50. objCaptions.Add "HideNotification", "Hide Notification"
  51. objCaptions.Add "NewYearsDay", "New Year's Day"
  52. objCaptions.Add "Pentecost", "Pentecost"
  53. objCaptions.Add "Sint Maarten", "Sint Maarten"
  54. objCaptions.Add "Sinterklaas", "Sinterklaas"
  55. objCaptions.Add "StPatricksDay", "Saint Patrick's Day"
  56. objCaptions.Add "Thanksgiving", "Thanksgiving"
  57. objCaptions.Add "UpdateNow", "Update Now"
  58. objCaptions.Add "Year", "Year"
  59.  
  60. ' Use variables for settings, to allow easy customization
  61. Set objSettings = CreateObject( "Scripting.Dictionary" )
  62. objSettings.Add "AutoUpdate", 0
  63. objSettings.Add "Language", ""
  64.  
  65.  
  66. Function BlameSomeoneElseDay( intYear )
  67. 	' Find the first Friday the 13th of the specified year: that is Blame Someone Else Day
  68. 	Dim blnFound, datDate, i, intWeekDay, strDate
  69.  
  70. 	BlameSomeoneElseDay = "N/A"
  71.  
  72. 	blnFound = False
  73.  
  74. 	For i = 1 To 12
  75. 		strDate = "13 " & MonthName( i ) & " " & intYear
  76. 		datDate = CDate( strDate )
  77. 		intWeekDay = DatePart( "w", datDate, vbSunday )
  78. 		If intWeekDay = 6 Then
  79. 			If blnFound = False Then
  80. 				blnFound = True
  81. 				BlameSomeoneElseDay = CDate( datDate )
  82. 			End If
  83. 		End If
  84. 	Next
  85. End Function
  86.  
  87.  
  88. Sub CheckUpdate( )
  89. 	Dim lenLatestVer, strCurrentVer, strLatestver, strQuote, wshShell
  90.  
  91. 	On Error Resume Next
  92.  
  93. 	' Change mouse pointer to hourglass while checking for update
  94. 	Document.Body.Style.Cursor = "wait"
  95.  
  96. 	strCurrentVer = Left( Holidays.Version, 4 )
  97. 	' Read the latest version info from the web
  98. 	strLatestVer  = WGet( "http://www.robvanderwoude.com/updates/holidays.txt" )
  99.  
  100. 	' Retry once, after clearing the IE cache, if the versions don't match
  101. 	If strCurrentVer <> strLatestver Then
  102. 		' Clear the IE cache
  103. 		Set wshShell = CreateObject( "WScript.Shell" )
  104. 		wshShell.Run "RUNDll32.EXE InetCpl.cpl,ClearMyTracksByProcess 8", 7, True
  105. 		Set wshShell = Nothing
  106. 		' Try again, read the latest version info from the web
  107. 		strLatestver = WGet( "http://www.robvanderwoude.com/updates/holidays.txt" )
  108. 	End If
  109.  
  110. 	lenLatestVer  = Len( strLatestVer )
  111. 	If lenLatestVer = 4 Then
  112. 		If objSettings.Item( "AutoUpdate" ) = 1 Then
  113. 			Update
  114. 		Else
  115. 			If strLatestVer < strCurrentVer Then
  116. 				blnUpdate                    = True
  117. 				UpdateBlock.style.display    = "block"
  118. 				UpdateGroup.style.border     = "1px solid yellow"
  119. 				UpdateNotification.InnerHTML = "You seem to be using a pre-release version (" & Holidays.Version & ") of Holidays.hta. The latest stable release is " & strLatestVer & "."
  120. 			End If
  121. 			If strLatestVer > strCurrentVer Then
  122. 				blnUpdate                    = True
  123. 				UpdateBlock.style.display    = "block"
  124. 				UpdateGroup.style.border     = "1px solid red"
  125. 				UpdateNotification.InnerHTML = "You are using version " & Holidays.Version & " of Holidays.hta. The latest stable release is " & strLatestVer & "."
  126. 			End If
  127. 		End If
  128. 	End If
  129.  
  130. 	' Change mouse pointer back to default
  131. 	Document.Body.Style.Cursor = "default"
  132.  
  133. 	On Error Goto 0
  134. End Sub
  135.  
  136.  
  137. Sub Copy2Clipboard( )
  138. 	Dim strCopy
  139. 	strCopy = """" & objCaptions.Item( "Year" ) _
  140. 	        & """,""" & MyYear0.InnerHTML       _
  141. 	        & """,""" & MyYear1.Value           _
  142. 	        & """,""" & MyYear2.InnerHTML       _
  143. 	        & """" & vbCrLf & """"              _
  144. 	        & NewYearsDayName.InnerHTML         _
  145. 	        & """,""" & NewYearsDay0.Value      _
  146. 	        & """,""" & NewYearsDay1.Value      _
  147. 	        & """,""" & NewYearsDay2.Value      _
  148. 	        & """" & vbCrLf & """"              _
  149. 	        & GroundhogDayName.InnerHTML        _
  150. 	        & """,""" & GroundhogDay0.Value     _
  151. 	        & """,""" & GroundhogDay1.Value     _
  152. 	        & """,""" & GroundhogDay2.Value     _
  153. 	        & """" & vbCrLf & """"              _
  154. 	        & BlameSomeoneElseDayName.InnerHTML _
  155. 	        & """,""" & BSED0.Value             _
  156. 	        & """,""" & BSED1.Value             _
  157. 	        & """,""" & BSED2.Value             _
  158. 	        & """" & vbCrLf & """"              _
  159. 	        & EasterName.InnerHTML              _
  160. 	        & """,""" & Easter0.Value           _
  161. 	        & """,""" & Easter1.Value           _
  162. 	        & """,""" & Easter2.Value           _
  163. 	        & """" & vbCrLf & """"              _
  164. 	        & AscensionName.InnerHTML           _
  165. 	        & """,""" & Ascension0.Value        _
  166. 	        & """,""" & Ascension1.Value        _
  167. 	        & """,""" & Ascension2.Value        _
  168. 	        & """" & vbCrLf & """"              _
  169. 	        & PentecostName.InnerHTML           _
  170. 	        & """,""" & Pentecost0.Value        _
  171. 	        & """,""" & Pentecost1.Value        _
  172. 	        & """,""" & Pentecost2.Value        _
  173. 	        & """" & vbCrLf & """"              _
  174. 	        & ColumbusDayName.InnerHTML         _
  175. 	        & """,""" & ColumbusDay0.Value      _
  176. 	        & """,""" & ColumbusDay1.Value      _
  177. 	        & """,""" & ColumbusDay2.Value      _
  178. 	        & """" & vbCrLf & """"              _
  179. 	        & HalloweenName.InnerHTML           _
  180. 	        & """,""" & Halloween0.Value        _
  181. 	        & """,""" & Halloween1.Value        _
  182. 	        & """,""" & Halloween2.Value        _
  183. 	        & """" & vbCrLf & """"              _
  184. 	        & SintMaartenName.InnerHTML         _
  185. 	        & """,""" & SintMaarten0.Value      _
  186. 	        & """,""" & SintMaarten1.Value      _
  187. 	        & """,""" & SintMaarten2.Value      _
  188. 	        & """" & vbCrLf & """"              _
  189. 	        & StPatricksDayName.InnerHTML       _
  190. 	        & """,""" & StPatricksDay0.Value    _
  191. 	        & """,""" & StPatricksDay1.Value    _
  192. 	        & """,""" & StPatricksDay2.Value    _
  193. 	        & """" & vbCrLf & """"              _
  194. 	        & ThanksgivingName.InnerHTML        _
  195. 	        & """,""" & Thanksgiving0.Value     _
  196. 	        & """,""" & Thanksgiving1.Value     _
  197. 	        & """,""" & Thanksgiving2.Value     _
  198. 	        & """" & vbCrLf & """"              _
  199. 	        & SinterklaasName.InnerHTML         _
  200. 	        & """,""" & Sinterklaas0.Value      _
  201. 	        & """,""" & Sinterklaas1.Value      _
  202. 	        & """,""" & Sinterklaas2.Value      _
  203. 	        & """" & vbCrLf & """"              _
  204. 	        & ChristmasName.InnerHTML           _
  205. 	        & """,""" & Christmas0.Value        _
  206. 	        & """,""" & Christmas1.Value        _
  207. 	        & """,""" & Christmas2.Value        _
  208. 	        & """" & vbCrLf
  209. 	Document.ParentWindow.ClipboardData.SetData "text", strCopy
  210. 	If Not Err Then
  211. 		Button_Copy.Value = objCaptions.Item( "Copied" )
  212. 	End If
  213. End Sub
  214.  
  215.  
  216. Function Easter( intYear )
  217. 	Dim D, DD, E, ED, EM, G, L, P, PP, PPP, S, X
  218.  
  219. 	' Calculate Easter Day using the instructions found at Simon Kershaw's "KEEPING THE FEAST":
  220. 	' http://www.oremus.org/liturgy/etc/ktf/app/easter.html
  221. 	' Variable names match the ones found at that page.
  222.  
  223. 	G   = ( intYear Mod 19 ) + 1
  224. 	S   = ( ( intYear - 1600 ) \ 100 ) - ( ( intYear - 1600 ) \ 400 )
  225. 	L   = ( ( ( intYear - 1400 ) \ 100 ) * 8 ) \ 25
  226. 	PP  = ( 30003 - 11 * G + S - L ) Mod 30
  227. 	Select Case PP
  228. 		Case 28
  229. 			If G > 11 Then P = 27
  230. 		Case 29
  231. 			P = 28
  232. 		Case Else
  233. 			P = PP
  234. 	End Select
  235. 	D   = ( intYear + ( intYear \ 4 ) - ( intYear \ 100 ) + ( intYear \ 400 )) Mod 7
  236. 	DD  = ( 8 - D ) Mod 7
  237. 	PPP = ( 70003 + P ) Mod 7
  238. 	X   = (( 70004 - D - P ) Mod 7 ) + 1
  239. 	E   = P + X
  240. 	If E < 11 Then
  241. 		ED = E + 21
  242. 		EM = MonthName( 3 )
  243. 	Else
  244. 		ED = E - 10
  245. 		EM = MonthName( 4 )
  246. 	End If
  247. 	' Return the result
  248. 	Easter = CDate( ED & " " & EM & " " & intYear )
  249. End Function
  250.  
  251.  
  252. Sub HandleYearChange()
  253. 	Dim datBSED0, datBSED1, datBSED2, datEaster0, datEaster1, datEaster2, datThanks0, datThanks1, datThanks2, intThanks0, intThanks1, intThanks2, strThanks0, strThanks1, strThanks2
  254.  
  255. 	MyYear0.InnerHTML   = MyYear1.Value - 1
  256. 	MyYear2.InnerHTML   = MyYear1.Value + 1
  257.  
  258. 	NewYearsDay0.Value  = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear0.InnerHTML, vbLongDate )
  259. 	NewYearsDay1.Value  = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear1.Value,     vbLongDate )
  260. 	NewYearsDay2.Value  = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear2.InnerHTML, vbLongDate )
  261.  
  262. 	GroundhogDay0.Value = FormatDateTime( "2 " & MonthName( 2 ) & " " & MyYear0.InnerHTML, vbLongDate )
  263. 	GroundhogDay1.Value = FormatDateTime( "2 " & MonthName( 2 ) & " " & MyYear1.Value,     vbLongDate )
  264. 	GroundhogDay2.Value = FormatDateTime( "2 " & MonthName( 2 ) & " " & MyYear2.InnerHTML, vbLongDate )
  265.  
  266. 	StPatricksDay0.Value = FormatDateTime( "17 " & MonthName( 3 ) & " " & MyYear0.InnerHTML, vbLongDate )
  267. 	StPatricksDay1.Value = FormatDateTime( "17 " & MonthName( 3 ) & " " & MyYear1.Value,     vbLongDate )
  268. 	StPatricksDay2.Value = FormatDateTime( "17 " & MonthName( 3 ) & " " & MyYear2.InnerHTML, vbLongDate )
  269.  
  270. 	datEaster0             = Easter( MyYear0.InnerHTML )
  271. 	datEaster1             = Easter( MyYear1.Value     )
  272. 	datEaster2             = Easter( MyYear2.InnerHTML )
  273.  
  274. 	GoodFriday0.Value      = FormatDateTime( DateAdd( "d", -2, datEaster0 ), vbLongDate )
  275. 	GoodFriday1.Value      = FormatDateTime( DateAdd( "d", -2, datEaster1 ), vbLongDate )
  276. 	GoodFriday2.Value      = FormatDateTime( DateAdd( "d", -2, datEaster2 ), vbLongDate )
  277.  
  278. 	Easter0.Value          = FormatDateTime( datEaster0, vbLongDate )
  279. 	Easter1.Value          = FormatDateTime( datEaster1, vbLongDate )
  280. 	Easter2.Value          = FormatDateTime( datEaster2, vbLongDate )
  281.  
  282. 	Ascension0.Value       = FormatDateTime( DateAdd( "d", 39, datEaster0 ), vbLongDate )
  283. 	Ascension1.Value       = FormatDateTime( DateAdd( "d", 39, datEaster1 ), vbLongDate )
  284. 	Ascension2.Value       = FormatDateTime( DateAdd( "d", 39, datEaster2 ), vbLongDate )
  285.  
  286. 	Pentecost0.Value       = FormatDateTime( DateAdd( "d", 49, datEaster0 ), vbLongDate )
  287. 	Pentecost1.Value       = FormatDateTime( DateAdd( "d", 49, datEaster1 ), vbLongDate )
  288. 	Pentecost2.Value       = FormatDateTime( DateAdd( "d", 49, datEaster2 ), vbLongDate )
  289.  
  290. 	datBSED0               = BlameSomeoneElseDay( MyYear0.InnerHTML )
  291. 	datBSED1               = BlameSomeoneElseDay( MyYear1.Value     )
  292. 	datBSED2               = BlameSomeoneElseDay( MyYear2.InnerHTML )
  293.  
  294. 	BSED0.Value            = FormatDateTime( datBSED0, vbLongDate )
  295. 	BSED1.Value            = FormatDateTime( datBSED1, vbLongDate )
  296. 	BSED2.Value            = FormatDateTime( datBSED2, vbLongDate )
  297.  
  298. 	' Canada: second Monday of October
  299. 	intThanks0             = 16 - Weekday( CDate( CStr( MyYear1.Value - 1 ) & "-10-01" ), vbMonday )
  300. 	intThanks1             = 16 - Weekday( CDate( CStr( MyYear1.Value     ) & "-10-01" ), vbMonday )
  301. 	intThanks2             = 16 - Weekday( CDate( CStr( MyYear1.Value + 1 ) & "-10-01" ), vbMonday )
  302.  
  303. 	If intThanks0 > 14 Then intThanks0 = intThanks0 - 7
  304. 	If intThanks1 > 14 Then intThanks1 = intThanks1 - 7
  305. 	If intThanks2 > 14 Then intThanks2 = intThanks2 - 7
  306.  
  307. 	datThanks0             = CDate( CStr( MyYear1.Value - 1 ) & "-10-" & CStr( intThanks0 ) )
  308. 	datThanks1             = CDate( CStr( MyYear1.Value     ) & "-10-" & CStr( intThanks1 ) )
  309. 	datThanks2             = CDate( CStr( MyYear1.Value + 1 ) & "-10-" & CStr( intThanks2 ) )
  310.  
  311. 	ColumbusDay0.Value     = FormatDateTime( datThanks0, vbLongDate )
  312. 	ColumbusDay1.Value     = FormatDateTime( datThanks1, vbLongDate )
  313. 	ColumbusDay2.Value     = FormatDateTime( datThanks2, vbLongDate )
  314.  
  315. 	Halloween0.Value       = FormatDateTime( "31 " & MonthName( 10 ) & " " & MyYear0.InnerHTML, vbLongDate )
  316. 	Halloween1.Value       = FormatDateTime( "31 " & MonthName( 10 ) & " " & MyYear1.Value,     vbLongDate )
  317. 	Halloween2.Value       = FormatDateTime( "31 " & MonthName( 10 ) & " " & MyYear2.InnerHTML, vbLongDate )
  318.  
  319. 	SintMaarten0.Value     = FormatDateTime( "11 " & MonthName( 11 ) & " " & MyYear0.InnerHTML, vbLongDate )
  320. 	SintMaarten1.Value     = FormatDateTime( "11 " & MonthName( 11 ) & " " & MyYear1.Value,     vbLongDate )
  321. 	SintMaarten2.Value     = FormatDateTime( "11 " & MonthName( 11 ) & " " & MyYear2.InnerHTML, vbLongDate )
  322.  
  323. 	' USA: fourth Thursday of November
  324. 	intThanks0             = 30 - Weekday( CDate( CStr( MyYear1.Value - 1 ) & "-11-01" ), vbThursday )
  325. 	intThanks1             = 30 - Weekday( CDate( CStr( MyYear1.Value     ) & "-11-01" ), vbThursday )
  326. 	intThanks2             = 30 - Weekday( CDate( CStr( MyYear1.Value + 1 ) & "-11-01" ), vbThursday )
  327.  
  328. 	If intThanks0 > 28 Then intThanks0 = intThanks0 - 7
  329. 	If intThanks1 > 28 Then intThanks1 = intThanks1 - 7
  330. 	If intThanks2 > 28 Then intThanks2 = intThanks2 - 7
  331.  
  332. 	datThanks0             = CDate( CStr( MyYear1.Value - 1 ) & "-11-" & CStr( intThanks0 ) )
  333. 	datThanks1             = CDate( CStr( MyYear1.Value     ) & "-11-" & CStr( intThanks1 ) )
  334. 	datThanks2             = CDate( CStr( MyYear1.Value + 1 ) & "-11-" & CStr( intThanks2 ) )
  335.  
  336. 	Thanksgiving0.Value    = FormatDateTime( datThanks0, vbLongDate )
  337. 	Thanksgiving1.Value    = FormatDateTime( datThanks1, vbLongDate )
  338. 	Thanksgiving2.Value    = FormatDateTime( datThanks2, vbLongDate )
  339.  
  340. 	Sinterklaas0.Value     = FormatDateTime( "5 " & MonthName( 12 ) & " " & MyYear0.InnerHTML, vbLongDate )
  341. 	Sinterklaas1.Value     = FormatDateTime( "5 " & MonthName( 12 ) & " " & MyYear1.Value,     vbLongDate )
  342. 	Sinterklaas2.Value     = FormatDateTime( "5 " & MonthName( 12 ) & " " & MyYear2.InnerHTML, vbLongDate )
  343.  
  344. 	Christmas0.Value       = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear0.InnerHTML, vbLongDate )
  345. 	Christmas1.Value       = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear1.Value,     vbLongDate )
  346. 	Christmas2.Value       = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear2.InnerHTML, vbLongDate )
  347.  
  348. 	Button_Copy.Value      = objCaptions.Item( "Copy" )
  349. End Sub
  350.  
  351.  
  352. Sub HelpMsg( )
  353. 	Dim strHTML
  354. 	strHTML = "<p><strong>Holidays Calculator,  Version " & Holidays.Version & "</strong>\n" _
  355. 	        & "This program calculates the dates of several western holidays.\n\n" _
  356. 	        & "<strong>Usage</strong>\n\n" _
  357. 	        & "The only interaction required is the choice of the year(s) to display.\n" _
  358. 	        & "The program will then display the dates for a selection of holidays for the year before, the selected year, and the year after that.\n\n" _
  359. 	        & "Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "Copy" ) & """> to copy the results to the clipboard (comma delimited).\n\n" _
  360. 	        & "<strong>Program Updates</strong>\n\n" _
  361. 	        & "This program automatically checks for updates.\n" _
  362. 	        & "If an update is available, a notification area will pop up at the top of the window.\n" _
  363. 	        & "Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "Download" ) & """> to navigate to the program's download page.\n" _
  364. 	        & "Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "UpdateNow" ) & """> to update the program ""on-the-fly"" (after a prompt for confirmation).\n" _
  365. 	        & "A backup of the current file will be made before the update, allowing a roll-back if necessary.\n" _
  366. 	        & "If AutoUpdate is enabled, the program is updated ""on-the-fly"" without <em>any</em> notification (see the chapter ""Customization"" for more details).\n\n" _
  367. 	        & "Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""" & objCaptions.Item( "HideNotification" )& """> to move the notification out of sight.\n" _
  368. 	        & "Unless you update the program, the notification will reappear next time the program is started.\n\n" _
  369. 	        & "<strong id=""Customization"">Customization</strong>\n\n" _
  370. 	        & "You may use a configuration file named Holidays.cfg, to customize the window size, default input and output languages and number of simultaneous translations.\n" _
  371. 	        & "Holidays.cfg is an ANSI encoded (or ""ASCII"") plain text file, located in Holidays.hta's parent folder.\n" _
  372. 	        & "Examine the default settings shown below to find out what you can customize and how:</p>"
  373. 	strHTML = Replace( strHTML, "\n\n", "</p>" & vbCrLf & vbCrLf & "<p>" )
  374. 	strHTML = Replace( strHTML, "\n", "<br>" & vbCrLf ) _
  375. 	        & "<pre>AutoUpdate=0\n" _
  376. 	        & "Language=en\n</pre>\n"
  377. 	strHTML = Replace( strHTML, "\n", vbCrLf ) _
  378. 	        & "<strong>Note:</strong> <code>AutoUpdate=1</code> will update the HTA to the latest version without <em>any</em> user interaction.\n\n" _
  379. 	        & "Besides the program settings, you can also customize (translate) the captions (holiday names) and button labels.\n" _
  380. 	        & "This requires an ANSI encoded (or ""ASCII"") plain text file named Holidays.<em>lang</em>, located in Holidays.hta's parent folder, where <em>lang</em> is the language code specified by <code>ConfigLanguage</code> in Holidays.cfg (e.g. <code>en</code>).\n" _
  381. 	        & "Unicode or extended ASCII characters in all text except button labels must be escaped (e.g. <code>&amp;Uuml;</code> for <code>&Uuml;</code>).\n" _
  382. 	        & "You may have to experiment with code page settings when using extended ASCII characters in translated <em>button</em> labels.\n\n" _
  383. 	        & "The values at the right of the equal sign are the text as displayed in the program window.\n" _
  384. 	        & "You can translate the captions and labels, or modify them in any way you like.\n" _
  385. 	        & "Examine Holidays.en, shown below, to figure out what you can customize and how:</p>"
  386. 	strHTML = Replace( strHTML, "\n\n", "</p>" & vbCrLf & vbCrLf & "<p>" )
  387. 	strHTML = Replace( strHTML, "\n", "<br>" & vbCrLf ) _
  388. 	        & "<pre>Ascension=Ascension\n" _
  389. 	        & "BlameSomeoneElseDay=Blame Someone Else Day\n" _
  390. 	        & "Christmas=Christmas\n" _
  391. 	        & "ColumbusDay=Columbus Day\n" _
  392. 	        & "Copy=Copy\n" _
  393. 	        & "Copied=Copied\n" _
  394. 	        & "Download=Download\n" _
  395. 	        & "Easter=Easter\n" _
  396. 	        & "GoodFriday=Good Friday\n" _
  397. 	        & "GroundhogDay=Groundhog Day\n" _
  398. 	        & "Halloween=Halloween\n" _
  399. 	        & "HideNotification=Hide Notification\n" _
  400. 	        & "NewYearsDay=New Year's Day\n" _
  401. 	        & "Pentecost=Pentecost\n" _
  402. 	        & "Sinterklaas=Sinterklaas\n" _
  403. 	        & "SintMaarten=Sint Maarten\n" _
  404. 	        & "StPatricksDay=Saint Patrick's Day\n" _
  405. 	        & "Thanksgiving=Thanksgiving\n" _
  406. 	        & "UpdateNow=Update Now\n" _
  407. 	        & "Year=Year</pre>\n"
  408. 	strHTML = Replace( strHTML, "\n", vbCrLf ) _
  409. 	        & "<strong>Note:</strong> All <em>values</em> (except <code>Copy</code> and <code>Copied</code>, which are <em>button</em> labels) must be HTML escaped, e.g. <code>Year=A&amp;ntilde;o</code> instead of <code>Year=A&ntilde;o</code>.\n\n" _
  410. 	        & "Change one setting at a time and examine the effect.\n" _
  411. 	        & "If the result is a complete mess, just delete Holidays.cfg (and optionally Holidays.<em>lang</em>) to restore the default settings.\n\n" _
  412. 	        & "If you like this program, why not show your appreciation by making a donation?\n" _
  413. 	        & "Click <input type=""button"" style=""width: 10em; height: 2em; vertical-align: middle"" value=""Donate"" onclick=""window.open('http://www.robvanderwoude.com/donate.php')""> or navigate to <a href=""http://www.robvanderwoude.com/donate.php"">http://www.robvanderwoude.com/donate.php</a>\n\n" _
  414. 	        & "&copy; Rob van der Woude 2006 - 2013\n" _
  415. 	        & "<a href=""http://www.robvanderwoude.com/holidays.php"">http://www.robvanderwoude.com/holidays.php</a></p>"
  416. 	strHTML = Replace( strHTML, "\n\n", "</p>" & vbCrLf & vbCrLf & "<p>" )
  417. 	strHTML = Replace( strHTML, "\n", "<br>" & vbCrLf )
  418.  
  419. 	On Error Resume Next
  420. 	objIE.Navigate "about:blank"
  421. 	If Err Then
  422. 		Set objIE = CreateObject( "InternetExplorer.Application" )
  423. 		objIE.Navigate "about:blank"
  424. 	End If
  425. 	On Error Goto 0
  426. 	objIE.Width  = intWindowWidth
  427. 	objIE.Height = intWindowHeight + intUpdateSize
  428. 	objIE.Left   = Int( ( window.screen.width  - objIE.Width  ) / 2 ) + 30
  429. 	objIE.Top    = Int( ( window.screen.height - objIE.Height ) / 2 ) + 30
  430. 	objIE.StatusBar  = False
  431. 	objIE.AddressBar = False
  432. 	objIE.MenuBar    = False
  433. 	objIE.ToolBar    = False
  434. 	objIE.Document.Title = "Help for Holidays " & Holidays.Version & ", ® Rob van der Woude 2011"
  435. 	objIE.Document.Body.style.fontFamily = "arial,sans-serif"
  436. 	objIE.Document.Body.InnerHTML = strHTML
  437. 	objIE.Visible = 1
  438. End Sub
  439.  
  440.  
  441. Sub LoadConfig( )
  442. 	Dim blnError
  443. 	Dim i
  444. 	Dim objCaptionsFile, objFSO, objNewOption, objSettingsFile
  445. 	Dim strBaseName, strCaptionsFile, strKey, strLine, strSettingsFile, strValue
  446.  
  447. 	blnError = False
  448.  
  449. 	' Find the full path of this HTA
  450. 	strBaseName = Left( Self.location.pathname, Len( Self.location.pathname ) - 4 )
  451.  
  452. 	' Check if it is accompanied by a config file
  453. 	strSettingsFile = strBaseName & ".cfg"
  454. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  455. 	With objFSO
  456. 		If .FileExists( strSettingsFile ) Then
  457. 			Set objSettingsFile = .OpenTextFile( strSettingsFile, ForReading, TristateFalse )
  458. 			While Not objSettingsFile.AtEndOfStream
  459. 				strLine = objSettingsFile.ReadLine( )
  460. 				strKey   = Trim( Left( strLine, InStr( strLine, "=" ) - 1 ) )
  461. 				strValue = Trim( Mid( strLine, InStr( strLine, "=" ) + 1 ) )
  462. 				Select Case strKey
  463. 					Case "AutoUpdate", "Language"
  464. 						objSettings.Item( strKey ) = strValue
  465. 					Case Else
  466. 						If Left( strKey, 1 ) <> ";" Then blnError = True
  467. 				End Select
  468. 			Wend
  469. 			objSettingsFile.Close
  470. 			Set objSettingsFile = Nothing
  471.  
  472. 			If Not blnError Then
  473. 				If objSettings.Item( "Language" ) <> "" Then
  474. 					strCaptionsFile = strBaseName & "." & objSettings.Item( "Language" )
  475. 					If .FileExists( strCaptionsFile ) Then
  476. 						Set objCaptionsFile = .OpenTextFile( strCaptionsFile, ForReading, TristateFalse )
  477. 						While Not objCaptionsFile.AtEndOfStream
  478. 							strLine = objCaptionsFile.ReadLine( )
  479. 							strKey = Trim( Left( strLine, InStr( strLine, "=" ) - 1 ) )
  480. 							strValue = Trim( Mid( strLine, InStr( strLine, "=" ) + 1 ) )
  481. 							Select Case strKey
  482. 								Case "Ascension", "BlameSomeoneElseDay", "Christmas", "ColumbusDay", "Copy", "Copied", "Download", "Easter", "GoodFriday", "GroundhogDay", "Halloween", "HideNotification", "NewYearsDay", "Pentecost", "SintMaarten", "Sinterklaas", "Thanksgiving", "UpdateNow", "Year"
  483. 									objCaptions.Item( strKey ) = strValue
  484. 								Case Else
  485. 									If Left( strKey, 1 ) <> ";" Then blnError = True
  486. 							End Select
  487. 						Wend
  488. 						objCaptionsFile.Close
  489. 						Set objCaptionsFile = Nothing
  490. 					End If
  491. 				End If
  492. 			End If
  493. 		End If
  494. 	End With
  495. 	Set objFSO = Nothing
  496. End Sub
  497.  
  498.  
  499. Sub Locale( )
  500. 	' Translate holiday names based on current locale,
  501. 	' as returned by the GetLocale( ) function:
  502. 	'
  503. 	' Afrikaans                                1078
  504. 	' Albanian                                 1052
  505. 	' Arabic - Algeria                         5121
  506. 	' Arabic - Bahrain                        15361
  507. 	' Arabic - Egypt                           3073
  508. 	' Arabic - Iraq                            2049
  509. 	' Arabic - Jordan                         11265
  510. 	' Arabic - Kuwait                         13313
  511. 	' Arabic - Lebanon                        12289
  512. 	' Arabic - Libya                           4097
  513. 	' Arabic - Morocco                         6145
  514. 	' Arabic - Oman                            8193
  515. 	' Arabic - Qatar                          16385
  516. 	' Arabic - Saudi Arabia                    1025
  517. 	' Arabic - Syria                          10241
  518. 	' Arabic - Tunisia                         7169
  519. 	' Arabic - United Arab Emirates           14337
  520. 	' Arabic - Yemen                           9217
  521. 	' Armenian                                 1067
  522. 	' Azeri - Cyrillic                         2092
  523. 	' Azeri - Latin                            1068
  524. 	' Basque                                   1069
  525. 	' Belarusian                               1059
  526. 	' Bulgarian                                1026
  527. 	' Catalan                                  1027
  528. 	' Chinese - China                          2052
  529. 	' Chinese - Hong Kong S.A.R.               3076
  530. 	' Chinese - Macau S.A.R.                   5124
  531. 	' Chinese - Singapore                      4100
  532. 	' Chinese - Taiwan                         1028
  533. 	' Croatian                                 1050
  534. 	' Czech                                    1029
  535. 	' Danish                                   1030
  536. 	' Dutch - Belgium                          2067
  537. 	' Dutch - The Netherlands                  1043
  538. 	' English - Australia                      3081
  539. 	' English - Belize                        10249
  540. 	' English - Canada                         4105
  541. 	' English - Carribbean                     9225
  542. 	' English - Ireland                        6153
  543. 	' English - Jamaica                        8201
  544. 	' English - New Zealand                    5129
  545. 	' English - Phillippines                  13321
  546. 	' English - South Africa                   7177
  547. 	' English - Trinidad                      11273
  548. 	' English - United Kingdom                 2057
  549. 	' English - United States                  1033
  550. 	' Estonian                                 1061
  551. 	' Faroese                                  1080
  552. 	' Farsi                                    1065
  553. 	' Finnish                                  1035
  554. 	' French - Belgium                         2060
  555. 	' French - Canada                          3084
  556. 	' French - France                          1036
  557. 	' French - Luxembourg                      5132
  558. 	' French - Switzerland                     4108
  559. 	' Macedonian                               1071
  560. 	' Gaelic - Ireland                         2108
  561. 	' Gaelic - Scotland                        1084
  562. 	' German - Austria                         3079
  563. 	' German - Germany                         1031
  564. 	' German - Liechtenstein                   5127
  565. 	' German - Luxembourg                      4103
  566. 	' German - Switzerland                     2055
  567. 	' Greek                                    1032
  568. 	' Hebrew                                   1037
  569. 	' Hindi                                    1081
  570. 	' Hungarian                                1038
  571. 	' Icelandic                                1039
  572. 	' Indonesian                               1057
  573. 	' Italian - Italy                          1040
  574. 	' Italian - Switzerland                    2064
  575. 	' Japanese                                 1041
  576. 	' Korean                                   1042
  577. 	' Latvian                                  1062
  578. 	' Lithuanian                               1063
  579. 	' Malay - Brunei                           2110
  580. 	' Malay - Malaysia                         1086
  581. 	' Maltese                                  1082
  582. 	' Marathi                                  1102
  583. 	' Norwegian - Bokmål                       1044
  584. 	' Norwegian - Nynorsk                      2068
  585. 	' Polish                                   1045
  586. 	' Portuguese - Brazil                      1046
  587. 	' Portuguese - Portugal                    2070
  588. 	' Raeto-Romance                            1047
  589. 	' Romanian - Moldova                       2072
  590. 	' Romanian - Romania                       1048
  591. 	' Russian - Moldova                        2073
  592. 	' Russian                                  1049
  593. 	' Sanskrit                                 1103
  594. 	' Serbian - Cyrillic                       3098
  595. 	' Serbian - Latin                          2074
  596. 	' Setsuana                                 1074
  597. 	' Slovak                                   1051
  598. 	' Slovenian                                1060
  599. 	' Sorbian                                  1070
  600. 	' Spanish - Argentina                     11274
  601. 	' Spanish - Bolivia                       16394
  602. 	' Spanish - Chile                         13322
  603. 	' Spanish - Colombia                       9226
  604. 	' Spanish - Costa Rica                     5130
  605. 	' Spanish - Dominican Republic             7178
  606. 	' Spanish - Ecuador                       12298
  607. 	' Spanish - El Salvador                   17418
  608. 	' Spanish - Guatemala                      4106
  609. 	' Spanish - Honduras                      18442
  610. 	' Spanish - Mexico                         2058
  611. 	' Spanish - Nicaragua                     19466
  612. 	' Spanish - Panama                         6154
  613. 	' Spanish - Paraguay                      15370
  614. 	' Spanish - Peru                          10250
  615. 	' Spanish - Puerto Rico                   20490
  616. 	' Spanish - Spain                          1034
  617. 	' Spanish - Uruguay                       14346
  618. 	' Spanish - Venezuela                      8202
  619. 	' Sutu                                     1072
  620. 	' Swahili                                  1089
  621. 	' Swedish - Finland                        2077
  622. 	' Swedish - Sweden                         1053
  623. 	' Tamil                                    1097
  624. 	' Tatar                                    1092
  625. 	' Thai                                     1054
  626. 	' Tsonga                                   1073
  627. 	' Turkish                                  1055
  628. 	' Ukrainian                                1058
  629. 	' Urdu                                     1056
  630. 	' Uzbek - Cyrillic                         2115
  631. 	' Uzbek - Latin                            1091
  632. 	' Vietnamese                               1066
  633. 	' Xhosa                                    1076
  634. 	' Yiddish                                  1085
  635. 	' Zulu                                     1077
  636.  
  637. 	If intLocale = 0 Then intLocale = GetLocale( )
  638. 	Select Case intLocale
  639. 		Case 1031, 2055, 3079, 4103, 5127 ' German (Germany, Switzerland, Austria, Luxembourg, Liechtenstein)
  640. 			objCaptions.Item( "Copy" )        = "Kopieren"
  641. 			objCaptions.Item( "Copied" )      = "Kopiert"
  642. 			objCaptions.Item( "Year" )        = "Jahr"
  643. 			objCaptions.Item( "NewYearsDay" ) = "Neujahrstag"
  644. 			objCaptions.Item( "GoodFriday" )  = "Karfreitag"
  645. 			objCaptions.Item( "Easter" )      = "Ostern"
  646. 			objCaptions.Item( "Ascension" )   = "Himmelfahrt"
  647. 			objCaptions.Item( "Pentecost" )   = "Pfingsten"
  648. 			objCaptions.Item( "Christmas" )   = "Weihnachten"
  649. 			objCaptions.Item( "Halloween" )   = "Reformationstag (DE), Halloween"
  650. 			objCaptions.Item( "Sinterklaas" ) = "Nikolaus"
  651. 			objCaptions.Item( "SintMaarten" ) = "Sankt Martin"
  652. 		Case 1036, 2060, 3084, 4108, 5132 ' French (France, Belgium, Canada, Switzerland, Luxembourg)
  653. 			objCaptions.Item( "Copy" )        = "Copier"
  654. 			objCaptions.Item( "Copied" )      = "Copié"
  655. 			objCaptions.Item( "Year" )        = "Ann&eacute;e"
  656. 			objCaptions.Item( "NewYearsDay" ) = "Jour de l'an"
  657. 			objCaptions.Item( "GoodFriday" )  = "Vendredi Saint"
  658. 			objCaptions.Item( "Easter" )      = "P&acirc;ques"
  659. 			objCaptions.Item( "Ascension" )   = "Ascension"
  660. 			objCaptions.Item( "Pentecost" )   = "Pentec&ocirc;te"
  661. 			objCaptions.Item( "Christmas" )   = "No&euml;l"
  662. 		Case 1040, 2046 ' Italian
  663. 			objCaptions.Item( "Copy" )        = "Copiare"
  664. 			objCaptions.Item( "Copied" )      = "Copiati"
  665. 			objCaptions.Item( "Year" )        = "Anno"
  666. 			objCaptions.Item( "NewYearsDay" ) = "Capodanno"
  667. 			objCaptions.Item( "GoodFriday" )  = "Venerd&igrave; Santo"
  668. 			objCaptions.Item( "Easter" )      = "Pasqua"
  669. 			objCaptions.Item( "Ascension" )   = "Ascensione"
  670. 			objCaptions.Item( "Pentecost" )   = "Pentecoste"
  671. 			objCaptions.Item( "Christmas" )   = "Natale"
  672. 		Case 1043, 2067 ' Dutch (Netherlands, Belgium)
  673. 			objCaptions.Item( "Copy" )        = "Kopiëren"
  674. 			objCaptions.Item( "Copied" )      = "Gekopieerd"
  675. 			objCaptions.Item( "Year" )        = "Jaar"
  676. 			objCaptions.Item( "NewYearsDay" ) = "Nieuwjaarsdag"
  677. 			objCaptions.Item( "GoodFriday" )  = "Goede Vrijdag"
  678. 			objCaptions.Item( "Easter" )      = "Pasen"
  679. 			objCaptions.Item( "Ascension" )   = "Hemelvaart"
  680. 			objCaptions.Item( "Pentecost" )   = "Pinksteren"
  681. 			objCaptions.Item( "Sinterklaas" ) = "Sinterklaas"
  682. 			objCaptions.Item( "SintMaarten" ) = "Sint Maarten"
  683. 			objCaptions.Item( "Christmas" )   = "Kerst"
  684. 		Case 1046, 2070 ' Portuguese
  685. 			objCaptions.Item( "Copy" )        = "Copiar"
  686. 			objCaptions.Item( "Copied" )      = "Copiado"
  687. 			objCaptions.Item( "Year" )        = "Ano"
  688. 			objCaptions.Item( "NewYearsDay" ) = "Ano Novo"
  689. 			objCaptions.Item( "GoodFriday" )  = "Sexta-feira da Paix&atilde;o"
  690. 			objCaptions.Item( "Easter" )      = "P&aacute;scoa"
  691. 			objCaptions.Item( "Ascension" )   = "Dia da Ascens&atilde;o "
  692. 			objCaptions.Item( "Pentecost" )   = "Pentecostes"
  693. 			objCaptions.Item( "Christmas" )   = "Natal"
  694. 		Case 1034, 2058, 4106, 5130, 6154, 7178, 8202, 9226, 10250, 11274, 12298, 13322, 14346, 15370, 16394, 17418, 18442, 19466, 20490 ' Spanish
  695. 			objCaptions.Item( "Copy" )        = "Copiar"
  696. 			objCaptions.Item( "Copied" )      = "Copiado"
  697. 			objCaptions.Item( "Year" )        = "A&ntilde;o"
  698. 			objCaptions.Item( "NewYearsDay" ) = "A&ntilde;o Nuevo"
  699. 			objCaptions.Item( "GoodFriday" )  = "Viernes Santo"
  700. 			objCaptions.Item( "Easter" )      = "Domingo de Resurrecci&oacute;n"
  701. 			objCaptions.Item( "Ascension" )   = "Ascensi&oacute;n"
  702. 			objCaptions.Item( "Pentecost" )   = "Pentecost&eacute;s"
  703. 			objCaptions.Item( "Christmas" )   = "Navidad"
  704. 		Case Else ' Default: English
  705. 			objCaptions.Item( "Copy" )        = "Copy"
  706. 			objCaptions.Item( "Copied" )      = "Copied"
  707. 			objCaptions.Item( "Year" )        = "Year"
  708. 			objCaptions.Item( "NewYearsDay" ) = "New Year's Day"
  709. 			objCaptions.Item( "GoodFriday" )  = "Good Friday"
  710. 			objCaptions.Item( "Easter" )      = "Easter"
  711. 			objCaptions.Item( "Ascension" )   = "Ascension"
  712. 			objCaptions.Item( "Pentecost" )   = "Pentecost"
  713. 			objCaptions.Item( "Christmas" )   = "Christmas"
  714. 	End Select
  715.  
  716. 	' If config and translations files exist, the values from the translation file will prevail
  717. 	LoadConfig
  718.  
  719. 	Button_Copy.Value                   = objCaptions.Item( "Copy" )
  720. 	Button_Download.Value               = objCaptions.Item( "Download" )
  721. 	Button_HideUpdateNotification.Value = objCaptions.Item( "HideNotification" )
  722. 	Button_Update.Value                 = objCaptions.Item( "UpdateNow" )
  723. 	AscensionName.InnerHTML             = objCaptions.Item( "Ascension" )
  724. 	BlameSomeoneElseDayName.InnerHTML   = objCaptions.Item( "BlameSomeoneElseDay" )
  725. 	ChristmasName.InnerHTML             = objCaptions.Item( "Christmas" )
  726. 	ColumbusDayName.InnerHTML           = objCaptions.Item( "ColumbusDay" ) & " (USA)<br>" & objCaptions.Item( "Thanksgiving" ) & " (CAN)"
  727. 	EasterName.InnerHTML                = objCaptions.Item( "Easter" )
  728. 	GoodFridayName.InnerHTML            = objCaptions.Item( "GoodFriday" )
  729. 	GroundhogDayName.InnerHTML          = objCaptions.Item( "GroundhogDay" )
  730. 	HalloweenName.InnerHTML             = objCaptions.Item( "Halloween" )
  731. 	NewYearsDayName.InnerHTML           = objCaptions.Item( "NewYearsDay" )
  732. 	PentecostName.InnerHTML             = objCaptions.Item( "Pentecost" )
  733. 	SinterklaasName.InnerHTML           = objCaptions.Item( "Sinterklaas" )
  734. 	SintMaartenName.InnerHTML           = objCaptions.Item( "SintMaarten" )
  735. 	StPatricksDayName.InnerHTML         = objCaptions.Item( "StPatricksDay" )
  736. 	ThanksgivingName.InnerHTML          = objCaptions.Item( "Thanksgiving" )
  737. End Sub
  738.  
  739.  
  740. Sub RestoreWindowSize( )
  741. 	If blnUpdate Then
  742. 		intUpdateSize = 200
  743. 	Else
  744. 		intUpdateSize = 0
  745. 	End If
  746. 	' Disabled error handling to prevent an error message but no error when the window is resized by doubleclicking the title bar
  747. 	On Error Resume Next
  748. 	WindowSize intWindowWidth, intWindowHeight + intUpdateSize
  749. 	On Error Goto 0
  750. End Sub
  751.  
  752.  
  753. Sub Sleep( seconds )
  754. 	Dim wshShell, strCmd
  755. 	On Error Resume Next
  756. 	Set wshShell = CreateObject( "Wscript.Shell" )
  757. 	strCmd = "%COMSPEC% /C (PING -n " & seconds & " 127.0.0.1 >NUL 2>&1 || PING -n " & seconds & " ::1 >NUL 2>&1)"
  758. 	wshShell.Run strCmd, 0, 1
  759. 	Set wshShell = Nothing
  760. 	On Error Goto 0
  761. End Sub
  762.  
  763.  
  764. Sub Update( )
  765. 	Dim blnAccess, blnCreate, blnOverwrite
  766. 	Dim objFSO, objHTAFile, objShell
  767. 	Dim strHTAFile
  768.  
  769. 	blnCreate = True
  770. 	blnOverwrite = True
  771. 	strHTAFile = Self.location.pathname
  772. 	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  773. 	On Error Resume Next
  774. 	With objFSO
  775. 		Set objHTAFile = .GetFile( strHTAFile )
  776. 		objHTAFile.Copy Left( strHTAFile, Len( strHTAFile ) - 4 ) & ".bak." & CStr( 10000 * Year( Now ) + 100 * Month( Now ) + Day( Now ) ) & CStr( 10000 * Hour( Now ) + 100 * Minute( Now ) + Second( Now ) ), blnOverwrite
  777. 		If Err Then
  778. 			blnAccess = False
  779. 		Else
  780. 			blnAccess = True
  781. 		End If
  782. 		Set objHTAFile = Nothing
  783. 		WGetSource
  784. 		Self.location.reload( True )
  785. 	End With
  786. 	On Error Goto 0
  787. 	Set objFSO   = Nothing
  788. 	' If we could not access the HTA to update it, we will retry with elevated privileges
  789. 	If Not blnAccess Then
  790. 		If InStr( Holidays.CommandLine, " /Update" ) Then
  791. 			MsgBox "Update failed, no access."
  792. 		Else
  793. 			If OSVersion > 599 Then
  794. 				Set objShell = CreateObject( "Shell.Application" )
  795. 				objShell.ShellExecute Holidays.CommandLine & " /Update", "", "runas", 1
  796. 				Set objShell = Nothing
  797. 			Else
  798. 				MsgBox "Update failed, no access."
  799. 			End If
  800. 		End If
  801. 	End If
  802. End Sub
  803.  
  804.  
  805. ' Read the entire web page
  806. Function WGet( myURL )
  807. 	Dim objHTTP
  808. 	WGet = "--Not Found: " & myURL & "--"
  809. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  810. 	objHTTP.Open "GET", myURL
  811. 	objHTTP.Send
  812. 	If objHTTP.Status = 200 Then
  813. 		WGet = objHTTP.ResponseText
  814. 	Else
  815. 		WGet = "--Not found (" & objHTTP.Status & ") " & myURL & "--"
  816. 	End If
  817. 	Set objHTTP = Nothing
  818. End Function
  819.  
  820.  
  821. ' Read the HTA source code from the web page and overwrite this HTA itself
  822. Sub WGetSource(  )
  823. 	Dim objADODB, objFSO, objIE, objRE, objSelf
  824. 	Dim strHTA, strNewText, strText, strURL
  825.  
  826. 	Const adTypeBinary          = 1
  827. 	Const adTypeText            = 2
  828. 	Const adSaveCreateNotExist  = 1
  829. 	Const adSaveCreateOverWrite = 2
  830.  
  831. 	strURL = "http://www.robvanderwoude.com/holidays_hta_src.php"
  832. 	strHTA = Self.location.pathname
  833.  
  834. 	Set objADODB = CreateObject( "ADODB.Stream" )
  835. 	Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  836. 	Set objIE    = CreateObject( "InternetExplorer.Application" )
  837. 	Set objRE    = New RegExp
  838.  
  839. 	With objIE
  840. 		.Navigate strURL
  841. 		.Visible = False
  842. 		Do While .Busy
  843. 			Sleep 1
  844. 		Loop
  845. 		strText = .Document.Body.InnerText
  846. 		Do While .Busy
  847. 			Sleep 1
  848. 		Loop
  849. 		.Quit
  850. 	End With
  851.  
  852. 	' Trim only HTA source code from the web page
  853. 	objRE.Global = True
  854. 	objRE.IgnoreCase = False
  855. 	' The patterns for the HTML begin and end tags must be "masked" to prevent them from replacing themselves
  856. 	objRE.Pattern = "^.*<ht" & "ml>"
  857. 	strText = objRE.Replace( strText, "<ht" & "ml>" )
  858. 	objRE.Pattern = "</ht" & "ml>(.|[\n\r.])*"
  859. 	strText = objRE.Replace( strText, "</ht" & "ml>" )
  860.  
  861. 	' Use ADODB stream to convert to and save as ASCII
  862. 	With objADODB
  863. 		.Open
  864. 		.Type = adTypeText
  865. 		.CharSet = "us-ascii"
  866. 		.WriteText strText
  867. 		.SaveToFile strHTA, adSaveCreateOverWrite
  868. 		.Close
  869. 	End With
  870.  
  871. 	With objFSO
  872. 		' Reread the saved ASCII file
  873. 		Set objSelf = .OpenTextFile( strHTA, ForReading, False, TristateFalse )
  874. 		strText = objSelf.ReadAll
  875. 		objSelf.Close
  876. 		Set objSelf = Nothing
  877.  
  878. 		' Correct copyright symbols
  879. 		strText = Replace( strText, "Const CopyRights = """ & "C""", "Const CopyRights = ""©""" )
  880. 		objRE.Global = True
  881. 		objRE.IgnoreCase = True
  882. 		objRE.Pattern = "((\.title|strText) =.*?)"", [C<] Rob van der Woude"
  883. 		strText = objRE.Replace( strText, "$1"", " & CopyRights & " Rob van der Woude" )
  884.  
  885. 		' Correct extended ASCII in button labels, and incorrect "ae" and "oe" translations
  886. 		objRE.Pattern = vbTab & vbTab & "Case 1036, 2060, 3084, 4108, 5132 ' French \(France, Belgium, Canada, Switzerland, Luxembourg\)" & vbCrLf _
  887. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""Copy"" \)        = ""Copier""" & vbCrLf _
  888. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""Copied"" \)      = ""Copi."""
  889. 		strNewText    = vbTab & vbTab & "Case 1036, 2060, 3084, 4108, 5132 ' French (France, Belgium, Canada, Switzerland, Luxembourg)" & vbCrLf _
  890. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""Copy"" )        = ""Copier""" & vbCrLf _
  891. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""Copied"" )      = ""Copié"""
  892. 		strText = objRE.Replace( strText, strNewText )
  893. 		objRE.Pattern = vbTab & vbTab & "Case 1043, 2067 ' Dutch \(Netherlands, Belgium\)" & vbCrLf _
  894. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""Copy"" \)        = ""Kopi.ren""" & vbCrLf _
  895. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""Copied"" \)      = ""Gekopieerd""" & vbCrLf _
  896. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""Year"" \)        = ""Jaar""" & vbCrLf _
  897. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""NewYearsDay"" \) = ""Nieuwjaarsdag""" & vbCrLf _
  898. 		              & vbTab & vbTab & vbTab & "objCaptions\.Item\( ""GoodFriday"" \)  = ""G.{1,2}de Vrijdag"""
  899. 		strNewText    = vbTab & vbTab & "Case 1043, 2067 ' Dutch (Netherlands, Belgium)" & vbCrLf _
  900. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""Copy"" )        = ""Kopiëren""" & vbCrLf _
  901. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""Copied"" )      = ""Gekopieerd""" & vbCrLf _
  902. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""Year"" )        = ""Jaar""" & vbCrLf _
  903. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""NewYearsDay"" ) = ""Nieuwjaarsdag""" & vbCrLf _
  904. 		              & vbTab & vbTab & vbTab & "objCaptions.Item( ""GoodFriday"" )  = ""Goede Vrijdag"""
  905. 		strText = objRE.Replace( strText, strNewText )
  906. 		objRE.Pattern = "' Far.{1,2}se\s+1080"
  907. 		strNewText    = "' Faroese                                  1080"
  908. 		strText = objRE.Replace( strText, strNewText )
  909. 		objRE.Pattern = "' G.lic - "
  910. 		strNewText    = "' Gaelic - "
  911. 		strText = objRE.Replace( strText, strNewText )
  912. 		objRE.Pattern = "' Norwegian - Bokm.l"
  913. 		strNewText    = "' Norwegian" & " - Bokmål"
  914. 		strText = objRE.Replace( strText, strNewText )
  915. 		objRE.Pattern = "' R.{1,2}to-Romance"
  916. 		strNewText    = "' Raeto-Romance"
  917. 		strText = objRE.Replace( strText, strNewText )
  918.  
  919. 		' Save the corrected ASCII file
  920. 		Set objSelf = .OpenTextFile( strHTA, ForWriting, False, TristateFalse )
  921. 		objSelf.Write strText
  922. 		objSelf.Close
  923. 		Set objSelf = Nothing
  924. 	End With
  925.  
  926. 	Set objADODB = Nothing
  927. 	Set objFSO   = Nothing
  928. 	Set objIE    = Nothing
  929. 	Set objRE    = Nothing
  930. End Sub
  931.  
  932.  
  933. Sub Window_Onload( )
  934. 	AppName.InnerHTML    = Holidays.ApplicationName
  935. 	AppVersion.InnerHTML = Holidays.Version
  936. 	window.document.title = "Holidays Calculator " & Holidays.Version & ", © 2006 - 2013 Rob van der Woude"
  937. 	If InStr( UCase( strArguments ), "/LANG:DE" ) Then IntLocale = 1031
  938. 	If InStr( UCase( strArguments ), "/LANG:EN" ) Then IntLocale = 1033
  939. 	If InStr( UCase( strArguments ), "/LANG:FR" ) Then IntLocale = 1036
  940. 	If InStr( UCase( strArguments ), "/LANG:IT" ) Then IntLocale = 1040
  941. 	If InStr( UCase( strArguments ), "/LANG:NL" ) Then IntLocale = 1043
  942. 	If InStr( UCase( strArguments ), "/LANG:PT" ) Then IntLocale = 1046
  943. 	If InStr( UCase( strArguments ), "/LANG:SP" ) Then IntLocale = 1034
  944. 	RestoreWindowSize
  945. 	CheckUpdate
  946. 	RestoreWindowSize
  947. 	Locale
  948. 	MyYear1.Value = Year( Now )
  949. 	HandleYearChange
  950. End Sub
  951.  
  952.  
  953. Sub Window_OnUnload( )
  954. 	On Error Resume Next
  955. 	objIE.Quit
  956. 	Set objIE = Nothing
  957. 	On Error Goto 0
  958. End Sub
  959.  
  960.  
  961. Sub WindowSize( intWidth, intHeight )
  962. 	On Error Resume Next
  963. 	Dim posWidth, posHeight
  964. 	If intWidth  > window.screen.width  Then intWidth  = window.screen.width
  965. 	If intHeight > window.screen.height Then intHeight = window.screen.height
  966. 	posWidth  = ( window.screen.width  - intWidth  ) / 2
  967. 	posHeight = ( window.screen.height - intHeight ) / 2
  968. 	If posWidth  < 0 Then posWidth  = 0
  969. 	If posHeight < 0 Then posHeight = 0
  970. 	window.resizeTo intWidth, intHeight
  971. 	window.moveTo posWidth, posHeight
  972. 	On Error GoTo 0
  973. End Sub
  974.  
  975.  
  976. Sub OnClick_ButtonDownload( )
  977. 	window.open "http://www.robvanderwoude.com/holidays.php"
  978. End Sub
  979.  
  980.  
  981. Sub OnClick_ButtonHideUpdateNotification( )
  982. 	blnUpdate                 = False
  983. 	UpdateBlock.style.display = "none"
  984. 	RestoreWindowSize
  985. End Sub
  986.  
  987.  
  988. Sub OnClick_ButtonUpdate( )
  989. 	Dim strMsg, strTitle
  990.  
  991. 	Const vbCancel = 2
  992. 	Const vbYes    = 6
  993. 	Const vbNo     = 7
  994.  
  995. 	If Left( Holidays.Version, 1 ) = "0" Then strQuote = Chr(34)
  996. 	strMsg   = "You are about to update the running Holidays program to its latest stable release." & vbCrLf _
  997. 	         & "A copy of the program will be saved, allowing a roll-back if necessary."  & vbCrLf  & vbCrLf _
  998. 	         & "Do you want to update now?"
  999. 	strTitle = "Confirm Update"
  1000. 	If MsgBox( strMsg, vbYesNoCancel, strTitle ) = vbYes Then Update
  1001. End Sub
  1. </script>
  2.  
  3. <body onresize="RestoreWindowSize" onhelp="HelpMsg">
  4.  
  5. <div align="Center">
  6.  
  7. <div id="UpdateBlock" style="display: none;">
  8.  
  9. <h3 id="Label_Update">Update</h3>
  10.  
  11. <div id="UpdateGroup" class="Group">
  12.  
  13. <table>
  14. <tr>
  15. 	<td id="UpdateNotification" colspan="5">&nbsp;</td>
  16. </tr>
  17. <tr>
  18. 	<td colspan="5">&nbsp;</td>
  19. </tr>
  20. <tr>
  21. 	<td class="Content"><input type="button" class="Button" name="Button_Update" id="Button_Update" value="Update Now" onclick="OnClick_ButtonUpdate"></td>
  22. 	<td class="Spacer">&nbsp;</td>
  23. 	<td class="Content"><input type="button" class="Button" name="Button_Download" id="Button_Download" value="Download" onclick="OnClick_ButtonDownload"></td>
  24. 	<td class="Spacer">&nbsp;</td>
  25. 	<td class="Control"><input type="button" class="Button" name="Button_HideUpdateNotification" id="Button_HideUpdateNotification" value="Hide Notification" onclick="OnClick_ButtonHideUpdateNotification"></td>
  26. </tr>
  27. </table>
  28.  
  29. </div>
  30.  
  31. <p>&nbsp;</p>
  32.  
  33. </div>
  34.  
  35.  
  36. <table border="0" cellspacing="5">
  37. <tr>
  38.     <td><input type="button" class="Button" id="Button_Copy" value="Clipboard" onclick="Copy2Clipboard()"></td>
  39.     <th><span id="MyYear0">2010</span></th>
  40.     <th><select onchange="HandleYearChange()" name="MyYear1">
  41.         <option value="2000">2000</option>
  42.         <option value="2001">2001</option>
  43.         <option value="2002">2002</option>
  44.         <option value="2003">2003</option>
  45.         <option value="2004">2004</option>
  46.         <option value="2005">2005</option>
  47.         <option value="2006">2006</option>
  48.         <option value="2007">2007</option>
  49.         <option value="2008">2008</option>
  50.         <option value="2009">2009</option>
  51.         <option value="2010">2010</option>
  52.         <option value="2011">2011</option>
  53.         <option value="2012">2012</option>
  54.         <option value="2013">2013</option>
  55.         <option value="2014">2014</option>
  56.         <option value="2015">2015</option>
  57.         <option value="2016">2016</option>
  58.         <option value="2017">2017</option>
  59.         <option value="2018">2018</option>
  60.         <option value="2019">2019</option>
  61.         <option value="2020">2020</option>
  62.         <option value="2021">2021</option>
  63.         <option value="2022">2022</option>
  64.         <option value="2023">2023</option>
  65.         <option value="2024">2024</option>
  66.         <option value="2025">2025</option>
  67.         <option value="2026">2026</option>
  68.         <option value="2027">2027</option>
  69.         <option value="2028">2028</option>
  70.         <option value="2029">2029</option>
  71.         <option value="2030">2030</option>
  72.         <option value="2031">2031</option>
  73.         <option value="2032">2032</option>
  74.         <option value="2033">2033</option>
  75.         <option value="2034">2034</option>
  76.         <option value="2035">2035</option>
  77.         <option value="2036">2036</option>
  78.         <option value="2037">2037</option>
  79.         <option value="2038">2038</option>
  80.         <option value="2039">2039</option>
  81.         <option value="2040">2040</option>
  82.         <option value="2041">2041</option>
  83.         <option value="2042">2042</option>
  84.         <option value="2043">2043</option>
  85.         <option value="2044">2044</option>
  86.         <option value="2045">2045</option>
  87.         <option value="2046">2046</option>
  88.         <option value="2047">2047</option>
  89.         <option value="2048">2048</option>
  90.         <option value="2049">2049</option>
  91.         <option value="2050">2050</option>
  92.         </select></th>
  93.     <th><span id="MyYear2">2012</span></th>
  94. </tr>
  95. <tr>
  96.     <TD colspan="4">&nbsp;</td>
  97. </tr>
  98. <tr>
  99.     <td><span id="NewYearsDayName" style="white-space: nowrap;">New Year's Day</span>:</td>
  100.     <td><input type="text" size="30" readonly name="NewYearsDay0"></td>
  101.     <td><input type="text" size="30" readonly name="NewYearsDay1"></td>
  102.     <td><input type="text" size="30" readonly name="NewYearsDay2"></td>
  103. </tr>
  104. <tr>
  105.     <td style="white-space: nowrap;"><span id="GroundhogDayName">Groundhog Day</span> (USA/CAN):</td>
  106.     <td><input type="text" size="30" readonly name="GroundhogDay0"></td>
  107.     <td><input type="text" size="30" readonly name="GroundhogDay1"></td>
  108.     <td><input type="text" size="30" readonly name="GroundhogDay2"></td>
  109. </tr>
  110. <tr>
  111.     <td><span id="StPatricksDayName" style="white-space: nowrap;">Saint Patrick's Day</span> (IE):</td>
  112.     <td><input type="text" size="30" readonly name="StPatricksDay0"></td>
  113.     <td><input type="text" size="30" readonly name="StPatricksDay1"></td>
  114.     <td><input type="text" size="30" readonly name="StPatricksDay2"></td>
  115. </tr>
  116. <tr>
  117.     <td><span id="GoodFridayName" style="white-space: nowrap;">Good Friday</span>:</td>
  118.     <td><input type="text" size="30" readonly name="GoodFriday0"></td>
  119.     <td><input type="text" size="30" readonly name="GoodFriday1"></td>
  120.     <td><input type="text" size="30" readonly name="GoodFriday2"></td>
  121. </tr>
  122. <tr>
  123.     <td><span id="EasterName" style="white-space: nowrap;">Easter</span>:</td>
  124.     <td><input type="text" size="30" readonly name="Easter0"></td>
  125.     <td><input type="text" size="30" readonly name="Easter1"></td>
  126.     <td><input type="text" size="30" readonly name="Easter2"></td>
  127. </tr>
  128. <tr>
  129.     <td><span id="AscensionName" style="white-space: nowrap;">Ascension</span>:</td>
  130.     <td><input type="text" size="30" readonly name="Ascension0"></td>
  131.     <td><input type="text" size="30" readonly name="Ascension1"></td>
  132.     <td><input type="text" size="30" readonly name="Ascension2"></td>
  133. </tr>
  134. <tr>
  135.     <td><span id="PentecostName" style="white-space: nowrap;">Pentecost</span>:</td>
  136.     <td><input type="text" size="30" readonly name="Pentecost0"></td>
  137.     <td><input type="text" size="30" readonly name="Pentecost1"></td>
  138.     <td><input type="text" size="30" readonly name="Pentecost2"></td>
  139. </tr>
  140. <tr>
  141.     <td style="white-space: nowrap;"><span id="BlameSomeoneElseDayName">Blame Someone Else Day</span> (USA):</td>
  142.     <td><input type="text" size="30" readonly name="BSED0"></td>
  143.     <td><input type="text" size="30" readonly name="BSED1"></td>
  144.     <td><input type="text" size="30" readonly name="BSED2"></td>
  145. </tr>
  146. <tr>
  147.     <td><span id="ColumbusDayName" style="white-space: nowrap;">Columbus day (USA) / Thanksgiving (CAN)</span>:</td>
  148.     <td><input type="text" size="30" readonly name="ColumbusDay0"></td>
  149.     <td><input type="text" size="30" readonly name="ColumbusDay1"></td>
  150.     <td><input type="text" size="30" readonly name="ColumbusDay2"></td>
  151. </tr>
  152. <tr>
  153.     <td><span id="HalloweenName" style="white-space: nowrap;">Halloween</span>:</td>
  154.     <td><input type="text" size="30" readonly name="Halloween0"></td>
  155.     <td><input type="text" size="30" readonly name="Halloween1"></td>
  156.     <td><input type="text" size="30" readonly name="Halloween2"></td>
  157. </tr>
  158. <tr>
  159.     <td><span id="SintMaartenName" style="white-space: nowrap;">Sint Maarten</span> (NL/BE/DE):</td>
  160.     <td><input type="text" size="30" readonly name="SintMaarten0"></td>
  161.     <td><input type="text" size="30" readonly name="SintMaarten1"></td>
  162.     <td><input type="text" size="30" readonly name="SintMaarten2"></td>
  163. </tr>
  164. <tr>
  165.     <td><span id="ThanksgivingName" style="white-space: nowrap;">Thanksgiving</span> (USA):</td>
  166.     <td><input type="text" size="30" readonly name="Thanksgiving0"></td>
  167.     <td><input type="text" size="30" readonly name="Thanksgiving1"></td>
  168.     <td><input type="text" size="30" readonly name="Thanksgiving2"></td>
  169. </tr>
  170. <tr>
  171.     <td><span id="SinterklaasName" style="white-space: nowrap;">Sinterklaas</span> (NL/BE/DE):</td>
  172.     <td><input type="text" size="30" readonly name="Sinterklaas0"></td>
  173.     <td><input type="text" size="30" readonly name="Sinterklaas1"></td>
  174.     <td><input type="text" size="30" readonly name="Sinterklaas2"></td>
  175. </tr>
  176. <tr>
  177.     <td><span id="ChristmasName" style="white-space: nowrap;">Christmas</span>:</td>
  178.     <td><input type="text" size="30" readonly name="Christmas0"></td>
  179.     <td><input type="text" size="30" readonly name="Christmas1"></td>
  180.     <td><input type="text" size="30" readonly name="Christmas2"></td>
  181. </tr>
  182. </table>
  183.  
  184. <p>&nbsp;</p>
  185.  
  186. <p><b><span id="AppName">Application Name</span>,&nbsp; Version <span id="AppVersion">0.00</span><br>
  187. <span style="font-size: 80%;">&copy; 2006 - 2013 Rob van der Woude<br>
  188. <a href="http://www.robvanderwoude.com/holidays.php" target="_blank"><span style="color: blue;">http://www.robvanderwoude.com/holidays.php</span></a></span></b></p>
  189.  
  190. </div>
  191.  
  192. </body>
  193. </html>

page last modified: 2024-04-16; loaded in 0.0371 seconds