?? upload.asp
字號:
Case 1
Call OutScript("parent.UploadError('file')")
Case 2
Call OutScript("parent.UploadError('size')")
End Select
End If
Set oFile = oUpload.File("uploadfile")
sFileExt = LCase(oFile.FileExt)
Call CheckValidExt(sFileExt)
sOriginalFileName = oFile.FileName
sSaveFileName = GetRndFileName(sFileExt)
Dim str_Mappath
str_Mappath = sUploadDir & sSaveFileName
sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
Call CheckValidExt(sFileExt)
oFile.SaveToFile str_Mappath
Set oFile = Nothing
Set oUpload = Nothing
End Sub
Function GetRndFileName(sExt)
Dim sRnd
Randomize
sRnd = Int(900 * Rnd) + 100
GetRndFileName = FormatTime(Now(), 5) & sRnd & "." & sExt
End Function
Sub OutScript(str)
If sAction <> "LOCAL" Then
Response.Write "<script language=javascript>" & str & ";history.back()</script>"
End If
Response.End
End Sub
Sub OutScriptNoBack(str)
Response.Write "<script language=javascript>" & str & "</script>"
End Sub
Sub CheckValidExt(sExt)
Dim b, i, aExt
b = False
aExt = Split(sAllowExt, "|")
For i = 0 To UBound(aExt)
If LCase(aExt(i)) = sExt Then
b = True
Exit For
End If
Next
If b = False Then
Call OutScript("parent.UploadError('ext')")
End If
End Sub
Sub InitUpload()
sType = UCase(Trim(Request.QueryString("type")))
sStyleName = Trim(Request.QueryString("style"))
sCusDir = Trim(Request.QueryString("cusdir"))
sParamSYFlag = Trim(Request.QueryString("syflag"))
sCusDir = Replace(sCusDir, "\", "/")
If Left(sCusDir, 1) = "/" Or Left(sCusDir, 1) = "." Or Right(sCusDir, 1) = "." Or InStr(sCusDir, "./") > 0 Or InStr(sCusDir, "/.") > 0 Or InStr(sCusDir, "//") > 0 Then
sCusDir = ""
End If
Dim i, aStyleConfig, bValidStyle
bValidStyle = False
For i = 1 To Ubound(aStyle)
aStyleConfig = Split(aStyle(i), "|||")
If Lcase(sStyleName) = Lcase(aStyleConfig(0)) Then
bValidStyle = True
Exit For
End If
Next
If bValidStyle = False Then
OutScript("parent.UploadError('style')")
End If
sBaseUrl = aStyleConfig(19)
nUploadObject = Clng(aStyleConfig(20))
nAutoDir = CLng(aStyleConfig(21))
sUploadDir = aStyleConfig(3)
If sBaseUrl<>"3" Then
If Left(sUploadDir, 1) <> "/" Then
sUploadDir = "../" & sUploadDir
End If
End If
Select Case sBaseUrl
Case "0", "3"
sContentPath = aStyleConfig(23)
Case "1"
sContentPath = RelativePath2RootPath(sUploadDir)
Case "2"
sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
End Select
If sBaseUrl<>"3" Then
sUploadDir = Server.Mappath(sUploadDir)
End If
If Right(sUploadDir,1)<>"\" Then
sUploadDir = sUploadDir & "\"
End If
Select Case sType
Case "REMOTE"
sAllowExt = aStyleConfig(10)
nAllowSize = Clng(aStyleConfig(15))
Case "FILE"
sAllowExt = aStyleConfig(6)
nAllowSize = Clng(aStyleConfig(11))
Case "MEDIA"
sAllowExt = aStyleConfig(9)
nAllowSize = Clng(aStyleConfig(14))
Case "FLASH"
sAllowExt = aStyleConfig(7)
nAllowSize = Clng(aStyleConfig(12))
Case "LOCAL"
sAllowExt = aStyleConfig(44)
nAllowSize = Clng(aStyleConfig(45))
Case Else
sAllowExt = aStyleConfig(8)
nAllowSize = Clng(aStyleConfig(13))
End Select
nSLTFlag = Clng(aStyleConfig(29))
nSLTMinSize = Clng(aStyleConfig(30))
nSLTOkSize = Clng(aStyleConfig(31))
nSYWZFlag = Clng(aStyleConfig(32))
sSYText = aStyleConfig(33)
sSYFontColor = aStyleConfig(34)
nSYFontSize = Clng(aStyleConfig(35))
sSYFontName = aStyleConfig(36)
sSYPicPath = aStyleConfig(37)
nSLTSYObject = Clng(aStyleConfig(38))
sSLTSYExt = aStyleConfig(39)
nSYWZMinWidth = Clng(aStyleConfig(40))
sSYShadowColor = aStyleConfig(41)
nSYShadowOffset = Clng(aStyleConfig(42))
nSYWZMinHeight = Clng(aStyleConfig(46))
nSYWZPosition = Clng(aStyleConfig(47))
nSYWZTextWidth = Clng(aStyleConfig(48))
nSYWZTextHeight = Clng(aStyleConfig(49))
nSYWZPaddingH = Clng(aStyleConfig(50))
nSYWZPaddingV = Clng(aStyleConfig(51))
nSYTPFlag = Clng(aStyleConfig(52))
nSYTPMinWidth = Clng(aStyleConfig(53))
nSYTPMinHeight = Clng(aStyleConfig(54))
nSYTPPosition = Clng(aStyleConfig(55))
nSYTPPaddingH = Clng(aStyleConfig(56))
nSYTPPaddingV = Clng(aStyleConfig(57))
nSYTPImageWidth = Clng(aStyleConfig(58))
nSYTPImageHeight = Clng(aStyleConfig(59))
nSYTPOpacity = CDbl(aStyleConfig(60))
nCusDirFlag = Clng(aStyleConfig(61))
If nSYWZFlag=2 Then
If sParamSYFlag = "1" Then
nSYWZFlag = 1
Else
nSYWZFlag = 0
End If
End If
If nSYTPFlag=2 Then
If sParamSYFlag = "1" Then
nSYTPFlag = 1
Else
nSYTPFlag = 0
End If
End If
End Sub
Function RelativePath2RootPath(url)
Dim sTempUrl
sTempUrl = url
If Left(sTempUrl, 1) = "/" Then
RelativePath2RootPath = sTempUrl
Exit Function
End If
Dim sWebEditorPath
sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
Do While Left(sTempUrl, 3) = "../"
sTempUrl = Mid(sTempUrl, 4)
sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
Loop
RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
End Function
Function RootPath2DomainPath(url)
Dim sHost, sPort
sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
sPort = Request.ServerVariables("SERVER_PORT")
If sPort <> "80" Then
sHost = sHost & ":" & sPort
End If
RootPath2DomainPath = sHost & url
End Function
Function ReplaceRemoteUrl(sHTML, sExt)
Dim s_Content
s_Content = sHTML
If IsObjInstalled("Microsoft.XMLHTTP") = False Or nAllowSize <= 0 then
ReplaceRemoteUrl = s_Content
Exit Function
End If
Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
Set re = new RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}([A-Za-z0-9]{1,5})\/(\S+\.(" & sExt & ")))"
Set RemoteFile = re.Execute(s_Content)
Dim a_RemoteUrl(), n, i, bRepeat
n = 0
For Each RemoteFileurl in RemoteFile
If n = 0 Then
n = n + 1
Redim a_RemoteUrl(n)
a_RemoteUrl(n) = RemoteFileurl
Else
bRepeat = False
For i = 1 To UBound(a_RemoteUrl)
If UCase(RemoteFileurl) = UCase(a_RemoteUrl(i)) Then
bRepeat = True
Exit For
End If
Next
If bRepeat = False Then
n = n + 1
Redim Preserve a_RemoteUrl(n)
a_RemoteUrl(n) = RemoteFileurl
End If
End If
Next
nFileNum = 0
For i = 1 To n
SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
SaveFileName = GetRndFileName(SaveFileType)
If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
nFileNum = nFileNum + 1
If nFileNum > 1 Then
sOriginalFileName = sOriginalFileName & "|"
sSaveFileName = sSaveFileName & "|"
sPathFileName = sPathFileName & "|"
End If
sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
sSaveFileName = sSaveFileName & SaveFileName
sPathFileName = sPathFileName & sContentPath & SaveFileName
s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
End If
Next
ReplaceRemoteUrl = s_Content
End Function
Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
Dim Ads, Retrieval, GetRemoteData
Dim bError
bError = False
SaveRemoteFile = False
On Error Resume Next
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", s_RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
If LenB(GetRemoteData) > nAllowSize*1024 Then
bError = True
Else
Set Ads = Server.CreateObject("Adodb." & "Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile sUploadDir & s_LocalFileName, 2
Call makeImageSY(sUploadDir, s_LocalFileName)
.Cancel()
.Close()
End With
Set Ads=nothing
End If
If Err.Number = 0 And bError = False Then
SaveRemoteFile = True
Else
Err.Clear
End If
End Function
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
inHTML = sTemp
End Function
Function FormatTime(s_Time, n_Flag)
Dim y, m, d, h, mi, s
FormatTime = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
FormatTime = y & "-" & m & "-" & d
Case 3
FormatTime = h & ":" & mi & ":" & s
Case 4
FormatTime = y & m & d
Case 5
FormatTime = y & m & d & h & mi & s
End Select
End Function
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -