Dim m_EinwilligungIncomming

' Erst mal die Instanz erzeugen
Set m_EinwilligungIncomming = New cEinwilligungIncomming

' Und bei FlowFact anmelden
Application.EventsConsumers.Add m_EinwilligungIncomming
'Für lokale Ausführung
m_EinwilligungIncomming.Main

Class cEinwilligungIncomming

    Public m_oFF
	Public m_oDev
    Public m_Msg_From
    Public tempMailFrom
    Public m_Msg_Subject
    Public m_Msg_Text
    Public m_Msg_Header
    Public m_blnCancel
 	Public strFileName
	Dim strInfo
    
    Public Sub Main()
        Set m_oFF = Application
		Call DoLog("EinwilligungIncomming", "Start batch")
    End Sub

	'******************************************************************
    '** DoLog Logfile schreiben
    '******************************************************************
	Sub DoLog(ByVal strProcName, ByVal strMessageString)
		Dim strMsg 
		On Error Resume Next
		strFileName =  m_oFF.folder & "\Dat\ffEinwilligungIncomming.log"
		strMsg = CStr(Now) & " - " & strProcName & " : " & strMessageString
		set m_oFso = CreateObject("Scripting.FilesystemObject")
		ForAppending = 8
		Set oLog = m_oFso.OpenTextFile(strFileName, ForAppending, True)
		oLog.WriteLine strMsg
		oLog.Close
	End Sub	
	
	'******************************************************************
    '** MessageProcessed verarbeiten
    '******************************************************************
	Sub MessageProcessed(msg, rsAccounts, rsAkt, rsAktMkm, blnCancel)
	
		Call DoLog("EinwilligungIncomming", vbcrlf & "MessageReceived----------------------------------------")
		m_Msg_Subject = msg.Subject
        m_Msg_Content = CStr(msg.Content)
        m_Msg_Body = CStr(msg.Content)
        m_Msg_From = CStr(msg.From)
        m_Msg_To = CStr(msg.To.Item(1))
        m_Msg_Header = CStr(msg.Header.All)
		dim strAdDSN
		if instr(m_Msg_Header,"X-FF-Einwilligung:")>0 then
			rsAkt("erledigt").Value = 1
		
			strAdDSN = GetValue(m_Msg_Content,"X-FF-Einwilligung:")
			if instr(strAdDSN,"{") = 0 then strAdDSN = "{" & strAdDSN & "}"
			Call DoLog("MessageReceived", "X-FF-Einwilligung:" & vbcrlf & strAdDSN )
			Init_oDev
			'** Einwilligung ist da
			if instr(m_Msg_Body,"Status: Einwilligung")> 0 then
				'anlegen der aktivität
				call MacheAkt(rsAkt("DSN").Value, strAdDSN, 1, "Einwilligung", "Einwilligung für den Kunden ist eingetroffen." & vbcrlf & "Das entsprechende Merkmal wurde hinterlegt" )
				Call DoLog("MessageReceived", "AKT angelegt")
				'vorher alle anderen Löschen?
				call DeleteADMKM(strAdDsn, "{CE2DCB7F-404C-4D85-99B2-3FECB9B38A64}")
				call DeleteADMKM(strAdDsn, "{327FD808-7410-4E9C-B84F-02E7D49F8FDC}")
				Call DoLog("MessageReceived", "Merkmale Anf/Wid gelöscht")
				'jetzt setzen
				call SetADMKM(strAdDsn, "{046C1411-5D65-450D-AF40-BF5CA96DFB7E}")
				Call DoLog("MessageReceived", "Einwilligung Merkmal gesetzt")
				'jetzt Detailsatz noch füllen
				'Zweck der Einwilligung
				Call DetailsDet(strAdDsn, "{9C336996-C6A1-4AF8-8195-BD5DEB9D86B3}", "Akquisition und Vermittlung von Immobilien und für den Fall von Rückfragen", Null)
				'Datum der Einwilligung
				Call DetailsDet(strAdDsn, "{8D33E575-5238-4C86-AB27-5A93DEDDBA30}", FormatDateTime(Now, vbShortDate),Null)
				'Quelle der Einwilligung
				Call DetailsDet(strAdDsn, "{2943901B-638B-4EE2-B61B-C59F6CA1AD80}", "Mail", "{2FF3C936-E48D-404B-939E-80637CEF7121}")
				Call DoLog("MessageReceived", "Details Einwilligung fertig")
			end if
			'** Wiederspruch ist da
			if instr(m_Msg_Body,"Status: Widerspruch")> 0 then
				'anlegen der aktivität n
				call MacheAkt(rsAkt("DSN").Value, strAdDSN, 0, "Widerspruch", "Ein Widerspruch des Kunden ist eingetroffen." & vbcrlf & "Das entsprechende Merkmal wurde hinterlegt" )
				Call DoLog("MessageReceived", "AKT angelegt")
				'vorher alle anderen Löschen?
				call DeleteADMKM(strAdDsn, "{CE2DCB7F-404C-4D85-99B2-3FECB9B38A64}")
				call DeleteADMKM(strAdDsn, "{046C1411-5D65-450D-AF40-BF5CA96DFB7E}")
				Call DoLog("MessageReceived", "Merkmale Anf/Ein gelöscht")
				'jetzt setzen
				call SetADMKM(strAdDsn, "{327FD808-7410-4E9C-B84F-02E7D49F8FDC}")
				Call DoLog("MessageReceived", "Widerspruch Merkmal gesetzt")
				'jetzt Detailsatz noch füllen
				'Grund des Widerrufes
				Call DetailsDet(strAdDsn, "{F3640300-4974-4E40-B2F2-7AF5F097D71A}", "Widerruf per Mail", Null)
				'Datum des Widerrufes
				Call DetailsDet(strAdDsn, "{FDF92AF1-E179-4CF1-8C66-EBC419FDB601}", FormatDateTime(Now, vbShortDate),Null)
				Call DoLog("MessageReceived", "Details Widerruf fertig")
			end if
			
			Application.UpdateRecordset rsAkt
		end if
	End Sub
    
	'******************************************************************
    '** GetValue aus einem Key-Set
    '******************************************************************
	Function GetValue(strText, strSuchName)
		Dim wo
		Dim nextCrlf
		Dim strRest
		wo = instr(strText,strSuchName)
		if wo > 0 then
			strRest = mid(strText,wo)
			nextCrlf = instr(strRest,vbCrlf)
			if nextCrLf>0 then
				GetValue = trim(mid(strRest,len(strSuchName)+1,nextCrlf-len(strSuchName)))
			else
				GetValue = trim(mid(strRest,len(strSuchName)+1))
			end if
			GetValue = trim(replace(GetValue,vbCrlf,""))
			GetValue = trim(replace(GetValue,vbCr,""))
			GetValue = trim(replace(GetValue,vbLF,""))
		end if	
	End Function

	'******************************************************************
    '** Init_oDev
    '******************************************************************
	Sub Init_oDev
		' Hier eigenen Code einfügen
		Set m_oDev = GetObject("", "FFDeveloper.Application")
		m_oDev.FlowFact_InitApplication
		Call DoLog("Init_oDev", "Init OK")
	End Sub

	'******************************************************************
    '** MacheAkt anlegen für Adresse mit prio
    '******************************************************************
	Sub MacheAkt(ByVal strParentActivityDsn, ByVal AdrDSN, ByVal Erledigt, ByVal strSubject, ByVal InfoText)
		Dim AktDSN
		Dim aktenNotizDsn
		aktenNotizDsn = GetArtDsn_Aktennotiz()
		InfoText = vbCrlf & InfoText & FormatDateTime(Now, vbGeneralDate) & vbCrlf & vbCrlf & "Hinweis: E-Mail ist im Vorgang enthalten."
		
		AktDSN = m_oDev.AKT_Create(aktenNotizDsn, strSubject & " am " & FormatDateTime(Now, vbShortDate) & " eingetroffen", InfoText,Erledigt,Now,,Now,,,,,,AdrDSN,,,,,,,, strParentActivityDsn)
		Call DoLog("MacheAkt", "was angelegt" & AktDSN & vbcrlf & InfoText)
	End Sub

	Function GetArtDsn_Aktennotiz()
		Dim strArtDsn
		Dim strArtName
		
		If GetArtDsnAndName("Aktennotiz", "%Aktennotiz%", "{10000100-0000-0202-0011-00001B3B30F6}", "", strArtDsn, strArtName) = True Then
			GetArtDsn_Aktennotiz = strArtDsn
		Else
			Set rs = Application.GetRecordset("SELECT TOP 1 dsn FROM Aktivitätenarten")
			If rs.Eof = False Then
				Call DoLog("GetArtDsn_Aktennotiz", "Aktivitätenarte Aktennotiz nicht gefunden, benutze erste Aktivitätenart")
				GetArtDsn_Aktennotiz = rs("dsn").value & ""
			else 
				GetArtDsn_Aktennotiz = ""	
			End If
		End If
		
	End Function

	Function GetArtDsnAndName(ByVal strArtBez, ByVal strNamePipeList1, ByVal strDefDsnPipList, ByVal strNamePipeList2, ByRef strResultDsn, ByRef strResultName)
		Dim rs
		Dim strArtDsn
		Dim strArtName
		
		
		'** flowfact.INI - Wert
		strArtName = m_oFF.Util.IniGet("Aktivitätenarten", strArtBez, "", Application.Folder & "\flowfact.INI")
		If strArtName <> "" Then
			Set rs = Application.GetRecordset("SELECT dsn, name FROM Aktivitätenarten WHERE Name = " & m_oFF.Util.SqlStr(strArtName))
			If rs.Eof = False Then
				strResultDsn = rs("dsn").value & ""
				strResultName = rs("name").value & ""
			End If
		End If
		
		
		'** Liste1
		While strResultName = "" And strNamePipeList1 <> ""
			strArtName = m_oFF.Util.StrList_DeleteFirst(strNamePipeList1, "|")
			Set rs = Application.GetRecordset("SELECT dsn, name FROM Aktivitätenarten WHERE name like " & m_oFF.Util.SqlStr(strArtName) & " ORDER BY name")
			If rs.Eof = False Then
				strResultDsn = rs("dsn").value & ""
				strResultName = rs("name").value & ""
			End If
		Wend
		
		'** DefDsn Liste
		While strResultName = "" And strDefDsnPipList <> ""
			strArtDsn = m_oFF.Util.StrList_DeleteFirst(strDefDsnPipList, "|")
			Set rs = Application.GetRecordset("SELECT dsn, name FROM Aktivitätenarten WHERE dsn = " & m_oFF.Util.SqlUid(strArtDsn))
			If rs.Eof = False Then
				strResultDsn = rs("dsn").value & ""
				strResultName = rs("name").value & ""
			End If
		Wend
		
		'** Liste2
		While strResultName = "" And strNamePipeList2 <> ""
			strArtName = m_oFF.Util.StrList_DeleteFirst(strNamePipeList2, "|")
			Set rs = Application.GetRecordset("SELECT dsn, name FROM Aktivitätenarten WHERE name like " & m_oFF.Util.SqlStr(strArtName) & " ORDER BY name")
			If rs.Eof = False Then
				strResultDsn = rs("dsn").value & ""
				strResultName = rs("name").value & ""
			End If
		Wend
		
		GetArtDsnAndName = strResultName <> ""
		
	End Function
	
    '***************************************************************************
    '** Löscht ein AD Merkmal
    '***************************************************************************
    Private Sub DeleteADMKM(strAdDsn, strMkmDsn)
        Dim rsAdMkm
        Dim strSql
        Dim blnMkmExists
        blnMkmExists = ProofIfExists("MKM", strMkmDsn)
        If blnMkmExists Then
			Call DoLog("DeleteADMKM", "ist vorhanden: " & strMkmDsn)
            strSql = "SELECT * FROM admkm WHERE admkm.link_dsn = '" & strAdDsn & "' AND admkm.mkm_dsn = '" & strMkmDsn & "'"
            Set rsAdMkm = m_oFF.GetRecordSet(strSql)
            If rsAdMkm.EOF = False Then
                rsAdMkm.Delete
                m_oFF.UpdateRecordSet (rsAdMkm)
                rsAdMkm.Close
            End If
            Set rsAdMkm = Nothing
		end if
	end sub

    '***************************************************************************
    '** Setzt ein AD Merkmal
    '***************************************************************************
    Private Sub SetADMKM(strAdDsn, strMkmDsn)
        Dim rsAdMkm
        Dim strSql
        Dim blnMkmExists
 		Call DoLog("SetADMKM", strAdDsn & " " &  strMkmDsn)
        blnMkmExists = ProofIfExists("MKM", strMkmDsn)
        If blnMkmExists Then
			Call DoLog("SetADMKM", "gibt es")
            strSql = "SELECT * FROM admkm WHERE admkm.link_dsn = " & m_oFF.Util.SqlUid(strAdDsn) & " AND admkm.mkm_dsn = " & m_oFF.Util.SqlUid(strMkmDsn)
            Set rsAdMkm = m_oFF.GetRecordSet(strSql)
			Call DoLog("SetADMKM", "Set 1")
            If rsAdMkm.EOF Then
                rsAdMkm.AddNew
                rsAdMkm.Fields("DSN").Value = m_oFF.Util.NewGuid
                rsAdMkm.Fields("MKM_DSN").Value = strMkmDsn
                rsAdMkm.Fields("LINK_DSN").Value = strAdDsn
                m_oFF.UpdateRecordSet (rsAdMkm)
				Call DoLog("SetADMKM", "update durch")
			End If
            rsAdMkm.Close
            Set rsAdMkm = Nothing
        End If
    End Sub
    '***************************************************************************
    '** Löscht ein Aktivtäten Merkmal
    '***************************************************************************
    Private Sub DeleteAktMKM(strAktDsn, strMkmDsn)
        Dim rsAktMkm
        Dim strSql
        Dim blnResult
        Dim blnMkmExists
        blnMkmExists = ProofIfExists("MKM", strMkmDsn)
        If blnMkmExists Then
            strSql = "SELECT * FROM aktmkm WHERE aktmkm.link_dsn = '" & strAktDsn & "' AND aktmkm.mkm_dsn = '" & strMkmDsn & "'"
            Set rsAktMkm = m_oFF.GetRecordSet(strSql)
            If rsAktMkm.EOF = False Then
                rsAktMkm.Delete
                m_oFF.UpdateRecordSet (rsAktMkm)
                rsAktMkm.Close
            End If
            Set rsAktMkm = Nothing
        End If
    End Sub

    '***************************************************************************
    '** Setzt ein Aktivitäten Merkmal
    '***************************************************************************
    Private Sub SetAktMKM(strAktDsn, strMkmDsn)
        Dim rsAktMkm
        Dim strSql
        Dim blnMkmExists
        blnMkmExists = ProofIfExists("MKM", strMkmDsn)
        If blnMkmExists Then
            strSql = "SELECT * FROM aktmkm WHERE aktmkm.link_dsn = " & m_oFF.Util.SqlUid(strAktDsn) & " AND aktmkm.mkm_dsn = " & m_oFF.Util.SqlUid(strMkmDsn)
            Set rsAktMkm = m_oFF.GetRecordSet(strSql)
            If rsAktMkm.EOF Then
                rsAktMkm.AddNew
                rsAktMkm.Fields("DSN").Value = m_oFF.Util.NewGuid
                rsAktMkm.Fields("MKM_DSN").Value = strMkmDsn
                rsAktMkm.Fields("LINK_DSN").Value = strAktDsn
                m_oFF.UpdateRecordSet (rsAktMkm)
            End If
            rsAktMkm.Close
            Set rsAktMkm = Nothing
        End If
    End Sub

    '***************************************************************************
    '** Prüft, ob ein bestimmter Datensatz vorhanden ist
    '***************************************************************************
    Private Function ProofIfExists(strTable, strDsn)
        Dim strSql
        Dim rs
        strSql = "SELECT * FROM " & strTable & " WHERE DSN = " & m_oFF.Util.SqlUid(strDsn) & ""
        Set rs = m_oFF.GetRecordSet(strSql)
		blnResult = Not rs.EOF
        rs.Close
        Set rs = Nothing
        ProofIfExists = blnResult
    End Function

    '***************************************************************************
    '** Prüft, ob ein bestimmter Datensatz vorhanden ist
    '***************************************************************************
    Private Sub DetailsDet(strAdDsn, strFldartDSN, strEingabe, strFldartopDSN)
        Dim strSql
        Dim rs
		Dim strDetDsn
        strSql = "SELECT DSN FROM Details WHERE AD_DSN = " & m_oFF.Util.SqlUid(strAdDsn) & " and EMSK_DSN = '{B0184C2A-1B8E-4467-AECA-9D7292DD192B}'"
        Set rs = m_oFF.GetRecordSet(strSql)
		if Not rs.EOF then
			Call DoLog("DetailsDet", "Detail gefunden")				
			strDetDsn = rs(0)
			strSql = "SELECT * FROM DetailsDet WHERE Details_DSN = '" &  strDetDsn & "'" 
			Set rs = m_oFF.GetRecordSet(strSql)
			if Not rs.EOF then
				'es sind schon sätze da
				Call DoLog("DetailsDet", "Gefunden: " & rs.recordcount)
			else
				Call DoLog("DetailsDet", "Nix: " & rs.recordcount)				
			end if
			strSql = "SELECT * FROM DetailsDet WHERE Details_DSN = '" &  strDetDsn & "' and Fldart_DSN = '" & strFldartDSN & "'"
			'strSql = "Select DetailsDet.DSN, DetailsDet.Details_DSN, DetailsDet.Fldart_DSN, DetailsDet.Eingabe, DetailsDet.von_str, DetailsDet.bis_str  from Details inner join DetailsDet on Details.dsn = DetailsDet.Details_dsn WHERE Details_DSN = '" &  strDetDsn & "' and Fldart_DSN = '" & strFldartDSN & "'"
			Set rs = m_oFF.GetRecordSet(strSql)
			if rs.eof then
				Call DoLog("DetailsDet", "NeuDetail")				
				rs.addNew
				rs("DSN").Value = m_oFF.Util.NewGuid
				Call DoLog("DetailsDet", "NeuDetail1")				
			end if
			rs("Details_DSN").Value = strDetDsn
			rs("Fldart_DSN").Value = strFldartDSN
			rs("Fldartop_DSN").Value = strFldartopDSN
			rs("Eingabe").Value = strEingabe
			rs("von_str").Value = strEingabe
			rs("bis_str").Value = strEingabe
			m_oFF.UpdateRecordSet (rs)
			Call DoLog("DetailsDet", "gespeichert " & rs("DSN").Value)							
		else
			Call DoLog("DetailsDet", "Kein Detail?")		
		end if
		rs.Close
        Set rs = Nothing
    End Sub
    
End Class