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

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