her er noget som du måske kan bruge.....
index.asp
----------------
<!--#include file="fileupload_class.inc"-->
<%
Dim ul
Set ul = New FileUpload
ul.Upload()
Set ul = Nothing
%>
fileupload_class.inc
------------------------
<%
response.expires = 0
Class FileUpload
Private strThisPage, lngUploadSize, boolAllowOverwrite
Private UploadRequest, arrExt, strUploadDir
Public Property LET Extensions(byVal arrayInput)
arrExt = arrayInput
End Property
Public Property LET UploadDirectory(byVal strInput)
strUploadDir = strInput
End Property
Public Property LET AllowOverWrite(byVal boolInput)
boolAllowOverwrite = boolInput
End Property
Public Property LET UploadSize(byVal lngInput)
lngUploadSize = CLng( lngInput )
End Property
Public Property GET Extensions()
If IsArray( arrExt ) then
Extensions = arrExt
ElseIf Len(arrExt) = 1 AND arrExt = "*" Then
Extensions = "*"
Else
' ********************************************************************
' ******** Her deklareres de gyldige extensions i et array **********
' ********************************************************************
Extensions = Array(".jpg", ".gif")
End If
End Property
Public Property GET UploadDirectory()
If strUploadDir = Empty then
' ********************************************************************
' ******** Her sættes biblioteket hvor filerne uploades til **********
' ********************************************************************
UploadDirectory = Server.Mappath("picture/")
Else
UploadDirectory = strUploadDir
End If
End Property
Public Property GET AllowOverWrite()
' allow file overwrite
AllowOverWrite = CBool( boolAllowOverwrite )
End Property
' ********************************************************************
' ******** Her sættes max upload størrelse på uploadfilen i byte *****
' ********************************************************************
Public Property GET UploadSize()
' set maximum file size
If lngUploadSize = 0 then
UploadSize = 102400
Else
UploadSize = lngUploadSize
End If
End Property
Private Sub Class_Initialize()
strThisPage = request.serverVariables("PATH_INFO")
Call ClearVariables()
Call ClearDictionary()
End Sub
Private Sub Class_Terminate()
strThisPage = ""
Call ClearVariables()
Call ClearDictionary()
End Sub
Public Default Sub Upload()
Dim lngTotalBytes
On Error Resume Next
lngTotalBytes = Request.TotalBytes
If lngTotalBytes <= 0 Then
Call ShowForm()
ElseIf lngTotalBytes > 0 And lngTotalBytes <= UploadSize Then
Call UploadBinary( lngTotalBytes )
ElseIf lngTotalBytes > UploadSize Then
Call FileTooBig_Error()
Else
Call ShowForm()
End If
On Error GoTo 0
End Sub
' ***************************************************************************
' ******** Her bestemmes det hvorvidt der tillades overskrivning af filer ***
' ***************************************************************************
Private Sub ClearVariables()
lngUploadSize = 0
arrExt = Empty
strUploadDir = Empty
boolAllowOverwrite = False
End Sub
Private Sub ClearDictionary()
Set UploadRequest = Server.CreateObject("Scripting.Dictionary")
UploadRequest.RemoveAll
Set UploadRequest = Nothing
End Sub
Private Sub QuitUpload()
Response.Write "<P><CENTER><A HREF=""" & strThisPage & """>"
Response.Write "<B>Try Again</B></A></CENTER></P>"
End Sub
Private Sub UploadBinary(byVal MaxBytes)
Dim byteCount, RequestBin, filepathext
Dim ContentType, filePathName, filename, boolAllowed
boolAllowed = False
byteCount = MaxBytes
RequestBin = Request.BinaryRead(byteCount)
Set UploadRequest = Server.CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
filepathext = Right(filepathname, 4)
If IsArray(Extensions) Then
boolAllowed = ExtensionCheck( filepathext )
ElseIf Extensions = "*" Then
boolAllowed = True
End If
If boolAllowed Then
' filename = "22" & filepathext
session("filnavn") = filename
filename = UploadDirectory & "\" & filename
Call WriteUploadFile( filename, UploadRequest.Item("blob").Item("Value") )
Else
Call BadExtension_Error()
End If
End Sub
Private Sub WriteUploadFile(byVal NAME, byVal CONTENTS)
dim ScriptObject, i, NewFile
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
If ScriptObject.FolderExists( UploadDirectory ) Then
If NOT AllowOverWrite AND ScriptObject.FileExists( NAME ) Then
Set ScriptObject = Nothing
Call FileAlreadyExists_Error()
Exit Sub
End If
Set NewFile = ScriptObject.CreateTextFile( NAME )
For i = 1 to LenB( CONTENTS )
NewFile.Write chr( AscB( MidB( CONTENTS, i, 1) ) )
Next
NewFile.Close
Set NewFile = Nothing
Call Success( NAME )
Else
Set ScriptObject = Nothing
Call UploadDirNotFound_Error()
Exit Sub
End If
Set ScriptObject = Nothing
End Sub
Private Function ExtensionCheck(byVal EXT)
Dim Item
For each item in Extensions
if LCase( EXT ) = LCase( Item ) Then
ExtensionCheck = True
Exit Function
end if
Next
ExtensionCheck = False
End Function
' ********************************************************************
' ******** Herunder kommer samtlige forskellige brugeroplysninger, ***
' ******** afhængig af brugerens opførsel ****************************
' ********************************************************************
Private Sub Success(byVal FILE)
Dim strRoot
strRoot = LCase( Server.Mappath("/") )
FILE = LCase( FILE )
FILE = Replace( Replace( FILE, strRoot, "" ), "\", "/" )
Response.Write "<H1>Upload var en succes!!!</H1>"
' Response.Write "<H1>Upload Successful</H1>"
Response.Write "<P><BIG><B>" & FILE & "</B></BIG></P>"
Response.Write "<P><B><A HREF=""" & strThisPage & """>Upload en fil mere</A></B></P>"
' Response.Write "<P><B><A HREF=""" & strThisPage & """>Upload Again</A></B></P>"
End Sub
Private Sub ShowForm()
' display the upload form and let the
' user know what they can and cannot upload
Dim tmp, item
With Response
.Write "<H1>File Upload</H1>"
.Write "<P>Du kan tilføje alle filer af typerne: "
' .Write "<P>You can currently add any file of type: "
tmp = ""
If IsArray(Extensions) Then
For Each Item In Extensions
tmp = tmp & "*" & Item & ", "
Next
tmp = left( tmp, Len(tmp) - 2 )
Else
tmp = "All file types allowed"
End If
.Write tmp & "<BR>"
.Write "som har en maximum størrelse på: ~ "
' .Write "Having a maximum size of: ~ "
.Write Round( UploadSize / 1024, 1 ) & " k</P>"
.Write "<FORM ENCTYPE=""multipart/form-data"" ACTION="""
.Write strThisPage & """ METHOD=""POST"">" & vbCrLf
.Write "Vælg fil du vil uploade "
' .Write "Please select a file to upload "
.Write "fra din computer:<BR><BR>" & vbCrLf
' .Write "from your computer:<BR><BR>" & vbCrLf
.Write "<INPUT TYPE=FILE NAME=""blob""><BR><BR>" & vbCrLf
.Write "<INPUT TYPE=SUBMIT VALUE=""Upload File"">" & vbCrLf
.Write "</FORM>" & vbCrLf
End With
End Sub
Private Sub FileTooBig_Error()
Response.Write "<H1>Upload fil for stor...</H1>"
' Response.Write "<H1>Upload File Too Large...</H1>"
Response.Write "<P>Du er begrænset til at kunne "
' Response.Write "<P>You are currently limited to "
Response.Write "uploade filer på maximum "
On Error Resume Next
Response.Write Round( UploadSize / 1024, 1 ) & " k.</P>"
On Error GoTo 0
Call QuitUpload()
End Sub
Private Sub UploadDirNotFound_Error()
Response.Write "<H1>Upload biblioteket blev ikke fundet...</H1>"
' Response.Write "<H1>Upload Directory Not Found ...</H1>"
Response.Write "<P>Det specificerede upload bibliotek blev ikke fundet.</P>"
' Response.Write "<P>The Specified Upload Directory Cannot Be Found.</P>"
Call QuitUpload()
End Sub
Private Sub FileAlreadyExists_Error()
Response.Write "<H1>Specified File Already Exists ...</H1>"
Response.Write "<P>File OverWrite Disabled.</P>"
Response.Write "<P>Rename the file on your computer and re-upload...</P>"
Call QuitUpload()
End Sub
Private Sub BadExtension_Error()
Dim Item, tmp
Response.Write "<H1>Bad File Type...</H1>"
Response.Write "<P>You are currently limited to "
Response.Write "uploading only the following types of files:</P>"
Response.Write "<P>"
tmp = ""
For Each Item In Extensions
tmp = tmp & "*" & Item & ", "
Next
tmp = left( tmp, Len(tmp) - 2 )
Response.Write "<P>" & tmp & "</P>"
Call QuitUpload()
End Sub
Private Function getByteString(StringStr)
dim char, i
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function
Private Function getString(StringBin)
dim intCount
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
Private Sub BuildUploadRequest(RequestBin)
dim PosBeg,PosEnd,boundary,boundaryPos,Pos,Name,PosFile
dim PosBound,FileName,ContentType,Value
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
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)
If PosFile<>0 AND (PosFile<PosBound) Then
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
Else
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
UploadControl.Add "Value" , Value
UploadRequest.Add name, UploadControl
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub
End Class
%>
håber det måske kan hjælpe
Ny bruger
Nybegynder
Opret
Preview
