Uploading Pictures

[ASPSQLVB]

Guys,

I am so close to finishing a project that is very important to me. The last thing I need to do is provide "Image file uploading" to the server.
I do have some code to follow but, I am not sure what minor changes I need to make. Any help is deeply appreciated.
Below is what I have to follow:

First Page is the HTML PAGE: UPLOAD.HTM
Second Page is UP.ASP
Third Page is: UPLOAD.ASP

UP.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)))
Response.Write "<BR>Saved " & Upload_FormFiles.Item(File) & ", size=" & Size
Next

%>

UPLOAD.ASP

<%
const adBinary = 128
const adVarBinary = 204
const adLongVarBinary = 205
const adLongVarchar = 201
const adVarchar = 200
const adBigInt = 20


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

' 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 = ""
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
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 "data", adLongVarBinary, PartContentLength
rst.Open
rst.AddNew
rst("data").AppendChunk PartContent & ChrB(0)
rst.Update
PartContent2 = rst("data").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 rst = CreateObject("ADODB.Recordset")
rst.Fields.Append "data", adLongVarChar, PartContentLength
rst.Open
rst.AddNew
rst("data").AppendChunk PartContent2
rst.Update
DataString = rst("data")
rst.close
set rst = nothing
Else
' nothing to convert
dataString = ""
End If

' conversion has been done, now what to do with it

If FileName <> "" Then

' we have a file, let's save it to disk

FileName = Mid(Filename,InstrRev(FileName,"\")+1)

With Upload_Data
.AddNew
.Fields("fieldname").Value = Partname
.Fields("filename").Value = FileName
.Fields("size").Value = Len(datastring)
.Fields("bytes").AppendChunk datastring
.Update
End with

Upload_FormFiles.Add Partname, Filename

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)

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

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

' 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



%>

[chrismartz]

Does this script give an error when you use it?

[russell]

you've abandoned the method i gave u in other post (http://www.webdeveloper.com/forum/showthread.php?t=132587) ? does this method work locally as that one did? if it works on your test machine, but not your host, then it is permission or configuration issues with the server and no code modifications will fix it. since the object testing code i gave u didnt create a file on the server then server is configured to disallow write/modify, or the service account doesnt have modify permissions on that directory. what did host tell u about that? in addition to directory security in iis mmc (like u showed in screenshot), need to make sure permission granted via win explorer. host needs to make sure that account executing iis for your web site has write and modify permissions on images directory. who is your hosting company?

[ASPSQLVB]

Hi Russell. I am addressing the permission/configuration issue with the hosting company. Ironically my account expired and tomorrow I will have the account up and running. Hopefully I can write to the folder in my directory on the web server.

BY the way, the code works fine on my local machine. On the hosts server it does not work. I will keep you posted on the progress.
Thanks a bunch. You are a great addition to this website.

Ken

[ASPSQLVB]

Hi Russell,

I hope this makes sense. I had another account created on a server that the administrator was abel to check the WRITE PERMISSION feature.
Now, when I try writing a file to the specified folder I am still getting this error:

ADODB.Stream error '800a0bbc'

Write to file failed.

/upload2.asp, line 59

[ASPSQLVB]

Ok....forget the ABOVE messages.

I can upload images to the folder on the Server..of course within a certain size. But, Now I am running into a new error when I add the INPUT FILES to my code. Below is the error.


Now, why am I getting this error:
Error Type:
Microsoft VBScript compilation (0x800A03EA)
Syntax error
/TheOnlineKeepSack/upload.asp, line 2
Class clsFile


<%
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
'Response.Write namefofFile
'Response.End
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
%>

[ASPSQLVB]

Most reecent ERROR:

Error Type:
Request object, ASP 0207 (0x80004005)
Cannot use Request.Form collection after calling BinaryRead.
/TheOnlineKeepSack/EnterCarpAngler2.asp, line 32

[russell]

that's right. once u call request.binary read, cant call request.form. have to parse entire form in binary. else (easier) have image upload in form all by itself. in other words, on page1 let user input whatever info u r grabbing and page2 have only the img upload.

[ASPSQLVB]

So, put something like this at the top

<%@ Language=VBScript %>
<%
If Trim(Request.Form("AnglerPhoto")) <> "" Then
%>
<!-- #include file="upload.asp" -->
<!-- #include file="upload2.asp" -->
<%
Dim oUpload
Set oUpload = New clsUpload
If Request.TotalBytes > 0 Then
oUpload.Save("pathname")
End If

set oUpload = Nothing

End IF
%>

[ASPSQLVB]

Russell,

I can upload images, and what is not being sent is the values from the HTML document.
I am using a Response.Redirect after the image is uploaded to the server.
Is there an easier way to pass the HTML values?....This is what I have,


<!-- #include file="upload.asp" -->
<!-- #include file="upload2.asp" -->

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

oUpload.Save("D:PathName")

set oUpload = Nothing
End If

Response.Redirect "EnterCarpAngler2.asp"
Response.End
%>

[ASPSQLVB]

Ok Russell,

Its working now. My next step is to create a folder in the directory and save the file in it. HeHEHe....finally having some fun now. Thank You Sir!!!

[russell]

SWEEEEEET!!!

sorry i havent been able to check back today. been a busy week flying around. Sittin' in the Vegas airport right now. Been in San Fran, Cleveland, Phoenix and Vegas in the last few days....now waiting for a freakin 1am flight. maybe i'll head over to the sports lounge and order a 7 dollar beer...

[ASPSQLVB]

Wow.....Nice!!!....I hope whatever your doing is more than enjoyable!!

I am still running into some other problems....and I am sure youv'e heard them before from maybe personal experiences.?..
..Seems now I am getting only some of the values from the previous page. Some of the values are not being added to the database. One in particular is the VALUE for the INPUT TYPE = "file" .
Ive been banging away at this thing for hrs now. LOL.
Russell, talk about flying...I know where your coming from. Ive been to the Middle East once and I also been to Antartica. These were some very humbling flights. 20 - 30 hrs a piece.

[russell]

wow. those are long flights! what was antartica like? what were u doing there? this is a work trip for me. i'm not 100% sure that u can grab the textual value of input type=file from the previos form. not sure and too tired to test it right now. u can use javascript to copy the value to a hidden input though. or, u can set a cookie server-side or use session, to remember some values from screen to screen.

[ASPSQLVB]

Using the Session Object would be an idea.....anyway, I stopped in New Zealand for 1 week to get my "ALL WEATHER" gear and then I was off to Antartcia for a 1 month stay. I was a part of the mission "Operation Deep Freeze" (very fitting), thanks to the Air Force.

I flew down on a C-130 military aircraft. I was accompanied by Sir Edmund Hilary. If you dont know who he is, he was the first explorer to climb to the top of Mt. Everast. Amongst other things.
In Antartica the sun is out 24/7 during the summer months. The summer months fall between October and March. Give or take a few weeks.
Also, I managed a flight down to the South Pole. I have a picture of me standing next to the pole. That was very interesting!!! It was a very extreme experience. Nothing like I have ever been exposed to. Very vacant and wide open. Huge mountains, glacies and tons of ice.
The flightline were the planes would land and takeoff was all ice. About 15 - 20 ft of ice.
If you ever get the chance to go to New Zealand, you will absolutely LOVE IT!! Very nonhostile environment, virgin land, beautiful shorelines, fresh air and fresh food. Very delicious. The people were great!!!

[ASPSQLVB]

Russell,

I am now trying to use the SESSION object.

I created a temp page that would trap the values into a SESSION object, then at the end of the code I am redirected to the destination page.
I am still not getting the value from the INPUT FILE.

Page 1 has:
<input type="file" size="30" name="AnglerPhoto">
Page 2 has:
Session("AnglerPhoto") = Request.Form("AnglerPhoto")
Page 3 has:
Response.Write Session("AnglerPhoto")
Response.End

[russell]

Ken, when/where does the binary read come in?

it works for me. for example, this simple test works:

<%
'Response.Write Request.Form("rrr")
Session("rrr") = Request.Form("rrr")
Response.Write Session("rrr")
%>

<form method=post action="test.asp">
<input type=file name=rrr>
<input type=submit>
</form>

[ASPSQLVB]

Now I am trying to put all the variables in Cookies then pas it on a Querystring, then display it on a querysting.
Not working.

I tried SESSION and COOKIE nothing is working.

Russ, can you suggest how I should do this....

[ASPSQLVB]

Russell,

Here are the pages.

Page 1

<input type="file" size="30" name="AnglerPhoto">

Page 2

Session("FirstName") = Trim(Request.Form("FirstName"))

destination_page = "up.asp?FirstName=" & FirstName

Response.Write destination_page
Response.End

Page 3

<!-- #include file="adovbs.inc" -->
<!-- #include file="upload.asp" -->
<!-- #include file="upload2.asp" -->

<%

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

oUpload.Save("D:\Path\")

''''''''''''set oUpload = Nothing

End If
%>

<%
Dim RS1,STRSQL,CONN,FirstName,LastName,EmailHome,State,Sponsor,SponsorWebAddress,Country,PegNumber,Angle rPhoto,TeamName,Anglers,Bio,AnglerPassword,NewAngler,NameofEvent,CustomerId

Trying to retrieve all these variables and the INPUT FILE TYPE VALUE(doesn'y work)

FirstName = Trim(oUpload.QueryString("FirstName"))
Response.Write FirstName
Response.End

[russell]

i sent u a PM. by the way, for code listings, it's a lot easier to read if u use code tags:

[ code ]
code here
[/ code]

but without the spaces between the brackets and the word "code"

[ASPSQLVB]

Sent you a PM