<html><head><title>Upload</title></head><body>
<%
dim strAction
strAction = request("action")
select case strAction
case "upload"
UploadFile
case else
ShowForm
end select
' -------------------------------------
' Funktioner/procedurer
' -------------------------------------
sub ShowForm
%>
<h1>Opload profil billed</h1><br>
her kan du oploade dit personlige profil billede, billedet må max fylde 40 kb og vis du har oploadet billeder før vil dette blive slettet når du oploader et ny!!<br>
<form enctype="multipart/form-data" action="<%=curfile%>?side=profil&vis=opload&action=upload" method=post>
Fil: <input type="file" name="file" class='textbox'><br>
<input type="submit" class='knap'>
</form>
<%
end sub
sub UploadFile
dim intPosMIMEHeader, intPosFileDataStart
dim intPosFileNameStart, intPosFileNameEnd
dim intPosFileDataEnd, intDataSize
dim binData, binFileData, binFileName, binStart
dim strFileName
dim objFSO, objFile
intDataSize = request.totalbytes
if intdatasize => 40000 then
response.write "<h1>Fejl</h1><br>"
response.write "Billedet er for stort til at du kan oploade det, det må max fylde 40 kb"
response.write "<br><a href='" & curfile & "?side=profil&vis=opload'>Prøv igen</a>"
else
binData = request.binaryread(intDataSize)
intPosMIMEHeader = instrB(binData,chrB(13) & chrB(10)) - 1
intPosFileDataStart = instrB(binData, chrB(13) & chrB(10) & chrB(13) & chrB(10)) + 4
intPosFileNameStart = instrB(binData,cstrB("filename=")) + 10
intPosFileNameEnd = instrB(intPosFileNameStart,binData,chrB(34))
binStart = midB(binData,1,intPosMimeHeader)
binFileName = midB(binData,intPosFileNameStart, _
intPosFileNameEnd - intPosFileNameStart)
intPosFileDataEnd = instrB(intPosMIMEHeader, binData, binStart) - 2
strFileName = bin2str(binFileName)
strFileName = right(strFileName, len(strFileName) - instrrev(strFileName,"\"))
response.write "Filstørrelse: " & intPosFileDataEnd - intPosFileDataStart & _
" bytes.<br>"
response.write server.mappath("images\profilimg\")
set objFSO = server.createobject("Scripting.FileSystemObject")
set objFile = objFSO.CreatetextFile(server.mappath("images\profilimg\" & strFileName), _
true, false)
objFile.write bin2str(midB(binData, intPosFileDataStart, _
intPosFileDataEnd - intPosFileDataStart))
objFile.close
set objFile = Nothing
set objFSO = Nothing
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
fil = fs.Fileexists(server.mappath("images\profilimg\" & session("aktivbruger") & ".jpg"))
if fil = true then
set delfil = fs.getfile(server.mappath("images\profilimg\" & session("aktivbruger") & ".jpg"))
delfil.delete
end if
Set f = fs.GetFile(server.mappath("images\profilimg\" & strfilename))
f.name = session("aktivbruger") & ".jpg" ' Fileobjectets property, name kan anvendes til ændring af filnavn
s = f.Name &" onDrive " & UCase(f.Drive) & vbCrLf
Response.Write s
SQL = "Update brugere set privatimg = '" & session("aktivbruger") & ".jpg' where id = " & session("aktivbruger")
conn.execute(SQL)
SQL = "update brugere set imgtype = '1' where id = " & session("aktivbruger")
conn.execute(SQL)
response.redirect "" & curfile & "?side=profil"
end if
end sub
function bin2str(byref binS)
' omdanner en binær følge til en tekststreng
dim i, strRes
for i = 1 to lenB(binS)
strRes = strRes & chr(ascB(midB(binS, i, 1)))
next
bin2str = strRes
end function
function cstrB(strS)
' omdanner en tekststreng til en binær følge
dim i, binRes
for i = 1 to len(strS)
binRes = binRes & chrB(asc(mid(strS,i,1)))
next
cstrB = binRes
end function
%>
</body></html>
den giver følgende fejl:
Sun ONE ASP VBScript runtime (0x800A4001)
Function or method call not implemented: 'ChrB'
upload.asp, line 32
Og det ksla siges at har vikret korrekt før vi skiftede server:)
