Oracle Seeker, Oracle探索者

 
 
 
               aronehome
               aronehome

Option Explicit
 
Implements IHeaderHandler
 
Private Const XmlnsSoap As String = "http://schemas.xmlsoap.org/soap/envelope/"
Private Const SecurityXmlnsWsse As String = "http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
Private Const SecurityXmlns As String = "http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
Private Const SecurityXmlnsEnv As String = "http://schemas.xmlsoap.org/soap/envelope/"
Private Const UsernameTokenXmlnsWsse As String = "http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
Private Const UsernameTokenXmlns As String = "http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd"
Private Const WssePasswordType As String = "http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-username-token-profile-1.0#PasswordText"
 
Private myUsernameToken As String
Private myPassword As String
Private myMustUnderstand As Integer
 
Public Property Let UsernameToken(ByVal pUsernameToken As String)
    myUsernameToken = pUsernameToken
End Property
 
Public Property Get UsernameToken() As String
    UsernameToken = myUsernameToken
End Property
 
Public Property Let Password(ByVal pPassword As String)
    myPassword = pPassword
End Property
 
Public Property Get Password() As String
    Password = myPassword
End Property
 
Public Property Let MustUnderstand(ByVal pMustUnderstand As Integer)
    myMustUnderstand = pMustUnderstand
End Property
 
Public Property Get MustUnderstand() As Integer
    MustUnderstand = myMustUnderstand
End Property
 
Private Function IHeaderHandler_ReadHeader(ByVal par_Reader As MSOSOAPLib30.ISoapReader, ByVal par_HeaderNode As MSXML2.IXMLDOMNode, ByVal par_Object As Object) As Boolean
    IHeaderHandler_ReadHeader = True
End Function
 
Private Function IHeaderHandler_WillWriteHeaders() As Boolean
    IHeaderHandler_WillWriteHeaders = True
End Function
 
Private Sub IHeaderHandler_WriteHeaders(ByVal par_ISoapSerializer As MSOSOAPLib30.ISoapSerializer, ByVal par_Object As Object)
    Dim tempHeaderDoc As String
    tempHeaderDoc = ""
    tempHeaderDoc = tempHeaderDoc & " " _
                    & "" _
    tempHeaderDoc = tempHeaderDoc & " " _
                    & "" & myUsernameToken & "" _
                    & "" & myPassword & ""
    tempHeaderDoc = tempHeaderDoc & "" _
                    & "" _
                    & ""
    par_ISoapSerializer.WriteXml tempHeaderDoc   
End Sub

'用户认证
Dim objCurAuthHelper As UserTokenAuthHelper
Set objCurAuthHelper = New UserTokenAuthHelper
objCurAuthHelper.UsernameToken = "aronehome"
objCurAuthHelper.Password = "aronehome"
objCurAuthHelper.MustUnderstand = 1
Set sc_UserListInfo.HeaderHandler = objCurAuthHelper

Private sc_UserListInfo As SoapClient30
Private Const c_WSDL_URL As String = "http://oracle:8888/aronehome/UserListInfoSoapHttpPort?wsdl"
Private Const c_SERVICE As String = "UserListInfo"
Private Const c_PORT As String = "UserListInfoSoapHttpPort"
Private Const c_SERVICE_NAMESPACE As String = "http://com/aronehome/demo/UserListInfo.wsdl"
 
Private Sub Class_Initialize()
    Dim str_WSML As String
    str_WSML = ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
    str_WSML = str_WSML & ""
 
    Set sc_UserListInfo = New SoapClient30
 
    sc_UserListInfo.MSSoapInit2 c_WSDL_URL, str_WSML, c_SERVICE, c_PORT, c_SERVICE_NAMESPACE
    'Use the proxy server defined in Internet Explorer's LAN settings by
    'setting ProxyServer to 
    sc_UserListInfo.ConnectorProperty("ProxyServer") = ""
    'Autodetect proxy settings if Internet Explorer is set to autodetect
    'by setting EnableAutoProxy to True
    sc_UserListInfo.ConnectorProperty("EnableAutoProxy") = True
 
    Set sc_UserListInfo.ClientProperty("GCTMObjectFactory") = New clsof_Factory_UserListInfo
 
End Sub
 
Private Sub Class_Terminate()
 
    'Error Trap
    On Error GoTo Class_TerminateTrap
 
    Set sc_UserListInfo = Nothing
 
Exit Sub
 
Class_TerminateTrap:
    UserListInfoErrorHandler ("Class_Terminate")
End Sub
 
Private Sub UserListInfoErrorHandler(str_Function As String)
 
    'SOAP Error
    If sc_UserListInfo.FaultCode <> "" Then
        Err.Raise vbObjectError, str_Function, sc_UserListInfo.FaultString
    'Non SOAP Error
    Else
        Err.Raise Err.Number, str_Function, Err.Description
    End If
 
End Sub
 
Public Function wsm_getUserList() As Variant
    'Error Trap
    On Error GoTo wsm_getUserListTrap
 
    wsm_getUserList = sc_UserListInfo.getUserList()
 
Exit Function
wsm_getUserListTrap:
    UserListInfoErrorHandler "wsm_getUserList"
End Function
 
Public Sub wsm_updateUserInfo(ByVal ar_pUserList As Variant)
    'Error Trap
    On Error GoTo wsm_updateUserInfoTrap
 
    sc_UserListInfo.updateUserInfo ar_pUserList
 
Exit Sub
wsm_updateUserInfoTrap:
    UserListInfoErrorHandler "wsm_updateUserInfo"
End Sub

Dim clsUserListInfo As clsws_UserListInfo
Dim objCurUserListArray() As struct_AronehomeDemoWs2User
Dim objCurUser As struct_AronehomeDemoWs2User
 
Set clsUserListInfo = New clsws_UserListInfo
objCurUserListArray = clsUserListInfo.wsm_getUserList
 
For i = 0 To UBound(objCurUserListArray)
    Set objCurUser = objCurUserListArray(i)
    MsgBox objCurUser.username + "" + objCurUser.password
Next

Dim lines As Integer
Dim clsUpdateUserInfo As clsws_UserListInfo
Dim objCurUserInfoArrary() As struct_AronehomeDemoWs2User
Dim objCurUserInfo As struct_AronehomeDemoWs2User
 
lines = 3
 
ReDim objCurUserInfoArrary(lines) As struct_AronehomeDemoWs2User
 
For i = 1 To 3
    Set objCurUserInfo = New struct_AronehomeDemoWs2User
    objCurUserInfo.userid = i
    objCurUserInfo.username = "a" + i
    objCurUserInfo.password = "b" + i
 
    Set objCurUserInfoArray(i) = objCurUserInfo
Next
 
Set clsUpdateUserInfo = New clsws_UserListInfo
clsUpdateUserInfo.wsm_updateUserInfo objCurUserInfoArray