Подскажите пожалуйста, ка зделать такого Агента

  • Автор темы -
  • Дата начала
Статус
Закрыто для дальнейших ответов.

Гость
#1
Господа, я совсем недавно столкнулся с задачами Lotus Notes, но мне нарезали
срочное задание зделать вот такого вот агента на станции клиета почтовой базы
LN.
Его действия (запускаемые вручную из меню "Действия"):
1. Пометить выбранное сообщение как прочитанное (это я разобрался).
2. Сформировать подтверждение о доставке (так ка подтверждение формируется
автоматически при открытии сообщения).
3. Извлечь все вложенные файлы в каталог на локальном диске !
4. Скопировать содержимое поля "Тема" в текстовый файл на локальном диске
(можно, чтобы создавал сам файл, можно и в ранее созданный- пофиг).

Помогите пожалуйста, буду премного благодарен.
Заранее спаисбо.
С уважением Аркадий fhserv@mail.ru icq 24295867
 
N

nor

Гость
#2
Привет, Аркадий
Следующий агент создается в почтовой бд пользователя. Для распространения агента для всех пользователей необходимо модифицированную почтовую бд реплицировать как шаблон. Агент выполняет следующие действия для помеченных пользователем документов: 1. формирует подтверждение о доставке, 2. извлекает вложенные файлы в указанный пользователем каталог на локальный диск (при отсутствии каталога он создается агентом), 3. копирует содержимое темы письма в указанный пользователем текстовый файл (*.txt) на локальном диске (при отсутствии файла, он создается агентом; если файл уже существует, то новая информация добавляется в конец этого файла). Агент проверен на работоспособность.


Код:
Name: Обработка писем | MailDocProccess
Options: Shared
Runtime: Trigger On event; Action menu selection; Target: All selected documents

(Options)
Option Public
%INCLUDE "lsconst.lss"

(Declarations)
Dim session As NotesSession
Dim ws As NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim collection As NotesDocumentCollection
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim dateTime As NotesDateTime
Dim obj As NotesEmbeddedObject

'____________________________________
Dim attach_dir As String
Dim subject_file As String

Sub Initialize

Set session = New NotesSession
Set ws = New NotesUIWorkspace
Set db = session.CurrentDatabase	

Call MailDocProccess()

End Sub

Sub MailDocProccess()
Dim maildoc As NotesDocument
Dim msg As String	
Dim file_name As String
Dim dir_name As String	
Dim file_num As Integer

Set dateTime = New NotesDateTime( "00/00/00" )
Set collection = db.UnprocessedSearch("!@IsUnavailable(Form)", dateTime, 0)	
If collection.Count = 0 Then
msg = "Выберите документы."
Messagebox msg, MB_OK + MB_ICONINFORMATION, db.Title  
Exit Sub
End If

attach_dir = Inputbox$("Укажите директорию расположения вложенных файлов писем:" ,db.Title, "C:\EMailFiles")
subject_file = Inputbox$("Укажите файл, содержащий темы сообщений писем :" ,db.Title, "C:\EMailSubjects\EMailSubjects.txt")

attach_dir = FileDir(attach_dir)
If attach_dir = "" Then Exit Sub 
file_name = Strrightback(subject_file, "\")
dir_name = Strleft(subject_file, "\" + file_name, 1)
If FileDir(dir_name) = "" Then Exit Sub 

For i = 1 To collection.Count
Set doc = collection.GetNthDocument(i)

' формирование подтверждения о доставке письма
Set maildoc = New NotesDocument(db)	
maildoc.Form = "Memo"
maildoc.Subject = "ДОСТАВЛЕНО: " + doc.Subject(0)
maildoc.SendTo = doc.From(0)
maildoc.Principal = "Mail Router"
Set rtitem = New NotesRichTextItem(maildoc, "Body")	
msg = "Ваш документ " + doc.Subject(0) + " был доставлен " + doc.SendTo(0) + ", дата доставки " + Cstr(doc.DeliveredDate(0)) + "." 
Call rtitem.AppendText(msg) 	
Call maildoc.Send(False)	

' извлечение вложенных файлов письма в указанную директорию
If doc.HasEmbedded Then
Forall item In doc.Items
 If item.Name = "$FILE" Then
 	Set item = doc.GetFirstItem(item.Name)
 	Set obj = doc.GetAttachment(item.Values(0))   
 	If obj.Type = EMBED_ATTACHMENT Then Call obj.ExtractFile(attach_dir + "\" + obj.Name)          	
 	Call item.Remove	' (если документ не сохранять, то поле не удалится)
 End If
End Forall 	
End If

' запись темы письма в указанный файл
file_num = Freefile() 
Open subject_file For Append As file_num
Write #file_num, doc.Subject(0)
Close file_num

Next

End Sub

Function FileDir(dir_name As String) As String
' Проверка наличия указанной директории; если директория отсутсвует, то она создается.
Dim drive As String
Dim dir_path As String 
Dim folder_name As String	
Dim msg As String

' проверка драйвера
drive = Strleft(dir_name, "\", 1)
If Instr(1, drive, ":", 5) = 0 Then 
msg = "Неверно задан путь." + Chr(10) + Chr(10) + "Действие отменено."
Messagebox msg, MB_OK + MB_ICONEXCLAMATION, db.Title  
FileDir = ""
Exit Function
End If

' проверка директории
dir_path = drive
Do 
dir_name = Strright(dir_name, "\", 1)
If Instr(1, dir_name, "\", 5) <> 0 Then
folder_name = Strleft(dir_name, "\", 1)
Else
folder_name = dir_name
End If 
dir_path = dir_path + "\" + folder_name  
If Dir$(dir_path, 16) = "" Then Mkdir dir_path	
dir_name = Strright(dir_name, folder_name, 1)
Loop While dir_name <> ""	

FileDir = dir_path

End Function
Если возникнут вопросы, то пиши.
 
Статус
Закрыто для дальнейших ответов.