'转换页面

sub openurl(page1)
	window.open page1,""
end sub
sub gotourl(page1)
	window.location=page1
end sub


'编辑框颜色
sub inputonk1(id)
	t1=document.all.item(id).classname
	t1=replace(t1,"1","2")
	t1=replace(t1,"3","2")
	document.all.item(id).classname=t1
end sub

sub inputoutk1(id)
	t1=document.all.item(id).classname
	t1=replace(t1,"2","1")
	t1=replace(t1,"3","1")
	document.all.item(id).classname=t1
end sub

function obj(id1)
	set obj=document.all.item(id1)
end function


'检测输入内容
dim TestJg
TestJg=""

sub AddTestJg(id)
	TestJg=TestJg&"{"&id&"}"
end sub
sub DelTestJg(id)
	TestJg=replace(TestJg,"{"&id&"}","")
end sub

sub SubwxySub()
	if TestJg="" then
		document.all.item("Subwxy").submit()
	else
		MsgBoxErr "请修正红色格子的错误!"
	end if
end sub

Function GetWxySub()
	if TestJg="" then
		GetWxySub=true
	else
		MsgBoxErr "请修正红色格子的错误!"
		GetWxySub=false
	end if
end function
function TestTestJg(id)
	if instr(TestJg,"{"&id&"}")>0 then
		TestTestJg=true
	else
		TestTestJg=false
	end if
end function
sub MsgBoxErr(textA)
	msgbox textA,16,"错误"
end sub

function MsgBoxYesNo(textA)
	MsgBoxYesNo=msgbox(textA,4+32,"注意")
end function
'文本内容检测
sub TestText(id,wwtwrite,wwtmin,wwtmax,wwttype,st)
	tt=document.all.item(id).value
	DelTestJg id
	
	JCT=false
	
	if len(tt)=0 and not wwtwrite then
		textA=""
		JCT=true
	elseif len(tt)=0 and (clng(wwtmin)>0 or wwtwrite) then
		textA="不能为空"
	elseif len(tt)<clng(wwtmin) then
		textA="不能少于"&wwtmin&"个字符,当前"&len(tt)&"个字符"
	elseif len(tt)>clng(wwtmax) and clng(wwtmax)>0 then
		textA="不能多于"&wwtmax &"个字符,当前"&len(tt)&"个字符"
	elseif wwttype<>"" and wwttype<>"[MAIL]" and not InStrString(tt,wwttype) then
		textA="有无效字符存在"
	elseif wwttype="[MAIL]" and not IsEmail(tt) then
		textA="不是有效的邮件格式"
	else
		JCT=true
		textA="填写正确"
	end if
	
	if JCT then
		if texta<>"" then textA="<img border=""0"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
	else
		if texta<>"" then textA="<img border=""0"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id
		'document.all.item(id).classname="k3"
		t1=document.all.item(id).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(id).classname=t1
	end if
	if st then
		textA=""
	end if
	document.all.item(id&"_text").innerHTML=textA
end sub

'检测定长
sub TestTextLong(id,wwtlong(),wwttype,st)
	tt=document.all.item(id).value
	DelTestJg id
	
	JCT=false
	textA=""
	if len(tt)=0 and clng(wwtlong(1))>0 then
		textA="不能为空"
	end if
	
	if textA="" then
		textA1=""
		textA2=""
		for i1=1 to ubound(wwtlong)
			if len(tt)=wwtlong(i1) then
				textA1=textA1&"a"
			else
				textA1=textA1&"b"
			end if
			textA2=textA2&"b"
		next
		if texta1=textA2 then
			textA="长度不符合条件"
		end if
	end if
	
	if textA="" and wwttype<>""  and not InStrString(tt,wwttype) then
		textA="有无效字符存在"
	end if
	
	if textA="" and tt="" then
		textA=""
		JCT=true
	elseif textA="" then
		JCT=true
		textA="填写正确"
	end if
	
	if JCT then
		if texta<>"" then textA="<img border=""0"" width=""14"" height=""14"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
	else
		if texta<>"" then textA="<img border=""0"" width=""14"" height=""14"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id
		'document.all.item(id).classname="k3"
		t1=document.all.item(id).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(id).classname=t1
	end if
	if st then
		textA=""
	end if
	document.all.item(id&"_text").innerHTML=textA
end sub



'文本内容检测
sub TestRead(id,Clasid,tt1,wwtmin,wwtmax,st)
	'tt=document.all.item(id).value
	tt=tt1
	tttype=getremtype(tt)
	'document.title=tt1
	DelTestJg id
	
	JCT=false
	
	if len(tt)=0 and clng(wwtmin)>0 then
		textA="不能为空"
	elseif len(tt)<clng(wwtmin) then
		textA="不能少于"&wwtmin&"个字符,当前"&len(tt)&"个字符"
	elseif len(tt)>clng(wwtmax) then
		textA="不能多于"&wwtmax &"个字符,当前"&len(tt)&"个字符"
	elseif wwtmin=0 and tt="" then
		textA=""
		JCT=true
	else
		JCT=true
		textA="填写正确"
	end if
	
	if JCT then
		if texta<>"" then textA="<img border=""0"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
		t1=document.all.item(Clasid).classname
		t1=replace(t1,"3","1")
		t1=replace(t1,"2","1")
		document.all.item(Clasid).classname=t1
	else
		if texta<>"" then textA="<img border=""0"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id
		'document.all.item(id).classname="k3"
		t1=document.all.item(Clasid).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(Clasid).classname=t1
	end if
	if st then
		textA=""
	end if
	document.all.item(id&"_text").innerHTML=textA
end sub
'数字内容检测
sub TestNumber(id,wwtmin,wwtmax,st)
	JCT=false
	
	if document.all.item(id).value="" or not IsNumeric(document.all.item(id).value) then document.all.item(id).value=0
	tt=ccur(document.all.item(id).value)
	
	if tt<ccur(wwtmin) then
		textA="不能小于"&wwtmin
		if st then
			document.all.item(id).value=clng(wwtmin)
			'JCT=true
		end if
	elseif tt>ccur(wwtmax) then
		textA="不能大于"&wwtmax
		if st then
			document.all.item(id).value=clng(wwtmax)
			'JCT=true
		end if
	else
		textA="填写正确"
		JCT=true
	end if
	
	if JCT then
		textA="<img border=""0"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
	else
		textA="<img border=""0"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id
		t1=document.all.item(id).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(id).classname=t1
		
	end if
	if st then
		textA=""
	end if
	document.all.item(id&"_text").innerHTML=textA
end sub


'货币内容检测
sub TestMoney(id,wwtmin,wwtmax,st)
	JCT=false
	
	if document.all.item(id).value="" or not IsNumeric(document.all.item(id).value) then document.all.item(id).value=wwtmin
	
	document.all.item(id).value=formatmoney(document.all.item(id).value)
	
	tt1=ccur(formatmoney(document.all.item(id).value))
	
	if tt1<ccur(wwtmin) then
		textA="不能小于"&wwtmin
		
		if st then
			document.all.item(id).value=formatmoney(wwtmin)
			JCT=true
		end if
		
	elseif tt1>ccur(wwtmax) then
		textA="不能大于"&wwtmax
		if st then
			document.all.item(id).value=formatmoney(wwtmax)
			JCT=true
		end if
	else
		textA="填写正确"
		JCT=true
	end if
	
	if JCT then
		textA="<img border=""0"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
	else
		textA="<img border=""0"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id
		t1=document.all.item(id).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(id).classname=t1
		
	end if
	
	if st then
		textA=""
	else
		document.all.item(id&"_text").innerHTML=textA
	end if
	
	
end sub


sub TestSelect(id,wwtwrite,st)
	tt=document.all.item(id).options(document.all.item(id).selectedIndex).value
	DelTestJg id
	
	JCT=false
	
	if tt="" and not wwtwrite then
		textA=""
		JCT=true
	elseif tt="" and wwtwrite then
		textA="必须选择"
	else
		JCT=true
		textA="选择正确"
	end if
	
	if JCT then
		if texta<>"" then textA="<img border=""0"" width=""14"" height=""14"" src=""../Images/InputYes.png"" align=""absmiddle""><font color=""#008000""> " & textA & "</font>" 
		DelTestJg id
	else
		if texta<>"" then textA="<img border=""0"" width=""14"" height=""14"" src=""../Images/InputNo.png"" align=""absmiddle""><font color=""#FF0000""> " & textA & "</font>"
		AddTestJg id

		t1=document.all.item(id).classname
		t1=replace(t1,"1","3")
		t1=replace(t1,"2","3")
		document.all.item(id).classname=t1
	end if
	if st then
		textA=""
	end if
	document.all.item(id&"_text").innerHTML=textA
end sub

function KeyPressTest(KeyAscii,wwttype)
	KeyPressTest=KeyAscii
	If KeyAscii = 8 or KeyAscii = 13 or wwttype="" Then Exit function
    
    If InStr(wwttype, Chr(KeyAscii)) = 0 Then
        KeyPressTest= 0
    End If
end function


sub LostFocusN(meKey,MaxN,MinN,N)
	if document.all.item(meKey).value="" or not IsNumeric(document.all.item(meKey).value) then document.all.item(meKey).value=N

	if clng(document.all.item(meKey).value)>MaxN then
		document.all.item(meKey).value=MaxN
	elseif clng(document.all.item(meKey).value)<MinN then
		document.all.item(meKey).value=MinN
	else
		document.all.item(meKey).value=clng(document.all.item(meKey).value)
	end if	
end sub


Function URLEncode(strURL)
    Dim I
    Dim tempStr
    For I = 1 To Len(strURL)
        If Asc(Mid(strURL, I, 1)) < 0 Then
            tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
            tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr
            URLEncode = URLEncode & tempStr
        ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Or (Asc(Mid(strURL, I, 1)) >= 48 And Asc(Mid(strURL, I, 1)) <= 57) Then
            URLEncode = URLEncode & Mid(strURL, I, 1)
        Else
            URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
        End If
    Next
End Function

Function URLDecode(strURL)
    Dim I
    
    If InStr(strURL, "%") = 0 Then
        URLDecode = strURL
        Exit Function
    End If
    
    For I = 1 To Len(strURL)
        If Mid(strURL, I, 1) = "%" Then
            If Eval("&H" & Mid(strURL, I + 1, 2)) > 127 Then
                URLDecode = URLDecode & Chr(Eval("&H" & Mid(strURL, I + 1, 2) & Mid(strURL, I + 4, 2)))
                I = I + 5
            Else
                URLDecode = URLDecode & Chr(Eval("&H" & Mid(strURL, I + 1, 2)))
                I = I + 2
            End If
        Else
            URLDecode = URLDecode & Mid(strURL, I, 1)
        End If
    Next
End Function

sub Swep(t1,t2)
	t3=t1
	t1=t2
	t2=t3
end sub



'nohtml
function nohtml(wttring1)
	wttring=wttring1
	if not isnull(wttring) then
		wttring = replace(wttring,">","&gt;")
		wttring = replace(wttring,"<", "&lt;")
		wttring = Replace(wttring, CHR(34), "&quot;")
		wttring = Replace(wttring, CHR(39), "&#39;")
		wttring = Replace(wttring, CHR(13), "")
		wttring = Replace(wttring, CHR(10) & CHR(10), "</P><P>")
		wttring = Replace(wttring, CHR(10), "<BR>")
		wttring = Replace(wttring, "  ","&nbsp; ")
		nohtml = wttring
	else
		nohtml=""
	end if
end function
'<><><><><><>
'删除html格式
'<><><><><><>
function DelHtml(t1)
	if not isnull(t1) then
		t=t1		
		deli1=1
		j1=2
		
		do while deli1>0 and j1>deli1
			deli1=instr(t,"<")
			j1=instr(t,">")
			
			if deli1>0 and j1>deli1 then
				t2=mid(t,deli1,j1-deli1+1)
				t= replace(t,t2,"")
			end if		
			
			t3=t3&"<"&deli1&"-"&j1&">"
		loop
		
		DelHtml=t
	end if	
end function


function BornTextnohtml(wttring1,ke)
	wttring=wttring1
	if not isnull(wttring) then
		wttring = replace(wttring,">","&gt;")
		wttring = replace(wttring,"<", "&lt;")
		wttring = Replace(wttring, CHR(34), "&quot;")
		wttring = Replace(wttring, CHR(39), "&#39;")
		wttring = Replace(wttring, CHR(13), "")
		wttring = Replace(wttring, "  ","&nbsp; ")
				
		if ke="" then
			wttring = Replace(wttring, CHR(10) & CHR(10), "</P><P>")
			wttring = Replace(wttring, CHR(10), "<BR>")
		else
			wttring = Replace(wttring, CHR(10) & CHR(10), "</P><P "&ke&">")
			wttring = Replace(wttring, CHR(10), "</P><P "&ke&">")
			wttring="<P "&ke&">"&wttring&"</p>"
		end if

		
		BornTextnohtml = wttring
	end if
end function


function BornTextnohtmlClass(wttring1,ke)
	BornTextnohtmlClass=BornTextnohtml(wttring1,"class="""&ke&"""")
end function
'<><><><><><>
'显示内容
'<><><><><><>
Function BornText(Bot1,ke)
	BotnT=Bot1
	BotnType=GetRemType(BotnT)
	
	if BotnType=0 then '不同文本
		BotnT = replace(BotnT,">","&gt;")
		BotnT = replace(BotnT,"<", "&lt;")
		BotnT = Replace(BotnT, CHR(9), "&nbsp;")
		BotnT = Replace(BotnT, CHR(34), "&quot;")
		BotnT = Replace(BotnT, CHR(39), "&#39;")
		BotnT = Replace(BotnT, CHR(13), "")
		if ke="" then
			BotnT = Replace(BotnT, CHR(10) & CHR(10), "&nbsp;</P><P>")
			BotnT = Replace(BotnT, CHR(10), "&nbsp;<BR>")
		else
			BotnT = Replace(BotnT, CHR(10) & CHR(10), "&nbsp;</P><P "&ke&">")
			BotnT = Replace(BotnT, CHR(10), "&nbsp;</P><P "&ke&">")
			BotnT="<P "&ke&">"&BotnT&"</p>"
		end if
		BotnT = Replace(BotnT, "  ","&nbsp; ")
	end if
	BornText=BotnT
end function

function BornTextClass(wttring1,ke)
	BornTextClass=BornText(wttring1,"class="""&ke&"""")
end function

'按钮变换
sub ButtonChange(id)
	t=document.all.item(id).src
	if instr(lcase(t),"_true.") then
		t=replace(lcase(t),"_true.","_false.")
	else
		t=replace(lcase(t),"_false.","_true.")
	end if
	document.all.item(id).src=t
end sub
sub SetButtonChange(id,boolV)
	t=document.all.item(id).src
	if not boolV then
		t=replace(lcase(t),"_true.","_false.")
	else
		t=replace(lcase(t),"_false.","_true.")
	end if
	document.all.item(id).src=t
end sub
function GetButtonBool(id)
	t=document.all.item(id).src
	if instr(lcase(t),"_true.") then
		GetButtonBool=true
	else
		GetButtonBool=false
	end if
end function


sub BChange(obj1,tf1)
	t=obj1.src
	if not tf1 then
		t=replace(lcase(t),"_true","_false")
	else
		t=replace(lcase(t),"_false","_true")
	end if
	obj1.src=t
end sub

'文件类型
function GetFileType(fileA)
	t100=instrrev(fileA,".")
	if t100>0 then
		GetFileType=right(fileA,len(fileA)-t100)
	else
		GetFileType=""
	end if
end function

'获得内容类型及内容
function GetRemType(texta)
	if len(texta)<3 then
		GetRemType=1
	else
		ti1=mid(texta,2,1)
		if left(texta,1)="[" and mid(texta,3,1)="]" and (ti1="1" or ti1="0") then
			GetRemType=clng(ti1)
			texta=right(texta,len(texta)-3)
		else
			GetRemType=1
		end if
	end if
end function

function FormatDate(dateaa)
	FormatDate=year(dateaa)&"-"&right(month(dateaa)+100,2)&"-"&right(day(dateaa)+100,2)
end function
function FormatMoney(t100)
	FormatMoney=formatnumber(t100,2,true,false,false)
end function

function InStrString(t1,t2)	
	for iss1=1 to len(t1)
		iss2=mid(t1,iss1,1)
		if instr(t2,iss2)=0 then
			InStrString=false
			exit function
		end if
	next
	InStrString=true
end function

function IsEmail(email)  
'检测邮件
dim names, name, i, c  
  
  
IsEmail = true  
names = Split(email, "@")  
if UBound(names) <> 1 then  
   IsEmail = false  
   exit function  
end if  
for each name in names  
   if Len(name) <= 0 then  
     IsEmail = 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  
       IsEmail = false  
       exit function  
     end if  
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then  
      IsEmail = false  
      exit function  
   end if  
next  
if InStr(names(1), ".") <= 0 then  
   IsEmail = false  
   exit function  
end if  
i = Len(names(1)) - InStrRev(names(1), ".")  
if i <> 2 and i <> 3 then  
   IsEmail = false  
   exit function  
end if  
if InStr(email, "..") > 0 then  
   IsEmail = false  
end if  
  
end function


function GetWeekDay(datea)
	if isdate(datea) then
		weekb="日一二三四五六"
		GetWeekDay="星期"&mid(weekb,weekday(datea),1)
	else
		GetWeekDay=""
	end if
end function


function GetStr0(t1,iaa)
	GetStr0=right("0000000000000000000000000000000000000"&t1,iaa)
end function


'日期准换成数字
function DateToNumber(DateQ1)
	if not IsNumeric(DateQ2) then exit function
	
	DateQ2="2008-" & DateQ1\100 & "-" & (DateQ1 mod 100)
	if not isdate(DateQ2) then exit function
	
	DateToNumber=datediff("d","2008-1-1",DateQ2)+1
end function

'数字转换成日期
function NumberToDate(ShuQ1)
	if not IsNumeric(ShuQ1) then exit function
	if ShuQ1<1 or ShuQ1>366 then exit function
	
	DateQ2=Dateadd("d",ShuQ1-1,"2008-1-1")
	NumberToDate=GetStr0(month(DateQ2),2)&GetStr0(day(DateQ2),2)
end function






























'按钮变换
sub ButtonChangeTF(id,id1)
	t=id.src
	if not id1 then
		t=replace(lcase(t),"_true.","_false.")
	else
		t=replace(lcase(t),"_false.","_true.")
	end if
	id.src=t
end sub





sub apng2(img,widtha,heighta,linka)
	imgt=""
	if img.id<>"" then
		imgt=imgt&" id="""&img.id&""""
	end if
	if img.classname<>"" then
		imgt=imgt&" class="""&img.classname&""""
	end if
	if img.title<>"" then
		imgt=imgt&" title="""&img.title&""""
	end if
	
	imgStyle = "display:inline-block;" + img.style.cssText
	if img.align = "left" then imgStyle = "float:left;" + imgStyle
	if img.align = "right" then imgStyle = "float:right;" + imgStyle
	if linka<>"" then
		imgStyle = "cursor:hand;" + imgStyle
		linkb=" onclick="""&linka&""""
	else
		linkb=""
	end if

	strNewHTML = "<span"&imgt
	strNewHTML =strNewHTML &" style=""width:"&widtha&"; height:" & heighta & ";"&imgStyle&";"
    strNewHTML =strNewHTML &"filter:progid:DXImageTransform.Microsoft.AlphaImageLoader"
   	strNewHTML =strNewHTML &"(src='"&img.src&"', sizingMethod='scale')"""&linkb&"></span>"
	
	img.outerHTML = strNewHTML
	'document.title=img.width&strNewHTML
	'document.title=img.width
end sub
sub apng1(img,widtha,heighta)
	png2 img,widtha,heighta,""
end sub



sub PngImageChange()
	for pngi=0 to document.images.length-1
		set img = document.images(pngi)
		if right(lcase(img.src),4)=".png" then
			t1=img.style.cssText
			if instr(t1,"%")>0 then
				t3="scale"
			else
				t3="image"
			end if
			t2="filter:progid:DXImageTransform.Microsoft.AlphaImageLoader(src='"&img.src&"',sizingMethod='"&t3&"')"
			if t1<>"" then t2=t1&";"&t2
			img.style.cssText=t2
			img.src="../images/noimage.gif"
		end if
	next
	'document.title=document.uniqueID
end sub
sub GoToPng()
	if navigator.platform = "Win32" and navigator.appName = "Microsoft Internet Explorer" and instr(navigator.appVersion,"MSIE 7")=0 and instr(navigator.appVersion,"MSIE 8")=0 then
		PngImageChange
	end if
end sub
sub window_onload()
	GoToPng
end sub


'<><><>
'得到完全格式日期
Function GetDate(dateq,type1)
	if not isdate(dateq) then
		GetDate=""
	elseif type1=0 then
		GetDate=right(year(dateq)+10000,4)&right(month(dateq)+100,2)&right(day(dateq)+100,2)
	elseif type1=1 then
		GetDate=right(year(dateq)+10000,4)&"-"&right(month(dateq)+100,2)&"-"&right(day(dateq)+100,2)
	elseif type1=2 then
		GetDate=year(dateq)&"年"&month(dateq)&"月"&day(dateq)&"日"
	elseif type1=3 then
		GetDate=right(year(dateq)+10000,2)&"-"&right(month(dateq)+100,2)&"-"&right(day(dateq)+100,2)&" "&right(hour(dateq)+100,2)&":"&right(Minute(dateq)+100,2)&":"&right(Second(dateq)+100,2)
	elseif type1=31 then
		GetDate=right(year(dateq)+10000,2)&"-"&right(month(dateq)+100,2)&"-"&right(day(dateq)+100,2)&" "&right(hour(dateq)+100,2)&":"&right(Minute(dateq)+100,2)
	
	elseif type1=4 then
		GetDate=right(month(dateq)+100,2)&"."&right(day(dateq)+100,2)
	elseif type1=5 then
		GetDate=right(hour(dateq)+100,2)&":"&right(Minute(dateq)+100,2)&":"&right(Second(dateq)+100,2)
	elseif type1=6 then
		GetDate=right(month(dateq)+100,2)&"-"&right(day(dateq)+100,2)&" "&right(hour(dateq)+100,2)&":"&right(Minute(dateq)+100,2)	
	elseif type1=7 then
		GetDate=right(month(dateq)+100,2)&"."&right(day(dateq)+100,2)
		GetDateT="日一二三四五六"
		GetDate=GetDate&" 周"&mid(GetDateT,weekday(dateq),1)
	elseif type1=71 then
		GetDate=year(dateq)&"-"&month(dateq)&"-"&day(dateq)
		GetDateT="日一二三四五六"
		GetDate=GetDate&"("&mid(GetDateT,weekday(dateq),1)&")"
	else
		GetDate=right(year(dateq)+10000,4)&"-"&right(month(dateq)+100,2)&"-"&right(day(dateq)+100,2)
	end if
end function



'货币大写
Function ChineseMoney(moneya)
    Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
    Const letter = "0123456789sbqwy.zjf" '定义汉字缩写
    Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分" '定义大写汉字
    
    if moneya<0 then
    	yf1="负"
    	moneya=abs(moneya)
    else
    	yf1=""
    end if
    
    'Dim temp As String
    temp = moneya
    If InStr(temp, ".") > 0 Then temp = Left(temp, InStr(temp, ".") - 1)
    
    If Len(temp) > 16 Then
    	ChineseMoney="数目太大，无法换算！请输入一亿亿以下的数字"
    	exit function
    end if
    
    X = FormatMoney(moneya) '格式化货币
    Y = ""
    For i = 1 To Len(X) - 3
    Y = Y & Mid(X, i, 1) & Mid(zimu, Len(X) - 2 - i, 1)
    Next
    If Right(X, 3) = ".00" Then
    Y = Y & "z"          '***元整
    Else
     Y = Y & Left(Right(X, 2), 1) & "j" & Right(X, 1) & "f"     '*元*角*分
     End If
    Y = Replace(Y, "0q", "0") '避免零千(如：40200肆萬零千零贰佰)
    Y = Replace(Y, "0b", "0") '避免零百(如：41000肆萬壹千零佰)
    Y = Replace(Y, "0s", "0") '避免零十(如：204贰佰零拾零肆)
    
    Do While Y <> Replace(Y, "00", "0")
    Y = Replace(Y, "00", "0") '避免双零(如：1004壹仟零零肆)
    Loop
    Y = Replace(Y, "0y", "y") '避免零億(如：210億     贰佰壹十零億)
    Y = Replace(Y, "0w", "w") '避免零萬(如：210萬     贰佰壹十零萬)
    'Y = IIf(Len(X) = 5 And Left(Y, 1) = "1", Right(Y, Len(Y) - 1), Y) '避免壹十(如：14壹拾肆；10壹拾)
    
    if Len(X) = 5 And Left(Y, 1) = "1" then
    	Y=Right(Y, Len(Y) - 1)
    end if
    
    'Y = IIf(Len(X) = 4, Replace(Y, "0.", ""), Replace(Y, "0.", ".")) '避免零元(如：20.00贰拾零圆；0.12零圆壹角贰分)
    if Len(X) = 4 then
    	Y=Replace(Y, "0.", "")
    else
    	Y=Replace(Y, "0.", ".")
    end if
    
    
    
    For i = 1 To 19
    Y = Replace(Y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
    Next
    
    ChineseMoney = yf1 & Y
End Function


sub swap(zh1,zh2)  '交换数据
	zh3=zh1
	zh1=zh2
	zh2=zh3
end sub

'时间汉字,小时和分
function GetHM(shuaaa)
	shua=shuaaa
	
	if shua>60 then
		GetHM=shua\60 & "小时"
		shua=shua mod 60
	end if
	GetHM=GetHM & shua& "分"
	
end function

'时间汉字,小时，分和秒
function GetHMS(shuaaa)
	shua=shuaaa
	GetHMS=""
	if shua>86400 then
		GetHMS=shua\86400 & "天"
		shua=shua mod 86400
	end if
	
	
	if shua>3600 then
		GetHMS=GetHMS & shua\3600 & "小时"
		shua=shua mod 3600
	end if
	
	if shua>60 then
		GetHMS=GetHMS & (shua\60) & "分"
		shua=shua mod 60
	end if
	GetHMS=GetHMS & shua& "秒"
	
end function


'取得文件名
function GetFileName(fi1)
	fi1i=instrrev(fi1,"\")
	if fi1i=0 then
		GetFileName=fi1
	else
		GetFileName=right(fi1,len(fi1)-fi1i)
	end if
end function

function FileSizeText(Sz1)
	if sz1<=1024 then
		FileSizeText=formatnumber(Sz1,0,true) & "b"
	elseif sz1<=1024*1024 then
		FileSizeText=formatnumber(Sz1/1024,2,true) & "kb"
	else
		FileSizeText=formatnumber(Sz1/1024/1024,2,true) & "mb"
	end if
end function




sub TestPic(id1)
	setTimeout "TestPic1 '"&id1&"'",200
end sub
sub TestPic1(id1)
	document.all.item(id1).src=document.all.item(id1&"_pic").src
end sub

sub TestPicImage(id1,maxw,maxh)
	setTimeout "TestPicImage1 '"&id1&"',"&maxw&","&maxh,200
	'setTimeout "TestPic1 '"&id1&"'",200
end sub
sub TestPicImage1(id1,maxw,maxh)
	width1=document.all.item(id1&"_pic").width
	height1=document.all.item(id1&"_pic").height
	if maxw<>0 and maxh<>0 then
		if width1>maxw then
			maxw1=" width="&maxw
			height1=height1*(maxw/width1)
		end if
		if height1>maxh then
			maxh1=" height="&maxh
			maxw1=""
		end if
	elseif maxw<>0 then
		if width1>maxw then
			maxw1=" width="&maxw
		end if
	elseif maxh<>0 then
		if height1>maxh then
			maxh1=" height="&maxh
		end if
	end if
	
	document.all.item(id1).innerHTML="<img border=""0"" src="""&document.all.item(id1&"_pic").src&""" class=""Image1"""&maxw1&maxh1&" style=""cursor:hand"" onclick=""openurl '"&document.all.item(id1&"_pic").src&"'"">"
	
end sub



'按钮变换
sub ButtonTf(id)
	't=document.all.item(id & "_false").style.display
	if not GetButtonBoolTf(id) then
		document.all.item(id & "_false").style.display="none"
		document.all.item(id & "_true").style.display=""
	else
		document.all.item(id & "_true").style.display="none"
		document.all.item(id & "_false").style.display=""
	end if
end sub

function GetButtonBoolTf(id)
	t=document.all.item(id & "_false").style.display
	if t="" then
		GetButtonBoolTf=false
	else
		GetButtonBoolTf=true
	end if
end function

sub SetButtonTf(id,boolV)
	if boolV then
		document.all.item(id & "_false").style.display="none"
		document.all.item(id & "_true").style.display=""
	else
		document.all.item(id & "_true").style.display="none"
		document.all.item(id & "_false").style.display=""
	end if
end sub�