Click to See Complete Forum and Search --> : Buying Aspupload


ASPSQLVB
12-23-2006, 07:30 PM
Guys,

I have given up trying to figure out how to upload images to a web server.

So, to make it easy can someone suggest a script I can purchase that is good.
All the free scripts and I cannot piece it together so it works in my project.
Last alternative is buying the script.

Any advice would be greatly appreciated.

russell
12-23-2006, 09:46 PM
given up, or almost given up?

here is the Persists ASPUpload (http://www.aspupload.com/) dll you are looking for.

what problems are u running in to? coding problems or permissions problems?

persists product works fine. still, it isnt too difficult to create your own. if u need help, post back with specific issues. else, go ahead and buy persists. however, if your issues are permissions problems, that wont make 'em go away.

ASPSQLVB
12-23-2006, 10:03 PM
Hey Russell,

Its not permission problems.....its coding problems. The couple of free scripts I tried using did not work out. Its been two weeks.........LOL. I am desperate now.
So, Russell......I basically am trying to upload an image file to a directory on a web server. I would then reference the path thats stored in the database so the image can than be displayed in my HTML document.
I already have the HTML and database done....Its just the scripting.

russell
12-23-2006, 10:48 PM
may i see the html for the form please? i'll try to help. how is your asp skills? and what db are u using?

ASPSQLVB
12-23-2006, 10:53 PM
ASP is decent.....

UPLOAD.HTM<HTML>
<HEAD>
<TITLE>File upload test form</TITLE>
</HEAD>
<BODY>

<FORM ACTION=up.asp METHOD=POST enctype="multipart/form-data" id=form1 name=form1>
<BR><INPUT TYPE=text NAME=filename>
<BR><INPUT name=file1 type="file">
<BR><INPUT type=submit>
</FORM>

</BODY>
</HTML>

UP.ASP
<!-- #include file="upload.asp" -->
<%

Upload_ProcessRequest

Response.Write "Process outcome: " & Upload_Outcome

Dim Field
For Each Field in Upload_FormFields.Items
Response.Write "<BR>Form fields: " & Field
Next

Dim File
For Each File in Upload_FormFiles.Keys
Response.Write "<BR>You upped: " & Upload_FormFiles.Item(File) & " as " & File
'Size = Upload_SaveFile(File, Server.MapPath(Upload_FormFiles.Item(File)))

Size = Upload_SaveFile(File, Server.MapPath("/aspsqlvb/keenesolutions.com/images.Item(File)"))

Response.Write "<BR>Saved " & Upload_FormFiles.Item(File) & ", size=" & Size
Next
Response.Write File
Response.End
%>
UPLOAD.ASP
<%
Dim Upload_FormFields, Upload_FormFiles, Upload_Data, Upload_Outcome
Set Upload_FormFields = Server.CreateObject("Scripting.Dictionary")
Set Upload_FormFiles = Server.CreateObject("Scripting.Dictionary")
Set Upload_Data = Server.CreateObject("ADODB.Recordset")

If Upload_MaxFileSize = "" Then Upload_MaxFileSize = 10485760 ' 10 MB

With Upload_Data
.Fields.Append "fieldname", adVarchar, 255
.Fields.Append "filename", adVarchar, 255
.Fields.Append "size", adBigInt
.Fields.Append "bytes", adBinary , 10485760 ' 10 MB
.Open
End With

Function Upload_ProcessRequest()

' used to track various positions
dim PosB, PosBBound, PosEBound, PosEHead, PosBFld, PosEFld

' these handle the data
dim Boundary, BBoundary, PartBHeader, PartAHeader, PartContent, PartContent2, Binary

' for writing and converting
dim fso, fle, rst, DataString, FileName

' various other
dim I, Length, ContType, PartName, LastPart, BCrlf, PartContentLength

' must be submitted using POST
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then

ContType = Request.ServerVariables("HTTP_Content_Type")
' must be "multipart/form-data"
If LCase(Left(ContType, 19)) = "multipart/form-data" Then

PosB = InStr(LCase(ContType), "boundary=") 'get boundary
If PosB > 0 Then Boundary = Mid(ContType, PosB + 9) 'we have one

'bugfix IE5.01 - double header
PosB = InStr(LCase(ContType), "boundary=")
If PosB > 0 then
PosB = InStr(Boundary, ",")
If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)
end if

Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
End If

If Length > 0 And Boundary <> "" Then
Boundary = "--" & Boundary

' get request, binary
Binary = Request.BinaryRead(Length)

' convert boundry to binary
For I=1 to len(Boundary)
BBoundary = BBoundary & ChrB(Asc(Mid(Boundary,I,1)))
Next
'Response.Write BBoundary
'Response.End
' binary crlf
BCrlf = ChrB(Asc(vbCr)) & ChrB(Asc(vbLf))

' get begin and end of first boundary
PosBBound = InStrB(Binary, BBoundary)
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary, 0)

' keep doing until we had them all
Do While (PosBBound > 0 And PosEBound > 0)

' get position of the end of the header
PosEHead = InStrB(PosBBound + LenB(BBoundary), Binary, BCrlf & BCrlf)

' get content of header and convert to string
PartBHeader = MidB(Binary, PosBBound + LenB(BBoundary) + 2, PosEHead - PosBBound - LenB(BBoundary) - 2)
PartAHeader = ""
'Response.Write PartBHeader
'Response.End
For I=1 to lenb(PartBHeader)
PartAHeader = PartAHeader & Chr(AscB(MidB(PartBHeader,I,1)))
Next

' make sure we end it with ;
If Right(PartAHeader,1) <> ";" Then PartAHeader = PartAHeader & ";"

' get content of this part
PartContent = MidB(Binary, PosEHead + 4, PosEBound - (PosEHead + 4) - 2)

' get name of part
PosBFld = Instr(lcase(PartAHeader),"name=")

If PosBFld > 0 Then
' name found
PosEFld = Instr(PosBFld,lcase(PartAHeader),";")
If PosEFld > 0 Then
' well-formed name header
PartName = Mid(PartAHeader,PosBFld+5,PosEFld-PosBFld-5)
end if
' chop of leading and trailing "'s
Do Until Left(PartName,1) <> """"
PartName = Mid(PartName,2)
Loop
Do Until Right(PartName,1) <> """"
PartName = Left(PartName,Len(PartName)-1)
Loop
end if

' get file name of part (if any)
PosBFld = Instr(lcase(PartAHeader),"filename=""")
If PosBFld > 0 Then
' content header found
PosEFld = Instr(PosBFld + 10,lcase(PartAHeader),"""")
If PosEFld > 0 Then
' well-formed content header
FileName = Mid(PartAHeader,PosBFld+10,PosEFld-PosBFld-10)
end if
' chop of leading and trailing "'s
Do Until Left(FileName,1) <> """"
FileName = Mid(FileName,2)
Loop
'Response.Write FileName
'Response.end
Do Until Right(FileName,1) <> """"
FileName = Left(FileName,Len(FileName)-1)

Loop
Else
' not a file, regular field
FileName = ""
end if

' do conversion of binary to regular data
' at the end, datastring will contain 'readable' data
' is this wide-byte binary data?
if vartype(PartContent) = 8 then
' need to do some conversion
Set rst = CreateObject("ADODB.Recordset")
PartContentLength = LenB(PartContent)
if PartContentLength > 0 then
' data, so add to recordset to speed up conversion
rst.Fields.Append "Bitmap", adLongVarBinary, PartContentLength
rst.Open
rst.AddNew
rst("Bitmap").AppendChunk PartContent & ChrB(0)
rst.Update
PartContent2 = rst("Bitmap").GetChunk(PartContentLength)
rst.close
set rst = nothing
else
' no data?
PartContent2 = ChrB(0)
End If
else
' no need for conversion
PartContent2 = PartContent
end if

PartContentLength = LenB(PartContent2)
if PartContentLength > 0 then
' we have data to convert
Set Conn = Server.CreateObject("ADODB.Connection")

Set rst = CreateObject("ADODB.Recordset")
rst.Fields.Append "Bitmap", adLongVarChar, PartContentLength
rst.Open
rst.AddNew
rst("Bitmap").AppendChunk PartContent2
rst.Update
DataString = rst("Bitmap")
rst.close
set rst = nothing
Else
' nothing to convert
dataString = ""
End If
'Response.Write PartContent2
'Response.End
' conversion has been done, now what to do with it

If FileName <> "" Then
'Response.Write FileName
'Response.End
' we have a file, let's save it to disk

FileName = Mid(Filename,InstrRev(FileName,"\")+1) '//////////////////////I THINK I NEED TO CHANGE THE FOLDER TO IMAGES
'Response.Write Mid(Filename,InstrRev(FileName,"\")+1)
'Response.End
With Upload_Data
.AddNew
.Fields("fieldname").Value = Partname
.Fields("filename").Value = FileName
.Fields("size").Value = Len(datastring)
.Fields("bytes").AppendChunk datastring
.Update
End with
'Response.Write Len(datastring)
'Response.End
Upload_FormFiles.Add Partname, Filename
'Response.Write Partname & " " & Filename & " " & datastring
'Response.End

else

' some other type of field, let's just output this
Upload_FormFields.Add Partname, Datastring

End If

LastPart = MidB(Binary, PosEBound + LenB(BBoundary), 2)
'Response.Write LastPart
'Response.End
If LastPart = ChrB(Asc("-")) & ChrB(Asc("-")) Then
' don't look for others
PosBBound = 0
PosEBound = 0
else
' look for others
PosBBound = PosEBound
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary)

End If
'Response.Write PosEBound
'Response.End
loop

Upload_Outcome = "+OK"

else

Upload_Outcome = "-INVALID_REQUEST"

end if

else

Upload_Outcome = "-NOPOST"

end if

end function

Function Upload_SaveFile(FieldName, FileName)

Upload_Data.MoveFirst

Do Until Upload_Data.EOF

If Upload_Data("fieldname").Value = FieldName Then
'Response.Write FileName
'Response.End
' open a file (textstream)
set fso = Server.CreateObject("Scripting.Filesystemobject")

set fle = fso.CreateTextFile(FileName & "." & t)
' write the data
DataString = Upload_Data("bytes").GetChunk(Upload_Data("bytes").ActualSize)

fle.write DataString
fle.close

Upload_SaveFile = len(DataString)

' cleanup
set fle = nothing
set fso = nothing

Exit Do

End If
Loop


End Function



%>

russell
12-23-2006, 11:53 PM
this isnt quite how i'd do it, but i dont see any glaring problems. what happens when u run it? errors, or just nothing?

anyway, tired its late. i'll post back tomorrow with a generic file upload that works.

russell
12-25-2006, 08:38 PM
ok, sorry, i took a little holiday break. here is a method that i know works. it is adapted originally from free asp upload which can be found here (http://www.freeaspupload.net/freeaspupload/download.asp), then another script originally written by a great programmer named Kenny Le.

first, 2 class files. these should be included at the top of the page that processes the form.


<%
Class clsFile

'' http://www.freeaspupload.net/freeaspupload/download.asp
Public ContentType
Public Start
Public Length
Public Path
Private nameOfFile

' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = fN
nameOfFile = SubstNoReg(nameOfFile, "\", "_")
nameOfFile = SubstNoReg(nameOfFile, "/", "_")
nameOfFile = SubstNoReg(nameOfFile, ":", "_")
nameOfFile = SubstNoReg(nameOfFile, "*", "_")
nameOfFile = SubstNoReg(nameOfFile, "?", "_")
nameOfFile = SubstNoReg(nameOfFile, """", "_")
nameOfFile = SubstNoReg(nameOfFile, "<", "_")
nameOfFile = SubstNoReg(nameOfFile, ">", "_")
nameOfFile = SubstNoReg(nameOfFile, "|", "_")
End Property

Public Property Get FileName()
FileName = nameOfFile
End Property

Function SubstNoReg(initialStr, oldStr, newStr)
Dim currentPos, oldStrPos, skip
If IsNull(initialStr) Or Len(initialStr) = 0 Then
SubstNoReg = ""
ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
SubstNoReg = initialStr
Else
If IsNull(newStr) Then newStr = ""
currentPos = 1
oldStrPos = 0
SubstNoReg = ""
skip = Len(oldStr)
Do While currentPos <= Len(initialStr)
oldStrPos = InStr(currentPos, initialStr, oldStr)
If oldStrPos = 0 Then
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
currentPos = Len(initialStr) + 1
Else
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
currentPos = oldStrPos + skip
End If
Loop
End If
End Function

End Class
%>



<%
Class clsUpload

Public dFiles
Public dFormFields

Private bstrData
Private bstream
Private isUploaded

Private Sub Class_Initialize()
Set dFiles = Server.CreateObject("Scripting.Dictionary")
Set dFormFields = Server.CreateObject("Scripting.Dictionary")
Set bstream = Server.CreateObject("ADODB.Stream")

bstream.Type = 1
bstream.Open
isUploaded = false
End Sub

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

If IsObject(dFormFields) Then
dFormFields.RemoveAll()
Set dFormFields = Nothing
End If
bstream.Close
Set bstream = Nothing
End Sub

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

Public Property Get Files()
Files = dFiles.Items
End Property

Public Sub Save(path)
Dim streamFile, fileItem

If Right(path, 1) <> "\" Then path = path & "\"

If not isUploaded then Upload

For Each fileItem In dFiles.Items
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
bstream.Position = fileItem.Start
bstream.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close

Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub

Private Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr

'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:")

isUploaded = true

bstrData = 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 = MidB(bstrData, 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 = getValue(tDoubleQuotes, nCurPos)

nPosFile = FindToken(tFilename, nCurPos)
nPosBound = FindToken(vDataSep, nCurPos)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile
Set oUploadFile = New clsFile

nCurPos = SkipToken(tFilename, nCurPos)
auxStr = getValue(tDoubleQuotes, nCurPos)

'' check unix style path
osPathSep = "\"
If InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))

If (Len(oUploadFile.FileName) > 0) then 'File field not left empty
nCurPos = SkipToken(tContentType, nCurPos)

auxStr = getValue(tNewLine, nCurPos)
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line

oUploadFile.Start = nCurPos-1
oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

If oUploadFile.Length > 0 Then dFiles.Add LCase(sFieldName), oUploadFile
End If
Else
Dim nEndOfData
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not dFormFields.Exists(LCase(sFieldName)) Then
dFormFields.Add LCase(sFieldName), String2Byte(MidB(bstrData, nCurPos, nEndOfData-nCurPos))
else
dFormFields.Item(LCase(sFieldName))= dFormFields.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(bstrData, nCurPos, nEndOfData-nCurPos))
end if

End If

nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
bstream.Write(bstrData)
End Sub

Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, bstrData, 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, bstrData, sToken)
End Function

Private Function getValue(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, bstrData, sToken)
If nEnd = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end If
getValue = String2Byte(MidB(bstrData, nStart, nEnd-nStart))
End Function

Private Function Byte2String(sString)
Dim i
For i = 1 to Len(sString)
Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))
Next
End Function

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
%>

here is a sample file to utilize the classes:

<!--#Include Virtual="/lib/class/clsUpload.asp"-->
<!--#Include Virtual="/lib/class/clsFile.asp"-->
<%
Dim oUpload
Set oUpload = New clsUpload
If Request.TotalBytes > 0 Then
oUpload.Save("c:\tmp\")
End If

set oUpload = Nothing
%>
<form name="upload" method=post encType="multipart/form-data" action="1.asp">
<input name=f1 type=file>
<br><input type=text name=fname>
<input type=submit>
</form>

russell
12-25-2006, 08:45 PM
Note one important omission from the form -- we do not allow the user to enter a description or name of the file. there are 2 reasons for this:
(1) it is a lot easier if we have a form just for file uploading and nothing else and (2) it is never a good idea to let users name files. a better solution is to simply accept the file name, then rename it with a randomly generated file name. we can store the original name and our new name in the database if we like. Why, you ask? Because if someone uploads a malicious file, they are going to try to execute it. Much better if they dont know the name of it. This won't stop a serious hacker maybe, but it will stop the easy automated attacks -- which happen to be the most common kind.

Note that the class files do not need to be modified unless you want to parse more form data than just the file upload, or want to add in the file name randomizer. I'll be happy to show code for both if you want.

only thing needs to be modified is the oUpload.Save("c:\tmp\") call in the form processing script, passing the path where you want the files actually saved. remeber the service account will need modify permission on the directory where files are stored.

Merry Xmas. Psot back with any questions
Russell

ASPSQLVB
12-26-2006, 11:59 AM
Hi Russell......

I know this sounds silly but, can u point to the code were it needs to be changed?.....thank you.

Dim Upload_FormFields, Upload_FormFiles, Upload_Data, Upload_Outcome
Set Upload_FormFields = Server.CreateObject("Scripting.Dictionary")
Set Upload_FormFiles = Server.CreateObject("Scripting.Dictionary")
Set Upload_Data = Server.CreateObject("ADODB.Recordset")

If Upload_MaxFileSize = "" Then Upload_MaxFileSize = 10485760 ' 10 MB

With Upload_Data
.Fields.Append "fieldname", adVarchar, 255
.Fields.Append "filename", adVarchar, 255
.Fields.Append "size", adBigInt
.Fields.Append "bytes", adBinary , 10485760 ' 10 MB
.Open
End With

Function Upload_ProcessRequest()

' used to track various positions
dim PosB, PosBBound, PosEBound, PosEHead, PosBFld, PosEFld

' these handle the data
dim Boundary, BBoundary, PartBHeader, PartAHeader, PartContent, PartContent2, Binary

' for writing and converting
dim fso, fle, rst, DataString, FileName

' various other
dim I, Length, ContType, PartName, LastPart, BCrlf, PartContentLength

' must be submitted using POST
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then

ContType = Request.ServerVariables("HTTP_Content_Type")
' must be "multipart/form-data"
If LCase(Left(ContType, 19)) = "multipart/form-data" Then

PosB = InStr(LCase(ContType), "boundary=") 'get boundary
If PosB > 0 Then Boundary = Mid(ContType, PosB + 9) 'we have one

'bugfix IE5.01 - double header
PosB = InStr(LCase(ContType), "boundary=")
If PosB > 0 then
PosB = InStr(Boundary, ",")
If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)
end if

Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
End If

If Length > 0 And Boundary <> "" Then
Boundary = "--" & Boundary

' get request, binary
Binary = Request.BinaryRead(Length)

' convert boundry to binary
For I=1 to len(Boundary)
BBoundary = BBoundary & ChrB(Asc(Mid(Boundary,I,1)))
Next
'Response.Write BBoundary
'Response.End
' binary crlf
BCrlf = ChrB(Asc(vbCr)) & ChrB(Asc(vbLf))

' get begin and end of first boundary
PosBBound = InStrB(Binary, BBoundary)
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary, 0)

' keep doing until we had them all
Do While (PosBBound > 0 And PosEBound > 0)

' get position of the end of the header
PosEHead = InStrB(PosBBound + LenB(BBoundary), Binary, BCrlf & BCrlf)

' get content of header and convert to string
PartBHeader = MidB(Binary, PosBBound + LenB(BBoundary) + 2, PosEHead - PosBBound - LenB(BBoundary) - 2)
PartAHeader = ""
'Response.Write PartBHeader
'Response.End
For I=1 to lenb(PartBHeader)
PartAHeader = PartAHeader & Chr(AscB(MidB(PartBHeader,I,1)))
Next

' make sure we end it with ;
If Right(PartAHeader,1) <> ";" Then PartAHeader = PartAHeader & ";"

' get content of this part
PartContent = MidB(Binary, PosEHead + 4, PosEBound - (PosEHead + 4) - 2)

' get name of part
PosBFld = Instr(lcase(PartAHeader),"name=")

If PosBFld > 0 Then
' name found
PosEFld = Instr(PosBFld,lcase(PartAHeader),";")
If PosEFld > 0 Then
' well-formed name header
PartName = Mid(PartAHeader,PosBFld+5,PosEFld-PosBFld-5)
end if
' chop of leading and trailing "'s
Do Until Left(PartName,1) <> """"
PartName = Mid(PartName,2)
Loop
Do Until Right(PartName,1) <> """"
PartName = Left(PartName,Len(PartName)-1)
Loop
end if

' get file name of part (if any)
PosBFld = Instr(lcase(PartAHeader),"filename=""")
If PosBFld > 0 Then
' content header found
PosEFld = Instr(PosBFld + 10,lcase(PartAHeader),"""")
If PosEFld > 0 Then
' well-formed content header
FileName = Mid(PartAHeader,PosBFld+10,PosEFld-PosBFld-10)
end if
' chop of leading and trailing "'s
Do Until Left(FileName,1) <> """"
FileName = Mid(FileName,2)
Loop
'Response.Write FileName
'Response.end
Do Until Right(FileName,1) <> """"
FileName = Left(FileName,Len(FileName)-1)

Loop
Else
' not a file, regular field
FileName = ""
end if

' do conversion of binary to regular data
' at the end, datastring will contain 'readable' data
' is this wide-byte binary data?
if vartype(PartContent) = 8 then
' need to do some conversion
Set rst = CreateObject("ADODB.Recordset")
PartContentLength = LenB(PartContent)
if PartContentLength > 0 then
' data, so add to recordset to speed up conversion
rst.Fields.Append "Bitmap", adLongVarBinary, PartContentLength
rst.Open
rst.AddNew
rst("Bitmap").AppendChunk PartContent & ChrB(0)
rst.Update
PartContent2 = rst("Bitmap").GetChunk(PartContentLength)
rst.close
set rst = nothing
else
' no data?
PartContent2 = ChrB(0)
End If
else
' no need for conversion
PartContent2 = PartContent
end if

PartContentLength = LenB(PartContent2)
if PartContentLength > 0 then
' we have data to convert
Set Conn = Server.CreateObject("ADODB.Connection")

Set rst = CreateObject("ADODB.Recordset")
rst.Fields.Append "Bitmap", adLongVarChar, PartContentLength
rst.Open
rst.AddNew
rst("Bitmap").AppendChunk PartContent2
rst.Update
DataString = rst("Bitmap")
rst.close
set rst = nothing
Else
' nothing to convert
dataString = ""
End If
'Response.Write PartContent2
'Response.End
' conversion has been done, now what to do with it

If FileName <> "" Then
'Response.Write FileName
'Response.End
' we have a file, let's save it to disk

FileName = Mid(Filename,InstrRev(FileName,"\")+1) '//////////////////////I THINK I NEED TO CHANGE THE FOLDER TO IMAGES
'Response.Write Mid(Filename,InstrRev(FileName,"\")+1)
'Response.End
With Upload_Data
.AddNew
.Fields("fieldname").Value = Partname
.Fields("filename").Value = FileName
.Fields("size").Value = Len(datastring)
.Fields("bytes").AppendChunk datastring
.Update
End with
'Response.Write Len(datastring)
'Response.End
Upload_FormFiles.Add Partname, Filename
'Response.Write Partname & " " & Filename & " " & datastring
'Response.End

else

' some other type of field, let's just output this
Upload_FormFields.Add Partname, Datastring

End If

LastPart = MidB(Binary, PosEBound + LenB(BBoundary), 2)
'Response.Write LastPart
'Response.End
If LastPart = ChrB(Asc("-")) & ChrB(Asc("-")) Then
' don't look for others
PosBBound = 0
PosEBound = 0
else
' look for others
PosBBound = PosEBound
PosEBound = InStrB(PosBBound + LenB(BBoundary), Binary, BBoundary)

End If
'Response.Write PosEBound
'Response.End
loop

Upload_Outcome = "+OK"

else

Upload_Outcome = "-INVALID_REQUEST"

end if

else

Upload_Outcome = "-NOPOST"

end if

end function

Function Upload_SaveFile(FieldName, FileName)

Upload_Data.MoveFirst

Do Until Upload_Data.EOF

If Upload_Data("fieldname").Value = FieldName Then
'Response.Write FileName
'Response.End
' open a file (textstream)
set fso = Server.CreateObject("Scripting.Filesystemobject")

set fle = fso.CreateTextFile(FileName & "." & t)
' write the data
DataString = Upload_Data("bytes").GetChunk(Upload_Data("bytes").ActualSize)

fle.write DataString
fle.close

Upload_SaveFile = len(DataString)

' cleanup
set fle = nothing
set fso = nothing

Exit Do

End If
Loop


End Function

russell
12-26-2006, 12:14 PM
what happens when u execute it?

ASPSQLVB
12-26-2006, 12:31 PM
Path not found
/InputFile/upload.asp, line 302

ASPSQLVB
12-26-2006, 12:36 PM
This is what I get when I d a Response.Writ FileName before the error line:

Process outcome: +OK
Form fields: Ken
You upped: BoilieShopLogo.jpg as file1c:\inetpub\wwwroot\aspsqlvb\keenesolutions.com\images.Item(File)

Russell.....I cannot find where this path is coming from. I would like to change it to the path that is on the web server. Not on my local hard drive.

russell
12-26-2006, 01:13 PM
change this line

set fle = fso.CreateTextFile(FileName & "." & t)
to the right path.

of course, if u use the code i posted, it gets easier.

ASPSQLVB
12-26-2006, 01:21 PM
Oh, Sorry Russell. I just noticed the code you posted. GEEZ.......I did not look above to see the code. My fault. I will try this again. I'll get back to you soon.

ASPSQLVB
12-26-2006, 02:11 PM
Ok, Russell.......I ran it and I am getting this error.

Error Type:
Microsoft VBScript compilation (0x800A0401)
Expected end of statement
/InputFile/up.asp, line 12, column 19
form name="upload" method=post encType="multipart/form-data" action="up.asp"
------------------^

ASPSQLVB
12-26-2006, 02:15 PM
Forget about the revious ERROR. Here is the New Error.

Error Type:
ADODB.Stream (0x800A0BBC)
Write to file failed.
/InputFile/upload2.asp, line 57

<%
Class clsUpload

Public dFiles
Public dFormFields

Private bstrData
Private bstream
Private isUploaded

Private Sub Class_Initialize()
Set dFiles = Server.CreateObject("Scripting.Dictionary")
Set dFormFields = Server.CreateObject("Scripting.Dictionary")
Set bstream = Server.CreateObject("ADODB.Stream")

bstream.Type = 1
bstream.Open
isUploaded = false
End Sub

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

If IsObject(dFormFields) Then
dFormFields.RemoveAll()
Set dFormFields = Nothing
End If
bstream.Close
Set bstream = Nothing
End Sub

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

Public Property Get Files()
Files = dFiles.Items
End Property

Public Sub Save(path)
Dim streamFile, fileItem

If Right(path, 1) <> "\" Then path = path & "\"

If not isUploaded then Upload

For Each fileItem In dFiles.Items
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
bstream.Position = fileItem.Start
bstream.CopyTo streamFile, fileItem.Length
ERROR LINE streamFile.SaveToFile path & fileItem.FileName, 2 streamFile.close

Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub

Private Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr

'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:")

isUploaded = true

bstrData = 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 = MidB(bstrData, 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 = getValue(tDoubleQuotes, nCurPos)

nPosFile = FindToken(tFilename, nCurPos)
nPosBound = FindToken(vDataSep, nCurPos)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile
Set oUploadFile = New clsFile

nCurPos = SkipToken(tFilename, nCurPos)
auxStr = getValue(tDoubleQuotes, nCurPos)

'' check unix style path
osPathSep = "\"
If InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))

If (Len(oUploadFile.FileName) > 0) then 'File field not left empty
nCurPos = SkipToken(tContentType, nCurPos)

auxStr = getValue(tNewLine, nCurPos)
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line

oUploadFile.Start = nCurPos-1
oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

If oUploadFile.Length > 0 Then dFiles.Add LCase(sFieldName), oUploadFile
End If
Else
Dim nEndOfData
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not dFormFields.Exists(LCase(sFieldName)) Then
dFormFields.Add LCase(sFieldName), String2Byte(MidB(bstrData, nCurPos, nEndOfData-nCurPos))
else
dFormFields.Item(LCase(sFieldName))= dFormFields.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(bstrData, nCurPos, nEndOfData-nCurPos))
end if

End If

nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
bstream.Write(bstrData)
End Sub

Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, bstrData, 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, bstrData, sToken)
End Function

Private Function getValue(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, bstrData, sToken)
If nEnd = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end If
getValue = String2Byte(MidB(bstrData, nStart, nEnd-nStart))
End Function

Private Function Byte2String(sString)
Dim i
For i = 1 to Len(sString)
Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))
Next
End Function

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
%>

russell
12-26-2006, 02:47 PM
streamFile.SaveToFile path & fileItem.FileName, 2 ----> streamFile.close

needs to be on 2 lines

ASPSQLVB
12-26-2006, 02:58 PM
Yes!!!!!!!!!!!!!!!!! She's working Russel!!!!!!!

I am so HAPPY!!!.....Russell, I am sure I wil have a question in reference to Uploadng Images in the Near future. I will keep playing with this until it is totally done.
Some HUGE progress has just been made.

Thank You SOOOOOO Much Russell!! You absolutely mad my day.

russell
12-26-2006, 03:21 PM
glad to help :) u have been fighting this too long. very cool to get it working. always feel free to post back. we all have problems from time to time and a lot of good people here like to help out.

cheers.
russell

ASPSQLVB
12-26-2006, 03:34 PM
Russell, now the path I want to store the pictures in .....should it look like this?

oUpload.Save("/Folder1/myweb/images")

russell
12-26-2006, 03:42 PM
no it should look like c:\somedirectory\

can use Server.MapPath("/Folder1/myweb/images/") if u want to use relative path

ASPSQLVB
12-26-2006, 03:49 PM
Russell,

I an executing this on the Web Sever now. Looks like the error is here

<%
Dim oUpload
Set oUpload = New clsUpload
If Request.TotalBytes > 0 Then
oUpload.Save("\aspsqlvb\keenesolutions.com\images")
End If

set oUpload = Nothing
%>

Here is the ERROR I am getting

THE PAGE CANNOT BE DISPLAYED.

russell
12-26-2006, 04:36 PM
use absolute path, not relative path. else use server.mappath

oUpload.Save("c:/inetpub/wwwroot/aspsqlvb/keenesolutions.com/images/")

or

oUpload.Save(Server.MapPath("\aspsqlvb\keenesolutions.com\images\"))

ASPSQLVB
12-26-2006, 05:08 PM
Sorry Russell but, still not working.

russell
12-26-2006, 06:09 PM
so what happens?

using absolute path?

permissions are appropriate?

ASPSQLVB
12-26-2006, 06:12 PM
Here is the path I am using...

Dim oUpload
Set oUpload = New clsUpload
If Request.TotalBytes > 0 Then

oUpload.Save(Server.MapPath("\aspsqlvb\keenesolutions.com\images\"))

End If

set oUpload = Nothing



I keep getting HTTP 500 INTERNAL ERROR THE PAGE CANNOT BE DISPLAYED


Russel, what do you mean by the permissions ?

russell
12-26-2006, 06:20 PM
does the account running iis have permission to write to that directory?

what type of authentication do u have? integrated or anonymous? if integrated, everyone needs permission to the actual unc path. if anonymous, you need to go to the iis mmc and see what account is running the web site, make sure it has permissions to write to the directory specified.

seems u have multiple web sites in path. is this a server you personally have full control over or a hosted server?

what happens if you response.write Server.MapPath("\aspsqlvb\keenesolutions.com\images\")

dont post the answer here to that last one. just make sure u understand the actual physical path and that the service account has permission to modify that directory.

finally, what changed since u first got it working and now it doesnt?

ASPSQLVB
12-26-2006, 06:40 PM
Russell, I sent you a personal message with answers to your question.

ASPSQLVB
12-26-2006, 07:24 PM
Russell, using my FTP program I can access the folder on the web server. I right click that folder and I see READ, WRITE and EXECUTE are all checked.

ASPSQLVB
12-26-2006, 09:15 PM
Russell,

In the Control Panel that is available to customers that have accounts with this particular web hosting company, there is a feature that can be used to upload files using a BROWSE button to the folder I wish.
Exactly the same thing I hope to do using a HTML DOCUMENT.
So, since I can upload to the folder I want, would this suggest that the permissions would not be an issue?

ASPSQLVB
12-26-2006, 11:42 PM
These are the attributes I see within my FTP program for the Folder I want to upload images to: rwxrwxrwx

Looks like read, write and execute for all.
I found an interesting web page that talks about this .
http://www.interspire.com/content/articles/12/1/FTP-and-Understanding-File-Permissions

russell
12-27-2006, 08:13 AM
YOU have permission, but the account that the web server is running under may not.

Do this:
Copy / Paste the following code. Make it an ASP file. Dont put any code in it except what you pasted from below.

FTP it to the Root of your website, then go to that page in your web browser.

Copy/Paste the results back here.

<%
Dim fso
Dim tst
Dim dct
Dim strm
Dim blnFSO
Dim fl

blnFSO = False

On Error Resume Next

With Response
.Write "<h4>Testing</h4>" & vbCrLf
.Write "scrrun.dll -- Create Dictionary..."

Set dct = Server.CreateObject("Scripting.Dictionary")

If Err.number <> 0 Then
.Write "<span style=color:red>FAILED</span><br>Unable to create instance of Scripting.Dictionary. This component is not available on your server"
Else
.Write "OK"
End If

Err.Clear

.Write "<p>scrrun.dll -- Create FileSystemObject..."
Set fso = Server.CreateObject("Scripting.FileSystemObject")

If Err.number <> 0 Then
.Write "<span style=color:red>FAILED</span><br>Unable to create instance of Scripting.FileSystemObject. This component is not available on your server"
Err.Clear
Else
.Write "OK"
blnFSO = True
End If

Err.Clear

If blnFSO Then
.Write "<p>Create File..."
fl = Server.MapPath("/images/") & "/test.txt"
Set tst = fso.OpenTextFile(fl, 1, true)

If Err.number <> 0 Then
.Write "<span style=color:red>FAILED</span><br>Service account does not have permission to write to /images/ directory or directory does not exist<br>"
.Write err.number & " " & err.Description & vbCrLf
Else
.Write "OK"
End If
End If

Err.Clear

.Write "<p>Create ADODB.Stream..."
Set fso = Server.CreateObject("Scripting.FileSystemObject")

If Err.number <> 0 Then
.Write "<span style=color:red>FAILED</span><br>Unable to create instance of ADODB.Stream. This component is not available on your server"
Err.Clear
Else
.Write "OK"
End If
End With
%>

Here's what it looks like in mine:

Testing
scrrun.dll -- Create Dictionary...OK
scrrun.dll -- Create FileSystemObject...OK

Create File...OK

Create ADODB.Stream...OK

ASPSQLVB
12-27-2006, 10:19 AM
Russell, this what I got back..

Testing
scrrun.dll -- Create Dictionary...OK
scrrun.dll -- Create FileSystemObject...OK

Create File...OK

Create ADODB.Stream...OK Here's what it looks

russell
12-27-2006, 10:43 AM
thats on the remote server that u are having problems with, not your local machine, right? in that case, you just need to make sure the path is right when you go to save the image,

oUpload.Save(Server.MapPath("/images/"))

russell
12-27-2006, 10:45 AM
by the way, that simple test just created a file in your images directory called test.txt. u may want to delete that...

ASPSQLVB
12-27-2006, 10:50 AM
Russell,

I just talked to the owner and he said whatever needs to be done please send it in an email and he will forward it over to his technicians who configure the server settings.
Is there something that needs to be asked ?

ASPSQLVB
12-27-2006, 10:54 AM
Actually, that test.txt was not created on the Server directory.

russell
12-27-2006, 11:26 AM
tell him you need the account running iis to have modify permissions on your images directory.

ASPSQLVB
12-27-2006, 11:33 AM
Will do......by the way, thank you so much for sticking with me through this. I really do appreciate all your effort Russell.

I will get back to you as soon as possible.

Ken

ASPSQLVB
12-27-2006, 03:06 PM
Russell,

I sent you a personal message.

guyjusthere
08-14-2007, 05:36 PM
what is the text box for??
I REALLY NEED TO CHOOSE the file name.. b/c i want to replace other files in that directory...
how?

guyjusthere
08-15-2007, 02:54 PM
helppp