<% 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 & session("email") & "__" & fileItem.FileName, 2 '*** ACHEI ONDE COLOCA O NOME! *** ' VAMOS TESTAR ARQUIVAR BANCO DE DADOS dim sql, conn,abrir,caminho CAMINHO = "c:\dominios\newphoto\dados\banco.mdb" ABRIR = "DBQ="& CAMINHO & ";Driver={Microsoft Access Driver (*.mdb)}" sql="INSERT INTO fotografias(codcliente,email,dataenvio,horaenvio,nomefoto,quantidade,tamanho,tipopapel,bordabranca,cidade) VALUES (" & session("id") & ",'" & session("email") & "',#" & date() & "#,#" & time() & "#,'" & session("email") & "__" & fileItem.FileName &"'," & session("qntde") & ",'" & session("tamanho") & "','" & session("tipopapel") & "','" & session("bordabranca") &"', '" & session("cidade") & "')" Set Conn = Server.CreateObject("ADODB.Connection") Conn.open ABRIR conn.close() Set Conn = Nothing streamFile.close Set streamFile = Nothing fileItem.Path = path & fileItem.FileName Next End Sub 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 '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 VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes) 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, sFileName Set oUploadFile = New UploadedFile nCurPos = SkipToken(tFilename, nCurPos) sFileName = ExtractField(tDoubleQuotes, nCurPos) oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\")) if (Len(oUploadFile.FileName) > 0) then 'File field not left empy nCurPos = SkipToken(tContentType, nCurPos) oUploadFile.ContentType = ExtractField(tNewLine, nCurPos) 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)) 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 Public Function SaveBinRequest(path) ' For debugging purposes StreamRequest.SaveToFile path & "debugStream.bin", 2 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 Function End Class Class UploadedFile Public ContentType Public FileName Public Start Public Length Public Path End Class %>
