Ir para conteúdo

POWERED BY:

Arquivado

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

essex

Dir list e link download arquivo

Recommended Posts

Galera

 

Para variar sempre estamos com problemas e todos sempre sao uregentes kkkkkkkk tenho quer rir......

 

Este script é o que eu preciso, porem quando clico no arquivo que esta listando na pasta dos arquivos

ele nao baixa....

 

Será que alguem com o olho de águia ou mais conhecimento poderia me ajudar, por favor.

 

Obrigado

 

-----------------------------------------------------------------------

 

==[ dirlist.asp ]===

 

<%@ Language=VBScript %> 
<% 
On Error Resume Next 

Dim d, i 
Const dictKey = 1 
Const dictItem = 2 
Dim sHTTPFolder 
Dim sFolderPath 

On Error Resume Next 
sFolderPath = "d:\www\dominiox.com.br\ftp4\" 'This must be the absolute path for the FSO 
sHTTPFolder = "ftpewb4/" 'This could be blank if this file lives where all the Files To list are. Used for <a href below 

Set fso = server.CreateObject("Scripting.FileSystemObject") 
Set fldr = fso.GetFolder(sFolderPath) 
If Err.number > 0 then 
Response.Write "Error Opening Folder: " & err.description 
Set fso = nothing 
Response.End 
end if 

Set d = Server.CreateObject("Scripting.Dictionary") 

Set Files = fldr.Files 

If Files.Count <> 0 Then 
For Each File In Files 
d.Add File.Name, GetFileTime(file) 
Next 
End If 


%> 
<HTML> 
<BODY bgcolor=Wheat link=blue alink=red> 
<CENTER> 
<h1>File download Center</h1> 
<% 
SortDictionary d,dictItem 
For Each i In d 
If right(i,3) <> "asp" then 
if right(i,3) <> "txt" then 
Response.Write "<a href=" & sHTTPFolder & i & "><font size=4>" & i & "</a> - " & d(i) & "<BR>" 
end if 
end if 
Next 


Function SortDictionary(objDict,intSort) 
' declare our variables 
Dim strDict() 
Dim objKey 
Dim strKey,strItem 
Dim X,Y,Z 

' get the dictionary count 
Z = objDict.Count 

' we need more than one item to warrant sorting 
If Z > 1 Then 
' create an array to store dictionary information 
ReDim strDict(Z,2) 
X = 0 
' populate the string array 
For Each objKey In objDict 
strDict(X,dictKey) = CStr(objKey) 
strDict(X,dictItem) = CStr(objDict(objKey)) 
X = X + 1 
Next 

' perform a a shell sort of the string array 
For X = 0 to (Z - 2) 
For Y = X to (Z - 1) 
If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then 
strKey = strDict(X,dictKey) 
strItem = strDict(X,dictItem) 
strDict(X,dictKey) = strDict(Y,dictKey) 
strDict(X,dictItem) = strDict(Y,dictItem) 
strDict(Y,dictKey) = strKey 
strDict(Y,dictItem) = strItem 
End If 
Next 
Next 

' erase the contents of the dictionary object 
objDict.RemoveAll 

' repopulate the dictionary with the sorted information 
u = z 
For X = 0 to (Z - 1) 
u = u - 1 
objDict.Add strDict(u,dictKey), strDict(u,dictItem) 
Next 

End If 

End Function 

Function GetFileTime(File) 
Dim intSlash1 
Dim intSlash2 
Dim mm 
Dim dd 
Dim yy 
Dim hh 
Dim mn 


GetFileTime = file.DateLastModified 

'Response.Write (GetFileTime) & "<BR>" 

intSlash1 = instr(1,GetFileTime,"/") 
mm = left(GetFileTime,(intSlash1 - 1)) 
If len(mm) = 1 then 
mm = "0" & mm 
end if 

intSlash2 = instr((intSlash1+1),GetFileTime,"/") 
dd = mid(GetFileTime,(intSlash1+1), (intSlash2 - intSlash1 - 1)) 
If len(dd) = 1 then 
dd = "0" & dd 
end if 

yy = mid(GetFileTime,(intSlash2+1),4) 

MyTime = Right(GetFileTime,(len(GetFileTime) - (intSlash2 + 4))) 
'Response.Write (MyTime) & " " & FormatDateTime(MyTime,4) & "<BR>" 
hh = left (FormatDateTime(MyTime,4),2) 
mn = right (FormatDateTime(MyTime,4),2) 
if hh = "00" then 
hh = "23" 
mn = "59" 
dd = dd - 1 
end if 
If len(dd) = 1 then 
dd = "0" & dd 
end if 
'mn = right (FormatDateTime(MyTime,4),2) 
MyTime = hh&":"& mn 
'Response.Write "New HH " & hh 
GetFileTime = mm & "/" & dd & "/" & yy & " " & MyTime 
'Response.Write (GetFileTime & MyTime) & "<BR>" 

'Response.Write (MyTime) & "<BR>" 
'Response.Write (GetFileTime) & "<BR>" 
end Function 
Set fso = nothing 
%> 
</CENTER> 
</BODY> 
</HTML>

Compartilhar este post


Link para o post
Compartilhar em outros sites

ele esta gerando algum erro ?

verifique se o link criado esta correto

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá

 

Lista somente os arquivos que quero deixar visiveis, mas qdo clico no link para baixar gera um gero... tipo, ele tenta achar uma pagina...???

 

 

File download Center

 

obs.html - 12/14/2010 11:56

note.htm - 12/14/2010 11:56

birthday_02.jpg - 01/28/2011 18:56

12-21.cdr - 01/28/2011 11:01 <------------------------------- [ cliquei neste arquivo para baixar ]-----------

11-22.cdr - 01/28/2011 10:57

10-23.cdr - 01/28/2011 10:53

09-24.cdr - 01/28/2011 10:48

tira_isopor_blu_castelinho.cdr - 01/08/2011 10:40

 

 

 

Erro gerado============

 

 

 

The page cannot be found

 

The page you are looking for might have been removed, had its name changed, or is temporarily unavailable.

--------------------------------------------------------------------------------

 

Please try the following:

 

•Make sure that the Web site address displayed in the address bar of your browser is spelled and formatted correctly.

•If you reached this page by clicking a link, contact the Web site administrator to alert them that the link is incorrectly formatted.

•Click the Back button to try another link.

HTTP Error 404 - File or directory not found.

Internet Information Services (IIS)

 

--------------------------------------------------------------------------------

Compartilhar este post


Link para o post
Compartilhar em outros sites

Testei o script aqui e ele gera o erro não importa o arquivo que você escolha, coloquei no servidor um arquivo .rar e algumas fotos e arquivos .asp e htm, e gerava o erro.

Comentei a seguite linha:

'sHTTPFolder = "web/" 'This could be blank if this file lives where all the Files To list are. Used for <a href below

E passou a funcionar corretamente, aparecendo a caixa de dialogo para download do arquivo .rar ou carregando as imagens ou arquivos .htm .asp

 

O problema é que ele estava repetindo a ultima pasta, e ficava assim:

d:\dominio\pasta\ftp\ftp

comentando a linha, fica assim:

d:\dominio\pasta\ftp

 

Uma alternativa seria tirar a ultima pasta do caminho na linha:

sFolderPath = "d:\www\dominiox.com.br\ftp4\"

e complementando o caminho na linha que comentei.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Colega, nao nao mudou nada...

 

Achei um outro script bem show que pode ser util para muitos aqui da lista e vou postar abaixo.

 

Este novo script lista todos os arquivos da pasta configurada, ao clicar em qualquer arquivo da listagem

pedirá para baixar download ) do arquivo.

 

 

Logo no lado direito da listagem dos arquivos quero que apareca a opcao "delete", pois qdo quiser poderei

excluir o arquivo selecionado, MAS nao estou conseguindo ajustá-la ao script.

 

 

 

Primeiro arquivo

 

Abaixo o arquivo que lista todos os arquivos do diretório configurado, neste caso: ftp/uploads/

 

===[ dir_list.asp ]===

<% 

Dim strThisPage
strThisPage = Request.ServerVariables("SCRIPT_NAME")
strThisPage = Right(strThisPage, Len(strThisPage) - 1)

'Path To Folder That holds Files To Download Here
'Default is the current Folder
   	'FILE_FOLDER = StripFileName(Request.ServerVariables("PATH_TRANSLATED")) 

Dim FILE_FOLDER
FILE_FOLDER = Server.MapPath("/ftp/uploads/") 

'Constants
Const adVarChar = 200
Const adInteger = 3
Const adDate = 7
Const adFileTime = 64
Const adNumeric = 131

%>
<HTML>
<HEAD>
<TITLE>Lista de downloads  <%= Date() %></TITLE>
<style type="text/css">
body {
margin-left: 5px;
margin-top: 5px;
background-image: url(icons/back.gif);
}
a:visited,a:link {color:#003333;text-decoration:none;}
a:hover   {color: #006699; font-weight: bold; TEXT-DECORATION: underline overline;}
.style4 {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 18px; font-weight: bold; }
.style41 {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 18px; color: #FFFFFF; font-weight: bold; }
.style5 {font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; color: #FFFFFF; font-weight: bold; }
.style13 {
font-family: Verdana, Arial, Helvetica, sans-serif;
font-size: 12px;
color: #F00 font-weight: bold; 	text-align: center;
}
   </style>

<STYLE TYPE="TEXT/CSS">
.TabHeader {
Font-Family: Arial;
Font-Weight: Bold;
Font-Size: 12px;
Background: #0099CC;
color: #FFF;
}
.DataCol { Font-Family: Verdana; Font-Size: 12px }
.style4 {
color: #FF0;
}
   </STYLE>
<script>
	function msg() {
		self.status = 'Downloads <%= Date() %>';
	return true
	}
</SCRIPT>

<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"></HEAD>

<BODY  onLoad="msg()">

<table width="999" border="0" align="center" cellpadding="0" cellspacing="0">
 <tr>
   <td width="885"> </td>
 </tr>
 <tr>
   <td class="style13"></td>
 </tr>
 <tr>
   <td> </td>
 </tr>
 <tr>
   <td class="style13"></td>
 </tr>
 <tr>
   <td><div align="right"></div></td>
 </tr>
 <tr>
   <td><TABLE width="997" BORDER=0 align="center" cellpadding="2" cellspacing="2" bordercolor="#000033" BACKGROUND="#0099CC" ID=tblFileData>
     <TR>
       <TD width="424" CLASS=TabHeader><A HREF="../sSort.asp?sort=Name" class="style5"> Arquivo</A></TD>
       <TD width="258" CLASS=TabHeader><A HREF="../sSort.asp?sort=Type" class="style5">Tipo</A></TD>
       <TD width="115" CLASS=TabHeader><A HREF="../../prestacao_script/sSort.asp?sort=Size" class="style5">Tamanho</A></TD>
       <!-- <TD CLASS=TabHeader><A HREF="sSort.asp?sort=Path">File Path</A></TD> -->
       <TD width="174" CLASS=TabHeader><A HREF="../sSort.asp?sort=Date" class="style5">Data</A>                    ( by Jurandir ) </TD>
     </TR>
     <%  
strSortHeader = Request.QueryString("sort")

IF strSortHeader = "" Then
	Call GetAllFiles("")
Else
	Call GetAllFiles(strSortHeader)
End IF
%>
   </TABLE></td>
 </tr>
</table>
</BODY>
</HTML>
<%  

Sub GetAllFiles(strSortBy)
Dim oFS, oFolder, oFile
Set oFS = Server.CreateObject("Scripting.FileSystemObject")

'Set Folder Object To Proper File Directory
Set oFolder = oFS.getFolder(FILE_FOLDER)

Dim intCounter

intCounter = 0

IF strSortBy = "" Then 'UnSorted (default)
	Dim FileArray()
	ReDim Preserve FileArray(oFolder.Files.Count, 5)

	For Each oFile in oFolder.Files
		strFileName = oFile.Name
		strFileType = oFile.Type
		strFileSize = oFile.Size
		strFilePath = oFile.Path
		strFileDtMod = oFile.DateLastModified

		FileArray(intCounter, 0) = strFileName
		FileArray(intCounter, 1) = "<A HREF=" & Chr(34) & "[b]startDownload.asp[/b]?File=" _
			& Server.urlEncode(strFilePath) & "&Name=" & Server.urlEncode(strFileName) & "&Size=" & strFileSize & Chr(34) _
			& " onMouseOver=" & Chr(34) & "self.status='" & strFileName & "'; return true;" & Chr(34) _
			& " onMouseOut=" & Chr(34) & "self.status=''; return true;" & Chr(34) & ">" & strFileName & "</A>"
		FileArray(intCounter, 2) = strFileType
		FileArray(intCounter, 3) = strFileSize
		'FileArray(intCounter, 4) = strFilePath
		FileArray(intCounter, 4) = strFileDtMod

[b]' === DUVIDA ===
' Como ajusto esta linha neste colocal ?
' Retorno um erro dizendo que falta uma aspa dupla ( " ) e nao consigo achar...?

' Response.Write("<li>" & item.Name & " <a href=""" & getDeleteLink(item.Path) &"""> Delete </a>" &"</li>" & vbCrLf)[/b]


		intCounter = (intCounter + 1)
	Next

	intRows = uBound(FileArray, 1)
	intCols = uBound(FileArray, 2)

	For x = 0 To intRows -1
		Echo("<TR>")
		For z = 0 To intCols
			If z > 0  Then
				BuildTableCol(FileArray(x, z))
			End IF
		Next
		Echo("</TR>")
	Next

Else
'Sorted List

	Set oRS = Server.CreateObject("ADODB.Recordset")
	oRS.Fields.Append "Name", adVarChar, 500
	oRS.Fields.Append "Type", adVarChar, 500
	oRS.Fields.Append "Size", adInteger
	'oRS.Fields.Append "Path", adVarChar, 500
	oRS.Fields.Append "Date", adFileTime
	oRS.Open

	For Each oFile in oFolder.Files
		strFileName = oFile.Name
		strFileType = oFile.Type
		strFileSize = oFile.Size
		strFilePath = oFile.Path
		strFileDtMod = oFile.DateLastModified

		oRS.AddNew
		oRS.Fields("Name").Value = "<A HREF=" & Chr(34) & "startDownload.asp?File=" _
			& Server.urlEncode(strFilePath) & "&Name=" & Server.urlEncode(strFileName) & "&Size=" & strFileSize & Chr(34) _
			& " onMouseOver=" & Chr(34) & "self.status='" & strFileName & "'; return true;" & Chr(34) _
			& " onMouseOut=" & Chr(34) & "self.status=''; return true;" & Chr(34) & ">" & strFileName & "</A>"
		oRS.Fields("Type").Value = strFileType
		oRS.Fields("Size").Value = strFileSize
		'oRS.Fields("Path").Value = strFilePath
		oRS.Fields("Date").Value = strFileDtMod
	Next

	oRS.Sort = strSortBy & " ASC"

	Do While Not oRS.EOF
		Echo("<TR>")
			BuildTableCol(oRS("Name"))
			BuildTableCol(oRS("Type"))
			BuildTableCol(oRS("Size"))
			'BuildTableCol(oRS("Path"))
			BuildTableCol(oRS("Date"))
		Echo("</TR>")
	oRS.MoveNext
	Loop			

	oRS.Close
	Set oRS = Nothing
End IF

EchoB("<B><br><center><span class='style13'>[ " & oFolder.Files.Count & " ] arquivos disponíveis para download.</B></span><br>")

Cleanup oFile
Cleanup oFolder
Cleanup oFS
End Sub

Function Echo(str)
Echo = Response.Write(str & vbCrLf)
End Function

Function EchoB(str)
EchoB = Response.Write(str & "<BR>" & vbCrLf)
End Function

Sub Cleanup(obj)
IF isObject(obj) Then
	Set obj = Nothing
End IF
End Sub

Function StripFileName(strFile)
StripFileName = Left(strFile, inStrRev(strFile, "\"))
End Function

Sub BuildTableCol(strData)
Echo("<TD CLASS=DataCol>" & strData & "</TD>")
End Sub

'Not implemented
Sub BuildTableRow(arrData)
Dim intCols
intCols = uBound(arrData)
For y = 0 To intCols
	Echo("<TD CLASS=DataCol>" & arrData(y) & "</TD>")
Next
End Sub

%>

==================================================================================

 

 

Segundo arquivo

 

 

Ao clicar em qualquer arquivo da listagem ( em forma de link )iniciára o download.

 

 

 

===[ startDownload.asp ]===

 

<%
Response.Buffer = True
Dim strFilePath, strFileSize, strFileName

Const adTypeBinary = 1

strFilePath = Request.QueryString("File")
strFileSize = Request.QueryString("Size")
strFileName = Request.QueryString("Name")

Response.Clear

Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = adTypeBinary
objStream.LoadFromFile strFilePath

strFileType = lcase(Right(strFileName, 4))

' Feel Free to Add Your Own Content-Types Here
   Select Case strFileType
       Case ".asf"
           ContentType = "video/x-ms-asf"
       Case ".avi"
           ContentType = "video/avi"
       Case ".doc"
           ContentType = "application/msword"
       Case ".zip"
           ContentType = "application/zip"
       Case ".xls"
           ContentType = "application/vnd.ms-excel"
       Case ".gif"
           ContentType = "image/gif"
       Case ".jpg", "jpeg"
           ContentType = "image/jpeg"
       Case ".wav"
           ContentType = "audio/wav"
       Case ".mp3"
           ContentType = "audio/mpeg3"
       Case ".mpg", "mpeg"
           ContentType = "video/mpeg"
       Case ".rtf"
           ContentType = "application/rtf"
	Case ".htm", "html"
           ContentType = "text/html"
	Case ".asp"
           ContentType = "text/asp"
       Case Else
           'Handle All Other Files
           ContentType = "application/octet-stream"
   End Select


Response.AddHeader "Content-Disposition", "attachment; filename=" & strFileName
Response.AddHeader "Content-Length", strFileSize
' In a Perfect World, Your Client would also have UTF-8 as the default 
' In Their Browser
Response.Charset = "UTF-8"
Response.ContentType = ContentType

Response.BinaryWrite objStream.Read
Response.Flush

objStream.Close
Set objStream = Nothing

%>

==================================================================================

 

Terceiro - trecho de codigo

 

Incluir estes trechos de codigo abaixo no arquivo --> ===[ dir_list.asp ]===

<%
Sub DeleteFile(path)
Dim fs
   Set fs = CreateObject("Scripting.FileSystemObject")
   If fs.FileExists(path) Then
       'Delete File 
       fs.DeleteFile path
   End IF
End Sub

Function getDeleteLink(path)
   Dim currentPage    
   currentPage = Request.ServerVariables("SCRIPT_NAME")
   'Generate delete link
   getDeleteLink = currentPage & "?Action=delete&file=" & Server.Urlencode(path)
End Function

Sub DeleteCheck
'Check delete parameters 
If LCase(Request.QueryString("Action")) = "delete" Then
   If LCase(Request.QueryString("file")) <> "" Then
       'Execute delete
       DeleteFile Request.QueryString("file")
   End If
End If
End Sub
%>

==================================================================================

 

D U V I D A

 

A linha abaixo não consigo ajustá-la no script do aquivo "dir_list.asp"

Response.Write("<li>" & item.Name & " <a href=""" & getDeleteLink(item.Path) &"""> Delete </a>" &"</li>" & vbCrLf)

 

Obs:

 

http://www.dmxzone.com/go?14206

 

Como mostra no link acima, a opcao DELETE fica no lado direito do arquivo podendo remove-lo, se quiser....

 

 

Valeu galera

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pelo que entendi, a duvida agora é sobre uma questão de layout, o código em ASP funciona corretamente, certo ?

 

Esse problema de layout pode ser o codigo em javascript que não está funcionando corretamente, verifique se o navegador não acusa algum erro no js, pode ser também alguma tag html que não foi aberta ou fechada e por isso acaba não apresentando a disposição esperada. (Codigos como div / li / tr / td ... podem causar isso)

Compartilhar este post


Link para o post
Compartilhar em outros sites

Tenho duvidas no ajuste de uma linha ali em "asp" e nao em javascript

 

----------------

:

:

FileArray(intCounter, 3) = strFileSize

'FileArray(intCounter, 4) = strFilePath

FileArray(intCounter, 4) = strFileDtMod

 

' === DUVIDA ===

' Como ajusto esta linha ... seguindo o esquema acima parece que tem que ajustar o array ? ...

' parece nao aceitar a lina response.write....seila ?

 

' Retorno um erro dizendo que falta uma aspa dupla ( " ) e nao consigo achar...?

 

'=== linha 143 abaixo ===

 

Response.Write("<li>" & item.Name & " <a href=""" & getDeleteLink(item.Path) &"""> Delete </a>" &"</li>" & vbCrLf)

 

 

intCounter = (intCounter + 1)

Next

:

:

 

----------------

 

 

Microsoft VBScript runtime error '800a01a8'

Object required: ''

 

/ftpewb4/ssort_de.asp, line 143

 

 

 

obrigado

Compartilhar este post


Link para o post
Compartilhar em outros sites

amigo, você também pode usar um script tipo explorer ,onde você terá mais gerenciamento

Compartilhar este post


Link para o post
Compartilhar em outros sites

Po mano, ai tu kebra o pesquisador que precisa apenas de apena uma "luz"

 

Para teres uma idéia levaram alguns dias até chegar num script deste, muitas páginas, pesuisas e talzzz deves saber como é isso....google ... e infindáveis googlessssss

 

 

So quero saber como ajusto essa ta linha acima....... somenteeee....

Compartilhar este post


Link para o post
Compartilhar em outros sites

Isso geralmente é porque você já tentou fechar ou definir um valor nothing a um objeto que não foi definido.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ao clicar no link APAGA o arquivo ( deveria apagar )

 

Alguem pode me dizer o que tem de errado .... :(

 

=== mensagem de erro abaixo ======

 

O site não pode exibir a página

 

HTTP 500

Causas prováveis:

•O site está em manutenção.

•O site tem um erro de programação.

 

 

 

( d11.asp = arquivo atual )

 

<%

strdelete = request.querystring("delete")

strFN = request.querystring("FN")

if strdelete = "Yes" Then

call functionDF()

End if

Sub functionDF()

Dim fso, f1

Set fso = CreateObject("Scripting.FileSystemObject")

Response.Write "Deleting file <b>" & strFN & "</b><br>"

Set f1 = fso.GetFile(Server.MapPath(strFN))

f1.Delete

Response.Write "All done!<br>"

End Sub

dirtowalk = "uploads/"

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(server.mappath(dirtowalk))

Set fc = f.Files

For Each tobdel in fc

response.write "<a href='d11.asp?delete=Yes&FN=" & tobdel.name & "'>"

response.write tobdel.name & "</a></br>"

Next

%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

====[ mensagem de erro ]========================

 

Deleting file imagem.jpg

 

Erro de tempo de execução do Microsoft VBScript erro '800a0035'

 

Arquivo não encontrado

 

/planob/d11.asp, linha 11

 

 

====[ linha 11 ]================================

 

 

Set f1 = fso.GetFile(Server.MapPath(strFN))

Compartilhar este post


Link para o post
Compartilhar em outros sites

Para certificar-se que o arquivo existe, você pode usar o método FileExists () do FSO

veja se o caminho não esta errado

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

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