<% Function coord_conversion(minx,miny,maxx,maxy,current_coordsys_id,current_coordsys_string,output_coordsys) ' "coord_conversion" function to reproject googlemap coordinates from lat-long to Mercator projection. ' It basically uses an arcims ArcMap image service to create a 1 x 1 pixel image that contains the ' reprojected coordinates from the input lat-long (filtercoordsys = 4326) to the Mercator meters (featurecoordsys = 54004). We ' use the ArcMap ArcIMS service because the projection engine for ArcMap is more reliable than the projection engine for the ' ArcIMS spatial server ' Build ArcXML string to send to server... dim axl, coordurl axl = "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" IF current_coordsys_id <> "" THEN axl = axl & "" ELSE axl = axl & "" END IF axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" ' Service to be used for coordinate conversion... This is an ArcMap image service. coordurl = "http://<< ---your server--- >>/servlet/com.esri.esrimap.Esrimap?ServiceName=<< ---your service--- >>" 'Create XMLHTTP object Set objXML = CreateObject("Microsoft.XMLHTTP") 'Load the coordurl into the XMLHTTP object objXML.open "POST", coordurl, False 'send it to the remote map server objXML.send(axl) 'get ArcXML responses from map service out_responseaxl = objXML.responseText response_axl = objXML.status ' clean up Set objXML = Nothing ' Parse the XMLHTTP response 'Create the DOM object and load the ArcXML response Set xmldom=Server.CreateObject("Microsoft.XMLDOM") xmldom.loadXML(out_responseaxl) If xmldom.parseError.errorCode <> 0 Then Response.Write ("Error parsing XML response") minx_miny_maxx_maxy = "" Else ' Fetch the ENVELOPE node in the ArcXML via the DOM set Layers = xmldom.getElementsByTagName("ARCXML/RESPONSE/IMAGE/ENVELOPE") IF Layers is nothing THEN response.write("DOH! it's empty") END IF ' Fetch the attributes from the ENVELOPE node For Each Node In Layers ' there should only be one ENVELOPE tag, but the getElementsByTagName returns a collection OUT_MinX = Node.getAttribute("minx") OUT_MinY = Node.getAttribute("miny") OUT_MaxX = Node.getAttribute("maxx") OUT_MaxY = Node.getAttribute("maxy") minx_miny_maxx_maxy = OUT_MinX & "," & OUT_MinY & "," & OUT_MaxX & "," & OUT_MaxY ' response.write("box: " & minx_miny_maxx_maxy ) Next End If ' Return converted coordinates as a string coord_conversion = minx_miny_maxx_maxy END FUNCTION 'Load a file from disk FUNCTION LoadStream(FilePath) Dim objStream ' create a binary stream Set objStream = Server.CreateObject("ADODB.Stream") objStream.Type = 1 'adTypeBinary=1 objStream.Open ' load file into the stream objStream.LoadFromFile FilePath ' read the contents of the binary stream into a new object LoadStream = objStream.Read ' clean up objStream.Close Set objStream = Nothing END FUNCTION 'returns the MIME header type for a given extension FUNCTION GetMIMEType(FName) 'Get file extension Dim FileExt FileExt = UCase(mid(FName, instrrev(FName,".") + 1)) select case FileExt 'Common documents case "TXT", "TEXT", "JS", "VBS", "ASP", "CGI", "PL", "NFO", "ME", "DTD" sMIME = "text/plain" case "HTM", "HTML", "HTA", "HTX", "MHT" sMIME = "text/html" case "CSV" sMIME = "text/comma-separated-values" case "JS" sMIME = "text/javascript" case "CSS" sMIME = "text/css" case "PDF" sMIME = "application/pdf" case "RTF" sMIME = "application/rtf" case "XML", "XSL", "XSLT" sMIME = "text/xml" case "WPD" sMIME = "application/wordperfect" case "WRI" sMIME = "application/mswrite" case "XLS", "XLS3", "XLS4", "XLS5", "XLW" sMIME = "application/msexcel" case "DOC" sMIME = "application/msword" case "PPT","PPS" sMIME = "application/mspowerpoint" 'WAP/WML files case "WML" sMIME = "text/vnd.wap.wml" case "WMLS" sMIME = "text/vnd.wap.wmlscript" case "WBMP" sMIME = "image/vnd.wap.wbmp" case "WMLC" sMIME = "application/vnd.wap.wmlc" case "WMLSC" sMIME = "application/vnd.wap.wmlscriptc" 'Images case "GIF" sMIME = "image/gif" case "JPG", "JPE", "JPEG" sMIME = "image/jpeg" case "PNG" sMIME = "image/png" case "BMP" sMIME = "image/bmp" case "TIF","TIFF" sMIME = "image/tiff" case "AI","EPS","PS" sMIME = "application/postscript" 'Sound files case "AU","SND" sMIME = "audio/basic" case "WAV" sMIME = "audio/wav" case "RA","RM","RAM" sMIME = "audio/x-pn-realaudio" case "MID","MIDI" sMIME = "audio/x-midi" case "MP3" sMIME = "audio/mp3" case "M3U" sMIME = "audio/m3u" 'Video/Multimedia files case "ASF" sMIME = "video/x-ms-asf" case "AVI" sMIME = "video/avi" case "MPG","MPEG" sMIME = "video/mpeg" case "QT","MOV","QTVR" sMIME = "video/quicktime" case "SWA" sMIME = "application/x-director" case "SWF" sMIME = "application/x-shockwave-flash" 'Compressed/archives case "ZIP" sMIME = "application/x-zip-compressed" case "GZ" sMIME = "application/x-gzip" case "RAR" sMIME = "application/x-rar-compressed" 'Miscellaneous case "COM","EXE","DLL","OCX" sMIME = "application/octet-stream" 'Unknown (send as binary stream) case else sMIME = "application/octet-stream" end select ' return the type of document GetMIMEType = sMIME END FUNCTION 'Sends the specified file to the browser Sub SendStreamToBrowser(FileStream, FileName, ContentType, IsInline) dim FileSize FileSize = Ubound(FileStream) + 1 'Disable error checking on error resume next 'Clear buffer Response.Clear 'Add filename to header Response.AddHeader "Connection", "keep-alive" Response.AddHeader "Content-Length", FileSize 'Check if data should be delivered inline or not If IsInline = True then 'Allow the browser to render the file inside a browser window (if it can) Response.AddHeader "Content-Disposition","inline; filename=" & FileName Else 'Force browser to save file Response.AddHeader "Content-Disposition","attachment; filename=""" & FileName & """" End If 'Use the ContentType that was passed from the GetMIMEType() function Response.ContentType = ContentType 'Send data to client Response.BinaryWrite(FileStream) Response.Flush End Sub %> <% x = Request("x") y = Request("y") z = Request("zoom") image_type = Request("image_type") cache_name = Request("cache_name") 'Set/get image type SELECT CASE image_type CASE "gif","jpg","png","png8" image_type = image_type CASE ELSE image_type = "jpg" END SELECT 'set cached tile name. For above url the image would be "orthos__8273_12131_2.jpg" 'this is the name of the file that will be stored on the local server. tile_name = cache_name & "__" & x & "_" & y & "_" & z & "." & image_type 'set cache directory path. This directory is only set up to allow web access from within its domain directory_path = "<< --- your directory path --- >>" 'Check to see if image is cached set fs = Server.CreateObject("Scripting.FileSystemObject") IF fs.FileExists(directory_path & tile_name) = true THEN ' 'If the url to the cached image is valid then pass the cached image directly back to the client ' ' ----- use functions and subroutine to push tile image to browser ----- Call SendStreamToBrowser(LoadStream(directory_path & tile_name), tile_name, GetMIMEType(tile_name), True) ELSE ' 'If the image was not found then we need to build the image using ArcIMS 'Parse mapserver and mapservice name from url servername = Request("servername") mapservice = Request("mapservice") ' ' If request has a layer_id list as a url parameter, then request all the layer ids from remote mapservice. ' We need to know all the layers in the map service so we can request that only the selected layers be made ' available for the tiled image. We also need to make sure that the requested layer ids exist in the remote mapservice. ' So... we build two arrays to handle the IDs... one for the requested IDs and one for the mapservice IDs. layer_id = Request("layer_id") IF layer_id <> "" THEN dim arcxml ' Build ArcXML request to get all the layer info from the remote service... arcxml = "" arcxml = arcxml & "" arcxml = arcxml & "" arcxml = arcxml & "" arcxml = arcxml & "" curl = "http://" & servername & "/servlet/com.esri.esrimap.Esrimap?ServiceName=" & mapservice &"" 'Create XMLHTTP object Set objXML = CreateObject("Microsoft.XMLHTTP") 'Load the url objXML.open "POST", curl, False ' send the ArcXML request objXML.send(arcxml) ' fetch the reply out_responseaxl = objXML.responseText response_axl = objXML.status ' clean up Set objXML = Nothing ' Build the DOM object to parse the ArcXML reply Set xmldom=Server.CreateObject("Microsoft.XMLDOM") xmldom.loadXML(out_responseaxl) If xmldom.parseError.errorCode <> 0 Then Response.Write ("Error parsing XML response") Else ' Fetch all the layer info tags into a collection... set Layers = xmldom.getElementsByTagName("ARCXML/RESPONSE/SERVICEINFO/LAYERINFO") If Layers Is Nothing Then response.write("DOH! it's empty") End If LayerNameList = "" icount = 0 ' Loop through each of the layers and get the attribute info... For Each Node In Layers LayerID = Node.getAttribute("id") LayerName = Node.getAttribute("name") ' Build a string containing all the valid layerids in the mapservice... If icount = 0 Then LayerNameList = LayerID Else LayerNameList = LayerNameList & "," & LayerID End If icount = icount + 1 Next End If Set xmldom = Nothing ' build arrays from the LayerNameList and the list of layer_ids passed in the url. LayerNameArray = Split(LayerNameList,",") LayerIDArray = Split(layer_id,",") END IF 'For clarity, place each coordinate into a clearly marked bottom_left or top_right variable. 'These are the coordinates returned from the getLatLng() Google Maps function bbox = Split(Request("BBOX"), ",") blong_min = bbox(0) blat_min = bbox(1) blong_max = bbox(2) blat_max = bbox(3) 'If the image_width is defined in the requesting url use its value, if it is not defined then default to 256 by 256 pixels image_width = Request("image_width") image_height = Request("image_height") If image_width = "" Then image_width = "256" End If If image_height = "" Then image_height = "256" End If ' CALL coord_conversion function to get correct coordinates ... coords = coord_conversion(blong_min, blat_min, blong_max, blat_max, 4326, "",54004) 'Parse the results into an array and get the individual values coordArray = Split(coords, ",") long_min = coordArray(0) lat_min = coordArray(1) long_max = coordArray(2) lat_max = coordArray(3) 'Create arcims request to generate map tile image dim axl axl = "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" axl = axl & "" ' Lat Long envelope from above. Google Map tile lat-longs reprojected to Mercator axl = axl & "" ' projection for Google Maps--Mercator axl = axl & "" axl = axl & "" ' image width and height from above axl = axl & "" axl = axl & "

" ' If layer id is set, then only draw layers that are in the layer_id list. If not then draw the default layers that are turned on. ' Also check for submitted layerid values that don't exist in the map service ' ' Could have put the above code dealing with layerids here, but this way it keeps the ArcXML together, so it is easier to read... ' IF layer_id <> "" THEN axl = axl & "" For Each Lid In LayerIDArray For Each LName In LayerNameArray IF Lid = LName THEN axl = axl & "" ELSE axl = axl & "" END IF Next Next axl = axl & "" END IF axl = axl & "

" axl = axl & "" axl = axl & "" axl = axl & "" 'Submit arcxml request to the remote server curl = "http://" & servername & "/servlet/com.esri.esrimap.Esrimap?ServiceName=" & mapservice & "" 'Create XMLHTTP object Set objXML1 = CreateObject("Microsoft.XMLHTTP") 'Load the url and send the ArcXML request to the remote server objXML1.open "POST", curl, False objXML1.send(axl) 'Get the ArcXML response out_responseaxl = objXML1.responseText response_axl = objXML1.status ' clean up Set objXML1 = Nothing 'Create the DOM object to parse the ArcXML response Set xmldom1=Server.CreateObject("Microsoft.XMLDOM") xmldom1.loadXML(out_responseaxl) IF out_responseaxl = "" THEN response.write("Null Mapserver") ELSE 'Fetch the OUTPUT tag from the ArcXML set OUT_IMAGE = xmldom1.getElementsByTagName("ARCXML/RESPONSE/IMAGE/OUTPUT") IF OUT_IMAGE Is Nothing THEN response.write("DOH! it's empty") OUT_IMAGEURL = "" END IF For Each Node In OUT_IMAGE ' --- should only be one, but the OUT_IMAGE variable is a collection ' Get the url attribute value from the OUTPUT tag OUT_IMAGEURL = Node.getAttribute("url") ' Check to see if the remote site has set up the ArcIMS output correctly IF UBound(Split(OUT_IMAGEURL,".")) = 1 THEN '---only has the image name, not the full url OUT_IMAGEURL = "http://" & servername & "/" & Replace(OUT_IMAGEURL, "/output/","",1,1) ELSE IF InStr(OUT_IMAGEURL, "../../") <> 0 THEN '---uses relative paths, not the full url OUT_IMAGEURL = Replace(OUT_IMAGEURL, "../..", "http://" & servername) ELSE IF (InStr(OUT_IMAGEURL, "http:") <> 0) AND (InStr(OUT_IMAGEURL, "http://") = 0) THEN '---malformed http prefix OUT_IMAGEURL = Replace(OUT_IMAGEURL, "http:/", "http://") END IF END IF END IF Next END IF Set xmldom1 = Nothing IF OUT_IMAGEURL <> "" THEN 'If a valid OUT_IMAGEURL, then get the image from the remote server and save to the local directory with the generated tile name Dim oXmlHttp, oStream Set oXmlHttp = CreateObject("Microsoft.XMLHTTP") Set oStream = CreateObject("ADODB.Stream") oXmlHttp.open "GET", OUT_IMAGEURL, False oXmlHttp.send if oXmlHttp.status = 200 Then oStream.Type = 1 oStream.Open oStream.write oXmlHttp.responsebody oStream.SaveToFile directory_path&tile_name oStream.Close End if Set oXmlHttp = Nothing Set oStream = Nothing 'now pass the newly cached image directly back to the client ' ' ----- use functions and subroutine to push tile image to browser ----- Call SendStreamToBrowser(LoadStream(directory_path & tile_name), tile_name, GetMIMEType(tile_name), True) ELSE response.write("We have encountered a map viewer error.
Please try to refresh the page to see if the remote server responds.") END IF END IF set fs = Nothing %>