Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
-
thierry_b
- Normal user
- Posts: 45
- Joined: 2021-05-12 11:00
Post
by thierry_b » 2021-06-23 18:43
Hello,
First of all I apologize for my bad English.
Below, my script which aims to automatically download pdf files based on urls found in emails
The problem is that the number of open smtp sessions is constantly increasing (3-4 per hour).
I'm sure the problem stems from this procedure. If I block it, no problem with a smtp session:
Code: Select all
Function DownloadURL(oMessage, sFileURL, sLocation)
' Télécharge un fichier sur base d'une URL SFileURL
Dim objXMLHTTP, objADOStream, objFSO
DownloadURL = False
'create xmlhttp object
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
On Error Resume Next
'get the remote file
objXMLHTTP.open "GET", sFileURL, False
'send the request
objXMLHTTP.send()
On Error Resume Next
'wait until the data has downloaded successfully
do until objXMLHTTP.Status = 200 : Delay(1) : loop
'if the data has downloaded sucessfully
If objXMLHTTP.Status = 200 Then
On Error Resume Next
'create binary stream object
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
'adTypeBinary
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
'Set the stream position to the start
objADOStream.Position = 0
'create file system object to allow the script to check for an existing file
Set objFSO = Createobject("Scripting.FileSystemObject")
'check if the file exists, if it exists then delete it
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
'destroy file system object
Set objFSO = Nothing
' Vérifie si l'objet chargé est bien un fichier PDF
If IsPdfDownloaded(objADOStream) = True Then
DownloadURL = True
' Sauvegarde le fichier sur le serveur Mail
objADOStream.SaveToFile sLocation
' Sauvegarde le fichier en pièce jointe
oMessage.Attachments.Add(sLocation)
End If
'close the ado stream
objADOStream.Close
'destroy the ado stream object
Set objADOStream = Nothing
'end object downloaded successfully "doctype html"
End if
Set objXMLHTTP = Nothing
End Function
-
mattg
- Moderator
- Posts: 22437
- Joined: 2007-06-14 05:12
- Location: 'The Outback' Australia
Post
by mattg » 2021-06-24 01:00
I'd guess that your download script doesn't time out
Perhaps remove the error bypass, and see what happens then
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation
-
SorenR
- Senior user
- Posts: 6315
- Joined: 2006-08-21 15:38
- Location: Denmark
Post
by SorenR » 2021-06-24 12:37
thierry_b wrote: ↑2021-06-23 18:43
Hello,
First of all I apologize for my bad English.
Below, my script which aims to automatically download pdf files based on urls found in emails
The problem is that the number of open smtp sessions is constantly increasing (3-4 per hour).
I'm sure the problem stems from this procedure. If I block it, no problem with a smtp session:
Your script reads the entire file into memory ... Not good! You will allocate a lot of RAM this way.
I have put this together from bits I use in my scripts [
WARNING: UNTESTED] and it shows a different strategy with a few rough failsafes...
Code: Select all
' How to use:
'
' Dim Test
' Test = DownloadURL(oMessage, "https://url.to.file/filename", "c:\tempdir")
' If Test = True Then ....
' Else ....
Function DownloadURL(oMessage, sFileURL, sLocation) : DownloadURL = False
'
' Using CURL - https://curl.se/download.html
'
Const EXECRUN = 0
Const EXECDONE = 1
Const EXECFAIL = 2
On Error Resume Next
Err.Clear
Dim a, sFileName
a = Split(sFileURL, "/")
sFileName = a(ubound(a))
If sFileName = "" Then Exit Function
Dim oShell : Set oShell = CreateObject("WScript.Shell")
Dim oExec : Set oExec = oShell.Exec("curl --output " sLocation & "\" & sFileName & " " & sFileURL)
While oExec.Status = EXECRUN
With CreateObject("WScript.Shell")
.Run "powershell Start-Sleep -Milliseconds 1000", 0, True
End With
Wend
Select Case oExec.Status
Case EXECDONE
oMessage.Attachments.Add(sLocation & "\" & sFileName)
With CreateObject("Scripting.FileSystemObject")
.DeleteFile sLocation & "\" & sFileName
If Err.number > 0 Then Exit Function
End With
DownloadURL = True
Case Else
DownloadURL = False
End Select
Set oShell = Nothing
Set oExec = Nothing
On Error GoTo 0
End Function
SørenR.
Woke is Marxism advancing through Maoist cultural revolution.
-
thierry_b
- Normal user
- Posts: 45
- Joined: 2021-05-12 11:00
Post
by thierry_b » 2021-06-24 23:06
Thanks for your reply
I will look at this !
Best Regards
Thierry