• پایان فعالیت بخشهای انجمن: امکان ایجاد موضوع یا نوشته جدید برای عموم کاربران غیرفعال شده است

کمککک لطفا یک حرفه ای کمک کنه

ikeyvan

Registered User
تاریخ عضویت
14 مارس 2005
نوشته‌ها
199
لایک‌ها
10
محل سکونت
Tehran
سلام من میخوام با استفاده از upload_class.asp عکس به سرور اپلود کنم اما نمیخوام هر ContnetType رو قبول کنه و فقط عکس رو قبول کنه ...خواهشن اگه کسی میدونه بگه چون خیلی احتیاجش دارم ...سورس upload_class.asp هم که فکر کنم همه دیده باشید تا به حال اما من بازم اینجا میزارمش و یکی زحمت بکشه بگه چه تغییری بدیم که فقط عکس رو قبول کنه :) منتظرم مرسی

upload_class.asp

-------------------------------------------------------------------------------------------------------------------------------------
<%
'+--------------------------------+
'|Class: FileUpload |
'|Date: 11:01 PM 7/23/2002|
'|By: M.Meijer |
'|Version: 1.0 |
'+--------------------------------+
'
'To upload and save a file submitted within a html form
'
'**Remarks:
'Uploading files with this class is not recommended for huge files,
'it takes alot of time saving the file to a textstream (as it the function 'save' does).
'It takes 7.812ms to upload a file from 'localhost', with a size of 40,000 bytes.
'Saving this file however costs 1078.125ms, and it takes 145828.1ms to save a file of 5.5Mb.
'Conclusion don't save big files, use the maxfilesize property to limit the filesize.
'The class can only handly one file on a submission.
'The file will be saved in the specified 'Path', if there is no 'path' set, it can't save the file. (doh!)
'
'Properties:
'-----------
'
' ContentType string read Content-Type of the file
' Filename string read/write Name of the file
' Path string read/write A path to a directory with permissions to write the file
' Size long read The size of the file in bytes
' AllowedFiles string read/write Allowed file extension(s), multiple seperated with a comma
' Maxfilesize long read/write Maximum allowed size of the file
' Error string read The explenation of an error if occured
'
'Methods
'-------
'
' Upload() = Status
' Copies the result of Request.Binaryread to a file
'
' Status integer 0 Upload success
' 1 A file has not been posted
' 2 File exceeds the maximum allowed filesize
' 3 Type is not allowed
'
' Save(Overwrite) = Satus
' Slaat de bytearray op in een bestand met de in Filename gedefineerde bestandsnaam,
' in de in Path gedefineerde diretorie.
'
' Overwrite boolean true If the file exists it will be overwritten
' false If the file exists it will not be overwritten
'
' Status integer 0 The file has been saved
' 1 The binary value could not be written to a file
' 2 There is no binary value
' 3 The filename is empty
' 4 An error already occured, can't continue
'
'
'
'Code:
'-----------------------------------------------------------------------------------
Class FileUpload
Private strContentType
Private bytData
Private strFilename
Private strPath
Private lngTotalbytes
Private strAllowedFiles
Private lngMaxFileSize
Private strError

Private Sub Class_initialize()
strContentType = ""
bytData = chrB(10)
strFilename = ""
strPath = ""
lngTotalbytes = 0
strAllowedFiles = ""
lngMaxFileSize = 0
strError = ""
End Sub

Private Sub CLass_Terminate()
bytData = Null
End Sub

Public Property Get Size
Size = lngTotalbytes
End Property

Public Property Let MaxFileSize(byval vData)
If isNumeric(vData) > 0 Then
lngMaxFileSize = vData
End If
End Property

Public Property Get MaxFilesize
MaxFilesize = lngMaxFileSize
End Property

Public Property Let AllowedFiles(byval vData)
If Len(vData) > 0 Then
strAllowedFiles = vData
End If
End Property

Public Property Get AllowedFiles
AllowedFiles = strAllowedFiles
End Property

Public Property Get Error
Error = strError
End Property

Public Property Get ContentType
ContentType = strContentType
End Property

Public Property Let Path(byval vData)
If Len(vData) > 0 Then
strPath = vData
End If
End Property

Public Property Get Path
Path = strPath
End Property

Public Property Let Filename(byval vData)
If Len(vData) > 0 Then
strFilename = vData
End If
End Property

Public Property Get Filename
Filename = strFilename
End Property


Public Function Upload()' as integer
Dim bytAllData
lngTotalbytes = Request.Totalbytes
If lngTotalbytes > 0 Then
If lngMaxFilesize <> 0 Then
If lngTotalBytes > lngMaxFileSize Then
strError = "The file exceeds the allowed capacity."
Upload = 2
Exit Function
End If
End If
bytAllData = Request.BinaryRead(lngTotalbytes)
strContentType = GetContentType(bytAllData)
strFilename = GetFilename(bytAllData)
If strAllowedFiles <> "" Then
If Not AllowedFile(strFilename) Then
strError = "Filetype is not allowed."
Upload = 3
Exit Function
End If
End If
bytData = GetData(bytAllData)
Upload = 0
Else
Upload = 1
strError = "No data recieved."
End If
End Function

Public Function Save(byval bOverwrite)
If strError <> "" Then
Save = 4
Exit Function
End If
If strPath <> "" Then
If Mid(strPath,Len(strPath)-1,1) <> "\" Then strPath = strPath & "\"
If strFilename <> "" Then
If LenB(bytData) > 1 Then
If SaveBinaryData(bytData,strPath & strFilename,bOverwrite) Then
Save = 0
Else
Save = 1
End If
Else
Save = 2
strError = "No data."
End If
Else
Save = 3
strError = "Not a valid filename specified."
End If
Else
Save = 4
strError = "No path specified."
End If
End Function

Private Function AllowedFile(byval sFilename)'as boolean
Dim arrAllowedFiles, intCount
Dim strExtension
If Len(sFilename) > 0 Then
If inStr(sFilename,".") > 0 Then
strExtension = Mid(sFilename,Len(sFilename) - inStr(strReverse(sFilename),".")+2)
arrAllowedFiles = Split(strAllowedFiles,",")
AllowedFile = False
For intCount = 0 To Ubound(arrAllowedFiles)
If arrAllowedFiles(intCount) <> "" Then
If Lcase(strExtension) = Lcase(Trim(arrAllowedFiles(intCount))) Then
AllowedFile = True
Exit For
End If
End If
Next
Else
AllowedFile = False
End If
Else
AllowedFile = False
End If
End Function

Private Function SaveBinaryData(byval bData, byval sFilename, byval bOverwrite) 'as boolean
Dim objFs, objTextFile
Dim intCount, strFile
If LenB(bData) < 2 Then
strError = "No data."
SaveBinaryData = False
Exit Function
End If

Set objFs = Server.CreateObject("scripting.filesystemobject")
If Not objFs.FolderExists(strPath) Then
strError = "Directory does not exists."
SaveBinaryData = False
Exit Function
End If

If Not bOverwrite And objFs.FileExists(sFilename) Then
strError = "File already exists."
SaveBinaryData = False
Exit Function
End If

Set objTextFile = objFs.CreateTextFile(sFilename,True,False)

For intCount = 1 To LenB(bData)
objTextFile.Write Chr(AscB(MidB(bData,intCount,1)))
Next

objTextFile.Close
Set objTextFile = Nothing
Set objFs = Nothing
Session("file") = Null
SaveBinaryData = True
End Function

Private Function GetData(byval bFile)'as bytearray
Dim intStart, intEnd

If LenB(bFile) < 1 Then
GetData = ChrB(10)
Exit Function
End If
intStart = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)) + 4
intEnd = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(45) & ChrB(45)& ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45))
If intStart > 0 Then
If intStart < intEnd Then
GetData = MidB(bFile, intStart, intEnd - intStart)
Else
GetData = ChrB(10)
End If
Else
GetData = ChrB(10)
End If
End Function

Private Function GetFilename(byval bFile)' as string
Dim bytFilename, bytChar, strFilename
Dim intStart, intCount

If LenB(bFile) < 1 Then
GetFilename = ""
Exit Function
End If

If LenB(bFile) > 0 Then
If inStrB(bFile,ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) Then
intStart = inStrB(bFile, ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) + 10
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(34) Then
Exit For
End If
bytFilename = bytFilename & bytChar
Next
End If
End If
For intCount = 1 To LenB(bytFilename)
strFilename = strFilename & Chr(AscB(MidB(bytFilename,intCount,1)))
Next
strFilename = Mid(strFilename,Len(strFilename) - inStr(strReverse(strFilename),"\")+2)
GetFilename = strFilename
End Function

Private Function GetContentType(byval bFile)
Dim bytContentType, strContentType, bytChar
Dim intStart, intCount

If LenB(bFile) < 1 Then
GetContentType = ""
Exit Function
End If

If inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) > 0 Then
intStart = inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) + 14
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(13) Then
Exit For
End If
bytContentType = bytContentType & bytChar
Next
End If
For intCount = 1 To LenB(bytContentType)
strContentType = strContentType & Chr(AscB(MidB(bytContentType,intCount,1)))
Next
GetContentType = strContentType
End Function
End Class
'-----------------------------------------------------------------------------------

%>


Upload_page.asp
----------------------------------------------------------------------------------------------------------------------------------
<!-- #include file="upload.asp" -->
<%
Server.ScriptTimeout = 300 'now i can upload and save files upto ~8Mb
Dim intLevel, intUpload, intSave, strError, strContenType, strFilename, lngFileSize
Dim objUpload
Dim lngTime, lngUploadTime, lngSaveTime
intLevel = Request.QueryString("level")
'--------------------------------------
wrHead
If intLevel = 1 Then
Set objUpload = New FileUpload
With objUpload
.Path = "c:\Inetpub\wwwroot\test"
lngTime = Timer()
intUpload = .Upload
lngUploadTime = Round((Timer() - lngTime) * 1000,3)
lngTime = Timer()
intSave = .Save(true)
lngSaveTime = Round((Timer() - lngTime) * 1000,3)
strError = .Error
strFilename = .Filename
lngFilesize = .Size
strContentType= .ContentType
End With
Set objUpload = Nothing
End If

wrForm
wr "<hr style=""height:1px;width:100%;"" />"
wr "Upload = " & intUpload & "<br />"
wr "Save = " & intSave & "<br />"
wr "Error = " & strError & "<br />"
wr "Filename = " & strFilename & "<br />"
wr "Filesize = " & lngFilesize & "<br />"
wr "Content-Type = " & strContentType & "<br />"
wr "Upload time = " & lngUploadTime & " ms<br />"
wr "Save time = " & lngSaveTime & " ms <br />"
wr "<hr style=""height:1px;width:100%;"" />"
wrFoot
'--------------------------------------



Sub wrForm
wr "<form method=""post"" enctype=""multipart/form-data"" action=""?level=1"">"
wr "<input type=""file"" name=""file""></input>"
wr "<input type=""submit""></input>"
wr "</form>"
End Sub

Sub wrHead
wr "<html>"
wr "<head>"
wr "<title>upload</title>"
wr "</head>"
wr "<body>"
End Sub

Sub wrFoot
wr "</body>"
wr "</html>"
Response.End
End Sub

Sub wr(byval sText)
If sText <> "" Then Response.Write sText & vbNewLine
End Sub
%>
 

amin1us

کاربر تازه وارد
تاریخ عضویت
2 ژوئن 2004
نوشته‌ها
199
لایک‌ها
0
بايد پسوند فايلتو چك كني اگه عكس بود آپلود كنه!
 

ikeyvan

Registered User
تاریخ عضویت
14 مارس 2005
نوشته‌ها
199
لایک‌ها
10
محل سکونت
Tehran
:lol: خسته نباشی پهلوون ....یکی بلد نبود حد اقل یک sample ارایه کنه؟!:)
 
بالا