AANS#26774 Mail Subject kunnen sturen met ##OPDRTYPE##

svn path=/Website/trunk/; revision=19056

UTILS/PutOrders/AllOrders.bas

@@ -10,7 +10,7 @@ Option Explicit
 ' *
 ' ******************************************
 Function SendAllOrders(ByVal conn As ADODB.Connection)
-  Dim oRs, oRsB, oRsC As ADODB.Recordset
+  Dim oRs, oRsB, oRsC, oRsS As ADODB.Recordset
   Dim sql As String
   Dim RecTotal As Long, MLDRecSaved As Long, BESRecSaved As Long, CustRecSaved As Long
   Dim Bedrijf As Long
@@ -29,6 +29,7 @@ Function SendAllOrders(ByVal conn As ADODB.Connection)
   Dim sql_cust As String
   Dim Sender As String
   Dim XSLfile As String
+  Dim MailSubject As String
 
   ' Sinds 4.70 hebben we een virtuele orderqueue
   ' en sinds 4.70.1 een kolom reference
@@ -111,7 +112,7 @@ Function SendAllOrders(ByVal conn As ADODB.Connection)
       ' kan worden levert de functie een lege string. Voor orders gaan we dit blijven
       ' herhalen totdat de order wel verstuurd kan worden.
       xml_content = fetchXMLContent(conn, oRs("xmlnode").value, oRs("key").value, -1, "", "")
-      
+
       If xml_content <> "" Then
         ordernr = oRs("reference").value
         If oRsB("prs_bedrijf_order_certificate").value = "-" Then
@@ -143,9 +144,25 @@ Log2File 1, "Searching attachments under: " & AttachPath
         Log2File 4, "errText=" & errText
         Log2File 4, "AttachPath=" & AttachPath
 
+        If oRs("xmlnode").value = "opdracht" Then
+            MailSubject = SubjectPrefixMLD
+            sql = "SELECT mld.opdrsprintf('" & Replace(MailSubject, "'", "''") & "'," & oRs("key").value & ") subj FROM DUAL"
+        Else
+            MailSubject = SubjectPrefix
+            sql = "SELECT bes.opdrsprintf('" & Replace(MailSubject, "'", "''") & "'," & oRs("key").value & ") subj FROM DUAL"
+        End If
+        If InStr(MailSubject, "##") = 0 Then
+            MailSubject = SubjectPrefix & ordernr '' Geen ##, backwards compatible
+        Else
+            Set oRsS = conn.Execute(sql)
+            MailSubject = oRsS("subj").value
+            oRsS.Close
+        End If
+
         SendOrderResult = filer.SendOrder(connect, xml_content, XSLfile, _
                                    ordernr, oRs("key").value, _
-                                   oRsB("prs_bedrijf_order_mode"), certificateName, errText, AttachPath, Sender)
+                                   oRsB("prs_bedrijf_order_mode"), certificateName, errText, _
+                                   AttachPath, Sender, MailSubject)
 
         If oRs("cust").value = 0 Then
             sql = "BEGIN FAC.markorderassent( '" & _
@@ -199,7 +216,7 @@ End Function
 Function getXslNode(pXslFile, pNode)
   Dim fs
   Dim vFile As String
-  
+
   Set fs = CreateObject("Scripting.FileSystemObject")
 
   vFile = pXslFile
@@ -209,7 +226,7 @@ Function getXslNode(pXslFile, pNode)
       vFile = pXslFile
     End If
   End If
-  
+
   Set fs = Nothing
   getXslNode = vFile
 End Function

UTILS/PutOrders/Notifications.bas

@@ -220,7 +220,7 @@ FinallySMS:
       Dim SendOrderResult As Long
 
       Call connect.connect(oRs("fac_notificatie_systeemadres").value)
-        
+
       If Not IsNull(oRs("fac_srtnotificatie_xmlnode").value) Then
         ' Errors in de generatie van de XML worden afgevangen in fetchXMLContent
         ' De functie levert dan een lege string, de notificatie wordt dan als verzonden
@@ -252,7 +252,8 @@ FinallySMS:
 
           SendOrderResult = filer.SendOrder(connect, xml_content, System2SystemXSL, _
                                      ordernr, oRs("fac_notificatie_refkey").value, _
-                                     ordermode, certificateName, errText, AttachPath, fac_notificatie_sender_email)
+                                     ordermode, certificateName, errText, _
+                                     AttachPath, fac_notificatie_sender_email, SubjectPrefix & ordernr)
         End If
         If SendOrderResult <> 0 Then
           Log2File 0, "Notification to systeemadres failed. Errorcode:" & SendOrderResult

UTILS/PutOrders/PutOrders.bas

@@ -6,7 +6,8 @@ Const INIFileName As String = ".\PutOrders.ini"
 Const LogFileName As String = "PutOrders.log"
 Const BufferSize As Long = 2048
 '
-Global SubjectPrefix As String
+Global SubjectPrefix As String ' BES
+Global SubjectPrefixMLD As String
 Global IniNotificationInMailBody As String
 Global IniNotificationXSL As String
 Global IniSystem2SystemXSL As String
@@ -135,7 +136,7 @@ End Sub
 Function getXslName(pNode As String) As String
   Dim resxslsheet As String
   Dim fs
-  
+
   Set fs = CreateObject("Scripting.FileSystemObject")
 
   If (pNode <> "") Then
@@ -149,7 +150,7 @@ Function getXslName(pNode As String) As String
   If (Not fs.FileExists(resxslsheet)) Then
     resxslsheet = "..\..\appl\shared\default.xsl"
   End If
-  
+
   Set fs = Nothing
   getXslName = resxslsheet
 End Function
@@ -280,6 +281,7 @@ Dim errText As String
   NotificationDelay = ReadINIInt("GENERAL", "NotificationDelay", 0)
   '
   SubjectPrefix = ReadINIStr("GENERAL", "SubjectPrefix", "Facilitor bestelling: Bestelopdracht nr.")
+  SubjectPrefixMLD = ReadINIStr("GENERAL", "SubjectPrefixMLD", SubjectPrefix)
   '' FacilitorHome & "cust/" & CustomerId & "/flexfiles/
   FlexfilesFolder = ReadINIStr("GENERAL", "FlexfilesFolder", "")
   '

UTILS/PutOrders/PutOrders.vbp

@@ -29,7 +29,7 @@ HelpContextID="0"
 CompatibleMode="0"
 MajorVer=5
 MinorVer=2
-RevisionVer=35
+RevisionVer=36
 AutoIncrementVer=1
 ServerSupportFiles=0
 VersionCompanyName="SG|facilitor"

UTILS/PutOrders/PutOrders.vbw

@@ -8,7 +8,7 @@ SendHttp = 19, -16, 1151, 742, C
 PutOrders_Mod1 = 42, 38, 807, 646, I
 Connector = 344, 27, 1032, 618, C
 SendMail = 123, 67, 811, 658, C
-AllOrders = 8, 43, 889, 647, I
-Notifications = -223, 41, 1053, 664, C
+AllOrders = 8, 43, 889, 647, 
+Notifications = -41, 32, 1187, 655, 
 SendOrder = -181, 34, 897, 645, C
 SendSoap = 44, 44, 732, 635, I

UTILS/PutOrders/SendFile.cls

@@ -75,7 +75,8 @@ Function SendOrder(ByRef connect As Connector, _
                     ByVal order_certificate As String, _
                     ByRef errText As String, _
                     ByRef AttachFolder As String, _
-                    ByVal Sender As String) As Integer
+                    ByVal Sender As String, _
+                    ByVal MailSubject As String) As Integer
 
 
   Debug.Assert (xslPath <> "")
@@ -243,19 +244,19 @@ Function SendOrder(ByRef connect As Connector, _
             ' to be able to add the logo and to include the email parameter
             content = XML2HTML(xmlData, xslPath, "", "email")
             mailResult = mailer.SendMail(Sender, connect.MailUser + "@" + connect.MailServer, _
-                                      CC, BCC, ReceiptTo, SubjectPrefix & ordernr, _
+                                      CC, BCC, ReceiptTo, MailSubject, _
                                       "", _
                                       content, filename, Nothing, AttachFolder, encryptpass)
           Else
             mailResult = mailer.SendMail(Sender, connect.MailUser + "@" + connect.MailServer, _
-                                      CC, BCC, ReceiptTo, SubjectPrefix & ordernr, _
+                                      CC, BCC, ReceiptTo, MailSubject, _
                                       StrConv(streamResult.Read, vbUnicode), _
                                       "", "", Nothing, _
                                      AttachFolder, encryptpass)
           End If
         Else ' Plain body met verwijzing naar de attachment, waarschijnlijk een XML
           mailResult = mailer.SendMail(Sender, connect.MailUser + "@" + connect.MailServer, _
-                                  CC, BCC, ReceiptTo, SubjectPrefix & ordernr, _
+                                  CC, BCC, ReceiptTo, MailSubject, _
                                   body, _
                                   "", _
                                   filename, _