آموزش asp >> فرستادن فایل یا Upload از صفحه وب

در اینجا به ذکر نمونه ای از یک کد آماده برای بارگزاری فایل از طریق صفحه وب ( Upload ) به یک سرویس دهنده می پردازیم . این کدها از مجموعه موجود در سایت

گرفته شده اند . در ابتدا باید هر دو فایل زیر را بسازید :

upload_page.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:\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 & " " wr "Save = " & intSave & " " wr "Error = " & strError & " " wr "Filename = " & strFilename & " " wr "Filesize = " & lngFilesize & " " wr "Content-Type = " & strContentType & " " wr "Upload time = " & lngUploadTime & " ms " wr "Save time = " & lngSaveTime & " ms " 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) > ۰ 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 <> ۰ 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 '----------------------------------------------------------------------------------- %>

حالا کافیست در فایل اول در خط ۱۵ مسیر را برای ذخیره فایلها روی سرویس‌دهنده خود مشخص کنید :

.Path = "D:\Inetpub\wwwroot\test";

مسیر تعیین شده باید حتماً موجود باشد

Facebook

Twitter

عضویت در خبرنامه

آخرین بازدید شده ها

تبلیغات متنی

درخواست شما

آموزش asp >> فرستادن فایل یا Upload از صفحه وب

دیدگاه خود را به اشتراک بگذارید

دیدگاهتان را بنویسید لغو پاسخ