ASP實現圖文混合上傳，無須資料庫(二)
未測試
來源:網路流傳
代碼如下:
檔名: uploadx.asp
<% Dim FormData, FormSize, Divider, bCrLf
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)
'將上傳的文件保存到path所指定的目錄下面。
'Formfield 上傳表單的"file"域名 Path
' 要保存文件的服務器絕對路徑，形式為："d:\path\subpath"或"d:\path\subpath\"
'MaxSize 限制上傳文件的最大長度，以KByte為單位
' SavType 服務器保存文件的方式：
'0 唯一文件名方式，如果有同名則自動改名；
'1 報錯方式，如果有同名則出錯；
'2 覆蓋方式，如果有同名則覆蓋原來的文件
Function SaveFile(FormFileField, Path, MaxSize, SavType)
Dim StreamObj,StreamObj1
Set StreamObj = Server.CreateObject("ADODB.Stream")
Set StreamObj1 = Server.CreateObject("ADODB.Stream")
StreamObj.Mode = 3
StreamObj1.Mode = 3
StreamObj.Type = 1
StreamObj1.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
If Right(Path,1) <> "\" Then
Path = Path & "\"
End If
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType))
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
StreamObj.Open
StreamObj1.Open
StreamObj.Write FormData
StreamObj.Position=FileStart-1
StreamObj.CopyTo StreamObj1,FileLen
If SavType =0 Then
SavType = 1
End If
StreamObj1.SaveToFile Path & FileName, SavType
StreamObj.Close
StreamObj1.Close
If SaveFile <> "" Then
SaveFile = SaveFile & "," & FileName
Else
SaveFile = FileName
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",*TooBig*"
Else
SaveFile = "*TooBig*"
End If
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
'獲取表單值
Function GetFormVal(FormName)
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
Else
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
Function bin2str(binstr)
Dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = LenB(binstr)
For i = 1 To varlen
If skipflag = 0 Then
clow = MidB(binstr, i, 1)
If AscB(clow) > 127 Then
ccc = ccc & Chr(AscW(MidB(binstr, i + 1, 1) & clow))
skipflag = 1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag = 0
End If
Next
bin2str = ccc
End Function
Function str2bin(str)
For i = 1 To Len(str)
str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function
Function GetFileName(str,path,savtype)
Set fs = Server.CreateObject("Scripting.FileSystemObject")
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
End If
Next
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
hFileName = hFileName & str2bin(i)
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
End If
Next
End If
Set fs = Nothing
GetFileName = FileName
End Function
%>
********************************************************************************
下面是上傳文件部分代碼
<%
if request.QueryString("action")="save" then
dim upload,imgfile,filePath,extname,fname
set upload=new upload_5xsoft ''建立上傳對象
set imgfile=upload.file("picfile")
'圖片存儲位置
imgdir=upload.Form("imgdir")
if imgfile.FileSize>0 then ''如果 FileSize > 0 說明有文件資料
extname=right(imgfile.filename,3)
fname=year(now())&month(now())&day(now())&hour(now())&second(now())&minute(now())&"."&extname
image=replace(imgdir&fname,"/","\")
imgfile.SaveAs image
image=replace(image,server.MapPath("\"),"")
image=replace(image,"\","/")
if left(image,1)<>"/" then
image="/"&image
end if
end if
set imgfile=nothing
response.Write("<a href="""&image&""" target=""blank"">"&image&"</a>"&vbcrlf)
response.Write("<a href=""?imgdir="&imgdir&""" onclick=""top.mainFrame.document.form1.img.value=''"">清除</a>")
response.Write("<script LANGUAGE=VBSCRIPT>top.frames(""mainFrame"").document.form1.img.value="""&image&"""" & vbcrlf & "top.frames(""mainFrame"").document.proimg.src="""&image&"""</script>")
response.End()
elseif request("action")="edit" and len(request("file"))>0 then
image=request("file")
imgdir=request("imgdir")
response.Write("<a href="""&image&""" target=""blank"">"&image&"</a>"&vbcrlf)
response.Write("[<a href='?imgdir="&imgdir&"' onclick=""top.mainFrame.document.form1.img.value=''"">清除</a>]")
response.Write("<script LANGUAGE=VBSCRIPT>top.frames(""mainFrame"").document.form1.img.value="""&image&"""" & vbcrlf & "top.frames(""mainFrame"").document.proimg.src="""&image&"""</script>")
response.End()
else
%>
未測試
來源:網路流傳
代碼如下:
檔名: uploadx.asp
<% Dim FormData, FormSize, Divider, bCrLf
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)
'將上傳的文件保存到path所指定的目錄下面。
'Formfield 上傳表單的"file"域名 Path
' 要保存文件的服務器絕對路徑，形式為："d:\path\subpath"或"d:\path\subpath\"
'MaxSize 限制上傳文件的最大長度，以KByte為單位
' SavType 服務器保存文件的方式：
'0 唯一文件名方式，如果有同名則自動改名；
'1 報錯方式，如果有同名則出錯；
'2 覆蓋方式，如果有同名則覆蓋原來的文件
Function SaveFile(FormFileField, Path, MaxSize, SavType)
Dim StreamObj,StreamObj1
Set StreamObj = Server.CreateObject("ADODB.Stream")
Set StreamObj1 = Server.CreateObject("ADODB.Stream")
StreamObj.Mode = 3
StreamObj1.Mode = 3
StreamObj.Type = 1
StreamObj1.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
If Right(Path,1) <> "\" Then
Path = Path & "\"
End If
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType))
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
StreamObj.Open
StreamObj1.Open
StreamObj.Write FormData
StreamObj.Position=FileStart-1
StreamObj.CopyTo StreamObj1,FileLen
If SavType =0 Then
SavType = 1
End If
StreamObj1.SaveToFile Path & FileName, SavType
StreamObj.Close
StreamObj1.Close
If SaveFile <> "" Then
SaveFile = SaveFile & "," & FileName
Else
SaveFile = FileName
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",*TooBig*"
Else
SaveFile = "*TooBig*"
End If
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
'獲取表單值
Function GetFormVal(FormName)
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
Else
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
Function bin2str(binstr)
Dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = LenB(binstr)
For i = 1 To varlen
If skipflag = 0 Then
clow = MidB(binstr, i, 1)
If AscB(clow) > 127 Then
ccc = ccc & Chr(AscW(MidB(binstr, i + 1, 1) & clow))
skipflag = 1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag = 0
End If
Next
bin2str = ccc
End Function
Function str2bin(str)
For i = 1 To Len(str)
str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function
Function GetFileName(str,path,savtype)
Set fs = Server.CreateObject("Scripting.FileSystemObject")
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
End If
Next
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
hFileName = hFileName & str2bin(i)
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
End If
Next
End If
Set fs = Nothing
GetFileName = FileName
End Function
%>
********************************************************************************
下面是上傳文件部分代碼
<%
if request.QueryString("action")="save" then
dim upload,imgfile,filePath,extname,fname
set upload=new upload_5xsoft ''建立上傳對象
set imgfile=upload.file("picfile")
'圖片存儲位置
imgdir=upload.Form("imgdir")
if imgfile.FileSize>0 then ''如果 FileSize > 0 說明有文件資料
extname=right(imgfile.filename,3)
fname=year(now())&month(now())&day(now())&hour(now())&second(now())&minute(now())&"."&extname
image=replace(imgdir&fname,"/","\")
imgfile.SaveAs image
image=replace(image,server.MapPath("\"),"")
image=replace(image,"\","/")
if left(image,1)<>"/" then
image="/"&image
end if
end if
set imgfile=nothing
response.Write("<a href="""&image&""" target=""blank"">"&image&"</a>"&vbcrlf)
response.Write("<a href=""?imgdir="&imgdir&""" onclick=""top.mainFrame.document.form1.img.value=''"">清除</a>")
response.Write("<script LANGUAGE=VBSCRIPT>top.frames(""mainFrame"").document.form1.img.value="""&image&"""" & vbcrlf & "top.frames(""mainFrame"").document.proimg.src="""&image&"""</script>")
response.End()
elseif request("action")="edit" and len(request("file"))>0 then
image=request("file")
imgdir=request("imgdir")
response.Write("<a href="""&image&""" target=""blank"">"&image&"</a>"&vbcrlf)
response.Write("[<a href='?imgdir="&imgdir&"' onclick=""top.mainFrame.document.form1.img.value=''"">清除</a>]")
response.Write("<script LANGUAGE=VBSCRIPT>top.frames(""mainFrame"").document.form1.img.value="""&image&"""" & vbcrlf & "top.frames(""mainFrame"").document.proimg.src="""&image&"""</script>")
response.End()
else
%>
全站熱搜
留言列表
我的紀錄 (4)
