hMailServer — вырезаем текст из письма 2

В прошлом году написал статью, как вырезать текст из письма:

hMailServer — вырезаем текст из письма

Иногда требуется вырезать кусок лишнего текста, это может быть:

• ненужный рекламный блок
• нежелательный футер
• чувствительная информация в виде номеров банковских карт или баланс счёта
• любая другая ненужная информация, от которой нужно избавиться

Всё было прекрасно до определённого момента, пока отправитель не изменил HTML тело письма. В письмо была вставлена какая-то кривая картинка, которую COM API сервера не смог распознать. Всё как здесь:

https://github.com/hmailserver/hmailserver/issues/28

Разработчик hMailServer исправил ошибку, но она выстрелила снова. Симптомы следующие:

Если мы просто получаем письмо, или переадресуем его, то всё проходит успешно. Но стоит вызвать собственную функцию и попытаться получить oMessage.HTMLBody, то письмо считывается не полностью, код обрывается на середине. Мы просто теряем возможность работать с HTML телом письма. Если бы в письме сообщение дублировалось через PLAIN TEXT, то можно было бы работать с ним, однако, у нас чистый HTML.

Если мы вызываем такую функцию, то проблем нет:

Sub MailFabric(oMessage)
	if oMessage.HasBodyType("text/html") then
		dim x
		'что-то своё делаем, не трогая письмо
	end if
	oMessage.Save
End Sub

Как только мы получаем oMessage.HTMLBody и перезаписываем, то всё плохо:

Sub MailFabric(oMessage)
	if oMessage.HasBodyType("text/html") then
		oMessage.HTMLBody = oMessage.HTMLBody
	end if
	oMessage.Save
End Sub

Бубен не помог, будем добавлять танцы.

Скрипт для вырезания текста из сообщения

Раз наше COM API не работает в плане получения текста HTML, то будем писать своё. В этом нам поможет переменная oMessage.Filename, в которой содержится путь к EML файлу письма. Зная путь, мы можем сами открыть файл, распарсить его и получить вожделенный HTML. Исправим его и засунем обратно в письмо. Приступим.

Включаем скрипты: Настройки → Дополнительно → Скрипты.

Сохранить.

Кнопка Показать откроет директорию с файлом скриптов. По умолчанию это C:\Program Files (x86)\hMailServer\Events\EventHandlers.vbs. Редактируем файл EventHandlers.vbs. Следует помнить, что после внесения изменений в файл нужно нажать кнопку Перезагрузить, при этом изменения внесутся в память hMailServer. Кнопка Проверка проверяет код на наличие ошибок.

Добавляем код:

• EventHandlers.vbs

  Sub MailClean(oMessage)
  	dim FSO, OFile
  	dim MyPattern, objRegExp
  	
  	'если письмо HTML, то танцы с бубном
  	if oMessage.HasBodyType("text/html") then
  		oMessage.RefreshContent()
  		set FSO = CreateObject("Scripting.FileSystemObject")
  		
  		'из-за ошибки в COM API мы не можем читать кривой код oMessage.HTMLbody,
  		'поэтому сами получим его из файла письма.
  		dim oMHTMLBody
  		
  		'вытаскиваем тело письма из файла
  		oMHTMLBody = TakeHTMLFromEML(oMessage.Filename)
  		
  		'декодируем из Base64
  		oMHTMLBody = Base64Decode(oMHTMLBody)
  		
  		'вырезаем строку
  		
  		'регулярное выражение для вырезания строки из тела письма
  		MyPattern = "Ваш(<.*>)?[\s]*(<.*>)?баланс(<.*>)?[\s]*(<.*>)?[0-9]\d*(,|\.)[0-9]{1,2}(<.*>)?\."
  
  		'мы пишем здесь на UTF-8, а hMailServer работает с ISO-8859-1, переводим нашу регулярку в другую кодировку
  		MyPattern = StrConv(MyPattern,"UTF-8","ISO-8859-1")
  
  		'объект для регулярного выражения [Global = True] ищет все вхождения, если нужно вырезать только первое, сто ставим false
  		Set objRegExp = CreateObject("VBScript.RegExp")
  		objRegExp.Pattern = MyPattern
  		objRegExp.Global = True
  		objRegExp.IgnoreCase = False
  		objRegExp.Multiline = True
  		oMessage.HTMLBody = objRegExp.Replace(oMHTMLBody, "")
  	end if
  	
  	'если письмо текстовое, то правим oMessage.Body
  	if oMessage.HasBodyType("text/plain") then
  		'вырезаем строку
  		
  		'регулярное выражение для вырезания строки из тела письма
  		MyPattern = "Ваш баланс [0-9]\d*,[0-9]{1,2}\."
  		
  		'объект для регулярного выражения [Global = True] ищет все вхождения, если нужно вырезать только первое, сто ставим false
  		Set objRegExp = CreateObject("VBScript.RegExp")
  		objRegExp.Pattern = MyPattern
  		objRegExp.Global = True
  		objRegExp.IgnoreCase = False
  		objRegExp.Multiline = False
  		oMessage.Body = objRegExp.Replace(oMessage.Body, "")
  	end if
  	
  	oMessage.Save
  End Sub
  
  Function StrConv(Text,SourceCharset,DestCharset)
  	Set Stream = CreateObject("ADODB.Stream")
  	Stream.Type=2
  	Stream.Mode=3
  	Stream.Open
  	Stream.Charset=DestCharset
  	Stream.WriteText Text
  	Stream.Position=0
  	Stream.Charset=SourceCharset
  	StrConv = Stream.ReadText
  End Function
  
  Function TakeHTMLFromEML(PathEML)
  	TakeHTMLFromEML = ""
  
  	dim FSO
  	set FSO = CreateObject("Scripting.FileSystemObject")
  			
  	'читаем файл письма сами (1 = ForReading)
  	dim fM, fMcontent
  	Set fM = FSO.OpenTextFile(PathEML, 1)
  	fMcontent = fM.ReadAll
  	fM.Close
  
  	'выбираем контент письма
  	dim fMpattern, fMRE, fMatches, fMHTMLcontent
  	fMpattern = "--boundary[\s\S]*--boundary--"
  	Set fMRE = CreateObject("VBScript.RegExp")
  	fMRE.Pattern = fMpattern
  	fMRE.Global = False
  	fMRE.IgnoreCase = False
  	fMRE.Multiline = True
  	Set fMatches = fMRE.Execute(fMcontent)
  	if fMatches.Count > 0 Then
  		'вырезаем лишнее
  		fMHTMLcontent = fMatches.Item(0).Value
  		fMHTMLcontent = Replace(fMHTMLcontent, "--boundary--", "")
  		fMHTMLcontent = Replace(fMHTMLcontent, "--boundary", "")
  		fMHTMLcontent = Replace(fMHTMLcontent, "Content-Type: text/html; charset=utf-8", "")
  		fMHTMLcontent = Replace(fMHTMLcontent, "Content-Transfer-Encoding: base64", "")
  		fMHTMLcontent = Trim(fMHTMLcontent)
  		TakeHTMLFromEML = fMHTMLcontent
  	end if
  End Function
  
  Function Base64Decode(ByVal vCode)
  	Dim oXML, oNode
  	Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  	Set oNode = oXML.CreateElement("base64")
  	oNode.dataType = "bin.base64"
  	oNode.text = vCode
  	Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
  	Set oNode = Nothing
  	Set oXML = Nothing
  End Function
  
  'Stream_BinaryToString Function
  '2003 Antonin Foller, http://www.motobit.com
  'Binary - VT_UI1 | VT_ARRAY data To convert To a string 
  Function Stream_BinaryToString(Binary)
  	Const adTypeText = 2
  	Const adTypeBinary = 1
  
  	'Create Stream object
  	Dim BinaryStream 'As New Stream
  	Set BinaryStream = CreateObject("ADODB.Stream")
  
  	'Specify stream type - we want To save binary data.
  	BinaryStream.Type = adTypeBinary
  
  	'Open the stream And write binary data To the object
  	BinaryStream.Open
  	BinaryStream.Write Binary
  
  	'Change stream type To text/string
  	BinaryStream.Position = 0
  	BinaryStream.Type = adTypeText
  
  	'Specify charset For the output text (unicode) data.
  	'BinaryStream.CharSet = "us-ascii"
  	BinaryStream.CharSet = "UTF-8"
  
  	'Open the stream And get text/string data from the object
  	Stream_BinaryToString = BinaryStream.ReadText
  	Set BinaryStream = Nothing
  End Function

Здесь:

• MailClean — функция удаления ненужного текста из тела письма
• oMessage.RefreshContent() — не обязательная вещь, перечитывает содержимое письма в COM API объект.
• TakeHTMLFromEML — функция для вытаскивания из EML тела письма, часть данных я стираю
• Base64Decode — тело письма оказалось закодировано в Base64, декодер
• Stream_BinaryToString — вспомогательная функция для декодирования, обратите внимание на кодировку внутри
• StrConvert — вспомогательная функция для конвертации текста, нужна для поддержки кириллицы
• MyPattern — регулярное выражение для поиска ненужной строки, разное, в зависимости от типа письма

Стоит обратить внимание на работу с кодировками, особенно если требуется работать с кириллицей. И не забывайте о том, что письмо может быть текстовым или HTML. TakeHTMLFromEML — здесь можно было бы использовать регулярное выражение для поиска Base64, но я пошёл по более простому пути, мне нужно было изменить только один шаблон письма от одного отправителя.

Пример настройки ящика

Настроим ящик cleantest@internet-lab.ru, Переключаемся на вкладку правила.

Добавляем новое правило, у меня уже добавлено, назвал его: "CleanTest".

Какой добавлять критерий — решать вам. Если нужно обрабатывать все сообщения, указываем Размер сообщения > 0. Если нужно чистить письма только от определённого отправителя или получателя — указываем соответствующий адрес. Критериев может быть несколько.

Добавляем действие "Выполнить скрипт".

Выполняем скрипт MailClean. Сохраняем изменения. P.S. VBS скрипт у меня сохранён в UTF-8. Без BOM.

Конец

Данный пример — не панацея от всех бед. Но на конкретном примере мы показали, что некоторые недоработки COM API в hMailServer мы можем обойти, использую свои собственные руки. Очень жаль, что разработчик hMailServer почти не занимается разработкой. На форуме есть предложение взять управление эти бесплатным сервером в свои руки. В любом случае, код доступен на GitHub.