Occasional fail on .DeleteByDBID call

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
Post Reply
User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-05 22:52

Chaps and experts

I have this script that runs nightly. It was created in conjunction with help I received here on the forum (I think from Doom or Matt, and the original script is found somewhere here on this forum). It generally works well.

You can see by the code that it is coded correctly (hopefully!) by the way it uses the FOR loops to check the individual TRASH folders and delete qualifying messages (by message age) in them for each account. Basically, it looks in the TRASH folder, collects the .ID of a message that satisfy selection criteria and then performs a oMessages.DeleteByDBID(oMessage.ID) of that message.

However, occasionally (say every 2 or 3 days) it errors with:
Delete failed
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
... so far in (having already done some accounts and yet got other accounts to do). The account it fails on can change, as can the amount of emails it finds (in other words there is nothing obviously symptomatic. And yet, another day, another run, and it all completes in one go as it should do. By the way, when it does fail, a second run of the same script does then complete ok (starting at the messages yet to be deleted left behind by the aborted first run). It seems that despite finding a message and obtaining its ID, the 'DeleteByID' call fails to find that message (Or at least Im guessing thats what the problem is).

Im wondering if anyone can see an obvious problem or if the error is somewhere within the Hmailserver API handling? (I have marked/highlighted the 4 main lines with <--- about 2 thirds down the code)

Code: Select all

Const DAYS_TO_KEEP_MESSAGES = "0" ' Days old to keep mails
Const MESSAGES_FOLDER = "trash" ' Folder to delete from, case insensitive, subfolder delimiter needs to be as below (.) based on ur delimiter setting in hmailserver, multiple fodlers can be specified seprated by | (pipe)  eg: "spam|trash|deleted messages|deleted items|junk e-mail"
Const IMAP_DELIMITER = "." ' This needs to be same as what u used above for subfodlers based on delimiter setting in hmailserver
Const ADMINUSER = "Administrator" ' Admin username
Const ADMINPWD = "secretpassword" ' Admin password
Const FROM_EMAIL = "system@mydomain.com" ' Replace this with the email address you want the report to come from
Const REPORT_TO_EMAIL = "admin@mydomain.com" ' Replace this with the email address you want the report to be sent to

Dim mFolders
Dim oApp
Dim AccountSize
Dim NumMsgs
Dim NumDeleted
Dim FoundFolder
Dim FolderList
Dim aFolder
Dim Message

Dim ReturnValue
ReturnValue = 0
On Error Resume Next

mFolders = Split(MESSAGES_FOLDER, "|")
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate(ADMINUSER, ADMINPWD)

For x = 0 to oApp.Domains.Count - 1
     Dim oDomain
     Set oDomain = oApp.Domains.Item(x)
   If oDomain.Active Then
      For y = 0 to oDomain.Accounts.Count - 1
         Dim oAccount
         Set oAccount = oDomain.Accounts.Item(y)
         OutputMsg = OutputMsg & "<tr><td colspan=""5"">&nbsp;</td></tr>" & vbCrLf
         If oAccount.Active Then
            For each SpamFolder in mFolders
               AccountSize = 0
               NumMsgs = 0
               NumDeleted = 0
               xFolder = ""
               Dim FindFolders
               Set FindFolders = oAccount.IMAPFolders
               FoundFolder = False
               FolderList = ListFolders(FindFolders, 0, "")
               aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|")
               For each z in aFolder
                  If UCase(z) = UCase(Trim(SpamFolder)) Then
                     FoundFolder = True
                     SpamFolder = z
                     Exit For
                  End If
               Next
               If FoundFolder Then
                  Dim oMessages
                  Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolder)
                  NumMsgs = oMessages.Count
                  If oMessages.Count > 0 Then                           '<---  message found
                    Dim iMessages
                    For iMessages = (oMessages.Count) To 1 step -1      '<--- individual message selected
                     Dim oMessage
                     Set oMessage = oMessages.Item(iMessages - 1)
                     AccountSize = AccountSize + oMessage.Size
                     Dim vbDate
                     vbDate = oMessage.InternalDate
                     If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then  ' <--- message qualifies for deletion
                       NumDeleted = NumDeleted + 1
                       oMessages.DeleteByDBID(oMessage.ID)                  ' <---  Deletion called
		       If Err.Number <> 0 Then
		         ShowError("Delete failed")
		         Exit For
		       End If
                     End If
                    Next
                  End If
                  WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf
                  OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>"
                  OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>"
                  OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(NumMsgs, 0, True, False, True) & "</td>"
                  OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>"
                  OutputMsg = OutputMsg & "<td align=""right"">" & FormatNumber(NumDeleted, 0, True, False, True) & "</td></tr>" & vbCrLf
               Else
                  WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
               End If
            Next
         End If
      Next
   End If
Next

OutputMsg = "<font face=""Calibri""><table border=""1""><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg
OutputMsg = OutputMsg & "</table>" & vbCrLf
Dim CreateGUIDval
   CreateGUID
Set Message = CreateObject("hMailServer.Message")
Message.HeaderValue("Message-ID") = "<" & CreateGUIDval & ">"
Message.FromAddress = FROM_EMAIL
Message.From = "Email Clearup <" & FROM_EMAIL & ">"
Message.AddRecipient "System Administrator", REPORT_TO_EMAIL
Message.Subject = "Email Clearup deletion report"
Message.HTMLBody = OutputMsg
Message.Save

Wscript.Quit ReturnValue

Function ShowError(strMessage)
    WScript.Echo strMessage
    WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
    ReturnValue = Err.Number
'Err.Clear
End function

Function ListFolders(obFolders, iRecursion, rootFolder)
  iRecursion = iRecursion + 1
  Dim sMessage
  Dim i
  for i = 0 to obFolders.Count -1
     Dim obFolder
   Set obFolder = obFolders.Item(i)
   if iRecursion > 1 then
      sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|"
   else
      sMessage = sMessage & obFolder.Name & "|"
   end if
   sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion,  obFolder.Name)   
  Next
  iRecursion = iRecursion -1
  ListFolders = sMessage
End Function

Function GetInsideFolders(obFolders2, subFolders)
   Dim iRecursion2
   iRecursion2 = 1
   Dim SeprateFodlers
   SeprateFodlers = Split(subFolders, IMAP_DELIMITER)
   For each w in SeprateFodlers
      if iRecursion2 = 1 then
         Set obFolders2 = obFolders2.ItemByName(w)
         iRecursion2 = iRecursion2 + 1
      Else
         Set obFolders2 = obFolders2.SubFolders.ItemByName(w)
      End If
   Next
   Set GetInsideFolders = obFolders2.Messages
End Function

Function CreateGUID()
' Generate a random string.
Dim obUtilities
Set obUtilities = CreateObject("hMailServer.Utilities")
CreateGUIDval = Mid(obUtilities.GenerateGUID, 2, 36) & "@servermail"
End Function
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-08 23:58

Ok in the absence of any replies, I tried to identify the problem myself but have uncovered a frankly bizarre situation that doesnt make any sense. To the point I am wondering if there is a fault within Hmailserver API.

I modified my script to:
a, when it finds a message, it echos out information about the message (From, subject etc + message ID)
b, then assuming the message qualifies (by date) it echos out the message ID again
c, then if the message ID is NOT ZERO then attempts to delete it - this was supposed to stop the error (which seemed to be happeneing because of a messageID=0 problem)

here is the section of script to show the changes:

Code: Select all

                   For iMessages = (oMessages.Count) To 1 step -1
                     Dim oMessage
                     Set oMessage = oMessages.Item(iMessages - 1)
                     AccountSize = AccountSize + oMessage.Size
                     Dim vbDate
WScript.Echo "   oMessage.ID= " & oMessage.ID & "   from=["& oMessage.FromAddress &"]   filename="&oMessage.Filename & " subject=[" & oMessage.Subject & "]"      <<<-----   part a
                     vbDate = oMessage.InternalDate
                     If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
WScript.Echo "Current NumDeleted= " & NumDeleted & ".  Attempting to delete Message=" & oMessage.ID        <<<-----   part b
		        If not oMessage.ID = 0 then          <<<-----   part c
                           NumDeleted = NumDeleted + 1
                           oMessages.DeleteByDBID(oMessage.ID)
			End If
However, tonights run still errored. And looking at the log file it did exactly part A and B, reported a message of having ID=ZERO ....but still then went to try and delete it! (then naturally failed). Here is the log file section:

Code: Select all

   oMessage.ID= 227536   from=[]   filename=D:\data\hMailData\mycompany.com\userA\FA\{FAF5055A-1525-4C0A-BA60-8D82B4EBCF1E}.eml subject=[Email notification - IMPORTANT:  mycompany email address change (was: Fwd: mycompany collection of roll directly from IVC Friday 9th January !!)]
Current NumDeleted= 0.  Attempting to delete Message=227536
   oMessage.ID= 0   from=[]   filename=D:\data\hMailData\mycompany.com\userA\FA\{FAF5055A-1525-4C0A-BA60-8D82B4EBCF1E}.eml subject=[Email notification - IMPORTANT:  mycompany email address change (was: Fwd: mycompany collection of roll directly from IVC Friday 9th January !!)]
Current NumDeleted= 1.  Attempting to delete Message=0
Delete failed
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
You can see it found message with ID =227536, then reported it was about to delete it, and then deleted it.
It then reported it found message ID =0 (which therefore should be skipped), reported 1 already deleted (correct) and was about to delete message=0 (and then failed obviously)

WHY ON EARTH is it

a, 'finding' message ID = 0 ?
b, still trying to delete it when the code says to ignore them?
c, a database check shows there is not and never has been a messageID=0 anyway

Could this be an API failure? Or anyone with any ideas?

Please, anyone?
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Occasional fail on .DeleteByDBID call

Post by percepts » 2015-01-09 00:17

what version of hmail are you running? If its 5.4.2 then I would suggest upgrading to 5.6.

AND

what did running the other script to find missing eml files tell you ?

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-09 01:38

Try...

If oMessage.ID > 0 then

From your log it shows that it is trying to delete the same message again thus ID=0 as it is already deleted... Check the filenames in your log :wink:

Also... Is oMessage.Count static during the run or does it reflect that messages are deleted?
You may want to assign it's value to a variable before entering the loop :idea:
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-09 12:13

Thanks for replies.

Soren, youre right! I had not noticed that the filename of both the previous (successfully deleted) message and this apparent rogue one is the same.

That certainly shows more sense in to why the message is zero but of course it doesnt explain why the loop has performed in that way (and not moved on to the next valid record with a new ID and different filename).

Re oMessage.Count: It becomes reflected as the variable NumMsgs which gets written out into the report and as far as I can remember I have never seen a discrepancy between its value and the actual number of messages sitting in TRASH prior to running. (Admittedly I dont look EVERY day).

I propose setting the filename of the previous message as a variable, and then checking the current message doesnt match before trying to delete. Something like

Code: Select all

              If not oMessage.Filename = preFilename then 
                           NumDeleted = NumDeleted + 1
                           set preFilename = oMessage.Filename
                           oMessages.DeleteByDBID(oMessage.ID)
              End If
percepts:
You would be right to think that it was because of this problem that I wanted to do the database to filename check (we discussed before). I wanted to see if there really was any ID=0 and what the state of that record would be. That check uncovered no errors (ID=0) at all. I confirmed this with a SQL statement on hm_messages and a database record count of hm_messages to filename count in the data directory all matching counts).

I dont want to upgrade to 5.6 because I have seen changes in the changelog I dont like/want and other than this weird issue my system seems to be running ok ("if it aint broke....etc"). So unless I see benefits worthy of the hassle of upgrading I prefer to stay as is. (It was enough hassle upgrading from 5.3 to 5.4 - which didnt work for no reason than "newer is supposedly better". I had my fingers burnt doing then.)
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-09 23:51

Regarding "For iMessages = (oMessages.Count) To 1 step -1"

Just made a sample script to test my theory... Theory failed :oops:

Code: Select all

j = 10
For i = j To 1 step -1
   Wscript.echo "i=" & i & " j=" & j
   j = j - 2
Next
Conclusion: The loop is not affected by j changing value inside the loop.
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-10 00:06

And in fact I wouldnt expect the loop to be affected. I imagine that at the start it reads the command

"For i = j To 1 step -1" and traslate the variable into values:

For i = 10 To 1 step -1

and consequently the loop will remain always going from 10 to 1 irrespective of what goes in INSIDE the loop (with exception to an EXIT FOR of course :-) )

I would think the only way you get the FOR loop 'readjusting' because the value J has been changed within the loop, would be to change J, then exit the FOR loop, then recall the FOR loop again.

Ill be honest though I wasnt quite sure what you were trying to get at initially.

UPDATE: tonights cleardown with my proposed changes above worked ok, but often does anyway. So nothing proven yet.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-11 17:25

I have an update for some thought

I have just ran a test on my script (with the actual DELETE call rem'd so I can repeat the test).

I was finding that the log was seemingly 'deleting' 16 messages - all listed out by ID. However, in my TRASH folder I only have 10 messages. So something wasnt right because 6 of the apparent 16 simply were not showing up in the mail client.

So I took to the hm_messages table.

I noticed that one of the mails that appear in both the Trash AND also in the log file for deletion (ie, correctly tally) has a 'messageflags' value of 65 - which according to martin on another post (viewtopic.php?t=15947)

Code: Select all

         FlagSeen = 1,
         FlagDeleted = 2,
         FlagFlagged = 4,
         FlagAnswered = 8,
         FlagDraft = 16,
         FlagRecent = 32,
         FlagVirusScan = 64
would mean 65 is VIRUS SCANNED and SEEN. And yet, there it is in the Trash folder.

Now, come to a message that is appearing in the log file as eligible for deletion yet ISNT visible in the Trash folder or anywhere else, it has a flag of 3 which means Seen and Deleted.

So now I am all confused.

mail1 - IN Trash -, visible, selected for deletion by script, has flag value of SEEN
mail2 - NOT in TRASH, and not visible, yet apparently selected for deletion by the script, yet already has flag value DELETED) - but still being selected.

So am I misunderstanding what messageflags value is? Does the value have no refection of whether the message has actually been moved to the Trash folder, and is it simply a reflection of someone hitting the PERMANENT DELETE button of a message (thereby flagging it as deleted)? (And conversely, because the other message hasnt been deleted but simply moved to a Trash folder, it isnt actually flagged as deleted because it still exists)?

Of course, I probably right in that conclusion (that the flag has no reference to physical folder location)

But that then still leaves me with the error of having 5 message rows that are being selected for deletion by the script and yet they are not visible by the email clients. When a message is flagged as DELETED (flag=2), when does it ACTUALLY get removed from the hm_messages table? (im sure they must disappear eventually because otherwise the table would be FULL of 'flag=2 deleted' messages unless they run a script similar to this)

Can ANYONE make any sense of this?


Selected for deletion in the script:

Code: Select all

oMessage.ID= 227720   filename=D:\data\hMailData\mycompany.com\user\DE\{DE652A82-C35D-41C6-A4F7-B59827B78B04}.eml subject=[Email Clearup deletion report]
   oMessage.ID= 227719   filename=D:\data\hMailData\mycompany.com\user\78\{785D475C-63A3-4BBF-A178-804903E4B5C2}.eml subject=[Email Clearup deletion report]
   oMessage.ID= 227703   filename=D:\data\hMailData\mycompany.com\user\05\{054098F4-24E9-4544-B2E5-73F21B0B0481}.eml subject=[test1]
   oMessage.ID= 227702   filename=D:\data\hMailData\mycompany.com\user\93\{935C8AE8-91A8-46C2-8343-B83B12942DB9}.eml subject=[Message undeliverabley]
   oMessage.ID= 227701   filename=D:\data\hMailData\mycompany.com\user\4C\{4CC7C5B3-010C-47C2-B384-A1A88A074CD9}.eml subject=[test]
   oMessage.ID= 227696   filename=D:\data\hMailData\mycompany.com\user\96\{96EDFA2E-A77E-4982-A655-1E3802F3A275}.eml subject=[[SpamCop] has accepted 1 email for processing]
   oMessage.ID= 227694   filename=D:\data\hMailData\mycompany.com\user\8A\{8A905383-778D-48FA-986F-CB34B916D797}.eml subject=[[SpamCop] has accepted 1 email for processing]
   oMessage.ID= 227692   filename=D:\data\hMailData\mycompany.com\user\D7\{D7BB98BC-3CEA-4DB7-B3A0-66E09405B31A}.eml subject=[!! Gite internet offline too long!! -potential powercut ocurred]
   oMessage.ID= 227687   filename=D:\data\hMailData\mycompany.com\user\4F\{4F125CD8-70F3-4322-8BF8-51862F6810CD}.eml subject=[!! Gite internet offline too long!! -potential powercut ocurred]
   oMessage.ID= 227685   filename=D:\data\hMailData\mycompany.com\user\56\{56645194-F72E-4D6E-9540-3EB23F94F70E}.eml subject=[!! GITE INTERNET DOWN for extensive period (8 hours)!!  See message for details]
   oMessage.ID= 227684   filename=D:\data\hMailData\mycompany.com\user\85\{85944F6D-B3D6-47B2-B2A5-9C12BA5803FE}.eml subject=[!! Gite internet offline too long!! -potential powercut ocurred]
   oMessage.ID= 227679   filename=D:\data\hMailData\mycompany.com\user\C8\{C8B69492-E053-4AA8-8B25-AEB35D9EE7F1}.eml subject=[!! GITE INTERNET DOWN for extensive period (6 hours)!!  See message for details]
   oMessage.ID= 227677   filename=D:\data\hMailData\mycompany.com\user\0B\{0B98EDF5-0C7D-47E5-9C52-8ECE04630C85}.eml subject=[!! GITE INTERNET DOWN for extensive period (4 hours)!!  See message for details]
   oMessage.ID= 227665   filename=D:\data\hMailData\mycompany.com\user\7B\{7BFB5A57-28EB-4F78-A8C3-22D527E9894A}.eml subject=[Offsite Storage log file]
   oMessage.ID= 227661   filename=D:\data\hMailData\mycompany.com\user\AE\{AE4B082E-45AD-43E9-9EC2-01119223E54A}.eml subject=[Email Clearup deletion report]
   oMessage.ID= 227660   filename=D:\data\hMailData\mycompany.com\user\F5\{F52F0D4C-ED08-4080-AEC7-C540FFE5372A}.eml subject=[Backup completed. See attachment log file.]
Removed 16 message(s) from Trash folder in account sales@mycompany.com
TrashFolder.png
p.s I have stoped and started MYsql and hmailserver to rule out Caching.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-11 18:54

With IMAP deleting a message is a two-step process... Mark for delete & Expunge...

This may explain it a bit better...

http://kb.mozillazine.org/Deleting_mess ... P_accounts
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-11 21:51

Cheers Soren. Yes I was aware of this, my question is WHEN does hmailserver 'expunge' ie, get rid of flag=deleted and phsysically delete the message? You can imagine that clients on the pcs do a lot of deleting (move to Trash) and only occasionally will one of them actually do an expunge (me usually on the server client). I, however, often (albeit with few) do direct 'deletions' (without moving to trash) or even do it on a message that is in the Trash.

So, if I am to read what is being suggested here correctly, is that if anything gets 'direct deleted' then its only flagged (=2 deleted). So it would remain in the messages table forever unless someone runs the script similar to the one I am talking about. The only time it would physically remove recors is if it was moved to Trash and then the Trash is 'purged'/emptied (which should also include an expunge command)
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
mattg
Moderator
Moderator
Posts: 19883
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Occasional fail on .DeleteByDBID call

Post by mattg » 2015-01-11 23:45

jimimaseye wrote:So, if I am to read what is being suggested here correctly, is that if anything gets 'direct deleted' then its only flagged (=2 deleted). So it would remain in the messages table forever unless someone runs the script similar to the one I am talking about. The only time it would physically remove recors is if it was moved to Trash and then the Trash is 'purged'/emptied (which should also include an expunge command)
That's about right I reckon
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-12 15:15

So how one one identify records remaining in the table that are flagged as deleted (as 'flagged' is a binary of 2)? There could be records in the database that are very old, flagged deleted, never to be seen, redundant, and yet will never be cleared out.

To convert these values in to the relevant flags, iIs there a vbs or API function or is it a case of maths? (I cant figure out the formula)

Anyone?
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
mattg
Moderator
Moderator
Posts: 19883
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Occasional fail on .DeleteByDBID call

Post by mattg » 2015-01-12 16:03

jimimaseye wrote:... or is it a case of maths?
jimimaseye wrote:

Code: Select all

         FlagSeen = 1,
         FlagDeleted = 2,
         FlagFlagged = 4,
         FlagAnswered = 8,
         FlagDraft = 16,
         FlagRecent = 32,
         FlagVirusScan = 64
So you add the flag values together.

IE if flag is 97

Then it
is Virus SCAN = 64
is Recent = 32
is Seen = 1

64+32+1 = 97 (no other options will get this total)


So to test
If
odd
then
Seen = true
subtract 1 from flag total
end

if
divisible by 2
then
Deleted = TRUE
subtract 2 from flag total
end


etc
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-12 16:28

Dont matter, Ive worked it out.

Ive ran a script to check flags. In my database I have 92 records that are flags as Deleted

I presume these records can be deleted safely? What is your opinion?

(I know its only 92 records in 39000, but I do wonder how many other people have in there databases that have millions of message records)

FYI, From an input file containing the MessageID and flag (created by direct MySQL output), I read the file in. The Formula was

Code: Select all

if Flag >= 64 then 
Flag=Flag-64
End if
if Flag >= 32 then 
Flag=Flag-32
End if
if Flag >= 16 then 
Flag=Flag-16
End if
if Flag >= 8 then 
Flag=Flag-8
End if
if Flag >= 4 then 
Flag=Flag-4
End if
if Flag >= 2 then
			Elog.Write ("ID="&MessageID & " flag="&Flag & " Orig flag: "  & OrigFlag)
Flag=Flag-2
End if
	End If
Loop
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-12 17:05

(Of course, I probably no what 'toe the line' answer I am about to receive but I will ask anyway:

Isit alright to delete the message record (from hm_messages) and the physical email using SQL? (ie, are any other table updates involved in deleting a message)?
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-12 17:34

Ive just discovered something weird.

I have found evidence of messages with a flag of 75 which should equate to being 'deleted', and yet copies are sitting quite happily in a folder - very NOT deleted! Something just isnt right. I have 2 copes of the same email: it seems that the moving of the message from INBOX to DEALT has created the new version (in DEALT) but didnt actually get the original one physically deleted. This is all too much to try and lay blame (client, HMS..??). Im probably the only one reading my postings and consequently nothing is going to get resolved any.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-12 19:56

Treating the flag as a bitmask makes it easier to work with :mrgreen:

test.vbs:

Code: Select all

intFlag = 97

'Test for each flag
If intFlag AND 1 Then Wscript.Echo " - Message has been read"
If intFlag AND 2 Then Wscript.Echo " - Message is marked for deletion"
If intFlag AND 4 Then Wscript.Echo " - Message has been flagged"
If intFlag AND 8 Then Wscript.Echo " - Message has been answered"
If intFlag AND 16 Then Wscript.Echo " - Message is a draft"
If intFlag AND 32 Then Wscript.Echo " - Message is recent ???"
If intFlag AND 64 Then Wscript.Echo " - Message has been virus scanned"
Output:

Code: Select all

C:\Temp>test.vbs
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.

 - Message has been read
 - Message is recent ???
 - Message has been virus scanned

C:\Temp>
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-12 20:03

jimimaseye wrote:Ive just discovered something weird.

I have found evidence of messages with a flag of 75 which should equate to being 'deleted', and yet copies are sitting quite happily in a folder - very NOT deleted! Something just isnt right. I have 2 copes of the same email: it seems that the moving of the message from INBOX to DEALT has created the new version (in DEALT) but didnt actually get the original one physically deleted. This is all too much to try and lay blame (client, HMS..??). Im probably the only one reading my postings and consequently nothing is going to get resolved any.
Blame the client - always :mrgreen:
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-13 00:25

Indeed, of course I will blame the client.

I do wonder though (and maybe if you are a code reader you could confirm), when the hmailserver service STARTED is there any form of scan and purge of such flagged messages? (out of interest)
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-01-13 02:48

jimimaseye wrote:Indeed, of course I will blame the client.

I do wonder though (and maybe if you are a code reader you could confirm), when the hmailserver service STARTED is there any form of scan and purge of such flagged messages? (out of interest)
No... Deleting and Expunging is exclusively the responsibility of the client (or a script).
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-01-13 16:49

Fair enough.

The only reason I asked is because I stopped and started the MySQL and Hmailservice services (after running an update SQL to move 40 of the messages from a folder into the TRASH folder id) and when I did another check all of a sudden ALL of the 'flag=deleted' messages had completely gone. Some weird conincidence and who knows why.

A mystery. But in the end SOMETHING was working correctly because I was left with none (without me needing to run any script to check for them).
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-02-24 00:25

Ok, despite coding in what I considered to be failsafes, I am still getting these rare occasional Subscript Out of Range crashes and it just doesnt make sense to me.

Soren, I coded for checking the filename as we discussed earlier. Here is the main part of the script (with some diagnostic output messages to help follow the output):

Code: Select all

FOR... accounts (selection code not shown for brevity)
  If oAccount.Active Then

NumMsgs = oMessages.Count
   If oMessages.Count > 0 Then
      Dim iMessages
      For iMessages = (NumMsgs - 1) To 0 Step -1
            Dim oMessage
            Set oMessage = oMessages.Item(iMessages)
             AccountSize = AccountSize + oMessage.Size
            Dim vbDate
WScript.Echo "oMessage.ID= " & oMessage.ID &" filename="&oMessage.Filename & " subject=[" & oMessage.Subject & "]"
            vbDate = oMessage.InternalDate
            If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
                  If not oMessage.Filename = preFilename then
WScript.Echo "Current NumDeleted= " & NumDeleted & ".  Attempting to delete Message=" & oMessage.ID
                        NumDeleted = NumDeleted + 1
                        preFilename = oMessage.Filename
                        oMessages.DeleteByDBID(oMessage.ID)
                  Else
WScript.Echo "!!!!!!!!!!!  Message=" & oMessage.ID & " !!!!! ---- NOT DELETED - Duplicate filename!. FILENAME=" & oMessage.Filename
                        ShowError("--->  Delete failed  <---")
                        Exit For
                  End If
                  If Err.Number <> 0 Then
                        ShowError("Delete failed due to Error>0")
                        Exit For
                  End If
            End If
      Next
    End If
  End If
NEXT 'account  (not shown)
And yet, OCCASIONALLY (most nights everuthing is fine), this happens:

Code: Select all

oMessage.ID= 232343 filename=D:\data\hMailData\mycompany.co.uk\userA\DB\{DBC8C2F2-D88A-4217-A58A-6BEDFB9A631E}.eml subject=[[SPAM] [9.5] Eustace lamented but did not lose his faith.]
Current NumDeleted= 0.  Attempting to delete Message=232343
oMessage.ID= 0 filename=D:\data\hMailData\mycompany.co.uk\userA\DB\{DBC8C2F2-D88A-4217-A58A-6BEDFB9A631E}.eml subject=[[SPAM] [9.5] Eustace lamented but did not lose his faith.]
!!!!!!!!!!!  Message=0 !!!!! ---- NOT DELETED - Duplicate filename!. FILENAME=D:\data\hMailData\mycompany.co.uk\userA\DB\{DBC8C2F2-D88A-4217-A58A-6BEDFB9A631E}.eml
--->  Delete failed  <---
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
Removed 1 message(s) from Trash folder in account userA@mycompany.co.uk

oMessage.ID= 232246 filename=D:\data\hMailData\mycompany.co.uk\userB\DE\{DEBBBAE3-A958-4197-86EF-2A4E9D1AB9D5}.eml subject=[Paints.Stripes.Recipes.#Lifehacks]
Current NumDeleted= 0.  Attempting to delete Message=232246
Delete failed due to Error>0
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
Removed 1 message(s) from Trash folder in account userB@mycompany.co.uk

oMessage.ID= 232349 filename=D:\data\hMailData\mycompany.co.uk\userC\73\{731BF4C2-0014-4E6B-A042-197B0A362AB1}.eml subject=[Windows Live Password Reset]
Current NumDeleted= 0.  Attempting to delete Message=232349
Delete failed due to Error>0
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
Removed 1 message(s) from Trash folder in account userC@mycompany.co.uk

Email clear up finished at 20:17:58.45 (errorlevel: 9) **********************
You will see from the log file that it matches a filename and as per the script it aborts "--Not DELETED Duplicate filename" ). As per the script I assumed it then does an EXIT FOR to move on to the net user ("UserB") and should justy go through normally. And yet it doesnt. It goes into an area of an IF statement that simply by passes all clauses before it.

Really its such a simple script and yet its failure (and randomness) is baffling and I cant believe its not down to some 'weirdness' of the hmailserver database. In any case can anyone make any sense of that? Is it my understanding of the EXIT FOR and in fact it is exiting the first level (ie 'account' rather than the inner most recent loop of the FOR MESSAGES? I Dunno. Im baffled.

Thanks.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
mattg
Moderator
Moderator
Posts: 19883
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Occasional fail on .DeleteByDBID call

Post by mattg » 2015-02-24 01:11

jimimaseye wrote: As per the script I assumed it then does an EXIT FOR to move on to the net user ("UserB") and should justy go through normally. And yet it doesnt.
Try adding 'On Error resume next' at the top

Also, I'd suggest adding a time stamp to the output for each file found.
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-02-24 02:24

jimimaseye wrote:Ok, despite coding in what I considered to be failsafes, I am still getting these rare occasional Subscript Out of Range crashes and it just doesnt make sense to me.

Soren, I coded for checking the filename as we discussed earlier. Here is the main part of the script (with some diagnostic output messages to help follow the output):

Code: Select all

...
...
And yet, OCCASIONALLY (most nights everuthing is fine), this happens:

Code: Select all

...
...
You will see from the log file that it matches a filename and as per the script it aborts "--Not DELETED Duplicate filename" ). As per the script I assumed it then does an EXIT FOR to move on to the net user ("UserB") and should justy go through normally. And yet it doesnt. It goes into an area of an IF statement that simply by passes all clauses before it.

Really its such a simple script and yet its failure (and randomness) is baffling and I cant believe its not down to some 'weirdness' of the hmailserver database. In any case can anyone make any sense of that? Is it my understanding of the EXIT FOR and in fact it is exiting the first level (ie 'account' rather than the inner most recent loop of the FOR MESSAGES? I Dunno. Im baffled.

Thanks.
Still going through the code, but... Immediate findings...

Why "For iMessages = (NumMsgs - 1) To 0 Step -1" ?? !! ??

You should use "For iMessages = oMessages.Count-1 To 0 Step -1"

When you delete a message, the number of messages change and it will affect the index at some level.
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-02-24 02:28

mattg wrote:
jimimaseye wrote: As per the script I assumed it then does an EXIT FOR to move on to the net user ("UserB") and should justy go through normally. And yet it doesnt.
Try adding 'On Error resume next' at the top

Also, I'd suggest adding a time stamp to the output for each file found.
I suspect he's already doing that since he's using "Err.Number" to check for errors ;-)
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-02-24 02:46

You could also check if oMessage.ID = 0 as I believe this is the cause of the "Subscript out of range".

Code: Select all

For iMessages = oMessages.Count-1 To 0 Step -1
   Dim oMessage
   Set oMessage = oMessages.Item(iMessages)

   If oMessage.ID > 0 Then

      AccountSize = AccountSize + oMessage.Size
      Dim vbDate
WScript.Echo "oMessage.ID= " & oMessage.ID &" filename="&oMessage.Filename & " subject=[" & oMessage.Subject & "]"
      vbDate = oMessage.InternalDate
      If (vbDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
         If not oMessage.Filename = preFilename Then
WScript.Echo "Current NumDeleted= " & NumDeleted & ".  Attempting to delete Message=" & oMessage.ID
            NumDeleted = NumDeleted + 1
            preFilename = oMessage.Filename
            oMessages.DeleteByDBID(oMessage.ID)
         Else
WScript.Echo "!!!!!!!!!!!  Message=" & oMessage.ID & " !!!!! ---- NOT DELETED - Duplicate filename!. FILENAME=" & oMessage.Filename
            ShowError("--->  Delete failed  <---")
            Exit For
         End If
         If Err.Number <> 0 Then
            ShowError("Delete failed due to Error>0")
            Exit For
         End If
      End If

   Else
      WScript.Echo "oMessage.ID = 0 -> Skipping index at: " & iMessages
   End If

Next
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-02-24 13:44

Thanks for your replies guys. I will address them accordingly:
SorenR wrote:Why "For iMessages = (NumMsgs - 1) To 0 Step -1" ?? !! ??

You should use "For iMessages = oMessages.Count-1 To 0 Step -1"
'NumMsgs' is a variable that was assigned the starting value of oMessages.Count for each account prior to entering the FOR 'messages' loop (not shown), so effectively it is the same as you are suggesting (it doesnt get re-evaluated). It never gets re-evaluated WITHIN the FOR loop. eg, it gets assign '8' and remains 8 right through the for loop until the next account is evaluated.

Code: Select all

    NumMsgs = oMessages.Count
mattg wrote:Try adding 'On Error resume next' at the top
Yes, it is already there. (well identified, Soren! :-) )
SorenR wrote:You could also check if oMessage.ID = 0 as I believe this is the cause of the "Subscript out of range"
I already used to have this and I still had the error. That is when (earlier in the thread) you pointed out to me that the filename was being deemed as the same, so I changed to checking for duplicate filename instead. (Reminder: even with If not oMessage.ID = 0 it still errored).

Code: Select all

'	If not oMessage.ID = 0 then
	If not oMessage.Filename = preFilename then
I just dont understand why the EXIT FOR does work as it seems that the section

Code: Select all

 If Err.Number <> 0 Then
            ShowError("Delete failed due to Error>0")
is reached (as shown in the log file) and yet theoretically it should never do. I remain baffled. Here is a question: for EXIT FOR exit the immediate current nested FOR ? ie, if I have

Code: Select all

FOR x....
       do something
       FOR y = 1 to 10 
          if y = 5
            EXIT FOR
          end if
       next 'y
next 'x
Should it just EXIT the Y loop (when value = 5) and go back and continue with the next X loop...or does it completely exit the X loop too? Just thought I would ask because I am now clutching at straws due to the randomness of this erratic behaviour.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-02-24 17:02

What bothers me is that according to the code, iMessage should be decremented by one and oMessages.Item(iMessages) should select the next (actually the previous item = step -1) in line...

It's like having a pad of post-it's with a unique number on each note, you take the notes off one by one, occationally throw one away, then proceed to the next in the stack until there are no more notes...

What I see from the log is that "the next note" got the same number as the one that was thrown away...
oMessage.ID= 232343 filename=D:\data\hMailData\mycompa......
Current NumDeleted= 0. Attempting to delete Message=232343
oMessage.ID= 0 filename=D:\data\hMailData\mycompa......
!!!!!!!!!!! Message=0 !!!!! ---- NOT DELETED - Duplicate filename!. FILENAME=D:\data\hMailData\mycompa......
---> Delete failed <---
9 Srce: Microsoft VBScript runtime error Desc: Subscript out of range
Removed 1 message(s) from Trash folder in account userA@mycompany.co.uk
The code successfully deleted a message and the index should point to the next, but it doesn't..

Could you either post the complete code - or - send it to me directly on hmail@lolle.org - it's a disposable account, I'll return my real address ;-) ?
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-02-24 23:34

I totally agree Soren. That's the head scratcher for me too. Further more, during the previous attempts of diagnosis by echoing out the records BEFORE they are processed for deletion, there is never a messageid=0 on the database, and yet it reports one prior to erroring. AND also, this error is simply not reproducable at will - I simply cannot work out how to recreate the scenario that leads to failure. 4 out of 5 times it will run through no problem.

Anyway, I have sent you the full script and log to your email. Cheers.

(Update: it bounced. see your PM's)
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

User avatar
SorenR
Senior user
Senior user
Posts: 3155
Joined: 2006-08-21 15:38
Location: Denmark

Re: Occasional fail on .DeleteByDBID call

Post by SorenR » 2015-02-24 23:56

jimimaseye wrote:(Update: it bounced. see your PM's)
"451 Please try again later." = Greylisting :mrgreen:
SørenR.

The quantum rule of insecurity which states that the act of observing how vulnerable a host or service is changes the insecurity level of the service.

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-03-12 23:18

EDIT: UPDATED two posts further down.


FOR THE RECORD and completeness....

....following many late nights and hassle from me, Soren was graceful enough to identify and rectify the script in order that it no longer fails.

The problem was that there were certain conditions where there was a caching of records hanging on to 'deleted records'

ie, The FOR loop would start off by seeing an oMessage.Count of (for example) 5 when in reality there was only 4 messages. Ultimately this caused a Subscript Out Of Range error.

It took many nights and tests but he nailed it.

With this script you can choose your FOLDERS that you wish to process, the DAYS age of messahes you want to keep, AND receive a nice little email afterwards telling you the result of it all. (It was originally taken from this forum, including Martins touches). The problem would exist in all previous versions of this script found on the forum (viewtopic.php?f=20&t=15363, here: viewtopic.php?f=21&t=27749 and viewtopic.php?f=20&t=27747&p=172816)

Enjoy:

Code: Select all

'  Routine empties the TRASH folders (Zero days retained) and is called by scheduler
'  in the backup script

Option Explicit

'   Routine empties the TRASH folders (Zero days retained) and is called by scheduler in the backup script

'   #### CONFIG START ####
    Const DAYS_TO_KEEP_MESSAGES = "0"				' Days old to keep mails
    Const MESSAGES_FOLDER = "trash"					' Folder to delete from, case insensitive, subfolder delimiter needs to be as
                                                    ' below (.) based on ur delimiter setting in hmailserver, multiple fodlers can
                                                    ' be specified seprated by | (pipe)  eg: "spam|trash|deleted messages|deleted
                                                    ' items|junk e-mail"
    Const IMAP_DELIMITER = "."                      ' This needs to be same as what u used above for subfodlers based on delimiter
                                                    ' setting in hmailserver
    Const HMSADMINUSER = "Administrator"            ' Admin username
    Const HMSADMINPWD = "yoursecretpassword"					' Admin password
    Const HMSSERVER = "localhost"		     ' hMailServer Server (DCOM)
    Const FROM_EMAIL = "system@yourdomain.com"       ' Replace this with the email address you want the report to come from
    Const REPORT_TO_EMAIL = "admin@yourdomain.com"   ' Replace this with the email address you want the report to be sent to
'   #### CONFIG END ####


'   Objects
    Dim oApp, oDomains, oDomain, oAccounts, oAccount, oMessages, oMessage

'   Numeric
    Dim AccountSize, NumMsgs, NumDeleted, iMessages, x, y, z, MessageID, DeleteCount, LoopCount

'   Strings / arrays
    Dim SearchFolders, FindFolders, FoundFolder, FolderList, aFolder, SpamFolder
    Dim Message, CreateGUIDval, OutputMsg, w

'   Flags
    Dim Skipped, ReturnValue : ReturnValue = 0

'   Date / time
    Dim MessageDate

'    On Error Resume Next

    SearchFolders = Split(MESSAGES_FOLDER, "|")

    Set oApp = CreateObject("hMailServer.Application", HMSSERVER)
    Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

    For x = 0 To oApp.Domains.Count - 1
        Set oDomain = oApp.Domains.Item(x)
        If oDomain.Active Then
            For y = 0 To oDomain.Accounts.Count - 1
                Set oAccount = oDomain.Accounts.Item(y)
                OutputMsg = OutputMsg & "<tr><td colspan=" & Chr(34) & "5" & Chr(34) & ">&nbsp;</td></tr>" & vbCrLf
                If oAccount.Active Then
                    Skipped = ""
                    For Each SpamFolder in SearchFolders
                        AccountSize = 0
                        NumMsgs = 0
                        NumDeleted = 0
                        Set FindFolders = oAccount.IMAPFolders
                        FoundFolder = False
                        FolderList = ListFolders(FindFolders, 0, "")
                        aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|")
                        For Each z in aFolder
                            If UCase(z) = UCase(Trim(SpamFolder)) Then
                                FoundFolder = True
                                SpamFolder = z
                                Exit For
                            End If
                        Next
                        If FoundFolder Then
                            Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolder)
                            NumMsgs = oMessages.Count
                            iMessages = 0
                            DeleteCount = 0
                            LoopCount = 0
                            Do While oMessages.Count > (LoopCount - DeleteCount)
                                Set oMessage = oMessages.Item(iMessages)
                                AccountSize = AccountSize + oMessage.Size
                                MessageDate = oMessage.InternalDate
                                If (MessageDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
                                    If CLng(oMessage.ID) > 0 Then
                                        NumDeleted = NumDeleted + 1
                                        DeleteCount = DeleteCount + 1
                                        WScript.Echo "Executing oMessages.DeleteByDBID(oMessage.ID) :: iMessages = " & iMessages & " oMessage.ID = " & CLng(oMessage.ID)
                                        oMessages.DeleteByDBID(oMessage.ID)
                                    Else
                                        WScript.Echo "iMessages = " & iMessages & " oMessage.ID = " & CLng(oMessage.ID)
                                        Skipped = " *"
                                        ShowError("--->  Delete failed  <---")
                                    End If
                                Else
                                    iMessages = iMessages + 1
                                End If
                                If oMessages.Count = (NumMsgs - DeleteCount) Then
                                    LoopCount = LoopCount + 1
                                Else
                                    NumMsgs = oMessages.Count
                                    iMessages = 0
                                    DeleteCount = 0
                                    LoopCount = 0
                                End If
                            Loop

                            WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf
                            OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>"
                            OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumMsgs, 0, True, False, True) & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumDeleted, 0, True, False, True) & Skipped & "</td></tr>" & vbCrLf
                        Else
                            WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
                        End If
                    Next
                End If
            Next
        End If
    Next

    OutputMsg = "<font face=" & Chr(34) & "Calibri" & Chr(34) & "><table border=" & Chr(34) & "1" & Chr(34) & "><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg
    OutputMsg = OutputMsg & "</table>" & vbCrLf

    Set Message = CreateObject("hMailServer.Message", HMSSERVER)
    Message.HeaderValue("Message-ID") = "<" & CreateGUID & ">"
    Message.FromAddress = FROM_EMAIL
    Message.From = "Email Clearup Daemon <"& FROM_EMAIL & ">"
    Message.AddRecipient "System Administrator", REPORT_TO_EMAIL 
    Message.Subject = "Email Clearup deletion report"
    Message.HTMLBody = OutputMsg
    Message.Save

    Wscript.Quit ReturnValue

    Function ShowError(strMessage)
        WScript.Echo strMessage
        WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
        ReturnValue = Err.Number
	Err.Clear
    End Function

    Function ListFolders(obFolders, iRecursion, rootFolder)
        iRecursion = iRecursion + 1
        Dim sMessage
        Dim i
        For i = 0 To obFolders.Count -1
            Dim obFolder
            Set obFolder = obFolders.Item(i)
            If iRecursion > 1 Then
                sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|"
            Else
                sMessage = sMessage & obFolder.Name & "|"
            End If
            sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion,  obFolder.Name)
        Next
        iRecursion = iRecursion -1
        ListFolders = sMessage
    End Function

    Function GetInsideFolders(obFolders2, subFolders)
        Dim iRecursion2
        iRecursion2 = 1
        Dim SeprateFodlers
        SeprateFodlers = Split(subFolders, IMAP_DELIMITER)
        For Each w in SeprateFodlers
            If iRecursion2 = 1 Then
                Set obFolders2 = obFolders2.ItemByName(w)
                iRecursion2 = iRecursion2 + 1
            Else
                Set obFolders2 = obFolders2.SubFolders.ItemByName(w)
            End If
        Next
        Set GetInsideFolders = obFolders2.Messages
    End Function

    Function CreateGUID()
        ' Generate a random string.
        With CreateObject("hMailServer.Utilities", HMSSERVER)
            CreateGUID = Mid(.GenerateGUID, 2, 36) & "@randommail"
        End With
    End Function

HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

baconpancakes
New user
New user
Posts: 1
Joined: 2015-04-09 03:35

Re: Occasional fail on .DeleteByDBID call

Post by baconpancakes » 2015-04-09 03:39

FOR THE RECORD and completeness....

....following many late nights and hassle from me, Soren was graceful enough to identify and rectify the script in order that it no longer fails.
I tested the script, found that it will only go one folder deep. i.e. inbox.folder1
In the case of inbox.folder1.folder2 it says "foldername folder not found"

I am not a vb coder so i cannot really tell where it's going wrong

Cheers
B

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2015-04-29 22:11

Thanks for the heads up there. Even though I dont think people would be quoting a 3+deep trash folder, out of principal I have fixed it.

To be clear, you can now enter multiple folders as the 'trash' folders, and these can be separated with PIPE symbol whilst listed using the folder delimiter. eg,
Const MESSAGES_FOLDER = "INBOX.Dealt.DealtRubbish|Trash"
where both folders DealtRubbish ("INBOX.Dealt.DealtRubbish") and Trash are considered for cleardown IF found.


You can also use trailing asterix wildcard such as:

DEALT* which will match folders:
  • DEALT
    DEALT2014
INBOX.SUB1* which will match
  • INBOX.SUB1
    INBOX.SUB123
    INBOX.SUB1.SUBA
Here is the new complete code:

Code: Select all

'  Routine empties the TRASH folders (Zero days retained) and is called by scheduler
'  in the backup script

Option Explicit

'   Routine empties the TRASH folders (Zero days retained) and is called by scheduler in the backup script

'   #### CONFIG START ####
   Const DAYS_TO_KEEP_MESSAGES = "0"            ' Days old to keep mails
   Const MESSAGES_FOLDER = "Trash|Deleted*"     ' Folder to delete from, case insensitive, subfolder delimiter needs to be as
                                                 ' below (.) based on ur delimiter setting in hmailserver, multiple folders can
                                                 ' be specified seprated by | (pipe) and can include asterix wilcard
                                                 ' eg: "spam|trash|deleted*|inbox.sub*"

   Const IMAP_DELIMITER = "."                    ' This needs to be same as what u used above for subfolders based on delimiter
                                                 ' setting in hmailserver
   Const HMSADMINUSER = "Administrator"          ' Admin username
   Const HMSADMINPWD = "secretpassword"          ' Admin password
   Const HMSSERVER = "127.0.0.1"                 ' hMailServer Server (DCOM)
   Const FROM_EMAIL = "system@yourdomain.com"    ' Replace this with the email address you want the report to come from
   Const REPORT_TO_EMAIL = "admin@yourdomain.com"' Replace this with the email address you want the report to be sent to
'   #### CONFIG END ####

'   Objects
   Dim oApp, oDomains, oDomain, oAccounts, oAccount, oMessages, oMessage

'   Numeric
   Dim AccountSize, NumMsgs, NumDeleted, iMessages, x, y, z, MessageID, DeleteCount, LoopCount

'   Strings / arrays
   Dim SearchFolders, FindFolders, FoundFolder, FolderList, aFolder, SpamFolder, SpamFolderAction, TotalMsgs
   Dim Message, CreateGUIDval, OutputMsg, w, FolderArray, SplitCount, xFolder

'   Flags
   Dim Skipped, ReturnValue : ReturnValue = 0

'   Date / time
   Dim MessageDate

'    On Error Resume Next

   SearchFolders = Split(MESSAGES_FOLDER, "|")

   Set oApp = CreateObject("hMailServer.Application", HMSSERVER)
   Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

   For x = 0 To oApp.Domains.Count - 1
     Set oDomain = oApp.Domains.Item(x)
      If oDomain.Active Then
         For y = 0 To oDomain.Accounts.Count - 1
            Set oAccount = oDomain.Accounts.Item(y)
            OutputMsg = OutputMsg & "<tr><td colspan=" & Chr(34) & "5" & Chr(34) & ">&nbsp;</td></tr>" & vbCrLf
            If oAccount.Active Then
              Skipped = ""
               For Each SpamFolder in SearchFolders
                  TotalMsgs = 0
                  AccountSize = 0
                  NumMsgs = 0
                  NumDeleted = 0
                  Set FindFolders = oAccount.IMAPFolders
                  FoundFolder = False
                  FolderList = ListFolders(FindFolders, 0, "")
                  aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|")
                  For Each z in aFolder
                     If UCase(z)=UCase(Trim(SpamFolder)) Or _
                     (Right(trim(SpamFolder),1)="*" And UCase(left(z,len(trim(Spamfolder))-1)) = UCase(left(trim(SpamFolder),len(trim(SpamFolder))-1))) Then
                        FoundFolder = True
                        SpamFolderAction = z
                        Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolderAction)
                        NumMsgs = oMessages.Count
                        TotalMsgs = TotalMsgs + NumMsgs
                        iMessages = 0
                        DeleteCount = 0
                        LoopCount = 0
                        Do While oMessages.Count > (LoopCount - DeleteCount)
                           Set oMessage = oMessages.Item(iMessages)
                           AccountSize = AccountSize + oMessage.Size
                           MessageDate = oMessage.InternalDate
                           If (MessageDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
                              If CLng(oMessage.ID) > 0 Then
                                 NumDeleted = NumDeleted + 1
                                 DeleteCount = DeleteCount + 1
                                 oMessages.DeleteByDBID(oMessage.ID)
                              Else
                                 Skipped = " *"
                                 ShowError("--->  Delete failed  <---")
                              End If
                           Else
                              iMessages = iMessages + 1
                           End If
                           If oMessages.Count = (NumMsgs - DeleteCount) Then
                              LoopCount = LoopCount + 1
                           Else
                              NumMsgs = oMessages.Count
                              iMessages = 0
                              DeleteCount = 0
                              LoopCount = 0
                           End If
                        Loop
                     End if
                  Next
                  If FoundFolder Then
                      WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf
                      OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>"
                      OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>"
                      OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(TotalMsgs, 0, True, False, True) & "</td>"
                      OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>"
                      OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumDeleted, 0, True, False, True) & Skipped & "</td></tr>" & vbCrLf
                  Else
                      WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
                  End If
               Next
            End If
         Next
      End If
   Next

   OutputMsg = "<font face=" & Chr(34) & "Calibri" & Chr(34) & "><table border=" & Chr(34) & "1" & Chr(34) & "><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg
   OutputMsg = OutputMsg & "</table>" & vbCrLf

   Set Message = CreateObject("hMailServer.Message", HMSSERVER)
   Message.HeaderValue("Message-ID") = "<" & CreateGUID & ">"
   Message.FromAddress = FROM_EMAIL
   Message.From = "Email Clearup Daemon <"& FROM_EMAIL & ">"
   Message.AddRecipient "System Administrator", REPORT_TO_EMAIL
   Message.Subject = "Email Clearup deletion report"
   Message.HTMLBody = OutputMsg
   Message.Save

   Wscript.Quit ReturnValue

   Function ShowError(strMessage)
      WScript.Echo strMessage
      WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
      ReturnValue = Err.Number
      Err.Clear
   End Function

   Function ListFolders(obFolders, iRecursion, rootFolder)
      iRecursion = iRecursion + 1
      Dim sMessage
      Dim i
      For i = 0 To obFolders.Count -1
         Dim obFolder
         Set obFolder = obFolders.Item(i)
         If iRecursion > 1 Then
            FolderArray = Split(rootFolder, IMAP_DELIMITER)
            SplitCount=0
            for each xFolder in FolderArray
               SplitCount=SplitCount+1
               if SplitCount < iRecursion then
                  if SplitCount = 1 then
                     rootFolder = xFolder
                  else
                     rootFolder = rootFolder & IMAP_DELIMITER & xFolder
                  end if
               else
                  if SplitCount = iRecursion then
                     Exit for
                  End if
               end if
            next
            sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|"
         Else
            sMessage = sMessage & obFolder.Name & "|"
         End If
         If iRecursion = 1 Then
            rootfolder =obFolder.Name
         Else
            rootFolder = rootFolder & IMAP_DELIMITER & obFolder.Name
         End If
         sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion, rootFolder )
      Next
      iRecursion = iRecursion -1
      ListFolders = sMessage
   End Function

   Function GetInsideFolders(obFolders2, subFolders)
      Dim iRecursion2
      iRecursion2 = 1
      Dim SeprateFodlers
      SeprateFodlers = Split(subFolders, IMAP_DELIMITER)
      For Each w in SeprateFodlers
         If iRecursion2 = 1 Then
            Set obFolders2 = obFolders2.ItemByName(w)
            iRecursion2 = iRecursion2 + 1
         Else
            Set obFolders2 = obFolders2.SubFolders.ItemByName(w)
         End If
      Next
      Set GetInsideFolders = obFolders2.Messages
   End Function

   Function CreateGUID()
     ' Generate a random string.
      With CreateObject("hMailServer.Utilities", HMSSERVER)
         CreateGUID = Mid(.GenerateGUID, 2, 36) & "@randommail"
      End With
   End Function
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

stefans10
Normal user
Normal user
Posts: 32
Joined: 2014-04-25 17:51

Re: Occasional fail on .DeleteByDBID call

Post by stefans10 » 2017-02-16 17:28

jimimaseye wrote:Thanks for the heads up there. Even though I dont think people would be quoting a 3+deep trash folder, out of principal I have fixed it.

To be clear, you can now enter multiple folders as the 'trash' folders, and these can be separated with PIPE symbol whilst listed using the folder delimiter.

eg,
Const MESSAGES_FOLDER = "INBOX.Dealt.DealtRubbish|Trash"
where both DealtRubbish ("INBOX.Dealt.DealtRubbish") and Trash are considered for cleardown IF found.

Here is the new complete code:

Code: Select all

'  Routine empties the TRASH folders (Zero days retained) and is called by scheduler
'  in the backup script

Option Explicit

'   Routine empties the TRASH folders (Zero days retained) and is called by scheduler in the backup script

'   #### CONFIG START ####
    Const DAYS_TO_KEEP_MESSAGES = "0"            ' Days old to keep mails
    Const MESSAGES_FOLDER = "trash|rubbish|inbox.spam"    ' Folder to delete from, case insensitive, subfolder delimiter needs to be as
                                                    ' below (.) based on ur delimiter setting in hmailserver, multiple fodlers can
                                                    ' be specified seprated by | (pipe)  eg: "spam|trash|deleted messages|deleted
                                                    ' items|junk e-mail"
    Const IMAP_DELIMITER = "."                      ' This needs to be same as what u used above for subfodlers based on delimiter
                                                    ' setting in hmailserver
    Const HMSADMINUSER = "Administrator"            ' Admin username
    Const HMSADMINPWD = "yoursecretpassword"         ' Admin password
    Const HMSSERVER = "localhost"           ' hMailServer Server (DCOM)
    Const FROM_EMAIL = "system@yourdomain.com"       ' Replace this with the email address you want the report to come from
    Const REPORT_TO_EMAIL = "admin@yourdomain.com"   ' Replace this with the email address you want the report to be sent to
'   #### CONFIG END ####


'   Objects
    Dim oApp, oDomains, oDomain, oAccounts, oAccount, oMessages, oMessage

'   Numeric
    Dim AccountSize, NumMsgs, NumDeleted, iMessages, x, y, z, MessageID, DeleteCount, LoopCount

'   Strings / arrays
    Dim SearchFolders, FindFolders, FoundFolder, FolderList, aFolder, SpamFolder
    Dim Message, CreateGUIDval, OutputMsg, w, FolderArray, SplitCount, xFolder

'   Flags
    Dim Skipped, ReturnValue : ReturnValue = 0

'   Date / time
    Dim MessageDate

'    On Error Resume Next

    SearchFolders = Split(MESSAGES_FOLDER, "|")

    Set oApp = CreateObject("hMailServer.Application", HMSSERVER)
    Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

    For x = 0 To oApp.Domains.Count - 1
        Set oDomain = oApp.Domains.Item(x)
        If oDomain.Active Then
            For y = 0 To oDomain.Accounts.Count - 1
                Set oAccount = oDomain.Accounts.Item(y)
                OutputMsg = OutputMsg & "<tr><td colspan=" & Chr(34) & "5" & Chr(34) & ">&nbsp;</td></tr>" & vbCrLf
                If oAccount.Active Then
                    Skipped = ""
                    For Each SpamFolder in SearchFolders
                        AccountSize = 0
                        NumMsgs = 0
                        NumDeleted = 0
                        Set FindFolders = oAccount.IMAPFolders
                        FoundFolder = False
                        FolderList = ListFolders(FindFolders, 0, "")
                        aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|")
                        For Each z in aFolder
                            If UCase(z) = UCase(Trim(SpamFolder)) Then
                                FoundFolder = True
                                SpamFolder = z
                                Exit For
                            End If
                        Next
                        If FoundFolder Then
                            Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolder)
                            NumMsgs = oMessages.Count
                            iMessages = 0
                            DeleteCount = 0
                            LoopCount = 0
                            Do While oMessages.Count > (LoopCount - DeleteCount)
                                Set oMessage = oMessages.Item(iMessages)
                                AccountSize = AccountSize + oMessage.Size
                                MessageDate = oMessage.InternalDate
                                If (MessageDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
                                    If CLng(oMessage.ID) > 0 Then
                                        NumDeleted = NumDeleted + 1
                                        DeleteCount = DeleteCount + 1
                                        oMessages.DeleteByDBID(oMessage.ID)
                                    Else
                                        Skipped = " *"
                                        ShowError("--->  Delete failed  <---")
                                    End If
                                Else
                                    iMessages = iMessages + 1
                                End If
                                If oMessages.Count = (NumMsgs - DeleteCount) Then
                                    LoopCount = LoopCount + 1
                                Else
                                    NumMsgs = oMessages.Count
                                    iMessages = 0
                                    DeleteCount = 0
                                    LoopCount = 0
                                End If
                            Loop

                            WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf
                            OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>"
                            OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumMsgs, 0, True, False, True) & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumDeleted, 0, True, False, True) & Skipped & "</td></tr>" & vbCrLf
                        Else
                            WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
                        End If
                    Next
                End If
            Next
        End If
    Next

    OutputMsg = "<font face=" & Chr(34) & "Calibri" & Chr(34) & "><table border=" & Chr(34) & "1" & Chr(34) & "><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg
    OutputMsg = OutputMsg & "</table>" & vbCrLf

    Set Message = CreateObject("hMailServer.Message", HMSSERVER)
    Message.HeaderValue("Message-ID") = "<" & CreateGUID & ">"
    Message.FromAddress = FROM_EMAIL
    Message.From = "Email Clearup Daemon <"& FROM_EMAIL & ">"
    Message.AddRecipient "System Administrator", REPORT_TO_EMAIL
    Message.Subject = "Email Clearup deletion report"
    Message.HTMLBody = OutputMsg
    Message.Save

    Wscript.Quit ReturnValue

    Function ShowError(strMessage)
        WScript.Echo strMessage
        WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
        ReturnValue = Err.Number
   Err.Clear
    End Function

    Function ListFolders(obFolders, iRecursion, rootFolder)
        iRecursion = iRecursion + 1
        Dim sMessage
        Dim i
        For i = 0 To obFolders.Count -1
            Dim obFolder
            Set obFolder = obFolders.Item(i)
            If iRecursion > 1 Then
                FolderArray = Split(rootFolder, IMAP_DELIMITER)
                SplitCount=0
                for each xFolder in FolderArray
                   SplitCount=SplitCount+1
                   if SplitCount < iRecursion then
                      if SplitCount = 1 then
                         rootFolder = xFolder
                      else
                         rootFolder = rootFolder & IMAP_DELIMITER & xFolder
                      end if
                   else
                      if SplitCount = iRecursion then
                         Exit for
                      End if
                   end if
                next
                sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|"
            Else
                sMessage = sMessage & obFolder.Name & "|"
            End If
            If iRecursion = 1 Then
                rootfolder =obFolder.Name
            Else
                rootFolder = rootFolder & IMAP_DELIMITER & obFolder.Name
            End If
            sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion, rootFolder )
        Next
        iRecursion = iRecursion -1
        ListFolders = sMessage
    End Function

    Function GetInsideFolders(obFolders2, subFolders)
        Dim iRecursion2
        iRecursion2 = 1
        Dim SeprateFodlers
        SeprateFodlers = Split(subFolders, IMAP_DELIMITER)
        For Each w in SeprateFodlers
            If iRecursion2 = 1 Then
                Set obFolders2 = obFolders2.ItemByName(w)
                iRecursion2 = iRecursion2 + 1
            Else
                Set obFolders2 = obFolders2.SubFolders.ItemByName(w)
            End If
        Next
        Set GetInsideFolders = obFolders2.Messages
    End Function

    Function CreateGUID()
        ' Generate a random string.
        With CreateObject("hMailServer.Utilities", HMSSERVER)
            CreateGUID = Mid(.GenerateGUID, 2, 36) & "@randommail"
        End With
    End Function
Hi I have this running on my server and it's doing a very good job clearing spam folder older than x days and trash as well
But we use a lot of subfolders for case files of the clients and they are always a different name is there a way to include it in the delete?

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2017-02-17 16:45

stefans10 wrote: Hi I have this running on my server and it's doing a very good job clearing spam folder older than x days and trash as well
But we use a lot of subfolders for case files of the clients and they are always a different name is there a way to include it in the delete?
I have just updated the script for you that now enables wildcard entry. (And it was not easy - I found a bug within HMS and took me hours to realise).

Re-read the post for details and re-download the script.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

makza
New user
New user
Posts: 1
Joined: 2017-02-07 08:54

Re: Occasional fail on .DeleteByDBID call

Post by makza » 2017-02-18 11:31

Hi , I'm new beginning for this site recommend I thank you for everything

User avatar
jimimaseye
Moderator
Moderator
Posts: 8012
Joined: 2011-09-08 17:48

Re: Occasional fail on .DeleteByDBID call

Post by jimimaseye » 2017-02-19 15:36


This script is no longer going to be updated in this thread.


This script has been incorporated in to the FIRST post of thread viewtopic.php?f=21&t=28139 (used in a ready-to-go housekeeping cleardown routine) and any new modifications/amendments will be done in there. Visit that thread, scroll down, and the script is available in the CODE section (called "Emailclearup.vbs") or even in the ZIP file that is attached to it.

FOR ANY LATEST VERSIONS OR MODIFICATIONS PLEASE VISIT THAT THREAD. THE SCRIPT IN THIS THREAD WILL NO LONGER BE UPDATED.
HMS 5.6.6 B2383 on Win Server 2008 R2 Foundation, + 5.6.7-B2415 on test.
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829

Post Reply