Debug script - open smtp session increase

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
Post Reply
thierry_b
New user
New user
Posts: 19
Joined: 2021-05-12 11:00

Debug script - open smtp session increase

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

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

Re: Debug script - open smtp session increase

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

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

Re: Debug script - open smtp session increase

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.

Algorithm (noun.)
Word used by programmers when they do not want to explain what they did.

thierry_b
New user
New user
Posts: 19
Joined: 2021-05-12 11:00

Re: Debug script - open smtp session increase

Post by thierry_b » 2021-06-24 23:06

Thanks for your reply
I will look at this !

Best Regards
Thierry

Post Reply