<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>


<% 
'*************************************
'日期转换函数
'*************************************
Function DateToStr(DateTime,ShowType)  
	Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
	Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
	TimeZone1="+0800"
	TimeZone2="+08:00"
	FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
	shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
    Fullmonth=Array("January","February","March","April","May","June","July","August","September","October","November","December")
    Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")

	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	DateWeek=weekday(DateTime)
	DateSecond=Second(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
	Select Case ShowType
	Case "Y-m-d"  
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
	Case "Y-m-d H:I A"
		Dim DateAMPM
		If DateHour>12 Then 
			DateHour=DateHour-12
			DateAMPM="PM"
		Else
			DateHour=DateHour
			DateAMPM="AM"
		End If
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
	Case "Y-m-d H:I:S"
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	Case "YmdHIS"
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond	
	Case "ym"
		DateToStr=Right(Year(DateTime),2)&DateMonth
	Case "d"
		DateToStr=DateDay
    Case "ymd"
        DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
    Case "mdy" 
        Dim DayEnd
        select Case DateDay
         Case 1 
          DayEnd="st"
         Case 2
          DayEnd="nd"
         Case 3
          DayEnd="rd"
         Case Else
          DayEnd="th"
        End Select 
        DateToStr=Fullmonth(DateMonth-1)&" "&DateDay&DayEnd&" "&Right(Year(DateTime),4)
    Case "w,d m y H:I:S" 
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
        DateToStr=shortWeekday(DateWeek-1)&","&DateDay&" "& Left(Fullmonth(DateMonth-1),3) &" "&Right(Year(DateTime),4)&" "&DateHour&":"&DateMinute&":"&DateSecond&" "&TimeZone1
    Case "y-m-dTH:I:S"
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&TimeZone2
	Case Else
		If Len(DateHour)<2 Then DateHour="0"&DateHour
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
	End Select
End Function

'*************************************
'检测是否有效的E-mail地址
'*************************************
Function IsValidEmail(Email) 
	Dim names, name, i, c
	IsValidEmail = True
	Names = Split(email, "@")
	If UBound(names) <> 1 Then
   		IsValidEmail = False
   		Exit Function
	End If
	For Each name IN names
		If Len(name) <= 0 Then
     		IsValidEmail = False
     		Exit Function
   		End If
   		For i = 1 to Len(name)
     		c = Lcase(Mid(name, i, 1))
     		If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
       			IsValidEmail = false
       			Exit Function
     		End If
   		Next
   		If Left(name, 1) = "." or Right(name, 1) = "." Then
      		IsValidEmail = false
      		Exit Function
   		End If
	Next
	If InStr(names(1), ".") <= 0 Then
   		IsValidEmail = False
   		Exit Function
	End If
	i = Len(names(1)) - InStrRev(names(1), ".")
	If i <> 2 And i <> 3 Then
   		IsValidEmail = False
   		Exit Function
	End If
	If InStr(email, "..") > 0 Then
   		IsValidEmail = False
	End If
End Function

'*************************************
'获取客户端IP
'*************************************
function getIP() 
		 dim strIP,IP_Ary,strIP_list
		 strIP_list=Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
		 
		 If InStr(strIP_list,",")<>0 Then
			IP_Ary = Split(strIP_list,",")
			strIP = IP_Ary(0)
		 Else
			strIP = strIP_list
		 End IF
		 
		 If strIP=Empty Then strIP=Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
		 getIP=strIP
End Function

'*************************************
'Tag转换函数
'*************************************
Function Tags(TagName)
	Dim TempTag,GetTag
	TagName=Split(TagName," ")
	For Each GetTag in TagName
		TempTag=TempTag & "<a href=""Default.asp?Tag=" & server.URLencode(GetTag) & """>" & GetTag & "</a> "
	next
	Tags=TempTag
End Function

'*************************************
'解码函数
'*************************************
function   urldecoding(vstrin) 
IF vstrin="" then
	urldecoding=""
else  
  dim   i,strreturn,strSpecial   
  strSpecial   =   "!""#$%&'()*+,./:;<=>?@[\]^`{|}~%"   
  strreturn   =   ""   
   for   i   =   1   to   len(vstrin)   
   thischr   =   mid(vstrin,i,1)   
    if   thischr="%"   then   
     intasc=eval("&h"+mid(vstrin,i+1,2))   
     if   instr(strSpecial,chr(intasc))>0   then   
      strreturn=   strreturn   &   chr(intasc)   
      i=i+2   
     else   
      intasc=eval("&h"+mid(vstrin,i+1,2)+mid(vstrin,i+4,2))   
      strreturn=   strreturn   &   chr(intasc)   
      i=i+5   
     end   if   
    else   
     if   thischr="+"   then   
      strreturn=   strreturn   &   "   "   
     else   
      strreturn=   strreturn   &   thischr   
     end   if   
    end   if   
   next   
  urldecoding   =   strreturn   
end if
end   function   

'*************************************
'写入数据转换函数
'*************************************
Function HTMLtoStr(HTMLtxt)
	HTMLtxt=Replace(HTMLtxt,"<","&lt")
	HTMLtxt=Replace(HTMLtxt,">","&gt;")
	HTMLtxt=Replace(HTMLtxt,"="," ")
	HTMLtxt=Replace(HTMLtxt,VBCrlf,"<br />")
	HTMLtxt=Replace(HTMLtxt,Chr(10),"<br />")
	HTMLtxt=Replace(HTMLtxt,Chr(13),"<br />")
	HTMLtxt=Replace(HTMLtxt,"<br /><br /><br /><br />","<br />")
	HTMLtoStr=HTMLtxt
End Function

'*************************************
'反写入数据转换函数
'*************************************
Function StrtoHTML(HTMLtxt)
	HTMLtxt=Replace(HTMLtxt,"<br />",VBCrlf)
	HTMLtxt=Replace(HTMLtxt,"&lt","<")
	HTMLtxt=Replace(HTMLtxt,"&gt;",">")
	HTMLtoStr=HTMLtxt
End Function

'*************************************
'分解图片地址函数
'*************************************
Function UrlToImg(ImgUrl)
	Dim TempImg,GetImg
	ImgUrl=Split(ImgUrl,"/")
	For Each GetImg In ImgUrl
		TempImg=GetImg
	Next
	UrlToImg=TempImg
End Function

'*************************************
'Byte转Str函数
'*************************************
Function BtoS (bstr)
	If IsNull(bstr)=False Then
		for i = 0 to lenb(bstr) - 1
			bchr = midb(bstr,i+1,1)
			If ascb(bchr)>127 Then '汉字是双字节，得两个字符一起处理
				temp = temp&chr(ascw(midb(bstr, i+2, 1)&bchr))

				i = i+1
			Else
				temp = temp&chr(ascb(bchr))
			End If
		next
	End If
	BtoS = temp
End Function  

Function BtoS_Debug (bstr)
	If IsNull(bstr)=False Then
		for i = 0 to lenb(bstr) - 1
			bchr = midb(bstr,i+1,1)
			temp = temp & hex(ascb(bchr)) & " "
		next
	End If
	BtoS_Debug = temp
end function

'*************************************
'读取图片属性函数
'*************************************
Function GetImgType(ImgUrl)
	Dim TempType
	TempType=right(ImgUrl,4)
	If Left(TempType,1)="." then TempType=right(ImgUrl,3)
	GetImgType=TempType
End Function
%>





<%'Option Explicit
Response.Buffer = True
Server.ScriptTimeOut = 90

Session.CodePage=65001

If Trim(Request.QueryString("CP"))="GBK" Then Session.CodePage = 936

'定义 Cookie,Application 域，必须修改，否则可能运行不正常
Const CookieName="DPDex"

'上传文件的大小以及后缀名限制
'Dim Adm_UP_FileSize,Adm_UP_FileType,Mem_UP_FileSize,Mem_UP_FileType,MemCanUP
'MemCanUP=1             '设定一般用户是否可以上传文件，1为可以上传，0为不可以上传
'Adm_UP_FileSize = 20480000
'Adm_UP_FileType = "JPG,PNG,GIF,jpg,png,gif"
'Mem_UP_FileSize = 1024000
'Mem_UP_FileType = "JPG,PNG,GIF,jpg,png,gif"
%>
<%Function IsvalidFile(File_Type)   '限制上传文件类型
	IsvalidFile = False
	Dim GName
	For Each GName in UP_FileType
		If File_Type = GName Then
			IsvalidFile = True
			Exit For
		End If
	Next
End Function

Function SplitLines(byVal Content,byVal ContentNums) '切割内容
Dim ts,i,l
If IsNull(Content) Then Exit Function
i=1
ts = 0
For i=1 to Len(Content)
l=Mid(Content,i,4)
If l="<br>" Then
ts=ts+1
End If
If ts>ContentNums Then Exit For 
Next
If ts>ContentNums Then
Content=Left(Content,i-1)
End If
SplitLines=Content
End Function
Function Generator(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz1234567890" 
Generator = ""
If isNumeric(Length) = False Then 
Exit Function 
End If 
For i = 1 to Length 
Randomize 
Generator = Generator & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
Next 
End Function 
%>
<%
Dim oUpFileStream

Class Upload_File

	Dim Forms,File,Err
	dim FormDatas,FormSizes

	Private Sub Class_Initialize
		Err=-1
	End Sub

	Private Sub Class_Terminate 
		'Clear Variables & Objects
		If Err < 0 Then
			oUpFileStream.Close
			Forms.RemoveAll
			File.RemoveAll
			Set Forms=Nothing
			Set File=Nothing
			Set oUpFileStream =Nothing
		End If
	End Sub
	
	Public Sub GetDate(RetSize)
		'Define Variables
		Dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
		Dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
		Dim iFindStart,iFindEnd
		Dim iFormStart,iFormEnd,sFormName

		If Request.TotalBytes < 1 Then
			Err=1
			Exit Sub
		End If
		If RetSize > 0 Then 
			If Request.TotalBytes > RetSize Then
				Err=2
				Exit Sub
			End If
		End If
		Set Forms = Server.CreateObject("Scripting.Dictionary")
		Forms.CompareMode = 1
		Set File = Server.CreateObject("Scripting.Dictionary")
		File.CompareMode = 1
		Set tStream = Server.CreateObject("Adodb.Stream")
		Set oUpFileStream = Server.CreateObject("Adodb.Stream")
		oUpFileStream.Type = 1
		oUpFileStream.Mode = 3
		oUpFileStream.Open 
		FormSizes=Request.TotalBytes
		FormDatas=Request.BinaryRead(FormSizes)
		oUpFileStream.Write FormDatas
		oUpFileStream.Position=0
		RequestBinDate = oUpFileStream.Read 
		iFormEnd = oUpFileStream.Size
		bCrLf = chrB(13) & chrB(10)
		'Get Seperators
		sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
		iStart = LenB (sStart)
		iFormStart = iStart+2
		'Split Items
		Do
			iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
			tStream.Type = 1
			tStream.Mode = 3
			tStream.Open
			oUpFileStream.Position = iFormStart
			oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
			tStream.Position = 0
			tStream.Type = 2
			tStream.Charset = "utf-8"
			sInfo = tStream.ReadText 
			'Get form item name
			iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1
			iFindStart = InStr(22,sInfo,"name=""",1)+6
			iFindEnd = InStr(iFindStart,sInfo,"""",1)
			sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
			'If it's a file
			If InStr (45,sInfo,"filename=""",1) > 0 Then
				Set oFileInfo= new FileInfo
				'Get File attributes
				iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
				iFindEnd = InStr(iFindStart,sInfo,"""",1)
				sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
				oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
				oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\"))
				oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
				iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
				iFindEnd = InStr(iFindStart,sInfo,vbCr)
				oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
				oFileInfo.FileStart = iInfoEnd
				oFileInfo.FileSize = iFormStart -iInfoEnd -2
				oFileInfo.FormName = sFormName
				file.add sFormName,oFileInfo
			Else
				'If it's form item
				tStream.Close
				tStream.Type = 1
				tStream.Mode = 3
				tStream.Open
				oUpFileStream.Position = iInfoEnd 
				oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
				tStream.Position = 0
				tStream.Type = 2
				tStream.Charset = "utf-8"
				sFormvalue = tStream.ReadText 
				If Forms.Exists (sFormName) Then
					Forms (sFormName) = Forms (sFormName) & ", " & sFormValue
				Else
					Forms.Add sFormName,sFormvalue
				End If
			End If
			tStream.Close
			iFormStart = iFormStart+iStart+2
			'Exit at end of file
		Loop Until (iFormStart+2) = iFormEnd 
		RequestBinDate=""
		Set tStream = Nothing
	End Sub

End Class

	'Get File Info
Class FileInfo
	Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt

	Private Sub Class_Initialize 
		FileName = ""
		FilePath = ""
		FileSize = 0
		FileStart= 0
		FormName = ""
		FileType = ""
		FileExt = ""
	End Sub

	'Save File Method
	Public Function SaveToFile(FullPath)
		Dim oFileStream,ErrorChar,i
		On Error Resume Next
		Set oFileStream=CreateObject("Adodb.Stream")
		oFileStream.Type=1
		oFileStream.Mode=3
		oFileStream.Open
		oUpFileStream.position=FileStart
		oUpFileStream.copyto oFileStream,FileSize
		oFileStream.SaveToFile FullPath,2
		oFileStream.Close
		Set oFileStream=Nothing
	End Function

	'Get File Content
	Public Function GetDate
		oUpFileStream.Position =FileStart
		GetDate=oUpFileStream.Read(FileSize)
	End Function
End Class
%>
<%'On Error Resume Next%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" 
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<link rel="stylesheet" href="DPstyle.css" type="text/css" media="screen" />
<title>上传图片 口袋吧珍钻PM图鉴</title>
</head>
<body>

<table height="23px" width="100%" border="0" cellspacing="0" cellpadding="0" bgcolor="#FFFFFF">
<tr><%
Server.ScriptTimeOut = 999

	Dim UP_FileType,UP_FileSize
	'If memStatus="SupAdmin" Or memStatus="Admin" Then
		'UP_FileType=Adm_UP_FileType
		'UP_FileSize=Adm_UP_FileSize
	'Else
		UP_FileType="JPG,PNG,GIF,jpg,png,gif"
		UP_FileSize=1024000
	'End If
	IF Request.QueryString("action")="upload" Then	
		Response.Write("<td>")
		Dim FSO,FSOIsOK
		FSOIsOK=1
		Err.Clear
		Set FSO=Server.CreateObject("Scripting.FileSystemObject")
		If Err<>0 Then
			Err.Clear
			FSOIsOK=0
		End If
		Dim D_Name,F_Name
		If FSOIsOK=1 Then
			D_Name="month_"&DateToStr(Now(),"ym")
			If FSO.FolderExists(Server.MapPath("attachments/"&D_Name))=False Then
				FSO.CreateFolder Server.MapPath("attachments/"&D_Name)
			End If
		Else
			D_Name="All_Files"
		End If
		Set FSO=Nothing
		Dim FileUP
		Set FileUP=New Upload_File
		FileUP.GetDate(-1)
		Dim F_File,F_FileType,F_FileName
		Set F_File=FileUP.File("File")
		
Dim PMID
PMID=FileUP.Forms("PMID") 

		F_FileName = F_File.FileName
		F_FileType = Ucase(F_File.FileExt)
		IF F_File.FileSize > Int(UP_FileSize) Then
			Response.Write("<a href='javascript:history.go(-1);'>文件大小超出，请返回重新上传</a>")
		ElseIF IsvalidFileName(F_FileName) = False Then
			Response.Write("<a href='javascript:history.go(-1);'>文件名称非法，请返回重新上传</a>")
		ElseIF IsvalidFileExt(F_FileType) = False Then
			Response.Write("<a href='javascript:history.go(-1);'>文件格式非法，请返回重新上传</a>")
		Else
			If FSOIsOK=1 Then
				Dim FileIsExists
				Set FSO=Server.CreateObject("Scripting.FileSystemObject")
				FileIsExists=FSO.FileExists(Server.MapPath("attachments/"&D_Name&"/"&F_Name))
				Do
					'F_Name=Generator(4)&"_"&F_FileName
					F_Name=Hour(Now())&Minute(Now())&Second(Now())&"_"&Generator(4)&"."&GetImgType(F_FileName)
				Loop Until FSO.FileExists(Server.MapPath("attachments/"&D_Name&"/"&F_Name)) = False
				Set FSO=Nothing
			Else
				F_Name=Generator(4)&"_"&Hour(Now())&Minute(Now())&Second(Now())&"_"&F_FileName
			End If
			F_File.SaveToFile Server.MapPath("attachments/"&D_Name&"/"&F_Name)
			
%>
<%

'Dim FormData,FormSize,DataStart,CLStr,DivStr,TempDates1,TempDates2,TempDates3

'FormData=FileUP.Formdatas
'FormSize=FileUP.FormSizes

'CLStr=ChrB(13)&ChrB(10)
'DataStart=InStrB(FormData,CLStr&CLStr)+4  '4是两对回车换行符的长度
'DivStr=LeftB(FormData,InStrB(FormData,CLStr)-1)
'DataSize=InStrB(DataStart+1,FormData,DivStr)-DataStart-2
'Names=MidB(FormData,DataStart,DataSize)

'TempDates1=rightB(FormData,LenB(FormData)-InStrB(DataStart+1,FormData,DivStr))
'DivStr=LeftB(TempDates1,InStrB(TempDates1,CLStr)-1)
'DataSize=InStrB(DataStart+1,TempDates1,DivStr)-DataStart-2-1
'Email=MidB(TempDates1,DataStart,DataSize)

'TempDates2=rightB(TempDates1,LenB(TempDates1)-InStrB(DataStart+1,TempDates1,DivStr))
'DataStart=InStrB(TempDates2,CLStr&CLStr)+4
'DivStr=LeftB(TempDates2,InStrB(TempDates2,CLStr)-1)
'DataSize=InStrB(DataStart+1,TempDates2,DivStr)-DataStart-2-2
'tag=MidB(TempDates2,DataStart,DataSize)

'TempDates3=rightB(TempDates2,LenB(TempDates2)-InStrB(DataStart+1,TempDates2,DivStr))
'DataStart=InStrB(TempDates3,CLStr&CLStr)+4
'DivStr=LeftB(TempDates3,InStrB(TempDates3,CLStr)-1)
'DataSize=InStrB(DataStart+1,TempDates3,DivStr)-DataStart-2-3
'Texts=MidB(TempDates3,DataStart,DataSize)


'On Error goto 0

'dim W,H

'Set Jpeg = Server.CreateObject("Persits.Jpeg") '调用组件
'Path =Request.ServerVariables("APPL_PHYSICAL_PATH") & "attachments\" & D_Name & "\" & F_Name

'Jpeg.Open Path '打开图片

'W=Jpeg.OriginalWidth
'H=Jpeg.OriginalHeight

'If Jpeg.OriginalWidth / Jpeg.OriginalHeight >= 1 then
'Jpeg.Width = 200
'Jpeg.Height = int((200/Jpeg.OriginalWidth)*Jpeg.OriginalHeight)

'elseif Jpeg.OriginalWidth / Jpeg.OriginalHeight < 1 then
'Jpeg.Height = 200
'Jpeg.Width= int((200/Jpeg.OriginalHeight)*Jpeg.Width)

'end if
'DestPath =Request.ServerVariables("APPL_PHYSICAL_PATH") & "attachments\" & D_Name & "\z_" & F_Name

'Jpeg.Save DestPath 

PMID=cint(trim(HTMLtoStr(PMID)))
if PMID="" then PMID=0

Dim cnn,dete,dete2,sql
set cnn=server.CreateObject("ADODB.Connection")
set RS=server.CreateObject("ADODB.Recordset")
'set dete2=server.CreateObject("ADODB.Recordset")
cnn.connectionstring="provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.MapPath("ImgData.asp")
cnn.open
response.Buffer=true 


SQL="Select * From List;"
RS.open sql,cnn,3,3
RS.AddNew
	RS("PMID")=PMID
	RS("time")=Now
	RS("Img")="attachments/" & D_Name & "/" & F_Name
	RS("IP")=GetIP()
	RS("Mods")=True
RS.Update
RS.close

cnn.close
			
			Response.Write("文件上传成功，待管理员审核操作后图片方可显示。&nbsp;&nbsp;<a href=""DPImgUpLoad.asp"">继续上传</a>")   '<meta http-equiv='refresh' content='1;url=UpLoad.asp'>
%>
<br />
<%
		End IF
		Set F_File=Nothing
		Set FileUP=Nothing
		Response.Write("</td>")
	Else %>
		<form enctype="multipart/form-data" method="post" action="DPImgUpLoad.asp?action=upload">
		<td>编号：
		  <select name="PMID" id="PMID">
		  <%
		   Function FormatID(ID)
			FormatID=ID
			 if len(FormatID)<2 then FormatID="00"& FormatID
			 if len(FormatID)<3 then FormatID="0" & FormatID
			End Function
		   Dim PMIDs,IDTemp
		  		IDTemp=Cint(Request.QueryString("PMID"))
				IF IDTemp=0 then IDTemp=1
				response.Write(IDTemp)
		  		For PMIDs=1 to 493 %>
		    <option value="<%=PMIDs%>" <% IF IDTemp=PMIDs then%> selected="selected"<% end if %>><%=FormatID(PMIDs)%></option>
		  <% Next %>
	      </select>
		图片：
		<input name="File" type="File" size="20" tabindex="6">
		支持.jpg/.gif/.png格式的图片(最大1M)
		&nbsp;&nbsp;
		<input type="Submit" name="Submit" value="上传" tabindex="7" /> 
		
  </td>
		</form>
	<%End IF

Function IsvalidFileName(File_Name)
	IsvalidFileName = True
	'IsvalidFileName = False
	'Dim re,reStr
	'Set re=new RegExp
	're.IgnoreCase =True
	're.Global=True
	're.Pattern="[^_\.a-zA-Z\d\s]"
	'reStr=re.Replace(File_Name,"")
	'If File_Name = reStr Then IsvalidFileName=True
	'Set re=Nothing
End Function

Function IsvalidFileExt(File_Type)
	Dim GName,UP_FileTypeArr
	UP_FileTypeArr=Split(UP_FileType,",")
	IsvalidFileExt = False
	For Each GName In UP_FileTypeArr
		If File_Type = GName Then
			IsvalidFileExt = True
			Exit For
		End If
	Next
End Function

%>
</tr></table>
</body>