VBS/WSH/JS - VBS

Iska · Отправлено: **16:48, 09-09-2012** | #2

Ragnazar, приводите код, достаточный для воспроизведения ошибки.

Ragnazar · Конфигурация компьютера

Использовалась почта Yandex

Код:

 Option Explicit

Const cdoSendUsingPort = 2
Const cdoBasic         = 1

Const strPartSchema    = "http://schemas.microsoft.com/cdo/configuration/"

Dim strValue
Dim Server
Dim From
Dim strTo
Dim Subject
Dim CDOM

From = InputBox("Ваша почта:", "Mail", "User@site.ru")
Server = Split(From, "@")


Const READYSTATE_COMPLETE = 4

Dim objIE
Dim objWindow

Dim boolDone
Dim strPassword


Set objIE = WScript.CreateObject("InternetExplorer.Application", "IE_")

With objIE
    .Navigate "about:blank"
    
    Do
        WScript.Sleep 100
    Loop Until Not .Busy And .ReadyState = READYSTATE_COMPLETE
    
    .AddressBar = False
    .MenuBar    = False
    .StatusBar  = False
    .ToolBar    = False
    
    With .Document
        .write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Strict//EN"">" & vbCrLf & _
                "<html>" & vbCrLf & _
                "    <head>" & vbCrLf & _
                "        <meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>" & vbCrLf & _
                "        <meta http-equiv='Content-Language' content='ru'>" & vbCrLf & _
                "        <title>SaVlad @-mail v2</title>" & vbCrLf & _
                "        <style>" & vbCrLf & _
                "            body {" & vbCrLf & _
                "                margin: 1em 1em 1em 1em;" & vbCrLf & _
                "                color: MidnightBlue;" & vbCrLf & _
                "                background-color: LightSteelBlue" & vbCrLf & _
                "            }" & vbCrLf & _
                "        </style>" & vbCrLf & _
                "    </head>" & vbCrLf & _
                "    <body>" & vbCrLf & _
                "        <label for='sPassword' accesskey='p'>Enter <u>p</u>assword:</label>" & vbCrLf & _
                "        <input type='password' name='sPassword' id='sPassword' size='50'>" & vbCrLf & _
                "        <input type='button' value='OK' name='OK'>" & vbCrLf & _
                "        <input type='button' value='Отмена' name='Cancel'>" & vbCrLf & _
                "    </body>" & vbCrLf & _
                "</html>"
        
        .getElementsByName("OK").item(0).onclick     = GetRef("IEButtonClick")
        .getElementsByName("Cancel").item(0).onclick = GetRef("IEButtonClick")
        
        With .getElementByID("sPassword")
            .onKeyPress                             = GetRef("IEOnKeyPress")
            .focus
        End With
        
        Set objWindow = .parentWindow
        
        With .Body
            objWindow.resizeTo .scrollWidth + 25, .scrollHeight + 32
            objWindow.moveTo (objWindow.screen.availWidth - .offsetWidth) \ 2, (objWindow.screen.availHeight - .offsetHeight) \ 2
        End With
        
        Set objWindow = Nothing
        
        '.getElementByID("sPassword").focus
    End With
    
    .Visible = True
    
    boolDone = False
    strPassword = Empty
    
    Do
        WScript.Sleep 100
    Loop Until boolDone
    
    On Error Resume Next
    .Quit
    On Error Goto 0
End With

Set objIE = Nothing


If Not IsEmpty(strPassword) Then
strTo = InputBox("Почта получателя:", "Mail", "User@site.ru")
Subject = InputBox("Тема сообщения", "Mail", "Тема")
Set CDOM = WScript.CreateObject("CDO.Message")
CDOM.Configuration.Fields.Item(strPartSchema & "sendusing")        = cdoSendUsingPort
CDOM.Configuration.Fields.Item(strPartSchema & "smtpauthenticate") = cdoBasic
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserver")       = "smtp." & Server(1)
CDOM.Configuration.Fields.Item(strPartSchema & "smtpserverport")   = 25
CDOM.Configuration.Fields.Item(strPartSchema & "sendusername")     = From
CDOM.Configuration.Fields.Item(strPartSchema & "sendpassword")     = strPassword
CDOM.Configuration.Fields.Update
    
CDOM.To          = strTo
CDOM.From        = From
CDOM.Subject     = Subject
    
    Do
        strValue = InputBox("Текст сообщения:", "Отправка почтового сообщения", "(пустая строка завершает ввод текста)")
        
        If Len(strValue) = 0 Then
            If MsgBox("Отправить?",1+32,"Mail") = vbOk then
            CDOM.Send
            MsgBox "Отправлено!",64,"Mail"
            Else
            MsgBox "Отменено!",48,"Mail"
            WScript.Quit 0
            End if
            Exit Do
        Else
            CDOM.TextBody = CDOM.TextBody & vbCrLf & strValue
        End If
    Loop

Else
    WScript.Echo "Password is not entered"
    WScript.Quit
End If

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub IE_OnQuit
    boolDone = True
End Sub
'=============================================================================

'=============================================================================
Sub IEButtonClick
    Select Case Me.Name
        Case "OK"
            strPassword = objIE.Document.getElementByID("sPassword").Value
            boolDone = True
        Case "Cancel"
            boolDone = True
        Case Else
            ' Nothing to do
    End Select
End Sub
'=============================================================================

'=============================================================================
Sub IEOnKeyPress
    Select Case Me.ownerDocument.parentWindow.event.keyCode
        Case 13
            strPassword = Me.Value
            boolDone = True
        Case 27
            boolDone = True
        Case Else
            ' Nothing to do
    End Select
End Sub
'=============================================================================

Iska · Отправлено: **01:47, 11-09-2012** | #4

Ragnazar, воспользовавшись выложенным Вами кодом я отправил сообщение с одного адреса и получил на другой. Без ошибки.

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