Ok.
-----------------Default.asp---------------------
<!-- #INCLUDE FILE=\"fileupload.inc\" -->
<%
If Request.ServerVariables(\"REQUEST_METHOD\") <> \"POST\" Then
Set Conn = Server.CreateObject(\"ADODB.Connection\")
Conn.Open \"DRIVER={Microsoft Access Driver (*.mdb)};DBQ=C:\\db\\chat\\chat.mdb\"
if request.form(\"what\") = \"opret\" then
inp_brugernavn = replace(request.form(\"brugernavn\"),\"\'\",\"\")
inp_adgangskode1 = replace(request.form(\"adgangskode1\"),\"\'\",\"\'\'\")
inp_adgangskode2 = replace(request.form(\"adgangskode2\"),\"\'\",\"\'\'\")
inp_email = replace(request.form(\"email\"),\"\'\",\"\'\'\")
opret = true
if instr(inp_brugernavn,\" \") then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Brugernavnet må ikke indeholde mellerum !</font>\"
opret = false
end if
sql2 = \"select * from reg_brugere where brugernavn = \'\" & inp_brugernavn & \"\'\"
set rs2 = conn.execute(sql2)
if inp_brugernavn = \"\" then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Du skal angive et brugernavn !</font>\"
opret = false
elseif not (rs2.bof or rs2.eof) then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Brugernavnet er taget af en anden bruger ! Vælg et andet !</font>\"
opret = false
end if
rs2.close
if inp_adgangskode1 = \"\" or inp_adgangskode2 = \"\" then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Adgangskoden skal skrives i begge felter !</font>\"
opret = false
elseif inp_adgangskode1 <> inp_adgangskode2 then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Adgangskoden er ikke gentaget korrekt !</font>\"
opret = false
elseif len(inp_adgangskode1) < 6 then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Adgangskoden skal mindst bestå af 6 tegn !</font>\"
opret = false
end if
sql = \"select * from reg_brugere where email = \'\" & inp_email & \"\'\"
set rs = conn.execute(sql)
if inp_email = \"\" then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Der skal angives en Email</font>\"
opret = false
elseif not (rs.bof or rs.eof) then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>En bruger med den indtastet Email findes allerede !</font>\"
opret = false
elseif instr(inp_email,\"@\") = 0 or instr(right(inp_email,len(inp_email) - instr(inp_email,\"@\")),\"@\") <> 0 or instr(inp_email,\"@\") = 1 or instr(right(inp_email,len(inp_email) - instr(inp_email,\"@\")),\".\") = 0 or len(inp_email) < 6 or instr(right(inp_email,len(inp_email) - instr(inp_email,\"@\")),\".\") = 1 or instr(inp_email,\".\") = 1 or instr(inp_email,\" \") <> 0 or instr(inp_email,\"..\") <> 0 then
fejl = fejl & \"<li><font face=\'Verdana\' size=\'1\' color=\'#000000\'>Den angivet Email findes ikke !</font>\"
opret = false
end if
rs.close
end if
if fejl <> \"\" then
fejl = \"<br><font color=\'#FF0000\'>\" & fejl & \"</font><br><br>\"
end if
if not opret = true then
response.write \"<font face=\'Verdana\' size=\'3\' color=\'#000000\'><center><b>Oprettelse af nyt brugernavn</b></center></font><br><br>\"
response.write \"<form ENCTYPE=\'multipart/form-data\' method=\'POST\' action=\'default.asp\'>\"
response.write \"<br>\" & fejl
response.write \"<font face=\'Verdana\' size=\'1\' color=\'#000000\'><b>Brugernavn :<input type=\'text\' name=\'brugernavn\' size=\'20\' style=\'background-color: #FF6600; color: #000000; font-family: Verdana; font-size: 8 pt; font-weight: bold; border: 1 dashed #000000\' value=\'\" & request.form(\"brugernavn\") & \"\'><br>\"
response.write \"Adgangskode: <input type=\'password\' name=\'adgangskode1\' size=\'20\' style=\'background-color: #FF6600; color: #000000; font-family: Verdana; font-size: 8 pt; font-weight: bold; border: 1 dashed #000000\'><br>\"
response.write \"Gentag adgangskode: <input type=\'password\' name=\'adgangskode2\' size=\'20\' style=\'background-color: #FF6600; color: #000000; font-family: Verdana; font-size: 8 pt; font-weight: bold; border: 1 dashed #000000\'><br>\"
response.write \"Gyldig email: <input type=\'text\' name=\'email\' size=\'20\' style=\'background-color: #FF6600; color: #000000; font-family: Verdana; font-size: 8 pt; font-weight: bold; border: 1 dashed #000000\' value=\'\" & request.form(\"email\") & \"\'><br>\"
response.write \"Vælg en fil: <INPUT NAME=\'fileupload\' TYPE=\'file\'><br>\"
response.write \"<input type=\'submit\' value=\'Opret\' name=\'submit\' style=\'background-color: #FF6600; color: #000000; font-family: Verdana; font-size: 8 pt; font-weight: bold; border: 1 dashed #000000\'>\"
response.write \"<input type=\'hidden\' name=\'what\' value=\'opret\'>\"
response.write \"</form>\"
else
sql = \"insert into reg_brugere ( brugernavn , adgangskode , email ) values( \'\" & inp_brugernavn & \"\' , \'\" & inp_adgangskode1 & \"\' , \'\" & inp_email & \"\' )\"
conn.execute(sql)
response.write \"<font face=\'Verdana\' size=\'1\' color=\'#000000\'>Du er nu oprettet som bruger !</font><br><br>\"
end if
%>
<%
Else
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes
intFileUpload = FileUpload(\"upload/\", 20000, Array(\"image/gif\", \"image/jpeg\", \"image/pjpeg\"), Array(\"gif\", \"jpg\"), strContentType, strFilename, intFileTotalBytes)
If intFileUpload = 0 Then
Response.Write \"Filen \" & strFilename & \" blev uploaded.<BR>\"
Response.Write \"Det er en fil af typen \" & strContentType & \" og den fylder \" & intFileTotalBytes & \" bytes:<BR>\"
Response.Write \"<IMG SRC=\"\"upload/\" & strFilename & \"\"\"><BR>\"
Else
Response.Write \"Der opstod en fejl under upload!<BR>\"
Response.Write \"Fejl nr: \" & intFileUpload & \"<BR>\"
Response.Write \"Filnavn: \" & strFilename & \"<BR>\"
Response.Write \"Filtype: \" & strContentType & \"<BR>\"
Response.Write \"Filstørrelse: \" & intFileTotalBytes & \"<BR>\"
End If
End If
%>
-----------Include filen (fileupload.inc)--------
<%
\'-------------------- Start: fileupload.inc --------------------
\'*** FileUpload ***
\'*** af Lars Snyder (pila@mailme.dk) ***
\'***
http://www.tipsogtricks-online.dk ***
\'*
\'* Sprog: VBScript
\'*
\'* Input:
\'* strPath Streng med uploadpath, f.eks. \"output/\", \"/asp/binary/upload/\" eller \"\"
\'* intMaxSize Tilladte grænse for filerne filer der uploades. Hvis < 1 er der ingen grænse.
\'* arrAcceptType Array med accepterede Content-Type, f.eks. \"image/gif\", \"image/jpeg\". Hvis (\"\") er alle filtyper accepterede.
\'* arrAcceptExt Array med sidste dele af filnavne, f.eks. \"gif\", \"jpg\" eller \"kundennefil.xls\". Hvis (\"\") er alle ext accepterede.
\'*
\'* Output: 0 hvis filen er uploaded korrekt.
\'* 1 Request fra bruger gik galt
\'* 2 Content med name=\"fileupload\" blev ikke fundet
\'* 3 Ingen filnavn
\'* 4 Content-Type accepteres ikke
\'* 5 Ext accepteres ikke
\'* 6 Filen er for stor
\'* 7 Filen blev ikke uploaded korrekt
\'* strContentType Den fundne type, f.eks. \"image/gif\"
\'* strFilename Det fundne filnavn, f.eks. \"button.gif\"
\'* intFileTotalBytes Filens samlede størrelse, f.eks. 9853
\'*
\'* Eksempler på ContentTypes
\'* Microsoft IE4 | Netscape NN4 | Beskrivelse
\'* \"image/gif\" | \"image/gif\" | CompuServe Graphics Interchange (.gif)
\'* \"image/pjpeg\" | \"image/jpeg\" | JPEG/JFIF Compliant (.jpg | .jif | .jpeg)
\'* \"application/octet-stream\" | \"application/msexcel\" | Microsoft Excel-regneark (.xls)
\'* \"application/octet-stream\" | \"application/msword\" | Microsoft Word-dokument (.doc)
\'* \"text/html\" | \"text/html\" | HTML Document (.htm | .html)
\'* \"text/plain\" | \"application/x-unknown-content-type-asp_auto_file\" | Active Server Page (.asp)
\'* \"text/plain\" | \"text/plain\" | Tekstdokument (.txt)
\'* \"text/plain\" | \"application/x-unknown-content-type-Excel.CSV\" | Separeret fil (.csv)
\'* \"application/octet-stream\" | \"application/octet-stream\" | Binær fil (.bin)
\'* \"application/octet-stream\" | \"application/octet-stream\" | Uden kendt filtype (.lol)
\'* Bemærk i øvrigt, at
\'* a. Der er desværre forskel på den tekst Microsoft og Netscape anvender på samme filtype.
\'* b. Microsoft evaulerer ikke kun filens efternavn, men også det faktiske indhold!
Function FileUpload(strPath, intMaxSize, arrAcceptType, arrAcceptExt, ByRef strContentType, ByRef strFilename, ByRef intFileTotalBytes)
\'Variable deklaration
Dim intPostTotalBytes, intStartPos, intEndPos, i
Dim bstrPostData, bstrDivider
Dim strTemp, strFileSpec
Dim arrSplit
Dim vbCrLfB
Dim bolStopLoop, bolContentTypeOK, bolExtOK
Dim fs, ts, f
\'Sæt returværdier
strContentType = \"\"
strFilename = \"\"
intFileTotalBytes = 0
\'Check: Er det faktisk POST upload?
If Request.ServerVariables(\"REQUEST_METHOD\") = \"POST\" Then
\'Dan vbCrLf som binær streng
vbCrLfB = ChrB(13) & ChrB(10)
\'Hent den binære POST fra brugeren
intPostTotalBytes = Request.TotalBytes \'Find antallet af bytes i POST
bstrPostData = Request.BinaryRead(intPostTotalBytes) \'Hent POST til en binær streng
If LenB(bstrPostData) <> intPostTotalBytes Then \'Check: Er antallet af bytes i POST forskelligt fra den binære streng?
\'Returner værdi og stop
FileUpload = 1
Exit Function
End If
\'Hent delelinien inkl. vbCrLfB (altid hele første linje)
bstrDivider = LeftB(bstrPostData, InStrB(bstrPostData, vbCrLfB) + 1)
\'Default StartPos
intStartPos = 1
\'Find Content-Disposition hvor name=\"fileupload\"
bolStopLoop = False
Do
\'Find starten af denne Content del (umiddelbart efter delelinien)
intStartPos = InStrB(intStartPos, bstrPostData, bstrDivider) + LenB(bstrDivider)
If intStartPos = 0 Then
\'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
\'Find slutningen af denne Content del (umiddelbart inden den næste delelinie)
intEndPos = InStrB(intStartPos, bstrPostData, bstrDivider)
If intEndPos = 0 Then
\'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
\'Hent denne Content-Disposition (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
\'Er fileupload feltet i denne Content-Disposition?
If InStr(LCase(strTemp), \"name=\"\"fileupload\"\"\") > 0 Then
\'Stop løkken her
bolStopLoop = True
Else
\'Start igen umiddelbart efter denne Content, men før næste divider
intStartPos = intEndPos
End If
Loop Until bolStopLoop
\'Flyt intStartPos til efter Content-Disposition linjen
intStartPos = intStartPos + Len(strTemp) + 2
\'Ekstrakt POST filnavnet fra strTemp
arrSplit = Split(strTemp, \";\") \'Opdel strTemp ved ;: Content-Disposition: form-data; name=\"fileupload\"; filename=\"filen.txt\"
\'Find filnavnet fra filename= array
strTemp = \"\" \'Værdi ved fejl
For i = 0 To UBound(arrSplit) \'Køres for alle i denne array
If LCase(Left(Trim(arrSplit(i)), 9)) = \"filename=\" Then \'Står der filename= ?
strTemp = Trim(arrSplit(i))
Exit For
End If
Next
\'Afbryd hvis der ikke blev fundet noget filnavn
If strTemp = \"\" Or strTemp = \"filename=\"\"\"\"\" Then
FileUpload = 3
Exit Function
End If
\'Find filnavnet
arrSplit = Split(strTemp, \"\"\"\") \'Opdel streng ved \"
strTemp = arrSplit(UBound(arrSplit) - 1) \'Næstsidste indholder filnavn
arrSplit = Split(strTemp, \"\\\") \'Del ved alle \\ Så indeholder den sidste filnavn.ext\"
strFilename = arrSplit(UBound(arrSplit)) \'Hent den sidste array, der må være filnavnet
\'Dan det fulde outputfilnavn via MapPath
strFileSpec = Server.MapPath(LCase(strPath & strFilename)) \'LCase kan evt fjernes herfra
\'Hent Content-Type (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
\'Flyt intStartPos til efter Content-Type linjen
intStartPos = intStartPos + Len(strTemp) + 2
\'Ekstrakt POST Content-Type
arrSplit = Split(strTemp, \" \")
strContentType = arrSplit(UBound(arrSplit))
\'Skal Content-Type checkes?
bolContentTypeOK = False
If arrAcceptType(LBound(arrAcceptType)) <> \"\" Then
For Each strTemp In arrAcceptType
If strContentType = strTemp Then
bolContentTypeOK = True
End If
Next
\'Check: Er det en accepteret Content-Type?
If Not bolContentTypeOK Then
\'ContentType ikke fundet - Returner værdi og stop
FileUpload = 4
Exit Function
End If
End If
\'Skal ekstention checkes?
bolExtOK = False
If arrAcceptExt(LBound(arrAcceptExt)) <> \"\" Then
For Each strTemp In arrAcceptExt
If LCase(Right(strFilename, Len(strTemp))) = strTemp Then
bolExtOK = True
End If
Next
\'Check: Er det en accepteret ekstention?
If Not bolExtOK Then
\'Ekstention ikke fundet - Returner værdi og stop
FileUpload = 5
Exit Function
End If
End If
\'Find faktiske start/slut på datafilen ved at fjerne foranstillede og efterstillede vbCrLfB
intStartPos = intStartPos + 2
intEndPos = intEndPos - 2
intFileTotalBytes = intEndPos - intStartPos
\'Skal filstørrelsen checkes?
If intMaxSize > 0 Then
\'Check: Er filen for stor?
If intFileTotalBytes > intMaxSize Then
\'Filen er for stor - Returner værdi og stop
FileUpload = 6
Exit Function
End If
End If
\'Åbn, skriv og luk outputfilen
Set fs = CreateObject(\"Scripting.FileSystemObject\") \'Filsystem objekt
Set ts = fs.CreateTextFile(strFileSpec, True) \'Åbn outputfil, overskriv evt. eksisterende
For i = intStartPos To intEndPos - 1
ts.Write(Chr(AscB(MidB(bstrPostData, i, 1)))) \'Skriv data eet tegn af gangen
Next
ts.Close \'Luk outputfil
\'Check: Blev filen oprettet og har den samme størrelse?
Set f = fs.GetFile(strFileSpec)
If f.Size <> intFileTotalBytes Then
FileUpload = 7
Exit Function
End If
\'* Returner OK
FileUpload = 0
End If
End Function
\'* Funktion der oversætter en bstr binær streng til en almindelig streng
\'* Pas på med 00 værdier, da de fungerer som EOF i en almindelig streng
Function bin2str(bstrBinary)
Dim i
For i = 1 To LenB(bstrBinary)
bin2str = bin2str & Chr(AscB(MidB(bstrBinary, i, 1)))
Next
End Function
\'-------------------- Slut: fileupload.inc --------------------
%>
-----------------------------------------------
Lige nu uploader den kun filen, den skal jo også skrive til en db.
Ny bruger
Nybegynder
Opret
Preview
