إرسال بريد باستخدام دومين خاص بك ..

السلام عليكم و رحمة الله و بركاته

أخوتي في الله ...

عندما كنت أبحث عن smtp الخاص بالهوتميل و جدت موضوعا أتمنى من الجميع المشاركه فيه

الموضوع يتكلم عن إنشاء دومين خاص و إيميل خاص بمزاجك أو باسم شركتك

سأضع الكود و أضع مرفق الموضوع

أتمنى أن نصل إلى حل في هذا الموضوع

أترككم مع الكود

Option Explicit

'Add functions - add one email address.
' adds postoffice, mailbox, login And maps email address
Public Function AddFullEmail(ByRef Email As String, _
ByRef Password As String) As Long

Dim UserName As String, Domain As String
Domain = Split(Email, "@")(1)
UserName = Split(Email, "@")(0)

Dim result As Long
result = createPostOffice(Domain)
If result <> 0 Then result = AddDoaminToPostOffice(Domain)
If result <> 0 Then result = AddMailBoxToPostOffice(Domain, UserName)
If result <> 0 Then result = AddLogin(Domain, UserName, Password)
If result <> 0 Then result = AddEmail(Domain, UserName, Email)
AddFullEmail = result
End Function

Function createPostOffice(ByRef name As String) As Long
Dim lResult As Long
Dim PostOffice As New MEAOPO.PostOffice
'Set PostOffice = createObject("MEAOPO.Postoffice")

With PostOffice
.name = name
.Host = name
.Account = name
.Status = 1
'Try To get existing postoffice
lResult = .GetPostoffice()
If lResult = 0 Then 'create the postoffice
lResult = .AddPostoffice()
Else 'Postoffice already exists.
lResult = -1
End If
End With
createPostOffice = lResult
End Function

'Adds domain To postoffice
Function AddDoaminToPostOffice(ByRef PostOffice As String, _
Optional ByVal DomainName As String = "") As Long
If Len(DomainName) = 0 Then DomainName = PostOffice

Dim lResult As Long
Dim oDomain As New MEAOSM.Domain
'Set oDomain = createObject("MEAOSM.Domain")

With oDomain
.AccountName = PostOffice
.DomainName = DomainName
.Status = 1
'try To get existing domain.
lResult = .GetDomain
If lResult = 0 Then 'create the postoffice
lResult = .AddDomain
Else 'Postoffice already exists.
lResult = -1
End If
End With
AddDoaminToPostOffice = lResult
End Function


'Adds mailbox To postoffice
Function AddMailBoxToPostOffice(ByRef PostOffice As String, _
ByRef UserName As String, _
Optional ByVal Limit As Long = -1) As Long


Dim lResult As Long
Dim oMailbox As New MEAOPO.Mailbox
'Set oMailbox = createObject("MEAOPO.Mailbox")

With oMailbox
.PostOffice = PostOffice
.Mailbox = UserName
.RedirectAddress = ""
.RedirectStatus = 0
.Status = 1

'try To get existing Mailbox.
lResult = .GetMailbox
If lResult = 0 Then 'create the Mailbox
.Limit = Limit
lResult = .AddMailbox()
Else 'Mailbox already exists.
lResult = -1
End If
End With
AddMailBoxToPostOffice = lResult
End Function


'Adds Login To postoffice
Function AddLogin(ByRef PostOffice As String, _
ByRef UserName As String, ByRef Password As String) As Long


Dim lResult As Long
Dim oAUTHLogin As New MEAOAU.Login
'Set oAUTHLogin = createObject("MEAOAU.Login")

'when we create a mailbox we also create a pop logon
With oAUTHLogin
.Account = PostOffice
.UserName = UserName & "@" & PostOffice
.Status = 1
.Description = ""
.Host = ""
.Rights = "USER"

'try To get existing login.
lResult = .GetLogin()
If lResult = 0 Then 'create the login
.Password = Password
lResult = .AddLogin()
Else 'login already exists.
lResult = -1
End If
End With
AddLogin = lResult
End Function

'Adds domain To postoffice
Function AddEmail(ByRef PostOffice As String, _
ByRef UserName As String, ByRef Email As String) As Long

Dim lResult As Long
Dim oAddressMap As New MEAOAM.AddressMap
' Set oAddressMap = createObject("MEAOAM.AddressMap")

With oAddressMap
Dim varTemp

.Account = PostOffice
.DestinationAddress = "[SF:" & PostOffice & "/" & UserName & "]"
.Scope = "[SMTP:" & Email & "]"
.SourceAddress = "[SMTP:" & Email & "]"

'try To get existing email address.
lResult = .GetAddressMap
If lResult = 0 Then 'create a new email address map
lResult = .AddAddressMap()
Else 'email address already exists.
lResult = -1
End If
End With
AddEmail = lResult
End Function




'****************** control functions **********************
'retrieves a password from an email address (username@postoffice)
Public Function GetPassword(ByRef Email As String) As String
Dim oLogin
Set oLogin = GetoLogin("" & Split(Email, "@")(1), _
"" & Split(Email, "@")(0))
GetPassword = oLogin.Password
End Function

'checks If the login/account is created.
Public Function ExistsLogin(ByRef Email As String) As Boolean
ExistsLogin = IsObject(GetoLogin("" & Split(Email, "@")(1), _
"" & Split(Email, "@")(0)))
End Function

'Returns a login object
Function GetoLogin(ByRef PostOffice As String, _
ByRef UserName As String)

Dim lResult As Long
Dim oAUTHLogin As New MEAOAU.Login
'Set oAUTHLogin = createObject("MEAOAU.Login")

With oAUTHLogin
.Account = PostOffice
.UserName = UserName & "@" & PostOffice
.Status = 1
.Description = ""
.Host = ""
.Rights = "USER"

'try To get existing login.
lResult = .GetLogin()
If lResult <> 0 Then 'create the login
Set GetoLogin = oAUTHLogin
End If
End With
End Function

'checks If the email address is mapped To an account.
Public Function ExistsEmail(ByRef Email As String) As Boolean
Dim lResult As Long
Dim oAddressMap As New MEAOAM.AddressMap
' Set oAddressMap = createObject("MEAOAM.AddressMap")

Dim PostOffice As String
PostOffice = Split(Email, "@")(1)
With oAddressMap
Dim varTemp

.Account = PostOffice
.SourceAddress = "[SMTP:" & Email & "]"

'try To get existing address.
lResult = .GetAddressMap
ExistsEmail = lResult <> 0
End With
End Function

أو الاطلاع على الرابط التالي

الرابط

منتظر الردود و الاقتراحات

أخوكم / أبو مروان