Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

luiscarlos5046

Localizar imagem no servidor

Por , em ASP Clássico

Recommended Posts

luiscarlos5046    3

luiscarlos5046
Postado

Galera,

 

Tenho um formulário com um campo IMG para ser digitado manualmente o nome de um icone png que já está numa pasta no servidor.

 

Alguém sabe me dizer como eu posso fazer uma busca nas pastas do servidor do site para localizar a imagem e me retornar neste campo só o nome da imagem?

 

 

Luis Carlos

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

olha este exemplo

 

<% Option Explicit %>
<% 
'Set the response buffer to true.
Session.LCID="1046"
Response.Buffer = False 

'Dimension global variables
Dim fsoObject			
Dim fldObject	
Dim sarySearchWord		
Dim strSearchWords		
Dim blnIsRoot			
Dim strFileURL			
Dim strServerPath		
Dim intNumFilesShown		
Dim intTotalFilesSearched	
Dim intTotalFilesFound		
Dim intFileNum			
Dim intPageLinkLoopCounter	
Dim sarySearchResults(1000,2)	
Dim intDisplayResultsLoopCounter 
Dim intResultsArrayPosition	
Dim blnSearchResultsFound	
Dim strFilesTypesToSearch	
Dim strBarredFolders		
Dim strBarredFiles		
Dim blnEnglishLanguage		



' -------------------------- --------
Const intRecordsPerPage = 10 


strFilesTypesToSearch = "htm,html,asp,shtml,txt,doc,gif,xml,xsl,aspx" 

'
strBarredFolders = "cgi_bin,_bin" 


strBarredFiles = "adminstation.htm,no_allowed.asp" 

--------------------------------------------------
blnEnglishLanguage = True 

'-----------------------------------------------------------------------------------------------------



intTotalFilesSearched = 0

%>
<html>
<head>
<title>Busca</title>
<meta name="Description" content="">
<meta name="KeyWords" content="site search">

     
       

<script  language="JavaScript">



var search_icon_off = new Image(); 
search_icon_off.src = "site_search_icon_off.gif";


function CheckForm () {


	if (document.frmSiteSearch.search.value==""){
		alert("Porfavor entre com uma ou mais palavras para a busca.");
		document.frmSiteSearch.search.focus();
		return false;
	}
	
	return true
}
// -->
</script>
       
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000CC" vlink="#0000CC" alink="#FF0000">
<h1 align="center"><font size="4" face="Verdana, Arial, Helvetica, sans-serif"><strong> 
  Busca</strong></font></h1>
  
<form method="get" name="frmSiteSearch" action="site_search.asp" onSubmit="return CheckForm();">
  <table cellpadding="0" cellspacing="0" width="90%" align="center">
    <tr> 
      
   <td height="66" width="165" align="right" rowspan="3" valign="middle"><img src="site_search_icon_on.gif" width="58" height="52" align="absmiddle" alt="Search the Web Site" name="searchIcon">   </td>
      <td height="66" width="15" align="right" rowspan="3" valign="middle"> </td>
      <td class="arial" height="4" width="571"> <font size="1" face="Verdana, Arial, Helvetica, sans-serif"><strong>Pesquisa 
        no Site:</strong> </font></td>
    </tr>
    <tr> 
      <td class="normal" height="2" width="571">
      <input type="TEXT" name="search" maxlength="50" size="36" value="<% =Request.QueryString("search") %>">
        <input type="submit" value="Pesquisa >>" name="submit">
        </td>
    </tr>
    <tr> 
      <td class="normal" height="34" width="571" valign="top"> <font size="1" face="Verdana, Arial, Helvetica, sans-serif">Pesquisa 
        em: 
        <input type="radio" name="mode" value="allwords" CHECKED>
        Todas as palavras 
        <input type="radio" name="mode" value="anywords">
        Qualquer palavra 
        <input type="radio" name="mode" value="phrase">
        Frase</font></td>
    </tr>
  </table>
</form>

<%


strSearchWords = Trim(Request.QueryString("search"))


If blnEnglishLanguage = True Then
	
	strSearchWords = Server.HTMLEncode(strSearchWords)


Else
	
	strSearchWords = Replace(strSearchWords, "<", "<", 1, -1, 1)
	strSearchWords = Replace(strSearchWords, ">", ">", 1, -1, 1)
End If


sarySearchWord = Split(Trim(strSearchWords), " ")




intFileNum = CInt(Request.QueryString("FileNumPosition"))


intNumFilesShown = intFileNum



Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")



If NOT strSearchWords = "" Then



	Set fldObject = fsoObject.GetFolder("C:\Inetpub\wwwroot")
	
	
	strServerPath = fldObject.Path & "\"
	
	
	blnIsRoot = True
		
	
	Call SearchFile(fldObject)			
	

	Set fsoObject = Nothing
	Set fldObject = Nothing	
	
	

	Call SortResultsByNumMatches(sarySearchResults, intTotalFilesFound)
		
	

	Response.Write vbCrLf & "	<table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"" bgcolor=""#CCCCCC"">"
	Response.Write vbCrLf & " 	  <tr>"
	
	
	If blnSearchResultsFound = False Then 
		Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Desculpe nenhum resultado encontrado.</td>"   
	
d
	Else	
		Response.Write vbCrLf & " 	    <td> Pesquisa nos arquivos por: <b>" & strSearchWords & "</b>.    Mostrando resultados " & intFileNum + 1 & " - " & intNumFilesShown & " of " & intTotalFilesFound & ".</td>"	    
	End If
	

	Response.Write vbCrLf & "	  </tr>"
	Response.Write vbCrLf & "	</table>"
		
	
	
	Response.Write vbCrLf & "	<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">"
	Response.Write vbCrLf & "	 <tr>" 
	Response.Write vbCrLf & "	  <td>"   
	
	
	If blnSearchResultsFound = False Then 
	
		'Write HTML displaying the error
		Response.Write vbCrLf & "	  <br>"
		Response.Write vbCrLf & "	   Sua Pesquisa - <b>" & strSearchWords & "</b> - não existe nenhuma ocorrência em nossos arquivos."
	   	Response.Write vbCrLf & "	   <br><br>"
	   	Response.Write vbCrLf & "	   Sugestão:"
	   	Response.Write vbCrLf & "	   <br>"
	   	Response.Write vbCrLf & "	   <ul><li>Faça uma outra pesquisa com as palavras corretas.<li>Tente diferentes palavras.<li>Tente palavras mais comuns.<li>Tente outras palavras</ul>"
	
	
	Else
		
	
		For intDisplayResultsLoopCounter = (intFileNum + 1) to intNumFilesShown
		
			Response.Write vbCrLf & "	     <br>"
			Response.Write vbCrLf & "	    " & sarySearchResults(intDisplayResultsLoopCounter,1)
			Response.Write vbCrLf & "	     <br>"
		Next
	End If
	
	
	Response.Write vbCrLf & "	    </td>"
	Response.Write vbCrLf & "	  </tr>"
	Response.Write vbCrLf & "	</table>"

End If

 

If intTotalFilesFound > intRecordsPerPage then


	Response.Write vbCrLf & "	<br>"
	Response.Write vbCrLf & "	<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" align=""center"">"
	Response.Write vbCrLf & " 	  <tr>"
	Response.Write vbCrLf & " 	    <td>"
	Response.Write vbCrLf & "		<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
	Response.Write vbCrLf & "		  <tr>"
	Response.Write vbCrLf & "		    <td width=""50%"" align=""center"">"
	
	Response.Write vbCrLf & "		Results Page:  "
	
		
	  	
	If intNumFilesShown > intRecordsPerPage Then 
		Response.Write vbCrLf & "		 <a href=""site_search.asp?FileNumPosition=" &  intFileNum - intRecordsPerPage  & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self""><< Prev</a> "   	     	
	End If     	
	
	
	If intTotalFilesFound > intRecordsPerPage Then 
		
		
		For intPageLinkLoopCounter = 1 to CInt((intTotalFilesFound / intRecordsPerPage) + 0.5)
			
			
			If intFileNum = (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage Then
				Response.Write vbCrLf & "		     " & intPageLinkLoopCounter
			Else
			
				Response.Write vbCrLf & "		      <a href=""site_search.asp?FileNumPosition=" &  (intPageLinkLoopCounter * intRecordsPerPage) - intRecordsPerPage & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">" & intPageLinkLoopCounter & "</a>  "			
			End If
		Next
	End If
	
	
	   	
	If intTotalFilesFound > intNumFilesShown then   	
		Response.Write vbCrLf & "		 <a href=""site_search.asp?FileNumPosition=" &  intNumFilesShown  & "&search=" & Replace(strSearchWords, " ", "+") & "&mode=" & Request.QueryString("mode") & """ target=""_self"">Next >></a>"	   	
	End If      	
	
	
     	
	Response.Write vbCrLf & "		    </td>"      	
	Response.Write vbCrLf & "		  </tr>"
	Response.Write vbCrLf & "		</table>"		
	Response.Write vbCrLf & "	    </td>"
	Response.Write vbCrLf & "	  </tr>"
	Response.Write vbCrLf & "	</table>"
	
 
End If 

%>
 <br>
 <div align="center">  
  <table width="98%" border="0" cellspacing="1" cellpadding="1" bgcolor="#CCCCCC" align="center">
    <tr> 
        
      <td width="47%" height="18"><font size="1" face="Verdana, Arial, Helvetica, sans-serif"> Total 
        de documentos encontrados:</font> 
        <% = intTotalFilesSearched  %>
      </td>
        <td width="53%" align="right" height="18"><%				  
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 
Response.Write("		Powered By - <a href=""xanburzum"" target=""_blank"">www.freecode.com.br</a>")
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 
%>
       </td>
      </tr>
    </table>

    <script langauge="JavaScript">document.searchIcon.src = search_icon_off.src</script>
    <br>
</div>
<br>
</body>
</html>
<%




Public Sub SearchFile(fldObject)

	'Dimension local variabales
	Dim objRegExp				
	Dim objMatches				
	Dim filObject				
	Dim tsObject				
	Dim subFldObject			
	Dim strFileContents			
	Dim strPageTitle			
	Dim strPageDescription			
	Dim strPageKeywords			
	Dim intSearchLoopCounter		
	Dim intNumMatches			
	Dim blnSearchFound			
	
	'Error handler
	On Error Resume Next
	
	
	Err.Number = 0
		  		
	
	Set objRegExp = New RegExp
	
	If Err.Number <> 0 Then 
		Response.Write("<br>Erro: O Servidor não suporta Regular Expessions object<br>Porfavor faça o download da versão alternativa em http://www.webwizguide.info/asp/sample_scripts/site_search_script.asp")
					
	
		Err.Number = 0
	End If

	For Each filObject in fldObject.Files
		
				
		
		If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then
	 
		
			If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then		  	
		  	
		  		
			 	blnSearchFound = False
		  		
		  	
		  		intNumMatches = 0		  	
		  		
		  		
		  		objRegExp.Global = True
		  		
		  
		  		objRegExp.IgnoreCase = True
		  		
		  				  		
		  	
			
			    	Set tsObject = filObject.OpenAsTextStream
			
			
			   	strFileContents = tsObject.ReadAll		
		
		
				strPageTitle = GetFileMetaTag("<title>", "</title>", strFileContents)
						
			
				strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
			 	
		
			 	strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", strFileContents)
			 			 	
			 	
			 	
			
			 	objRegExp.Pattern = "<[^>]*>"
			 	
			 
			 	strFileContents = objRegExp.Replace(strFileContents,"")
			 		
			 	
			 	strFileContents = strFileContents & " " & strPageTitle & " " & strPageDescription & " " & strPageKeywords
			 	
			 
			 				 	
			 	
			 	If Request.QueryString("mode") = "phrase" Then
			 		
			 	
			 		objRegExp.Pattern = "\b" & strSearchWords & "\b"
			 		
			 		
			 		Set objMatches = objRegExp.Execute(strFileContents)
			 		
			 	
			 		If objMatches.Count > 0 Then
			 		
			 			
			 			intNumMatches = objMatches.Count
			 		
			 			
			 			blnSearchFound = True
			 		End If
			 	
			 	
			 
			 	Else
			 			 	
			 		
				 	If Request.QueryString("mode") = "allwords" then blnSearchFound = True
				 	
				 	
				 	
				 	For intSearchLoopCounter = 0 to UBound(sarySearchWord)
				 	
				 		
				 		objRegExp.Pattern = "\b" & sarySearchWord(intSearchLoopCounter) & "\b"
				 		Set objMatches = objRegExp.Execute(strFileContents)
				 
					    	If objMatches.Count > 0 Then 
					    	
					    		
			 				intNumMatches = intNumMatches + objMatches.Count
				    	
				    			
				    			If Request.QueryString("mode") = "anywords" then blnSearchFound = True
				    			
				    		Else
				    		
				    			If Request.QueryString("mode") = "allwords" then blnSearchFound = False
				    			
				    		End If
				    	Next
			    	End If
			    				    	
			    	
			   
			    	intTotalFilesSearched = intTotalFilesSearched + 1
			
			
			    	
			
			    	If strPageTitle = "" Then strPageTitle = "Sem Titulo"
			    	
			    	
			    	If strPageDescription = "" Then strPageDescription = "Descrição do arquivo (pagina)"
			    	
			    		    				    			    	
			    	
			  
			    	If blnSearchFound = True Then
			    			    	
			    					    		    	
					
					intTotalFilesFound = intTotalFilesFound + 1
										
			    			    		
					
					If  intNumFilesShown < (intRecordsPerPage + intFileNum) and intTotalFilesFound > intNumFilesShown Then
	
					
						intNumFilesShown = intNumFilesShown + 1
						
					End If	
		
					       		
				       		
			       		
			       		intResultsArrayPosition = intResultsArrayPosition + 1
			       		
				       		
			       		
			       		blnSearchResultsFound = True
				       					       		
					
					If blnIsRoot = True Then
						
						
					
						sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" &  filObject.Name & """ target=""_self"">" & strPageTitle & "</a>" 
													
								    						       		
			       
			       		Else
			       			'Place the search results into the search results array
			       			sarySearchResults(intResultsArrayPosition,1) = "<a href=""./" & strFileURL  & fldObject.Name & "/" & filObject.Name & """ target=""_self"">" & strPageTitle & "</a>"			   			   								
						
					End If						
					
					
					sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "        <br>" & strPageDescription
					sarySearchResults(intResultsArrayPosition,1) = sarySearchResults(intResultsArrayPosition,1) & vbCrLf & "        <font size=""2"" color=""#0000FF""><br><i>Search Matches " & intNumMatches & "  -  Last Updated " & FormatDateTime(filObject.DateLastModified, VbLongDate) & "  -  Size " & CInt(filObject.Size / 1024) & "kb</i></font>"
					
					
					
					
					sarySearchResults(intResultsArrayPosition,2) = intNumMatches
									
		      		End If
							
			
		    		tsObject.Close
			End If
		End If
	Next
	

	Set objRegExp = Nothing
		
	

	For Each subFldObject In FldObject.SubFolders
										
		
		If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then
	
			blnIsRoot = False
						
					
			
			strFileURL = fldObject.Path & "\"
			
		
			strFileURL = Replace(strFileURL, strServerPath, "")
			
			
			strFileURL = Replace(strFileURL, "\", "/")
			
		
			strFileURL = Server.URLEncode(strFileURL)
			
			
			strFileURL = Replace(strFileURL, "%2F", "/")
						
		
			Call SearchFile(subFldObject)
		End If
	Next




	Set filObject = Nothing
	Set tsObject = Nothing
	Set subFldObject = Nothing
End Sub





Private Sub SortResultsByNumMatches(ByRef sarySearchResults, ByRef intTotalFilesFound)

	
	Dim intArrayGap 		
	Dim intIndexPosition		
	Dim intTempResultsHold			
	Dim intTempNumMatchesHold	
	Dim intPassNumber		
	
	

	For intPassNumber = 1 To intTotalFilesFound
	
		
		For intIndexPosition = 1 To (intTotalFilesFound - intPassNumber)
		
		
			If sarySearchResults(intIndexPosition,2) < sarySearchResults((intIndexPosition+1),2) Then
			
				
				
				intTempResultsHold = sarySearchResults(intIndexPosition,1)
				
			
				intTempNumMatchesHold = sarySearchResults(intIndexPosition,2)
	
				sarySearchResults(intIndexPosition,1) = sarySearchResults((intIndexPosition+1),1)
									
			
				sarySearchResults(intIndexPosition,2) = sarySearchResults((intIndexPosition+1),2)
				

				sarySearchResults((intIndexPosition+1),1) = intTempResultsHold
				
				
				sarySearchResults((intIndexPosition+1),2) = intTempNumMatchesHold			
			End If
		Next			
	Next					
End Sub


Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents)


	Dim intStartPositionInFile	'Holds the start position in the file
	Dim intEndPositionInFile	'Holds the end position in the file
	
	

	intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)
	
	

	If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then
		

		strStartValue = Replace(strStartValue, "name=", "http-equiv=")
		
	
		intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)		
	End If
	
				    	

	If NOT intStartPositionInFile = 0 Then
					
	
		intStartPositionInFile = intStartPositionInFile + Len(strStartValue)
						
	
		intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1)
	
		
		GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))
					

	Else
		GetFileMetaTag = ""
		       		
	End If

End Function
%>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito