asp کارها بیان تو

naeim_crack

Active Member
سلام

اقا من چند تا کار می خواستم با asp انجام بدم ولی نمی دونم چه جوری میشه کمک کنید
1- می خوام وقتی کاربر می خواد عکس خودشو آپلود کنه ظرفیت فایل و اندازه فایل مثلا 200*200 بگیره و اگه جر اون ظرفیت و اندازه مجاز بود رو به کاربز اچازخ بده که فایل آپلود بشه این کار تو php کاری نداره مثل همین قسمت قرار دادن آواتور در سایت مجید انلان

2- یه سوال دیگه وقتی کاربر میره فایل رو برای ارسال انتخاب میکنه باید از روی سیستم خودش یه فایل گرافیکی انتخاب کنه مثلا اسم فایل naeim.jpg هستش من می خوام این فایل وقتی آپلود میشه مثلا اگه کد کاربر 123 هستش اسم فایلی که رو سرور میره هم بشه 123.jpg

مرسی
 

AliReza26

Active Member
واسه اولي نمونه برنامه مشابه زياده(يه سرچي تو hotscripts.com , google كن) ببخشيد خودم نگشتم... :oops: يخورده كارهام زياده نعيم جان.... :oops:

واسه دومي هم خيلي راحت با تابع :

کد:
right(ImageName,4)

پسوند فايل را جدا كن و به Username متصل كن بعد با نام قبلي فايل جايگزين كن......
 

naeim_crack

Active Member
افا سلام

ببین علی رضا جون مرسی سوال اول رو می گردم و پیدا می کنم
اما برای سوال دوم یه توضیحی بده اسم فایل باید قبل از اینکه فایل به سروز آپلود بشه اسم روعوض کنم یا وقتی که آپلود شد بعد با چه دستوری اسم رو عوض کنم
مرسی
 

nima_isp

Member
کد:
test.asp

<!-- #include file="upload_class.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 = "d:\sites\incoming\"
		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
%>

کد:
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
'-----------------------------------------------------------------------------------

%>
خيلي راحت ميفرسته
 

naeim_crack

Active Member
بابا نیما تو که این همه بلیدی پس چرا ؟؟؟؟؟؟؟؟؟؟؟؟؟

فقط مونده یه چیز اندازه عکس چه جوری تشخیص بدم 200*200 هستش

مرسی ؟؟؟
 

hoom

Active Member
نعيم جان،
من خودم عين همين مشكل رو قبلا داشتم كه راه حلش رو برات اينجا ميذارم. البته همه رو يه كمي ساده تر كردم.
اين رو به هر اسمي كه ميخواي ذخيره كن.

کد:
<% 
Response.Buffer = True 

Session.CodePage = 1252
Session.LCID = 2057
Response.CharSet = "Windows-1252"
%>

<html>
<head>
        <title>Insert Image</title>
</head>

<body>

<Script Language="JavaScript">
function DoClick()
{
if (document.form1.file.value != '')
        {
        document.form1.action = 'insert.asp?UpLoad=True';
        document.form1.submit();
        }
}
</Script>

<form METHOD="POST" ENCTYPE="multipart/form-data" action="" name="form1" id="form1">
  <table border="1" width="100%" bordercolor="#000000" bordercolorlight="#000000" bordercolordark="#000000" cellspacing="0" cellpadding="15" name="table1" id="table1">
    <tr>
      <td width="100%">Picture Source: <input type="file" accept="picture" name="file" size="20"></td>
    </tr>
  </table>
</form>

</body>

</html>

اين كلاسLoader هستش كه اون رو با اسم Loader.asp ذخيره كن

کد:
<%
 Session.CodePage = 1252
 Session.LCID = 2057
 Response.CharSet = "Windows-1252"

        Class Loader
                Private dict
                
                Private Sub Class_Initialize
                        Set dict = Server.CreateObject("Scripting.Dictionary")
                End Sub
                
                Private Sub Class_Terminate
                        If IsObject(intDict) Then
                                intDict.RemoveAll
                                Set intDict = Nothing
                        End If
                        If IsObject(dict) Then
                                dict.RemoveAll
                                Set dict = Nothing
                        End If
                End Sub

                Public Property Get Count
                        Count = dict.Count
                End Property

                Public Sub Initialize
                        If Request.TotalBytes > 0 Then
                                Dim binData
                                        binData = Request.BinaryRead(Request.TotalBytes)
                                        getData binData
                        End If
                End Sub
                
                Public Function getFileData(name)
                        If dict.Exists(name) Then
                                getFileData = dict(name).Item("Value")
                                Else
                                getFileData = ""
                        End If
                End Function

                Public Function getValue(name)
                        Dim gv
                        If dict.Exists(name) Then
                                gv = CStr(dict(name).Item("Value"))
                                
                                gv = Left(gv,Len(gv)-2)
                                getValue = gv
                        Else
                                getValue = ""
                        End If
                End Function
                
                Public Function saveToFile(name, path)
                        If dict.Exists(name) Then
                                Dim temp
                                temp = dict(name).Item("Value")
                                
                                Dim fso
                                Dim file
                                
                                Set fso = Server.CreateObject("Scripting.FileSystemObject")
                                Set file = fso.CreateTextFile(path, True, False)
                                
                                For tPoint = 1 to LenB(temp)
                                  file.write Chr(AscB(MidB(temp,tPoint,1)))
                                Next
                                
                                file.Close
                                saveToFile = True
                                Set fso = Nothing
                        Else
                                saveToFile = False
                        End If
                End Function
                
                Public Function getFileName(name)
                        If dict.Exists(name) Then
                                Dim temp, tempPos
                                        temp = dict(name).Item("FileName")
                                        tempPos = 1 + InStrRev(temp, "\")
                                        getFileName = Mid(temp, tempPos)
                        Else
                                getFileName = ""
                        End If
                End Function
                
                Public Function getFilePath(name)
                        If dict.Exists(name) Then
                                Dim temp, tempPos
                                        temp = dict(name).Item("FileName")
                                        tempPos = InStrRev(temp, "\")
                                        getFilePath = Mid(temp, 1, tempPos)
                        Else
                                getFilePath = ""
                        End If
                End Function
                
                Public Function getFilePathComplete(name)
                        If dict.Exists(name) Then
                                getFilePathComplete = dict(name).Item("FileName")
                        Else
                                getFilePathComplete = ""
                        End If
                End Function

                Public Function getFileSize(name)
                        If dict.Exists(name) Then
                                getFileSize = LenB(dict(name).Item("Value"))
                        Else
                                getFileSize = 0
                        End If
                End Function

                Public Function getFileSizeTranslated(name)
                        If dict.Exists(name) Then
                                temp = 1 + LenB(dict(name).Item("Value"))
                                        If Len(temp) <= 3 Then
                                                getFileSizeTranslated = temp & " bytes"
                                        ElseIf Len(temp) > 6 Then
                                                temp = FormatNumber(((temp / 1024) / 1024), 2)
                                                getFileSizeTranslated = temp & " megabytes"     
                                        Else
                                                temp = FormatNumber((temp / 1024), 2)
                                                getFileSizeTranslated = temp & " kilobytes"
                                        End If
                        Else
                                getFileSizeTranslated = ""
                        End If
                End Function
                
                Public Function getContentType(name)
                        If dict.Exists(name) Then
                                getContentType = dict(name).Item("ContentType")
                        Else
                                getContentType = ""
                        End If
                End Function

        Private Sub getData(rawData)
                Dim separator 
                separator = MidB(rawData, 1, InstrB(1, rawData, ChrB(13)) - 1)

                Dim lenSeparator
                        lenSeparator = LenB(separator)

                Dim currentPos
                        currentPos = 1
                Dim inStrByte
                        inStrByte = 1
                Dim value, mValue
                Dim tempValue
                        tempValue = ""

                While inStrByte > 0
                        inStrByte = InStrB(currentPos, rawData, separator)
                        mValue = inStrByte - currentPos

                        If mValue > 1 Then
                                value = MidB(rawData, currentPos, mValue)

                                Dim begPos, endPos, midValue, nValue
                                Dim intDict
                                        Set intDict = Server.CreateObject("Scripting.Dictionary")
                
                                        begPos = 1 + InStrB(1, value, ChrB(34))
                                        endPos = InStrB(begPos + 1, value, ChrB(34))
                                        nValue = endPos

                                Dim nameN
                                        nameN = MidB(value, begPos, endPos - begPos)

                                Dim nameValue, isValid
                                        isValid = True
                                        
                                        If InStrB(1, value, stringToByte("Content-Type")) > 1 Then

                                                begPos = 1 + InStrB(endPos + 1, value, ChrB(34))
                                                endPos = InStrB(begPos + 1, value, ChrB(34))
        
                                                If endPos = 0 Then
                                                        endPos = begPos + 1
                                                        isValid = False
                                                End If
                                                
                                                midValue = MidB(value, begPos, endPos - begPos)
                                                        intDict.Add "FileName", trim(byteToString(midValue))
                                                                
                                                begPos = 14 + InStrB(endPos + 1, value, stringToByte("Content-Type:"))
                                                endPos = InStrB(begPos, value, ChrB(13))
                                                
                                                midValue = MidB(value, begPos, endPos - begPos)
                                                intDict.Add "ContentType", trim(byteToString(midValue))
                                                
                                                begPos = endPos + 4
                                                endPos = LenB(value)
                                                
                                                nameValue = MidB(value, begPos, endPos - begPos)
                                        Else
                                                nameValue = trim(byteToString(MidB(value, nValue + 5)))
                                        End If

                                        If isValid = true Then
                                                intDict.Add "Value", nameValue
                                                intDict.Add "Name", nameN

                                                dict.Add byteToString(nameN), intDict
                                        End If
                        End If

                        currentPos = lenSeparator + inStrByte
                Wend
        End Sub
        
        End Class

        Private Function stringToByte(toConv)
                Dim tempChar
                 For i = 1 to Len(toConv)
                        tempChar = Mid(toConv, i, 1)
                        stringToByte = stringToByte & chrB(AscB(tempChar))
                 Next
        End Function

        Private Function byteToString(toConv)
                For i = 1 to LenB(toConv)
                        byteToString = byteToString & chr(AscB(MidB(toConv,i,1))) 
                Next
        End Function
%>

و اينم اون قسمتي كه ميخواستي. متغيرهاي MAXIMAGEWIDTH و MAXIMAGEHEIGHT اندازه هاي عكست هستند كه من اونا رو 200 گذاشتم. تابع CheckFile هم اول تشخيص ميده كه فايل عكس هستش يا نه (حالا پسوندش هر چي ميخواد باشه) و بعدش هم توي اون اندازه هايي كه تو ميخواي هست يا نه. البته اين تابع تشخيص فرمت و اندازه عكس از خودمه كه بيزحمت اگر جايي خواستيد معرفي كنيد كپي رايتش رو رعايت كنيد
متغير fileName هم اسم فايلي هستش كه ميخواي فايل با اون اسم ذخيره بشه كه ميتوني اون رو هر چيزي بذاري

کد:
<!-- #include file="Loader.asp" -->

<%
 Dim IW, IH

 Response.AddHeader "cache-control", "private"
 Response.AddHeader "pragma", "no-cache"
 Response.ExpiresAbsolute = #January 1, 1990 00:00:01#
 Response.Expires=-1
 Server.ScriptTimeout = 100000000
 Session.Timeout = 60
 
 Session.CodePage = 1252
 Session.LCID = 2057
 Response.CharSet = "Windows-1252"

 Const MAXIMAGEWIDTH = 200
 Const MAXIMAGEHEIGHT = 200

 If Request.QueryString("UpLoad") = "True" Then 
     'Response.Clear
     'Response.Buffer = True
                         
     '// Path to Save the Image on Image Server
     Dim strContentImagePath
     strContentImagePath = "C:\Temp"
     
     '// Create Image folder on ImageServer if doesn't exists
     Dim fso
     Set fso = CreateObject("Scripting.FileSystemObject")
     
     '// load object
     Dim load
     Set load = new Loader
                
     '// calling initialize method
     load.initialize
     
     '// File binary data
     Dim fileData
     fileData = load.getFileData("file")
     '// File name
     Dim fileName
     fileName = LCase(load.getFileName("file"))
     '// File path
     Dim filePath
     filePath = load.getFilePath("file")
     '// File path complete
     Dim filePathComplete
     filePathComplete = load.getFilePathComplete("file")
     '// File size
     Dim fileSize
     fileSize = load.getFileSize("file")
     '// File size translated
     Dim fileSizeTranslated
     fileSizeTranslated = load.getFileSizeTranslated("file")
     '// Content Type
     Dim contentType
     contentType = load.getContentType("file")

     '// Check that file is correct
     Dim CheckFileError
     CheckFileError = CheckFile
        
     '// Check that file is GIF or JPG
     If CheckFileError = 1 Then
        Response.Write "Not an image"
        Set load = Nothing
        Response.End
     End If

     '// Check that file has our Image Size
     If CheckFileError = 2 Then
        Response.Write "Image is bigger than allowed"
        Set load = Nothing
     End If
        
     '// No. of Form elements
     Dim countElements
     countElements = load.Count
     
     '// Value of text input field "name"
     Dim nameInput
     nameInput = load.getValue("name")
     
     '// Path where file will be uploaded

     '// Uploading file data
     Dim pathToFile
     Dim strTempImagePath
     
     fileName = Replace(fileName, " ", "_")
     pathToFile = strContentImagePath & "\" & fileName
     
     Dim fileUploaded
     fileUploaded = load.saveToFile ("file", pathToFile)
     
     '// Destroying load object
     Set load = Nothing
     Set fso = Nothing

End If

Function CheckFile()

 '// Read File Type
 Dim DocType
 DocType = UCase(contentType)

 Dim blnGIF
 Dim blnJPG

 blnGIF = (InStr(DocType, "GIF") > 0)
 blnJPG = (InStr(DocType, "JPEG") > 0)

 CheckFile = 0
 
 If (Not blnGIF) AND (Not blnJPG) Then
    CheckFile = 1
    Exit Function
 End If

 '// Bytes 4 and 5 of each GIF Files are Width and Height
 If blnGIF Then
   IW = CInt(AscW(Mid(fileData, 4, 1)))
   IH = CInt(AscW(Mid(fileData, 5, 1)))
   
   If (IW > MAXIMAGEWIDTH) Or (IH > MAXIMAGEHEIGHT) Then CheckFile = 2
   Exit Function
 End If

 '// Retrieving the JPG size is a little complexer
 '// We must search file till reach "FF D8 FF"(Hex)
 If blnJPG Then
   Dim lPos
   Const BUFFERSIZE = 65535

   lPos = 1

   Do
       If (bBuf(lPos) = &HFF And bBuf(lPos + 1) = &HD8 _
            And bBuf(lPos + 2) = &HFF) _
            Or (lPos >= BUFFERSIZE - 10) Then Exit Do

       '// Move our pointer up
       lPos = lPos + 1
   Loop

   lPos = lPos + 2
   If lPos >= BUFFERSIZE - 10 Then Exit Function

   Do
   
       Do
       '// Loop until we find the beginning of the next marker
           If bBuf(lPos) = &HFF And bBuf(lPos + 1) _
          <> &HFF Then Exit Do
           lPos = lPos + 1
           If lPos >= BUFFERSIZE - 10 Then Exit Function
       Loop
       
       '// Move pointer up
       lPos = lPos + 1
       
       Select Case bBuf(lPos)
           Case &HC0, &HC1, &HC2, &HC3, &HC5, &HC6, &HC7, &HC9, &HCA, &HCB, &HCD, &HCE, &HCF
           '// We found the right block
               Exit Do
       End Select
       
       '// Otherwise keep looking
       lPos = lPos + Mult(bBuf(lPos + 2), bBuf(lPos + 1))
       
       '// check for end of buffer
       If lPos >= BUFFERSIZE - 10 Then Exit Function
       
   Loop
   
   '// Get the height
   IH = Mult(bBuf(lPos + 5), bBuf(lPos + 4))
   
   '// Get the width
   IW = Mult(bBuf(lPos + 7), bBuf(lPos + 6))

   If (IW > MAXIMAGEWIDTH) Or (IH > MAXIMAGEHEIGHT) Then CheckFile = 2
   Exit Function
 End If

End Function

Function bBuf(lngPos)
   bBuf = (AscB(MidB(fileData, lngPos, 1)))
End Function


Function Mult(lsb, msb)
    Mult = lsb + (msb * CLng(256))
End Function

%>

ارادتمند
 

جدیدترین ارسال ها

بالا