Lotus/Domino и вебсервер. Вебсервисы (web-services) в лотусе.

Class Yurclass
    Public Function getYurName  (sFullName As String) As String
        Dim session  As NotesSession 
        Set session = New NotesSession 
        Dim db2 As notesdatabase 
        Set db2 = session.GetDatabase("","fiWor\BN.nsf")
        getYurName  =  db2.Title
    End Function
End Class

Public Function getYurName  (sFullName As String, Fault1 As WS_FAULT) As String
        On Error Goto processError
        Dim formula As String
        Dim mas As String
        Dim session  As NotesSession 
        Set session = New NotesSession 
        Dim db As notesdatabase 
        Dim db2 As notesdatabase 
        Set db = session.CurrentDatabase
        Set db2 = session.GetDatabase("","Offr\Arh.nsf")
        mas = ""
        formula =  {@Contains(FullName;"} & sFullName & {")}        
        Dim doc As notesdocument
        Dim dc As NotesDocumentCollection
        Set dc=db2.Search(formula,Nothing,0) 
        mas  = "найдено" &  dc.count & ": "
        For i=1 To dc.count
            Set doc = dc.GetNthDocument(i)        
            mas = mas & "//" &  doc.FullName(0) &    "-"    &  doc.Afiscod(0)     
        Next
        getYurName  = mas
        Exit Function
processError:
        Call Fault1.setFault(True)   ' необходимо для ошибочной активации 
        Call Fault1.setFaultString(Error$  & Erl())  
        Exit Function    
    End Function

Class myklass
    Public A() As String
    Public B() As String    
End Class

Class test
    Public Function BaseName  (xName As String,yName As String  ) As myklass
        Dim xxx As New myklass
        Redim xxx.A(5)
        Redim xxx.B(5)
        For x=0 To 5
            xxx.A(x) =  xName
            xxx.B(x)=  yName
        Next
        Set        BaseName = xxx
    End Function
End Class

 <BASENAMEReturn xsi:type="ns1:MYKLASS">
            <A xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[6]">
               <item xsi:type="xsd:string">1</item>
               <item xsi:type="xsd:string">1</item>
               <item xsi:type="xsd:string">1</item>
               <item xsi:type="xsd:string">1</item>
               <item xsi:type="xsd:string">1</item>
               <item xsi:type="xsd:string">1</item>
            </A>
            <B xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[6]">
               <item xsi:type="xsd:string">2</item>
               <item xsi:type="xsd:string">2</item>
               <item xsi:type="xsd:string">2</item>
               <item xsi:type="xsd:string">2</item>
               <item xsi:type="xsd:string">2</item>
               <item xsi:type="xsd:string">2</item>
            </B>
         </BASENAMEReturn>

%INCLUDE "lsxsd.lss"

Class BookPolya
    Public author As String
    Public description As String
End Class

Class myArray
    Public bookArray() As BookPolya
    
    Public Function    setmyArray  (x As String, Fault1 As WS_FAULT) As String
        On Error Goto processError
        Redim bookArray(2)
        For i=0 To 2
            Dim book As New BookPolya
            book.author = "author " &  i
            book.description = "description " &  i
            Set bookArray(i) = book
        Next
        Exit Function
processError:
        Call Fault1.setFault(True)
        Call Fault1.setFaultString(Error$  & Erl())  
        Exit Function
    End Function
End Class    

Class Yurclass
    Public Function Myfunk  (sName As String, Fault1 As WS_FAULT) As myArray ' Вызываемая функция
        On Error Goto processError
        Set Myfunk = New myArray
        Call Myfunk.setmyArray(sName,Fault1)
        Exit Function
processError:
        Call Fault1.setFault(True)
        Call Fault1.setFaultString(Error$  & Erl())  
        Exit Function
    End Function
End Class

    Public Function getArea  (FIO As String, Pasp As String, Fault1 As WS_FAULT)  
        On Error Goto processError        
        Dim formula As String
        Dim session  As NotesSession 
        Dim dc As NotesDocumentCollection
        Dim doc As notesdocument
        Dim db2 As notesdatabase 
        Dim dblog As notesdatabase
        Dim doclog As notesdocument
        
        Set session = New NotesSession 
        Set db2 = session.GetDatabase("","....GosReRe.nsf")
        Set dblog = session.GetDatabase("","WebLog.nsf")
        
        Set doclog = New NotesDocument    (dblog)
        Dim dateTime As New NotesDateTime( "" )
        dateTime.LSLocalTime = Now
        doclog.Form ="Log Entry"
        doclog.text_log = FIO
        doclog.base_name="Недвижимость"
        Dim doc2 As NotesDocument ' Не всё логирует!!
        Set doc2 = session.DocumentContext
        doclog.ip = doc2.Remote_Addr(0)
        
        formula =  {([PravoObladF1_1] CONTAINS "} &  FIO & {")  &  ([PravoObladF1_1]  CONTAINS "} & Pasp  & {")  & ([Form] CONTAINS "forma1-3" OR "forma1-2" OR "forma1-1")}        
        
        If Pasp ="" Then
            formula =  {([PravoObladF1_1] CONTAINS "} &  FIO & {")  &   ([Form] CONTAINS "forma1-3" OR "forma1-2" OR "forma1-1")}            
        End If
        
        Set dc=db2.FTSearch(formula,0) 
        Print "найдено: " & dc.count
        
        If dc.count=0 Then
            getArea="ничего не найдено"    
        Else
            
            Dim returnArray As New VARIANTARRAY_HOLDER
        'Redim returnArray.Value(dc.count,2)
            Redim returnArray.Value(dc.count-1,1)
            For i=1 To dc.count
                Set doc = dc.GetNthDocument(i)    
                
                returnArray.Value(i-1,0) = doc.AdresF1_1(0)
                returnArray.Value(i-1,1) = doc.PloshF1_1(0) 
            'returnArray.Value(i,2) = doc.PravoObladF1_1(0)
            Next
            
            Set getArea =returnArray
        End If
        doclog.log_time=dateTime.LSLocalTime
        Call doclog.Save(True, False)
        
        Exit Function
processError:
        doclog.ERRMSG = Error$  & Erl()
        doclog.log_time=dateTime.LSLocalTime
        Call doclog.Save(True, False)
        Call Fault1.setFault(True)   ' необходимо для ошибочной активации 
        Call Fault1.setFaultString(Error$  & Erl())  
    End Function

  <urn:GETAREA soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
         <FIO xsi:type="xsd:string">Сиваков</FIO>

   <ns1:GETAREAResponse soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:ns1="urn:DefaultNamespace">
         <GETAREAReturn xsi:type="soapenc:Array" soapenc:arrayType="xsd:anyType[7]">
            <item xsi:type="xsd:string">С район, с. С, ул. Чапаева, 1</item>
            <item xsi:type="xsd:string">93</item>
            <item xsi:type="xsd:string">г. Т, ул. 20 , д. 1, ком. 98</item>
            <item xsi:type="xsd:string">199,0 кв.м.</item>
......
         </GETAREAReturn>

Class GTKclass
    Public Function getIndP  (RegNum As String, SerPassp As String, NumPassp As String, Fam As String, FirstName As String, MiddleName As String,  Fault1 As WS_FAULT)  As IndPArray
        On Error Goto processError
Dim doc As notesdocument    
        Print "СТАРТ вебсервиса -  Function getIndP"
        Dim dc As NotesDocumentCollection
        Set getIndP = New IndPArray
        Call getIndP.SetMyArr(dc,Fault1)
        Exit Function    
        
processError:
        Print Err, Error & { в строке } & Erl
        Call Fault1.setFault(True)   ' необходимо для ошибочной активации 
        Call Fault1.setFaultString(Error$  & Erl())  
        Exit Function
        
    End Function
End Class

Class IndPArray
    Public MainMassiv() As PolyaIndP
    Public Function    SetMyArr  (dc As NotesDocumentCollection, Fault1 As WS_FAULT) As String
        j%=0
        For i=1 To dc.count
Set doc = dc.GetNthDocument(i)    
            Dim obyekt As New PolyaIndP
        ' obyekt.имя поля = значение с дока
            Redim Preserve MainMassiv (j%)
            Set MainMassiv(j%) = obyekt
            j%=j%+1
        Next
        Print "КОНЕЦ Вебсервиса -  Function getIndP"
    End Function
End Class

Class PolyaIndP
    'Возвращаемые данные - имена полей
Public фамилия As String
End Class

<wsdl:part name="REGNUM" type="xsd:string"/>
<wsdl:part name="SERPASSP" type="xsd:string"/>
<wsdl:part name="NUMPASSP" type="xsd:string"/>
<wsdl:part name="FAM" type="xsd:string"/>
<wsdl:part name="FIRSTNAME" type="xsd:string"/>
<wsdl:part name="MIDDLENAME" type="xsd:string"/>

Class indpredklass
    Public A() As String
    Public B() As String 
    Public C() As toklass '  тут!
End Class

Class toklass
    Public D(0) As String
    Public E(0) As String    
End Class

Class test
    Public Function BaseName  (xName As String,yName As String  ) As indpredklass
        Dim xxx As New indpredklass
        Dim yyy As New toklass
        Redim xxx.A(1)
        Redim xxx.B(1)
        Redim xxx.C(3)
        For x=0 To 1
            xxx.A(x) =  "Имя " &  xName-x
            xxx.B(x)=  "Фамилия" &  yName-x
        Next
        
        For x=0 To 3
            yyy.D(0) =  "ИмячленаКФХ " &  x
            yyy.E(0) =  "ФамилиячленаКФХ " &  x
            Set    xxx.C(x)=  yyy
        Next
        
        Set        BaseName = xxx
    End Function
End Class

<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://_.w3.org/2001/XMLSchema" xmlns:xsi="http://_.w3.org/2001/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">
   <soapenv:Body>
      <ns1:BASENAMEResponse soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:ns1="urn:DefaultNamespace">
         <BASENAMEReturn xsi:type="ns1:INDPREDKLASS">
            <A xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[2]">
               <item xsi:type="xsd:string">Имя 3</item>
               <item xsi:type="xsd:string">Имя 2</item>
            </A>
            <B xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[2]">
               <item xsi:type="xsd:string">Фамилия1</item>
               <item xsi:type="xsd:string">Фамилия0</item>
            </B>
            <C xsi:type="soapenc:Array" soapenc:arrayType="ns1:TOKLASS[4]">
               <item xsi:type="ns1:TOKLASS">
                  <D xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ИмячленаКФХ 3</item>
                  </D>
                  <E xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ФамилиячленаКФХ 3</item>
                  </E>
               </item>
               <item xsi:type="ns1:TOKLASS">
                  <D xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ИмячленаКФХ 3</item>
                  </D>
                  <E xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ФамилиячленаКФХ 3</item>
                  </E>
               </item>
               <item xsi:type="ns1:TOKLASS">
                  <D xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ИмячленаКФХ 3</item>
                  </D>
                  <E xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ФамилиячленаКФХ 3</item>
                  </E>
               </item>
               <item xsi:type="ns1:TOKLASS">
                  <D xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ИмячленаКФХ 3</item>
                  </D>
                  <E xsi:type="soapenc:Array" soapenc:arrayType="xsd:string[1]">
                     <item xsi:type="xsd:string">ФамилиячленаКФХ 3</item>
                  </E>
               </item>
            </C>
         </BASENAMEReturn>
      </ns1:BASENAMEResponse>
   </soapenv:Body>
</soapenv:Envelope>