'*******************************************************************************
'*      MAPImail script for Microsoft Visual Basic Scripting Host Engine       *
'*      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~       *
'*                 Copyright (C) by 1999-2000 Maxim Malencoff                  *
'*                    E-Mail: Support@SilmarilSoftware.Com                     *
'*                  http://www.SilmarilSoftware.com/mapimail                   *
'*                                                                             *
'* Use "CScript MAPIMail.vbs" command line for help ...                        *
'*******************************************************************************
Option Explicit 
On Error Resume Next
'*******************************************************************************
' 0 - English
' 1 - Russian
'*******************************************************************************
Const ProgLang = 0
'*******************************************************************************
Const ProgName    = "MAPImail for MS-VBS"
Const ProgVer     = "v.1.6.5"
Const ProgHomeURL = "[http://www.SilmarilSoftware.com/mapimail]"
'*******************************************************************************
Const LOW    = 0
Const NORMAL = 1
Const URGENT = 2
Const C_NORMAL = 0
Const C_UPPER  = 1
Const C_LOWER  = 2
'*******************************************************************************
Dim bEnableImport, bEnableExport, bCheckNewMail, bExportAll, bOneMsgExp, iRetVal
Dim bDisableAttach
'*******************************************************************************
bEnableImport  = False
bEnableExport  = False
bCheckNewMail  = False
bExportAll     = False
bOneMsgExp     = False
bDisableAttach = False
iRetVal        = 0
'*******************************************************************************
Dim S_strTo, S_strSubj, S_strBody, S_strFileBody, S_bDOSFileBody, S_iImp 
Dim S_strFile, S_strProfileName, S_strProfilePassword, S_strProfileInfo
Dim S_strCC, S_strBCC
'*******************************************************************************
S_strTo                = Null
S_strCC                = Null
S_strBCC               = Null
S_strSubj              = Null
S_strBody              = Null
S_strFileBody          = Null
S_bDOSFileBody         = False
S_iImp                 = 1
S_strFile              = Null
S_strProfileName       = Null
S_strProfilePassword   = Null
S_strProfileInfo       = Null
'*******************************************************************************
Dim R_strClientPrefix, R_strDestPath, R_bKillWrongMail, R_bShowBody 
Dim R_strProfileName, R_strProfilePassword, R_strProfileInfo, R_bEraseMsgID
Dim R_strMsgID, R_bProcessUnreadOnly
'*******************************************************************************
R_strClientPrefix      = Null
R_strDestPath          = Null
R_bKillWrongMail       = False
R_bShowBody            = False
R_strProfileName       = Null
R_strProfilePassword   = Null
R_strProfileInfo       = Null
R_bEraseMsgID	       = False
R_strMsgID	       = Null
R_bProcessUnreadOnly   = False
'*******************************************************************************
Dim xCase, TearLine
'*******************************************************************************
xCase                  = C_NORMAL
TearLine               = True

InitKeys

If bEnableImport = True Then
	Send S_strTo, S_strCC, S_strBCC, S_strSubj, S_strBody, S_strFileBody, S_bDOSFileBody, S_iImp, S_strFile, S_strProfileName, S_strProfilePassword, S_strProfileInfo
End If
If bEnableExport = True Then
	Receive R_strClientPrefix, R_strDestPath, R_bKillWrongMail, R_bShowBody, R_strProfileName, R_strProfilePassword, R_strProfileInfo
End If

If Err <> 0 Then
	WScript.Echo ProgName & " " & ProgVer & " Error: " & Err.Description
	iRetVal = -1
End If

WScript.Quit(iRetVal)

'*******************************************************************************
'* Send                                                                        *
'*******************************************************************************
Sub Send(strTo, strCC, strBCC, strSubj, strBody, strFileBody, bDOSFileBody, iImp, strFile, strProfileName, strProfilePassword, strProfileInfo)
	Dim VBSEncoding, VBSDir, objSession, objMessage, objOneRecip
	Dim objFileSystem, objAttach
	Dim strBodyWIN, strSubjWIN, strAbsFilePath, strFileName, arrayFileList
	Dim TMPNum, TMPStr, strOneTo

	WScript.Echo "# Send mode"

	If IsNull(strSubj) Then strSubj = "" End If
	If IsNull(strBody) Then strBody = "" End If

	If iImp < 0 Then iImp = 0 End If
	If iImp > 2 Then iImp = 2 End If

	If Not IsNull(strTo) Then 
		WScript.Echo "$ To: " & strTo
	End If
	If Not IsNull(strCC) Then 
		WScript.Echo "$ CC: " & strCC 
	End If
	If Not IsNull(strBCC) Then 
		WScript.Echo "$ BCC: " & strBCC 
	End If
	WScript.Echo "$ Subject: " & strSubj

	If iImp = 0 Then
		WScript.Echo "$ Mail urgency: " & "Low"
	ElseIf iImp = 1 Then
		WScript.Echo "$ Mail urgency: " & "Normal"
	ElseIf iImp = 2 Then
		WScript.Echo "$ Mail urgency: " & "Urgent"
	End if

	Set objSession = WScript.CreateObject("MAPI.Session")
	objSession.Logon strProfileName,strProfilePassword,False,,,,strProfileInfo 
	Set objMessage = objSession.Outbox.Messages.Add

	If Not IsNull(strTo) Then 
		TMPStr = strTo
		Do
			TMPNum = InStr(TMPStr, ";")
			If TMPNum > 0 Then
				strOneTo = Mid(TMPStr, 1, TMPNum - 1)
				TMPStr = Mid(TMPStr, TMPNum + 1, Len(TMPStr) - TMPNum)
			Else
				strOneTo = TMPStr
			End If
			Set objOneRecip = objMessage.Recipients.Add 
			objOneRecip.Name = strOneTo
			objOneRecip.Type = 1 'TO:
			objOneRecip.Resolve False
			WScript.DisconnectObject objOneRecip
			Set objOneRecip = Nothing
	      	Loop Until TMPNum = 0
	End If

	If Not IsNull(strCC) Then 
		TMPStr = strCC
		Do
			TMPNum = InStr(TMPStr, ";")
			If TMPNum > 0 Then
				strOneTo = Mid(TMPStr, 1, TMPNum - 1)
				TMPStr = Mid(TMPStr, TMPNum + 1, Len(TMPStr) - TMPNum)
			Else
				strOneTo = TMPStr
			End If
			Set objOneRecip = objMessage.Recipients.Add 
			objOneRecip.Name = strOneTo
			objOneRecip.Type = 2 'CC:
			objOneRecip.Resolve False
			WScript.DisconnectObject objOneRecip
			Set objOneRecip = Nothing
	      	Loop Until TMPNum = 0
	End If

	If Not IsNull(strBCC) Then 
		TMPStr = strBCC
		Do
			TMPNum = InStr(TMPStr, ";")
			If TMPNum > 0 Then
				strOneTo = Mid(TMPStr, 1, TMPNum - 1)
				TMPStr = Mid(TMPStr, TMPNum + 1, Len(TMPStr) - TMPNum)
			Else
				strOneTo = TMPStr
			End If
			Set objOneRecip = objMessage.Recipients.Add 
			objOneRecip.Name = strOneTo
			objOneRecip.Type = 3 'BCC:
			objOneRecip.Resolve False
			WScript.DisconnectObject objOneRecip
			Set objOneRecip = Nothing
	      	Loop Until TMPNum = 0
	End If

	Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
	If bDisableAttach = False Then
		strAbsFilePath = objFileSystem.GetParentFolderName(objFileSystem.GetAbsolutePathName(strFile))
		arrayFileList = DirList(strFile)
	        For Each strFileName In arrayFileList
        		Set objAttach = objMessage.Attachments.Add
	        	objAttach.Type = 1
        		objAttach.Position = 0
        		objAttach.Name = strFileName
        		objAttach.Source = strAbsFilePath & "\" & strFileName
	        	objAttach.ReadFromFile strAbsFilePath & "\" & strFileName
        		objMessage.Update
			WScript.DisconnectObject objAttach
			Set objAttach = Nothing
			WScript.Echo "+ file:	""" & strAbsFilePath & "\" & strFileName & """"
	        Next 
        End If

	objMessage.Subject = strSubj
	objMessage.Text = objMessage.Text & strBody
	If Len(strFileBody) > 0 Then
		If bDOSFileBody = False Then
			objMessage.Text = objMessage.Text & Chr(10) & FileToString(strFileBody)
		Else
			objMessage.Text = objMessage.Text & Chr(10) & Rus_OEMConvertString(FileToString(strFileBody))
		End If
	End If 
	
	If TearLine = True Then
		objMessage.Text = objMessage.Text & Chr(10) & "---" & Chr(10) & ProgName & " " & ProgVer & " " & ProgHomeURL
	End If

	If xCase = C_UPPER Then
		objMessage.Text = UCase(objMessage.Text)
	ElseIf xCase = C_LOWER Then
		objMessage.Text = LCase(objMessage.Text)
	End If

	objMessage.Importance = iImp
        objMessage.Update

	objMessage.Send False
	objSession.Logoff

	WScript.DisconnectObject objFileSystem
	Set objFileSystem = Nothing
	WScript.DisconnectObject objMessage
	Set objMessage = Nothing
	WScript.DisconnectObject objSession
	Set objSession = Nothing
End Sub

'*******************************************************************************
'* Receive                                                                     *
'*******************************************************************************
Sub Receive(strClientPrefix, strDestPath, bKillWrongMail, bShowBody, strProfileName, strProfilePassword, strProfileInfo)
	Dim objSession, objInboxFolder, objInMessagesCollection
	Dim objOneMsg, objAttachColl, objAttach
	Dim iInc, iExpNum, MsgID

	If R_bEraseMsgID = False Then 
		WScript.Echo "# Receive mode"
	Else
		WScript.Echo "# Erase mode"
	End If

	iExpNum = 0

	Set objSession = WScript.CreateObject("MAPI.Session")
	objSession.Logon strProfileName,strProfilePassword,False,,,,strProfileInfo 
	Set objInboxFolder = objSession.Inbox
        Set objInMessagesCollection = objInboxFolder.Messages
	objInMessagesCollection.Sort 1 ' ‘®авЁа®ўЄ  Ї® ¤ вҐ Ї®«г祭Ёп
	Set objOneMsg = objInMessagesCollection.GetFirst

	If Not objOneMsg Is Nothing Then
		Do
			If R_bProcessUnreadOnly = False Or (R_bProcessUnreadOnly = True And objOneMsg.Unread = True) then
				If R_bEraseMsgID = True Then
					If objSession.CompareIDs(objOneMsg.ID,GetShellVar(R_strMsgID)) = True Then 
						objOneMsg.Delete
						WScript.Echo "+ MsgID: """ & R_strMsgID & """ ... deleted."
					End If
				ElseIf StrCompN(UCase(objOneMsg.Subject), UCase(strClientPrefix), 0, InStr(strClientPrefix, " ") - 1) <> 0 And bKillWrongMail = True Then	
					WScript.Echo "- Wrong mail prefix: " & objOneMsg.Subject
					WScript.Echo "- Message From: " & objOneMsg.Sender.Name & " <" & objOneMsg.Sender.Address & ">"
					WScript.Echo "- Incorrect message was deleted ..."			
			                objOneMsg.Delete
				ElseIf StrCompN(UCase(objOneMsg.Subject), UCase(strClientPrefix), 0, InStr(strClientPrefix, " ") - 1) = 0 Then
					WScript.Echo "$ Message From: " & objOneMsg.Sender.Name & " <" & objOneMsg.Sender.Address & ">"				
					If bShowBody = True Then
						WScript.Echo "$ Message Body: " & objOneMsg.Text 				
					End If
					If bCheckNewMail = False And R_bEraseMsgID = False Then
						If Not IsNull (R_strMsgID) Then
							WScript.Echo "+ MsgID: """ & R_strMsgID & """"
							SetShellVar R_strMsgID, objOneMsg.ID 
						End If
				                Set objAttachColl = objOneMsg.Attachments
        	        			For iInc = 1 To objAttachColl.Count
					               	Set objAttach = objAttachColl.Item(iInc)
                					objAttach.WriteToFile strDestPath & "\" & objAttach.Name
							WScript.Echo "+ file:	""" & strDestPath & "\" & objAttach.Name & """"
							WScript.DisconnectObject objAttach
							Set objAttach = Nothing
		        	        	Next
						WScript.DisconnectObject objAttachColl
						Set objAttachColl = Nothing
						If IsNull (R_strMsgID) Then
		                			objOneMsg.Delete
						End If
					Else
						iRetVal = 1
					End if
					iExpNum = iExpNum + 1
				Else
					WScript.Echo "! Wrong mail prefix: " & objOneMsg.Subject
					WScript.Echo "! Message From: " & objOneMsg.Sender.Name & " <" & objOneMsg.Sender.Address & ">"
					WScript.Echo "! This messge still stored in your mailbox! Please delete it manually ..."			
				End If
			End If
			If bOneMsgExp = True And iExpNum >= 1 Then
				Exit Do
			End If
			Set objOneMsg = objInMessagesCollection.GetNext
		Loop Until objOneMsg Is Nothing
        End If

	WScript.DisconnectObject objInMessagesCollection
	Set objInMessagesCollection = Nothing
	WScript.DisconnectObject objInboxFolder
	Set objInboxFolder = Nothing
	WScript.DisconnectObject objSession
	Set objSession = Nothing
End Sub

'*******************************************************************************
'* FileToString                                                                *
'*******************************************************************************
Function FileToString(FileName)
	Dim objFileSystem, objTextFile

	Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFileSystem.OpenTextFile(FileName)
	
	Do While objTextFile.AtEndOfStream <> True
		FileToString = FileToString & objTextFile.ReadLine & Chr(10)
	Loop 

	WScript.DisconnectObject objFileSystem
	Set objFileSystem = Nothing
End Function

'*******************************************************************************
'* StrCompN                                                                    *
'*******************************************************************************
Function StrCompN(Str1, Str2, Compare, Number)
    Dim CuteStr1, CuteStr2 

    If Number > 0 Then
        CuteStr1 = Mid(Str1, 1, Number)
        CuteStr2 = Mid(Str2, 1, Number)
    Else
        CuteStr1 = Mid(Str1, 1, Len(Str2))
        CuteStr2 = Str2
    End If

    StrCompN = StrComp(CuteStr1, CuteStr2, Compare)
End Function

'*******************************************************************************
'* IniҐKeys                                                                    *
'*******************************************************************************
Sub InitKeys()
	Dim objArguments
	Dim iArgNum, strProfileInfo_Server, strProfileInfo_Nick

	Set objArguments = WScript.Arguments
	If objArguments.Count = 0 Then
		Help
	Else
		iArgNum = 0
		While iArgNum < objArguments.Count
			Select Case LCase(Mid(objArguments(iArgNum),1,2))
				Case "-e":
					bEnableExport = True
					bEnableImport = False
				Case "-i":
					bEnableImport = True
					bEnableExport = False
				Case "-#":
					bCheckNewMail = True
					bEnableExport = True
					bEnableImport = False
				Case "-1"
					bOneMsgExp    = True
				Case "--":
					R_bEraseMsgID = True
					bEnableExport = True
					bEnableImport = False
				Case "-v":
					R_strMsgID = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-n":
					S_strProfileName = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
					R_strProfileName = S_strProfileName
				Case "-p":
					S_strProfilePassword = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
					R_strProfilePassword = S_strProfilePassword
				Case "-l":
					strProfileInfo_Nick = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-m":
					strProfileInfo_Server = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-f":
					S_strFile = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-d":
					R_strDestPath = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-a":
					S_strTo = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-r":
					S_strCC = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-h":
					S_strBCC = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-s":
					S_strSubj = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
					R_strClientPrefix = S_strSubj
				Case "-b":
					S_strBody = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-o":
					bExportAll = True
					R_strClientPrefix = ""
				Case "-@":
					bDisableAttach = True
				Case "-k":
					R_bKillWrongMail = True
				Case "-t":
					S_strFileBody = Mid(objArguments(iArgNum),3,Len(objArguments(iArgNum)))
				Case "-x":
					S_bDOSFileBody = True
				Case "-u":
					If Mid(objArguments(iArgNum),3,1) = "+" then
						S_iImp = URGENT
					ElseIf Mid(objArguments(iArgNum),3,1) = "-" then
						S_iImp = LOW
					Else
						S_iImp = NORMAL
					End if
				Case "-c":
					If UCase(Mid(objArguments(iArgNum),3,1)) = "U" then
						xCase = C_UPPER
					ElseIf UCase(Mid(objArguments(iArgNum),3,1)) = "L" then
						xCase = C_LOWER
					Else
						xCase = C_NORMAL
					End if
				Case "-z":
					R_bProcessUnreadOnly = True
				Case "-!":
					TearLine = False
				Case "-h","-?":
					Help
			End Select
			iArgNum = iArgNum + 1
		Wend
		If Len(strProfileInfo_Server) > 0 And Len(strProfileInfo_Nick) > 0 then
			S_strProfileInfo = strProfileInfo_Server & Chr(10) & strProfileInfo_Nick
			R_strProfileInfo = S_strProfileInfo
        	End If
	End If
	
	' FoolProf section
	' ToDo: Сделать английскую версию :-)
	If bEnableExport = False And bEnableImport = False And R_bEraseMsgID = False Then
		If ProgLang = 0 Then
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-i"", ""-e"" or ""--"" keys."
		Else
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-i"", ""-e"" или ""--"" является обязательным."
		End if
		WScript.Quit(-1)
	End if

	If R_bEraseMsgID = True And IsNull(R_strMsgID) Then
		If ProgLang = 0 Then
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-v*"" key."
		Else
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-v*""являетя обязательным."
		End If
		WScript.Quit(-1)
	End If

	If R_bEraseMsgID = False And Not IsNull(R_strMsgID) And bOneMsgExp = False Then
		If ProgLang = 0 Then
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! ""-v*"" option requires ""-1"" key."
		Else
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-v*"" требует ключа ""-1""."
		End If
		WScript.Quit(-1)
	End if

	If IsNull(S_strProfileInfo) And IsNull(S_strProfileName) Then
		If ProgLang = 0 Then
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-l*"", ""-m*"" and/or ""-n*"" keys!"
		Else
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметры ""-l*"", ""-m*"" и/или ""-n*"" являются обязятельными!"
		End If
		WScript.Quit(-1)
	End if

	If (Len(strProfileInfo_Server) > 0 And Len(strProfileInfo_Nick) = 0) OR Len(strProfileInfo_Server) = 0 And Len(strProfileInfo_Nick) > 0 Then
		If ProgLang = 0 Then
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! ""-l*"" option requires ""-m*"" key."
		Else
			WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметры ""-l*"" и ""-m*"" являются зависимыми. " & Chr(10) & "Если Вы указали один из них то необходимо так же указать и другой!"
		End if
		WScript.Quit(-1)
	End If

	If R_bEraseMsgID = True Or bEnableExport = True Then
		If R_bEraseMsgID = False And IsNull(R_strDestPath) And bCheckNewMail = False Then
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-d*"" key!"
			Else
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-d*"" является обязательным!"
			End If
			WScript.Quit(-1)
		End if
		If R_bEraseMsgID = False And Not IsNull(R_strClientPrefix) And Len(R_strClientPrefix) = 0 And bExportAll = False Then 
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! ""-s*"" key value can't be void!"
			Else
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Значение параметра ""-s*"" не может быть пустым!"
			End If
			WScript.Quit(-1)
		End if
		If R_bEraseMsgID = False And IsNull(R_strClientPrefix) And bExportAll = False Then 
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-s*"" or ""-o"" keys!"
			Else 
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметры ""-s*"" или ""-o"" являются обязятельными!"
			End If
			WScript.Quit(-1)
		End if
	ElseIf R_bEraseMsgID = False And bEnableImport = True Then
		If IsNull(S_strFile) And bDisableAttach = False Then
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-f*"" key!"
			Else
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-f*"" является обязательным!"
			End If
			WScript.Quit(-1)
		End if
		If IsNull(S_strTo) And IsNull(S_strCC) And IsNull(S_strBCC) Then
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing  ""-a*"" or ""-r*"" or ""-h*"" keys!"
			Else
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Один из параметров ""-a*"" или ""-r*"" или ""-h*"" является обязательным!"
			End If
			WScript.Quit(-1)
		End if
		If IsNull(S_strSubj) Then
			If ProgLang = 0 Then
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ERROR! Missing ""-s*"" key!"
			Else
				WScript.Echo ProgName & " " & ProgVer & Chr(10) & "ОШИБКА! Параметр ""-s*"" является обязательным!"
			End If
			WScript.Quit(-1)
		End if
	End If

	WScript.DisconnectObject objArguments
	Set objArguments = Nothing
End Sub

'*******************************************************************************
'* DirList (by Viacheslav Pechenin)                                            *
'*******************************************************************************
Function DirList(strSrcMask)
	Dim fso, dp, nx, i, File, Files
	
	DirList=Array()
	Set fso=CreateObject("Scripting.FileSystemObject")
	dp=fso.GetParentFolderName(strSrcMask)
	If dp="" Then 
		dp="." 
	End If
	nx=fso.GetFileName(strSrcMask)
    	Set Files=fso.GetFolder(dp).Files

	If Err<>0 Then Exit Function
    	i=0

	Dim A()
	For Each File In Files
		If Match(UCase(nx), UCase(fso.GetFileName(file))) Then
			Redim Preserve A(i)
			A(i)=fso.GetFileName(file)
			i=i+1
		End If
	Next
	DirList=A
End Function

'*******************************************************************************
'* Match (by Viacheslav Pechenin)                                              *
'*******************************************************************************
Function Match(m,o)
	Dim p, i

       	If InStr(o,".") = 0 Then o = o & "."
	If InStr(m,".") = 0 Then m = m & "."

	match=0
	p=instr(m,"*")
    	if p=0 then
    		if len(m)<>len(o) then exit function
	        for i=1 to len(m)
        		if mid(m,i,1)<>"?" then 
        			if mid(m,i,1)<>mid(o,i,1) then exit function
			end if
        	next
	        match=1
        	exit function
	else
	    	for i=0 to len(o)-len(m)+2
    			if match(Left(m,p-1) & String(i,"?") & Right(m,len(m)-p),o) then
        	    		match=1
	        	        exit function
			end if
	        next
	end if
end function

'*******************************************************************************
'* GetShellVar                                                                 *
'*******************************************************************************
Function GetShellVar(strVarName)
	Dim objShell, objEnviroment

	Set objShell = WScript.CreateObject("WScript.Shell") 
	Set objEnviroment = objShell.Environment("USER")
	GetShellVar = objEnviroment(strVarName)
	Set objEnviroment = Nothing
	Set objShell = Nothing
End Function

'*******************************************************************************
'* SetShellVar                                                                 *
'*******************************************************************************
Sub SetShellVar(strVarName, Value)
	Dim objShell, objEnviroment

	Set objShell = WScript.CreateObject("WScript.Shell") 
	Set objEnviroment = objShell.Environment("USER")
	objEnviroment(strVarName) = Value
	Set objEnviroment = Nothing
	Set objShell = Nothing
End Sub

'*******************************************************************************
'* Rus_OEMConvertChar                                                          *
'*******************************************************************************
Function Rus_OEMConvertChar(cChar)
	If Asc(cChar) >= 128 And Asc(cChar) <= 175 Then
		Rus_OEMConvertChar = Chr(192 + (Asc(cChar)-128))
	ElseIf Asc(cChar) >= 224 And Asc(cChar) <= 239 Then
		Rus_OEMConvertChar = Chr(240 + (Asc(cChar)-224))
	Else
		Rus_OEMConvertChar = cChar
	End If
End Function

'*******************************************************************************
'* Rus_OEMConvertString                                                        *
'*******************************************************************************
Function Rus_OEMConvertString(strString)
	Dim iInc, strNewStr

	For iInc = 1 To Len(strString) 
		strNewStr = strNewStr + Rus_OEMConvertChar(Mid(strString, iInc,1))
	Next 

	Rus_OEMConvertString = strNewStr
End Function

'*******************************************************************************
'* Help                                                                        *
'*******************************************************************************
Sub Help()
    WScript.Echo ProgName & " " & ProgVer & " " & ProgHomeURL
    Select Case ProgLang
	Case 0
	    WScript.Echo  "Work modes:                             Profile control:               "        
	    WScript.Echo  " -e Export messages from mail box       -n* Profile name               "        
    	    WScript.Echo  " -i Import messages to mail box         -p* Password (optional)        "        
	    WScript.Echo  " -- Erase message by MsgID              -v* MsgID variable             "        
	    WScript.Echo  " -# Check your mail box (return         Server control:                "       
	    WScript.Echo  "    ERRORLEVEL=1 if mail exist)         -l* User name                  "        
	    WScript.Echo  " -1 Export only one message at run      -m* Exchange server name       "        
	    WScript.Echo  "File attachments control:                                              "        
	    WScript.Echo  " -f* File name (or file mask) for import                               "        
	    WScript.Echo  " -d* Target directory for export        -k  Kill all messages with     "        
	    WScript.Echo  " -a* E-Mail (To:)                           wrong prefix               "        
	    WScript.Echo  " -r* Carbon Copy (CC:)                  -h* Blind Carbon Copy (BCC:)   "
	    WScript.Echo  " -s* Subject (Subject:)                 -t* Mail body as a text file   "        
	    WScript.Echo  " -b* Mail body as a text string         -@  Ignore -f* key             "
	    WScript.Echo  " -o  Export all messages independently from prefix                     "        
	    WScript.Echo  " -z  Process unread messages only       -cu Convert all characters of  "        
	    WScript.Echo  "Importance control:                         mail-text to upper case    "        
	    WScript.Echo  " -u+ High (Urgent)                      -cl Convert all characters fo  "      
	    WScript.Echo  " -u- Low                                    mail-text to lower case    "      
	    WScript.Echo  " -u  Normal (optional)                  -!  Disable ""tearline""       "      
	    WScript.Echo  "Help control:                           -?  This help                  "      
	Case 1
	    WScript.Echo  "Режим работы:                           Управление профилем:           "        
	    WScript.Echo  " -e Режим экспорта сообщений из ПО      -n* Имя профиля                "        
    	    WScript.Echo  " -i Режим импорта сообщений в ПО        -p* Пароль (не обязательно)    "        
	    WScript.Echo  " --  Удалить сообщение по MsgID         -v* Имя переменной для MsgID   "        
	    WScript.Echo  " -# Проверить наличие новых писем      Подключение к серверу:          "       
	    WScript.Echo  "    в ПО (возвращает ERRORLEVEL=1)      -l* Системное имя пользователя "        
	    WScript.Echo  " -1 Экспорт только одного письма        -m* Имя почтового сервера      "        
	    WScript.Echo  "Файловые вложения:                      -z  Только не прочтенные письма"        
	    WScript.Echo  " -f* Имя файла (или файловая маска) для импорта                        "        
	    WScript.Echo  " -d* Каталог для экспорта файлов        -k  Удалять письма с не верным "        
	    WScript.Echo  " -a* Адрес e-mail (To:)                     префиксом                  "        
	    WScript.Echo  " -r* Копия (CC:)                        -h* Скрытая копия (BCC:)       "
	    WScript.Echo  " -s* Предмет письма (Subject:)          -t* Текст письма в виде файла  "        
	    WScript.Echo  " -b* Текст письма                       -x  Котвертировать файл текста "
	    WScript.Echo  " -o  Экспорт всех писем с любым префиксом   письма из CP866 в CP1251   "        
	    WScript.Echo  " -@  Игнорировать ключ -f*              -cu Конвертировать все символы "        
	    WScript.Echo  "Установка срочности письма:                 письма в верний регистр    "        
	    WScript.Echo  " -u+ Срочное письмо                     -cl Конвертировать все символы "      
	    WScript.Echo  " -u- Низкий приоритет письма                письма в нижний регистр    "      
	    WScript.Echo  " -u  Нормальный приоритет письма        -!  Отключить ""tearline""     "      
	    WScript.Echo  "Получение справки о работе программы:   -?  Этот текст справки         "      
    End Select
    WScript.Quit(-1)
End Sub