<%
'************************************************************
'	Software name: Finereason HRCMS 7.0
'	软件名称:嘉缘人才网站内容管理系统 V7.0
'	Email: service@finereason.com . QQ:109530926
'	Web: http://www.finereason.com  http://www.yjys.net
'	Copyright (C) FineSincere Inc. All Rights Reserved.
'	版权所有 嘉挚科技 未经嘉挚公司授权不得用于任何商业用途
'************************************************************
Dim sMyXmlDoc, sMyXmlHTTP
'创建一个二维数组，将元素名和值存入其中
ReDim sFR_Items(20, 1)
sFR_Items(0, 0) = "appid"
sFR_Items(1, 0) = "action"
sFR_Items(2, 0) = "syskey"
sFR_Items(3, 0) = "status"
sFR_Items(4, 0) = "message"
sFR_Items(5, 0) = "username"
sFR_Items(6, 0) = "password"
sFR_Items(7, 0) = "email"
sFR_Items(8, 0) = "question"
sFR_Items(9, 0) = "answer"
sFR_Items(10, 0) = "savecookie"
sFR_Items(11, 0) = "truename"
sFR_Items(12, 0) = "telephone"
sFR_Items(13, 0) = "address"
sFR_Items(14, 0) = "zipcode"
sFR_Items(15, 0) = "homepage"
sFR_Items(16, 0) = "userip"
sFR_Items(17, 0) = "jointime"
sFR_Items(18, 0) = "userstatus"
sFR_Items(19, 0) = "province"
sFR_Items(20, 0) = "city"

sFR_Items(0, 1) = "finereason"
sFR_Items(1, 1) = ""
sFR_Items(2, 1) = ""
sFR_Items(3, 1) = "0"
sFR_Items(4, 1) = "操作已成功完成！"
sFR_Items(5, 1) = ""
sFR_Items(6, 1) = ""
sFR_Items(7, 1) = ""
sFR_Items(8, 1) = ""
sFR_Items(9, 1) = ""
sFR_Items(10, 1) = ""
sFR_Items(11, 1) = ""
sFR_Items(12, 1) = ""
sFR_Items(13, 1) = ""
sFR_Items(14, 1) = ""
sFR_Items(15, 1) = ""
sFR_Items(16, 1) = ""
sFR_Items(17, 1) = ""
sFR_Items(18, 1) = ""
sFR_Items(19, 1) = ""
sFR_Items(20, 1) = ""

'定义与数组对应的常量，便于在编写程序时使用
Const conAppid = 0
Const conAction = 1
Const conSyskey = 2
Const conStatus = 3
Const conMessage = 4
Const conUsername = 5
Const conPassword = 6
Const conEmail = 7
Const conQuestion = 8
Const conAnswer = 9
Const conSavecookie = 10
Const conTruename = 11
Const conTelephone = 12
Const conAddress = 13
Const conZipcode = 14
Const conHomepage = 15
Const conUserip = 16
Const conJointime = 17
Const conUserstatus = 18
Const conProvince = 19
Const conCity = 20

'**************************************************
'函数名：prepareXML(vIsQuest)
'作  用：生成要发送的数据
'参  数：vIsQuest True=发送请求；False=响应请求
'**************************************************
Sub prepareXML(vIsQuest)
    'On Error Resume Next
    Dim TemplateFile, intIndex
    If vIsQuest Then
        TemplateFile = Server.MapPath(InstallDir & "API/Request.xml")
    Else
        TemplateFile = Server.MapPath(InstallDir & "API/Response.xml")
    End If
    If Not IsObject(sMyXmlDoc) Then createXmlDom
    sMyXmlDoc.Async = False
    sMyXmlDoc.Load (TemplateFile)
    If Err Then
        Err.Clear
        FoundErr = True
        ErrMsg = "加载XML模版文件出错！"
    Else
        For intIndex = 0 To UBound(sFR_Items, 1)
            If vIsQuest Then
                '如果是请求包，不处理响应包专用元素
                If intIndex <> conStatus And intIndex <> conMessage Then
                    setNodeText sFR_Items(intIndex, 0), sFR_Items(intIndex, 1)
                End If
            Else
                '如果是响应包，不处理请求包专用元素
                If intIndex <> conAction And intIndex <> conSyskey And intIndex <> conUsername Then
                    setNodeText sFR_Items(intIndex, 0), sFR_Items(intIndex, 1)
                End If
            End If
        Next
    End If
End Sub

'**************************************************
'函数名：prepareData(vIsQuest)
'作  用：从XML中获取用户信息
'参  数：vIsQuest True=请求格式；False=响应格式
'**************************************************
Sub prepareData(vIsQuest)
    'On Error Resume Next
    Dim intIndex
    For intIndex = 0 To UBound(sFR_Items, 1)
        If vIsQuest Then
            '如果是请求包，不处理响应包专用元素
            If intIndex <> conStatus Or intIndex <> conMessage Then
                sFR_Items(intIndex, 1) = getNodeText(sFR_Items(intIndex, 0))
            End If
        Else
            '如果是响应包，不处理请求包专用元素
            If intIndex <> conSyskey Or intIndex <> conUsername Or intIndex <> conPassword Then
                sFR_Items(intIndex, 1) = getNodeText(sFR_Items(intIndex, 0))
            End If
        End If
    Next
End Sub

'**************************************************
'函数名：getNodeText
'作  用：获取XML文件中指定节点的文本
'参  数：strNodeName   ----节点名称
'返回值：解析出来的文本值，
'**************************************************
Function getNodeText(strNodeName)
    If IsNull(strNodeName) Or IsEmpty(strNodeName) Or strNodeName = "" Then Exit Function
    If IsNode(strNodeName) Then
        getNodeText = sMyXmlDoc.documentElement.selectSingleNode(strNodeName).Text
    Else
        getNodeText = ""
    End If
End Function


'**************************************************
'函数名：setNodeText
'作  用：设置XML文件中指定节点的文本
'参  数：strNodeName   ----节点名称
'　　　　strNodeText   ----要设置的文本
'返回值：0 = 设置成功; 否则返回Err.Description
'**************************************************
Function setNodeText(strNodeName, strNodeText)
	On Error Resume Next
    If IsNull(strNodeText) Or IsEmpty(strNodeText) Or strNodeText = "" Then
	sMyXmlDoc.documentElement.selectSingleNode(strNodeName).Text = Err.Description
	end if
    If IsNull(strNodeName) Or IsEmpty(strNodeName) Or strNodeName = "" Then Exit Function
    If IsNode(strNodeName) Then sMyXmlDoc.documentElement.selectSingleNode(strNodeName).Text = strNodeText
End Function

'**************************************************
'函数名：IsNode
'作  用：检查一个Node是否存在且文本不为空
'参  数：strNodeName   ----节点名称
'返回值：True or False
'**************************************************
Function IsNode(strNodeName)
    IsNode = False
    If strNodeName = "" Then Exit Function
    If sMyXmlDoc.documentElement.selectSingleNode(strNodeName) Is Nothing Then
        IsNode = False
    Else
        IsNode = True
    End If
End Function

'**************************************************
'函数名：createXmlDom
'作  用：创建尽可能高版本的MSXML对象
'参  数：无
'返回值：True - 创建sMyXmlDoc成功
'　　　　False - 服务器不支持MSXML对象
'**************************************************
Function createXmlDom()
    'On Error Resume Next
    Set sMyXmlDoc = Server.CreateObject("MSXML2.FreeThreadedDOMDocument")
    If Err Then
        Err.Clear
        createXmlDom = False
        FoundErr = True
        ErrMsg = "服务器不支持MSXML2.FreeThreadedDOMDocument对象"
    Else
        createXmlDom = True
    End If
End Function
'**************************************************
'函数名：createXmlHTTP
'作  用：创建尽可能高版本的ServerXMLHTTP对象
'参  数：无
'返回值：True - 创建sMyXmlDoc成功
'　　　　False - 服务器不支持ServerXMLHTTP对象
'**************************************************
Function createXmlHttp()
    'On Error Resume Next
    Set sMyXmlHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
    If Err Then
        createXmlHttp = False
        FoundErr = True
        ErrMsg = "服务器不支持ServerXMLHTTP对象"
    Else
        createXmlHttp = True
    End If
End Function

Sub RollbackUser(startIndex)
    startIndex = startIndex - 1
    Do While startIndex >= 0
        setNodeText "action", "delete"
        sMyXmlHTTP.Open "POST", ArrUrls(startIndex), True
        sMyXmlHTTP.setRequestHeader "Content-Type", "text/xml; charset=gb2312"
        sMyXmlHTTP.send sMyXmlDoc
        startIndex = startIndex - 1
    Loop
End Sub

Sub WriteErrXml()
    Response.Clear
    Response.ContentType = "text/xml"
    Response.Charset = "gb2312"
    Response.Expires = 0
    Response.Expiresabsolute = Now() - 1
    Response.AddHeader "pragma", "no-cache"
    Response.AddHeader "cache-control", "private"
    Response.CacheControl = "no-cache"
    Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
    Response.Write "<root><appid>finereason</appid><status>1</status><body><message>" & ErrMsg & "</message></body></root>"
    Response.End
End Sub
Sub WriteXml()
    Response.Clear
    Response.ContentType = "text/xml"
    Response.Charset = "gb2312"
    Response.Expires = 0
    Response.Expiresabsolute = Now() - 1
    Response.AddHeader "pragma", "no-cache"
    Response.AddHeader "cache-control", "private"
    Response.CacheControl = "no-cache"
    Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>" & vbNewLine
    Response.Write sMyXmlDoc.documentElement.xml
    Response.End
End Sub

Function exchangeGender(iSex)
    If IsNull(iSex) Or iSex = "" Or Not IsNumeric(iSex) Then
        exchangeGender = 2
        Exit Function
    End If
    If iSex = "1" Then
        iSex = 0
    ElseIf iSex = "0" Then
        iSex = 1
    Else
        iSex = 2
    End If
End Function

Function AnsiToUnicode(ByVal str)
    Dim i, j, c, i1, i2, u, fs, f, p
    AnsiToUnicode = ""
    p = ""
    For i = 1 To Len(str)
        c = Mid(str, i, 1)
        j = AscW(c)
        If j < 0 Then
            j = j + 65536
        End If
        If j >= 0 And j <= 128 Then
            If p = "c" Then
                AnsiToUnicode = " " & AnsiToUnicode
                p = "e"
            End If
            AnsiToUnicode = AnsiToUnicode & c
        Else
            If p = "e" Then
                AnsiToUnicode = AnsiToUnicode & " "
                p = "c"
            End If
            AnsiToUnicode = AnsiToUnicode & ("&#" & j & ";")
        End If
    Next
End Function

Function BytesToBstr(Body, Cset)
    Dim Objstream
    Set Objstream = Server.CreateObject("adodb.stream")
    Objstream.Type = 1
    Objstream.Mode = 3
    Objstream.Open
    Objstream.Write Body
    Objstream.Position = 0
    Objstream.Type = 2
    Objstream.Charset = Cset
    If Err.Number <> 0 Then
        Err.Clear
        Objstream.Close
        Set Objstream = Nothing
        BytesToBstr = "$False$"
        Exit Function
    End If
    BytesToBstr = Objstream.ReadText
    Objstream.Close
    Set Objstream = Nothing
End Function
%>
