For info on using the BUILT-IN archiving feature in 5.4 read this:
http://www.hmailserver.com/forum/viewto ... 02#p123402
A few people have asked for the script version of hmailserver 5.4's "Archiving" feature that makes copies of all mail in/out & stores in a useful directory structure similar to hmail's Data tree. This script was the inspiration for hmail 5.4's Archiving. The original was made by rolaids0 & is posted here with permission
(This is an update of the original version which was later tweaked/enhanced & if I recall there were minor issues but it has been 2 years so I don't recall off hand ATM. I'll work on posting a copy of the newest one but this is what is available for now. )
EDIT: I recall now. One issue with the original was if there was more than 1 recipient but this one is a newer one which looped thru recipients so each got a copy. Understand with this script that means a LOT of hard drive & cpu use with many recipients especially for bigger emails. 5.4's built-in archiving has hard-link support so actual copies are not needed & saves considerably on space & cpu usage.
Code: Select all
' Original by rolaids0 - Update: 5/13/2010 ' Set StrSave path to where you want Archive tree. ' Edit "Administrator","**PASSWORD**" below with your hmail admin user/pass Dim StrSave: StrSave = "C:\Archive" Dim DebugLog: DebugLog = False 'provides some archival facilites. Sub OnAcceptMessage(oClient, oMessage) Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") Dim HMA: Set HMA = CreateObject("hMailServer.Application") 'auth the connection Call HMA.Authenticate("Administrator","**PASSWORD**") HMA.Connect 'get the domains Dim oDomains: Set oDomains = HMA.Domains 'open the log If DebugLog = True Then Dim FSOStream: Set FSOStream = FSO.OpenTextFile(StrSave & "\" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & ".log",8,True) If DebugLog = True Then FSOStream.WriteLine Now & " Count: " & oMessage.Recipients.Count FSOStream.WriteLine Now & " Processing: " & oMessage.FileName End If Dim I, J J = False For I = 0 to oMessage.Recipients.Count - 1 'test to see if the user is local or not If oMessage.Recipients(I).IsLocalUser = True Then If DebugLog = True Then FSOStream.WriteLine Now & " For Local User:" & oMessage.Recipients(I).Address Call FSO.CopyFile(oMessage.FileName,GenerateFolderTree(oMessage.Recipients(I).Address,FSO) & FSO.GetFileName(oMessage.FileName)) If oMessage.Recipients(I).Address = oMessage.FromAddress Then J = True Else If J = False Then If DebugLog = True Then FSOStream.WriteLine Now & " From Local User:" & oMessage.FromAddress Call FSO.CopyFile(oMessage.FileName,GenerateFolderTree(oMessage.FromAddress,FSO) & FSO.GetFileName(oMessage.FileName)) J = True End If End If Next If DebugLog = True Then FSOStream.WriteLine Now & " Done!" 'close the log FSOStream.Close End If 'set the result=0, deliver Result.Value=0 'clean up Set FSO = Nothing Set FSOStream = Nothing Set HMA = Nothing Set oDomains = Nothing End Sub 'this function will create a tree based upon the email address given Private Function GenerateFolderTree(ByRef StrEmail, ByRef oFSO) Dim UserName: UserName = Mid(StrEmail,1,InStr(StrEmail,"@") - 1) Dim UserDom: UserDom = Mid(StrEmail,InStr(StrEmail,"@") + 1, Len(StrEmail)) 'See if the folder exists... If oFSO.FolderExists(StrSave & "\" & UserDom & "\" & UserName) = True Then GenerateFolderTree = StrSave & "\" & UserDom & "\" & UserName & "\" 'exists Exit Function End If 'does not exist... lets build the path 'split the path parts up Dim ArrPath: ArrPath = Split(StrSave & "\" & UserDom & "\" & UserName, "\") Dim TempPath Dim I 'the first one is the drive, it must exist, skip it and check the others TempPath = ArrPath(0) & "\" For I = 1 to UBound(ArrPath) TempPath = TempPath & ArrPath(I) & "\" 'check to see if the folder exists... If oFSO.FolderExists(TempPath) = False Then 'create the folder oFSO.CreateFolder(TempPath) End If Next 'return the new path GenerateFolderTree = TempPath End Function