Erro em componente de upload

[clayton-mer 0]

olá turma

 

desenvolvi um sistema de upload usando o componente aspupload, no meu micro está funcionando corretamente, mais quando envio para o servidor da o seguinte erro

 

Persits.Upload.1 error '800a0005'

 

The system cannot find the file specified.

 

/ismControl/ismControFilesUpload.asp, line 7

 

e na linha 7 do arquivo acima está assim

 

Upload.Save "C:\Inetpub\vhosts\samaesap.com.br\httpdocs\"

 

o erro é onde fica o caminho onde vai ser upado o arquivo mais o caminha é este e a pasta está com permissão de escrita e gravação.

 

que pode ser.

 

tentei colocar ao inves do endereço fisico a url. tipo http://meusite.com.br/files, mais mesmo assim não deu

 

se alguem puder me ajudar fico muito agradecido sendo que quebrei a cabeça a dois dias sem parar e não dei conta

 

agradeço desde já

 

um abraço a todos do forum.

 

att.

 

Clayton

[jothaz 1]

olá turma desenvolvi um sistema de upload usando o componente aspupload, no meu micro está funcionando corretamente, mais quando envio para o servidor da o seguinte erroPersits.Upload.1 error '800a0005' The system cannot find the file specified. /ismControl/ismControFilesUpload.asp, line 7 e na linha 7 do arquivo acima está assimUpload.Save "C:\Inetpub\vhosts\samaesap.com.br\httpdocs\"o erro é onde fica o caminho onde vai ser upado o arquivo mais o caminha é este e a pasta está com permissão de escrita e gravação.que pode ser.tentei colocar ao inves do endereço fisico a url. tipo http://meusite.com.br/files, mais mesmo assim não deuse alguem puder me ajudar fico muito agradecido sendo que quebrei a cabeça a dois dias sem parar e não dei contaagradeço desde jáum abraço a todos do forum.att.Clayton

Camarada fica dificil opinar sem conhecer seu ambiente mas realmente você não poderá utilizar "C:\Inetpub\vhosts\samaesap.com.br\httpdocs\" pois este é o endereço local da sua maquina você deverá utilizar a função:

Server.MapPath(aqui_vai_odiretório_virtual)

t+

[clayton-mer 0]

valeu vou tentar aqui

[clayton-mer 0]

Server.MapPath(/files)sendo que a pasta onde vai ficar os arquivos está na raizwww.meusite.com.br/filesmais mesmo assimnão deu certo

[Rodrigo1 0]

Com q componente você está trabalhando?Scripting.Dictionary e ADODB.Stream?No caso do MapPath eu uso assim:aqui fica a pag upload.asp - www.meusite.com.br/contAqui fica a pasta - www.meusite.com.br/imagens

Dim vLocalUploadvLocalUpload = Server.MapPath("../imagens")Upload.Save "vLocalUpload"

ps:Eu tenho um sistema de upload aqui se você quiser...

[clayton-mer 0]

Com q componente você está trabalhando?

Scripting.Dictionary e ADODB.Stream?

 

 

No caso do MapPath eu uso assim:

aqui fica a pag upload.asp - www.meusite.com.br/cont

Aqui fica a pasta - www.meusite.com.br/imagens

Upload.ProgressID = Request.QueryString("PID")

Upload.Save "Server.MapPath(/files)"

' we use memory uploads, so we must limit file size

Upload.SetMaxSize 1000000, True

linenums:0'><%Set Upload = Server.CreateObject("Persits.Upload")' This is needed to enable the progress indicatorUpload.ProgressID = Request.QueryString("PID")Upload.Save "Server.MapPath(/files)"' we use memory uploads, so we must limit file sizeUpload.SetMaxSize 1000000, True

obrigado novamente

[Rodrigo1 0]

Cara..,

foi mal, não manjo com persist.upload...

mais se quiser t mando o meu script aqui q é com aqueles componentes citados anteriormentei!!

Abraxx

http://forum.imasters.com.br/public/style_emoticons/default/devil.gif

[clayton-mer 0]

se puder me mandarfico muito gratomais vou ter que usar esse mesmopelo seguinte tem barra de processo e o cliente quer esse mais se puder me mandar o seu script para eu estudar ele e ver como funcionao agradeçoate mais amigocaso queira add no msn claytonmergulhao@hotmail.com

[Rodrigo1 0]

opa!

Segue abaixo o 'Trem'!

kkk

Esse é o q contém o form<%@ Language="VBScript" %><% Option Explicit Response.Expires = -1Server.ScriptTimeout = 600%><!-- #include file="upload.asp" --><%' troque o diretorio aqui!!!  Dim uploadsDirVar  uploadsDirVar = "C:\fornari\www2\componente\UploadScript\up" function OutputForm()%>	<form name="frmSend" method="POST" enctype="multipart/form-data" action="uploadTester.asp" onSubmit="return onSubmitForm();">	<B>File names:</B><br>	File 1: <input name="attach1" type="file" size=35><br>	File 2: <input name="attach2" type="file" size=35><br>	File 3: <input name="attach3" type="file" size=35><br>	File 4: <input name="attach4" type="file" size=35><br>	<br> 	<!-- These input elements are obviously optional and just included here for demonstration purposes -->	<B>Additional fields (demo):</B><br>	Enter a number: <input type="text" name="enter_a_number"><br>	Checkbox values: <input type="checkbox" value="1" name="checkbox_values">-1 <input type="checkbox" value="2" name="checkbox_values">-2<br>	<!-- End of additional elements -->	<input style="margin-top:4" type=submit value="Upload">	</form><%end functionfunction TestEnvironment()	Dim fso, fileName, testFile, streamTest	TestEnvironment = ""	Set fso = Server.CreateObject("Scripting.FileSystemObject")	if not fso.FolderExists(uploadsDirVar) then		TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."		exit function	end if	fileName = uploadsDirVar & "\test.txt"	on error resume next	Set testFile = fso.CreateTextFile(fileName, true)	If Err.Number<>0 then		TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."		exit function	end if	Err.Clear	testFile.Close	fso.DeleteFile(fileName)	If Err.Number<>0 then		TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."		exit function	end if	Err.Clear	Set streamTest = Server.CreateObject("ADODB.Stream")	If Err.Number<>0 then		TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."		exit function	end if	Set streamTest = Nothingend functionfunction SaveFiles	Dim Upload, fileName, fileSize, ks, i, fileKey	Set Upload = New FreeASPUpload	Upload.Save(uploadsDirVar)	' If something fails inside the script, but the exception is handled	If Err.Number<>0 then Exit function	SaveFiles = ""	ks = Upload.UploadedFiles.keys	if (UBound(ks) <> -1) then		SaveFiles = "<B>Files uploaded:</B> "		for each fileKey in Upload.UploadedFiles.keys			SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "		next	else		SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."	end if	SaveFiles = SaveFiles & "<br>Enter a number = " & Upload.Form("enter_a_number") & "<br>"	SaveFiles = SaveFiles & "Checkbox values = " & Upload.Form("checkbox_values") & "<br>"end function%><HTML><HEAD><TITLE>Test Free ASP Upload</TITLE><style>BODY {background-color: white;font-family:arial; font-size:12}</style><script>function onSubmitForm() {	var formDOMObj = document.frmSend;	if (formDOMObj.attach1.value == "" && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )		alert("Please press the browse button and pick a file.")	else		return true;	return false;}</script></HEAD><BODY><br><br><div style="border-bottom: #A91905 2px solid;font-size:16">Upload files to your server</div><%Dim diagnosticsif Request.ServerVariables("REQUEST_METHOD") <> "POST" then	diagnostics = TestEnvironment()	if diagnostics <> "" then		response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"		response.write diagnostics		response.write "<p>After you correct this problem, reload the page."		response.write "</div>"	else		response.write "<div style=""margin-left:150"">"		OutputForm()		response.write "</div>"	end ifelse	response.write "<div style=""margin-left:150"">"	OutputForm()	response.write SaveFiles()	response.write "<br><br></div>"end if%><!-- Please support this free script by having a link to freeaspupload.net either in this page or somewhere else in your site. --><div style="border-bottom: #A91905 2px solid;font-size:10">Powered by <A HREF="http://www.freeaspupload.net/" style="color:black">Free ASP Upload</A></div><br><br><!--- START OF HTML TO REMOVE - contains the script ratings submission --><table cellspacing=10><tr><td><table width="140" border="1" cellpadding="0" cellspacing="0" bordercolor="#840300" bgcolor="#D70500">  <form action="http://www.hotscripts.com/cgi-bin/rate.cgi" method="POST">	<tr> 	  <td><table width="100%" border="0" cellspacing="0" cellpadding="2" style="font-size:8pt">		  <tr align="center" bgcolor="#AA0400"> 			<td colspan="2"><b><font color="#FFFFFF">Rate Our Program<br>at Hotscripts.com			  <input type="hidden" name="ID" value="21966">			  <input type="hidden" name="external2" value="1">			  </font></b></td>		  </tr>		  <tr> 			<td align="right"><input type="radio" value="5" name="rate"></td>			<td><font color="#FFFFFF">Excellent!</font></td>		  </tr>		  <tr> 			<td align="right"><input type="radio" value="4" name="rate"></td>			<td><font color="#FFFFFF">Very Good</font></td>		  </tr>		  <tr> 			<td align="right"><input type="radio" value="3" name="rate"></td>			<td><font color="#FFFFFF">Good</font></td>		  </tr>		  <tr> 			<td align="right"><input type="radio" value="2" name="rate"></td>			<td><font color="#FFFFFF">Fair</font></td>		  </tr>		  <tr> 			<td align="right"><input type="radio" value="1" name="rate"></td>			<td><font color="#FFFFFF">Poor</font></td>		  </tr>		  <tr align="center"> 			<td colspan="2"><input name="submit2" type="submit" value="Cast My Vote!"></td>		  </tr>		</table></td>	</tr>  </form></table><td valign=top><table border=0 cellpadding=1 cellspacing=0 bgcolor=000000><tr><td align=center>	<table border=0 cellpadding=3 cellspacing=0 bgcolor=eeeedd>	<tr><td align=center nowrap>		<font style="font-size:10pt;font-family:Arial;"><b>Rated:</b> <a href="http://www.Aspin.com/func/review?id=5380510"><img src=http://ratings.Aspin.com/getstars?id=5380510 border=0></a>		<font style="font-size:8pt;"><br>by <a href="http://www.Aspin.com">Aspin.com</a> users<br></font></font>	</td></tr><tr nowrap><form action="http://www.Aspin.com/func/review/write?id=5380510" method=post><td align=center>		<font style="font-size:10pt;font-family:Arial;">What do you think?</font><br>		<select name="VoteStars"><option>5 Stars<option>4 Stars<option>3 Stars<option>2 Stars<option>1 Star</select><input type=submit value="Vote">	</td></form></tr></table></td></tr></table><td valign=top style="font-size:10pt" width=300>Please support this free script by rating it with the boxes on the left.<p>To remove these boxes from this page please follow the instructions in the source HTML. The code to remove is clearly indicated and very easy to find.<p>Thank you.</table></BODY></HTML>

Esse é o upload.asp (que está no include do outro)<%Class FreeASPUpload	Public UploadedFiles	Public FormElements	Private VarArrayBinRequest	Private StreamRequest	Private uploadedYet	Private Sub Class_Initialize()		Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")		Set FormElements = Server.CreateObject("Scripting.Dictionary")		Set StreamRequest = Server.CreateObject("ADODB.Stream")		StreamRequest.Type = 1 'adTypeBinary		StreamRequest.Open		uploadedYet = false	End Sub		Private Sub Class_Terminate()		If IsObject(UploadedFiles) Then			UploadedFiles.RemoveAll()			Set UploadedFiles = Nothing		End If		If IsObject(FormElements) Then			FormElements.RemoveAll()			Set FormElements = Nothing		End If		StreamRequest.Close		Set StreamRequest = Nothing	End Sub	Public Property Get Form(sIndex)		Form = ""		If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))	End Property	Public Property Get Files()		Files = UploadedFiles.Items	End Property	'Calls Upload to extract the data from the binary request and then saves the uploaded files	Public Sub Save(path)		Dim streamFile, fileItem		if Right(path, 1) <> "\" then path = path & "\"		if not uploadedYet then Upload		For Each fileItem In UploadedFiles.Items			Set streamFile = Server.CreateObject("ADODB.Stream")			streamFile.Type = 1			streamFile.Open			StreamRequest.Position=fileItem.Start			StreamRequest.CopyTo streamFile, fileItem.Length			streamFile.SaveToFile path & fileItem.FileName, 2			streamFile.close			Set streamFile = Nothing			fileItem.Path = path & fileItem.FileName		 Next	End Sub	Public Function SaveBinRequest(path) ' For debugging purposes		StreamRequest.SaveToFile path & "\debugStream.bin", 2	End Function	Public Sub DumpData() 'only works if files are plain text		Dim i, aKeys, f		response.write "Form Items:<br>"		aKeys = FormElements.Keys		For i = 0 To FormElements.Count -1 ' Iterate the array			response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"		Next		response.write "Uploaded Files:<br>"		For Each f In UploadedFiles.Items			response.write "Name: " & f.FileName & "<br>"			response.write "Type: " & f.ContentType & "<br>"			response.write "Start: " & f.Start & "<br>"			response.write "Size: " & f.Length & "<br>"		 Next   	End Sub	Private Sub Upload()		Dim nCurPos, nDataBoundPos, nLastSepPos		Dim nPosFile, nPosBound		Dim sFieldName, osPathSep, auxStr		'RFC1867 Tokens		Dim vDataSep		Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType		tNewLine = Byte2String(Chr(13))		tDoubleQuotes = Byte2String(Chr(34))		tTerm = Byte2String("--")		tFilename = Byte2String("filename=""")		tName = Byte2String("name=""")		tContentDisp = Byte2String("Content-Disposition")		tContentType = Byte2String("Content-Type:")		uploadedYet = true		on error resume next		VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)		if Err.Number <> 0 then 			response.write "<br><br><B>System reported this error:</B><p>"			response.write Err.Description & "<p>"			response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"			Exit Sub		end if		on error goto 0 'reset error handling		nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)		If nCurPos <= 1  Then Exit Sub		 		'vDataSep is a separator like -----------------------------21763138716045		vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)		'Start of current separator		nDataBoundPos = 1		'Beginning of last line		nLastSepPos = FindToken(vDataSep & tTerm, 1)		Do Until nDataBoundPos = nLastSepPos						nCurPos = SkipToken(tContentDisp, nDataBoundPos)			nCurPos = SkipToken(tName, nCurPos)			sFieldName = ExtractField(tDoubleQuotes, nCurPos)			nPosFile = FindToken(tFilename, nCurPos)			nPosBound = FindToken(vDataSep, nCurPos)						If nPosFile <> 0 And  nPosFile < nPosBound Then				Dim oUploadFile				Set oUploadFile = New UploadedFile								nCurPos = SkipToken(tFilename, nCurPos)				auxStr = ExtractField(tDoubleQuotes, nCurPos)				' We are interested only in the name of the file, not the whole path				' Path separator is \ in windows, / in UNIX				' While IE seems to put the whole pathname in the stream, Mozilla seem to 				' only put the actual file name, so UNIX paths may be rare. But not impossible.				osPathSep = "\"				if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"				oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))				if (Len(oUploadFile.FileName) > 0) then 'File field not left empty					nCurPos = SkipToken(tContentType, nCurPos)										auxStr = ExtractField(tNewLine, nCurPos)					' NN on UNIX puts things like this in the streaa:					'	?? python py type=?? python application/x-python					oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))					nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line										oUploadFile.Start = nCurPos-1					oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos										If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile				End If			Else				Dim nEndOfData				nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line				nEndOfData = FindToken(vDataSep, nCurPos) - 2				If Not FormElements.Exists(LCase(sFieldName)) Then 					FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))				else					FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) 				end if 			End If			'Advance to next separator			nDataBoundPos = FindToken(vDataSep, nCurPos)		Loop		StreamRequest.Write(VarArrayBinRequest)	End Sub	Private Function SkipToken(sToken, nStart)		SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)		If SkipToken = 0 then			Response.write "Error in parsing uploaded binary request."			Response.End		end if		SkipToken = SkipToken + LenB(sToken)	End Function	Private Function FindToken(sToken, nStart)		FindToken = InstrB(nStart, VarArrayBinRequest, sToken)	End Function	Private Function ExtractField(sToken, nStart)		Dim nEnd		nEnd = InstrB(nStart, VarArrayBinRequest, sToken)		If nEnd = 0 then			Response.write "Error in parsing uploaded binary request."			Response.End		end if		ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart))	End Function	'String to byte string conversion	Private Function Byte2String(sString)		Dim i		For i = 1 to Len(sString)		   Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))		Next	End Function	'Byte string to string conversion	Private Function String2Byte(bsString)		Dim i		String2Byte =""		For i = 1 to LenB(bsString)		   String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1))) 		Next	End FunctionEnd ClassClass UploadedFile	Public ContentType	Public Start	Public Length	Public Path	Private nameOfFile	' Need to remove characters that are valid in UNIX, but not in Windows	Public Property Let FileName(fN)		nameOfFile = fN		nameOfFile = SubstNoReg(nameOfFile, "\", "_")		nameOfFile = SubstNoReg(nameOfFile, "/", "_")		nameOfFile = SubstNoReg(nameOfFile, ":", "_")		nameOfFile = SubstNoReg(nameOfFile, "*", "_")		nameOfFile = SubstNoReg(nameOfFile, "?", "_")		nameOfFile = SubstNoReg(nameOfFile, """", "_")		nameOfFile = SubstNoReg(nameOfFile, "<", "_")		nameOfFile = SubstNoReg(nameOfFile, ">", "_")		nameOfFile = SubstNoReg(nameOfFile, "|", "_")	End Property	Public Property Get FileName()		FileName = nameOfFile	End Property	'Public Property Get FileN()ameEnd Class' Does not depend on RegEx, which is not available on older VBScript' Is not recursive, which means it will not run out of stack spaceFunction SubstNoReg(initialStr, oldStr, newStr)	Dim currentPos, oldStrPos, skip	If IsNull(initialStr) Or Len(initialStr) = 0 Then		SubstNoReg = ""	ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then		SubstNoReg = initialStr	Else		If IsNull(newStr) Then newStr = ""		currentPos = 1		oldStrPos = 0		SubstNoReg = ""		skip = Len(oldStr)		Do While currentPos <= Len(initialStr)			oldStrPos = InStr(currentPos, initialStr, oldStr)			If oldStrPos = 0 Then				SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)				currentPos = Len(initialStr) + 1			Else				SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr				currentPos = oldStrPos + skip			End If		Loop	End IfEnd Function%>

[Rodrigo1 0]

Ae..ta em dois arquivos...o segundo tem q tá no include do primeirocerto??Abraxx

[Rodrigo1 0]

Ah...esqueci..

se funciona no seu comp e nao no servidor pode ser:

algo do componente do servidor diferente do "seu" componente...

 

teste de componente<%@Language="vb script:BringUpWindow('<%=Mid(request.servervariables("SCRIPT_NAME"), InstrRev(request.servervariables("SCRIPT_NAME"), "/") + 1)%>?comID=<%=i%>')">COM Detalhes</a>		<% end if %>	  </font></div>	</td>	<td><font size="2" face="Verdana, Arial, Helvetica, sans-serif"><% if comURL <> "" then %><a href="<%=comURL%>" target="_blank"><%=comName%></a><% else %><%=comName%><% end if %></font></td>  </tr>  <%end ifinstalled = "" : comCreate = "" : comURL = "" : comName = "" : comCat = "" : comCat2 = ""  next  response.flush()  %><% if onNum = 0 then %><tr>	<td colspan="5">	  <div align="center"><font size="2" face="Verdana, Arial, Helvetica, sans-serif"><b>Você não tem nenhum componente instalado</b></font></div>	</td>  </tr><% end if %></table>	<div align="center">  <p> </p>  <p><font size="3" face="Verdana, Arial, Helvetica, sans-serif">Você tem um total de <b><%=installedCOMs%></b> COMs instalados num total de <b><%=onNum%></b> verificados.<br>	 Atualmente, este certificado verifica se há <b><%=(UBound(com) + 1)%></b> componentes diferentes</font></p></div>	<table border="0" width="98%" cellpadding="2" align="center">	    <tr>	<td width="200%">	  <hr width="90%">	</td>  </tr>  <tr>			<td width="25%" valign="bottom">	  <p align="right"><%=constAutor%></p>	</td>  </tr></table><% end if %></BODY></HTML><%function IsObjInstalled(strClassString)IsObjInstalled = false : Err = 0	 Set testObj = Server.CreateObject(strClassString)		 if (0 = Err) then IsObjInstalled = true else IsObjInstalled = false	 Set testObj = nothingend functionClass Program	Public Description, ClsID, ProgID, Path, TypeLib, Version, DLLNameEnd ClassClass ProgIDInfo	Private WshShell, sCVProgID, oFSO	Private Sub Class_Initialize()		On Error Resume Next		set oFSO = CreateObject("Scripting.FileSystemObject")		Set WshShell = CreateObject("WScript.Shell")	End Sub	Private Sub Class_Terminate()		If IsObject(WshShell) Then Set WshShell = Nothing		If IsObject(oFSO) Then set oFSO = Nothing	End Sub	Private Function IIf(byval conditions, byval trueval, byval falseval)		if cbool(conditions) then IIf = trueval else IIf = falseval	End Function	Public Function LoadProgID(ByVal sProgramID)		Dim sTmpProg, oTmp, sRegBase, sDesc, sClsID		Dim sPath, sTypeLib, sProgID, sVers, sPathSpec		If IsObject(WshShell) Then			On Error Resume Next			sCVProgID = WshShell.RegRead("HKCR\" & _				sProgramID & "\CurVer\")			sTmpProg = IIf(Err.Number = 0, sCVProgID, sProgramID)			sRegBase = "HKCR\" & sTmpProg			sDesc = WshShell.RegRead(sRegBase & "\")			sClsID = WshShell.RegRead(sRegBase & "\clsid\")			sRegBase = "HKCR\CLSID\" & sClsID			sPath = WshShell.RegRead(sRegBase & "\InprocServer32\")			sPath = WshShell.ExpandEnvironmentStrings(sPath)			sTypeLib = WshShell.RegRead(sRegBase & "\TypeLib\")			sProgID = WshShell.RegRead(sRegBase & "\ProgID\")			sVers = oFSO.getFileVersion(sPath)			sPathSpec = right(sPath, len(sPath) - _				instrrev(sPath, "\"))			Set oTmp = New Program			oTmp.Description = sDesc			oTmp.ClsID = IIf(sClsID <> "", sClsID, "undetermined")			oTmp.Path = IIf(sPath <> "", sPath, "undetermined")			oTmp.TypeLib = IIf(sTypeLib <> "", _				sTypeLib, "undetermined")			oTmp.ProgID = IIf(sProgID <> "", _				sProgID, "undetermined")			oTmp.DLLName = IIf(sPathSpec <> "", _				sPathSpec, "undetermined")			oTmp.Version = IIf(sVers <> "", sVers, "undetermined")			Set LoadProgID = oTmp		Else			Set LoadProgID = Nothing		End If	End FunctionEnd Classfunction getHTML(strURL)  dim objXMLHTTP, strReturn  Set objXMLHTTP = SErver.CreateObject("Microsoft.XMLHTTP")  objXMLHTTP.Open "GET", strURL, False  objXMLHTTP.Send  getHTML = objXMLHTTP.responseText  Set objXMLHTTP = Nothingend function%>