<%
'================================================
'函数名：FormatDate - 2009-10-12 修订
'作 用：格式化日期
'参 数：DateAndTime ----原日期和时间
' para ----日期格式
'返回值：格式化后的日期
'================================================
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1"
'显示格式：09年07月06日 13:44
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
'显示格式：2009-07-06
strDateTime = y & "-" & m & "-" & d
Case "3"
'显示格式：2009/07/06
strDateTime = y & "/" & m & "/" & d
Case "4"
'显示格式：2009年07月06日
strDateTime = y & "年" & m & "月" & d & "日"
Case "5"
'显示格式：07-06 13:45
strDateTime = m & "-" & d & " " & h & ":" & mi
Case "6"
'显示格式：07/06
strDateTime = m & "/" & d
Case "7"
'显示格式：07月06日
strDateTime = m & "月" & d & "日"
Case "8"
'显示格式：2009年07月
strDateTime = y & "年" & m & "月"
Case "9"
'显示格式：2009-07
strDateTime = y & "-" & m
Case "10"
'显示格式：2009/07
strDateTime = y & "/" & m
Case "11"
'显示格式：09年07月06日 13:45
strDateTime = right(y,2) & "年" &m & "月" & d & "日 " & h & ":" & mi
Case "12"
'显示格式：09-07-06
strDateTime = right(y,2) & "-" &m & "-" & d
Case "13"
'显示格式：07-06
strDateTime = m & "-" & d
Case "14"
'显示格式：13:45
strDateTime = h & ":" & mi
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function
%>
'================================================
'函数名：FormatDate - 2009-10-12 修订
'作 用：格式化日期
'参 数：DateAndTime ----原日期和时间
' para ----日期格式
'返回值：格式化后的日期
'================================================
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1"
'显示格式：09年07月06日 13:44
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
'显示格式：2009-07-06
strDateTime = y & "-" & m & "-" & d
Case "3"
'显示格式：2009/07/06
strDateTime = y & "/" & m & "/" & d
Case "4"
'显示格式：2009年07月06日
strDateTime = y & "年" & m & "月" & d & "日"
Case "5"
'显示格式：07-06 13:45
strDateTime = m & "-" & d & " " & h & ":" & mi
Case "6"
'显示格式：07/06
strDateTime = m & "/" & d
Case "7"
'显示格式：07月06日
strDateTime = m & "月" & d & "日"
Case "8"
'显示格式：2009年07月
strDateTime = y & "年" & m & "月"
Case "9"
'显示格式：2009-07
strDateTime = y & "-" & m
Case "10"
'显示格式：2009/07
strDateTime = y & "/" & m
Case "11"
'显示格式：09年07月06日 13:45
strDateTime = right(y,2) & "年" &m & "月" & d & "日 " & h & ":" & mi
Case "12"
'显示格式：09-07-06
strDateTime = right(y,2) & "-" &m & "-" & d
Case "13"
'显示格式：07-06
strDateTime = m & "-" & d
Case "14"
'显示格式：13:45
strDateTime = h & ":" & mi
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function
%>
文件上传方法.... upload_ytpc.inc
<%
set upload=new upload_ytpc
IF upload.Form("tijiao")="" THEN
id=request.QueryString("id")
if id="" then
cation="添 加"
else
cation="修 改"
end if
%>
注意文件上传需要声明:<form name="formsousuo" action="yuangongupdate.asp" method="post" enctype="multipart/form-data" onsubmit="return checkYuangong();">
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_ytpc
Class upload_ytpc
dim objForm,objFile,Version
Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function
Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version=""
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_ytpc = Server.CreateObject("adodb.stream")
Data_ytpc.Type = 1
Data_ytpc.Mode =3
Data_ytpc.Open
Data_ytpc.Write Request.BinaryRead(Request.TotalBytes)
Data_ytpc.Position=0
RequestData =Data_ytpc.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_ytpc.Position = iFormStart
Data_ytpc.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_ytpc.Position = iInfoEnd
Data_ytpc.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_ytpc.Close
set Data_ytpc =nothing
end if
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_ytpc.position=FileStart
Data_ytpc.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>
dim Data_ytpc
Class upload_ytpc
dim objForm,objFile,Version
Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function
Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version=""
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_ytpc = Server.CreateObject("adodb.stream")
Data_ytpc.Type = 1
Data_ytpc.Mode =3
Data_ytpc.Open
Data_ytpc.Write Request.BinaryRead(Request.TotalBytes)
Data_ytpc.Position=0
RequestData =Data_ytpc.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_ytpc.Position = iFormStart
Data_ytpc.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_ytpc.Position = iInfoEnd
Data_ytpc.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_ytpc.Close
set Data_ytpc =nothing
end if
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_ytpc.position=FileStart
Data_ytpc.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>