Move emails to top of the queue based on certain priority header flags

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-05 02:59

Where can we move emails that come in to the top of the queue to be processed first based on a priority flag found in the header of the email?

Where is the best place to do this with scripting and is there anyone we can hire to do this for us?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by jimimaseye » 2019-05-05 12:15

You can't. Not by any method.

[Entered by mobile. Excuse my spelling.]
5.7 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

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-05 14:06

Work with me here. The message below, is it executed before it gets into the queue?

Code: Select all

OnAcceptMessage(oClient as hMailServer.Client, oMessage as hMailServer.Message)
If so how is the queue sorted and how does the "send now" button work in the queue to make emails go right away?

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 05:53

Anything?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 12:54

It appears that the "Send Now" button in the Delivery Queue window resets delivery time for the specific oMessage.ID and then restarts the delivery engine.

Code: Select all

        private void menuItemSendNow_Click(object sender, EventArgs e)
        {
            WaitCursor waitCursor = new WaitCursor();

            hMailServer.DeliveryQueue deliveryQueue = GetDeliveryQueue();
            foreach (ListViewItem item in listDeliveryQueue.SelectedItems)
            {
                string messageID = (string)item.Tag;

                deliveryQueue.ResetDeliveryTime(Convert.ToInt32(messageID));
            }

            deliveryQueue.StartDelivery();
            Marshal.ReleaseComObject(deliveryQueue);
        }
Interesting project ... It just may be possible to script such an event :idea:
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 13:31

Ok work with me here. I have posted that exact code you did multiple times without much luck on a good response.

If I wanted to use that code to send something right away, based on say a header, where would I put it? The OnAcceptMessage doesnt have a ID and that is when its placed in the queue right?

Also what does resetting the delivery time even do? Shouldnt that take it to the end of the line of the queue, nothing else?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 15:42

cblaze22 wrote:
2019-05-07 13:31
Ok work with me here. I have posted that exact code you did multiple times without much luck on a good response.

If I wanted to use that code to send something right away, based on say a header, where would I put it? The OnAcceptMessage doesnt have a ID and that is when its placed in the queue right?

Also what does resetting the delivery time even do? Shouldnt that take it to the end of the line of the queue, nothing else?
OnDeliverMessage is when it is placed into the queue.

Everything revolves around the queue and the way in is via OnDeliverMessage for both incoming and outgoing messages.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 16:15

Ok I feel like I am getting contradictory responeses with these methods. So OnDeliverMessage is when it goes INTO the queue. Meaning it has a Message ID, meaning I can run the code below to put it at the top of the queue. Please confirm.

Code: Select all

WaitCursor waitCursor = new WaitCursor();

            hMailServer.DeliveryQueue deliveryQueue = GetDeliveryQueue();
            foreach (ListViewItem item in listDeliveryQueue.SelectedItems)
            {
                string messageID = (string)item.Tag;

                deliveryQueue.ResetDeliveryTime(Convert.ToInt32(messageID));
            }

            deliveryQueue.StartDelivery();
            Marshal.ReleaseComObject(deliveryQueue);

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 16:46

cblaze22 wrote:
2019-05-07 16:15
Ok I feel like I am getting contradictory responeses with these methods. So OnDeliverMessage is when it goes INTO the queue. Meaning it has a Message ID, meaning I can run the code below to put it at the top of the queue. Please confirm.

Code: Select all

WaitCursor waitCursor = new WaitCursor();

            hMailServer.DeliveryQueue deliveryQueue = GetDeliveryQueue();
            foreach (ListViewItem item in listDeliveryQueue.SelectedItems)
            {
                string messageID = (string)item.Tag;

                deliveryQueue.ResetDeliveryTime(Convert.ToInt32(messageID));
            }

            deliveryQueue.StartDelivery();
            Marshal.ReleaseComObject(deliveryQueue);
That is is C# code... hMailServer is written in C++ and uses VBScript or JScript for eventhandling. Also what is your background for dealing with all this code? Are you a programmer?
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 17:07

Im a programmer, already programmed a VBScript to remove bounced messages within HMailServer so I know what I am doing.

I however dont know the logistics of how HMailServer flows. You just said its written in c++ but the admin panel IS NOT written in just c++,

https://github.com/nberardi/hMailServer ... cStatus.cs

Again can the code be convered to VBScript to do the same thing.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 17:44

cblaze22 wrote:
2019-05-07 17:07
Im a programmer, already programmed a VBScript to remove bounced messages within HMailServer so I know what I am doing.

I however dont know the logistics of how HMailServer flows. You just said its written in c++ but the admin panel IS NOT written in just c++,

https://github.com/nberardi/hMailServer ... cStatus.cs

Again can the code be convered to VBScript to do the same thing.
The Admin code is C# and uses the COM API... You would know that already as a programmer.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 18:08

Ok so I have no idea what the point was of stating its C# code. VBScript can also use the COM API, so the statement was irrelevant. So again, can that code be used in the OnDeliverMessage method. I dont see why not?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 23:22

Just mocking something together... This should list the content of the delivery queue.

VBScript stand-alone script to test on server in CMD window.

Code: Select all

   Dim Match, Matches, Done

   Dim oApp : Set oApp = CreateObject("hMailServer.Application")
   Call oApp.Authenticate("Administrator", "VERY SECRET")

'  Preliminary data ...
'
'  status.UndeliveredMessages = 1041428   2019-05-07 22:45:40     soren@localdomain.tld soren@otherdomain.tld     1901-01-01 00:00:00     C:\hMailServer\Data\{26C0D5B5-7B5A-41A7-A720-42D8FF38A915}.eml  1       0
'
'                          oMessage.ID    Created                 From                  To (list with ',')        Next try                Filename                                                        ??      #retries ??

   Done = False
   Do Until Done
      Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
      For Each Match in Matches
         WScript.Echo "Match = " & Match
      Next
      WScript.Sleep(1000)
   Loop

   WScript.Quit 0
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-07 23:37

Well that is neat, but where do you think the best place to call this?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-07 23:53

cblaze22 wrote:
2019-05-07 23:37
Well that is neat, but where do you think the best place to call this?
From a CMD window in Windows... On the server... It's a test... It does not really do anything but list the messages in queue - I hope - I usually never have any messages in my queue so I have only done limited testing.

It's a continous loop with a 1 second wait... Ctrl+C to stop it.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 01:14

So you cant run that say on OnAcceptMessage as a polling strategy?

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 04:38

I think we are getting somewhere. Below I am able to grab the MessageIds in the queue on a delivery start.

Next I need a way to read the email so I can view the headers in it for a certain flag? Is the best way to do that to read in the the .eml filepath and if so is there some reusable code someone already has used.

After that I need to figure out this SetDeliveryTime on the Queue For That Message ID if the Flag is found.

Code: Select all

Sub OnDeliveryStart(oMessage)
	Dim Match, Matches, Match2, Matches2
	Dim oApp : Set oApp = CreateObject("hMailServer.Application")
   	Call oApp.Authenticate("Administrator", "test")
	EventLog.Write("On Delivery Start")

   Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
      For Each Match in Matches
         	EventLog.Write("Match = " + Match)
		Matches2 = Split(Match, vbTab)
		For Each Match2 in Matches2
		EventLog.Write(Match2)
		Exit For
		Next
      Next
   End Sub

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

Re: Move emails to top of the queue based on certain priority header flags

Post by mattg » 2019-05-08 12:56

building on What SorenR started I may have something

This extracts the messageID from the Match, and then resets the deliverytime for that message, and then starts delivery

PLEASE TEST TEST TEST FIRST

Code: Select all

   Dim Match, Matches, Done, ID

   Dim oApp : Set oApp = CreateObject("hMailServer.Application")
   Call oApp.Authenticate("Administrator", "Top_Secret_Password")

'  Preliminary data ...
'
'  status.UndeliveredMessages = 1041428   2019-05-07 22:45:40     soren@localdomain.tld soren@otherdomain.tld     1901-01-01 00:00:00     C:\hMailServer\Data\{26C0D5B5-7B5A-41A7-A720-42D8FF38A915}.eml  1       0
'
'                          oMessage.ID    Created                 From                  To (list with ',')        Next try                Filename                                                        ??      #retries ??

   Done = False
   Do Until Done
      Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
      For Each Match in Matches
	     ID = Left(Match,InStr(Match," ")-12)
	     WScript.Echo "Match = " & Match
		 oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(ID)
		 oApp.GlobalObjects.DeliveryQueue.StartDelivery
      Next
      WScript.Sleep(10000)
   Loop

   WScript.Quit 0
It doesn't give a higher priority to any message (we don't believe that this can be done).
It does however get messages that have failed and are awaiting re-delivery to be processed NOW

You would need to find the messages that you want to attempt redelivery of - or more correctly remove from the queue, and process just those IDs

Use Remove(int iMessageID) instead of the ResetDeliveryTime(int iMessageID) to remove a particular ID from the queue
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 13:39

You stated

Code: Select all

It does however get messages that have failed and are awaiting re-delivery to be processed NOW
But that doesnt mean just failed, but anything in the queue correct? Is oApp.status.UndeliveredMessages items in the queue or failed items in the queue?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by mattg » 2019-05-08 14:00

cblaze22 wrote:
2019-05-08 13:39
But that doesnt mean just failed, but anything in the queue correct?
correct
cblaze22 wrote:
2019-05-08 13:39
Is oApp.status.UndeliveredMessages items in the queue or failed items in the queue?
Both

It is ALL items in the queue
But if you want a way to remove specific dud messages from the queue, this is the way to find them
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 15:18

I like this

Code: Select all

ID = Left(Match,InStr(Match," ")-12)
Can you explain how it works real quick. If I want to grab the .eml column, I assume that would work the same way.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-08 16:17

cblaze22 wrote:
2019-05-08 15:18
I like this

Code: Select all

ID = Left(Match,InStr(Match," ")-12)
Can you explain how it works real quick. If I want to grab the .eml column, I assume that would work the same way.
Hey Programmer !! Done that already for you in the thread about reading eml's from disk. And it works too...
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 16:27

I saw that nice job. So we know we can get messages in the queue, read the headers from them from disk. Then we know we can reset delivery time to send the email right away.

The last thing is where exactly should we put this code. Now I know you have a command window, which does a loop. I really dont want to have that unless I have too. I assume I could create that and have a Task Scheduler run it every 2 minutes.

My question is do you think there is a performance impact on this if there is 39,000 queue emails on HMailServer itself.

Also I assume there is NO other place in HMailServer where this code could live, CMD window outside of it is best place. Ive never done a VBScript stand alone, how do you run it within a command window? Just call the vbs file in the command window and it just runs?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-08 17:12

I believe this should do it... Try it out on a test system first and if it breaks something - Hey, I warned you!

Filename: queue.vbs

Code: Select all

Dim b, Match, Matches, oMail
Dim oApp : Set oApp = CreateObject( "hMailServer.Application" )
Call oApp.Authenticate( "Administrator", "BIG SECRET" )
Matches = Split( oApp.status.UndeliveredMessages, vbNewLine )
For Each Match in Matches
   b = Split( Match, vbTab )
   Set oMail = CreateObject( "hMailServer.Message" )
   strFilename = oMail.Filename
   With CreateObject( "Scripting.FileSystemObject" )
      .CopyFile b(5), strFilename, True
   End With
   oMail.RefreshContent
   If oMail.HeaderValue( "VIP" ) <> "" Then oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime( CInt( b(0) ) )
   Set oMail = Nothing
Next
oApp.GlobalObjects.DeliveryQueue.StartDelivery
Windows Scheduler:
Run: CScript C:\hMailServer\Events\queue.vbs
Start in: C:\hMailServer\Events <=== That's where I installed hMailServer, your path may be different!
RunAs: Administrator (on my system!)
Schedule: Daily
Start Time 00:00
[Advanced] Repeat task: 1 minutes, Duration: 24 hours.

If HeaderValue("VIP") is not blank (it exists) then mail is reset and moved to top of queue.

You can find and tag messages in e.g. OnAcceptMessage and use:

Code: Select all

If something Then
   oMessage.HeaderValue("VIP") = "YES"
   oMessage.Save
End If
All the code used here can be found in the forum if you search intelligently. All I have done is connect the dots.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-08 18:10

New version, no need to restart delivery if nobody is moved ...

Code: Select all

Dim b, Match, Matches, oMail, LiveVIP : LiveVIP = False
Dim oApp : Set oApp = CreateObject( "hMailServer.Application" )
Call oApp.Authenticate( "Administrator", "BIG SECRET" )
Matches = Split( oApp.status.UndeliveredMessages, vbNewLine )
For Each Match in Matches
   b = Split( Match, vbTab )
   Set oMail = CreateObject( "hMailServer.Message" )
   strFilename = oMail.Filename
   With CreateObject( "Scripting.FileSystemObject" )
      .CopyFile b(5), strFilename, True
   End With
   oMail.RefreshContent
   If oMail.HeaderValue( "VIP" ) <> "" Then
      oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime( CInt( b(0) ) )
      LiveVIP = True
   End If
   Set oMail = Nothing
Next
If LiveVIP Then oApp.GlobalObjects.DeliveryQueue.StartDelivery
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-08 21:30

Awesome Ill let you know how it goes. Anyway I can donate to your skills.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-09 05:42

Set up and will see how it works this weekend when loads of emails come in. Final code is below, needed CLng and updated header name. You said to put a value for StartIn in Task Scheduler. If nothing is in there would it hurt anything? I put my VBScript file is a customer folder and pointed the StartIn folder to that which contains my VBScript but I didnt know if you pointed to inside the HMailServer directory for any specific reason other then the Events folder that has the trigger VBScripts.

Code: Select all

Dim b, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)

For Each Match in Matches
   b = Split( Match, vbTab )
   Set oMail = CreateObject("hMailServer.Message")
   strFilename = oMail.Filename
   With CreateObject("Scripting.FileSystemObject")
      .CopyFile b(5), strFilename, True
   End With
   oMail.RefreshContent
   If oMail.HeaderValue("X-Priority") = "1" Then
      oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng( b(0)))
      Priority = True
   End If
   Set oMail = Nothing
Next
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-09 09:12

I hold all my hMailserver script/shell script code in the Events folder.

CInt (16bit) or CLng (32bit) dont care. It should really be LongLong (64bit) but VBScript is weird that way.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-10 02:51

I got a file not found error. Probably ran at the same time it was being deleted and the .eml was already deleted. I havent tested the code below, but do you believe its right?

The error shows in a pop up on the server and doesn’t run again. Is there a way to do try catch so it will run next minute? I dont know much about VBScript error handling, especially in a CMD window like this on how it should end. If there is an Error on anything the program should either continue or just stop. If they are in the match loop its probably best just to go to the next item. Any thoughts from your experience?

Code: Select all

Dim column, fso, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)

For Each Match in Matches
   column = Split( Match, vbTab )
   Set oMail = CreateObject("hMailServer.Message")
   strFilename = oMail.Filename
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.FileExists(column(5)) Then
   	fso.CopyFile column(5), strFilename, True
   
   	oMail.RefreshContent
   	If oMail.HeaderValue("X-Priority") = "1" Then
      		oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
      		Priority = True
   	End If
   End If
   Set oMail = Nothing
Next
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-10 03:34

My code seems to work. Would the code below be something to do with any type of error?

Code: Select all

On Error Resume Next

mikedibella
Senior user
Senior user
Posts: 837
Joined: 2016-12-08 02:21

Re: Move emails to top of the queue based on certain priority header flags

Post by mikedibella » 2019-05-10 03:38

I don't think this code will work.

I see the code is getting the stored message filename by parsing the UndeliveredMessages property, and that a Message object is created to parse the message.

This line:
Set oMail = CreateObject("hMailServer.Message")
Creates a new message object instance.

But this line:
strFilename = oMail.Filename
Assigns the filename for the new message to the strFilename variable. It does not load the the contents of the message in the queue to the instance. So the subsequent inspection is acting on an empty message. The header will never be found.

Forget using the Message object and just open the file and iterate lines. The RFC delimits the headers and body with a blank line, so you only have to read until you reach the first blank. For each line, look for the string "X-Priority: 1" and trigger the re-prioritization using the QueueID in the first field of the UndeliveredMessages tab-delimited line.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-10 06:21

I was skeptical of that line also, but my friend it does work and has long been working before my updated code.

Code: Select all

strFilename = oMail.Filename

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

Re: Move emails to top of the queue based on certain priority header flags

Post by mattg » 2019-05-10 06:55

doesn't the FSO.copyfile copy the file contents a couple of lines down
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
mattg
Moderator
Moderator
Posts: 22437
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Move emails to top of the queue based on certain priority header flags

Post by mattg » 2019-05-10 06:56

cblaze22 wrote:
2019-05-10 03:34
My code seems to work. Would the code below be something to do with any type of error?

Code: Select all

On Error Resume Next
That is VB for

If there is an error, then ignore it and just keep going
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
Dravion
Senior user
Senior user
Posts: 2071
Joined: 2015-09-26 11:50
Location: Germany
Contact:

Re: Move emails to top of the queue based on certain priority header flags

Post by Dravion » 2019-05-10 07:47

I think it all comes down to the DB-Field "messagenexttrytime" for delaying outgoing mails.

Code: Select all

UPDATE `hmailserver`.`hm_messages`
SET
	messagenexttrytime = '2019-05-10 08:03:59'
WHERE 
	messagefilename = '{C6C3D5C8-8820-4BE0-923B-CD4C02708AD8}.eml';    
If you run it via COM API Database Object, you can trigger it for example by incrementing messagenexttrytime (for example 33 Minutes, or any Dattime you want) after messagecreatetime.

PS: If you want to avoid instant delivery you can set all outgoing messages by messagelocked = 1, recalculate messagenexttrytime and unlock
the message.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-10 11:47

Dravion, that is food for thought ... Good point but very risky if you are not 112% certain of what you are doing! I am actually already using the COM DB object for updating a custom table in the hm database so maybe I should have a look at it.

The rest of you!

Windows can present multiple errors from accessing a file, "do not exist", "is locked", "file already exists" and what not...

This is using "On Error Resume Next" and proceeds ONLY if no error whatsoever.

Code: Select all

Dim column, oFSO, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

Set oFSO = CreateObject("Scripting.FileSystemObject")

Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
For Each Match in Matches
	column = Split( Match, vbTab )
	Set oMail = CreateObject("hMailServer.Message")
	strFilename = oMail.Filename
	On Error Resume Next ' Switch ON errorhandling (if NO error found)
	Err.Clear
	oFSO.CopyFile column(5), strFilename, True
	If Err.Number = 0 Then
		On Error Goto 0 ' Switch OFF errorhandling
		oMail.RefreshContent
		If oMail.HeaderValue("X-Priority") = "1" Then
			oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
			Priority = True
		End If
	Else
		On Error Goto 0 ' Switch OFF errorhandling (if error found)
	End If
	Set oMail = Nothing
Next

Set oFSO = Nothing
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery
Err.Number = ...
https://docs.microsoft.com/en-us/office ... ble-errors
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-10 12:11

mikedibella wrote:
2019-05-10 03:38
This line:
Set oMail = CreateObject("hMailServer.Message")
Creates a new message object instance.

But this line:
strFilename = oMail.Filename
Assigns the filename for the new message to the strFilename variable. It does not load the the contents of the message in the queue to the instance. So the subsequent inspection is acting on an empty message. The header will never be found.
You are missing this:
oMail.RefreshContent
The found message filename (column(5)) is copied to this new message filename (strFilename) and the command is simply repopulating ALL the message objects FROM FILE and thus you made a clone.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-10 15:18

Dravion wrote:
2019-05-10 07:47
I think it all comes down to the DB-Field "messagenexttrytime" for delaying outgoing mails.

Code: Select all

UPDATE `hmailserver`.`hm_messages`
SET
	messagenexttrytime = '2019-05-10 08:03:59'
WHERE 
	messagefilename = '{C6C3D5C8-8820-4BE0-923B-CD4C02708AD8}.eml';    
If you run it via COM API Database Object, you can trigger it for example by incrementing messagenexttrytime (for example 33 Minutes, or any Dattime you want) after messagecreatetime.

PS: If you want to avoid instant delivery you can set all outgoing messages by messagelocked = 1, recalculate messagenexttrytime and unlock
the message.
Well... Doesn't work :(

Code: Select all

Sub OnDeliverMessage(oMessage)
   If oMessage.FromAddress = "wile.e.coyote@acme.inc" Then
      Dim strSQL, oDB : Set oDB = GetDatabaseObject
      ' Strictly MySQL due to date handling.
      strSQL = "UPDATE hmailserver.hm_messages SET messagenexttrytime = DATE_ADD(NOW(), INTERVAL 1 HOUR) WHERE messagefilename = '" & oMessage.Filename & "';"
      Call oDB.ExecuteSQL(strSQL)
      Set oDB = Nothing
   End If
End Sub

Function GetDatabaseObject()
   Dim oApp : Set oApp = CreateObject("hMailServer.Application")
   Call oApp.Authenticate("Administrator", "VERY SECRET")
   Set GetDatabaseObject = oApp.Database
   Set oApp = Nothing
End Function
I had to create a fake non-existing SMTP relayer in order to keep the message on queue long enough to actually see it :wink:

I tried setting messagelocked = 1 ... did not stay in my system long enough for me to see it :mrgreen:

Using SQLyog to change messagenexttrytime manually works perfectly if you can delay the message long enough. If all goes well I have a message on queue until tomorrow 14:56:37 my time 8)
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

User avatar
Dravion
Senior user
Senior user
Posts: 2071
Joined: 2015-09-26 11:50
Location: Germany
Contact:

Re: Move emails to top of the queute based on certain priority header flags

Post by Dravion » 2019-05-10 15:32

Cool, good Job!

Maybe you can try to SQL insert a createdate in the future first and nexttrydate a bit longer than createdate?

I guess Createdate is the instant trigger which fires a new outgoing message right away because it is taken from the current Datetime if ithe message is qued via sql insert into hm_messages.

PS: Maybe you need to change createdate only and let hMailServer automaintain nexttrydate itself.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-10 15:33

Here is my most updated code. Big test this weekend to see how it works. Worried about pulling ALL messages while doing this. Again doing this in a trigger with the incoming message is so ideal.

Code: Select all

Dim column, fso, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)

For Each Match in Matches
   column = Split( Match, vbTab )
   Set oMail = CreateObject("hMailServer.Message")
   strFilename = oMail.Filename
   On Error Resume Next
   Err.Clear
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.FileExists(column(5)) Then
   	fso.CopyFile column(5), strFilename, True
   	If Err.Number = 0 Then
		On Error Goto 0
   		oMail.RefreshContent
   		If oMail.HeaderValue("X-Priority") = "1" Then
      			oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
      			Priority = True
   		End If
   	Else
   		On Error Goto 0
   	End If
   End If
   Set oMail = Nothing
Next

Set fso = Nothing
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

User avatar
Dravion
Senior user
Senior user
Posts: 2071
Joined: 2015-09-26 11:50
Location: Germany
Contact:

Re: Move emails to top of the queue based on certain priority header flags

Post by Dravion » 2019-05-10 15:42

Why do you compare this?
cblaze22 wrote:
2019-05-10 15:33
If oMail.HeaderValue("X-Priority") = "1"
Do you manipulate the Headers externaly so you can rely on it?

mikedibella
Senior user
Senior user
Posts: 837
Joined: 2016-12-08 02:21

Re: Move emails to top of the queue based on certain priority header flags

Post by mikedibella » 2019-05-10 15:53

I missed the FileCopy and RefreshContent methods being used as a work-around for the missing load-from-file method on the Message object.

I'd also suggest you run the code using the cscript.exe interpreter and not the default wscript.exe interpreter. As you've seen, wscript will throw a modal dialog on error and remain resident. Cscript writes errors to the console error device and terminates.

I'll offer a few edits for readability:

Code: Select all

Dim column, fso, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")
const QueueID = 0
const QueueFile = 5

QueueMessages = Split(oApp.status.UndeliveredMessages, vbNewLine)

For Each QueueRecord in QueueMessages
   QueueMessage = Split( QueueRecord, vbTab )
   Set oMail = CreateObject("hMailServer.Message")
   On Error Resume Next
   Err.Clear
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.FileExists(QueueMessage(QueueFile)) Then
   	fso.CopyFile QueueMessage(QueueFile), oMailFilename, True
   	If Err.Number = 0 Then
		On Error Goto 0
   		oMail.RefreshContent
   		If oMail.HeaderValue("X-Priority") = "1" Then
      			oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(QueueMessage(QueueID)))
      			Priority = True
   		End If
   	Else
   		On Error Goto 0
   	End If
   End If
   Set oMail = Nothing
Next

Set fso = Nothing
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-10 16:25

mikedibella wrote:
2019-05-10 15:53
I missed the FileCopy and RefreshContent methods being used as a work-around for the missing load-from-file method on the Message object.

I'd also suggest you run the code using the cscript.exe interpreter and not the default wscript.exe interpreter. As you've seen, wscript will throw a modal dialog on error and remain resident. Cscript writes errors to the console error device and terminates.

I'll offer a few edits for readability:

Code: Select all

Dim column, fso, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")
const QueueID = 0
const QueueFile = 5

QueueMessages = Split(oApp.status.UndeliveredMessages, vbNewLine)

...
...

Set fso = Nothing
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery
If you go back this thread you'll notice I specified cscript for windows scheduler. It's been taken care of.

Well... Use comments and do a description header. Comments are ignored by the interpretor when running the binary "compiled" code. This other way the code just gets longer and longer and longer to no use ... and there is NO garantee you'll have a clue what it does in 6 months anyways.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-12 02:42

Well its been a success. Had a log of 250 items, sent my priority email and got it within seconds. I always do. I thought this thing ran every minute, which I setup, but it seems its kinda instant, not sure why. In any case we have successfully moved items up the queue! Nice job guys!

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2019-05-12 03:44

Dravion wrote:
2019-05-10 15:42
Why do you compare this?
cblaze22 wrote:
2019-05-10 15:33
If oMail.HeaderValue("X-Priority") = "1"
Do you manipulate the Headers externaly so you can rely on it?
Yes I set this externally.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2019-05-12 10:49

cblaze22 wrote:
2019-05-12 02:42
Well its been a success. Had a log of 250 items, sent my priority email and got it within seconds. I always do. I thought this thing ran every minute, which I setup, but it seems its kinda instant, not sure why. In any case we have successfully moved items up the queue! Nice job guys!
You just got lucky and placed a message in the queue at the right time. Worst case scenario is 1 full minute - which is also the default for internal "autoreply" and "forward by rule".
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-04 02:25

I think the code below was creating orphan .eml files and ended up with 80GB of emails. Why are we doing a fake copy in this code?

Code: Select all

fso.CopyFile QueueMessage(QueueFile), oMailFilename, True

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

Re: Move emails to top of the queue based on certain priority header flags

Post by jimimaseye » 2020-03-04 09:53

Because you asked for something that hms doesnt do and someone offered a script with the warning that it is untested (ergo, might give problems).

I guess there is a lesson here.

The script doesn't do what you want. Perhaps you should abort it. (That said, the script is missing a delete after a copy. What is supposed to happen to the source email? )

[Entered by mobile. Excuse my spelling.]
5.7 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

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-04 16:27

I know all that, no lesson, it was obvious when I tried the script and the warning that was gave.

I am not well versed in VB, so if that copy function is creating a new file on the system, which I assume its doing, then wouldnt it then need to be deleted, or the source .eml would need to? I am just sending the email with a type of header value right away, but I am not sure if that is the original .eml or the copied .eml since I dont know VB or how hmailserver handles that situation.

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-04 18:11

Going back over "old" code can sometimes be challenging ;-)

Code: Select all

Set oMail = CreateObject("hMailServer.Message")
	strFilename = oMail.Filename
create a new blank email.

Code: Select all

	oFSO.CopyFile column(5), strFilename, True
copies the email in queue to the newly created email.

Code: Select all

		oMail.RefreshContent
reload the newly created email so it is a carbon-copy of the message in queue.

Code: Select all

		If oMail.HeaderValue("X-Priority") = "1" Then
			oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
			Priority = True
		End If
If the header "X-Priority" is "1" then reset delivery time for the queued email (column(0)).

Code: Select all

	Set oMail = Nothing
Close the object.

What strikes me is that allthough we do NOT do a oMessage.Save and simply closes the object, the line "oFSO.CopyFile column(5), strFilename, True" actually create a file that to the best of my knowledge should be deleted. If I am not mistaken then the variable "strFilename" should contain the filename to be deleted.

What actually goes on here is; We obtain the email object from the queue but are unable to READ the email. In order to read the email we have to copy it to a newly created blank email. Once copied we can examine the headers and if triggered we update the queue list with the original email with the next retry time for the original email.
The copy should ideally be deleted after usage.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-04 19:08

From my undertanding on your outline no NEW file is created on the server and no NEW mail message is inserted into the queue. It always works with the original .eml file?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-04 19:19

cblaze22 wrote:
2020-03-04 19:08
From my undertanding on your outline no NEW file is created on the server and no NEW mail message is inserted into the queue. It always works with the original .eml file?

Code: Select all

Set oMail = CreateObject("hMailServer.Message")
strFilename = oMail.Filename
This will create a new blank email with the filename in strFilename.
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-05 03:11

So it does create a physical file on the server? I know it creates a mail object with that name, but does it actually create the .eml file on the server? If so it never gets deleted does it?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by jimimaseye » 2020-03-05 09:55

I already answered that.
jimimaseye wrote:
2020-03-04 09:53
That said, the script is missing a delete after a copy. What is supposed to happen to the source email?
5.7 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

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-06 02:33

Ok so that is the issue. The source email is being retried from the line below I believe right away. So that is the original source.

Code: Select all

oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
What is the best way to now delete the copied .eml file then?

Code: Select all

fso.DeleteFile strFilename, True
This should be the full code with delete. Let me know if I have it in the right place and if I need to do any error checks.

Code: Select all

Dim column, fso, Match, Matches, oMail, Priority : Priority = False

Dim oApp : Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)

For Each Match in Matches
   column = Split( Match, vbTab )
   Set oMail = CreateObject("hMailServer.Message")
   strFilename = oMail.Filename
   On Error Resume Next
   Err.Clear
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.FileExists(column(5)) Then
   	fso.CopyFile column(5), strFilename, True
   	If Err.Number = 0 Then
		On Error Goto 0
   		oMail.RefreshContent
   		If oMail.HeaderValue("X-Priority") = "1" Then
      			oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
      			Priority = True
   		End If
   	Else
   		On Error Goto 0
   	End If
        fso.DeleteFile strFilename, True
   End If
   Set oMail = Nothing
Next

Set fso = Nothing
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-08 04:15

Any comments on my code? I know someone said the original code should delete the .eml file, but it doesnt so is my deletion the right way to do it?

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-08 15:05

Made a few changes and added some comments ;-)

Code: Select all

Dim oApp, oMail, oFSO, column, Match, Matches, Priority : Priority = False

'
'   Setting up DCOM access
'
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate("Administrator", "test")

'
'   Read queue list and process line by line
'
Matches = Split(oApp.status.UndeliveredMessages, vbNewLine)
For Each Match In Matches
    column = Split( Match, vbTab )
    
    '
    '   Create new temporary email structure and obtain filename
    '
    Set oMail = CreateObject("hMailServer.Message")
    strFilename = oMail.Filename
    
    '
    '   Copy original queued mail into temporary mail structure
    '
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(column(5)) Then
        Err.Clear
        On Error Resume Next
        oFSO.CopyFile column(5), strFilename, True
        On Error GoTo 0
        If Err.Number = 0 Then
            
            '
            '   Reload temporary mail structure and IF "X-Priority" = 1 THEN update priority in queue
            '
            oMail.RefreshContent
            If oMail.HeaderValue("X-Priority") = "1" Then
                oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
                Priority = True
            End If
            
            '
            '   Delete temporary mail structure
            '
            oFSO.DeleteFile strFilename, True
        End If
    End If
Next

'
'   Force delivery of prioritized mails.
'
If Priority Then oApp.GlobalObjects.DeliveryQueue.StartDelivery

'
'   Housekeeping ;-)
'
Set oApp = Nothing
Set oMail = Nothing
Set oFSO = Nothing
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-09 02:18

Ok Ill let you guys know how it goes.

cblaze22
Normal user
Normal user
Posts: 203
Joined: 2011-08-30 20:16

Re: Move emails to top of the queue based on certain priority header flags

Post by cblaze22 » 2020-03-14 01:44

Kind of odd but I got a File Not Found message at the line below. I am going to check first if it exists before deletion. I did have an orphan .eml, which was probably the one that didnt get deleted but I am not sure why it didnt find it when the file name should be the same.

Code: Select all

 oFSO.DeleteFile strFilename, True
New code

Code: Select all

 If oFSO.FileExists(strFilename) Then
 		Err.Clear
            	oFSO.DeleteFile strFilename, True
	    End If
On another note, should I close the oFSO before deleting it?

Code: Select all

oFSO.close

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

Re: Move emails to top of the queue based on certain priority header flags

Post by SorenR » 2020-03-14 08:23

There is no reason to close something that has not been opened...

Is everything else working as expected with the new changes?
SørenR.

Woke is Marxism advancing through Maoist cultural revolution.

Post Reply