Class FormItemValidation

Private m_Name
Private m_Type_Id
Private m_AllowNull
Private m_Min
Private m_MinEqual
Private m_Max
Private m_MaxEqual
Private m_ErrMsg

Public Property Get Type_Id
	Type_Id=m_Type_Id
End Property


Public Property Let Type_Id(vType_Id)
	m_Type_Id=vType_Id
End Property 


Public Property Get Name	
	Name=m_Name
End Property


Public Property Let Name(vName)
	m_Name=vName
end Property


Public Property Get AllowNull	
	AllowNull=m_AllowNull
End Property


Public Property Let AllowNull(vAllowNull)
	m_AllowNull=vAllowNull
End Property


Public Property Get Min
	Min=m_Min
End Property


Public Property Let Min(vMin)	
	m_Min=vMin
End Property


Public Property Get MinEqual
	MinEqual=m_MinEqual
End Property


Public Property Let MinEqual(vMinEqual)
	m_MinEqual=vMinEqual
End Property


Public Property Get Max
	Max=m_Max
End Property


Public Property Let Max(vMax)
	m_Max=vMax
End Property


Public Property Get MaxEqual
	MaxEqual=m_MaxEqual
End Property


Public Property Let MaxEqual(vMaxEqual)
	m_MaxEqual=vMaxEqual
End Property


Public Property Get ErrMsg
	ErrMsg=m_ErrMsg
End Property


Public Property Let ErrMsg(vErrMsg)	
	m_ErrMsg=vErrMsg
End Property


Private Sub Class_Initialize
	m_Min=Empty
	m_MinEqual=True
	m_Max=Empty
	m_MaxEqual=True
	m_AllowNull=True
	m_ErrMsg=""
End Sub


Public Function Validate(ByRef vErrCode)

Validate=True
vErrCode=0

Dim obj,Value,Length
Dim i,j
Dim Checked,Selected
Checked=false
Selected=false
Dim obj_Year,obj_Month,obj_Day

On Error Resume Next
If m_Type_Id<>8 then
			
	set obj=window.document.all(m_name)
	If obj is Nothing then Validate=false:vErrCode=1:msgbox "Item " & m_name & " Could not be found in the form!":Exit Function
	If m_Type_Id<>11 and m_Type_Id<>12 then 
		if Ucase(TypeName(obj))="DISPHTMLELEMENTCOLLECTION" then set obj=obj(0)
	End If	
	
Else

	set obj_Year=window.document.all(m_name & "_Year")
	If obj_Year is Nothing then Validate=false:vErrCode=1:msgbox "Item " & m_name & "_Year Could not be found in the form!":Exit Function
	if Ucase(TypeName(obj_Year))="DISPHTMLELEMENTCOLLECTION" then set obj_Year=obj_Year(0)
	set obj_Month=window.document.all(m_name & "_Month")
	If obj_Month is Nothing then Validate=false:vErrCode=1:msgbox "Item " & m_name & "_Month Could not be found in the form!":Exit Function
	if Ucase(TypeName(obj_Month))="DISPHTMLELEMENTCOLLECTION" then set obj_Month=obj_Month(0)	
	set obj_Day=window.document.all(m_name & "_Day")
	If obj_Day is Nothing then Validate=false:vErrCode=1:msgbox "Item " & m_name & "_Day Could not be found in the form!":Exit Function
	if Ucase(TypeName(obj_Day))="DISPHTMLELEMENTCOLLECTION" then set obj_Day=obj_Day(0)	
	
End If


If Err.Number<>0 then msgbox "Item " & m_name & " Could not be found in the form!":Exit Function
On Error goto 0

				  
Select Case m_Type_Id
	
	Case 1:'普通字符串
	Value=Trim(obj.value)
	Length=strLen(Value)
	
	if m_AllowNull and Length=0 then Exit Function
	if Not m_AllowNull and Length=0 then Validate=False:obj.Focus:Exit Function	
	if Not isEmpty(m_Min) and m_MinEqual and Length<m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and Length<=m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and Length>m_Max then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and Length>=m_Max then Validate=False:obj.Focus:Exit Function
			  
			  
	Case 2:'浮点数
	Value=Trim(obj.value)
	
	if m_AllowNull and Len(Value)=0 then Exit Function
	if Not isNumeric(Value) then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and m_MinEqual and CDbl(Value)<m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and CDbl(Value)<=m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and CDbl(Value)>m_Max then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and CDbl(Value)>=m_Max then Validate=False:obj.Focus:Exit Function
	
	
	Case 3:'整数
	Value=Trim(obj.value)
	
	if m_AllowNull and Len(Value)=0 then Exit Function
	if Not isNumeric(Value) then Validate=False:obj.Focus:Exit Function
	if Cdbl(Value)<>CLng(Value) then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and m_MinEqual and CLng(Value)<m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and CLng(Value)<=m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and CLng(Value)>m_Max then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and CLng(Value)>=m_Max then Validate=False:obj.Focus:Exit Function
	
	Case 4:'Email	
	Value=Trim(obj.value)
	Length=strLen(Value)
	
	if m_AllowNull and Length=0 then Exit Function	
	If Instr(1,Value,"@")=0 or Length>100 then  Validate=False:obj.Focus:Exit Function
	
	Case 5:'Zip
	Value=Trim(obj.value)
	
	if m_AllowNull and Len(Value)=0 then Exit Function
	If Len(Value)<>6 then Validate=False:obj.Focus:Exit Function
	
	For i=1 to 6
		j=Mid(Value,i,1)
		if j<"0" or j>"9" then Validate=False:obj.Focus:Exit Function
	Next
	
	Case 6:'TextArea
	Value=Trim(obj.innerText)
	Length=strLen(Value)
	
	if m_AllowNull and Length=0 then Exit Function
	if Not m_AllowNull and Length=0 then Validate=False:obj.Focus:Exit Function	
	if Not isEmpty(m_Min) and m_MinEqual and Length<m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and Length<=m_Min then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and Length>m_Max then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and Length>=m_Max then Validate=False:obj.Focus:Exit Function
	
	Case 7:'Date
	Value=Trim(obj.Value)
	if m_AllowNull and Len(Value)=0 then Exit Function
	if Not isDate(Value) then Validate=False:obj.Focus:Exit Function
	if Not isDate(Value) then Validate=False:obj_Year.Focus:Exit Function
	if Not isEmpty(m_Min) and m_MinEqual and cdate(value)<cdate(m_Min) then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and cdate(value)<=cdate(m_Min) then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and cdate(value)>cdate(m_Max) then Validate=False:obj.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and cdate(value)>=cdate(m_Max) then Validate=False:obj.Focus:Exit Function
	
	Case 8:'Date2
	Value=Trim(obj_Year.Value & "-" & obj_Month.Value & "-" & obj_Day.Value)	
	if m_AllowNull and Len(Value)=2 then Exit Function
	if Not isDate(Value) then Validate=False:obj_Year.Focus:Exit Function
	if Not isEmpty(m_Min) and m_MinEqual and cdate(value)<cdate(m_Min) then Validate=False:obj_year.Focus:Exit Function
	if Not isEmpty(m_Min) and Not m_MinEqual and cdate(value)<=cdate(m_Min) then Validate=False:obj_year.Focus:Exit Function
	if Not isEmpty(m_Max) and m_MaxEqual and cdate(value)>cdate(m_Max) then Validate=False:obj_year.Focus:Exit Function
	if Not isEmpty(m_Max) and Not m_MaxEqual and cdate(value)>=cdate(m_Max) then Validate=False:obj_year.Focus:Exit Function
		
	Case 9:'Select
	For i=1 to obj.Options.Length
		
		if obj.Options(i-1).Selected then Selected=true
			
	Next
	if Not m_AllowNull and Not Selected then Validate=False:obj.Focus:Exit Function
	
	Case 10:'Select2
	For i=1 to obj.Options.Length-1
		
		if obj.Options(i).Selected then Selected=true
			
	Next
	if Not m_AllowNull and Not Selected then Validate=False:obj.Focus:Exit Function
	
	Case 11:'Radio	
	if Ucase(TypeName(obj))="DISPHTMLELEMENTCOLLECTION" then
		For i=1 to obj.Length
			if obj(i-1).Checked then Checked=true
		Next
		if Not m_AllowNull and Not Checked then Validate=False:obj(0).Focus:Exit Function
	Else
		Checked=obj.Checked
		if Not m_AllowNull and Not Checked then Validate=False:obj.Focus:Exit Function
	End if
	
	Case 12:'CheckBox	
	if Ucase(TypeName(obj))="DISPHTMLELEMENTCOLLECTION" then
		For i=1 to obj.Length
			if obj(i-1).Checked then Checked=true
		Next
		if Not m_AllowNull and Not Checked then Validate=False:obj(0).Focus:Exit Function
	Else
		Checked=obj.Checked
		if Not m_AllowNull and Not Checked then Validate=False:obj.Focus:Exit Function
	End if
	
	Case 13:'IdCardNumber
	Value=Trim(obj.value)
	
	if m_AllowNull and Len(Value)=0 then Exit Function
	If Len(Value)<>15 and Len(Value)<>18 then Validate=False:obj.Focus:Exit Function
	For i=1 to Len(Value)
		j=Mid(Value,i,1)
		if (j<"0" or j>"9") and i<Len(Value) then Validate=False:obj.Focus:Exit Function
	Next
	
End Select
End Function
End Class


Class FormValidation

Private m_ProjectName
Private m_Dictionary

Public Property Get ProjectName
	ProjectName=m_ProjectName
End Property


Public Property Let ProjectName(vProjectName)
	m_ProjectName=vProjectName	
End Property


Private Sub Class_Initialize()
   set m_Dictionary=CreateObject("Scripting.Dictionary")
End sub


Public Sub add(vKey,vObj)
   m_Dictionary.Add vKey,vObj
End Sub


Public Function ValidateAll

	Dim objKeys,objItem,i,j,value
	objKeys=m_Dictionary.Keys
	for i=lbound(objKeys) to ubound(objKeys)
		set objItem=m_Dictionary(objKeys(i))
		If not objItem.Validate(j) then			
			If j<>1 then msgbox objItem.ErrMsg,48,m_ProjectName			
			ValidateAll=false
			Exit Function
		End if
	next
	ValidateAll = true
	
End Function


Public Sub add2(vName,vType_Id,vAllowNull,vMin,vMinEqual,vMax,vMaxEqual,vErrMsg)

	Dim objItem
	Set objItem=new FormItemValidation
	
	objItem.name=vName
	objItem.Type_Id=vType_Id
	objItem.AllowNull=vAllowNull
	objItem.Min=vMin
	objItem.MinEqual=vMinEqual
	objItem.Max=vMax
	objItem.MaxEqual=vMaxEqual
	objItem.ErrMsg=vErrMsg
	m_Dictionary.Add vName,objItem	 
	
End Sub

End Class


Sub Document_OnKeyUp

	On Error Resume Next
	
	Dim Identity,P,Value
	Identity=Trim(Window.Event.SrcElement.Name)
	If Len(Identity)=0 Then Identity=Trim(Window.Event.SrcElement.Id)
	Value=Window.Event.SrcElement.Value
	
	P=InstrRev(Identity,"_Year",-1,1)
	If P>0 And P+4=Len(Identity) Then
		If Len(Value)=4 And IsNumeric(Value) Then
			If Clng(Value)=CDbl(Value) Then Window.Document.All(Left(Identity,Len(Identity)-5) & "_Month").Focus
		End If
	End If
	
	P=InstrRev(Identity,"_Month",-1,1)
	
	If P>0 And P+5=Len(Identity) Then
		If IsNumeric(Value) And Value<>"1" Then
			If Clng(Value)=CDbl(Value) And Clng(Value)>=1 and Clng(Value)<=12 Then Window.Document.All(left(Identity,Len(Identity)-6) & "_Day").Focus
		End If
	End If
	
End Sub


Function strLen(vStr)

	Dim i,j
	For i=1 to len(vStr)
		j=j+1
		If Asc(Mid(vStr,i,1))<0 then j=j+1
	Next
	strLen=j
	
End Function

class loadingWindow
	dim objId,x,y,width,height,title
	public sub class_initialize
		randomize
		objId="loadingWindow_" & cstr(clng(rnd*9000+1000))
		width=350
		height=87
	end sub
	public sub show(x,y)
		if x<0 or y<0 then
			x=(document.body.clientwidth-width)/2
			y=(document.body.clientheight-width)/2
		end if
		document.write "<table id=""" & objId & """width=""350"" height=""87"" border=""1"" cellpadding=""4"" cellspacing=""0"" bordercolor=""#999999"" bgcolor=""#FFFFEC"" style=""display:none;border-collapse: collapse;position:absolute;left:" & cstr(x) & ";top=" & cstr(y) & """>"
		document.write "	<tr><td bgcolor=""#3399FF"" style=""font-size:12px;color:#ffffff"" height=24>&nbsp;</td></tr>"
		document.write "	<tr><td style=""font-size:12px;line-height:200%"" align=center><span id=""" & objId & "_title" & """>" & title & "</span>"
		document.write "	<marquee style=""border:1px solid #000000"" direction=""right"" width=""300"" scrollamount=""5"" scrolldelay=""10"" bgcolor=""#ECF2FF"">"
		document.write "		<table cellspacing=""1"" cellpadding=""0"">"
		document.write "			<tr height=8><td bgcolor=#3399FF width=8></td><td></td>"
		document.write "			<td bgcolor=#3399FF width=8></td><td></td>"
		document.write "			<td bgcolor=#3399FF width=8></td><td></td>"
		document.write "			<td bgcolor=#3399FF width=8></td><td></td></tr>"
		document.write "		</table>"
		document.write "	</marquee></td></tr>"
		document.write "</table>"		
	end sub
	
	public sub changeTitle(newTitle)
		on error resume next
		window.document.all(objId & "_title").innertext=newTitle
	end sub
	
	public sub hideWindow()
		on error resume next
		window.document.all(objId).style.display="none"
	end sub
	
	public sub revealWindow()
		on error resume next	
		window.document.all(objId).style.display=""
	end sub
end class