Distribution list annoucement mode for multiple users

This section contains scripts that hMailServer has contributed with. hMailServer 4 is needed to use these.
Post Reply
elkvis
New user
New user
Posts: 5
Joined: 2007-06-07 05:26

Distribution list annoucement mode for multiple users

Post by elkvis » 2007-07-29 10:48

Firstly, a big thanks to Asynchronous; who's code I mercilessly pillaged.

This script allows the users on one distribution list to all be 'announcers' of another. This allows you to have, say, a organisation wide email distribution list that can only be used by a management committee. The management distribution list can be in a deactivated state.

The downside of this script is that there is no automation, there needs to be one restrictaccess() method for each distribution list for which you require this access method. Also, it would be just as easy and more efficient for this to be implemented through a rule. It is hardly going to break the CPU bank though.

The distribution list needs to be in the 'public' or 'membership' mode.

Code: Select all

' Settings
dim adminpassword
adminpassword = "******"

'   Sub OnClientConnect(oClient)
'   End Sub

   Sub OnAcceptMessage(oClient, oMessage)
   call restrictaccess(oMessage)
   
   End Sub

'   Sub OnDeliverMessage(oMessage)
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub

sub restrictaccess(oMessage)
'Set Variables
dim sTo
dim eSender
dim distrubutionlist
dim strDomain
dim managementDist

sTo = oMessage.To
distrubutionlist = "distrubutionlist@domain.com"
strDomain = "domain.com"
managementDist = "management@domain.com"

If InStr(oMessage.HeaderValue("X-Mailer"),"PHP") Then
      eSender      = oMessage.HeaderValue("From")
Else
      eSender      = oMessage.fromaddress
End If

If InStr(sTo,distrubutionlist) Then
       Set oDList       = GetDistributionListObject(strDomain, managementDist)

    IF InDistributionListObject(oDList, eSender) THEN
        Result.Value = 0
    else
        Result.Value = 2
    end if

end if

end sub


FUNCTION InDistributionListObject(oDistributionList, address)
   ' make address lower-case, etc
   '
   address            = CleanAddress(address)
   qtyRecipients      = oDistributionList.Recipients.Count
   Set oRecipients    = oDistributionlist.Recipients
   
   For iRecipient = 0 to qtyRecipients-1
      If (address = CleanAddress(oRecipients(iRecipient).RecipientAddress)) Then
         InDistributionListObject   = 1
         Exit Function
      End If
   Next
   
   InDistributionListObject   = 0
END FUNCTION

'SUB WriteLogList(cString)
'   Dim ToDay
'   Dim mm
'   mm = month(now)
'      If Len(mm) = 1 Then
'      mm = "0" & mm
'      End If
'   ToDay = Right(Date,4) & "-" & mm & "-" & Left(Date,2)
'   
'    SET ofs = CreateObject("scripting.filesystemobject")
'    SET ofil = ofs.OpenTextFile( "C:\Program Files\hMailServer\Logs\hmailserver_" & ToDay & ".log", 8, True)
'    ofil.writeline( Now & " - " & cString)
'    ofil.close
'    SET ofil=nothing
'    SET ofs = nothing
'END SUB

FUNCTION CleanAddress(originaladdress)

   address      = originaladdress
   ' remove any white space
   address         = Trim(address)
   ' make the address lower case
   address         = Lcase(address)

   ' remove a leading angle bracket
   pos      = InStrRev(address, "<")
   If (pos > 0) Then
      address      = Mid(address, pos+1)
   End IF
   ' remove a traiing angle bracket
   pos      = InStrRev(address, ">")
   If (pos > 0) Then
      address      = Mid(address, 1, pos-1)
   End If
   ' remove any white space again
   address         = Trim(address)
   ' return the now-clean address
   CleanAddress   = address
END FUNCTION

FUNCTION GetDistributionListObject(domainName, listName)
   Dim iList
   Dim oDistributionList
   Dim oDomain
   Dim qtyDistLists

   ' get the domain object
   Set oDomain         = GetDomainObjectByName(domainName)
   If (oDomain Is Nothing) Then
      Set GetDistributionListObject      = Nothing
      'WriteLogList "Distribution List Management Process: GetDistributionListObject domain not found"
      Exit Function
   End If
   qtyDistLists        = oDomain.DistributionLists.Count
   For  iList = 0 to qtyDistLists-1
      Set oDistributionlist   = oDomain.DistributionLists(iList)
      If (oDistributionList.Address = listName) Then
         Set GetDistributionListObject   = oDistributionlist
         Exit Function
      End If
   Next
   Set GetDistributionListObject = Nothing
   'WriteLogList "Distribution List Management Process: GetDistributionListObject distribution list not found"
END FUNCTION

FUNCTION GetDomainObjectByName(domain)
   Dim iDomain
   Dim oApp
   Dim oDomain
   Dim oDomains
   Dim qtyDomains
   ' get the application object
   '
   Set oApp = CreateObject("hMailServer.Application")
   Call oApp.Authenticate("Administrator", adminpassword)
   ' get the Domains object
   Set oDomains        = oApp.Domains
   ' get the number of domains
   qtyDomains          = oDomains.Count
   For  iDomain = 0 to qtyDomains-1
      Set oDomain         = oDomains.Item(iDomain)
      If (Lcase(oDomain.Name) = Lcase(domain)) Then
         '
         ' found it!  return the index number
         '
         Set GetDomainObjectByName   = oDomain
         Exit Function
      End If
   Next
   ' failure - domain not found
   '
   Set GetDomainObjectByName      = Nothing
END FUNCTION


'**********************

DJP
Normal user
Normal user
Posts: 52
Joined: 2006-06-28 16:26

Post by DJP » 2007-08-13 12:36

Thx ;-)

Still don't know why it's not a "normal" feature in HMS ... o_0

^DooM^
Site Admin
Posts: 13861
Joined: 2005-07-29 16:18
Location: UK

Post by ^DooM^ » 2007-08-13 13:19

Because hmail is an E-Mail server not a List server or Collaboration server. The fact that you can make hmail become a List server is besides the point.

DJP
Normal user
Normal user
Posts: 52
Joined: 2006-06-28 16:26

Post by DJP » 2007-08-13 18:48

o_0 HMS already make lists... it even support any senders, 1 unique sender, why not a simple adress list as authorised senders ? o_0
In that case, OK, HMS is not a list server so ... remove distribution list ??!!?
I'm not asking to go far like mailman (with email subscription, etc...), but why purposing 1 only email authorised and not many ? o_0 That's the same principle...

That's silly, really...

elkvis
New user
New user
Posts: 5
Joined: 2007-06-07 05:26

Re: Distribution list annoucement mode for multiple users

Post by elkvis » 2009-08-18 14:21

If anyone is interested, this script still works perfectly fine in 5.2; but the following script appears to be far better featured.

http://www.hmailserver.com/forum/viewto ... 20&t=15301

Post Reply