Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for airreg.hta

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

  1. <html>
  2. <head>
  3.  
  4. <title>AirReg</title>
  5.  
  6. <HTA:APPLICATION
  7.   APPLICATIONNAME="Airplane Registration Lookup"
  8.   ID="AirReg"
  9.   VERSION="1.01"
  10.   BORDER="dialog"
  11.   INNERBORDER="no"
  12.   MAXIMIZEBUTTON="no"
  13.   SCROLL="no"
  14.   SINGLEINSTANCE="yes"/>
  15.  
  16. <style type="text/css">
  1. a {
  2. 	white-space: nowrap;
  3. 	font-size: 10pt;
  4. }
  5.  
  6. body {
  7. 	font-family: sans-serif;
  8. 	font-size: 10pt;
  9. }
  10.  
  11. td {
  12. 	font-size: 10pt;
  13. }
  14.  
  15. .Center {
  16. 	margin-left: auto;
  17. 	margin-right: auto;
  18. 	text-align: center;
  19. }
  20.  
  21. .Top {
  22. 	vertical-align: top;
  23. }
  1. </style>
  2. </head>
  3.  
  4.  
  5. <script language="VBScript">
  1. Option Explicit
  2.  
  3. Dim intHeight, intMaxLen, intMinLen, intWidth
  4. Dim objIE, objRequest
  5.  
  6. ' Internet Explorer constants
  7. Const navOpenInNewWindow       =     1
  8. Const navNoHistory             =     2
  9. Const navNoReadFromCache       =     4
  10. Const navNoWriteToCache        =     8
  11. Const navAllowAutosearch       =    16
  12. Const navBrowserBar            =    32
  13. Const navHyperlink             =    64
  14. Const navEnforceRestricted     =   128
  15. Const navNewWindowsManaged     =   256
  16. Const navUntrustedForDownload  =   512
  17. Const navTrustedForActiveX     =  1024
  18. Const navOpenInNewTab          =  2048
  19. Const navOpenInBackgroundTab   =  4096
  20. Const navKeepWordWheelText     =  8192
  21. Const navVirtualTab            = 16384
  22. Const navBlockRedirectsXDomain = 32768
  23. Const navOpenNewForegroundTab  = 65536
  24.  
  25.  
  26. Sub Back( )
  27. 	MainBlock.style.display = "block"
  28. 	HelpBlock.style.display = "none"
  29. 	Reg.focus
  30. End Sub
  31.  
  32.  
  33. Sub CheckEsc( )
  34. 	' Show input window if ESC key is pressed in Help screen
  35. 	If Self.window.event.keyCode = 27 And MainBlock.style.display = "none" Then Back
  36. End Sub
  37.  
  38.  
  39. Function Fetch( strURL )
  40. 	' Argument: URL of text to fetch
  41. 	' Returns:  URL's innerHTML or Null
  42. 	' Remark:   In Windows 8 and 10, the XmlHttpRequest will probably fail due to tighter security
  43. 	'           restrictions; in that case InternetExplorer is used as a fallback, but it is SLOW!
  44. 	Dim strResponseText
  45. 	Fetch = Null ' Return value in case of unknown failure
  46. 	On Error Resume Next ' Catch XMLHTTP errors (high probability)
  47. 	Set objRequest = CreateObject( "Microsoft.XMLHTTP" )
  48. 	objRequest.open "GET", strURL, False
  49. 	objRequest.send vbNull
  50. 	If Err Then
  51. 		' Tight security settings may break the XMLHTTP method,
  52. 		' in that case use Internet Explorer as a (slow) fallback
  53. 		Set objIE = CreateObject( "InternetExplorer.Application" )
  54. 		objIE.Visible = False
  55. 		objIE.Navigate2 strURL, 0, "_self", Null, "Content-Type: text/json"
  56. 		While objIE.Busy
  57. 			Sleep 1
  58. 		Wend
  59. 		Fetch = objIE.Document.body.innerHTML
  60. 		objIE.Quit
  61. 		Set objIE = Nothing
  62. 	ElseIf objRequest.status = 200 Then
  63. 		Fetch = objRequest.responseText
  64. 	Else
  65. 		ImageBlock.style.display = "none"
  66. 		ErrorBlock.innerHTML     = "Error " & objRequest.status & " (" & objRequest.statustext & ")"
  67. 		ErrorBlock.style.display = "block"
  68. 	End If
  69. 	Set objRequest = Nothing
  70. 	On Error Goto 0
  71. End Function
  72.  
  73.  
  74. Sub Help( )
  75. 	' Hide input window and show help text
  76. 	MainBlock.style.display = "none"
  77. 	HelpBlock.style.display = "block"
  78. 	BackButton.focus
  79. End Sub
  80.  
  81.  
  82. Sub Lookup( strReg )
  83. 	Dim intError, intLength, intPosErr, intPosImg, intPosLnk, intPosPho
  84. 	Dim objMatches, objRE
  85. 	Dim strError, strImage, strLink, strPhotographer, strRspTxt, strURL
  86. 	intLength = Len( Reg.value )
  87. 	If intLength >= intMinLen And intLength <= intMaxLen Then
  88. 		strURL    = "http://www.airport-data.com/api/ac_thumb.json?r=" & strReg
  89. 		strRspTxt = Fetch( strURL )
  90. 		' {"status":404,"error":"Aircraft thumbnail not found."}
  91. 		' {"status":200,"count":1,"data":[{"image":"http:\/\/www.airport-data.com\/images\/aircraft\/thumbnails\/001\/124\/001124807.jpg","link":"http:\/\/www.airport-data.com\/aircraft\/photo\/001124807.html","photographer":"Henk Geerlings"}]}
  92. 		If Not IsNull( strRspTxt ) Then
  93. 			Set objRE = New RegExp
  94. 			objRE.Pattern = """status"":(\d+),""error"":""([^""]+)"""
  95. 			If objRE.Test( strRspTxt ) Then
  96. 				Set objMatches = objRE.Execute( strRspTxt )
  97. 				If objMatches.Item(0).SubMatches.Count > 0 Then
  98. 					intError = objMatches.Item(0).Submatches(0)
  99. 					strError = objMatches.Item(0).Submatches(1)
  100. 				End If
  101. 				If intError = 404 And InStr( strReg, "-" ) < 3 Then
  102. 					' Insert a hyphen at the (next) most likely position and try again
  103. 					Select Case InStr( strReg, "-" )
  104. 						Case 0:
  105. 							strReg = Left( strReg, 1 ) & "-" & Mid( strReg, 2 )
  106. 						Case 1:
  107. 							strReg = Replace( strReg, "-", "" )
  108. 							strReg = Left( strReg, 1 ) & "-" & Mid( strReg, 2 )
  109. 						Case 2:
  110. 							strReg = Replace( strReg, "-", "" )
  111. 							strReg = Left( strReg, 2 ) & "-" & Mid( strReg, 3 )
  112. 						Case 3:
  113. 							strReg = Replace( strReg, "-", "" )
  114. 							strReg = Left( strReg, 3 ) & "-" & Mid( strReg, 4 )
  115. 					End Select
  116. 					Reg.value = strReg
  117. 					Lookup strReg
  118. 				Else
  119. 			    	ImageBlock.style.display = "none"
  120. 			    	ErrorBlock.innerHTML     = "Error " & intError & " (" & strError & ")"
  121. 			    	ErrorBlock.style.display = "block"
  122. 		    	End If
  123. 			Else
  124. 		    	objRE.Pattern = """image"":""([^\""]+)"",""link"":""([^\""]+)"",""photographer"":""([^\""]+)"""
  125. 		    	If objRE.Test( strRspTxt ) Then
  126. 		    		Set objMatches = objRE.Execute( strRspTxt )
  127. 		    		If objMatches.Item(0).Submatches.Count = 3 Then
  128. 		    			strImage        = Replace( objMatches.Item(0).Submatches(0), "\", "" )
  129. 		    			strLink         = Replace( objMatches.Item(0).Submatches(1), "\", "" )
  130. 		    			strPhotographer = Replace( objMatches.Item(0).Submatches(2), "\", "" )
  131. 		    		End If
  132. 			    	Link.href = strLink
  133. 			    	document.getElementById( "Image" ).src = strImage
  134. 			    	Photographer.innerHTML = "Photo &copy; " & strPhotographer
  135. 			    	ImageBlock.style.display = "block"
  136. 			    	ErrorBlock.style.display = "none"
  137. 		    	Else
  138. 					ImageBlock.style.display = "none"
  139. 					ErrorBlock.innerHTML     = "Unknown Error"
  140. 					ErrorBlock.style.display = "block"
  141. 		    	End If
  142. 			End If
  143. 			Set objMatches = Nothing
  144. 			Set objRE      = Nothing
  145. 		End If
  146. 	End If
  147. End Sub
  148.  
  149.  
  150. Sub OnChangeInputReg( )
  151. 	Dim intLength, objRE, strPattern
  152. 	Select Case Self.window.event.keyCode
  153. 		Case 13: ' ENTER key: start search
  154. 			intLength = Len( Reg.value )
  155. 			If intLength >= intMinLen And intLength <= intMaxLen Then Lookup Reg.value
  156. 		Case 27: ' ESC key: clear input
  157. 			Reg.value = ""
  158. 		   	ImageBlock.style.display = "none"
  159. 		   	ErrorBlock.style.display = "none"
  160. 		Case Else:
  161. 			If Self.window.event.keyCode >= 33 And Self.window.event.keyCode <= 40 Then
  162. 				' ARROWS/PGUP/PGDN/HOME/END keys: ignore
  163. 			ElseIf Self.window.event.keyCode = 8 Or Self.window.event.keyCode = 46 Then
  164. 				' BACKSPACE/DEL keys: hide previous result
  165. 				ImageBlock.style.display = "none"
  166. 				ErrorBlock.style.display = "none"
  167. 			ElseIf Self.window.event.keyCode = 45 Then
  168. 				' INS key: ignore
  169. 			ElseIf Self.window.event.keyCode >= 113 And Self.window.event.keyCode <= 123 Then
  170. 				' F2..F12 keys: ignore
  171. 			Else
  172. 			   	ImageBlock.style.display = "none"
  173. 			   	ErrorBlock.style.display = "none"
  174. 				Set objRE = New RegExp
  175. 				objRE.Pattern = "[^A-Z0-9-]" ' Allow only letters, numbers and dashes
  176. 				Reg.value = UCase( Reg.value )
  177. 				Reg.value = objRE.Replace( Reg.value, "" )
  178. 				Reg.value = Left( Reg.value, intMaxLen )
  179. 				Set objRE = Nothing
  180. 			End If
  181. 	End Select
  182. End Sub
  183.  
  184.  
  185. Sub OnClickButtonLookup( )
  186. 	Lookup Reg.value ' Start search
  187. End Sub
  188.  
  189.  
  190. Sub Sleep( seconds )
  191. 	' Time delay for InternetExplorer.Application object in Fetch( ) function
  192. 	Dim strCommand, wshShell
  193. 	strCommand = "PING -n " & CInt( seconds ) & " localhost"
  194. 	Set wshShell = CreateObject( "WScript.Shell" )
  195. 	wshShell.Run strCommand, 7, True
  196. 	Set wshShell = Nothing
  197. End Sub
  198.  
  199.  
  200. Sub Window_OnLoad
  201. 	Dim posVertical, posHorizontal
  202. 	' Initialize variables for window size and input string length
  203. 	intHeight = 320
  204. 	intWidth  = 240
  205. 	intMinLen =   4
  206. 	intMaxLen =   6
  207. 	' Resize the window
  208. 	window.resizeTo intWidth, intHeight
  209. 	' Position the window in the center of the screen
  210. 	posHorizontal = CInt( ( window.screen.width  - intWidth  ) / 2 )
  211. 	posVertical   = CInt( ( window.screen.height - intHeight ) / 2 )
  212. 	window.moveTo posHorizontal, posVertical
  213. 	' Add version number to window title and help text
  214. 	document.title = "AirReg " & AirReg.Version
  215. 	AirRegVersion.innerHTML = AirReg.Version
  216. 	' Show input window
  217. 	Back
  218. End Sub
  219.  
  220.  
  221. Sub Window_OnUnload
  222. 	On Error Resume Next
  223. 	objIE.Quit
  224. 	Set objIE      = Nothing
  225. 	Set objRequest = Nothing
  226. 	On Error Goto 0
  227. End Sub
  1. </script>
  2.  
  3.  
  4. <body onhelp="Help" onkeyup="CheckEsc">
  5.  
  6.  
  7.  
  8. <div id="MainBlock">
  9.  
  10. <p><input type="text" id="Reg" onchange="OnChangeInputReg" onkeyup="OnChangeInputReg" title="Enter airplane registration (4..6 characters; letters, numbers and dashes only)" style="width: 130px;" /> <input type="button" id="Lookup" value="Lookup" onclick="OnClickButtonLookup" /></p>
  11.  
  12. <div id="ImageBlock" style="display: none;">
  13.  
  14. <p><a id="Link"><img id="Image" /></a></span></p>
  15.  
  16. <p id="Photographer"></p>
  17.  
  18. </div><!-- End of ImageBlock -->
  19.  
  20. <p id="ErrorBlock" style="display: none;"></p>
  21.  
  22. </div><!-- End of MainBlock -->
  23.  
  24.  
  25.  
  26. <div id="HelpBlock" style="display: none;">
  27.  
  28. <h2 class="Center">AirReg <span id="AirRegVersion">0.00</span></h2>
  29.  
  30. <p>Demo script to look up airplane data by their registration number, using <a href="http://www.airport-data.com/api/doc.php">Airport-data.com's API</a>.</p>
  31.  
  32. <p>&copy; 2016 Rob van der Woude<br />
  33. <a href="http://www.robvanderwoude.com/airreg.php">http://www.robvanderwoude.com</a></p>
  34.  
  35. <p><strong>Note:</strong> The author is in no way associated with <a href="http://www.airport-data.com/">Airport-data.com</a></p>
  36.  
  37. <p class="Center"><input type="button" id="BackButton" value="Back" onclick="Back" /></p>
  38.  
  39. </div><!-- End of HelpBlock -->
  40.  
  41.  
  42.  
  43. </body>
  44. </html>

page last uploaded: 2016-12-15, 11:20