Option Explicit

' (SS,2/9/12) added ProcessWorldPayCallbackFailure, GetAttachmentAsString, GetURL
' removed GetWebPageContents, also added SetLogFileName
' logs now saved in "D:\logs\hMailServer Events\" instead of "D:\hMailServer\Logs\eventlog.txt"
' Also added Option Explicit

' (SS,23/12/14) added Sub ProcessSpamDeletion (global rule: Spam Deletion)

' (SS,20/09/17) added Sub ProcessTransferWisePayment (hyperflight rule for transferwise emails)
' (SS,26/09/17) amended to removed oMessage.HTMLBody from email sent in Sub ProcessTransferWisePayment
' (SS,13/10/17) added removal of comma from amount in Sub ProcessTransferWisePayment
' (SS,27/10/17) added alert to Sub ProcessTransferWisePayment to mark email as alert if payment couldn't be assigned to an order
' (SS,21/10/20) Change to Sub ProcessTransferWisePayment due to slight change in format, i.e. "Amount:" changed to "Amount received:"


'   Sub OnClientConnect(oClient)
'   End Sub

'   Sub OnAcceptMessage(oClient, oMessage)
'   End Sub

'   Sub OnDeliveryStart(oMessage)
'   End Sub

'   Sub OnDeliverMessage(oMessage)
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub

'   Sub OnError(iSeverity, iCode, sSource, sDescription)
'   End Sub

'   Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
'   End Sub

'   Sub OnExternalAccountDownload(oMessage, sRemoteUID)
'   End Sub

' (SS,2/9/12)
Const LOG_FOLDER = "D:\logs\hMailServer Events\"
Dim NL
NL = Chr(13) + Chr(10)
Dim FLogFileName, FLogText
SetLogFileName "log.txt"
FLogText = ""

' (SS,5/10/07)
Sub ProcessGoogleCheckout(oMessage)

  SetLogFileName "google-checkouts.txt" ' (SS,2/9/12)
  
	' (SS,25/2/09) modified hmailserver rules to check for noreply@checkout.google.com in From address
	' previously was "Purchase Receipt for Order" in subject

	AddLog ""
  ' (SS,24/10/08) added & oMessage.To to show which email address / site
  AddLog "1. ProcessGoogleCheckout called for " & oMessage.To
  Dim NL
  NL = Chr(13) + Chr(10)

 ' (SS,22/11/07) removed following check, wasn't working
 ' check email is from noreply@checkout.google.com i.e. in oMessage.FromAddress
  'If oMessage.FromAddress <> "noreply@checkout.google.com" Then
 '   AddLog "1.1 Process aborted, reply email doesn't match noreply@checkout.google.com"
 '   Exit Sub
 ' End If
  
  AddLog "2. Email from " & oMessage.FromAddress
  
  ' check subject contains with "Purchase Receipt for Order"
  ' (SS,25/2/09) removed subject check because it on longer contains 'Purchase Receipt for Order'
  'If InStr(1, oMessage.Subject, "Purchase Receipt for Order", 1) = 0 Then
  '  AddLog "2.1 Process aborted, subject doesn't contain 'Purchase Receipt for Order'"
  '  Exit Sub
  'End If
  
  'AddLog "3. Email subject contains Purchase Receipt for Order"

  Dim LPos, LDomain, LCallbackURL, LGoogleOrderNo, LOrderNo, LBuyer, LTotal, LEmailSubject, LBody
   
  ' NB. oMessage.Body has HTML tags removed
  LGoogleOrderNo = Trim(GetString(oMessage.Subject,"Purchase Receipt for Order #", "", "A"))
  ' (SS,25/2/09) replaced above with following because subject now contains just the number
  ' (SS,16/3/09) now copes with both cases, because Google reverted back to previous template
  If LGoogleOrderNo = "" Then
  	LGoogleOrderNo = Trim(oMessage.Subject)
  End If
  
  ' (SS,16/3/09) added following to show google order no in log
  AddLog "3. Email subject contains Google Order No: " & LGoogleOrderNo
  
  ' (SS,25/2/09) added following to convert newlines (0D & 0A) to spaces, the original email must be encoded 
  ' the word Order No was being split across two lines, line ending "..Order" and next line starting with "No.."
  LBody = ConvertNewlineToSpaces(oMessage.Body)
  
  LOrderNo = Trim(GetString(LBody, "Order No GC#", " ", "A"))  
  ' body must contain "Order No GC#"
  If LOrderNo = "" Then
  	AddLog "3.1 Process aborted, order no missing"
  	Exit Sub 
 	End If
	
	' (SS,25/2/09) added following to detect cancellation email 	
 	If InStr(1, LBody, "Order cancelled", 1) > 0 Then
  	AddLog "3.2 Process aborted, order was cancelled"
  	Exit Sub  		
	End If
  
  AddLog "4. Order Number is " & LOrderNo
  
  ' (SS,25/2/09) replaced all oMessage.Body with LBody, removed NL replaced with " "
  LBuyer = Trim(GetString(LBody, " has just completed a", " ", "B"))
  LTotal = Trim(GetString(LBody, " Total: ", " ", "A"))
  LTotal = Trim(Replace(LTotal, "=C2=A3", "")) ' remove unicode pound
  ' remove characters after and including the space
  LPos = InStr(1, LTotal, " ", 1)
  If LPos > 0 Then LTotal = Mid(LTotal, 1, LPos - 1)

  LDomain = Trim(GetString(oMessage.To, "@", ">", "A")) 
  LCallbackURL = "http://www." & LDomain & "/googlecheckout-callback.asp"
  
  Dim LPostData
  LPostData = ""
  LPostData = AddPostData(LPostData, "OrderNo", LOrderNo)
  LPostData = AddPostData(LPostData, "GoogleOrderNo", LGoogleOrderNo)
  LPostData = AddPostData(LPostData, "Buyer", LBuyer)
  LPostData = AddPostData(LPostData, "Total", LTotal)
  LPostData = AddPostData(LPostData, "EmailSubject", oMessage.Subject)
  LPostData = AddPostData(LPostData, "EmailContents", oMessage.Body)
  
  LBody = ""  
  LBody = LBody + "OrderNo = " & LOrderNo & NL	
  LBody = LBody + "GoogleOrderNo = " & LGoogleOrderNo & NL 
  LBody = LBody + "Buyer = " & LBuyer & NL
  LBody = LBody + "Total = " & LTotal & NL
  LBody = LBody + "To Address = " & oMessage.To & NL
  LBody = LBody + "From Address = " & oMessage.FromAddress & NL
  LBody = LBody + "Subject = " & oMessage.Subject & NL
  LBody = LBody + "CallbackURL = " & LCallbackURL & NL  
  LBody = LBody + "Email Content = " & oMessage.Body & NL  
  ' (SS,2/9/12) replaced GetWebPageContents(LCallbackURL, LPostData) with GetURL(LCallbackURL & "?" & LPostData)
  LBody = LBody + "Callback Content = " & GetURL(LCallbackURL & "?" & LPostData)  
  
  AddLog "5. Callback executed: " & LCallbackURLBody & " - " & LPostData

  ' send the new email message
  Dim oNewMessage 
  Set oNewMessage = CreateObject("hMailServer.Message")
  oNewMessage.From = "hMailServer (Google Checkout Event)"
  oNewMessage.FromAddress = "googlecheckout@itpartnership.com" 
  oNewMessage.Subject = "Google Checkout Payment Received for Order " & LOrderNo
  oNewMessage.AddRecipient "", oMessage.To
  oNewMessage.Body = LBody  
  oNewMessage.Save 
  Set oNewMessage = Nothing
  
  AddLog "6. Email sent"
  AddLog "7. ProcessGoogleCheckout completed"
End Sub

' (SS,2/9/12)
Sub ProcessWorldPayCallbackFailure(oMessage)
  SetLogFileName "worldpay-callback-failures.txt"
  
	AddLog ""
  AddLog "1. ProcessWorldPayCallbackFailure"
  AddLog "2. Email to " & oMessage.To  
  AddLog "3. Email from " & oMessage.FromAddress
  
  Dim LTransactionID, LCartID, LInstallationID, LCallbackURL
   
  ' NB. oMessage.Body has HTML tags removed
  LTransactionID = Trim(GetString(oMessage.Body, "Transaction ID: ", NL, "A"))
  LCartID = Trim(GetString(oMessage.Body, "Cart ID: ", NL, "A"))  
  LInstallationID = Trim(GetString(oMessage.Body, "Installation ID: ", NL, "A"))
  LCallbackURL = Trim(GetString(oMessage.Body, "Callback to: ", ": ", "A"))
  
  ' (SS,16/3/09) added following to show values in log
  AddLog "4. Transaction ID: " & LTransactionID
  AddLog "5. Cart ID: " & LCartID  
  AddLog "6. Installation ID: " & LInstallationID
  AddLog "7. Callback URL: " & LCallbackURL
  
  Dim LHost, LQueryString
  LHost = ""
  LQueryString = "" 
  If oMessage.Attachments.Count > 0 Then
    Dim LAttachmentString
    LAttachmentString = GetAttachmentAsString(oMessage.Attachments.Item(0))           
    AddLog "8.1 Attachment found: " &  oMessage.Attachments.Item(0).Filename
    LHost = Trim(GetString(LAttachmentString, "Host: ", NL, "A"))
    LQueryString = Trim(GetString(LAttachmentString, NL & NL, "", "A")) ' everything after two new lines
  End if
  AddLog "8.2 Host from attachment: " &  LHost
  AddLog "8.3 Query String from attachment: " &  LQueryString
  If LCallbackURL <> "" And LQueryString <> "" Then
    AddLog "8.4 Attempting callback to: " & LCallbackURL & "?" & LQueryString
    AddLog "8.5 Callback response = " & GetURL(LCallbackURL & "?" & LQueryString)
  Else
    AddLog "8.4 Nothing to do"
  End If
   
  ' send email message with log
  Dim oNewMessage 
  Set oNewMessage = CreateObject("hMailServer.Message")
  oNewMessage.From = "hMailServer (WorldPay Callback Failure Handler)"
  oNewMessage.FromAddress = "worldpaycallbackfailure@itpartnership.com" 
  oNewMessage.Subject = "WorldPay Callback Failure Handled for " & LHost & " Order " & LCartID
  oNewMessage.AddRecipient "", "purchases@itpartnership.com" 'oMessage.To
  oNewMessage.Body = FLogText  
  oNewMessage.Save 
  Set oNewMessage = Nothing
  
  AddLog "8. Email sent"
  AddLog "9. ProcessWorldPayCallbackFailure completed"
End Sub


' (SS,5/10/07) returns part of given string after given string ending at given string
' ADirection can be "A" for after, "B" for before
' e.g. GetString("abc def ghi", "def", "h", "A") returns " g"
' e.g. GetString("abcd def ghi", "def", "bc", "B") returns "d "
' StrComp used for Text comparison to work with unicode strings
Function GetString(ASearchIn, ASearchFor, AEndsWith, ADirection)

  Dim LStr, LPos, i, LLenSearchIn, LLenSearchFor, LLenEndsWith
  LStr = ""
  LPos = InStr(1, ASearchIn, ASearchFor, 1)
  If LPos > 0 Then
    LLenSearchIn = Len(ASearchIn)
    LLenSearchFor = Len(ASearchFor)
    LLenEndsWith = Len(AEndsWith)
    If ADirection = "A" Then
      LPos = LPos + LLenSearchFor
      For i = LPos To LLenSearchIn
        If LLenEndsWith <> 0 And StrComp(Mid(ASearchIn, i, LLenEndsWith), AEndsWith, 1) = 0 Then
          Exit For
        End If
        LStr = LStr + Mid(ASearchIn, i, 1)
      Next
    Else
      LPos = LPos - 1
      For i = LPos To 1 Step -1
        If LLenEndsWith <> 0 Then
          If i - LLenEndsWith + 1 > 0 Then
            If StrComp(Mid(ASearchIn, i - LLenEndsWith + 1, LLenEndsWith), AEndsWith, 1) = 0 Then
              Exit For
            End If
          End If
        End If
        LStr = Mid(ASearchIn, i, 1) + LStr
      Next
    End If
  End If
  
  ' (SS,25/2/09) added following to help with debugging
  ' (SS,2/9/12) removed debugged
  'AddLog "GetString called with ASearchIn=" & ASearchIn & ", ASearchFor=" & ASearchFor & ", AEndsWith=" & AEndsWith & ", ADirection=" & ADirection
  'AddLog "GetString returned " & LStr & ", LPos=" & LPos

  GetString = LStr
End Function

' (SS,25/2/09)
Function ConvertNewlineToSpaces(AString)
	ConvertNewlineToSpaces = Replace(AString, Chr(13) + Chr(10), " ")
End Function

' (SS,5/10/07)
Function AddPostData(APostData, AFieldName, AFieldValue)
  Dim LPostData
  LPostData = APostData
  If LPostData <> "" Then LPostData = LPostData & "&"
  LPostData = LPostData & AFieldName & "=" & URLEncode(AFieldValue)
  AddPostData = LPostData
End Function

' (SS/2/9/12) returns contents of given URL, used to send HTML emails, AURL can contain querystring
Function GetURL(AURL)
  Dim LResult, LHttp
  LResult = ""
  Set LHttp = CreateObject("Msxml2.ServerXMLHTTP.3.0")
  LHttp.open "GET", AURL, False
  LHttp.send
  If LHttp.status <> 200 then
    LResult = "Error: " & LHttp.status
  Else
    LResult = LHttp.responseText
  End If
  GetURL = LResult
End Function

' (SS,5/10/07) Server.URLEncode doesn't work here (only in for ASP)
' modified to work with scripts (i.e. removed variable types and error handling code)
'**************************************
' Name: URLEncode Function
' Description:Encodes a string to create
'     legally formatted
'QueryString For URL. This Function is more flexible 
'than the IIS Server.Encode Function because you can 
'pass In the WHOLE URL and only the QueryString data 
'will be converted. IIS strangely converts EVERYTHING 
'(ie "http://" becomes "http%3A%2F%2F").
' By: Markus Diersbock
'
' Inputs:sRawURL - String to Encode
'
' Returns:Encoded String
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=43806&lngWId=1'for details.'**************************************

Function URLEncode(sRawURL)
    Dim iLoop
    Dim sRtn
    Dim sTmp
    Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz:/.?=_-$(){}~&"


    If Len(sRawURL) > 0 Then
        ' Loop through each char


        For iLoop = 1 To Len(sRawURL)
            sTmp = Mid(sRawURL, iLoop, 1)


            If InStr(1, sValidChars, sTmp, vbBinaryCompare) = 0 Then
                ' If not ValidChar, convert to HEX and p
                '     refix with %
                sTmp = Hex(Asc(sTmp))


                If sTmp = "20" Then
                    sTmp = "+"
                ElseIf Len(sTmp) = 1 Then
                    sTmp = "%0" & sTmp
                Else
                    sTmp = "%" & sTmp
                End If
            End If
            sRtn = sRtn & sTmp
        Next
        URLEncode = sRtn
    End If

End Function

Sub SetLogFileName(AFileName)
  FLogFileName = LOG_FOLDER + AFileName
End Sub

' (SS,22/11/07)
Sub AddLog(AMessage)
	Dim fs, f
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set f = fs.OpenTextFile(FLogFileName, 8, True)
	f.WriteLine(Now & " - " & AMessage)
	f.Close
	Set f = Nothing
	Set fs = Nothing
  ' add to log text, which may be used in email
  If AMessage <> "" Then FLogText = FLogText & Now & " - " & AMessage & NL
End Sub

' (SS,2/9/12) return contents of attachment as string, it has to be saved as file first
Function GetAttachmentAsString(AAttachment)
  ' save to file
  Dim LFileName
  LFileName = LOG_FOLDER + AAttachment.Filename
  AAttachment.SaveAs(LFileName)

  ' read from file into string
	Dim fs, f
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set f = fs.OpenTextFile(LFileName, 1)
	GetAttachmentAsString = f.ReadAll
	f.Close
	Set f = Nothing
	Set fs = Nothing
End Function

' (SS,23/12/14) logs from and to address of the spam email, subject and name of the attached file (added to a Rule via function)
Sub ProcessSpamDeletion(oMessage)
  SetLogFileName "spam-deletion.txt"
  
  Dim LAttachmentFilename
  If oMessage.Attachments.Count > 0 Then        
    LAttachmentFilename = oMessage.Attachments.Item(0).Filename
  Else
    LAttachmentFilename = ""
  End if

  AddLog "ProcessSpamDeletion, " & oMessage.To & ", " & oMessage.FromAddress & ", " & oMessage.Subject & ", " & LAttachmentFilename
End Sub

' (SS,19/9/19) return contents of given file name as a string
' using this to send a test HTML email from a file (forwarding from Outlook messes up the HTML)
Function GetFileAsString(AFileName)
  ' read from file into string
	Dim fs, f
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set f = fs.OpenTextFile(AFileName, 1)
	GetFileAsString = f.ReadAll
	f.Close
	Set f = Nothing
	Set fs = Nothing
End Function

' (SS,20/9/19) writes given string to given file name
Function SaveStringAsFile(AString, AFileName)
	Dim fs, f
	Set fs = CreateObject("Scripting.FileSystemObject")
  Set f = fs.OpenTextFile(AFileName, 2, True)
	f.Write AString
	f.Close
	Set f = Nothing
	Set fs = Nothing  
End Function


'------------------------------------------
' Following functions TrimAll, TrimChar, TrimChars and NB; moved here from dbfunctions.asp, need TrimAll
' (SS,4/6/07) the ASP Trim function only removes leading and trailing spaces
' created TrimAll which removes spaces and control characters (i.e. the same as Delphi's Trim)
' this was required because at times I also want to remove newlines and carriage returns characters
' if string is null then it's converted to a blank string ""
' (SS,23/6/09) code moved to TrimChars which handles a range of chars
' this routine now calls TrimChars for characters between 0 and 32
Function TrimAll(AString)
  TrimAll = TrimChars(AString, Chr(0), Chr(32))
End Function

' (SS,23/6/09) trims given char from string
Function TrimChar(AString, ACharToTrim)
	TrimChar = TrimChars(AString, ACharToTrim, ACharToTrim)
End Function

' (SS,23/6/09) trims given chars between AMinChar and AMaxChar from start and end of string
' code taken from TrimAll and modified to trim a range of chars
Function TrimChars(AString, AMinChar, AMaxChar)
  Dim LString, LLen, LStart, LEnd, i
  LLen = Len(AString)
  LString = NB(AString)
  If LString = "" Then
    TrimChars = ""
    Exit Function
  End If
  For i = 1 To LLen
    If (Mid(LString, i, 1)) < AMinChar Or (Mid(LString, i, 1)) > AMaxChar Then
      Exit For
    End if
  Next
  LStart = i
  LEnd = LLen
  For i = LLen To 1 Step -1
    If (Mid(LString, i, 1)) < AMinChar Or (Mid(LString, i, 1)) > AMaxChar Then
      Exit For
    End if
  Next
  LEnd = i
  If LEnd < LStart Then
    TrimChars = ""
  Else
    TrimChars = Mid(LString, LStart, LEnd - LStart + 1)
  End If
End Function

' (SS,14/9/06) returns null as "" (i.e. Null as Blank)
Function NB(AValue)
  If IsNull(AValue) Then
    NB = ""
  Else
    ' (SS,22/5/07) replaced NB = AValue with following to ensure non string is converted to a string
    If VarType(AValue) = VBString Then
      NB = AValue
    Else
      NB = CStr(AValue)
    End If
  End If
End Function
'------------------------------------------

' (SS,19/9/17) handles email from TransferWise to automate bank transfer payments received for HyperFlight orders
' (SS,21/10/20) fixed for change from "Amount:" to "Amount received:", also added "Reference" field
' also changed to sent alert email when amount or currency missing
Sub ProcessTransferWisePayment(oMessage)

  SetLogFileName "transferwise-payments.txt"
  
	' (SS,25/2/09) modified hmailserver rules to check for noreply@checkout.google.com in From address
	' previously was "Purchase Receipt for Order" in subject

	AddLog ""
  AddLog "1. ProcessTransferWisePayment called for: " & oMessage.To
  Dim NL
  NL = Chr(13) + Chr(10) 
  AddLog "2. Email from: " & oMessage.FromAddress
    
  ' (SS,21/9/17) removed following, causing error because subject contains unicode characters
  ' AddLog "3. Email subject: " + oMessage.Subject

  Dim LPos, LDomain, LCallbackURL, LBuyer, LTotal, LEmailSubject, LBody
   
  LBody = oMessage.HTMLBody 
  
  Dim LPaymentDetails, LAmount, LCurrency, LPayerName, LTransferNumber, LReference
  
  LAmount = ""
  LCurrency = ""  
  LPayerName = ""
  LTransferNumber = ""
  LReference = "" ' (SS,21/10/20)
  
  ' try email format for EUR payments
  LPaymentDetails = Trim(GetString(LBody, "Payment details</h5>", "</dl>", "A"))
  If LPaymentDetails <> "" Then    
    ' LAmount = Trim(GetString(LPaymentDetails, "<dt>Amount:</dt>", "</dd>", "A"))
    ' (SS,21/10/20) replaced "Amount:" with "Amount received:", it had stopped working, last worked 13/10/2020
    LAmount = Trim(GetString(LPaymentDetails, "<dt>Amount received:</dt>", "</dd>", "A"))
    LAmount = Trim(GetString(LAmount, "<dd>", "</dd>", "A"))     
    LPayerName = Trim(GetString(LPaymentDetails, "<dt>From:</dt>", "</dd>", "A"))
    LPayerName = Trim(GetString(LPayerName, "<dd>", "</dd>", "A"))    
    LTransferNumber = Trim(GetString(LPaymentDetails, "<dt>Transfer Number:</dt>", "</dd>", "A"))
    LTransferNumber = Trim(GetString(LTransferNumber, "<dd>", "</dd>", "A"))
    ' (SS,21/10/20) noticed they now have the reference field, now added
    LReference = Trim(GetString(LPaymentDetails, "<dt>Reference:</dt>", "</dd>", "A"))
  Else
    ' try email format for USD payments
    LPaymentDetails = Trim(GetString(LBody, "<strong>Amount:</strong>", "</tbody>", "A"))
    LAmount = TrimAll(GetString(LPaymentDetails, "-webkit-text-size-adjust:100%;"">", "</td>", "A"))
    LPayerName = Trim(GetString(LPaymentDetails, "<strong>From:</strong>", "</tr>", "A"))
    LPayerName = TrimAll(GetString(LPayerName, "-webkit-text-size-adjust:100%;"">", "</td>", "A")) 
    LTransferNumber = Trim(GetString(LPaymentDetails, "<strong>Transfer Number:</strong>", "</tr>", "A"))
    LTransferNumber = TrimAll(GetString(LTransferNumber, "-webkit-text-size-adjust:100%;"">", "</td>", "A"))    
  End If
  
  ' separate currency from amount
  If LAmount <> "" Then
    LCurrency = Right(LAmount, 3)
    LAmount = Trim(Mid(LAmount, 1, Len(LAmount) - 3))
    LAmount = Replace(LAmount, ",", "") ' (SS,13/10/17) remove the comma from thousands
  End If
  
  AddLog "4. Amount: " + LAmount + "  Currency: " + LCurrency
  AddLog "5. Payer Name: " + LPayerName
  AddLog "6. Transfer Number: " + LTransferNumber
  
  
  'SaveStringAsFile LBody, "d:\temp\testfile.txt"

  ' (SS,21/10/20) move following here from below "If" to work for both condition in email
  LBody = ""  
  LBody = LBody + "Amount = " & LAmount & NL
  LBody = LBody + "Currency = " & LCurrency & NL
  LBody = LBody + "Payer Name = " & LPayerName & NL
  LBody = LBody + "Transfer Number = " & LTransferNumber & NL
  LBody = LBody + "To Address = " & oMessage.To & NL
  LBody = LBody + "From Address = " & oMessage.FromAddress & NL
  LBody = LBody + "Subject = " & oMessage.Subject & NL


  ' exit if no amount or currency
  ' (SS,21/10/20) replaced Exit Sub with Else to allow alert email to be sent if no amount found
  If LAmount = "" Or LCurrency = "" Then
  	AddLog "7. Process aborted, amount or currency missing"
    ' Exit Sub
    ' (SS,21/10/20) replaced above with following
    LBody = LBody + "No callback done due to missing amount or currency" & NL  
    LCallbackResult = ""
  Else
  
    LDomain = Trim(GetString(oMessage.To, "@", ">", "A"))
    LCallbackURL = "https://www." & LDomain & "/transferwise-callback.asp"
    
    ' ***
    'LCallbackURL = "http://hyperflight23.itpartnership.com:81" & "/transferwise-callback.asp"
    
    Dim LPostData, LCallbackResult
    LPostData = ""
    LPostData = AddPostData(LPostData, "Amount", LAmount)
    LPostData = AddPostData(LPostData, "Currency", LCurrency)
    LPostData = AddPostData(LPostData, "PayerName", LPayerName)
    LPostData = AddPostData(LPostData, "TransferNumber", LTransferNumber)
    LPostData = AddPostData(LPostData, "Reference", LReference) ' (SS,21/10/20)

    ' (SS,21/10/20) moved some of the LBody code from here to above
    LBody = LBody + "Callback URL = " & LCallbackURL & NL  
    LCallbackResult = GetURL(LCallbackURL & "?" & LPostData)
    LBody = LBody + "Callback Response = " & NL & LCallbackResult & NL  
    ' (SS,26/9/17) removed following and renamed "Callback Content" to "Callback Response" above, also removed 
    'LBody = LBody + "Email Content = " & NL & NL & oMessage.HTMLBody  

    AddLog "7. Callback executed and returned: " & LCallbackResult
  
  End If
  
  
  ' send the new email message
  Dim oNewMessage 
  Set oNewMessage = CreateObject("hMailServer.Message")
  oNewMessage.From = "hMailServer (TransferWise Payment Event)"
  oNewMessage.FromAddress = "transferwise@itpartnership.com"
    
  ' (SS,27/10/17) added following if, to mark as "ALERT!!!" if payment couldn't be applied
  Dim LSubject
  LSubject = "TransferWise Payment Received (" & LTransferNumber & ")"
  If InStr(LCallbackResult, "Payment succesfully applied") = 0 Then
    LSubject = "ALERT!!! " + LSubject
    oNewMessage.HeaderValue("X-Priority") = "1" ' mark as high importance
  End If  
  oNewMessage.Subject = LSubject  
  
  oNewMessage.AddRecipient "", "neil@hyperflight.co.uk" ' (SS,21/9/17) oMessage.To doesn't work because it contains name as well
  oNewMessage.AddRecipient "", "contactforms@itpartnership.com"
  oNewMessage.Body = LBody  
  oNewMessage.Save 
  Set oNewMessage = Nothing
  
  AddLog "8. Email sent"
  AddLog "9. ProcessTransferWisePayment completed"
End Sub

Sub SendTestEmail(oMessage)
  Dim LBody
  LBody = GetFileAsString("D:\Temp\testemail.txt")
  SendEmail "Surinder", "transferwise@ssbsoft.co.uk", "hMailServer SendTestEmail Event", "hmailserver@itpartnership.com", "Just testing", LBody, True
End Sub

' (SS,19/9/17) send given email
Sub SendEmail(AToName, AToAddress, AFromName, AFromAddress, ASubject, ABody, AIsHTML)
  Dim oNewMessage 
  Set oNewMessage = CreateObject("hMailServer.Message")
  oNewMessage.From = AFromName
  oNewMessage.FromAddress = AFromAddress
  oNewMessage.Subject = ASubject
  oNewMessage.AddRecipient AToName, AToAddress
  If AIsHTML Then
    oNewMessage.HTMLBody = ABody 
  Else
    oNewMessage.Body = ABody
  End If
  oNewMessage.Save 
  Set oNewMessage = Nothing
End Sub