Link to home
Start Free TrialLog in
Avatar of Dhiraj Mutha
Dhiraj MuthaFlag for United States of America

asked on

Read text File from HTTP

Hi,

I just want to change the below path of the text file from UNC to HTTP, is that possible?
 
Sub PopulateRecordSet
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Const intForReading = 1
 strPrinters = objFSO.GetFile("\\10.10.10.1\printer\Printers.txt")
 
to something like this
 
Sub PopulateRecordSet
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Const intForReading = 1
 strPrinters = objFSO.GetFile("http://testprinter/Printers.txt")
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Dhiraj Mutha

ASKER

Thanks a lot for quick help.

Only one thing, can you hightlight only those line in which you have made changes or add the new ones.
>> can you hightlight only those line in which you have made changes or add the new ones

Sure, lines 51 to 71 above is the changed section.

That section now used the MSXML2.XMLHTTP object to read the binary data from the URL location, and download the file to the %TEMP% folder, usually C:\Documents and Settings\%USERNAME%\Local Settings\Temp

It then just reads through that downloaded text file as normal, using the Scripting.FileSystemObject object.

 'strPrinters = objFSO.GetFile("\\172.29.1.67\printer\Printers.txt")
 strURL = "http://testprint/printers.txt"
 
 strPrinters = objShell.ExpandEnvironmentStrings("%TEMP%") & "\" & Mid(strURL, InStrRev(strURL, "/") + 1)
 ' Fetch the file
 Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 objXMLHTTP.open "GET", strURL, False
 objXMLHTTP.send()
 If objXMLHTTP.Status = 200 Then
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Open
  objADOStream.Type = 1 'adTypeBinary
 
  objADOStream.Write objXMLHTTP.ResponseBody
  objADOStream.Position = 0    'Set the stream position to the start
 
  If objFSO.FileExists(strPrinters) Then objFSO.DeleteFile strPrinters, True
 
  objADOStream.SaveToFile strPrinters
  objADOStream.Close
  Set objADOStream = Nothing



Regards,

Rob.
Thanks a lot mate.

<html>
<head>
<title>Tesco HSC - Printer Add-in Tool</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Printer Installation Utility"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
     Icon="./Images/icon.ico"
     Maximizebutton="no"
     ContextMenu="no"
     Selection="no"
     Version="1.0"
>
 
<script language="javascript">
var msg = " Printer Add-in Tool - For Assistance, login to http://ithelp and raise an IR ";
var pos = 0;
var spacer = " ..... ";
var time_length = 150;
function ScrollTitle()
{
 document.title = msg.substring(pos, msg.length) + spacer + msg.substring(0, pos);
 pos++;
 if (pos > msg.length) pos=0;
 window.setTimeout("ScrollTitle()",time_length);
}
ScrollTitle();
</script>
 
<script language="VBScript">
 
Dim strHTAPath, objDataList
 
Sub Window_onLoad
	intWidth = 470
	intHeight = 350
	Me.ResizeTo intWidth, intHeight
    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If
    PopulateRecordSet
    PopulateBuildings
End Sub
 
Sub PopulateRecordSet
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Const intForReading = 1
	'strPrinters = objFSO.GetFile(strHTAPath).ParentFolder & "\Printers.txt"
	strURL = "http://testprint/printers.txt"
 
 strPrinters = objShell.ExpandEnvironmentStrings("%TEMP%") & "\" & Mid(strURL, InStrRev(strURL, "/") + 1)
 ' Fetch the file
 Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 objXMLHTTP.open "GET", strURL, False
 objXMLHTTP.send()
 If objXMLHTTP.Status = 200 Then
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Open
  objADOStream.Type = 1 'adTypeBinary
  
  objADOStream.Write objXMLHTTP.ResponseBody
  objADOStream.Position = 0    'Set the stream position to the start
  
  If objFSO.FileExists(strPrinters) Then objFSO.DeleteFile strPrinters, True
  
  objADOStream.SaveToFile strPrinters
  objADOStream.Close
  Set objADOStream = Nothing
 
 
	Const adVarChar = 200
	Const MaxCharacters = 255
	Set objDataList = CreateObject("ADOR.Recordset")
	objDataList.Fields.Append "Building", adVarChar, MaxCharacters
	objDataList.Fields.Append "Floor", adVarChar, MaxCharacters
	objDataList.Fields.Append "DisplayName", adVarChar, MaxCharacters
	objDataList.Fields.Append "SharePath", adVarChar, MaxCharacters
	objDataList.Open
 
	Set objPrinters = objFSO.OpenTextFile(strPrinters, intForReading, False)
	While Not objPrinters.AtEndOfStream
		strLine = objPrinters.ReadLine
		If InStr(strLine, "|") > 0 Then
			arrParams = Split(strLine, "|")
			objDataList.AddNew
			objDataList("Building") = arrParams(0)
			objDataList("Floor") = arrParams(1)
			objDataList("DisplayName") = arrParams(2)
			objDataList("SharePath") = arrParams(3)
			objDataList.Update
		End If
	Wend
	objPrinters.Close
End Sub
 
Sub Clear_List(ByVal objListBox)
	For intListProgress = 1 To objListBox.Length
		objListBox.Remove 0
	Next
End Sub
 
Sub PopulateBuildings
	objDataList.MoveFirst
	strAdded = ";"
	While Not objDataList.EOF
		strBuilding = objDataList.Fields("Building").Value
		If InStr(strAdded, ";" & strBuilding & ";") = 0 Then
			Set objOption = document.createElement("OPTION")
			objOption.Text = strBuilding
			objOption.Value = strBuilding
			lst_building.Add objOption
			strAdded = strAdded & strBuilding & ";"
		End If
		objDataList.MoveNext
	Wend
	objDataList.MoveFirst
	PopulateFloors
End Sub
 
Sub PopulateFloors
	Clear_List(lst_floor)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select floor..."
	objOption.Value = "Select floor..."
	lst_floor.Add objOption
	If lst_building.Value <> "Select building..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strFloor = objDataList.Fields("Floor").Value
			If InStr(strAdded, ";" & strFloor & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strFloor
				objOption.Value = strFloor
				lst_floor.Add objOption
				strAdded = strAdded & strFloor & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
	PopulatePrinters
End Sub
 
Sub PopulatePrinters
	Clear_List(lst_printer)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select printer..."
	objOption.Value = "Select printer..."
	lst_printer.Add objOption
	If lst_floor.Value <> "Select floor..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strPrinter = objDataList.Fields("DisplayName").Value
			If InStr(strAdded, ";" & strPrinter & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strPrinter
				objOption.Value = strPrinter
				lst_printer.Add objOption
				strAdded = strAdded & strPrinter & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
End Sub
 
Sub Add_Printer
Set oShell1 = CreateObject("Wscript.Shell") 
strProf = oShell1.ExpandEnvironmentStrings("%USERPROFILE%") 
printer8="Congrats!!! Printer"
	If lst_printer.Value = "Select printer..." Then
		MsgBox "Please select a building, floor, and printer."
	Else
		Disable_Controls
		HTASleep 1
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.Value & "' AND DisplayName = '" & lst_printer.Value & "'"
		If objDataList.EOF Then
			MsgBox "There was an error finding the SharePath for " & lst_printer.Value
		Else
			'span_progress.InnerHTML = "<img src='./images/loadgraphic.gif'>"
			'span_progress1.InnerHTML = "<img src='./images/loadgraphic.gif'>"
			'span_progress2.InnerHTML = "<img src='./images/loadgraphic.gif'>"
			'span_progress3.InnerHTML = "<img src='./images/loadgraphic.gif'>"
			strSharePath = objDataList.Fields("SharePath").Value
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			Const intForReading = 1
			'strScript = objFSO.GetFile(strHTAPath).ParentFolder & "\AddPrinterScript.vbs"
			strScript = strProf & "\AddPrinterScript.vbs"
			Set objScript = objFSO.CreateTextFile(strScript, True)
			objScript.WriteLine "Set objFSO = CreateObject(""Scripting.FileSystemObject"")"
			'objScript.WriteLine "Set objFile = objFSO.CreateTextFile(""" & objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt" & """, True)"
			objScript.WriteLine "Set objFile = objFSO.CreateTextFile(""" & strProf & "\ScriptOutput.txt" & """, True)"
			objScript.WriteLine "Set objNetwork = CreateObject(""WScript.Network"")"
			objScript.WriteLine "On Error Resume Next"
			objScript.WriteLine "objNetwork.AddWindowsPrinterConnection """ & strSharePath & """"
			If chk_default.Checked = True Then objScript.WriteLine "objNetwork.SetDefaultPrinter """ & strSharePath & """"
			objScript.WriteLine "If Err.Number = 0 Then"
			objScript.WriteLine "	objFile.Write """ & printer8 & " Added Successfully."""
			objScript.WriteLine "Else"
			'objScript.WriteLine "	objFile.Write """ & "There was an error connecting to " & lst_printer.Value & """"
			objScript.WriteLine "      objFile.Write ""You don't have access to the Printer or Its not able to contact the Print Server"" & VbCrLf & Vbcrlf & ""                  For assistance, login to - http://ithelp - and raise an IR."""
			objScript.WriteLine "End If"
			objScript.WriteLine "objFile.Close"
			objScript.WriteLine "Set objNetwork = Nothing"
			objScript.WriteLine "Set objFSO = Nothing"
			objScript.Close
			Set objShell = CreateObject("WScript.Shell")
			Set objExec = objShell.Exec("wscript """ & strScript & """")
			While objExec.Status = 0
				HTASleep 1
			Wend
			'Set objFile = objFSO.OpenTextFile(objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt", intForReading, False)
			Set objFile = objFSO.OpenTextFile(strProf & "\ScriptOutput.txt", intForReading, False)
			strResult = objFile.ReadAll
			objFile.Close
			Set objFile = Nothing
			'objFSO.DeleteFile objFSO.GetFile(strHTAPath).ParentFolder & "\AddPrinterScript.vbs", True
			'objFSO.DeleteFile objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt", True
			objFSO.DeleteFile strProf & "\AddPrinterScript.vbs", True
			objFSO.DeleteFile strProf & "\ScriptOutput.txt", True
			'span_progress.InnerHTML = "<br>"
			'span_progress1.InnerHTML = "<br>"
			'span_progress2.InnerHTML = "<br>"
			'span_progress3.InnerHTML = "<br>"
			'Msgbox strprof
			MsgBox strResult
			
		End If
		objDataList.Filter = ""
		Enable_Controls
	End If
End Sub
 
Sub Disable_Controls
	document.body.style.cursor = "wait"
	lst_building.disabled = True
	lst_floor.disabled = True
	lst_printer.disabled = True
	chk_default.disabled = True
	btn_addprinter.disabled = True
End Sub
 
Sub Enable_Controls
	lst_building.disabled = False
	lst_floor.disabled = False
	lst_printer.disabled = False
	chk_default.disabled = False
	btn_addprinter.disabled = False
	document.body.style.cursor = "arrow"
End Sub
 
Sub HTASleep(intSeconds)
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
End Sub
 
</script>
</head>
<body style="background-color:#C0C0C0; Font-Family:Garamond">
	<table width='90%' height='100%' align='Left' border='0'>
		
<tr>
			<td align='center' colspan="2">
				
			</td>
		</tr>
		<tr>
			<td align="Center" style="font-family:Book Antiqua; font-size: 22px; font-weight: bold;color=#800080" colspan="2">
				-: <u>Printer Add-in Tool</u> :-<br><br>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family:Times New Romanl; font-size: 15px; font-weight: bold;">
				Select Building:
			</td>
			<td align='left' style="font-family:Times New Roman; font-size: 16px; font-weight: bold;">
				<select name="lst_building" id="lst_building" onchange="vbs:PopulateFloors">
					<option id="opt_building_select" value="Select building...">Select building...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family:Times New Romanl; font-size: 15px; font-weight: bold;">
				Select Floor:
			</td>
			<td align='left' style="font-family: Times New Roman; font-size: 16px; font-weight: bold;">
				<select name="lst_floor" id="lst_floor" onchange="vbs:PopulatePrinters">
					<option id="opt_floor_select" value="Select floor...">Select floor...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: Times New Roman; font-size: 15px; font-weight: bold;">
				Select Printer:
			</td>
			<td align='left' style="font-family: Times New Roman; font-size: 16px; font-weight: bold;">
				<select name="lst_printer" id="lst_printer">
					<option id="opt_printer_select" value="Select printer...">Select printer...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<br><input type="checkbox" id="chk_default" name="chk_default">&nbsp;Set selected printer as the Default Printer<br>
				<br><br>&nbsp;<input type="button" value="Add Printer" name="btn_addprinter"  onClick="vbs:Add_Printer" style="font-size: 17px;font-family:Garamond">&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="Exit" name="btn_exit"  onClick=self.close() style="font-size: 17px;font-family:Garamond">&nbsp;&nbsp;
				<br><br><span id="span_progress"></span>&nbsp;<span id="span_progress1"></span>&nbsp;
			<span id="span_progress2"></span>&nbsp;<span id="span_progress3"></span><br>
<marquee><u>Note</u>:To install printer on Dev domain, please select Common Printer (Dev)</marquee>
 
			</td>
		</tr>
 
 
	</table>
 
</body>
</html>

Open in new window