Class PoliaYurL
'Public NumDocF As Integer ' сколько нашлось доков
Public RegNum As String ' регномер
Public Tip As String ' тип - решщение / постановление
Public Datareg As String ' дата рег
Public Header As String ' заголовок
Public Ispolnitel As String ' вносит на расмотрение
Public UNID As String
Public Embed As ClassAtach
End Class
Class ClassAtach
Public descriptionAtach() As String
Public File64Atach() As String
End Class Public Function getAttachNew (AtName As String, UNID As String, Fault1 As WS_FAULT) As ClassAtach
Print "СТАРТ - функция getAttach"
On Error Goto processError
Dim session As NotesSession
Set session = New NotesSession
Dim inStream As NotesStream
Dim file As String
Dim Atachob As New ClassAtach ' Вложения
Dim db2 As NotesDatabase
Set db2 = session.GetDatabase("192","r.nsf")
If Not db2.Isopen Then'проверка доступа к базе
Print "Нет доступа к БД Решения/распоряжения"
Else
Print db2.Title
End If
Dim formula As String
formula = {id = "} & UNID & {"} ' regnom - текст , regnoms - цифра
Print formula
Set dc=db2.Search(formula, Nothing, 0)
Print "dc.count " dc.count
Print "Print" AtName
For i=1 To dc.count
Set doc = dc.GetNthDocument(i)
If doc.HasEmbedded Then 'есть вложения
datapatch$ = {C:\Tmp-attach\}
attachments = Evaluate("@AttachmentNames", doc)
Forall a In attachments
If AtName = a Then
Set o=doc.GetAttachment(a)
Set inStream=session.Createstream
Call o.ExtractFile ( datapatch$ & o.Name)
file = datapatch$ & o.Name
Print file
Call inStream.Open(file)
plainText$ = inStream.ReadText()
Dim b64 As New CBase64()
plainText$ = b64.encode (inStream)
Call inStream.Close
Kill datapatch$ & o.Name
Redim Preserve Atachob.descriptionAtach(0)
Redim Preserve Atachob.File64Atach(0)
Atachob.descriptionAtach(0) = o.Name
Atachob.File64Atach(0) = plainText$
Else
Print "ненужное вложение " a
End If
End Forall
Else
Print "нет вложений"
End If
Next
Set getAttachNew = Atachob
Print "КОНЕЦ - функция getAttachNew"
Exit Function
processError:
Print Err, Error & { _В строке__ } & Erl
Call Fault1.setFault(True) ' необходимо для ошибочной активации
Call Fault1.setFaultString(Error$ & Erl())
Exit Function
End Function Public Function getAttach (UNID As String, Fault1 As WS_FAULT) As ClassAtach
Print "СТАРТ - функция getAttach"
Dim session As NotesSession
Set session = New NotesSession
Dim inStream As NotesStream
Dim file As String
Dim Atachob As New ClassAtach ' Вложения
Dim db2 As NotesDatabase
Set db2 = session.GetDatabase("192","r.nsf")
If Not db2.Isopen Then'проверка доступа к базе
Print "Нет доступа к БД"
Else
Print db2.Title
End If
Dim formula As String
formula = {id = "} & UNID & {"} ' regnom - текст , regnoms - цифра
Print formula
Set dc=db2.Search(formula, Nothing, 0)
Print "dc.count " dc.count
For i=1 To dc.count
Set doc = dc.GetNthDocument(i)
If doc.HasEmbedded Then 'есть вложения
datapatch$ = {C:\Tmp-attach\}
attachments = Evaluate("@AttachmentNames", doc)
i=0
Forall a In attachments
Set o=doc.GetAttachment(a)
Set inStream=session.Createstream
Call o.ExtractFile ( datapatch$ & o.Name)
file = datapatch$ & o.Name
Print file
Call inStream.Open(file)
plainText$ = inStream.ReadText()
Dim b64 As New CBase64()
plainText$ = b64.encode (inStream)
Call inStream.Close
Kill datapatch$ & o.Name
Redim Preserve Atachob.descriptionAtach(i)
Redim Preserve Atachob.File64Atach(i)
Atachob.descriptionAtach(i) = o.Name
Atachob.File64Atach(i) = plainText$
i=i+1
End Forall
Else
Print "нет вложений"
End If
Next
Set getAttach = Atachob
Print "КОНЕЦ - функция getAttach"
End FunctionClass ClassArray ' описание вложения для getRD
Public Function FuncAtachttInfo (doc As NotesDocument, Fault1 As WS_FAULT) As ClassAtach
'Print "FunctionArray" & doc.header(0)
On Error Goto processError3
Dim file As String
Dim session As New NotesSession
Dim inStream As NotesStream
Dim Atachob As New ClassAtach
If doc.HasEmbedded Then
datapatch$ = {C:\Tmp-attach\}
attachments = Evaluate("@AttachmentNames", doc)
i=0
Forall a In attachments
Set o=doc.GetAttachment(a)
Redim Preserve Atachob.descriptionAtach(i)
Redim Preserve Atachob.File64Atach(i)
Atachob.descriptionAtach(i) = o.Name
Atachob.File64Atach(i) = "" ' plainText$ неисп
i=i+1
End Forall
Else
Print "нет вложений"
End If
Set FuncAtachttInfo = Atachob
Exit Function
processError3:
Print Err, Error & { _В строке__ } & Erl
Call Fault1.setFault(True) ' необходимо для ошибочной активации
Call Fault1.setFaultString(Error$ & Erl())
Exit Function
End Function
End Class Class RDNameArray ' Поля Документа
Public MainMassiv() As PoliaYurL ' главный тег POLIAYURL (экземпляр MainMassiv класса PoliaYurL)
Public Function MyArr (dc As NotesDocumentCollection, Fault1 As WS_FAULT) As String
Print "MyArr"
Dim doc As NotesDocument
If (dc.count = 0) Then
Redim MainMassiv(0)
Else
j%=0
For i=1 To dc.count
Set doc = dc.GetNthDocument(i)
' Print j% ". " doc.header(0)
Print doc.datereg(0) " - datereg"
Dim obyekt As New PoliaYurL
obyekt.RegNum = doc.regnoms(0)
' Print doc.regnoms(0) " - regnoms"
obyekt.Tip = doc.docnomen(0)
obyekt.Datareg = doc.datereg(0)
obyekt.Header = doc.header(0)
obyekt.Ispolnitel = doc.resolution(0)
obyekt.UNID = doc.id(0)
Set Myfunk = New ClassArray
Set obyekt.Embed = Myfunk.FuncAtachttInfo(doc,Fault1)
Redim Preserve MainMassiv (j%)
Set MainMassiv(j%) = obyekt
j%=j%+1
Next
End If
Print "MyArr-ЕНД"
End Function
End Class
Class Yurclass
' ---------------------- 2 --------------- ПОЛУЧИТЬ ДОК
Public Function getRD (Date1 As String, Date2 As String, RegNum As String, header As String, Fault1 As WS_FAULT) As RDNameArray
Print "СТАРТ вебсервиса Prok-ra. функция getRD"
Dim formula As String
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Dim session As NotesSession
Set session = New NotesSession
Dim db2 As NotesDatabase
Set db2 = session.GetDatabase("192.....","r.nsf")
If Not db2.Isopen Then'проверка доступа к базе
Print "Нет доступа к БД "
Else
Print db2.Title
End If
If RegNum<>"" Then
formula = {regnoms = "} & RegNum & {"} ' regnom - текст , regnoms - цифра
Set dc=db2.Search(formula, Nothing, 0)
End If
If header<>"" Then
formula = {[header] CONTAINS "} & header & {"}
Set dc=db2.FTSearch(formula,0,FT_DATE_DES,FT_STEMS+FT_FUZZY)
End If
If Date1<>"" Then
formula = {([datereg] >= } & Date1 &{)}
Set dc=db2.FTSearch(formula,0)
End If
If Date2<>"" Then
formula = formula + { & ([datereg] <= } & Date2 &{)}
Set dc=db2.FTSearch(formula,0)
End If
Print formula 'Set dc=db2.FTSearch(formula,0,FT_SCORES)
Print "dc.count " dc.count
Set getRD = New RDNameArray
Call getRD.MyArr(dc,Fault1)
Print "ЕНД функция getRD. вебсервиса Prok-ra"
End Function
End Class