Move emails to top of the queue based on certain priority header flags
Move emails to top of the queue based on certain priority header flags
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?
Where is the best place to do this with scripting and is there anyone we can hire to do this for us?
- jimimaseye
- Moderator
- Posts: 10060
- Joined: 2011-09-08 17:48
Re: Move emails to top of the queue based on certain priority header flags
You can't. Not by any method.
[Entered by mobile. Excuse my spelling.]
[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
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829
Re: Move emails to top of the queue based on certain priority header flags
Work with me here. The message below, is it executed before it gets into the queue?
If so how is the queue sorted and how does the "send now" button work in the queue to make emails go right away?
Code: Select all
OnAcceptMessage(oClient as hMailServer.Client, oMessage as hMailServer.Message)
Re: Move emails to top of the queue based on certain priority header flags
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.
Interesting project ... It just may be possible to script such an event
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);
}
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
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?
Re: Move emails to top of the queue based on certain priority header flags
OnDeliverMessage is when it is placed into the queue.cblaze22 wrote: ↑2019-05-07 13:31Ok 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?
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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);
Re: Move emails to top of the queue based on certain priority header flags
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?cblaze22 wrote: ↑2019-05-07 16:15Ok 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);
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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.
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.
Re: Move emails to top of the queue based on certain priority header flags
The Admin code is C# and uses the COM API... You would know that already as a programmer.cblaze22 wrote: ↑2019-05-07 17:07Im 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.
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
Re: Move emails to top of the queue based on certain priority header flags
Just mocking something together... This should list the content of the delivery queue.
VBScript stand-alone script to test on server in CMD window.
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
Well that is neat, but where do you think the best place to call this?
Re: Move emails to top of the queue based on certain priority header flags
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
So you cant run that say on OnAcceptMessage as a polling strategy?
Re: Move emails to top of the queue based on certain priority header flags
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.
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
Re: Move emails to top of the queue based on certain priority header flags
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
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
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 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
https://www.hmailserver.com/documentation
Re: Move emails to top of the queue based on certain priority header flags
You stated
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?
Code: Select all
It does however get messages that have failed and are awaiting re-delivery to be processed NOW
Re: Move emails to top of the queue based on certain priority header flags
correct
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
https://www.hmailserver.com/documentation
Re: Move emails to top of the queue based on certain priority header flags
I like this
Can you explain how it works real quick. If I want to grab the .eml column, I assume that would work the same way.
Code: Select all
ID = Left(Match,InStr(Match," ")-12)
Re: Move emails to top of the queue based on certain priority header flags
Hey Programmer !! Done that already for you in the thread about reading eml's from disk. And it works too...cblaze22 wrote: ↑2019-05-08 15:18I like this
Can you explain how it works real quick. If I want to grab the .eml column, I assume that would work the same way.Code: Select all
ID = Left(Match,InStr(Match," ")-12)
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
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?
Re: Move emails to top of the queue based on certain priority header flags
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
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:
All the code used here can be found in the forum if you search intelligently. All I have done is connect the dots.
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
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
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
Awesome Ill let you know how it goes. Anyway I can donate to your skills.
Re: Move emails to top of the queue based on certain priority header flags
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
Re: Move emails to top of the queue based on certain priority header flags
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.
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
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
Re: Move emails to top of the queue based on certain priority header flags
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
-
- Senior user
- Posts: 837
- Joined: 2016-12-08 02:21
Re: Move emails to top of the queue based on certain priority header flags
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:
But this line:
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.
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:
Creates a new message object instance.Set oMail = CreateObject("hMailServer.Message")
But this line:
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.strFilename = oMail.Filename
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.
Re: Move emails to top of the queue based on certain priority header flags
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
Re: Move emails to top of the queue based on certain priority header flags
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
https://www.hmailserver.com/documentation
Re: Move emails to top of the queue based on certain priority header flags
That is VB forcblaze22 wrote: ↑2019-05-10 03:34My code seems to work. Would the code below be something to do with any type of error?
Code: Select all
On Error Resume Next
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
https://www.hmailserver.com/documentation
Re: Move emails to top of the queue based on certain priority header flags
I think it all comes down to the DB-Field "messagenexttrytime" for delaying outgoing mails.
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.
Code: Select all
UPDATE `hmailserver`.`hm_messages`
SET
messagenexttrytime = '2019-05-10 08:03:59'
WHERE
messagefilename = '{C6C3D5C8-8820-4BE0-923B-CD4C02708AD8}.eml';
PS: If you want to avoid instant delivery you can set all outgoing messages by messagelocked = 1, recalculate messagenexttrytime and unlock
the message.
Re: Move emails to top of the queue based on certain priority header flags
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.
Err.Number = ...
https://docs.microsoft.com/en-us/office ... ble-errors
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
https://docs.microsoft.com/en-us/office ... ble-errors
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
You are missing this:mikedibella wrote: ↑2019-05-10 03:38This line:
Creates a new message object instance.Set oMail = CreateObject("hMailServer.Message")
But this line:
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.strFilename = oMail.Filename
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.oMail.RefreshContent
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
Well... Doesn't workDravion wrote: ↑2019-05-10 07:47I think it all comes down to the DB-Field "messagenexttrytime" for delaying outgoing mails.
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.Code: Select all
UPDATE `hmailserver`.`hm_messages` SET messagenexttrytime = '2019-05-10 08:03:59' WHERE messagefilename = '{C6C3D5C8-8820-4BE0-923B-CD4C02708AD8}.eml';
PS: If you want to avoid instant delivery you can set all outgoing messages by messagelocked = 1, recalculate messagenexttrytime and unlock
the message.
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 tried setting messagelocked = 1 ... did not stay in my system long enough for me to see it
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
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queute based on certain priority header flags
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.
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.
Re: Move emails to top of the queue based on certain priority header flags
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
-
- Senior user
- Posts: 837
- Joined: 2016-12-08 02:21
Re: Move emails to top of the queue based on certain priority header flags
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:
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
Re: Move emails to top of the queue based on certain priority header flags
If you go back this thread you'll notice I specified cscript for windows scheduler. It's been taken care of.mikedibella wrote: ↑2019-05-10 15:53I 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
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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!
Re: Move emails to top of the queue based on certain priority header flags
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".cblaze22 wrote: ↑2019-05-12 02:42Well 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!
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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
- jimimaseye
- Moderator
- Posts: 10060
- Joined: 2011-09-08 17:48
Re: Move emails to top of the queue based on certain priority header flags
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.]
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
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829
Re: Move emails to top of the queue based on certain priority header flags
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.
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.
Re: Move emails to top of the queue based on certain priority header flags
Going back over "old" code can sometimes be challenging
create a new blank email.
copies the email in queue to the newly created email.
reload the newly created email so it is a carbon-copy of the message in queue.
If the header "X-Priority" is "1" then reset delivery time for the queued email (column(0)).
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.
Code: Select all
Set oMail = CreateObject("hMailServer.Message")
strFilename = oMail.Filename
Code: Select all
oFSO.CopyFile column(5), strFilename, True
Code: Select all
oMail.RefreshContent
Code: Select all
If oMail.HeaderValue("X-Priority") = "1" Then
oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
Priority = True
End If
Code: Select all
Set oMail = Nothing
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
Re: Move emails to top of the queue based on certain priority header flags
Code: Select all
Set oMail = CreateObject("hMailServer.Message")
strFilename = oMail.Filename
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
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?
- jimimaseye
- Moderator
- Posts: 10060
- Joined: 2011-09-08 17:48
Re: Move emails to top of the queue based on certain priority header flags
I already answered that.
jimimaseye wrote: ↑2020-03-04 09:53That 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
SpamassassinForWindows 3.4.0 spamd service
AV: Clamwin + Clamd service + sanesecurity defs : https://www.hmailserver.com/forum/viewtopic.php?f=21&t=26829
Re: Move emails to top of the queue based on certain priority header flags
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.
What is the best way to now delete the copied .eml file then?
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
oApp.GlobalObjects.DeliveryQueue.ResetDeliveryTime(CLng(column(0)))
Code: Select all
fso.DeleteFile strFilename, True
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
Re: Move emails to top of the queue based on certain priority header flags
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?
Re: Move emails to top of the queue based on certain priority header flags
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.
Woke is Marxism advancing through Maoist cultural revolution.
Re: Move emails to top of the queue based on certain priority header flags
Ok Ill let you guys know how it goes.
Re: Move emails to top of the queue based on certain priority header flags
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.
New code
On another note, should I close the oFSO before deleting it?
Code: Select all
oFSO.DeleteFile strFilename, True
Code: Select all
If oFSO.FileExists(strFilename) Then
Err.Clear
oFSO.DeleteFile strFilename, True
End If
Code: Select all
oFSO.close
Re: Move emails to top of the queue based on certain priority header flags
There is no reason to close something that has not been opened...
Is everything else working as expected with the new changes?
Is everything else working as expected with the new changes?
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
Woke is Marxism advancing through Maoist cultural revolution.