upload-kodupload-kod ändringar
<code>
<form method="post" action="default.asp?page=upload&upload=yes" enctype="multipart/form-data">
<input type="file" name="blob" class=area>
<br>
<input type="submit" value="Upload" class=area name="submit">
</form>
<%
if request.querystring("upload") = "yes" then
'Response.BinaryWrite(Request.BinaryRead(Request.TotalBytes))
byteCount = Request.TotalBytes
'Response.BinaryWrite(Request.BinaryRead(varByteCount))
RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
'Exempel på hur man kan 'plocka ner' andra forumlärelement
'email = UploadRequest.Item("email").Item("Value")
contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = ""&session("user")&".jpg"
value = UploadRequest.Item("blob").Item("Value")
'Create FileSytemObject Component
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
'Create and Write to a File
pathEnd = Len(Server.mappath(Request.ServerVariables("PATH_INFO")))-14
' Set MyFile = ScriptObject.CreateTextFile(Left(Server.mappath(Request.ServerVariables("PATH_INFO")),pathEnd)&filename)
Set MyFile = ScriptObject.CreateTextFile(Server.mappath("pics/"&filename))
For i = 1 to LenB(value)
MyFile.Write chr(AscB(MidB(value,i,1)))
Next
MyFile.Close
Response.Write "<script language=""Javascript"">alert('Upload finished!');window.location='default.asp?page=demos';</script>"
%>
<%
Sub BuildUploadRequest(RequestBin)
'Get the boundary
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
'Get all data inside the boundaries
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl
Set UploadControl = CreateObject("Scripting.Dictionary")
'Get an object name
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
'Test if object is of file type
If PosFile<>0 AND (PosFile<PosBound) Then
'Get Filename, content-type and content of file
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
'Add filename to dictionary object
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
'Add content-type to dictionary object
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
'Get content of object
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
Else
'Get content of object
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
End If
'Add content to dictionary object
UploadControl.Add "Value" , Value
'Add dictionary object to main dictionary
UploadRequest.Add name, UploadControl
'Loop to next object
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub
'String to byte string conversion
Function getByteString(StringStr)
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function
'Byte string to string conversion
Function getString(StringBin)
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
%>
<%
end if
%>
<%
Set UploadRequest = nothing
Set ScriptObject = nothing
Set MyFile = nothing
Set UploadControl = nothing
%>
</code>
check-kod (kollar bredden+höjden på bilden)
<code>
<%
Dim imagefile,fso,image,width,height,buffer,length
imagefile="pics/"&session("user")&".jpg"
Set fso = CreateObject("Scripting.FileSystemObject")
Set image = fso.OpenTextFile(Server.MapPath(imagefile))
image.Skip(2)
Do
Do
buffer = image.Read(1)
If asc(buffer) <> 255 Then Exit Do
Loop
If asc(buffer) < 192 Or 195 < asc(buffer) Then
buffer = image.Read(2)
length = CLng(asc(mid(buffer,1,1))) * 256 + asc(mid(buffer,2,1))
image.Skip(length - 2)
Else
Exit Do
End If
Loop
buffer = image.Read(7)
width = asc(mid(buffer,6,1)) * 256 + asc(mid(buffer,7,1))
height = asc(mid(buffer,4,1)) * 256 + asc(mid(buffer,5,1))
Response.Write("width = " & width & ", height = " & height)
image.Close
Set image = Nothing
Set fso = Nothing
%>
</code>
vill att 200x200 pixlar är max värde, annars "avbryts" uploaden
men filen måste väl först verkligen uploadas, sen kollas, och sen tas bort (om bilden e större än 200x200) ? eller
sen vet jag inte VAR i upload-koden jag ska lägga in check-koden