Accedi per seguire   
Seguaci 0
alexis73

Nozioni Asp Per Imparare A Fare Upload File Con Db Da Area Privata

3 messaggi in questa discussione

Ciao visto che non c'è a disposizione un estensione free, vi chiedo se perfavore mi aiutate a creare il codice asp per poter interagire con il mio db.

il dabase è funzionante e ho già provveduto a creare 4 campi che ospiteranno il percorso per ricevere i file di foto.

nome db: db_lachiocciola.mdb

tabella: tab_LaChiocciola

nome campi: foto_esterna

foto_esterna1

foto_esterna2

foto_esterna3

Mi è chiaro che ci vorranno due pagine, una che ospita il form con il pulsante sfoglia e l'altro con codice asp.

Da dove posso iniziare? Vi ringrazio. :leggi:

Condividi questo messaggio


Link di questo messaggio
Condividi su altri siti

Ciao visto che non c'è a disposizione un estensione free, vi chiedo se perfavore mi aiutate a creare il codice asp per poter interagire con il mio db.

il dabase è funzionante e ho già provveduto a creare 4 campi che ospiteranno il percorso per ricevere i file di foto.

nome db: db_lachiocciola.mdb

tabella: tab_LaChiocciola

nome campi: foto_esterna

foto_esterna1

foto_esterna2

foto_esterna3

Mi è chiaro che ci vorranno due pagine, una che ospita il form con il pulsante sfoglia e l'altro con codice asp.

Da dove posso iniziare? Vi ringrazio. :leggi:

Prima di iniziare, una sola domanda:

Il database che hai creato contiene dei campi blob che conterranno fisicamente le foto?

Se così fosse, ti consiglio di modificarlo in modo che quei campi vadano a contenere il percorso di dove si trova la foto...

Dopodichè dividiamo il programma in due parti: l'upload del file sul server e l'aggiornamento del database.

:)

Condividi questo messaggio


Link di questo messaggio
Condividi su altri siti

No sono dei campi che servono da contenimento per l'url della foto.

Ho recuperato l'estensione di dw asp pure upload file, perfettamente funzionante se si inseriscono dei file in una cartella come /public ma quando entra in gioco il mio db segnala errore sulla linea 225

Segnala questo tipo di errore.

Server.MapPath() error 'ASP 0175 : 80004005'

Disallowed Path Characters

/ScriptLibrary/incPureUpload.asp, line 225

The '..' characters are not allowed in the Path parameter for the MapPath

method.

sulla linea 225, c'è scritto:

GP_FullPath = Trim(Server.mappath(GP_curPath))

Questo è il codice della libreria che crea questa estensione.

<script LANGUAGE="vb script:history.back(1)"">try again</a>"	  
  Response.End
 End If
End If
End Sub


'Check if version is uptodate
Sub CheckPureUploadVersion(pau_version)
Dim foundPureUploadVersion
foundPureUploadVersion = getPureUploadVersion()
if err or pau_version > foundPureUploadVersion then
 Response.Write "<b>You don't have latest version of ScriptLibrary/incPureUpload.asp uploaded on the server.</b><br/>"
 Response.Write "This library is required for the current page. It is fully backwards compatible so old pages will work as well.<br/>"
 Response.End	
end if
End Sub


'Get fieldname
function pau_Name(FormInfo)
Dim PosBeg, PosLen
PosBeg = InStr(FormInfo, "name=")+6
PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
pau_Name = Mid(FormInfo, PosBeg, PosLen)
end function


'Get filename
function pau_FileName(FormInfo)
Dim PosBeg, PosLen
PosBeg = InStr(FormInfo, "filename=")+10
PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
pau_FileName = Mid(FormInfo, PosBeg, PosLen)
end function


'Get contentType
function pau_ContentType(FormInfo)
Dim PosBeg
PosBeg = InStr(FormInfo, "Content-Type: ")+14
pau_ContentType = Mid(FormInfo, PosBeg)
end function


'Compatibility with older versions
Sub BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)
pau_BuildUploadRequest RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict
End Sub


Sub pau_BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)
Dim Boundary, FormInfo, TypeArr, BoundaryArr, BoundaryPos, Pos, PosLen
Dim PosFile, Name, PosBound, FileName, ContentType, Value, ValueBeg, ValueEnd, ValueLen
'Check content type
TypeArr = Split(Request.ServerVariables("HTTP_Content_Type"), ";")
if Trim(TypeArr(0)) <> "multipart/form-data" then
 Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br/>"
 Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"	  
 Response.End
end if
'Get the boundary
BoundaryArr = Split(Trim(TypeArr(1)), "=")
Boundary = pau_getByteString(Trim(BoundaryArr(1)))
BoundaryPos = InStrB(1, RequestBin, Boundary)
'Get all data inside the boundaries
Do until (BoundaryPos = InStrB(RequestBin, Boundary & pau_getByteString("--")))
 'Members variable of objects are put in a dictionary object
 Dim UploadControl, CrLf
 CrLf = pau_getByteString(chr(13) & chr(10))
 Set UploadControl = CreateObject("Scripting.Dictionary")
 Pos = InStrB(BoundaryPos, RequestBin, CrLf & CrLf)
 PosLen = (InStrB(Pos, RequestBin, boundary)-2)-(pos+4)
 if Pos > 0 then
  FormInfo = pau_getString(MidB(RequestBin, BoundaryPos, Pos-BoundaryPos))
  'Get name
  Name = LCase(pau_Name(FormInfo))
  'Is it a file?
  if InStr(FormInfo, "filename=") > 0 then
'Get filename
FileName = pau_FileName(FormInfo)
FileName = pau_RemoveInvalidChars(Mid(FileName,InStrRev(FileName,"\")+1))
'Add filename to dictionary object
UploadControl.Add "FileName", FileName
'Get contenttype
ContentType = pau_ContentType(FormInfo)
'Add content-type to dictionary object
UploadControl.Add "ContentType", ContentType
'Get content
Value = FileName
ValueBeg = Pos+3
ValueLen = PosLen
  else
Value = pau_getString(MidB(RequestBin, Pos+4, PosLen))
ValueBeg = 0
ValueLen = 0
  end if
  'Add content to dictionary object
  UploadControl.Add "Value", Value
  UploadControl.Add "ValueBeg", ValueBeg
  UploadControl.Add "ValueLen", ValueLen
  'Add dictionary object to main dictionary
  if UploadRequest.Exists(Name) then
UploadRequest(Name).Item("Value") = UploadRequest(Name).Item("Value") & "," & Value
  else
UploadRequest.Add Name, UploadControl
  end if
 end if
 BoundaryPos = InStrB(BoundaryPos+LenB(Boundary), RequestBin, Boundary)
Loop
Dim GP_keys, GP_i, GP_curKey, GP_value, GP_valueBeg, GP_valueLen, GP_curPath, GP_FullPath
Dim GP_CurFileName, GP_FullFileName, fso, GP_BegFolder, GP_RelFolder, GP_FileExist, Begin_Name_Num
Dim orgUploadDirectory
if InStr(UploadDirectory,"""") > 0 then 
 on error resume next
 orgUploadDirectory = UploadDirectory
 UploadDirectory = eval(UploadDirectory)  
 if err then
  Response.Write "<b>Upload folder is invalid</b><br/><br/>"	  
  Response.Write "Upload Folder: " & Trim(orgUploadDirectory) & "<br/>"
  Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
  err.clear
  response.End
 end if	
 on error goto 0
end if  
GP_keys = UploadRequest.Keys
for GP_i = 0 to UploadRequest.Count - 1
 GP_curKey = GP_keys(GP_i)
 'Save all uploaded files
 if UploadRequest.Item(GP_curKey).Item("FileName") <> "" then
  GP_value = UploadRequest.Item(GP_curKey).Item("Value")
  GP_valueBeg = UploadRequest.Item(GP_curKey).Item("ValueBeg")
  GP_valueLen = UploadRequest.Item(GP_curKey).Item("ValueLen")
  'Get the path
  if InStr(UploadDirectory,"\") > 0 then
GP_curPath = UploadDirectory
if Mid(GP_curPath,Len(GP_curPath),1) <> "\" then
 GP_curPath = GP_curPath & "\"
end if		 
GP_FullPath = GP_curPath
  else
GP_curPath = Request.ServerVariables("PATH_INFO")
GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & UploadDirectory)
if Mid(GP_curPath,Len(GP_curPath),1)  <> "/" then
 GP_curPath = GP_curPath & "/"
end if 
GP_FullPath = Trim(Server.mappath(GP_curPath))
  end if
  if GP_valueLen = 0 then
Response.Write "<b>An error has occured saving uploaded file!</b><br/><br/>"
Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br/>"
Response.Write "File does not exists or is empty.<br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
response.End
  end if
  'Create a Stream instance
  Dim GP_strm1, GP_strm2
  Set GP_strm1 = Server.CreateObject("ADODB.Stream")
  Set GP_strm2 = Server.CreateObject("ADODB.Stream")
  'Open the stream
  GP_strm1.Open
  GP_strm1.Type = 1 'Binary
  GP_strm2.Open
  GP_strm2.Type = 1 'Binary
  GP_strm1.Write RequestBin
  GP_strm1.Position = GP_ValueBeg
  GP_strm1.CopyTo GP_strm2,GP_ValueLen
  'Create and Write to a File
  GP_CurFileName = UploadRequest.Item(GP_curKey).Item("FileName")	  
  GP_FullFileName = GP_FullPath & "\" & GP_CurFileName
  Set fso = CreateObject("Scripting.FileSystemObject")
  pau_AutoCreatePath GP_FullPath
  'Check if the file already exist
  GP_FileExist = false
  If fso.FileExists(GP_FullFileName) Then
GP_FileExist = true
  End If	  
  if nameConflict = "error" and GP_FileExist then
Response.Write "<b>File already exists!</b><br/><br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
GP_strm1.Close
GP_strm2.Close
response.End
  end if
  if ((nameConflict = "over" or nameConflict = "uniq") and GP_FileExist) or (NOT GP_FileExist) then
if nameConflict = "uniq" and GP_FileExist then
 Begin_Name_Num = 0
 while GP_FileExist	
  Begin_Name_Num = Begin_Name_Num + 1
  GP_FullFileName = Trim(GP_FullPath)& "\" & fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
  GP_FileExist = fso.FileExists(GP_FullFileName)
 wend  
 UploadRequest.Item(GP_curKey).Item("FileName") = fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
 UploadRequest.Item(GP_curKey).Item("Value") = UploadRequest.Item(GP_curKey).Item("FileName")
end if
on error resume next
GP_strm2.SaveToFile GP_FullFileName,2
if err then
 err.clear
 Dim txt_stream, file_bin
 Set txt_stream = fso.CreateTextFile(GP_FullFileName, True)
 file_bin = pau_getString(MidB(RequestBin, GP_ValueBeg+1, GP_ValueLen))
 txt_stream.Write file_bin
 txt_stream.Close
 if err then
  GP_strm1.Close
  GP_strm2.Close
  Response.Write "<b>An error has occured saving uploaded file!</b><br/><br/>"
  Response.Write "Filename: " & GP_FullFileName & "<br/><br/>"
  if fso.FileExists(GP_FullFileName) then
   Dim f
   Response.Write "File exists on server!<br/>"
   Set f = fso.GetFile(GP_FullFileName)
   Response.Write "Attributes(" & f.attributes & "|" & f.parentfolder.attributes & "): "
   if f.attributes and 1 then
	Response.Write "ReadOnly "
   end if
   if f.attributes and 2 then
	Response.Write "Hidden "
   end if
   if f.attributes and 4 then
	Response.Write "System "
   end if
   if f.attributes and 16 then
	Response.Write "Directory "
   end if
   Response.Write "<br/><br/>"
  end if
  Response.Write "Error # " & CStr(Err.Number) & " " & Err.Description & "<br/>"
  Response.Write "in " & Err.Source & "(" & GP_strm2.state & ")<br/>"
  response.End
 end if
end if
GP_strm1.Close
GP_strm2.Close
if storeType = "path" then
 UploadRequest.Item(GP_curKey).Item("Value") = GP_curPath & UploadRequest.Item(GP_curKey).Item("Value")
end if
on error goto 0
  end if
 end if
next
End Sub


'Create folders if they do not exist
Sub pau_AutoCreatePath(PAU_FullPath)
Dim FL_fso, FL_EndPos, PAU_NewPath
Set FL_fso = CreateObject("Scripting.FileSystemObject")  
if not FL_fso.FolderExists(PAU_FullPath) then
FL_EndPos = InStrRev(PAU_FullPath,"\")
if FL_EndPos > 0 then
 PAU_NewPath = Left(PAU_FullPath,FL_EndPos-1)
 pau_AutoCreatePath PAU_NewPath
 on error resume next
 FL_fso.CreateFolder PAU_FullPath
 if err.number <> 0 then
  Response.Write "<b>Can not create upload folder path: " & PAU_FullPath & "!</b><br/>"
  Response.Write "Maybe you don't have enough permissions<br/><br/>"		
  Response.Write "Error # " & CStr(Err.Number) & " " & Err.Description & "<br/><br/>"
  Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
  Response.End		
 end if
 on error goto 0
 end if  
end if
Set FL_fso = nothing
End Sub


'String to byte string conversion
Function pau_getByteString(StringStr)
Dim i, char
For i = 1 to Len(StringStr)
 char = Mid(StringStr,i,1)
 pau_getByteString = pau_getByteString & chrB(AscB(char))
Next
End Function


'Byte string to string conversion (with double-byte support now)
Function pau_getString(StringBin)
Dim intCount,get1Byte
pau_getString = ""
For intCount = 1 to LenB(StringBin)
 get1Byte = MidB(StringBin,intCount,1)
 pau_getString = pau_getString & chr(AscB(get1Byte)) 
Next
End Function


'Replacement for the requests
Function UploadFormRequest(name)
Dim keyName
keyName = LCase(name)
if IsObject(UploadRequest) then
 if UploadRequest.Exists(keyName) then
  if UploadRequest.Item(keyName).Exists("Value") then
UploadFormRequest = UploadRequest.Item(keyName).Item("Value")
  end if  
 end if  
end if  
End Function


'Invalid characters
'Dollar sign ($) 
'At sign (@) 
'Angle brackets (< >), brackets ([ ]), braces ({ }), and parentheses (( )) 
'Colon (:) and semicolon (;) 
'Equal sign (=) 
'Caret sign (^) 
'Pipe (vertical bar) (|) 
'Asterisk (*) 
'Exclamation point (!) 
'Forward (/) and backward slash (\) 
'Percent sign (%) 
'Question mark (?) 
'Comma (,) 
'Quotation mark (single or double) (' ") 
'Tab 
Function pau_RemoveInvalidChars(str)
Dim newStr, ci, curChar, Invalid
Invalid = "[email="$@[]{}():;=^|*!/\%?,"]$@<>[]{}():;=^|*!/\%?,'[/email]"" "
for ci = 1 to Len(str)
 curChar = Mid(str,ci,1)
 if InStr(Invalid, curChar) = 0 then
  newStr = newStr & curChar
 end if
next
pau_RemoveInvalidChars = Trim(newStr)
End Function


'Fix for the update record
Function FixFieldsForUpload(GP_fieldsStr, GP_columnsStr)
Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_FieldValue, GP_CurFileName, GP_CurContentType
GP_Fields = Split(GP_fieldsStr, "|")
GP_Columns = Split(GP_columnsStr, "|") 
GP_fieldsStr = ""
' Get the form values
For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
 GP_FieldName = LCase(GP_Fields(GP_counter))
 GP_FieldValue = GP_Fields(GP_counter+1)
 if UploadRequest.Exists(GP_FieldName) then
  GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
  GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")
 else  
  GP_CurFileName = ""
  GP_CurContentType = ""
 end if 
 if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
  GP_fieldsStr = GP_fieldsStr & GP_FieldName & "|" & GP_FieldValue & "|"
 end if 
Next
if GP_fieldsStr <> "" then
 GP_fieldsStr = Mid(GP_fieldsStr,1,Len(GP_fieldsStr)-1)
else  
 Response.Write "<b>An error has occured during record update!</b><br/><br/>"
 Response.Write "There are no fields to update ...<br/>"
 Response.Write "If the file upload field is the only field on your form, you should make it required.<br/>"
 Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
 Response.End
end if
FixFieldsForUpload = GP_fieldsStr	
End Function


'Fix for the update record
Function FixColumnsForUpload(GP_fieldsStr, GP_columnsStr)
Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_ColumnName, GP_ColumnValue,GP_CurFileName, GP_CurContentType
GP_Fields = Split(GP_fieldsStr, "|")
GP_Columns = Split(GP_columnsStr, "|") 
GP_columnsStr = "" 
' Get the form values
For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
 GP_FieldName = LCase(GP_Fields(GP_counter))  
 GP_ColumnName = GP_Columns(GP_counter)  
 GP_ColumnValue = GP_Columns(GP_counter+1)
 if UploadRequest.Exists(GP_FieldName) then
  GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
  GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")   
 else  
  GP_CurFileName = ""
  GP_CurContentType = ""
 end if  
 if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
  GP_columnsStr = GP_columnsStr & GP_ColumnName & "|" & GP_ColumnValue & "|"
 end if 
Next
if GP_columnsStr <> "" then
 GP_columnsStr = Mid(GP_columnsStr,1,Len(GP_columnsStr)-1)	
end if
FixColumnsForUpload = GP_columnsStr
End Function

</SCRIPT>

Grazie Prozac! Con l'estensione credevo di riuscire ma perchè non mi funziona!

Condividi questo messaggio


Link di questo messaggio
Condividi su altri siti

Crea un account o accedi per lasciare un commento

Devi essere un utente registrato per partecipare

Crea un account

Iscriviti per un nuovo account nella nostra community. È facile!


Registra un nuovo account

Accedi

Sei già registrato? Accedi qui.


Accedi Ora
Accedi per seguire   
Seguaci 0