STRIGANOV SERGEY: Software development.

Разработка программного обеспечения на: C++, T-SQL, VBS, JavaScript, PHP

VBS, Socket, SMTP: Sending e-mail from command line

This script do not use CDO.Message object for sending mail.
Used only asynchronous-sockets. We have full control on any command and events.

Скрипт отправляет e-mail из командной строки, используя для этого сокеты "MSWinsock.Winsock" (MSWINSCK.ocx).
Письма отправляются в кодировке windows-1251 с HTML форматированием, при необходимости, в письмо можно вложить файл.

В командной строке указать: кому, тему, текст_письма.
D:\Projects\SendMailSMTP.vbs "someto@someserver.com" "тема письма" "текст письма:<br> сейчас будет слово в  &quot; кавычках &quot; <hr>Ваш скрипт."

Если нужно отправить еще и вложенный файл, то в командной строке последним параметром указать путь к файлу
D:\Projects\SendMailSMTP.vbs "someto@someserver.com" "тема письма" "текст письма" "D:\Projects\Images\exaple.png"

Перед вызовом скрипта в командной строке - тему письма и текст - заранее подготовьте:
В теме письма убрать или заменить на что-то другое все двойные кавычки и переносы строк.
В тексте письма:

  • Все двойные кавычки заменить на &quot; 
  • Все переносы строк заменить на <br>
  • Текст письма отправляется как HTML, соблюдайте соотвествующее форматирование.

На 64-bit операционных системах вызов скрипта делать через SysWOW64
C:\WINDOWS\SysWOW64\wscript.exe D:\Projects\SendMailSMTP.vbs "someto@someserver.com" "тема письма" "текст письма."

Массовая рассылка:
для отправки писем сразу нескольким получателям - перечислите их через запятую:
D:\Projects\SendMailSMTP.vbs "some-to-one@someserver.com,some-to-two@someserver.com,some-to-three@someserver.com" "тема письма" "текст письма"

Перед использованием - отредактируйте в тексте скрипта значения констант:
сервер, порт, логин и пароль SMTP авторизации, укажите адрес отправителя.
Если Ваш сервер не требует SMTP авторизацию, то логин заполните пустой строкой (SMTP_Login="")

Можете, так же указать каталог для ведения логов: LOG_Dir="D:\logs\mail_send\"

' www.striganov.com 21.04.2013 
'-------------------------------------
dim Winsock, fso, oWshNet, cmd_i, bConnected, CMDArry
dim mail_content,  bEndWork, data_str
dim SMTP_Server, SMTP_port, SMTP_Login, SMTP_Password, MAIL_From, LOG_Dir, FILE_name, FILE_body

FILE_name="" ' получим из функции readBinary (путь к файлу указать в командной строке при вызове скрипта)
FILE_body="" ' получим из функции readBinary

' -------------------------------------
' настройка отправки почты
 SMTP_Server="smtp.someserver.com"
 SMTP_port="25"
 SMTP_Login="someuser@someserver.com"
 SMTP_Password="bla-bla-bla"
 MAIL_From="someuser@someserver.com"
 LOG_Dir=""
 ' -------------------------------------
 
' инициализация системных обьектов
Set fso     = CreateObject ("Scripting.FileSystemObject")
Set oWshNet = CreateObject("Wscript.Network")

' разбираем вызов из командной строки: кому, тема, сообщение и вложение ( если оно есть )
Set objArgs= WScript.Arguments 'Создаём объект WshArguments

Select Case objArgs.Count
	Case 0
	MsgBox "Where is mail_to, mail_subject and mail_text ?"
	WScript.quit
	Case 1
	MsgBox "Where is mail_subject and mail_text ?"
	WScript.quit
	Case 2	
	MsgBox "Where is mail_text ?"
	WScript.quit
	Case 3
	VBS_SendMail objArgs(0) ,objArgs(1) ,objArgs(2)
    Case 4
		if (fso.FileExists(objArgs(3)))then
			FILE_body=Base64Encode(readBinary(objArgs(3)))		
		end if
	VBS_SendMail objArgs(0) ,objArgs(1) ,objArgs(2)
End Select 

'------------------------------------------------------------------------------
function VBS_SendMail( m_to, subject, text)
on error resume next


cmd_i=0
bEndWork=false

' создали сокет
Set Winsock=CreateObject("MSWinsock.Winsock")
WScript.ConnectObject Winsock,"Winsock_"

' подготовили последовательность SMTP команд
dim cmd_list
cmd_list= "HELO " & oWshNet.Computername & vbcrlf
if (Len(SMTP_Login)>0)  then							' если указан логин, то используем команды авторизации
	cmd_list=cmd_list&"AUTH LOGIN" & vbcrlf
	cmd_list=cmd_list& Base64Encode(SMTP_Login) & vbcrlf
	cmd_list=cmd_list& Base64Encode(SMTP_Password) & vbcrlf
end if 
cmd_list=cmd_list&"MAIL FROM: <" & MAIL_From & ">" & vbcrlf
cmd_list=cmd_list&"RCPT TO: <" & Replace(m_to,",", ">" & vbcrlf & "RCPT TO: <") & ">" & vbcrlf ' если указано несколько получателей через запятую, то генерим команды отправки каждому получателю
cmd_list=cmd_list&"DATA"&vbcrlf
CMDArry=Split(cmd_list,vbcrlf)

' письмо
mail_content="FROM: =?WINDOWS-1251?B?" & Base64Encode(oWshNet.UserName & "@" & oWshNet.ComputerName) & "?= <" & MAIL_From & ">" & vbcrlf &_
			"TO: <" & Replace(m_to,",",">,<") & ">" & vbcrlf &_
			"SUBJECT: =?WINDOWS-1251?B?" & Base64Encode(subject) & "?=" &  vbcrlf  &_			
			"X-Mailer: http://www.striganov.com/projects/vbscript-hta/31-vbs-socket-smtp-send-mail-from-command-line" & vbcrlf &_
			"MIME-Version: 1.0" & vbcrlf 
			
' обработаем вложеный файл, если он есть
 if (Len (FILE_name)>0 )	 then
  mail_content=mail_content & "Content-Type: multipart/mixed;" &vbcrlf &_
							"	boundary=""----=_NextPart_000_0007_01CBE58D.DEE88180""" & vbcrlf & vbcrlf &_							
							"This is a multi-part message in MIME format." & vbcrlf & vbcrlf &_
							"------=_NextPart_000_0007_01CBE58D.DEE88180" &vbcrlf &_
							"Content-Type: text/html;" & vbcrlf &_
							"	charset=""windows-1251""" & vbcrlf &_
							"Content-Transfer-Encoding: base64" &vbcrlf & vbcrlf &_
							Base64Encode(text) & vbcrlf & vbcrlf &_
							"------=_NextPart_000_0007_01CBE58D.DEE88180" & vbcrlf &_
							"Content-Type: application/octet-stream;" & vbcrlf &_
							"	name=""" & FILE_name & """" & vbcrlf &_
							"Content-Transfer-Encoding: base64" & vbcrlf &_
							"Content-Disposition: attachment;" & vbcrlf &_
							"	filename=""" & FILE_name & """" & vbcrlf & vbcrlf &_
							FILE_body & vbcrlf & vbcrlf &_
							"------=_NextPart_000_0007_01CBE58D.DEE88180--" 
 else
  mail_content=mail_content &	"Content-Type: text/html;" & vbcrlf &_
							"	charset=""windows-1251""" & vbcrlf &_
						    "Content-Transfer-Encoding: base64" & vbcrlf & vbcrlf &_
							Base64Encode(text)
 end if

  mail_content=mail_content & vbcrlf & vbcrlf & "." & vbcrlf
   
' устанавливаем соединение с сервером
Winsock.Connect SMTP_Server,SMTP_port

' ждем пока завершится обработка событий сокета
 Do While Not (bEndWork)
  WScript.Sleep 100  
 Loop

Log("-----------------end--------------------")
end function
'--------------------------------------------------------------------------------
Sub Winsock_Connect
   'Log( "Winsock_Connect")
   bConnected=true
End Sub
'------------------------------
Sub winsock_Error(Number, Description, SCode, Source, HelpFile, HelpContext,CancelDisplay)
	on error resume next
	 
	Log( "Winsock_Error: "&Number&" "&Description)	 
    Winsock.Close   
    bConnected=false 
    Winsock=nothing
	bEndWork=true

End Sub

'------------------------------
Sub Winsock_SendComplete
    'Log( "Winsock_SendComplete")
    bSent=true
End Sub

'------------------------------
Sub Winsock_DataArrival(bytTotal)

   Winsock.GetData data_str,8
   iTotal=bytTotal
   bDataReceived=true 
   Log(">> " & Replace(data_str,vbcrlf," "))   
   DataProcessor    
   CommandProcessor
 
End Sub

'------------------------------
Sub DataProcessor () 
on error resume next

if (data_str<>"DATA")Then
    if (Cint(Left(data_str,3))>354)Then
		Winsock.SendData "quit"&vbCrLf
		Winsock.Close
		bConnected=false
		bEndWork=true
	end if 
end if 		 
		 if (Left(data_str,3)="354")Then			
			Winsock.SendData mail_content 
			Log "<< send_size: " & CStr(Len(mail_content))
			'Log mail_content
		 end if 
		 
		 if (Left(data_str,3)="250" and cmd_i =UBound(CMDArry))Then
			Winsock.SendData "quit"&vbCrLf
			Winsock.Close
			bConnected=false
			bEndWork=true
		 end if 
		
end sub
'------------------------------
Sub CommandProcessor ()
if(bConnected)Then
 if (cmd_i <UBound(CMDArry))Then
         SCommand=CMDArry(cmd_i) &vbCrLf
		 Log "<< " & CMDArry(cmd_i)
         Winsock.SendData SCommand       
         cmd_i=cmd_i+1    
    end if 
 end if   
End Sub
'---------------------------------------
Function ConvertVBSDate2MSSQLDate( VBSDate )
    ConvertVBSDate2MSSQLDate = Mid(VBSDate,  7, 4) & "-" & _
                               Mid(VBSDate,  4, 2) & "-" & _
                               Mid(VBSDate,  1, 2) 
                      
End Function
'---------------------------------------
Sub Log(sData)  ' запись логов в файл
on error resume next 
    Dim ts, ForAppending, LogFileName
    ForAppending = 8
	
	LogFileName=  LOG_Dir & ConvertVBSDate2MSSQLDate(Date) & ".log"	
	Set ts = fso.OpenTextFile(LogFileName, ForAppending, True)    
    ts.Write ConvertVBSDate2MSSQLDate(Date) & " "& Time() & " " & sData & chr(13) & chr(10)
    ts.Close	
End Sub
'---------------------------------------------------------------
Function readBinary(path)
' http://stackoverflow.com/questions/6060529/read-and-write-binary-file-in-vbscript
Dim a
Dim i
Dim ts
dim file 

set file = fso.getFile(path)
If isNull(file) Then
    Log("readBinary::File not found: " & path)
    Exit Function
End If

FILE_name = fso.GetFileName(file)

Set ts = file.OpenAsTextStream()
msgbox file.size
a = makeArray(file.size)
i = 0
' Do not replace the following block by readBinary = by ts.readAll(), it would result in broken output, because that method is not intended for binary data 
While Not ts.atEndOfStream
    a(i) = ts.read(1)
i = i + 1
Wend
ts.close
readBinary = Join(a,"")
End Function
'---------------------------------------------------------------
Function makeArray(n) ' Small utility function
Dim s
s = Space(n)
makeArray = Split(s," ")
End Function
'===============================================================
'===  BASE64 ENCODE
'http://www.motobit.com/tips/detpg_Base64Encode/
'==============================================================
Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, Motobit Software, http://Motobit.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
  
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
    
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
    
    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)
    
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    
    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    
    'Add the part To OutPut string
    sOut = sOut + pOut
    
    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function
'---------------------------------------
Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function





'
Attachments:
FileDescriptionFile sizeLast modified
Download this file (SendMailSMTP.zip)SendMailSMTP.zipThis script can send emails in windows-1251 encoding, HTML-formatted, with attachment.3 kB2013-04-21 22:36

Add comment