Dim CertCustomItemName
CertCustomItemName ="0.9.2342.19200300.100.1.1"
Dim CertCustomIssuer
CertCustomIssuer = "MORCA"
Dim ICUWebObject
ICUWebObject = null

Function CreateICUWebObject()
	On Error Resume Next
	CreateICUWebObject = True
	IF IsNull(ICUWebObject) THEN
		Set ICUWebObject = CreateObject("FormXForICUProj1.FormXForICU")	'Morrowsoft.MrICU2
		IF Err.number > 0 THEN
    		MsgBox("创建即时通网页对象时出现错误: " & Err.Description)
			CreateICUWebObject = False
	    END IF
	END IF
END Function

Function FreeICUWebObject()
	ICUWebObject = null
END Function 

Function CheckLogState(ByRef UserName)
	Dim iLogged, iUserID, sUserCode, iDepID, iLogState

	On Error Resume Next
	CheckLogState = False
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	ICUWebObject.GetLogInfor iLogged, iUserID, UserName, sUserCode, iDepID, iLogState
	IF Err.number > 0 THEN
    	MsgBox("CheckLogState Error: " & Err.Description)
        Exit Function
    END IF
	
	IF (iLogged = 0) OR (iLogState = 0) THEN
		MsgBox("没有登录即时通或即时通处于离线状态。")
	ELSE
		CheckLogState = True
	END IF
END Function 

Function SendMsg(ByVal UserID, ByVal Content, ByVal HoldTime, ByVal ToOnLine)
	Dim iLogged, iUserID, sUserName, sUserCode, iDepID, iLogState
	Dim iResult, TheForm

	On Error Resume Next
	SendMsg = "发送失败"
	IF Not CheckLogState(sUserName) THEN
		Exit Function
	END IF

	ICUWebObject.SendMsg UserID, Content, HoldTime, ToOnLine, sUserName, iResult
	IF Err.number > 0 THEN
    	MsgBox("SendMsg Error: " & Err.Description)
        Exit Function
    END IF
	SendMsg = "发送成功"
End Function

Function BroadMsg(ByVal DepID, ByVal Content, ByVal IncludeSubDep, ByVal HoldTime, ByVal ToOnLine)
	Dim sUserName, iResult

	On Error Resume Next
	BroadMsg = "广播失败"
	IF Not CheckLogState(sUserName) THEN
		Exit Function
	END IF

	ICUWebObject.SendBroad DepID, Content, IncludeSubDep, HoldTime, ToOnLine, iResult
	IF Err.number > 0 THEN
    	MsgBox("SendMsg Error: " & Err.Description)
        Exit Function
    END If
	BroadMsg = "广播成功"
End Function

Function GetLogInfoVar(ByRef Logged, ByRef UserID, ByRef UserName, ByRef UserCode, ByRef DepID, ByRef LogState)
	Dim iLogged, iLogState

	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	ICUWebObject.GetLogInfor iLogged, UserID, UserName, UserCode, DepID, iLogState
	IF Err.number > 0 THEN
    	MsgBox("GetLogInfoVar Error: " & Err.Description)
        Exit Function
    END IF
	
	If iLogged = 1 THEN
		Logged = "已登录"
		If iLogState = 0 THEN
			LogState = "下线"
		ElseIf iLogState = 1 THEN
			LogState = "在线"
		ElseIf iLogState = 2 THEN
			LogState = "离开"
		ElseIf iLogState = 3 THEN
			LogState = "隐身"
		End IF
	Else
		Logged = "未登录"
		LogState = "未登录"
	End IF
End Function

Function GetLogInfo(ByVal FormName, ByVal LoggedControl, ByVal UserIDControl, ByVal UserNameControl, ByVal UserCodeControl, ByVal DepIDControl, ByVal LogStateControl)
	Dim iLogged, iUserID, sUserName, sUserCode, iDepID, iLogState
	Dim TheForm

	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	ICUWebObject.GetLogInfor iLogged, iUserID, sUserName, sUserCode, iDepID, iLogState
	IF Err.number > 0 THEN
    	MsgBox("GetLogInfo Error: " & Err.Description)
      Exit Function
    END IF
	
	Set TheForm = Document.forms(FormName)
	For Each Control IN TheForm.elements
		IF Control.Name = LoggedControl THEN
			IF iLogged = 1 THEN
				Control.Value = "已登录"
			ELSE
				Control.Value = "未登录"
			END IF
		END IF
		IF Control.Name = UserIDControl THEN
			Control.Value = CStr(iUserID)
		END IF
		IF Control.Name = UserNameControl THEN
			Control.Value = sUserName
		END IF
		IF Control.Name = UserCodeControl THEN
			Control.Value = sUserCode
		END IF
		IF Control.Name = DepIDControl THEN
			Control.Value = CStr(iDepID)
		END IF
		IF Control.Name = LogStateControl THEN
			IF iLogState = 0 THEN
				IF iLogged = 0 THEN
					Control.Value = "未登录"
				ELSE
					Control.Value = "下线"
				END IF
			ELSEIF iLogState = 1 THEN
				Control.Value = "在线"
			ELSEIF iLogState = 2 THEN
				Control.Value = "离开"
			ELSEIF iLogState = 3 THEN
				Control.Value = "隐身"
			END IF
		END IF
	NEXT
END Function

Function ReadCookieVariable(strVariableName) 
  ' 在用于查找 cookie 中变量 
  ' 的字符串处理代码中使用这五个变量。 
  Dim intLocation 
  Dim intNameLength 
  Dim intValueLength 
  Dim intNextSemicolon 
  Dim strTemp 

	Dim sCookie 
  ' Document.Cookie 的值类似：	
  'sCookies = "MrLk_FileServerIP_WWW=MrLk_FileServerIP_WWW; MrLk_VirtualDir_WWW=MrLk_VirtualDir_WWW; MrLk_FileServerIP=MrLk_FileServerIP; MrLk_VirtualDir=MrLk_VirtualDir; MrLk_Test; MrLk_Test2=; MrLk_Test3=MrLk_Test3"
	sCookie= Document.Cookie 
	
  ' 计算变量名的长度和位置。 
  intNameLength = Len(strVariableName) 
  ' 查找时包含"="，能够一次定位到变量名
  intLocation = Instr(sCookie, strVariableName & "=") 
  ' 检查变量名是否存在。 
  If intLocation = 0 Then
    ' 找不到变量名。 
    ReadCookieVariable = "" 
  Else 
    ' 获取"=" 后面的部分再进行处理。 
    strTemp = Right(sCookie, Len(sCookie) - intLocation + 1) 
		' 找到 "=" 后面的第一个 ";" 
    intNextSemicolon = Instr(strTemp, ";") 
		' 如果未找到，变量值为 "=" 后面的部分。 
    If intNextSemicolon = 0 Then 
    	intNextSemicolon = Len(strTemp) + 1 
    End If	
		' 检查空变量 (Var1=;)。 
    If intNextSemicolon = (intNameLength + 2) Then 
			' 变量为空。 
      ReadCookieVariable = "" 
    Else 
			' 正常计算此值，"=" 和 ";" 中间的部分。 
      intValueLength = intNextSemicolon - intNameLength - 2
			ReadCookieVariable = Mid(strTemp, intNameLength + 2, intValueLength) 
    End If 
  End If 
End Function 

Function GetUserLoginType() 
  ' BS:密码网页登录；CERT:数字证书网页登录；LOCK:铁道部数字证书方式网页登录
  ' ICU:使用即时通用户身份登录(使用密码或数字证书，如果使用数字证书则 GetUserCertHash 不为空,为数字证书微缩图，40字节的字符串)
  GetUserLoginType = ReadCookieVariable("UsrLoginType")
End Function 

Function GetUserCertHash() 
  GetUserCertHash = ReadCookieVariable("UsrCertHash")
End Function 

Function GetUserID() 
  Dim sUsrInfo
  sUsrInfo=ReadCookieVariable("UsrInfo")
  Dim b
  b=split(sUsrInfo,"|*")    
  GetUserID = b(0)
End Function 

Function GetUserCode() 
	Dim sUsrInfo
	sUsrInfo=ReadCookieVariable("UsrInfo")
  Dim b
  b=split(sUsrInfo,"|*")    
  GetUserCode = b(1)	
End Function 

Function GetUserName() 
	Dim sUsrInfo
	sUsrInfo=ReadCookieVariable("UsrInfo")
  Dim b
  b=split(sUsrInfo,"|*")    
  GetUserName = b(2)
End Function 

Function GetCertHash() 
	IF GetUserLoginType() = "ARMYCERT" THEN
		GetCertHash = "ARMYCERT"
		Exit Function
	END IF
	
	IF (GetUserLoginType() = "ICU") AND (GetUserCertHash = "#ARMYCERT") THEN
		GetCertHash = "ARMYCERT"
		Exit Function
	END IF
	
  GetCertHash = GetUserCertHash
End Function 

Function GetIcuCertHash()
	Dim sResult, iError
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	GetIcuCertHash = ""
	iError = ICUWebObject.GetUsrCertEncodedHash(sResult)
	IF Err.number > 0 Then
		GetIcuCertHash = ""
  	MsgBox("Get Cert Hash Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <> 1 Then
  	MsgBox("检测到使用ICU下线，出错代码为: " & CStr(iError))
    Exit Function
	End If

 	If sResult = "" Then
 		MsgBox("未使用数字证书登录即时通。")
   	Exit Function
  End If
	
	GetIcuCertHash = sResult
End Function

Function SignPreData(ByRef ABuffer)
	Dim sResult, iError
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	SignPreData = ""
	iError = ICUWebObject.DoSignPreData(ABuffer, sResult)
	IF Err.number > 0 Then
  	MsgBox("Sign Pre Data Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <= 0 Then
  	MsgBox("进行数字签名出现错误，出错代码为: " & CStr(iError))
    Exit Function
	End If
	
	SignPreData = sResult
End Function

Function BufSign(ABuffer, ABufferLen, UserUID,UserName,UserCode, CertHash)
	Dim sResult, iError
	BufSign = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF
	
	sResult = ""
	
  iError = ICUWebObject.DoSignBuf(ABuffer, ABufferLen, UserUID, UserName, UserCode, CertHash, sResult)
	If Err.number > 0 Then
  	'MsgBox("BufSign Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <= 0 Then
  	'MsgBox("给数据进行数字签名出现错误，出错代码为: " & CStr(iError))
    Exit Function
	End If
	
	BufSign = sResult
End Function

Function SignBuffer(ByRef ABuffer, ByRef sErrMsg)
	Dim sResult, iError, iLen
  Dim sEncodedHash
  Dim iUserID, sUserName, sUserCode
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	IF (GetUserLoginType() = "ARMYCERT") OR ((GetUserLoginType() = "ICU") AND (GetUserCertHash = "#ARMYCERT")) THEN
		iError = ICUWebObject.DoSignBuf_Mr418(ABuffer, sResult)
		If Err.number > 0 Then
			sErrMsg = "Sign Data Error: " & Err.Description		
			MsgBox(sErrMsg)  	
			Exit Function
		End If
	  
		If iError <= 0 Then
			sErrMsg = "给数据进行数字签名出现错误，可能未使用数字证书登录，出错代码为: " & CStr(iError)
			MsgBox(sErrMsg)  	
			Exit Function
		End If

		SignBuffer = sResult
		Exit Function
	END IF

	iUserID = GetUserID
	sUserName = GetUserName
	sUserCode = GetUserCode

	SignBuffer = ""
	sResult = ""
	
	iLen = vbsByteLength(ABuffer)
	sEncodedHash = GetCertHash
	If sEncodedHash="" Then
		sErrMsg = "未使用数字证书登录"
		MsgBox(sErrMsg)
    Exit Function
	End If
	
  iError = ICUWebObject.DoSignBuf(ABuffer, iLen, iUserID, sUserName, sUserCode, sEncodedHash, sResult)
	If Err.number > 0 Then
  	sErrMsg = "Sign Data Error: " & Err.Description		
		MsgBox(sErrMsg)  	
    Exit Function
  End If
  
  If iError <= 0 Then
  	sErrMsg = "给数据进行数字签名出现错误，可能未使用数字证书登录，出错代码为: " & CStr(iError)
		MsgBox(sErrMsg)  	
    Exit Function
	End If
	
	SignBuffer = sResult
End Function

Function SignData(ByRef ABuffer, ByRef sErrMsg)
	Dim sResult, iError, iLen
  Dim sEncodedHash, sCertSigner, sSerialNumber, sPubKey
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	SignData = ""
	sResult = ""
	
	iLen = vbsByteLength(ABuffer)
	sEncodedHash = GetCertHash
	If sEncodedHash="" Then
		sErrMsg = "未使用数字证书登录"
		MsgBox(sErrMsg)
    Exit Function
	End If
	
  iError = ICUWebObject.DoCertSign(ABuffer, iLen, sEncodedHash, sCertSigner, sSerialNumber, sResult, sPubKey, sErrMsg, 0, "", "", "", "", "", 0)
	If Err.number > 0 Then
  	MsgBox("Sign Data Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <> 0 Then
  	MsgBox("给数据进行数字签名出现错误，可能未使用数字证书登录，出错代码为: " & CStr(iError))
    Exit Function
	End If
	
	SignData = sResult
End Function

Function GetCertInfo(ByRef ACertFileName,ByRef AEncodedCertHash, ByRef ACertDisplayName, ByRef AEncodedCertSN, _
  ByRef ACertIssuer, ByRef ACustomItemName, ByRef ACustomItemValue, ByRef AValidStart, ByRef AValidEnd, _
  ByRef AType, ByRef AErrorMsg, ByRef AVerifyCertChain)
	Dim iError
	iError = -4
	On Error Resume Next
	IF NOT CreateICUWebObject() Then
		GetCertInfo = iError
		Exit Function
	End If

	iError = ICUWebObject.DoCertGetInfo( _
	  ACertFileName, AEncodedCertHash, ACertDisplayName, AEncodedCertSN, _
    ACertIssuer, ACustomItemName, ACustomItemValue, AValidStart, AValidEnd, _
    AType, AErrorMsg, AVerifyCertChain, False)
    
  GetCertInfo = iError
	IF Err.number > 0 Then
  	MsgBox("Get Cert Information Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <> 0 Then
  	'MsgBox("无法获取证书信息，请确认选择了正确的证书文件！" & Chr(13) &  Chr(10) & AErrorMsg)
	  MsgBox("无法获取证书信息，请确认选择的证书文件为 X.509 格式！")
    Exit Function
	End If
End Function


Function GetLockFile(ByRef LockFileName)
	Dim iError
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  GetLockFile = -1
	iError = ICUWebObject.GetLockFile(LockFileName)
	IF Err.number > 0 Then
  	MsgBox("GetLockFile Error: " & Err.Description)
    Exit Function
  End If
  
  If iError < 0 Then
  	MsgBox("进行数字签名出现错误，出错代码为: " & CStr(iError))
    Exit Function
	End If
	
	GetLockFile = iError
  
End Function

Function WebSignCredence(ByRef ASessionData, ilen)
	Dim sResult
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	sResult = "" 
  sResult = ICUWebObject.DoWebSignCredence(ASessionData, ilen)
  
	If Err.number > 0 Then
  	MsgBox("WebSignCredence Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult = null Then
  	'MsgBox("WebSignCredence 错误")
  	sResult = ""    
	End If
	
	WebSignCredence = sResult
End Function

Function GetLocalAdminLockNum()
	Dim sResult
	Dim vCfg
	sResult = 0
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  vCfg = ICUWebObject.DoGetCardCfg()

  If vCfg(0)=0 Then
  	If (vCfg(1)=1)And(vCfg(2)>0) Then
  	  sResult = vCfg(2)
    End If 
	End If 
	If Err.number > 0 Then
  	MsgBox("GetLocalAdminLockNum Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult = null Then
  	'MsgBox("DoGetCardCfg 错误")
	End If
	
	GetLocalAdminLockNum = sResult
End Function

Function WebBufCardSign(ByRef Buf, ilen)
	Dim sResult
	
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	sResult = ""

  sResult = ICUWebObject.DoWebBufCardSign(Buf, ilen)
	If Err.number > 0 Then
  	MsgBox("WebBufCardSign Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult = null Then
  	'MsgBox("WebBufCardSign 错误")
    Exit Function
	End If
	
	WebBufCardSign = sResult
End Function

Function GetLocalCertList()
	Dim vCertList

	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  vCertList = ICUWebObject.DoGetCertList()

	If Err.number > 0 Then
		vCertList = null
  	MsgBox("GetLocalCertList Error: " & Err.Description)
    Exit Function
  End If
  	
	GetLocalCertList = vCertList
End Function

Function StdCertBufSign(ByRef Buf, ilen, sCertHash)
	Dim sResult
	StdCertBufSign = null
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoStdCertBufSign(Buf, ilen, sCertHash)
	If Err.number > 0 Then
		sResult = null 
  	'MsgBox("StdCertBufSign Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult = null Then
  	'MsgBox("StdCertBufSign 错误")
    Exit Function
	End If
	
	StdCertBufSign = sResult
End Function


Function PreSignData(FileName,UserUID,UserName,UserCode, CertHash)
	Dim sResult
	PreSignData = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoPreSignData(FileName,UserUID,UserName,UserCode, CertHash)
	If Err.number > 0 Then		
  	'MsgBox("DoPreSignData Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult(0) > 0 Then
  	PreSignData = sResult(1)  	
  Else
  	'alert sResult(0) 	
	End If
End Function

Function CertMrExport(ASaveFileName, AEncodedCertHash, AGetCertInfo)
	Dim iError,vResult
	iError = -4
	On Error Resume Next
	IF NOT CreateICUWebObject() Then
		CertMrExport = iError
		Exit Function
	End If

	vResult = ICUWebObject.DoCertMrExport(ASaveFileName, AEncodedCertHash,AGetCertInfo, CertCustomItemName)
	iError = vResult(0)
    
  CertMrExport = vResult
	IF Err.number > 0 Then
  	MsgBox("Export Cert Error: " & Err.Description)
    Exit Function
  End If
  
  If iError <> 0 Then
	  'MsgBox("无法导出证书，" & vResult(2))
    Exit Function
	End If
End Function

Function CertGetHashWithCustomItemValue(AIssuer, ACustomItemName, ACustomItemValue)
  CertGetHashWithCustomItemValue=""
	Dim vInfo
	vInfo = CertGetInfoWithCustomItemValue(AIssuer, ACustomItemName, ACustomItemValue)
	If IsArray(vInfo) Then
		CertGetHashWithCustomItemValue=vInfo(11)
	End If 
End Function

Function CertGetInfoWithCustomItemValue(AIssuer, ACustomItemName, ACustomItemValue)
  CertGetInfoWithCustomItemValue = ""
  Dim vList, vCertInfo
  Dim iRet, iCount, sCertHash
  Dim sIssuer, sCustomItemName, sCustomItemValue
  vList= GetLocalCertList()
  If iRet = 0 then 
	'函数执行正确
		iCount = vList(1)
		If iCount = "-1" then 
			'存在梦龙锁或支持的科博锁，第一个证书就是
			sCertHash=vList(2)(1)
			vCertInfo = ICUWebObject.DoCertMrExport("", sCertHash,true, ACustomItemName)
			If vCertInfo(0)= "0" Then
				sIssuer = vCertInfo(5) 
				sCustomItemName = vCertInfo(10)
				sCustomItemValue = vCertInfo(6)
				If (sIssuer=AIssuer)And(sCustomItemName=ACustomItemName)And(sCustomItemValue=ACustomItemValue) Then
					CertGetInfoWithCustomItemValue = vCertInfo
					Exit Function
				End if
			End If 
		ElseIf iCount = 0 then
			'不存在任何数字证书
			Exit Function
		Else  
			'标准格式的数字证书列表		  
		  For i=0 to iCount-1
				sCertHash=vList(i+2)(1)
				vCertInfo = ICUWebObject.DoCertMrExport("", sCertHash,true, ACustomItemName)
				If vCertInfo(0)= "0" Then
					sIssuer = vCertInfo(5) 
					sCustomItemName = vCertInfo(10)
					sCustomItemValue = vCertInfo(6)
					If (sIssuer=AIssuer)And(sCustomItemName=ACustomItemName)And(sCustomItemValue=ACustomItemValue) Then
						CertGetInfoWithCustomItemValue = vCertInfo
						Exit Function
					End if
				End If			
		  Next		  
		End If   
	Else
		Exit Function
	End If 	
End Function

Function vbsByteLength(txt)
  txt=trim(txt) 
  x = len(txt) 
  y = 0 
  for ii = 1 to x 
    if asc(mid(txt,ii,1)) < 0 or asc(mid(txt,ii,1)) >255 then '如果是汉字 
      y = y + 2 
    else 
      y = y + 1 
    end if 
  next 
  vbsByteLength = y 
End Function

Function GetMD5(BUF)
  Dim Len
  Len = vbsByteLength(BUF)
  GetMD5 = GetMD5_(BUF,Len)
End Function

Function GetSHS1(BUF)
  Dim Len
  Len = vbsByteLength(BUF)
  GetSHS1 = GetSHS1_(BUF,Len)
End Function

Function GetMD5_(BUF,Len)
	Dim sResult
	GetMD5_ = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoGetMD5(BUF,Len)
	If Err.number > 0 Then		
  	'MsgBox("GetMD5 Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult(0) = 0 Then
  	GetMD5_ = sResult(1)  	
  Else
  	'alert sResult(0) 	
	End If
End Function

Function GetSHS1_(BUF,Len)
	Dim sResult
	GetSHS1_ = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoGetSHS1(BUF,Len)
	If Err.number > 0 Then		
  	'MsgBox("GetSHS1 Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult(0) = 0 Then
  	GetSHS1_ = sResult(1)  	
  Else
  	'alert sResult(0) 	
	End If
End Function

Function GetFileMD5(Filename)
	Dim sResult
	GetFileMD5 = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoGetFileMD5(Filename)
	If Err.number > 0 Then		
  	'MsgBox("GetFileMD5 Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult(0) = 0 Then
  	GetFileMD5 = sResult(1)  	
  Else
  	'alert sResult(0) 	
	End If
End Function


Function GetFileSHS1(Filename)
	Dim sResult
	GetFileSHS1 = ""
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  sResult = ICUWebObject.DoGetFileSHS1(Filename)
	If Err.number > 0 Then		
  	'MsgBox("GetFileMD5 Error: " & Err.Description)
    Exit Function
  End If
  
  If sResult(0) = 0 Then
  	GetFileSHS1 = sResult(1)  	
  Else
  	'alert sResult(0) 	
	End If
End Function

Function VerifySign(ByRef Buffer, ByRef SignData)
	Dim sResult
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	sResult = ICUWebObject.DoVerifySign_Mr418(Buffer, SignData)
	VerifySign = sResult
End Function

Function EncEnvlopeFile(ByRef FileName, ByRef CertInfo, ByRef LDAP)
	Dim sResult
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	sResult = ICUWebObject.DoEncEnvlopeFile_Mr418(FileName, CertInfo, LDAP)
	EncEnvlopeFile = sResult
End Function

Function DecEnvlopeFile(ByRef SrcFileName, ByRef DstFileName)
	Dim sResult
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

	sResult = ICUWebObject.DoDecEnvlopeFile_Mr418(SrcFileName, DstFileName)
	DecEnvlopeFile = sResult
End Function

Function GetLocalIPList(bGetMac)
	Dim vIPList

	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  vIPList = ICUWebObject.DoGetLocalIP(bGetMac)

	If Err.number > 0 Then
		vIPList = null
  	MsgBox("GetLocalIPList Error: " & Err.Description)    
  End If
  	
	GetLocalIPList = vIPList
End Function

Function GetLocalIPMac(IpAddress)
	Dim vMac

	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END IF

  vMac = ICUWebObject.DoGetIPMac(IpAddress)

	If Err.number > 0 Then
		vMac = null
  	MsgBox("GetLocalIPMac Error: " & Err.Description)    
  End If
  	
	GetLocalIPMac = vMac
End Function

Function GetIcuUserCredence()
	On Error Resume Next
	IF NOT CreateICUWebObject() THEN
		Exit Function
	END If
	
	'If(GetUserLoginType <> "ICU") Then
	'	GetIcuUserCredence = ""
	'	Exit Function
	'End If 
		
	Dim sCred,ss,num
  ss = ICUWebObject.GetCredence(num)
  
	If Err.number > 0 Then
		vMac = null
  	MsgBox("GetIcuUserCredence Error: " & Err.Description)    
  End If
    
  sCred = ""
  For i=0 to 15
		sCred = sCred & Chr(num(i))
	Next
	GetIcuUserCredence = sCred
End Function