چطوري يه سايت اپلود سنتر بزنم ؟ [آرشيو]

Janer

9 February 2008, 11:20 PM

سلام

من مي خواستم بخشي از هاستم رو به اپلود سنتر اختصاص بدم

مي خواستم بدونم با چه برنامه اي يك اپلود سنتر بزنم

كه بازديد كنندگان بتونن عكس و MP3 و Zip آپلود كنند

كه حداكثر امنيت هم داشته باشه

اگه خواسته باشم عكسهای آپلودي Thumbnail هم داشته باشه ، آپا ميشه

و يا واسه قابليت Resume داشتن دانلود ها چه احتياجاتي هست

ممنون از همگي

EbliiS

10 February 2008, 02:48 AM

دوست عزيز شما ميتوني آپلود سنتر را با زبان php يا asp بنويسي يا از نسخه هاي پولي آماده استفاده كني مثل PHP Advanced Transfer Manager.
اگه هم ASP كار ميكني بايد 2 تا فايل بسازي :

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";

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

منبع (http://forums.nsd.ir/nsd/showthread.php?tid=475)

Janer

13 February 2008, 08:29 PM

ممنون ابليس عزيز

لطف كرديد

اين فايل ها رو با پسوندasp بگذارم روي هاست آپلود سنتر راه مي يوفته ؟!

ميشه يك سايت كه همين جوري ساخته شده

يا سايتي كه با نسخه هاي پولي نوشته شده رو آدرس بديد

تا تفاوت رو ببينيم ؟

مي بخشيدا

ممنون

EbliiS

14 February 2008, 01:38 AM

من خودم اين كدها را تست نكردم شما بذاريد ببينيد كارتون زاه ميافته؟البته اين خيلي پيش و پا افتاده هست.
مثلا اين آپلود سنتر (http://dvb.lv/)با PHP Advanced Transfer Manage پياده سازي شده.http://asefsoft.com/qsimages/157.gif

pesartanha

21 February 2008, 12:16 AM

سايت (http://farsiupload.com) داراي چه سيستمي است؟

ali_zzr

10 August 2008, 11:14 PM

من یک اسکریپ قدرتمند php برای دانلود سنتر که امکاناتش فول بود رو داشتم فارسی میکردم 70% کار پیش رفته بود که ولش کردم.اگه خواستی تکمیلش میکنم میفروشمش ... بهم خبر بده