--- start upload.asp ---
<%
'############## ############### ############### ############### ############### #
###
'#
http://www.asp101.com/articles/jacob/scriptupload.asp
'############## ############### ############### ############### ############### #
###
'
'************** *************** **********
' File: Upload.asp
' Author: Jacob "Beezle" Gilley
' Email:
av***@airmail.n et
' 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!
'************** *************** ***********
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initializ e()
Set Files = Server.CreateOb ject("Scripting .Dictionary")
Set mcolFormElem = Server.CreateOb ject("Scripting .Dictionary")
End Sub
Private Sub Class_Terminate ()
If IsObject(Files) Then
Files.RemoveAll ()
Set Files = Nothing
End If
If IsObject(mcolFo rmElem) Then
mcolFormElem.Re moveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Ex ists(LCase(sInd ex)) Then Form =
mcolFormElem.It em(LCase(sIndex ))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryR ead(Request.Tot alBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegi n, 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(nDataBou ndPos, biData, CByteString("Co ntent-Disposition"))
nPos = InstrB(nPos, biData, CByteString("na me="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegi n, biData, CByteString(Chr (34)))
sInputName = CWideString(Mid B(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBou ndPos, biData, CByteString("fi lename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegi n, biData, CByteString(Chr (34)))
sFileName = CWideString(Mid B(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.Fil eName = Right(sFileName ,
Len(sFileName)-InStrRev(sFileN ame, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Co ntent-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegi n, biData, CByteString(Chr (13)))
oUploadFile.Con tentType = CWideString(Mid B(biData, nPosBegin,
nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegi n, biData, vDataBounds) - 2
oUploadFile.Fil eData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If oUploadFile.Fil eSize > 0 Then Files.Add LCase(sInputNam e),
oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr (13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegi n, biData, vDataBounds) - 2
If Not mcolFormElem.Ex ists(LCase(sInp utName)) Then mcolFormElem.Ad d
LCase(sInputNam e), CWideString(Mid B(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBou ndPos + LenB(vDataBound s), biData,
vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sSt ring)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(s String,nIndex,1 )))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsS tring)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(b sString,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(sPat h)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateOb ject("Scripting .FileSystemObje ct")
If Not oFS.FolderExist s(sPath) Then Exit Sub
Set oFile = oFS.CreateTextF ile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(F ileData,nIndex, 1)))
Next
oFile.Close
End Sub
Public Sub SaveToDatabase( ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField ) Then
oField.AppendCh unk FileData
End If
End Sub
Public function binary()
binary = FileData
End function
End Class
%>
--- koniec upload.asp ---
--- start : wykorzystanie w aplikacji ----
Dim Uploader, File
Set Uploader = New FileUploader
Uploader.Upload ()
For Each File In Uploader.Files. Items
dim RS
Set RS = Server.CreateOb ject("ADODB.Rec ordset")
RS.Open "select foto from WYROBY where ID = " & admin_wyr_id,
application("sh opman") , 2, 2
File.SaveToData base RS("foto")
' Commit the changes and close
RS.Update
RS.Close
Next
--- koniec : wykorzystanie w aplikacji ----
