وب سایت آموزش برنامه نویسی :: فرستادن فایل یا آپلود از صفحه وب :: Upload In ASP

كاربر فعال

كاربر مهمان

درباره وب سايت

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

برای عضویت در وب سایت روی لینک زیر کلیک کنید :

عضویت در وب سایت

برای طرح سوالات و پیشنهادات خود می توانید نظر خود را از طریق فرم پایین صفحات ارسال کنید و یا از طریق ایمیل با ما در میان بگذارید .همچنين مي توانيد به تالار گفتمان به آدرس زير مراجعه كنيد :

تالار گفتمان

لينك به ما

برای قرار دادن لینک سایت آموزش برنامه نویسی در وب سایت یا وبلاگ خود کد زیر را با کلیک بر روی دکمه " کپی کد " کپی کرده و در محل مورد نظر خود قرار دهید .

پيوندها

>>>اف سي پرسپوليس
>>>كسب درآمد اينترنتي ( درآمدزايي آسان و واقعي از طريق اينترنت )
>>>تالار گفتمان
>>>وب سایت افشین رشیدی
>>>وبلاگ بزرگ منچستر
>>>پول * پول * پول
>>>Astronomy
>>>شعرای یمانی
>>>اخبار سپاهان
>>>خريد و فروش اينترنتي (كمترين قيمتها )
>>>امیرحسین
>>>برنامه نویسی
>>>بهترین آهنگ های روز
>>>دريافت پول به ازاي هر كليك
>>>پایگاه آموزش
>>>جديدترين كليپ هاي موبايل
>>>دانلود ، سرگرمی ، مطالب جالب و خواندنی
>>>ارزان سراي اينترنتي
>>>Abtarang
>>>سرمست ترین
>>>سینما و رپ ایرانی
>>>!:: دنیـای عـکس و مـوزیک ::!
>>>عشق ، احساس ، زندگی
>>>فقط چند دقیقه
>>>Iranian-IT
>>>مهندسان برق
>>>مروارید درون
>>>آموزشکده کامپیوتر
>>>جونه من 18- نیان تو
>>>سلول زنده
>>>گيتار
>>>best download
>>>جک و SMS
>>>کلیپ ( جدید - 2008 ) و عکس و رینگتون و اس ام اس
>>>ورود ممنوع
>>>وبلاگ تخصصی کامپیوتر
>>>گروه شبکه پرشین بلاگ - پویا کوشنده
>>>خبرهای روز IT
>>>قفل سکوت
>>>دنیای کامپیوتر
>>>بیا تو مجانی اطلاعات بگیر
>>>برترین اخبار و مقالات رایانه
>>>فدا خانوم رو ببین چه کرده
>>>دابل-کلیک، مرکز آموزش کامپیوتر و اینترنت ایرانیان
>>>قاسم پرسپولیسی
>>>يه سايت توپ براي همه ي سليقه ها
>>>عکس داغ
>>>تجارت الكترونيك
>>>hossein
>>>تفریح>جک>ترفند>مطالب عاشقانه>هرچیکه بخوای
>>>وب سایت تفریحی طوطیا
>>>کرمانشاه نیوز
>>>computer-world20
>>>هنر رزمي فونگ پاي چي وو كونگ فو
>>>AIOS - All In One Site
>>>ROYAYE KHIS
>>>بانک مقالات فارسی
>>>قاسم روني
>>>طراحی وب سایت
>>>عکسهای جدید ایرانی

WWW.BARNAMENEVISI.SOMEE.COM

فرستادن فايل يا Upload از صفحه وب

فرستادن فايل يا 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 & "<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 '----------------------------------------------------------------------------------- %>

حالا كافيست در فايل اول در خط 15 مسير را براي ذخيره فايلها روي سرويس‌دهنده خود مشخص كنيد :

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

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

بازگشت به فهرست

بازگشت به صفحه نخست

آخرین مطالب وب سایت

راهنمای استفاده و آموزش MATLAB

الگوریتم محاسبه کوتاهترین مسیر بین تمام رئوس ( Floyd ) به زبان C

آموزش گام به گام پاسكال

برنامه نویسی با زبان اسمبلی

توابع و قطعه كدهاي مفيد برنامه نويسي

برنامه ماشين حساب مهندسي با زبان دلفي 7

همه چيز در مورد اينترنت

منابع ، سرفصلها و اطلاعات كنكور كارداني به كارشناسي دولتي 1388 نرم افزار كامپيوتر

برنامه بازي مارپله با زبان ويژوال بيسيك

برنامه استك چند گانه با استفاده از آرايه به زبان C

برنامه مساله پر پيچ و خم Mazing به زبان C

ارسال سوالات ، نظرات و پيشنهادات

منوي اصلي

= صفحه اصلی
= تالار گفتمان
= عضویت در وب سایت
= ورود به حساب شخصی
= آپلود عکس در وب سایت
= چت
= Visual Basic
= VB.NET
= C ++ / VC++ / C
= C #
= Pascal
= Delphi 7
= JAVA
= ASP
= ASP.NET
= PHP
= Gold Fusion
= XML
= HTML
= CSS
= Java Script
= Action Script
= SQL Server
= ADO / ADO.NET
= Security
= Registery
= UML
= Internet
= Windows XP Install
= Access
= Photoshop CS
= Flash
= Microsoft Power Point
= Microsoft Excel
= MATLAB
= ذخیره و بازیابی اطلاعات
= سیستم عامل
= ساختمان داده ها
= مهندسی نرم افزار
= معماری کامپیوتر
= هوش مصنوعی
= شیوه ارائه مطالب
= کتاب آموزش MATLAB
= الگوریتم Floyd
= آموزش گام به گام پاسكال
= برنامه نویسی اسمبلی
= توابع مفيد برنامه نويسي
= برنامه ماشين حساب دلفي
= همه چيز در مورد اينترنت
= كنكور كارداني به كارشناسي 88
= بازي مارپله با ويژوال بيسيك
= استكهاي چندگانه با زبان C
= مساله پر پيچ و خم Mazing
= تبديل Infix به Postfix
= شکستن پسورد administrator
= اجراي فايل صوتي در ويژوال بيسيك
= پارتيشن بندي FDisk
= اسمبل كردن كامپيوتر
= ارسال ايميل به ما

ورود به سيستم

نام کاربری :
رمز عبور :

عضویت در وب سایت

نظرسنجي

نتايج نظرسنجي

عالی : 73 رای - 68 درصد

خوب : 14 رای - 13 درصد

متوسط : 5 رای - 5 درصد

ضعیف : 2 رای - 2 درصد

خیلی ضعیف : 14 رای - 13 درصد

مجموع آرا : 108 رای

نويسنده

نام : افشین
نام خانوادگی : رشیدی
شهرستان : مهاباد
تاریخ تاسیس : 05/05/1387
ایمیل : afshinrashidi@yahoo.com

آمار وب سايت

[11/22/2009]
بازديدهاي شما :
IP شما : 38.107.191.104
ساعت ورود : 3:07:13 PM
تعداد کل بازدیدها : 86507 بار
تعداد اعضا : 866 نفر
آمار وبگذر :

وضوح تصوير :