p2p.wrox.com Forums

p2p.wrox.com Forums (http://p2p.wrox.com/index.php)
-   Classic ASP Databases (http://p2p.wrox.com/forumdisplay.php?f=62)
-   -   How to upload a picture (http://p2p.wrox.com/showthread.php?t=38981)

grstad February 24th, 2006 08:01 AM

How to upload a picture
 
Hei!

How do I make my visitors able to
upload their picture into my web-sites access-db?

Regards from grstad

[:I]


Steweb February 27th, 2006 07:19 PM

... I am very good !!!

with classic ASP

file Upload.asp

Code:

<%
Class FileUploader
Public Files
Private mcolFormElem

Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub

Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property

Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosFile1, nPosFile2, nPosBound

biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

If (nPosEnd-nPosBegin) <= 0 Then Exit Sub

vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))

nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

'//////////////////////////
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))

nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName, sFileName1, sFileName2
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))

'//////////////////////////
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

'//////////////////////////
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))

oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))

nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)

If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If

nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub

'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next

End Function

'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class

Class UploadedFile
Public ContentType
Public FileName
Public FileData

Public Property Get FileSize()
FileSize = LenB(FileData)
End Property

Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex

Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub

'///////////////////////////////////////////////////////////////////
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close


End Sub

Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub

If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub

End Class
%>

flie your_name.asp


Code:

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>

<%
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@  Variabili da settare di sistema  @@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

' Stringa di connessione a DB access
' metti il nome del tuo DB se lasci cosi il DB è sulla stessa cartella di questo file
' Se il DB è su una cartella metterai Server.MapPath("\nome_cartella\nome_DB.mdb")
strConn="driver={Microsoft Access Driver (*.mdb)};  DBQ=" & Server.MapPath("a_dbimage.mdb")

' percorso delle immagini in questo caso c'è una cartella upload dove vanno fisicamente a finire le immagini
percorso_img = "\Upload\"

dim categoria
dim filename
dim descrizione
dim msg

'Set Conn=Server.CreateObject("ADODB.Connection")
Set Uploader = New FileUploader

Uploader.Upload()

if Uploader.Form("submit")<>"" then
    filename=Uploader.Form("file")
    categoria=Uploader.Form("categoria")
    descrizione=Uploader.Form("descrizione")

    call SaveRecord()
End if


Sub SaveRecord()

dim rs, conn

set conn = server.CreateObject("Adodb.Connection")
set rs = server.CreateObject("Adodb.Recordset")

Conn.Open strConn
'-----------------------------------------------------------------
if Uploader.Files.count <> 0 then
File = Uploader.Files.Items()
File(0).SavetoDisk Server.MapPath(percorso_img)
filename = File(0).Filename
else
response.redirect("formfile.asp")
End if


if Uploader.Form("id")="" then
    rs.open "Select * From images",conn,2,3

     rs.addnew
     rs.fields("foto") = percorso_img&filename
     rs.fields("categoria") = categoria
     rs.fields("descrizione")= descrizione
     rs.update

        msg = "La foto(<B>"&Filename&"</B>) è stata salvata sul server ! "
        saved = true

End if


rs.close
conn.close
set rs = nothing
set conn = nothing

End Sub


%>
<html>
<head>
<title>No title</title>
<meta name="generator" content="Microsoft FrontPage 5.0">
</head>

<body bgcolor="white" text="black" link="blue" vlink="purple" alink="red" topmargin="0" marginheight="0">
<table border="0" align="center" width="780" cellpadding="0" cellspacing="0">
  <tr>
    <td width="100%" height="3" colspan="3"> </td>
  </tr>
  <tr>
    <td width="550" height="382" > <p align="center" style="margin-bottom:1;"><%= msg%> </p>
      <form action="" method="post" enctype="multipart/form-data" name="form1" style="line-height:1; margin-top:1; margin-bottom:1;">
        <div align="center">
          <table border="1" align="center" cellpadding="1" cellspacing="1" bordercolor="#9FC0DF" bordercolordark="#9FC0DF" bordercolorlight="#9FC0DF" width="444">
            <tr>
              <td height="23" colspan="2" bgcolor="#9FC0DF" width="436"><b>Inserimento
                Foto</b></td>
            </tr>
            <tr>
              <td width="436" height="15">&nbsp;</td>
              <td width="306">&nbsp; </td>
            </tr>
            <tr>
              <td width="436">Tipologia Foto</td>
              <td width="306"> <select name="categoria" size="1" id="categoria">
                  <option value="Categoria 1">Categoria 1</option>
                  <option value="Categorie 2">Categoria 2</option>
                  <option value="Categorie 3">Categorie 3</option>
                </select> </td>
            </tr>
            <tr>
              <td valign="top" width="436">Immagine</td>
              <td width="306"> <input type="file" name="file" size="20"> </td>
            </tr>
            <tr>
              <td valign="top" width="436">&nbsp;</td>
              <td width="306">&nbsp; </td>
            </tr>
            <tr>
              <td valign="top" width="436">Deescrizione
                Immagine </td>
              <td width="306"><textarea name="descrizione" cols="30" rows="5" id="descrizione"></textarea></td>
            </tr>
            <tr>
              <td colspan="2" width="436"> <p align="center">ATTENZIONE
                  : tutti i campi sono obbligatori</p></td>
            </tr>
            <tr>
              <td height="26" width="436">&nbsp;
              </td>
              <td width="306"><input type="submit" name="Submit" value="Submit">
                <input type="reset" name="Submit2" value="Reset"> </td>
            </tr>
          </table>
        </div>
        <p style="line-height:2; margin-top:0; margin-bottom:0;" align="center">
          <input name="id" type="hidden" id="id" value="<%=request.querystring("id")%>">
          <a href="visualizza_img.asp">Visualizza tutte le foto inserite</a></p>
      </form>
      <p style="line-height:0; margin-top:0; margin-bottom:0;" align="center">&nbsp;
      </p></td>
  </tr>
  <tr>
    <td width="100%" height="5" colspan="3">  </td>
  </tr>
</table>

</body>

</html>


:):D:)

Hello
Steweb




Visit my web site !
www.steweb.net

Imar February 28th, 2006 03:15 AM

Quote:

quote:Originally posted by Steweb... I am very good !!!
at Googling and copying and pasting ;)

If you do so (nothing wrong with that), you may also want to provide the original copy right notice and a link to the code:

'***************************************
' File: Upload.asp
' Author: Jacob "Beezle" Gilley
' Email: avis7@airmail.net
' Date: 12/07/2000
' Comments: The code for the Upload, CByteString,
' CWideString subroutines was originally
' written by Philippe Collignon...or so
' he claims. Also, I am not responsible
' for any ill effects this script may
' cause and provide this script "AS IS".
' Enjoy!
'****************************************

http://www.koders.com/asp/fid6BC392E...8A2BB139A.aspx


Imar
---------------------------------------
Imar Spaanjaars
Everyone is unique, except for me.

Steweb February 28th, 2006 08:13 AM

Hi Imar !

... Realy I don't say that I have write class Upload !!

My good is only because I have reply a possible solution for grstad !

I know realy only now Author this class! Thanks Imar

I make copying and pasting this Comments in this class


Enjoy!

Steweb





Visit my web site !
www.steweb.net

Imar February 28th, 2006 09:15 AM

Quote:

quote:Originally posted by Steweb
My good is only because I have reply a possible solution for grstad
I know; I was just making a joke.

Sorry if you thought my answer was inappropriate....

Imar
---------------------------------------
Imar Spaanjaars
Everyone is unique, except for me.

grstad February 28th, 2006 02:20 PM

Hei!

I am sure the cut and past answer tell it all, but I will try to understand the last italian code(!)[8D] The job will be to make it fit into my own case... Tank you steweb!

Mvh grstad



All times are GMT -4. The time now is 09:48 PM.

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.