Gostaria de renomear um arquivo após fazer upload, porém já entrei em todos os foruns possíveis e imaginaveis, mas o máximo que consegui, foi faz pelo FSO.
Se eu soubesse fazer pelo eu não entrava no Fórum.
Eu até comprei o livro de ASP, mas não achei nada que me ajudasse.
Caso alguém possa me ajudar posta um trecho do código que faz essa ação de renomear.
Por Favor galera!!!
Obrigado pela atenção!!!!
Renomear Arquivos
Started By Brunao, 10/03/2004, 12:16
5 replies to this topic
#1
Posted 10/03/2004, 12:16
1000 % ASP
#2
Posted 10/03/2004, 12:28
vamos fazer o seguinte, eu tenho um cod aqui, vc tem algo pronto ai?, se vc tiver eu faço uma adpitação e posto aqui
t+
t+
#3
Posted 10/03/2004, 12:48
Essa página é a upload.asp
Esse código é da página upload.inc
Na verdade baixei este código mas não gostei muito, porque eu precisaria de um código que só baixe jpg com no máximo 70 kb e de tamanho máximo 600 x 400 px, e que após fizesse o upload renomeasse a foto com uma sequencia numérica de 6 dígitos em ordem crescente tipo 000001.jpg - 000002.jpg etc. Mas não achei nada parecido, se vc tiver algum código assim ignora esse que postei e posta aí pra mim!!!!
Valeu!!!
<html> <head> <title>Upload</title> </head> <body> <form method=post ENCTYPE="multipart/form-data"> File : <input type="file" name="File1"><br> <input type="submit" Name="Action" value="Upload the file"> </form> </body></HTML> <!---#INCLUDE FILE="upload.inc" ---> <% 'Sauvegarde le fichier 'File1' sur le serveur dans le même répertoire que ce script 'Modifier le FilePath pour le claquer ailleurs If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" For get the fields Set Fields = GetUpload() FilePath = Server.MapPath(".") & "\fotos" & Fields("File1").FileName Fields("File1").Value.SaveAs FilePath End If
Esse código é da página upload.inc
<script RUNAT=SERVER LANGUAGE=VBSCRIPT> Const IncludeType = 2 'Vous pouvez utiliser ce composant d'upload pourr : ' 1. Uploader de petits fichiers sur le serveur (sauvegarde via les FileSystem object) ' 2. Uploader des fichiers binaires/texte de n'importe quelle taille sur une base de données serveur (RS("BinField") = Upload("FormField").Value) 'restriction de la taille de l'upload Dim UploadSizeLimit '********************************** Méthode GetUpload ********************************** 'Cette fonction lit les champs de formulaires en entrée binaire et les renvoie en tant qu'objet du dictionnaire. Function GetUpload() Dim Result Set Result = Nothing If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'la méthode REQUEST doit être POST Dim CT, PosB, Boundary, Length, PosE CT = Request.ServerVariables("HTTP_Content_Type") ' lit le header If LCase(Left(CT, 19)) = "multipart/form-data" Then 'qui doit être de type "multipart/form-data" PosB = InStr(LCase(CT), "boundary=") 'Finds boundary If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary '****** Erreur sur IE5.01 - doublement des entêtes http PosB = InStr(LCase(CT), "boundary=") If PosB > 0 then 'Patch pour l'erreur IE PosB = InStr(Boundary, ",") If PosB > 0 Then Boundary = Left(Boundary, PosB - 1) end if '****** Erreur sur IE5.01 - doublement des entêtes http Length = CLng(Request.ServerVariables("HTTP_Content_Length")) If "" & UploadSizeLimit <> "" Then UploadSizeLimit = CLng(UploadSizeLimit) If Length > UploadSizeLimit Then Request.BinaryRead (Length) Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B" Exit Function End If End If If Length > 0 And Boundary <> "" Then Boundary = "--" & Boundary Dim Head, Binary Binary = Request.BinaryRead(Length) 'lit les données à partir du poste client Set Result = SeparateFields(Binary, Boundary) Binary = Empty 'Mise à jour des variables Else Err.Raise 10, "GetUpload", "longueur nulle ." End If Else Err.Raise 11, "GetUpload", "Pas de fichier joint." End If Else Err.Raise 1, "GetUpload", "Mauvaise méthode de request." End If Set GetUpload = Result End Function '********************************** SeparateFields ********************************** Function SeparateFields(Binary, Boundary) Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary Dim Fields Boundary = StringToBinary(Boundary) PosOpenBoundary = InStrB(Binary, Boundary) PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0) Set Fields = CreateObject("Scripting.Dictionary") Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary) 'Entête et fichier source Dim HeaderContent, FieldContent, bFieldContent 'entêtes Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type 'variable Dim Field, TwoCharsAfterEndBoundary 'Fin de l'entête PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf)) 'Séparation des champs de l'entêter HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2) 'séparation du contenu bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2) 'séparation des champs d'entête de l'entêter GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type 'Creation d'un champs et attribution des paramètres Set Field = CreateUploadField()'See the JS function bellow Set FieldContent = CreateBinaryData(bFieldContent,LenB(bFieldContent)) ' FieldContent.ByteArray = bFieldContent ' FieldContent.Length = LenB(bFieldContent) Field.Name = FormFieldName Field.ContentDisposition = Content_Disposition Field.FilePath = SourceFileName Field.FileName = GetFileName(SourceFileName) Field.ContentType = Content_Type Field.Length = FieldContent.Length Set Field.Value = FieldContent ' response.write "<br>:" & FormFieldName Fields.Add FormFieldName, Field 'Dernière borne ? TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2)) isLastBoundary = TwoCharsAfterEndBoundary = "--" If Not isLastBoundary Then 'Putain!!! Pas la dernière... on avance jusqu'au champ suivant. PosOpenBoundary = PosCloseBoundary PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary) End If Loop Set SeparateFields = Fields End Function '********************************** Utilities ********************************** 'Separation des champs d'entête de l'entête uploadé Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type) Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";")) Name = (SeparateField(Head, "name=", ";")) 'ltrim If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2) FileName = (SeparateField(Head, "filename=", ";")) 'ltrim If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2) Content_Type = LTrim(SeparateField(Head, "content-type:", ";")) End Function 'Separation du champ entre sStart et sEnd Function SeparateField(From, ByVal sStart, ByVal sEnd) Dim PosB, PosE, sFrom sFrom = LCase(From) PosB = InStr(sFrom, sStart) If PosB > 0 Then PosB = PosB + Len(sStart) PosE = InStr(PosB, sFrom, sEnd) If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf) If PosE = 0 Then PosE = Len(sFrom) + 1 SeparateField = Mid(From, PosB, PosE - PosB) Else SeparateField = Empty End If End Function 'Separation du nom de fichier du chemin Function GetFileName(FullPath) Dim Pos, PosF PosF = 0 For Pos = Len(FullPath) To 1 Step -1 Select Case Mid(FullPath, Pos, 1) Case "/", "\": PosF = Pos + 1: Pos = 0 End Select Next If PosF = 0 Then PosF = 1 GetFileName = Mid(FullPath, PosF) End Function Function BinaryToStringSimple(Binary) Dim I, S For I = 1 To LenB(Binary) S = S & Chr(AscB(MidB(Binary, I, 1))) Next BinaryToStringSimple = S End Function Function BinaryToString(Binary) ' BinaryToString = RSBinaryToString(Binary) ' Exit Function dim cl1, cl2, cl3, pl1, pl2, pl3 Dim L', nullchar cl1 = 1 cl2 = 1 cl3 = 1 L = LenB(Binary) Do While cl1<=L pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1))) cl1 = cl1 + 1 cl3 = cl3 + 1 if cl3>300 then pl2 = pl2 & pl3 pl3 = "" cl3 = 1 cl2 = cl2 + 1 if cl2>200 then pl1 = pl1 & pl2 pl2 = "" cl2 = 1 End If End If Loop BinaryToString = pl1 & pl2 & pl3 End Function Function RSBinaryToString(xBinary) Dim Binary if vartype(xBinary)=8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary Dim RS, LBinary Const adLongVarChar = 201 Set RS = CreateObject("ADODB.Recordset") LBinary = LenB(Binary) if LBinary>0 then RS.Fields.Append "mBinary", adLongVarChar, LBinary RS.Open RS.AddNew RS("mBinary").AppendChunk Binary RS.Update RSBinaryToString = RS("mBinary") Else RSBinaryToString = "" End If End Function Function MultiByteToBinary(MultiByte) Dim RS, LMultiByte, Binary Const adLongVarBinary = 205 Set RS = CreateObject("ADODB.Recordset") LMultiByte = LenB(MultiByte) if LMultiByte>0 then RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte RS.Open RS.AddNew RS("mBinary").AppendChunk MultiByte & ChrB(0) RS.Update Binary = RS("mBinary").GetChunk(LMultiByte) End If MultiByteToBinary = Binary End Function Function StringToBinary(String) Dim I, B For I=1 to len(String) B = B & ChrB(Asc(Mid(String,I,1))) Next StringToBinary = B End Function Function vbsSaveAs(FileName, ByteArray) Dim FS, TextStream Set FS = CreateObject("Scripting.FileSystemObject") Set TextStream = FS.CreateTextFile(FileName) TextStream.Write BinaryToString(ByteArray) ' BinaryToString is in upload.inc. TextStream.Close End Function </SCRIPT> <script RUNAT=SERVER LANGUAGE=JSCRIPT> function CreateUploadField(){ return new uf_Init() } function uf_Init(){ this.Name = null this.ContentDisposition = null this.FileName = null this.FilePath = null this.ContentType = null this.Value = null this.Length = null } function CreateBinaryData(Binary, mLength){ return new bin_Init(Binary, mLength) } function bin_Init(Binary, mLength){ this.ByteArray = Binary this.Length = mLength this.String = BinaryToString(Binary) this.SaveAs = jsSaveAs } //function jsBinaryToString(){ // return BinaryToString(this.ByteArray) //}; function jsSaveAs(FileName){ return vbsSaveAs(FileName, this.ByteArray) } //Simulate ByteArray class by JS/VBS - end </SCRIPT>
Na verdade baixei este código mas não gostei muito, porque eu precisaria de um código que só baixe jpg com no máximo 70 kb e de tamanho máximo 600 x 400 px, e que após fizesse o upload renomeasse a foto com uma sequencia numérica de 6 dígitos em ordem crescente tipo 000001.jpg - 000002.jpg etc. Mas não achei nada parecido, se vc tiver algum código assim ignora esse que postei e posta aí pra mim!!!!
Valeu!!!
1000 % ASP
#4
Posted 10/03/2004, 14:14
mano o cod q eu tenho aqui ele renomeia de acordo com o id de um registro, tipo noticia tal com id=1 , qdo for cadastrar a img vai ficar assim, 1.jpg, serve este?
t+
t+
#5
Posted 10/03/2004, 14:23
Claro, me mande por favor!!!!!
Preciso muito disso, baseado no seu código eu adpito p/ o que eu preciso!!!!
Valeu!!!!
Preciso muito disso, baseado no seu código eu adpito p/ o que eu preciso!!!!
Valeu!!!!
1000 % ASP
#6
Posted 10/03/2004, 17:38
então toma,
depois p/ atualizar no banco de dados
ta ai o cod caso tenha duvidas no funcionamento é só falar
t+
<% response.buffer=true Func = Request("Func") nome= Request("nome") if isempty(Func) Then Func = 1 End if Select Case Func Case 1 response.redirect "../index.asp" Case 2 ForWriting = 2 adLongVarChar = 201 lngNumberUploaded = 0 noBytes = Request.TotalBytes binData = Request.BinaryRead (noBytes) Set RST = CreateObject("ADODB.Recordset") LenBinary = LenB(binData) if LenBinary > 0 Then RST.Fields.Append "myBinary", adLongVarChar, LenBinary RST.Open RST.AddNew RST("myBinary").AppendChunk BinData RST.Update strDataWhole = RST("myBinary") End if strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE") lngBoundryPos = instr(1,strBoundry,"boundary=") + 8 strBoundry = "--" & right(strBoundry,len(strBoundry)-lngBoundryPos) lngCurrentBegin = instr(1,strDataWhole,strBoundry) lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1 Do While lngCurrentEnd > 0 strData = mid(strDataWhole,lngCurrentBegin, lngCurrentEnd - lngCurrentBegin) strDataWhole = replace(strDataWhole,strData,"") lngBeginFileName = instr(1,strdata,"filename=") + 10 lngEndFileName = instr(lngBeginFileName,strData,chr(34)) if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 Then Response.Write "<H2> The following Error occured.</H2>" Response.Write "You must Select at least one file To upload" Response.Write "<BR><BR>Hit the back button, make the needed corrections and resubmit your information." Response.Write "<BR><BR><INPUT type='button' onclick='history.go(-1)' value='<< Back' id='button'1 name='button'1>" Response.End End if if lngBeginFileName <> lngEndFileName Then strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName) tmpLng = instr(1,strFilename,"\") Do While tmpLng > 0 PrevPos = tmpLng tmpLng = instr(PrevPos + 1,strFilename,"\") Loop FileName = right(strFilename,len(strFileName) - PrevPos) lngCT = instr(1,strData,"Content-Type:") if lngCT > 0 Then lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4 Else lngBeginPos = lngEndFileName End if lngEndPos = len(strData) lngDataLenth = lngEndPos - lngBeginPos strFileData = mid(strData,lngBeginPos,lngDataLenth) Set fso = CreateObject("Scripting.FileSystemObject") total = len(FileName) T = inStr(1,FileName,".") -1 uin = nome & right(FileName,total - T) Set f = fso.OpenTextFile(server.mappath(".") & "\" & uin, ForWriting, True) f.Write strFileData Set f = nothing Set fso = nothing lngNumberUploaded = lngNumberUploaded + 1 End if lngCurrentBegin = instr(1,strDataWhole,strBoundry) lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1 loop response.redirect "../admin/atualiza1_ass.asp?id="&nome&"&foto="&uin End Select %>
depois p/ atualizar no banco de dados
<!--#include file="conn.asp"--> <% ID = request.querystring("id") foto = request.querystring("foto") IF id = "" Then response.redirect "index.asp" else strSQL = "UPDATE tbl_ass SET img = '" & foto & "'WHERE id= " & id Set rs = Conn.Execute(strSQL) %>
ta ai o cod caso tenha duvidas no funcionamento é só falar
t+
0 user(s) are reading this topic
0 membro(s), 0 visitante(s) e 0 membros anônimo(s)