Положить Файл На Сервер

Sub Initialize
 
Этот агент срабатывает из Веба при нажатии кнопки "Заказ" - посылает письмо-заказ
Dim s As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Set doc=s.DocumentContext
Set agentLog = New NotesLog("Agent log")
Call agentLog.OpenAgentLog
 
 
Set db=s.CurrentDatabase
Set memo = New NotesDocument(db)
Dim rt As NotesRichTextItem
Set rt = New NotesRichTextItem( memo, "Body" )
order = doc.Request_Content(0)     содержимое запроса в виде: from=...&subject=...&body=...
 
 
pos = Instr(order,"&")                     извлечение первого параметра from= и
textFrom = Left(order,pos-1)              присваивание его в поле SMTPOriginator:
order = Right(order, Len(order)-pos)  ответ будет отсылаться по этому адресу
posEq = Instr(textFrom, "=")
memo.SMTPOriginator = Right (textFrom , Len(textFrom)-posEq)
 
..... все остальные обработки строки запроса
 
memo.Form = "Document"
отправка письма в базу где оно будет обработано как входящий заказ
Call memo.Send (False, "адрес@базы куда отправляем на обработку")
 
Print |ответ клиенту|
Call agentLog.LogAction("создано и отправлено письмо")
Call agentLog.Close
End Sub

encode возвращает вместо " " -> "+"
http://docs.oracle.com/javase/1.4.2/docs/api/java/net/URLEncoder.html
Class HttpBase As ErrorHandlerWJ
Private curdoc As NotesDocument
Private ses As NotesSession
Private isPrintedHeader As Boolean
Private isPrintedEnd As Boolean
Private decoderClass As JavaClass
Private encoderClass As JavaClass
Private encoderObj As JavaObject
Private Contenttype As String
Private msgList List As String
Private msgCount As Long
Private errList List As String
Private errCount As Long
Sub New()
Set ses=New NotesSession
Set curdoc=ses.DocumentContext
Set encoderClass=jSession.Getclass({java/net/URLEncoder})
Set decoderClass=jSession.Getclass({java/net/URLDecoder})
Contenttype={text}
End Sub
 
Sub Delete
Me.Close
End Sub
 
Property Get CGIvar(xName As String) As String
CGIvar=curdoc.GetItemValue(xName)(0)
End Property
 
Private Property Set Content As String
 
End Property
 
Property Get GetRequestParams As Variant
On Error Goto ErrH
Dim s As String
s=Fulltrim(GetRequestQuery)
If Len(s)>0 Then
GetRequestParams=Split(s,{&})
Else
s=Fulltrim(GetRequestPost)
If Len(s)>0 Then GetRequestParams=Split(s,{&})
End If
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
 
Property Get GetRequestQuery As String
On Error Goto ErrH
используется Query_String_Decoded - не чувствует разницы между "+" и " "
это поведение типично и потому "+" -> " "
GetRequestQuery=curdoc.getItemValue("Query_String_Decoded")(0)
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
 
Property Get GetRequestPost As String
On Error Goto ErrH
GetRequestPost=curdoc.getItemValue("Request_Content")(0)
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
 
Property Get GetRequesPath As String
GetRequesPath=curdoc.getItemValueString("Path_Info_Decoded")
End Property
 
Sub PrintMsg(msg As String)
PrintHeader
msgList({message_} &Cstr(msgCount))=msg
msgCount=msgCount+1
End Sub
 
Function Decode(msg As String) As String
Decode=decoderClass.decode(msg)
End Function
 
Function DecodeUTF8(msg As String) As String
DecodeUTF8=decoderClass.decode(msg,{UTF-8})
End Function
 
Function DecodeCP1251(msg As String) As String
DecodeCP1251=decoderClass.decode(msg, {Cp1251})
End Function
 
Function DecodeAll(msg As String, enc As String) As String
DecodeAll=decoderClass.decode(msg, enc)
End Function
 
Function EncodeAll(msg As String, enc As String) As String
EncodeAll=encoderClass.encode(msg, enc)
End Function
 
Function Encode(msg As String) As String
Encode=encoderClass.encode(msg)
End Function
 
Sub PrintMsgEncoded(msg As String)
PrintHeader
msgList({messageEnc_} &Cstr(msgCount))=encoderClass.encode(msg)
End Sub
 
Private Function PrintHeader As Boolean
On Error Goto ErrH
If isPrintedHeader Then Exit Function
возвращаем результат в UTF-8
Print {Content-Type: } &Contenttype &{; charset=UTF-8"} text/xml;application/xml;
Print {Content-Type: } &Contenttype &{; charset=Windows-1251"}
isPrintedHeader=True
Me.PrintHeader=True
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
 
Private Function PrintEnd As Boolean
If Not isPrintedHeader Then Exit Function
If isPrintedEnd Then Exit Function
isPrintedEnd=True
Me.PrintEnd=True
End Function
 
Private Sub PrintError(msg As String)
PrintHeader
errList({error_} &Cstr(errCount))=msg
errCount=errCount+1
End Sub
 
Sub Close
PrintEnd
End Sub
End Class
 
Class HttpBaseXML As HttpBase
Function PrintHeader As Boolean
Dim b As Boolean
b=HttpBase..PrintHeader
Me.PrintHeader=b
If Not b Then Exit Function
Print {<?xml version="1.0" encoding="UTF-8"?>}
Print {<response>}
End Function
 
Sub New()
Contenttype={text/xml}
End Sub
 
Sub PrintMsg(msg As String)
PrintHeader
Print {<message>} &msg &{</message>}
End Sub
 
Sub PrintMsgEncoded(msg As String)
PrintHeader
Print {<messageenc>} &encoderClass.encode(msg) &{</messageenc>}
End Sub
 
Function PrintEnd As Boolean
Dim b As Boolean
b=HttpBase..PrintEnd
Me.PrintEnd=b
If Not b Then Exit Function
Print {</response>}
End Function
 
Sub PrintError(msg As String)
Call HttpBase..PrintError(msg)
Print {<error><object>} & Typename(Me) &{</object><message>} &msg &{</message></error>}
End Sub
End Class
 
Class HttpBaseJSON As HttpBase
Function PrintHeader As Boolean
Dim b As Boolean
b=HttpBase..PrintHeader
Me.PrintHeader=b
If Not b Then Exit Function
Print |{"response":[|
Print |{|
End Function
 
Sub New
Contenttype="application/json"
End Sub
 
Function PrintEnd As Boolean
Dim b As Boolean
b=HttpBase..PrintEnd
Me.PrintEnd=b
If Not b Then Exit Function
Print |"end":"end"]}|
Print |"end":"end"}|заглушка, чтобы не заморачиваться на оконечные запятые
End Function
 
Sub PrintMsg(msg As String)
PrintHeader
Print {"message":"} &msg &{",}
End Sub
 
Sub PrintMsgEncoded(msg As String)
PrintHeader
Print {"message_enc":"} &encoderClass.encode(msg) &{",}
End Sub
 
Sub PrintJSONvar(xName As String, xValue As String)
PrintHeader
Print {"} &xName &{":"} &xValue &{",}
End Sub
 
Sub PrintError(msg As String)
Call HttpBase..PrintError(msg)
Print |"error":{"object":"| & Typename(Me) &|", "message":"| &msg &|"},|
End Sub
 
Sub Close
разделим потоки ошибок и сообщений
выводим ошибки из буфера
Print |errors:[|
Forall e In errList
Print |{"| & Listtag(e) & |":{"object":"| & Typename(Me) &|", "message":"| & e &|"}},|
End Forall
если первым елементом - errors[0]=="end" - нет ошибок
Print |"end"],| зглушка окончания списка ошибок
выаодим сообщения из буфера
Print |messages:[|
Forall m In msgList
Print |{"| &Listtag(m) &|":"| &m &|"},|
Print |"| &m &|",|
End Forall
если первым елементом - messages[0]=="end" - нет сообщений
Print |"end"],| заглушка окончания списка сообщений
HttpBase..Close
End Sub
End Class
 
Class HttpObj As HttpBaseJSON
End Class