Zipar sem componente

[Argos 0]

Olá

 

Estou com problemas ao zipar um arquivo sem componente. Localmente funciona, mas não no servidor. Aparece:

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request....

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!--#include file="conexao/conexao.asp"-->
<!--#include file="zipador.asp"-->
<%
Dim rec, id
id = Request.QueryString("ID")

Set rec = Server.CreateObject("ADODB.Recordset")
rec.ActiveConnection = strCon
rec.Source = "SELECT * FROM vistorias WHERE ID = "& id &""
rec.Open()

Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set PASTA = FSO.GetFolder(server.mapPath("imagens_vist/"& rec.Fields.Item("pasta").Value &"/"))
Set Arquivos = Pasta.Files
Dim objTar
Set objTar = New Tarball
FOR EACH arquivo IN arquivos
objTar.AddFile arquivo
NEXT
objTar.WriteTar
set FSO = nothing
Response.Write "<br>Arquivos copiados e compactados com sucesso!"
%>

zipador.asp

<%
Class Tarball

Public TarFilename
Public UserID
Public UserName
Public GroupID
Public GroupName
Public Permissions
Public BlockSize
Public IgnorePaths
Public BasePath

Private objFiles
Private objMemoryFiles

Public Sub AddFile(sFilename)
objFiles.Add sFilename,sFilename
End Sub

Public Sub RemoveFile(sFilename)
objFiles.Remove sFilename
End Sub

Public Sub AddMemoryFile(sFilename,sContents)
objMemoryFiles.Add sFilename,sContents
End Sub

Public Sub RemoveMemoryFile(sFilename)
objMemoryFiles.Remove sFilename
End Sub

Public Sub WriteTar()
Dim objStream, objInStream, lTemp, aFiles

Set objStream = Server.CreateObject("ADODB.Stream")
Set objInStream = Server.CreateObject("ADODB.Stream")

objStream.Type = 2
objStream.Charset = "x-ansi"
objStream.Open

objInStream.Type = 2
objInStream.Charset = "x-ansi"

aFiles = objFiles.Items

For lTemp = 0 to UBound(aFiles)
objInStream.Open
objInStream.LoadFromFile aFiles(lTemp)
objInStream.Position = 0
ExportFile aFiles(lTemp),objStream,objInStream
objInStream.Close
Next

aFiles = objMemoryFiles.Keys

For lTemp = 0 to UBound(aFiles)
objInStream.Open
objInStream.WriteText objMemoryFiles.Item(aFiles(lTemp))
objInStream.Position = 0
ExportFile aFiles(lTemp),objStream,objInStream
objInStream.Close
Next

objStream.WriteText String(BlockSize,Chr(0))
objStream.Position = 0
objStream.Type = 1

Response.AddHeader "Content-Disposition","filename=" & TarFilename
Response.ContentType = "application/x-zip"
Response.BinaryWrite objStream.Read

objStream.Close
Set objStream = Nothing
Set objInStream = Nothing
End Sub

Private Sub ExportFile(sFilename,objOutStream,objInStream)
Dim lStart, lSum, lTemp

lStart = objOutStream.Position

If IgnorePaths Then
lTemp = InStrRev(sFilename,"\")
if lTemp <> 0 then
sFilename = Right(sFilename,Len(sFilename) - lTemp)
end if
sFilename = BasePath & sFilename
End If
objOutStream.WriteText Left(sFilename & String(100,Chr(0)),100)
objOutStream.WriteText "100" & Right("000" & Oct(Permissions),3) & " " & Chr(0)
objOutStream.WriteText Right(String(6," ") & CStr(UserID),6) & " " & Chr(0)
objOutStream.WriteText Right(String(6," ") & CStr(GroupID),6) & " " & Chr(0)
objOutStream.WriteText Right(String(11,"0") & Oct(objInStream.Size),11) & Chr(0)
objOutStream.WriteText Right(String(11,"0") & Oct(dateDiff("s","1/1/1970 10:00",now())),11) & Chr(0)
objOutStream.WriteText "        0" & String(100,Chr(0))
objOutStream.WriteText "ustar  "  & Chr(0)
objOutStream.WriteText Left(UserName & String(32,Chr(0)),32)
objOutStream.WriteText Left(GroupName & String(32,Chr(0)),32)
objOutStream.WriteText "         40 " & String(4,Chr(0))
objOutStream.WriteText String(167,Chr(0))
objInStream.CopyTo objOutStream

if (objInStream.Size Mod BlockSize) > 0 then
objOutStream.WriteText String(BlockSize - (objInStream.Size Mod BlockSize),Chr(0))
end if

lSum = 0
objOutStream.Position = lStart

For lTemp = 1 To BlockSize
lSum = lSum + (Asc(objOutStream.ReadText(1)) And &HFF&)
Next

objOutStream.Position = lStart + 148
objOutStream.WriteText Right(String(7,"0") & Oct(lSum),7) & Chr(0)

objOutStream.Position = objOutStream.Size
End Sub

Private Sub Class_Initialize()
Set objFiles = Server.CreateObject("Scripting.Dictionary")
Set objMemoryFiles = Server.CreateObject("Scripting.Dictionary")

BlockSize = 512
Permissions = 438

UserID = 0
UserName = "root"
GroupID = 0
GroupName = "root"

IgnorePaths = True
BasePath = "fotos/"

TarFilename = "vistoria_" & date & "_" & time & ".zip"
End Sub

Private Sub Class_Terminate()
Set objMemoryFiles = Nothing
Set objFiles = Nothing
End Sub
End Class
%>

As pastas estão com as devidas permissões. Alguma ideia?

[xanburzum 169]

desabilite a opcaun no browser de exibir mensagens de erros amigaveis, para ver se exibe algum numero de erro, isso pode até ser permissaun, mas ja k estaun corretamente setadas

[Argos 0]

Estou usando o explorer 8. Desabilitei a opção mas aparece a msm msg.

Desde que atualizei o navegador, não consegui mais ver os codigos de erro.

[xanburzum 169]

estranho, pois desabilitando é para aparecer se caso ouver erro,

olha aki

[Argos 0]

Pois é..naveguei por

Ferramentas / Opções da Internet / aba "Avançada" / No item "Navegação" desmarquei a opção "Mostrar mensagens de erro http amigáveis". Mas nada.

 

No firefox não se chama mensagem amigavel? Tentei desabilitar lá pra testar mas não encontrei a opção

[xanburzum 169]

verifique se esta rodando algum add-on ou plugin, k naun esteja deixando alterar, isso como falei muitas vezes é permissaun, ja teve casos do user setar as permissoes no host e o host estar com problemas, tente entrar em contato com o suporte...

[Patrique 0]

Alguma coisa me diz que pode ser nestas linhas

 

UserID = 0
UserName = "root"
GroupID = 0
GroupName = "root"

tente deixar em e veja se da algum erro.

[jrcardozo 4]

pela mensagem de erro me parece que está configurado no servidor os erros amigaveis. vá no painel de controle e configure para que sejam exibidas as mensagens de erro padrão do IIS. caso não saiba se tem essa opção no painel, entre em contato com o suporte tecnico do host

[Patrique 0]

Veja também pelo painel de controle do seu dominio se a pasta esta com asp permissões corretas para o user root criar o zip, deixe liberado as permissões para todos.