Dica do SistemaEste artigo aplica-se a um sistema operativo diferente do que está a utilizar. Foi desactivado o conteúdo do artigo, que pode não ser relevante para si.
Este artigo descreve como habilitar o servidor Web para
receber transferências de arquivos de páginas da Microsoft Active Server Pages (ASP) usando
um componente Microsoft COM+ do lado do servidor.
Observação: Os limites de suporte da Microsoft para o desenvolvimento de Visual Basic 6 foram alteradas. Para obter mais informações, consultehttp://msdn.microsoft.com/en-US/vstudio/ms788708.
(http://msdn.microsoft.com/en-us/vstudio/ms788708)
Microsoft Windows 2000 com o Microsoft Internet Information
Server 5.0 (IIS) instalado e configurado
Se o seu computador de desenvolvimento é um computador diferente
o servidor, você deve ter uma rede válido ou a conexão com a Internet para o servidor que
hospeda as páginas ASP.
Código e configuração de projeto do Microsoft Visual Basic 6
Iniciar Visual Basic e inicie uma nova DLL de ActiveX
projeto.
Nome do projetoASPFileUpload.
Alterar o nome de Class1 paraArquivo.
Sobre o Projeto menu, clique em Referências.
No Referências caixa de diálogo, clique para selecionar as opções a seguir e clique em OK:
Visual Basic para aplicativos
Procedimentos e objetos de runtime Visual Basic
Procedimentos e objetos de Visual Basic
Automação OLE
Biblioteca de tipos de serviços do COM+
Biblioteca de objetos do Microsoft Active Server Pages
Microsoft Scripting Runtime
Sobre o Projeto menu, clique em Propriedades de aSPFileUpload.
No Propriedades do projeto caixa de diálogo, clique para selecionar Execução autônoma e Reter na memóriae, em seguida, clique em OK.
Cole o seguinte código para File.cls:
Option Explicit
Const ERR_INVALID_FILENAME = vbObjectError + 1000
Const ERR_INVALID_TARGET = vbObjectError + 1001
Const ERR_FILE_EXISTS = vbObjectError + 1002
Const ERR_UPLOAD_CALLED = vbObjectError + 1003
Const VB_ERR_PATH_NOT_FOUND = 76
Private m_objContext As ObjectContext
Private m_objRequest As ASPTypeLibrary.Request
Private m_strTarget As String
Private m_strFileName As String
Private m_blnOverWrite As Boolean
Private m_blnUploaded As Boolean
Private m_lngTotalBytes As Long
'All other form elements go here.
Private m_formCol As Scripting.Dictionary
Implements ObjectControl
Private Function ObjectControl_CanBePooled() As Boolean
ObjectControl_CanBePooled = False
End Function
Private Sub ObjectControl_Activate()
Set m_objContext = GetObjectContext()
Set m_objRequest = m_objContext("Request")
Set m_formCol = New Scripting.Dictionary
End Sub
Private Sub ObjectControl_Deactivate()
Set m_objContext = Nothing
Set m_objRequest = Nothing
Set m_formCol = Nothing
End Sub
Public Sub Upload()
Const DEFAULT_CHUNK_SIZE = 262144 '256kb
Dim bytBeginOfChunk() As Byte
Dim bytEndOfChunk() As Byte
Dim bytBeginOfName() As Byte
Dim bytEndOfName() As Byte
Dim bytBeginOfFile() As Byte
Dim bytEndOfFile() As Byte
Dim bytBeginOfValue() As Byte
Dim bytEndOfValue() As Byte
Dim bytName() As Byte
Dim bytValue() As Byte
Dim bytThisChunk() As Byte
Dim bytFileName() As Byte
Dim lngBeginOfChunk As Long
Dim lngEndOfChunk As Long
Dim lngBeginOfAttribute As Long
Dim lngEndOfAttribute As Long
Dim lngBeginOfValue As Long
Dim lngEndOfValue As Long
Dim blnEndOfData As Boolean
Dim lngChunkSize As Long
Dim lngBytesLeft As Long
Dim lngFileNum As Long
Dim strFileName As String
On Error GoTo UploadErr
If Uploaded Then
Err.Raise ERR_UPLOAD_CALLED, App.Title, "The Upload method has already been called."
End If
bytBeginOfChunk = StrConv("-----------------------------", vbFromUnicode)
bytEndOfChunk = StrConv("-----------------------------", vbFromUnicode)
bytBeginOfName = StrConv("name=", vbFromUnicode) & ChrB(34)
bytEndOfName = ChrB(34)
bytBeginOfFile = StrConv("filename=", vbFromUnicode) & ChrB(34)
bytEndOfFile = ChrB(34)
bytBeginOfValue = ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)
bytEndOfValue = ChrB(13) & ChrB(10) & StrConv("-----------------------------", vbFromUnicode)
'Initialize the chunk size.
If m_objRequest.TotalBytes <= DEFAULT_CHUNK_SIZE Then
lngChunkSize = m_objRequest.TotalBytes
Else
lngChunkSize = DEFAULT_CHUNK_SIZE
End If
'Get the chunk from the request object.
bytThisChunk = m_objRequest.BinaryRead(CVar(lngChunkSize))
'Initialize the value.
lngBeginOfChunk = 1
'Repeat until the end of the data.
Do While Not blnEndOfData
'Begin the chunk.
lngBeginOfChunk = InStrB(lngBeginOfChunk, bytThisChunk, bytBeginOfChunk) + UBound(bytBeginOfChunk)
'Get name of the item.
lngBeginOfAttribute = InStrB(lngBeginOfChunk, bytThisChunk, bytBeginOfName) + UBound(bytBeginOfName) + 1
lngEndOfAttribute = InStrB(lngBeginOfAttribute, bytThisChunk, bytEndOfName)
bytName = MidB(bytThisChunk, lngBeginOfAttribute, lngEndOfAttribute - lngBeginOfAttribute)
'Get the value of the item.
lngBeginOfValue = InStrB(lngEndOfAttribute, bytThisChunk, bytBeginOfValue, vbBinaryCompare) + UBound(bytBeginOfValue) + 1
lngEndOfValue = InStrB(lngBeginOfValue, bytThisChunk, bytEndOfValue, vbBinaryCompare)
If lngEndOfValue = 0 Then
'The item extends the past current chunk.
bytValue = MidB(bytThisChunk, lngBeginOfValue, lngChunkSize)
Else
'The item value exists in the current chunk.
bytValue = MidB(bytThisChunk, lngBeginOfValue, lngEndOfValue - lngBeginOfValue)
End If
If UCase(StrConv(bytName, vbUnicode)) = "FILE" Then
lngBeginOfAttribute = InStrB(lngBeginOfChunk, bytThisChunk, bytBeginOfFile, vbBinaryCompare) + UBound(bytBeginOfFile) + 1
lngEndOfAttribute = InStrB(lngBeginOfAttribute, bytThisChunk, bytEndOfFile, vbBinaryCompare)
bytFileName = MidB(bytThisChunk, lngBeginOfAttribute, lngEndOfAttribute - lngBeginOfAttribute)
If UBound(bytFileName) < 0 Or UBound(bytValue) < 0 Then
Err.Raise ERR_INVALID_FILENAME, App.Title, "Invalid File Name."
End If
If Me.Target = "" Then
Err.Raise ERR_INVALID_TARGET, App.Title, "Invalid Target."
End If
'Use the original file name.
If Me.FileName = "" Then
'Trim the path from the file name.
While InStrB(1, bytFileName, StrConv("\", vbFromUnicode), vbBinaryCompare) > 0
bytFileName = MidB(bytFileName, InStrB(1, bytFileName, StrConv("\", vbFromUnicode)) + 1)
Wend
'Set the property.
Me.FileName = StrConv(bytFileName, vbUnicode)
'Convert the byte to Unicode.
strFileName = Me.Target & Me.FileName
Else
strFileName = Me.Target & Me.FileName
End If
'Check for overwrite.
If Me.OverWrite Then
'This is the hack check. Make sure that wildcard characters cannot be used.
If Not InStr(1, strFileName, "*") Then
If FileExists(strFileName) Then
Kill strFileName
End If
Else
Err.Raise ERR_INVALID_FILENAME, App.Title, "The specified file name appears to be invalid."
End If
Else
If FileExists(strFileName) Then
Err.Raise ERR_FILE_EXISTS, App.Title, "The file already exists."
End If
End If
lngFileNum = FreeFile
Open strFileName For Binary Access Write As #lngFileNum
'Write the file to the destination directory.
Put #lngFileNum, , bytValue
'This chunk is empty. Therefore, get a new chunk.
lngBytesLeft = m_objRequest.TotalBytes - lngChunkSize
'Start the chunking machine.
Do While lngBytesLeft > 0
'Get a new chunk.
bytThisChunk = m_objRequest.BinaryRead(CVar(lngChunkSize))
lngEndOfValue = InStrB(1, bytThisChunk, bytEndOfValue, vbBinaryCompare)
If lngEndOfValue > 0 Then
'The item value exists in the current chunk.
bytThisChunk = MidB(bytThisChunk, 1, lngEndOfValue - 1)
End If
'Append the chunk to the file.
Put #lngFileNum, , bytThisChunk
lngBytesLeft = lngBytesLeft - lngChunkSize
If lngBytesLeft < lngChunkSize Then
lngChunkSize = lngBytesLeft
End If
Loop
Close #lngFileNum
TotalBytes = FileLen(strFileName)
' Exit Do
Else
If UCase(StrConv(bytName, vbUnicode)) = "SAVEAS" Then
Me.FileName = StrConv(bytValue, vbUnicode)
Else
'form field other than file, such as textboxes
If UBound(bytValue) > 0 And UBound(bytName) > 0 Then
m_formCol.Add StrConv(bytName, vbUnicode), StrConv(bytValue, vbUnicode)
Else
m_formCol.Add StrConv(bytName, vbUnicode), ""
End If
End If
End If
'Get the next chunk.
lngBeginOfChunk = lngEndOfValue
If InStrB(lngBeginOfChunk, bytThisChunk, bytBeginOfName, vbBinaryCompare) = 0 Then
blnEndOfData = True
End If
Loop
Uploaded = True
Exit Sub
UploadErr:
If Err.Number = VB_ERR_PATH_NOT_FOUND Then
Err.Raise ERR_INVALID_TARGET, App.Title, "The Target specified does not exist."
Else
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Sub
Public Property Get Form() As Collection
Set Form = m_formCol
End Property
Public Property Get FileName() As String
FileName = m_strFileName
End Property
Public Property Let FileName(ByVal strNewValue As String)
If Uploaded Then
Err.Raise ERR_UPLOAD_CALLED, App.Title, "The Upload method has already been called."
Else
m_strFileName = strNewValue
End If
End Property
Public Property Get OverWrite() As Boolean
OverWrite = m_blnOverWrite
End Property
Public Property Let OverWrite(ByVal blnNewValue As Boolean)
If Uploaded Then
Err.Raise ERR_UPLOAD_CALLED, App.Title, "The Upload method has already been called."
Else
m_blnOverWrite = blnNewValue
End If
End Property
Private Property Get Uploaded() As Boolean
Uploaded = m_blnUploaded
End Property
Private Property Let Uploaded(ByVal blnNewValue As Boolean)
m_blnUploaded = blnNewValue
End Property
Public Property Get Target() As String
Target = m_strTarget
End Property
Public Property Let Target(ByVal NewValue As String)
If Uploaded Then
Err.Raise ERR_UPLOAD_CALLED, App.Title, "The Upload method has already been called."
Else
m_strTarget = NewValue
End If
End Property
Private Function FileExists(ByVal FileName As String) As Boolean
On Error GoTo FileExistsErr
FileLen FileName
FileExists = True
Exit Function
FileExistsErr:
If Err.Number = VB_ERR_PATH_NOT_FOUND Then
FileExists = False
End If
End Function
Public Property Get TotalBytes() As Long
TotalBytes = m_lngTotalBytes
End Property
Private Property Let TotalBytes(ByVal NewValue As Long)
m_lngTotalBytes = NewValue
End Property
Copie o seguinte código para um editor como o bloco de notas ou
O Visual Interdev e, em seguida, salvá-lo como UploadFile.asp:
<%@ Language=VBScript %>
<%
'//////////////////////////////////////////////////////////////////////////////////
'// ASPFileUpload.File API
'//
'// Properties
'// FileName
'// - Read/Write
'// - The file will be saved with this file name.
'// - This property can only be set before calling Upload.
'// - If no value is specified, the original file name
'// - in the HTTP post will be used.
'//
'// OverWrite
'// - Read/Write
'// - This property can only be set before calling Upload.
'// - If set to false and if the destination file exists, an error
'// - is raised. The default value is False.
'//
'// Target
'// - Read/Write
'// - The file will be written to this folder.
'// - This property can only be set before calling Upload.
'// - There is no default value for this property and it is required.
'//
'// Form
'// - ReadOnly
'// - Scripting.Dictionary object
'// - Can access a specific item by using aspfileupload.Form("item").
'// - Acts like the asp form collection.
'// - Can enumerate all values in a collection with for each.
'// - Only filled after the Upload method is called.
'//
'// Methods
'// Upload
'// - This method parses the HTTP Post and writes the file.
'//
'// Other
'// - ASPFileUpload requires COM+
'// - Any call to the Request.Form() collection will cause the Upload
'// method to fail as the method references the Binary contents of the
'// Request object through the Request.BinaryRead method.
'// - Also, if you access a variable in the Request collection without
'// specifying the subcollection that it belongs to, the Request.Form collection
'// may be searched. This causes an error in the Upload method.
'//
'//////////////////////////////////////////////////////////////////////////////////
Dim strMsg 'As String
' On Error Resume Next
dim fuFile
set fuFile = server.CreateObject("aspFileupload.file")
'Set the destination folder.
fuFile.Target = "C:\TEMP\AspFileUpload\"
fuFile.Upload
If Err.number = 0 Then
strMsg = fuFile.FileName & " was uploaded successfully."
Else
strMsg = "An error occurred when uploading your file: " & Err.Description
End If
for each o in fuFile.Form
Response.Write o & "<BR>"
next
Response.Write fuFile.Form.item("text1") & " : " & fuFile.Form.item("text2")
' Response.Write Request.Form("test")
set fufile = nothing
%>
<html>
<head></head>
<body>
<%=strMsg%>
</body>
</html>
Crie uma pasta no servidor Web que receberá o
upload de arquivos, comoC:\TEMP\AspFileUpload.
Copie o arquivo de ASPFileUpload.dll para o servidor Web e, em seguida
para registrá-lo usando o seguinte comando no prompt de comando:
regsvr32 PathToDLL\ASPFileUpload.dll
Aplica permissões de arquivo (acesso de gravação) para os usuários que você deseja ser capaz de carregar os arquivos.
Clique em Iniciar, aponte paraConfiguraçõese, em seguida, clique em Controle
Painel.
No painel de controle, clique em Administrativo
Ferramentase, em seguida, clique em Serviços de componente Para abrir
Serviços de componentes no Console de gerenciamento Microsoft (MMC).
Expanda o Serviços de componente nó, oComputadores nó, o Meu computador nó e oAplicativos COM+ nó.
Clique com o botão direito no nó, aponte para Novoe, em seguida, clique emAplicativo.
No Instalar ou criar um novo aplicativo caixa de diálogo, clique em Criar um aplicativo vazio,
Nomeie o aplicativo, certifique-se de que você clique para selecionar Servidor
aplicativoe, em seguida, clique em Avançar.
No Definir identidade do aplicativo caixa de diálogo
Clique em Este usuárioe digite as credenciais para o
conta de usuário apropriada. A conta de usuário deve ter acesso de gravação para a pasta
que receberá o arquivo carregado.
Clique em Concluir.
Expanda o nó que você acabou de criar para isso
aplicativo.
Clique com o botão direito do aceno, aponte para Novo, e
em seguida, clique em Componente.
Clique em Instalar novos componentes,
e localize a pasta onde você salvou e registrado o arquivo. dll, clique em
o arquivo, clique em Avançare, em seguida, clique emConcluir.
Copie o arquivo de Postfile.asp e o arquivo Uploadfile.asp
sua pasta de raiz da Web. Por padrão, a pasta raiz da Web é
C:\Inetpub\Wwwroot.
Editar a pasta de destino de Uploadfile.asp para refletir o
pasta em que você criou na etapa 1. A atribuição da pasta de destino está localizada em
a seguinte linha de código:
Se você não digitar um nome de arquivo e se você tentar enviar
a página de Postfile.asp, você recebe uma mensagem de erro genérica, no lado do servidor. Você
Talvez seja necessário modificar o código para fornecer uma mensagem de erro mais amigável em um
o cliente lateral ou no lado do servidor.
Se você precisar de capacidade de carregamento de alto volume, Microsoft
recomenda que você compra ou criar um componente compilado com vários segmentos que podem
lidar com mais eficiência com a carga que esse componente Visual Basic.
Um risco de segurança existe sempre que você permitir que os usuários
para carregar arquivos para seu servidor Web. Isso é especialmente verdadeiro se o servidor for
na Internet e se você permitir anônimo carrega. Você deve corretamente
Configurar permissões do Windows e autenticação de usuário do IIS para certificar-se de que você
dar aos usuários o acesso que eles precisam. Isso é importante para que você não fizer isso
permitir que os usuários uma maneira de obter acesso, ignorando os controles de segurança do seu
sistema.
IMPORTANTE: Este artigo foi traduzido por um sistema de tradução automática (também designado por Machine Translation ou MT), não tendo sido portanto traduzido ou revisto por pessoas. A Microsoft possui artigos traduzidos por aplicações (MT) e artigos traduzidos por tradutores profissionais, com o objetivo de oferecer em português a totalidade dos artigos existentes na base de dados de suporte. No entanto, a tradução automática não é sempre perfeita, podendo conter erros de vocabulário, sintaxe ou gramática. A Microsoft não é responsável por incoerências, erros ou prejuízos ocorridos em decorrência da utilização dos artigos MT por parte dos nossos clientes. A Microsoft realiza atualizações freqüentes ao software de tradução automática (MT). Obrigado.
Clique aqui para ver a versão em Inglês deste artigo: 299692
(http://support.microsoft.com/kb/299692/en-us/
)
Quanto esforço foi necessário para seguir os procedimentos deste artigo?
Muito baixo
Baixo
Moderado
Alto
Muito alto
Diga-nos o porque e o que podemos fazer para melhorar esta informação
Obrigado! Seus comentários são usados para nos ajudar a aperfeiçoar o conteúdo de suporte. Para obter mais opções de ajuda, visite a Home Page de Ajuda e Suporte.