Nello
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
set oShell = wscript.CreateObject("Wscript.Shell")
Function main()
dim username, domain
'Ищем логин пользователя:
Set objNetwork = Wscript.CreateObject("Wscript.Network")
samUser = objNetwork.UserName
'Ищем имя прользователя:
Const adStateOpen = 1
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim objConn 'ADO Connection object
Dim objRS 'ADO Recordset object
Set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADSDSOObject"
objConn.Open ""
If not(objConn.State = adStateOpen) Then
WScript.Quit(1)
End If
эЗдесь надо подставить свой путь LDAP
Set objRS = objConn.Execute _
("<LDAP://dc=domain,dc=local>;(&(ObjectClass=User)(ObjectCategory=Person)(samaccountname="&samuser&"));" & "Name,mail;SubTree")
While Not objRS.EOF
DisplayedName=objRS.Fields.Item("name").Value
objRS.MoveNext
Wend
Ualias = inputbox("Введите префикс электронной почты(та часть e-mail, которая до @)","Outlook Express Profile Creator","Ualias")
DisplayedName=inputbox("Введите ваше имя и фамилию","Outlook Express Profile Creator",DisplayedName)
username = inputbox("Введите ваш логин Windows","Outlook Express Profile Creator",samUser)
If username = "" Then
wscript.Quit(0)
End If
If DisplayedName = "" Then
wscript.Quit(0)
End If
If ualias = "" Then
wscript.Quit(0)
End If
If username = "Username" Then
while username = "Enter your Email PREFIX or USERNAME"
username = inputbox("Введите ваш логин Windows","Outlook Express Profile Creator","Username")
If username = "" Then
wscript.Quit(0)
End If
wend
End If
эздесь ставьте ваш почтовый домен
domain = inputbox("Введите Ваш почтовый домен (та часть e-mail, которая после @)","Outlook Express Profile Creator","domain.ru")
If domain = "" Then
wscript.Quit(0)
End If
If domain = "Domain" Then
while domain = "Enter Your Domain name Here"
username = inputbox("Введите Ваш почтовый домен (та часть e-mail, которая после @)","Outlook Express Profile Creator","Domain")
If domain = "" Then
wscript.Quit(0)
End If
wend
End If
objConn.Close
Set objRS = Nothing
call placeMailSettings(username, domain,ualias,DisplayedName)
msgbox("Настройка Outlook Express Configuration окончена, запустите Outlook Express и введите ваш пароль.")
End Function
Function regRead(regStr)
regRead = oShell.RegRead(regStr)
End Function
Function regWrite(val1,val2,val3)
oShell.RegWrite val1,val2,val3
End Function
Function regDelete(regStr)
call oShell.RegDelete(regStr)
End Function
'----------------------------------------------------------------------------------------
' Place new settings for Mail
'----------------------------------------------------------------------------------------
Function placeMailSettings(theUsername, theDomain, theAlias, theDisplayname)
On Error Resume Next
dim newAccountNum, numKeyStr
dim username, domain
newAccountNum = regRead("HKCU\Software\Microsoft\Internet Account Manager\Account Name")
If newAccountNum = "" Then
newAccountNum = "00000001"
ElseIf newAccountNum < 9 Then
newAccountNum = "0000000" & newAccountNum
Else
newAccountNum = "000000" & newAccountNum
End If
numKeyStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\"
call regWrite(numKeyStr, newAccountNum, "REG_SZ")
username = theUsername
domain = theDomain
'Add Account Name
accName = thealias & "@" & domain
accNameStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\Account Name"
call regWrite(accNameStr, accName, "REG_SZ")
'Add Connection Type
conType = "3"
conTypeStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\Connection Type"
call regWrite(conTypeStr, conType, "REG_DWORD")
'Delete Connection Id
conId = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\ConnectionId"
call regDelete(conId)
'Delete Account Id
accId = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\Account ID"
call regDelete(accId)
'Delete IMAP Server
imapSvr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\IMAP Server"
call regDelete(imapSvr)
'Delete HTTP Mail Server
httpSvr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\HTTPMail Server"
call regDelete(httpSvr)
'Set POP3 Server
pop3svr = "rcmail"
pop3svrStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\POP3 Server"
call regWrite(pop3svrStr, pop3svr, "REG_SZ")
'Set POP3 Username
pop3usr = username & "@" & domain
pop3usrStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\POP3 User Name"
call regWrite(pop3usrStr, pop3usr, "REG_SZ")
'Delete POP3 Password 2
popPwdStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\POP3 Password2"
call regDelete(popPwdStr)
'Set POP3 Use Sicily
useSicily = "0"
useSicilyStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\POP3 Use Sicily"
call regWrite(useSicilyStr, useSicily, "REG_DWORD")
'Set POP3 Prompt for Pw
var promptPw = "1"
var promptPwStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\POP3 Prompt for Password"
call regWrite(promptPwStr, promptPw, "REG_DWORD")
'Set SMTP Server
smtpSvr = "rcmail"
smtpSvrStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\SMTP Server"
call regWrite(smtpSvrStr, smtpSvr, "REG_SZ")
'Set SMTP Display name
smtpDisp = ThedisplayName
smtpSvrStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\SMTP Display Name"
call regWrite(smtpSvrStr, smtpDisp, "REG_SZ")
'Set SMTP E-mail address
smtpEmail = thealias & "@" & domain
smtpEmailStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\SMTP Email Address"
call regWrite(smtpEmailStr, smtpEmail, "REG_SZ")
'Set SMTP Use Sicily
smtpUseSicily = "2"
smtpUseSicilyStr = "HKCU\Software\Microsoft\Internet Account Manager\Accounts\" & newAccountNum & "\SMTP Use Sicily"
call regWrite(smtpUseSicilyStr, smtpUseSicily, "REG_DWORD")
'Set New Account to default
defAccStr = "HKCU\Software\Microsoft\Internet Account Manager\Default Mail Account"
call regWrite(defAccStr, newAccountNum, "REG_SZ")
'Increment future account number
futAccNum = newAccountNum + 1
futAccNumStr = "HKCU\Software\Microsoft\Internet Account Manager\Account Name"
call regWrite(futAccNumStr, futAccNum, "REG_DWORD")
msgbox("POP3 Server Set to: " & pop3svr & chr(10) & "SMTP Server Set to: " & smtpSvr)
End Function
call main()
|
