True 2 ADM_ACT2BulkMailer Überträgt Act! Kontakte in die Adressen vom BulkMailer, etc. Überträgt entweder die aktuelle Gruppe oder die aktuelle Suche von Kontakten in den BulkMailer als Verteiler, etc. Connected Menus act-ui://com.act/application/menu/edit -1 False None ' #ScriptName: Act2BulkMailer ' #Description: - Überträgt die aktuelle Act! Kontaktsuche bzw. Kontakte der aktuellen Gruppe in die BulkMailer Adressdatenbank. ' - Erstellt aus den BulkMailer Sendeprotokollen eines Mailings Historien in Act! ' - Hängt die Vorlage und eventuelle Anlagen eines Mailings in die Dokumente der aktuellen Act! Gruppe ' #Author: Robert Schellmann, r@act7.de ' #Copyright: © 2019-2021 by Melville-Schellmann ' #Version: 0.3.8 (08.07.2020) Kein Index-Fehler bei Historienerstellung, wenn der Kontaktdatensatz mit der GUID nicht mehr existiert ' #Version: 0.3.7 (08.07.2020) Korrekte Erkennung bereits angelegter Historien in Act! ' #Version: 0.3.6 (18.02.2020) In der ersten Zeile der Historiendetails wird der Status ausgegeben ' #Version: 0.3.5 (24.09.2019) Aktuellen Act! Kontakt aus der Auschlussliste entfernen ' #Version: 0.3.4 (23.09.2019) Aus der Ausschlußliste eine aktuelle Suche in Act! erstellen ' #Version: 0.3.3 (20.09.2019) Übertragung der aktuellen Act! Suche in die Ausschlußliste vom BulkMailer ' #Version: 0.3.1 (12.09.2019) Verwendung der System-Historientypen Email Sent und Email Not Send. ' #Version: 0.3.2 (12.09.2019) Einstellungswert für das ACT! Feld in welches der Grund für die Mitgliedschaft in der Ausschlußliste geschrieben wird. ' #Version: 0.3.0 (04.09.2019) Historien Details Eingabe, Historiendauer = 0, optional aktuelle Gruppe mit Historien verknüpfen ' #Version: 0.2.0 (08.08.2019) Mailing-Anlagen verabeiten ' #Version: 0.1.0 (19.07.2019) Beta s.o. ' AddReference("Act.UI.PickList") ' AddReference("Act.Shared.Images") ' AddReference("C1.Win.C1FlexGrid") ' AddReference("C1.Common") m_sScriptName = "Act2BulkMailer" 'm_oACTApp = ACTApp 'm_oAutoData = AutoData m_oError = New ErrorHandling.BaseErrorMessage Dim frmAction As FormAction Dim sConfigurationName = m_sScriptName & "_Konfiguration" Dim sNameCurrentLookup As String = "Act! aktuelle Suche" Dim oConfig As Act2BulkMailerConfiguration Dim oBM As BulkMailer Dim oContacts As Act.Framework.Contacts.ContactList = Nothing Dim oFieldMappings As System.Collections.Generic.Dictionary(Of String,act.Framework.MutableEntities.MutableEntityFieldDescriptor) = Nothing Dim oFieldExcludeReason As Act.Framework.MutableEntities.MutableEntityFieldDescriptor = Nothing Dim oFieldEmail As Act.Framework.MutableEntities.MutableEntityFieldDescriptor = Nothing Dim sGroupName As String ' Act2BulkMailer Konfiguration einlesen (aus Act! Picklist) oConfig = New Act2BulkMailerConfiguration(ACTApp, sConfigurationName) If oConfig.TryLoadConfiguration = False Then If Msgbox(oConfig.ErrorMessage & vbcrlf & vbcrlf & "Wollen Sie die Konfiguration bearbeiten?", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, m_sScriptName) = MsgBoxResult.No Then GoTo Abbruch End If If oConfig.TryEditConfiguration = False Then m_oError.SetError(oConfig.ErrorMessage) End If GoTo Abbruch End If If EnsureValidEntity(ACTApp.CurrentView) = False Then GoTo Abbruch End If ' Das Hauptfenster anzeigen frmAction = New FormAction frmAction.Icon = Icons.ResIcons.ACTOptimum_AutoData frmAction.rbTransferCurrentLookupToAddressList.Enabled = TypeOf ACTApp.CurrentView Is Act.UI.IContactDetailView Or TypeOf ACTApp.CurrentView Is Act.UI.IContactListView frmAction.rbTransferCurrentGroupToAddressList.Enabled = TypeOf ACTApp.CurrentView Is act.UI.IGroupDetailView frmAction.rbTransferCurrentLookupToExcludeList.Enabled = TypeOf ACTApp.CurrentView Is Act.UI.IContactDetailView Or TypeOf ACTApp.CurrentView Is Act.UI.IContactListView frmAction.rbRemoveContactFromExcludeList.Enabled = TypeOf ACTApp.CurrentView Is Act.UI.IContactDetailView frmAction.rbAttachMailingFilesToActGroup.Enabled = TypeOf ACTApp.CurrentView Is act.UI.IGroupDetailView If frmAction.ShowDialog(ACTApp) = DialogResult.Cancel Then GoTo Abbruch End If ' Es wird die Act2BulkMailer Konfiguration bearbeitet If frmAction.rbEditConfiguration.Checked Then If oConfig.TryEditConfiguration = False Then m_oError.SetError(oConfig.ErrorMessage) GoTo Abbruch End If End If oContacts = Nothing sGroupName = String.Empty oBM = New BulkMailer(ACTApp) If oBM.TryInit(oConfig.BMProfile_Name) = False Then m_oError.SetError(oBM.ErrorMessage) GoTo Abbruch End If If oConfig.TryGetFieldMappings(oFieldMappings) = False Then m_oError.SetError(oConfig.ErrorMessage) GoTo Abbruch End If If oConfig.TryGetFieldExcludeReason(oFieldExcludeReason) = False Then m_oError.SetError(oConfig.ErrorMessage) GoTo Abbruch End If If oConfig.TryGetFieldEmail(oFieldEmail) = False Then m_oError.SetError(oConfig.ErrorMessage) GoTo Abbruch End If If frmAction.rbTransferCurrentLookupToAddressList.Checked Or frmAction.rbTransferCurrentGroupToAddressList.Checked Then ' Es wird die aktuelle Act! Suche von Kontakten übertragen If frmAction.rbTransferCurrentLookupToAddressList.Checked Then oContacts = ACTApp.ApplicationState.CurrentContactList sGroupName = sNameCurrentLookup End If ' Es wird die aktuelle Gruppe übertragen If frmAction.rbTransferCurrentGroupToAddressList.Checked Then oContacts = ACTApp.ApplicationState.CurrentGroup.GetContacts(Nothing) If TryGetFullPathNameFromGroup(ACTApp.ActFramework.Groups, ACTApp.ApplicationState.CurrentGroup, sGroupName) = False Then GoTo Abbruch End If End If If oContacts Is Nothing OrElse oContacts.Count = 0 Then m_oError.SetError("Die Liste der Kontakte ist leer.") GoTo Abbruch End If If oBM.TryTransferEntitiesToAddressList(oContacts, oFieldEmail, oFieldMappings, sGroupName) = False Then m_oError.SetError(oBM.ErrorMessage) GoTo Abbruch End If End If If frmAction.rbTransferCurrentLookupToExcludeList.Checked Then If oBM.TryTransferEntitiesLookupToExcludeList(ACTApp.ApplicationState.CurrentContactList, oFieldEmail, oFieldExcludeReason) = False Then m_oError.SetError(oBM.ErrorMessage) GoTo Abbruch End If End If ' Erstellung von Act! Historien aus dem Sendeprotokoll If frmAction.rbCreateActHistoriesFromLog.Checked Then Dim oMailing As BulkMailer.MailingNode = Nothing If oBM.TrySelectMailing(oMailing) = False Then If oBM.HasAnError Then m_oError.SetError(oBM.ErrorMessage) End If GoTo Abbruch End If Dim frmDetails As FormHistoryDetails Dim sDetails As String frmDetails = New FormHistoryDetails frmDetails.Icon = Icons.ResIcons.ACTOptimum_AutoData If frmDetails.ShowDialog(ACTApp) = DialogResult.Cancel Then GoTo Abbruch End If sDetails = frmDetails.TextboxDetails.Text Dim oGroup As Act.Framework.Groups.Group = Nothing If (TypeOf ACTApp.CurrentView Is Act.UI.IGroupDetailView) AndAlso Not (ACTApp.ApplicationState.CurrentGroup Is Nothing) Then oGroup = ACTApp.ApplicationState.CurrentGroup If MsgBox(String.Format("Sollen die Historien mit der aktuellen Gruppe '{0}' verknüpft werden?", oGroup.Name), MsgBoxStyle.YesNo Or MsgBoxStyle.Question, m_sScriptName) = MsgBoxResult.No Then oGroup = Nothing End If End If If oBM.TryCreateActHistoriesFromLog(oMailing, sDetails, oGroup) = False Then m_oError.SetError(oBM.ErrorMessage) GoTo Abbruch End If End If ' Mailing Vorlage und Anlagen in Act! Gruppe anhängen If frmAction.rbAttachMailingFilesToActGroup.Checked Then Dim oMailing As BulkMailer.MailingNode = Nothing If oBM.TrySelectMailing(oMailing) = False Then GoTo Abbruch End If If oBM.TryAttachMailingFilesToActGroup(oMailing) = False Then m_oError.SetError(oBM.ErrorMessage) GoTo Abbruch End If End If ' Act! Suche aus Ausschlußliste erstellen If frmAction.rbCreateLookupFromExcludeList.Checked Then If obm.TryCreateActLookupFromExcludeList(oFieldEmail) = False Then m_oError.SetError(obm.ErrorMessage) GoTo Abbruch End If End If ' Act! Kontakt aus Ausschlußliste entfernen If frmAction.rbRemoveContactFromExcludeList.Checked Then Dim oEntity As Act.Framework.MutableEntities.MutableEntity oEntity = ACTApp.ActFramework.Contacts.GetContactsByID(Nothing, New system.Guid(){ACTApp.ApplicationState.CurrentContact.ID}).Item(0) If oBM.TryRemoveEntityFromExcludeList(oEntity, oFieldEmail, oFieldExcludeReason) = False Then m_oError.SetError(obm.ErrorMessage) GoTo Abbruch End If End If Abbruch: If m_oError.HasAnError Then m_oError.ShowError(MsgBoxStyle.Exclamation, m_sScriptName) End If End Sub ' Objekte die in allen Funkionen verwendet werden können. 'Private Shared m_oACTApp As Act.UI.ActApplication 'Private Shared m_oAutoData As Melville_Schellmann.ACTOptimum3.Control.AutoData3.AutoDataScript Private Shared m_sScriptName As String Private Shared m_oError As ErrorHandling.BaseErrorMessage Private Shared Function TryGetFullPathNameFromGroup(oGroupManager As act.Framework.groups.GroupManager, oGroup As act.Framework.Groups.Group, ByRef sGroupPathName As String)As Boolean Dim bTry As Boolean bTry = False If oGroup Is Nothing Then m_oError.SetError("Es wurde keine Gruppe übergeben.") GoTo Abbruch End If Dim oPath As System.text.StringBuilder Dim oCurrentGroup As act.Framework.Groups.Group oPath = New System.text.StringBuilder oCurrentGroup = oGroup While Not oCurrentGroup Is Nothing If oPath.Length = 0 Then oPath.Append(oCurrentGroup.Name) Else oPath.Insert(0, "\") oPath.Insert(0, oCurrentGroup.Name) End If If oCurrentGroup.HierarchyLevel > 0 Then oCurrentGroup = oGroupManager.GetGroupsByID(Nothing, New GUID() {oCurrentGroup.parentid})(0) Else oCurrentGroup = Nothing End If End While sGroupPathName = oPath.ToString bTry = True Abbruch: Return bTry End Function Private Shared Function EnsureValidEntity(oView As Act.UI.IView) As Boolean Dim bReturn As Boolean Select Case True Case TypeOf(oView) Is act.UI.IContactDetailView bReturn = CType(oview, act.UI.icontactdetailview).Save If bReturn = False Then m_oError.SetError("Der aktuelle Kontakt muss zuvor gespeichert werden.") End If Case TypeOf(oView) Is act.UI.ICompanyDetailView bReturn = CType(oview, act.UI.icompanydetailview).Save If bReturn = False Then m_oError.SetError("Die aktuelle Firma muss zuvor gespeichert werden.") End If Case TypeOf(oView) Is act.UI.IGroupDetailView bReturn = CType(oview, act.UI.igroupdetailview).Save If bReturn = False Then m_oError.SetError("Die aktuelle Gruppe muss zuvor gespeichert werden.") End If Case TypeOf(oView) Is act.UI.IOpportunityDetail bReturn = CType(oview, act.UI.iopportunitydetailview).Save If bReturn = False Then m_oError.SetError("Die aktuelle Verkaufschance muss zuvor gespeichert werden.") End If Case Else bReturn = True End Select Return bReturn End Function #Region "BulkMailer Classes" Class BulkMailer Inherits ErrorHandling.BaseErrorMessage Private m_oACTApp As Act.UI.ActApplication Private m_oConfig As BulkMailerConfiguration Private m_frmMailingSelection As FormMailingSelection Private m_sAddressDBPath As String Private m_sExludeDBPath As String Private m_sMailingDBPath As String Private m_sOutboxDirectory As String Private m_sLogDirectory As String Private m_sTemplateDirectory As String Private m_sConfigKeyAddressDBPath As String Private m_sConfigKeyExcludeDBPath As String Private m_sConfigKeyMailingDBPath As String Private m_sConfigKeyOutboxDir As String Private m_sDBUserName As String Private m_sDBUserPassword As String Public Sub New(oACTApp As Act.UI.ActApplication) m_oACTApp = oACTApp m_oConfig = New BulkMailerConfiguration m_sConfigKeyAddressDBPath = "AdressenPath" m_sConfigKeyExcludeDBPath = "ExcludePath" m_sConfigKeyMailingDBPath = "MailingsPath" m_sConfigKeyOutboxDir = "OutboxDir" m_sDBUserName = "Admin" m_sDBUserPassword = String.Empty End Sub Public Function TryInit(ProfileName As String) As Boolean Dim bTry As Boolean bTry = False ClearError If m_oConfig.TryReadConfiguration = False Then SetError(m_oConfig, "Es ist ein Fehler bei der Initialisierung des BulkMailers aufgetreten.") GoTo Abbruch End If ' Get AddressDB Path If m_oConfig.TryGetProfileSetting(ProfileName, m_sConfigKeyAddressDBPath, m_sAddressDBPath) = False Then SetError(m_oConfig, "Es ist ein Fehler bei der Initialisierung des BulkMailers aufgetreten.") GoTo Abbruch End If If System.IO.File.Exists(m_sAddressDBPath) = False Then SetError("Es konnte nicht die Adressendatenbank '{0}' für das BulkMailer Profil '{1}' gefunden werden.", m_sAddressDBPath, ProfileName) GoTo Abbruch End If ' Get ExcludeDB Path If m_oConfig.TryGetProfileSetting(ProfileName, m_sConfigKeyExcludeDBPath, m_sExludeDBPath) = False Then SetError(m_oConfig, "Es ist ein Fehler bei der Initialisierung des BulkMailers aufgetreten.") GoTo Abbruch End If If System.IO.File.Exists(m_sExludeDBPath) = False Then SetError("Es konnte nicht die Ausschlußdatenbank '{0}' für das BulkMailer Profil '{1}' gefunden werden.", m_sAddressDBPath, ProfileName) GoTo Abbruch End If ' Get Mailing DB Path If m_oConfig.TryGetProfileSetting(ProfileName, m_sConfigKeyMailingDBPath, m_sMailingDBPath) = False Then SetError(m_oConfig, "Es ist ein Fehler bei der Initialisierung des BulkMailers aufgetreten.") GoTo Abbruch End If If System.IO.File.Exists(m_sMailingDBPath) = False Then SetError("Es konnte nicht die Mailingdatenbank '{0}' für das BulkMailer Profil '{1}' gefunden werden.", m_sAddressDBPath, ProfileName) GoTo Abbruch End If ' Den Pfad für das LogDir und TemplateDir über den OutboxDir Konfigurationswert ermitteln If m_oConfig.TryGetProfileSetting(ProfileName, m_sConfigKeyOutboxDir, m_sOutboxDirectory) = False Then SetError(m_oConfig, "Es ist ein Fehler bei der Initialisierung des BulkMailers aufgetreten.") GoTo Abbruch End If m_sOutboxDirectory = System.IO.Path.GetDirectoryName(m_sOutboxDirectory) ' \ am Ende entfernen m_sLogDirectory = m_sOutboxDirectory.Substring(0, m_sOutboxDirectory.LastIndexOf(System.IO.Path.DirectorySeparatorChar)) ' Letzten Unterordner abschneiden -> C:\Users\Administrator\AppData\Roaming\Kroll-Software\BulkMailer\Profile-00000001 m_sTemplateDirectory = System.IO.Path.Combine(m_sLogDirectory, "Templates") m_sLogDirectory = System.IO.Path.Combine(m_sLogDirectory, "LogFiles") bTry = True Abbruch: Return bTry End Function Public Function TryTransferEntitiesToAddressList(oEntities As Act.Framework.MutableEntities.MutableEntityList, oFieldEmail As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, oFieldMappings As System.Collections.Generic.Dictionary(Of String, Act.Framework.MutableEntities.MutableEntityFieldDescriptor), sVerteiler As String) As Boolean Dim bTry As Boolean bTry = False ClearError Dim oStatus As StatusManager = Nothing Dim oAddressDB As AddressDatabase = Nothing If oEntities Is Nothing OrElse oEntities.Count = 0 Then SetError("Es wurden keine Act!-Datensätze übergeben.") GoTo Abbruch End If If oFieldMappings Is Nothing OrElse oFieldMappings.Count = 0 Then SetError("Es wurden keine Feldzuordnungen übergeben.") GoTo Abbruch End If Dim i As Integer Dim oEntity As Act.Framework.MutableEntities.MutableEntity = Nothing Dim lBMAddressID As Integer Dim sBMFieldName As String Dim oValue As Object Dim bAddressExist As Boolean Dim bDebug As Boolean Dim lCountChanges As Integer Dim lCountIgnored As Integer Dim lCountCreated As Integer Dim oFieldValueList As System.Collections.Generic.Dictionary(Of String,Object) = Nothing Dim oActIDAddressIDList As System.Collections.Generic.Dictionary(Of System.Guid,Integer) = Nothing Dim oAddressIDVerteilerList As System.Collections.Generic.List(Of Integer) = Nothing Dim lVerteilerID As Integer Dim bVerteilerExist As Boolean bDebug = False ' DEBUG Modus oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Verbindung zur Datenbank wird erstellt...", False) oAddressDB = New AddressDatabase(System.IO.Path.GetDirectoryName(m_sAddressDBPath), System.IO.Path.GetFileName(m_sAddressDBPath), m_sDBUserName, m_sDBUserPassword) If oAddressDB.TryConnect = False Then SetError(oAddressDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sAddressDBPath) GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Vorhandene BulkMailer-Daten werden ermittelt...", 0, 1, False) If oAddressDB.TryGetAddressIDsWithActID(oActIDAddressIDList) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Ermitteln der vorhandenen Daten im BulkMailer aufgetreten.") GoTo Abbruch End If oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus(String.Format("Es wurden {0} Datensätze im BulkMailer mit Act!-IDs gefunden.", oActIDAddressIDList.Keys.Count), 0, 1, True) oStatus.PrintStatus("Act!-Daten werden mit den BulkMailer-Daten abgeglichen...", 0, oEntities.Count, False) If bDebug Then oStatus.PrintStatus("DEBUG", True) lCountChanges = 0 lCountCreated = 0 lCountIgnored = 0 ' Liste der Feldwerte erstellen (Key=Feldname,Value=Object) oFieldValueList = New System.Collections.Generic.Dictionary(Of String,Object) For Each sBMFieldName In oFieldMappings.Keys oFieldValueList.Add(sBMFieldName, Nothing) Next 'Liste der AddressIDs erstellen, die später mit dem Verteiler (Act! Gruppenname) verknüpft werden oAddressIDVerteilerList = New System.Collections.Generic.List(Of Integer) For i = 0 To oEntities.Count - 1 oStatus.SetProgress(i + 1) oStatus.SetState(String.Format("({0} von {1})", i + 1, oEntities.Count)) oEntity = oEntities.GetEntity(i) If String.IsNullOrEmpty(oFieldEmail.GetValue(oEntity))Then If bDebug Then oStatus.PrintStatus(String.Format("Der Act!-Datensatz mit der GUID '{0}' hat keine E-Mail-Adresse. Er wird nicht übertragen.", oEntity.ID, True)) lCountIgnored += 1 Continue For End If bAddressExist = False If oActIDAddressIDList.ContainsKey(oEntity.ID) Then bAddressExist = True lBMAddressID = oActIDAddressIDList(oEntity.ID) End If If bAddressExist = False Then ' Adresse neu im BulkMailer anlegen If bDebug Then oStatus.PrintStatus("Neuerdatensatz mit Act!-ID " & oEntity.ID.ToString, True) If oAddressDB.TryCreateNewAddressItem(oEntity.ID) = False Then SetError(oAddressDB, "Es konnte keine neue Adresse mit der Act!-ID '{0}' erstellt werden.", oEntity.ID.tostring) GoTo Abbruch End If ' Neue AdressID abfragen If oAddressDB.TryGetAddressIDFromActID(oEntity.ID, lBMAddressID, bAddressExist) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Transfer der Daten zum BulkMailer aufgetreten.") GoTo Abbruch End If If Not bAddressExist Then SetError("Die Adresse mit der Act!-ID '{0}' wurde nicht erstellt.", oEntity.ID) GoTo Abbruch End If lCountCreated += 1 End If ' Alle Feldwerte von dem BM Datensatz holen If oAddressDB.TryGetAddressValues(lBMAddressID, oFieldValueList) = False Then SetError(oAddressDB, "Es konnten die Feldwerte nicht abgefragt werden.") GoTo Abbruch End If ' Feldwerte in der Adresse überschreiben For Each sBMFieldName In oFieldMappings.Keys oValue = oFieldMappings.item(sBMFieldName).getValue(oEntity) Dim oBMValue As Object ' If oAddressDB.TryGetAddressValue(lBMAddressID, sBMFieldName, oBMValue) = False Then ' SetError(oAddressDB, "Es konnte ein Feldwert nicht abgefragt werden.") ' GoTo Abbruch ' End If oBMValue = oFieldValueList.item(sBMFieldName) If oValue Is Nothing Then If oBMValue Is Nothing OrElse TypeOf oBMValue Is DBNull Then If bDebug Then oStatus.PrintStatus("Datensatz " & oEntity.ID.ToString & " " & sBMFieldName & " beide Null.", True) Continue For End If Else If Not oBMValue Is Nothing AndAlso Not TypeOf oBMValue Is DBNull Then If String.Compare(oValue.ToString, oBMValue.ToString, False) = 0 Then If bDebug Then oStatus.PrintStatus("Datensatz " & oEntity.ID.ToString & " " & sBMFieldName & " beide gleich.", True) Continue For End If End If End If If oAddressDB.TrySetAddressValue(lBMAddressID, sBMFieldName, oValue) = False Then SetError(oAddressDB, "Es konnte ein Feldwert nicht gesetzt werden.") GoTo Abbruch End If lCountChanges += 1 If Not oValue Is Nothing Then If bDebug Then oStatus.PrintStatus("Datensatz " & oEntity.ID.ToString & " " & sBMFieldName & " = " & oValue.ToString, True) Else If bDebug Then oStatus.PrintStatus("Datensatz " & oEntity.ID.ToString & " " & sBMFieldName & " = Nothing", True) End If Next ' Die AddressID in der Liste für die Verteilerverknüpfungen merken oAddressIDVerteilerList.Add(lBMAddressID) If oStatus.Canceled Then Exit For End If Next oStatus.PrintStatus("OK", 0, 1, True) ' Verteiler erstellen bzw. seine bisherigen Verknüpfungen löschen bVerteilerExist = False oStatus.PrintStatus(String.Format("Ermittel Verteiler '{0}'...", sVerteiler), False) If oAddressDB.TryGetVerteilerIDFromVerteilerName(sVerteiler, lVerteilerID, bVerteilerExist) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Transfer der Daten zum BulkMailer aufgetreten.") GoTo Abbruch End If If bVerteilerExist = False Then If oAddressDB.TryCreateNewVerteilerItem(sVerteiler) = False Then SetError(oAddressDB, "Es konnte kein neuer Verteiler '{0}' erstellt werden.", sVerteiler) GoTo Abbruch End If If oAddressDB.TryGetVerteilerIDFromVerteilerName(sVerteiler, lVerteilerID, bVerteilerExist) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Transfer der Daten zum BulkMailer aufgetreten.") GoTo Abbruch End If If Not bVerteilerExist Then SetError("Der Verteiler '{0}' wurde nicht erstellt.", sVerteiler) GoTo Abbruch End If End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus(String.Format("Entferne Verknüpfungen im Verteiler '{0}'...", sVerteiler), False) If oAddressDB.TryRemoveRelationsForVerteilerID(lVerteilerID) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Transfer der Daten zum BulkMailer aufgetreten.") GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus(String.Format("Erstelle neue Verknüpfungen für Verteiler '{0}'...", sVerteiler), 0, oAddressIDVerteilerList.Count, False) For i = 0 To oAddressIDVerteilerList.Count - 1 oStatus.SetProgress(i + 1) If oAddressDB.TryCreateNewRelationForVerteilerIDAndAddressID(lVerteilerID, oAddressIDVerteilerList.item(i)) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Transfer der Daten zum BulkMailer aufgetreten.") GoTo Abbruch End If Next Abbruch: If Not oAddressDB Is Nothing Then oAddressDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) oStatus.PrintStatus(String.format("Bitte aktualisieren Sie mit F5 im BulkMailer die Ansicht und markieren Sie den Verteiler '{0}'.", sVerteiler), 0, 1, True) End If End If If lCountIgnored > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Act!-Datensätze ignoriert.", lCountIgnored), 0, 1, True) End If If lCountCreated > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} neue Adresse(n) angelegt.", lCountCreated), 0, 1, True) End If If lCountChanges > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Änderung(en) in den Adressen durchgeführt.", lCountChanges), 0, 1, True) End If oStatus.ShowDialog(False) ClearError bTry = True Return bTry End Function Public Function TryTransferEntitiesLookupToExcludeList(oEntities As Act.Framework.Contacts.ContactList, oFieldEmail As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, oFieldReason As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean Dim bTry As Boolean bTry = False ClearError Dim oStatus As StatusManager = Nothing Dim oExcludeDB As ExcludeDatabase = Nothing If oEntities Is Nothing OrElse oEntities.Count = 0 Then SetError("Es gibt keine Entitäten.") GoTo Abbruch End If Dim bDebug As Boolean Dim lCountIgnored As Integer Dim lCountCreated As Integer Dim oExcludeListStatic As System.Collections.Generic.Dictionary(Of String,Exclusion) = Nothing Dim oExcludeListWildcard As System.Collections.Generic.List(Of Exclusion) = Nothing Dim oExclusion As Exclusion Dim oExclusionWildcard As Exclusion = Nothing Dim oEntity As Act.Framework.MutableEntities.MutableEntity Dim i As Integer bDebug = False ' DEBUG Modus lCountIgnored = 0 lCountCreated = 0 oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Verbindung zur Datenbank wird erstellt...", False) oExcludeDB = New ExcludeDatabase(System.IO.Path.GetDirectoryName(m_sExludeDBPath), System.IO.Path.GetFileName(m_sExludeDBPath), m_sDBUserName, m_sDBUserPassword) If oExcludeDB.TryConnect = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sExludeDBPath) GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Vorhandene BulkMailer-Daten werden ermittelt...", 0, 1, False) If oExcludeDB.TryGetExcludeLists(oExcludeListStatic, oExcludeListWildcard) = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Ermitteln der Ausschlußliste vom BulkMailer aufgetreten.") GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Act!-Daten werden übetragen...", 0, oEntities.Count, True) For i = 0 To oEntities.Count - 1 oStatus.SetProgress(i + 1) oStatus.SetState(String.Format("({0} von {1})", i + 1, oEntities.Count)) oEntity = oEntities.GetEntity(i) oExclusion = New Exclusion oExclusion.BM_EMail = oFieldEmail.GetValue(oEntity) oExclusion.BM_Reason = oFieldReason.GetValue(oEntity) oExclusion.BM_Created = Date.Now If String.IsNullOrEmpty(oExclusion.BM_EMail) Then oStatus.PrintStatus(String.Format("Der Act!-Datensatz mit der GUID '{0}' hat keine E-Mail-Adresse. Er wird nicht in die Ausschlußliste übertragen.", oEntity.ID), True) lCountIgnored += 1 Continue For End If If oExclusion.isWildcard Then oStatus.PrintStatus(String.Format("Die E-Mail-Adresse '{0}' stellt einen Platzhalter dar. Diese werden nicht in die Ausschlußliste übertragen.", oExclusion.BM_EMail), True) lCountIgnored += 1 Continue For End If If oExcludeListStatic.ContainsKey(oExclusion.getKey) Then oStatus.PrintStatus(String.Format("Die E-Mail-Adresse '{0}' ist bereits in der Ausschlußliste enthalten.", oExclusion.BM_EMail), True) lCountIgnored += 1 Continue For End If If MatchWildcardInList(oExclusion, oExcludeListWildcard, oExclusionWildcard) = True Then oStatus.PrintStatus(String.Format("Die E-Mail-Adresse '{0}' wird durch den Platzhalter '{1}' aus der Ausschlußliste bereits abgedeckt.", oExclusion.BM_EMail, oExclusionWildcard.BM_EMail), True) lCountIgnored += 1 Continue For End If oStatus.PrintStatus(String.Format("Trage '{0}' in die Ausschlußliste ein...", oExclusion.BM_EMail), False) If oExcludeDB.TryCreateExcludeItem(oExclusion) = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Erstellen des Ausschlusses für die E-Mail-Adresse '{0}' aufgetreten.", oExclusion.BM_EMail) GoTo Abbruch End If oExcludeListStatic.Add(oExclusion.getKey, oExclusion) lCountCreated += 1 oStatus.PrintStatus("OK", True) If oStatus.Canceled = True Then Exit For End If Next Abbruch: If Not oExcludeDB Is Nothing Then oExcludeDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) oStatus.PrintStatus("Bitte aktualisieren Sie mit F5 im BulkMailer die Ansicht.", 0, 1, True) End If End If If lCountCreated > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} neue E-Mail-Adresse(n) der Ausschlußliste hinzugefügt.", lCountCreated), 0, 1, True) End If If lCountIgnored > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Act!-Kontakt(e) ignoriert.", lCountIgnored), 0, 1, True) End If oStatus.ShowDialog(False) ClearError bTry = True Return bTry End Function Public Function TrySelectMailing(ByRef oMailingNode As MailingNode) As Boolean Dim bTry As Boolean = False Dim oMailingDB As MailingDatabase = Nothing Dim oRootNode As MailingNode = Nothing Dim oSelectedMailing As MailingNode = Nothing ClearError ' Mit Mailing Datenbank verbinden oMailingDB = New MailingDatabase(System.IO.Path.GetDirectoryName(m_sMailingDBPath), System.IO.Path.GetFileName(m_sMailingDBPath), m_sDBUserName, m_sDBUserPassword) If oMailingDB.TryConnect = False Then SetError(oMailingDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sMailingDBPath) GoTo Abbruch End If ' Baumstruktur der Mailings einlesen If oMailingDB.TryGetMailingsTree(oRootNode) = False Then SetError(oMailingDB, "Es ist ein Fehler beim Ermitteln der Mailings aufgetreten.") GoTo Abbruch End If ' Mailing Datenbank schließen oMailingDB.Disconnect ' Mailing Auswahlfenster initialisieren und dann anzeigen lassen m_frmMailingSelection = New FormMailingSelection m_frmMailingSelection.Icon = Icons.ResIcons.ACTOptimum_AutoData m_frmMailingSelection.ilTree.Images.Add(Act.Shared.Images.ImageManager.GetIcon("folder.ico")) m_frmMailingSelection.ilTree.Images.Add(Act.Shared.Images.ImageManager.GetIcon("envelope.ico")) 'frmMailingSelection.ilTree.Images.Add(icons.ResIcons.ACT_History) 'frmMailingSelection.ilTree.Images.Add(icons.ResIcons.object_document) m_frmMailingSelection.tvMailings.ImageIndex = 0 m_frmMailingSelection.tvMailings.ImageList = m_frmMailingSelection.ilTree m_frmMailingSelection.tvMailings.Nodes.Add(oRootNode) m_frmMailingSelection.tvMailings.ExpandAll AddHandler m_frmMailingSelection.tvMailings.AfterSelect, AddressOf tvMailings_AfterSelect If m_frmMailingSelection.ShowDialog(m_oACTApp) = DialogResult.Cancel Then GoTo Abbruch End If ' Das ausgewählte Mailing abfragen oMailingNode = CType(m_frmMailingSelection.tvMailings.SelectedNode, MailingNode) bTry = True Abbruch: If Not oMailingDB Is Nothing Then oMailingDB.Disconnect If Not m_frmMailingSelection Is Nothing Then m_frmMailingSelection.Hide m_frmMailingSelection = Nothing End If Return bTry End Function Public Function TryCreateActLookupFromExcludeList(oFieldEmail As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean Dim bTry As Boolean = False ClearError Dim oExcludeDB As ExcludeDatabase = Nothing Dim oStatus As StatusManager = Nothing Dim bDebug As Boolean Dim lCountExcluded As Integer Dim oExcludeListStatic As System.Collections.Generic.Dictionary(Of String,Exclusion) = Nothing Dim oExcludeListWildcard As System.Collections.Generic.List(Of Exclusion) = Nothing Dim oExclusion As Exclusion Dim oIDList As System.Collections.Generic.Dictionary(Of System.GUID, Exclusion) Dim i,j As Integer bDebug = False ' DEBUG Modus lCountExcluded = 0 oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Verbindung zur Datenbank wird erstellt...", False) oExcludeDB = New ExcludeDatabase(System.IO.Path.GetDirectoryName(m_sExludeDBPath), System.IO.Path.GetFileName(m_sExludeDBPath), m_sDBUserName, m_sDBUserPassword) If oExcludeDB.TryConnect = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sExludeDBPath) GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Vorhandene BulkMailer-Daten werden ermittelt...", 0, 1, False) If oExcludeDB.TryGetExcludeLists(oExcludeListStatic, oExcludeListWildcard) = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Ermitteln der Ausschlußliste vom BulkMailer aufgetreten.") GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Statische Ausschlüße werden verarbeitet...", 0, oExcludeListStatic.Count, False) Dim oCriteriaColumn As act.Framework.Lookups.CriteriaColumn Dim oLookupCriteria As Act.Framework.Lookups.Criteria Dim oContacts As Act.Framework.Contacts.ContactList Dim aCriteria (0) As Act.Framework.Lookups.Criteria oCriteriaColumn = m_oACTApp.ActFramework.Lookups.GetCriteriaColumn(oFieldEmail) oIDList = New System.Collections.Generic.Dictionary(Of System.Guid,Exclusion) i = -1 For Each oExclusion In oExcludeListStatic.Values i += 1 oStatus.SetProgress(i + 1) If oStatus.Canceled = True Then Exit For End If oLookupCriteria = New Act.Framework.Lookups.Criteria(act.Framework.Lookups.LogicalOperator.End, 0, 0, oCriteriaColumn, Act.Framework.Lookups.OperatorEnum.EqualTo, oExclusion.BM_EMail) aCriteria(0) = oLookupCriteria oContacts = m_oACTApp.ActFramework.Lookups.LookupContactsReplace(aCriteria, True, True).GetContacts(Nothing) If oContacts Is Nothing OrElse oContacts.Count = 0 Then Continue For End If For j = 0 To oContacts.Count - 1 If Not oIDList.ContainsKey(oContacts.item(j).id) Then oIDList.Add(oCOntacts.item(j).id, oExclusion) lCountExcluded += 1 End If Next Next oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Platzhalter Ausschlüße werden verarbeitet...", 0, oExcludeListWildcard.Count, False) i = -1 For Each oExclusion In oExcludeListWildcard i += 1 oStatus.SetProgress(i + 1) If oStatus.Canceled = True Then Exit For End If If oExclusion.GetSQLLikeWildCard.EndsWith("%") Then oLookupCriteria = New Act.Framework.Lookups.Criteria(act.Framework.Lookups.LogicalOperator.End, 0, 0, oCriteriaColumn, Act.Framework.Lookups.OperatorEnum.Contains, oExclusion.GetSQLLikeWildCard) Else oLookupCriteria = New Act.Framework.Lookups.Criteria(act.Framework.Lookups.LogicalOperator.End, 0, 0, oCriteriaColumn, Act.Framework.Lookups.OperatorEnum.EndsWith, oExclusion.GetSQLLikeWildCard) End If aCriteria(0) = oLookupCriteria oContacts = m_oACTApp.ActFramework.Lookups.LookupContactsReplace(aCriteria, True, True).GetContacts(Nothing) If oContacts Is Nothing OrElse oContacts.Count = 0 Then Continue For End If For j = 0 To oContacts.Count - 1 If Not oIDList.ContainsKey(oCOntacts.item(j).id) Then oIDList.Add(oCOntacts.item(j).id, oExclusion) lCountExcluded += 1 End If Next Next If lCountExcluded > 0 Then ' GUIDs in einen Array kopieren und dann die aktuelle ACT! Suche erstellen Dim aGuid(lCountExcluded-1) As System.Guid oIDList.Keys.CopyTo(aGuid, 0) oContacts = m_oACTApp.ActFramework.Contacts.GetContactsByID(Nothing, aGuid) 'm_oACTApp.UIContactManager.PopupShowContacts(oContacts) 'm_oACTApp.UILookupManager.LookupContacts(oContacts) m_oACTApp.UILookupManager.LookupContactsAndShowView(oContacts) End If Abbruch: If Not oExcludeDB Is Nothing Then oExcludeDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) End If End If If lCountExcluded > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Datensätze in Act! ermittelt, die durch die Ausschlußliste betroffen sind.", lCountExcluded), 0, 1, True) End If oStatus.ShowDialog(False) ClearError bTry = True Return bTry End Function Public Function TryCreateActHistoriesFromLog(oMailing As MailingNode, sDetails As String, oGroup As Act.Framework.Groups.Group) As Boolean Dim bTry As Boolean = False Dim bDebug = True ' DEBUG Modus Dim oStatus As StatusManager = Nothing Dim oLogDB As LogDatabase = Nothing Dim oAddressDB As AddressDatabase = Nothing Dim lCountAll As Integer Dim lCountCreated As Integer Dim lCountIgnored As Integer Dim i As Integer Dim oLogItem As LogItem = Nothing Dim oLogs As System.Collections.Generic.List(Of LogItem) = Nothing Dim oActHsitoryTypeEmailSend As Act.Framework.Histories.HistoryType Dim oActHsitoryTypeEmailNotSend As Act.Framework.Histories.HistoryType Dim aACTID() As System.Guid = Nothing ClearError ' Status Fenster initialisieren und anzeigen lassen oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Vorhandene BulkMailer-Daten werden ermittelt...", 0, 1, False) ' Die Log Datenbank zu dem ausgewählten Mailing öffnen oLogDB = New LogDatabase(m_sLogDirectory, oMailing.BM_LogDBPath, m_sDBUserName, m_sDBUserPassword) If oLogDB.TryConnect = False Then SetError(oLogDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", oMailing.BM_LogDBPath) GoTo Abbruch End If ' Alle Logs aus der Datenabnk einlesen If oLogDB.TryGetLogs(oLogs) = False Then SetError(oLogDB, "Es ist ein Fehler beim Ermitteln der BulkMailer-Daten aufgetreten.") GoTo Abbruch End If ' Log Datenbank schließen oLogDB.Disconnect If oLogs.Count = 0 Then SetError("Es wurden keine Sendeprotokolle gefunden.") GoTo Abbruch End If oStatus.PrintStatus("OK", True) ' Falls gerade die Gruppen-Detailansicht mit der Registerkarte Historien angezeigt wird, sollte in die Registerkarte Kontakte gewechselt werden. If TypeOf(m_oACTApp.CurrentView) Is act.UI.IGroupDetailView Then Dim oTabControl As System.Windows.Forms.TabControl oTabControl = GetControl(m_oACTApp.CurrentView, GetType(System.Windows.Forms.TabControl), "Tabs") If Not oTabControl Is Nothing Then If String.Compare(oTabControl.SelectedTab.Name, "historyTab", True) = 0 And oTabControl.SelectedIndex > 0 Then oTabControl.SelectedIndex = 0 oStatus.PrintStatus(String.Format("Es wurde auf die Registerkarte '{0}' gewechselt.", oTabControl.TabPages.item(0).Text), True) End If End If End If lCountCreated = 0 lCountIgnored = 0 lCountAll = oLogs.Count oStatus.PrintStatus("BulkMailer-Sendeprotokolle werden übertragen...", 0, lCountAll - 1, False) If bDebug Then oStatus.PrintStatus("DEBUG", True) ' Die Act! Historien Typen ermitteln oActHsitoryTypeEmailSend = New Act.Framework.Histories.historytype(Act.Framework.Histories.SystemHistoryType.EmailSent) If oActHsitoryTypeEmailSend Is Nothing Then SetError("Es konnte der Act!-Historientyp '{0}' nicht gefunden werden.", act.Framework.Histories.SystemHistoryType.EmailSent.ToString) GoTo Abbruch End If oActHsitoryTypeEmailNotSend = New Act.Framework.Histories.HistoryType(Act.Framework.Histories.SystemHistoryType.EmailNotSent) If oActHsitoryTypeEmailNotSend Is Nothing Then SetError("Es konnte der Act!-Historientyp '{0}' nicht gefunden werden.", act.Framework.Histories.SystemHistoryType.EmailNotSent) GoTo Abbruch End If ' Mit Adress Datenbank verbinden oAddressDB = New AddressDatabase(System.IO.Path.GetDirectoryName(m_sAddressDBPath), System.IO.Path.GetFileName(m_sAddressDBPath), m_sDBUserName, m_sDBUserPassword) If oAddressDB.TryConnect = False Then SetError(oAddressDB, "Es ist ein Fehler beim Übertragen der BulkMailer-Sendeprotokolle aufgetreten.") GoTo Abbruch End If 'Durchlauf aller Log Einträge in der Logs Liste For i = 0 To lCountAll - 1 oStatus.SetProgress(i) oStatus.SetState(String.Format("({0} von {1})", i + 1, lCountAll)) oLogItem = oLogs.item(i) If oStatus.Canceled Then Exit For End If If String.IsNullOrEmpty(oLogItem.BM_EMail) Then If bDebug Then oStatus.PrintStatus(String.Format("Protokolleintrag[ID={0}] ignoriert: Es gibt keine E-Mail-Adresse.", oLogItem.BM_ID), True) lCountIgnored += 1 Continue For End If ' Die Act! GUIDs ermitteln aus der Adress Datenbank, es können mehrere sein, da die E-Mail-Adresse als Kriterium nicht eindeutig ist. If oAddressDB.TryGetACTIDsFromEmail(oLogItem.BM_EMail, aACTID) = False Then SetError(oAddressDB, "Es ist ein Fehler beim Übertragen der BulkMailer-Sendeprotokolle aufgetreten.") GoTo Abbruch End If If aACTID.Length = 0 Then If bDebug Then oStatus.PrintStatus(String.Format("Protokolleintrag[ID={0}] ignoriert: Zu der E-Mail-Adresse '{1}' gibt es keine Adresse mit einer Act!-ID.", oLogItem.BM_ID, oLogItem.BM_EMail), True) lCountIgnored += 1 Continue For End If ' Gibt es in Act! bereits einen Historieneintrag ? If ACTHistoryExist(aACTID, oMailing.BM_LogDBPath, oMailing.BM_ID, oLogItem.BM_ID) Then If bDebug Then oStatus.PrintStatus(String.Format("Protokolleintrag[ID={0}] ignoriert: Es existiert bereits ein Act!-Historieneintrag.", oLogItem.BM_ID), True) lCountIgnored += 1 Continue For End If Dim sRegarding As String Dim oDetail As System.Text.StringBuilder Dim oHistoryType As act.Framework.Histories.HistoryType Dim oStartDate As Date Dim lDuration As Integer sRegarding = String.Format("[{0},{1}] {2}", oMailing.BM_ID, oLogItem.BM_ID, oMailing.BM_Betreff) oDetail = New System.Text.StringBuilder oDetail.AppendLine(String.Format("Status: {0}", oLogItem.BM_Status)) oDetail.AppendLine(String.Format("Mailing: {0}", oMailing.FullPathWithoutRootNode)) oDetail.AppendLine(String.Format("E-Mail: {0}", oLogItem.BM_EMail)) oDetail.AppendLine(String.Format("LogDB: {0}", oMailing.BM_LogDBPath)) oDetail.AppendLine(String.Format("Details:", oLogItem.BM_EMail)) oDetail.AppendLine(String.Format("{0}", sDetails)) 'oDetail.AppendLine(String.Format("LogDB: {0}", oMailing.BM_LogDBPath)) If oLogItem.BM_StatusOK Then oHistoryType = oActHsitoryTypeEmailSend Else oHistoryType = oActHsitoryTypeEmailNotSend End If oStartDate = oLogItem.BM_created lDuration = 0 If TryCreateActHistory(aACTID, oGroup, oHistoryType, oStartDate, lDuration, sRegarding, oDetail.ToString) = False Then If bDebug Then oStatus.PrintStatus(String.Format("Eintrag[ID={0}] ignoriert: Fehler bei der Erstellung der Act!-Historie. {1}", oLogItem.BM_ID, Me.ErrorMessage), True) ClearError lCountIgnored += 1 Continue For End If lCountCreated += 1 If oStatus.Canceled Then Exit For End If Next Abbruch: If Not oAddressDB Is Nothing Then oAddressDB.Disconnect If Not oLogDB Is Nothing Then oLogDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) End If End If If lCountCreated > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} neue Act!-Historie(n) angelegt.", lCountCreated), 0, 1, True) End If If lCountIgnored > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Sendeprotokolleinträg(e) ignoriert.", lCountIgnored), 0, 1, True) End If oStatus.ShowDialog(False) ClearError bTry = True Return bTry End Function Public Function TryAttachMailingFilesToActGroup(oMailing As MailingNode) As Boolean Dim bTry As Boolean = False Dim oStatus As StatusManager = Nothing Dim oGroup As Act.Framework.Groups.Group Dim sACT2BMTemplatesFolder As String Dim sTemplateFileName As String Dim sTemplateFileExtension As String = String.Empty Dim lCountAttachments As Integer = 0 Dim sFileName As String Dim oFileInfo As System.IO.FileInfo Dim oAttachments As System.Collections.Generic.List(Of Attachment) = Nothing Dim oAttachment As Attachment = Nothing Dim oMailingDB As MailingDatabase = Nothing Dim i As Integer ClearError ' Status Fenster initialisieren und anzeigen lassen oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Ermittel aktuelle Act! Gruppe...", 0, 10, False) oGroup = m_oACTApp.ApplicationState.CurrentGroup If oGroup Is Nothing Then SetError("Es gibt keine aktuelle Gruppe in Act!.") GoTo Abbruch End If oStatus.PrintStatus("OK", 0, 10, True) oStatus.PrintStatus("Ermittel Act2BulkMailer-Vorlagenordner...", 1, 10, False) sACT2BMTemplatesFolder = System.IO.Path.Combine(m_sTemplateDirectory, "Act2BulkMailer") If Not System.IO.Directory.Exists(sACT2BMTemplatesFolder) Then Try System.IO.Directory.CreateDirectory(sACT2BMTemplatesFolder) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Erstellen des Ordners '{0}' aufgetreten.", sACT2BMTemplatesFolder) GoTo Abbruch End Try End If sTemplateFileName = GetCleanFileName(oMailing.FullPathWithoutRootNode) oStatus.PrintStatus("OK", 1, 10, True) Select Case oMailing.BM_Type Case Bulkmailer.MailingType.Text sTemplateFileExtension = "txt" Case BulkMailer.MailingType.HTML sTemplateFileExtension = "htm" End Select sTemplateFileName = System.IO.Path.ChangeExtension(sTemplateFileName, sTemplateFileExtension) oStatus.PrintStatus(String.Format("Speichere Vorlage '{0}'...", sTemplateFileName), 1, 10, False) sFileName = System.IO.Path.Combine(sACT2BMTemplatesFolder, sTemplateFileName) Try If System.IO.File.Exists(sFilename) Then System.IO.File.Delete(sFileName) End If System.IO.File.WriteAllText(sFileName, oMailing.BM_Nachricht) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Speichern der Mailing-Vorlage in die Datei '{0}' aufgetreten.", sFileName) GoTo Abbruch End Try oFileInfo = New System.IO.FileInfo(sFilename) oStatus.PrintStatus("OK", 1, 10, True) oStatus.PrintStatus(String.Format("Erstelle Act!-Dokumenteneintrag für die Datei '{0}' bei der Act! Gruppe '{1}'...", sTemplateFileName, oGroup.Name), 5, 10, False) If TryAttachFileToActGroup(oGroup, oFileInfo) = False Then GoTo Abbruch End If oStatus.PrintStatus("OK", 5, 10, True) ' Eventuelle Anlagen des Mailings auch in der Act! Gruppe anhängen ' Mit Mailing Datenbank verbinden oMailingDB = New MailingDatabase(System.IO.Path.GetDirectoryName(m_sMailingDBPath), System.IO.Path.GetFileName(m_sMailingDBPath), m_sDBUserName, m_sDBUserPassword) If oMailingDB.TryConnect = False Then SetError(oMailingDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sMailingDBPath) GoTo Abbruch End If If oMailingDB.TryGetAttachmentsFromMailingID(oMailing.BM_ID, oAttachments) = False Then SetError(oMailingDB, "Es ist ein Fehler beim Ermitteln der Anlagen des Mailings aufgetreten.") GoTo Abbruch End If If oAttachments.Count > 0 Then oStatus.PrintStatus("Verarbeite die Anlagendateien...", 0, oAttachments.Count - 1, True) End If For i = 0 To oAttachments.Count - 1 oStatus.SetProgress(i) oAttachment = oAttachments.item(i) If Not system.IO.File.Exists(oAttachment.BM_FileName) Then oStatus.PrintStatus(String.Format("Die Anlagendatei '{0}' wurde nicht gefunden!", oAttachment.BM_FileName), True) Else oFileInfo = New system.IO.FileInfo(oAttachment.BM_FileName) oStatus.PrintStatus(String.Format("Erstelle Act!-Dokumenteneintrag für die Anlagen-Datei '{0}' bei der Act! Gruppe '{1}'...", oFileInfo.Name, oGroup.Name), False) If TryAttachFileToActGroup(oGroup, oFileInfo) = False Then GoTo Abbruch End If oStatus.PrintStatus("OK", i, oAttachments.count - 1, True) lCountAttachments += 1 End If Next If lCountAttachments > 0 Then oStatus.PrintStatus(String.Format("Es wurde(n) {0} Anlage(n) der Gruppe '{1}' als Dokument hinzugefügt.", lCountAttachments, oGroup.Name), 0, 1, True) End If Abbruch: If Not oMailingDB Is Nothing Then oMailingDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus(String.Empty, 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) End If End If oStatus.ShowDialog(False) bTry = True ClearError Return bTry End Function Public Function TryRemoveEntityFromExcludeList(oEntity As Act.Framework.MutableEntities.MutableEntity, oFieldEmail As Act.Framework.MutableEntities.MutableEntityFieldDescriptor, oFieldReason As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) Dim bTry As Boolean = False ClearError Dim oExcludeDB As ExcludeDatabase = Nothing Dim oStatus As StatusManager = Nothing Dim bDebug As Boolean Dim oExcludeListStatic As System.Collections.Generic.Dictionary(Of String,Exclusion) = Nothing Dim oExcludeListWildcard As System.Collections.Generic.List(Of Exclusion) = Nothing Dim oExclusion As Exclusion Dim oExclusionWildcard As Exclusion bDebug = False ' DEBUG Modus If oEntity Is Nothing Then SetError("Es wurde kein Act!-Datensatz übergeben.") GoTo Abbruch End If oStatus = New StatusManager(m_oactapp, Icons.ResIcons.ACTOptimum_AutoData, m_sScriptName) oStatus.PrintStatus("Verbindung zur Datenbank wird erstellt...", False) oExcludeDB = New ExcludeDatabase(System.IO.Path.GetDirectoryName(m_sExludeDBPath), System.IO.Path.GetFileName(m_sExludeDBPath), m_sDBUserName, m_sDBUserPassword) If oExcludeDB.TryConnect = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Verbinden mit der BulkMailer Datenbank '{0}' aufgetreten.", m_sExludeDBPath) GoTo Abbruch End If oStatus.PrintStatus("OK", True) oStatus.PrintStatus("Vorhandene BulkMailer-Daten werden ermittelt...", 0, 1, False) If oExcludeDB.TryGetExcludeLists(oExcludeListStatic, oExcludeListWildcard) = False Then SetError(oExcludeDB, "Es ist ein Fehler beim Ermitteln der Ausschlußliste vom BulkMailer aufgetreten.") GoTo Abbruch End If oStatus.PrintStatus("OK", True) oExclusion = New Exclusion oExclusion.BM_EMail = oFieldEmail.GetValue(oEntity) oExclusion.BM_Reason = oFieldReason.GetValue(oEntity) If String.IsNullOrEmpty(oExclusion.BM_EMail) Then SetError("Der Act!-Datensatz hat keine E-Mail-Adresse.") GoTo Abbruch End If If oExcludeListStatic.ContainsKey(oExclusion.getKey) Then oStatus.PrintStatus(String.Format("Versuche die E-Mail-Adresse '{0}' in der Ausschlußliste zu entfernen...", oExclusion.BM_EMail), 0, 1, False) If oExcludeDB.TryRemoveExcludeItem(oExclusion) = False Then SetError(oExcludeDB, "Die E-Mail-Adresse '{0}' konnte nicht in der Ausschlußliste entfernt werden.", oExclusion.BM_EMail) GoTo Abbruch End If oStatus.PrintStatus("OK", 0, 1, True) oStatus.PrintStatus(String.Format("Lösche bei dem Act!-Datensatz den Inhalt des Feldes '{0}'...", oFieldReason.DisplayName), 0, 1, False) Try oFieldReason.SetValue(oEntity, String.empty) oEntity.Update Catch ex As Exception seterror(ex, "Es konnte nicht in dem Act!-Datensatz der Wert in dem Feld '{0}' gelöscht werden.", oFieldReason.DisplayName) GoTo Abbruch End Try oStatus.PrintStatus("OK", 0, 1, True) m_oACTApp.Cursor = Cursors.WaitCursor m_oACTApp.ExecuteCommand("act-ui://com.act/application/menu/view/refresh") System.Windows.Forms.Application.DoEvents() m_oACTApp.Cursor = Cursors.Default Else oStatus.PrintStatus(String.Format("Die E-Mail-Adresse '{0}' ist nicht in der Ausschlußliste enthalten.", oExclusion.BM_EMail), 0, 1, True) End If If MatchWildcardInList(oExclusion, oExcludeListWildcard, oExclusionWildcard) = True Then oStatus.PrintStatus(String.Format("Hinweis: Die E-Mail-Adresse '{0}' wird weiterhin durch den Platzhalter '{1}' in der Ausschlußliste vom BulkMailer blockiert.", oExclusion.BM_EMail, oExclusionWildcard.BM_EMail), True) End If Abbruch: If Not oExcludeDB Is Nothing Then oExcludeDB.Disconnect oStatus.SetState(String.Empty) If Me.HasAnError Then oStatus.PrintStatus("FEHLER", 0, 1, True) oStatus.PrintStatus(Me.ErrorMessage, 0, 1, True) Else If oStatus.Canceled Then oStatus.PrintStatus("ABBRUCH", 0, 1, True) oStatus.PrintStatus("Der Vorgang wurde abgebrochen.", 0, 1, True) Else oStatus.PrintStatus("Der Vorgang wurde abgeschlossen.", 0, 1, True) End If End If oStatus.ShowDialog(False) ClearError bTry = True Return bTry End Function Private Function GetControl(ByVal oControl As System.Windows.Forms.Control, typeControl As system.Type, sControlName As String)As System.Windows.Forms.Control ' m_sScriptName &= "oControl: " & oCOntrol.Name & vbcrlf If String.IsNullOrEmpty(sControlName) Then If typeControl Is Nothing Then Return oControl Else If typeControl.IsAssignableFrom(oControl.GetType) Then Return oControl End If End If Else If typeControl Is Nothing Then If String.Compare(oControl.Name, sControlName, True) = 0 Then Return oControl End If Else If typeControl.IsAssignableFrom(oControl.GetType) Then If String.Compare(oControl.Name, sControlName, True) = 0 Then Return oControl End If End If End If End If If Not oControl.Controls Is Nothing Then If oControl.Controls.Count > 0 Then Dim i As Integer Dim oResultControl As System.Windows.Forms.Control For i = 0 To oControl.Controls.Count - 1 oResultControl = GetControl(oControl.Controls.item(i), typeControl, sControlName) If Not oResultControl Is Nothing Then Return oResultControl End If Next End If End If Return Nothing End Function Private Function TryAttachFileToActGroup(oGroup As Act.Framework.Groups.Group, oFileInfo As System.IO.FileInfo) As Boolean Dim bTry As Boolean = False Dim oAttachment As Act.Framework.SupplementalFiles.Attachment = Nothing Try oAttachment = m_oACTApp.ActFramework.SupplementalFileManager.CreateAttachment(Act.Framework.SupplementalFiles.AttachmentMate.History, oFileInfo.FullName, oFileInfo.Name, False) Catch ex As exception SetError(ex, "Es ist ein Fehler beim Erstellen der Act!-Anlage für die Datei '{0}' aufgetreten.", oFileInfo.Name) GoTo Abbruch End Try Try m_oACTApp.ActFramework.Histories.CreateHistory( _ DirectCast(Nothing, Act.Framework.Contacts.ContactList), _ m_oACTApp.ActFramework.Groups.GetGroupAsGroupList(oGroup), _ DirectCast(Nothing, Act.Framework.companies.CompanyList), _ Guid.Empty, _ New act.Framework.Histories.HistoryType(Act.Framework.Histories.SystemHistoryType.Library), _ False, _ DateTime.Now, _ DateTime.Now, _ oFileInfo.Name, _ String.empty, _ oAttachment) Catch ex As exception SetError(ex, "Es ist ein Fehler beim Erstellen der Act!-Historie für die Datei '{0}' aufgetreten.", oFileInfo.Name) GoTo Abbruch End Try bTry = True Abbruch: Return bTry End Function Private Function TryCreateActHistory(aContactID() As system.Guid, oGroup As Act.Framework.Groups.Group, oHistoryType As act.Framework.Histories.HistoryType, oStartDate As Date, lDuration As Integer, sRegarding As String, sDetail As String) As Boolean Dim bTry As Boolean = False Dim oContacts As Act.Framework.Contacts.ContactList Dim oGroups As Act.Framework.Groups.GroupList Dim oHistory As Act.Framework.Histories.History oContacts = m_oACTApp.ActFramework.Contacts.GetContactsByID(Nothing, aContactID) If oContacts Is Nothing OrElse oContacts.count = 0 Then SetError("Es wurden keine Act!-Kontakte zu den Act!-IDs ({0},...) gefunden.", aContactID(0)) GoTo Abbruch End If If oGroup Is Nothing Then oGroups = Nothing Else oGroups = m_oACTApp.ActFramework.Groups.GetGroupsByID(Nothing, New System.Guid() {oGroup.ID}) End If oHistory = m_oACTApp.ActFramework.Histories.CreateHistory(oContacts, oGroups, Nothing, System.Guid.Empty, oHistoryType, False, oStartDate, oStartDate.AddMinutes(lDuration), sRegarding, sDetail, Nothing) oHistory.Update bTry = True Abbruch: Return bTry End Function Private Function ACTHistoryExist(aContactID() As system.Guid, sLogDBName As String, lMailingID As Integer, lLogID As Integer) As Boolean Dim oACTFramework As Act.Framework.ActFramework Dim oHistories As act.Framework.Histories.HistoryList Dim oHistory As act.Framework.Histories.History Dim aFilter(0) As Act.Framework.StaticTextFilterCriteria Dim oContact As act.Framework.Contacts.contact Dim oContacts As Act.Framework.Contacts.contactlist Dim i As Integer Dim bExist As Boolean Dim sSQLFilter As String bExist = False oACTFramework = m_oactapp.actframework oContacts = oACTFramework.Contacts.GetContactsByID(Nothing, aContactID) If oContacts Is Nothing OrElse oContacts.Count = 0 Then GoTo Abbruch End If sSQLFilter = String.Format("REGARDING LIKE '%\[{0},{1}\]%' ESCAPE '\'", lMailingID, lLogid) aFilter(0) = New act.Framework.StaticTextFilterCriteria(sSQLFilter) For i = 0 To oContacts.Count - 1 oContact = oContacts.GetEntity(i) oHistories = oACTFramework.Histories.GetHistories(Nothing, oContact, aFilter) If oHistories Is Nothing OrElse oHistories.Count = 0 Then Continue For End If ' Überprüfe den Namen der LogDB im Details-Text For Each oHistory In oHistories If oHistory.Details.ToLower.IndexOf(sLogDBName.ToLower) >= 0 Then bExist = True GoTo Abbruch End If Next Next Abbruch: Return bExist End Function Private Function GetCleanFileName(sFileName As String) As String Dim aInvalidChar() As Char Dim oCleanName As System.Text.Stringbuilder Dim i As Integer Dim j As Integer aInvalidChar = system.IO.Path.GetInvalidFileNameChars oCleanName = New system.Text.stringbuilder For i = 0 To sFileName.Length - 1 For j = 0 To aInvalidChar.Length - 1 If aInvalidChar(j) = sFileName.chars(i) Then oCleanName.Append("-") Exit For End If Next If j = aInvalidChar.Length Then oCleanName.Append(sFileName.chars(i)) End If Next Return oCleanName.ToString End Function Private Function MatchWildcardInList(oExclusion As Exclusion, oExcludeListWildcard As System.Collections.Generic.List(Of Exclusion), ByRef ExclusionWildcard As Exclusion) As Boolean Dim i As Integer For i = 0 To oExcludeListWildcard.Count - 1 If oExcludeListWildcard.item(i).matchwildcard(oExclusion.BM_EMail) Then ExclusionWildcard = oExcludeListWildcard.item(i) Return True End If Next Return False End Function Private Sub tvMailings_AfterSelect(sender As System.Object, e As System.Windows.Forms.TreeViewEventArgs) Dim tvMailings As System.Windows.Forms.TreeView Dim oSelectedMailing As MailingNode Dim oInfo As System.Text.StringBuilder tvMailings = CType(Sender, System.Windows.Forms.TreeView) oSelectedMailing = tvMailings.SelectedNode oInfo = New System.Text.StringBuilder If oSelectedMailing.BM_ID > 0 And oSelectedMailing.BM_FolderFlag = False Then oInfo.AppendLine(String.Format("Betreff: {0}", oSelectedMailing.BM_Betreff)) oInfo.AppendLine(String.Format("LogDB: {0}", oSelectedMailing.BM_LogDBPath)) If System.IO.File.Exists(System.IO.Path.Combine(m_sLogDirectory, oSelectedMailing.BM_LogDBPath)) Then m_frmMailingSelection.Cursor = System.Windows.forms.Cursors.WaitCursor Dim oLogDB As LogDatabase Dim lCount As Integer Dim oDate As Date oLogDB = New LogDatabase(m_sLogDirectory, oSelectedMailing.BM_LogDBPath, m_sDBUserName, m_sDBUserPassword) If oLogDB.TryConnect = False Then oInfo.AppendLine(oLogDB.ErrorMessage) GoTo Abbruch End If If oLogDB.TryGetCountAll(lCount) = False Then GoTo Abbruch End If oInfo.Append(String.Format("{0} Protokolle", lCount)) If oLogDB.TryGetCountStatusok(lCount) = False Then GoTo Abbruch End If oInfo.Append(String.Format(" davon sind {0} erfolgreich", lCount)) If oLogDB.TryGetCountStatusNotOK(lCount) = False Then GoTo Abbruch End If oInfo.AppendLine(String.Format(" und {0} gescheitert", lCount)) If oLogDB.TryGetMinDate(oDate) = False Then GoTo Abbruch End If oInfo.Append(String.Format("Zeitraum vom {0}", oDate)) If oLogDB.TryGetMaxDate(oDate) = False Then GoTo Abbruch End If oInfo.AppendLine(String.Format(" bis {0}", oDate)) Abbruch: If Not oLogDB Is Nothing Then oLogDB.Disconnect m_frmMailingSelection.Cursor = System.Windows.forms.Cursors.Default If oLogDB.HasAnError Then oInfo.AppendLine(oLogDB.ErrorMessage) End If End If End If m_frmMailingSelection.lbInfo.Text = oInfo.ToString m_frmMailingSelection.btnOK.enabled = oSelectedMailing.BM_ID > 0 And oSelectedMailing.BM_FolderFlag = False And String.IsNullOrEmpty(oSelectedMailing.BM_LogDBPath) = False End Sub Public ReadOnly Property AddressDBPath() As String Get Return m_sAddressDBPath End Get End Property Public Enum MailingType Text=0 HTML=1 End Enum Public Enum NodeType IsMailing = 0 IsFolder= -1 End Enum Public Class MailingNode Inherits System.Windows.Forms.TreeNode Public BM_ID As Integer Public BM_Titel As String Public BM_Betreff As String Public BM_Nachricht As String Public BM_Type As MailingType Public BM_FolderFlag As Boolean Public BM_LogDBPath As String Public BM_ParentID As Integer Public Sub New() MyBase.New() BM_ID = 0 BM_Titel = String.Empty BM_Betreff = String.Empty BM_Nachricht = String.empty BM_Type = AutoDataMenuApp.BulkMailer.MailingType.HTML BM_FolderFlag = False BM_LogDBPath = String.Empty BM_ParentID = 0 End Sub Public ReadOnly Property FullPathWithoutRootNode As String Get Return Me.FullPath.Substring(Me.FullPath.IndexOf(Me.TreeView.PathSeparator) + 1) End Get End Property End Class Public Class Attachment Public BM_FileName As String Public Sub New() BM_FileName = String.empty End Sub End Class Public Class LogItem Public BM_ID As Integer Public BM_EMail As String Public BM_Status As String Public BM_StatusOK As Boolean Public BM_created As Date Public Sub New() BM_ID = 0 BM_EMail = String.Empty BM_Status = String.Empty BM_StatusOK = False BM_created = New Date(1969, 11, 7) End Sub End Class Public Class Exclusion Public BM_ID As Integer Public BM_EMail As String Public BM_Reason As String Public BM_Created As Date Public Sub New() BM_ID = 0 BM_EMail = String.Empty BM_Reason = String.Empty BM_Created = New Date(1969, 11, 7) End Sub Public Function getKey() As String Return BM_EMail.Trim.ToLower End Function Public Function IsWildcard() As Boolean If String.IsNullOrEmpty(BM_EMail) Then Return False End If If BM_EMail.StartsWith("!*") And BM_EMail.EndsWith("*") Then Return True End If If BM_EMail.StartsWith("*@") Then Return True End If Return False End Function Public Function MatchWildcard(Text As String) As Boolean If BM_EMail.StartsWith("!*") And BM_EMail.EndsWith("*") Then Return Text.ToLower.IndexOf(BM_EMail.Substring(2, Len(BM_EMail) - 3).tolower) >= 0 End If If BM_EMail.StartsWith("*@") Then Return Text.ToLower.EndsWith(BM_EMail.Substring(2).tolower) >= 0 End If Return String.Compare(Text, BM_EMail, True) = 0 End Function Public Function GetSQLLikeWildCard() As String If String.IsNullOrEmpty(BM_EMail) Then Return String.Empty End If If BM_EMail.StartsWith("!*") And BM_EMail.EndsWith("*") Then Return "%" + BM_EMail.Substring(2, Len(BM_EMail) - 3) + "%" End If If BM_EMail.StartsWith("*@") Then Return "%@" + BM_EMail.Substring(2) Return True End If Return BM_EMail End Function End Class Private Class BulkMailerConfiguration Inherits ErrorHandling.BaseErrorMessage Private m_sProfileName As String Private m_sProfile As String Private m_sAppDataFolder As String Private m_sConfigurationFile As String Private m_oConfiguration As System.Collections.Generic.Dictionary(Of String,System.Collections.Generic.Dictionary(Of String,String)) Private m_sProfileSectionNamePrefix As String Private m_sProfileKeyDescription As String Public Sub New() m_sAppDataFolder = System.Environment.GetFolderPath(System.Environment.SpecialFolder.ApplicationData) m_sAppDataFolder = System.IO.Path.Combine(m_sAppDataFolder, "Kroll-Software") m_sAppDataFolder = System.IO.Path.Combine(m_sAppDataFolder, "BulkMailer") m_sConfigurationFile = System.IO.Path.Combine(m_sAppDataFolder, "BulkMailer.cfg") m_sProfileSectionNamePrefix = "Profile-" m_sProfileKeyDescription = "Description" m_oConfiguration = New System.Collections.Generic.Dictionary(Of String,System.Collections.Generic.Dictionary(Of String,String)) End Sub Public Function TryReadConfiguration As Boolean Dim bTry As Boolean Dim aRow() As String Dim sRow As String Dim i As Integer Dim sCurrentSection As String Dim sNewSection As String Dim sNewKey As String Dim sNewValue As String Dim oCurrentSection As System.Collections.Generic.Dictionary(Of String,String) Dim oSectionRegExp As System.Text.RegularExpressions.Regex Dim oKeyValuePairRegExp As System.Text.RegularExpressions.Regex bTry = False m_oConfiguration = New System.Collections.Generic.Dictionary(Of String,System.Collections.Generic.Dictionary(Of String,String)) oSectionRegExp = New System.Text.RegularExpressions.Regex("\[.+\]") oKeyValuePairRegExp = New System.Text.RegularExpressions.Regex("\w+=.*") Try aRow = System.io.File.ReadAllLines(m_sConfigurationFile) Catch ex As Exception SetError(ex, "Die Konfigurationsdatei '{0}' von BulkMailer konnte nicht gelesen werden.", m_sConfigurationFile) GoTo Abbruch End Try sCurrentSection = "NoSection" oCurrentSection = New System.Collections.Generic.Dictionary(Of String,String) m_oConfiguration.Add(sCurrentSection.ToLower, oCurrentSection) For i = 0 To aRow.Length - 1 sRow = aRow(i).Trim If String.IsNullOrEmpty(sRow) Then Continue For If oSectionRegExp.IsMatch(sRow) Then sNewSection = sRow.Substring(1, sRow.Length - 2).Trim.ToLower If String.IsNullOrEmpty(sNewSection) Then Continue For sCurrentSection = sNewSection If m_oConfiguration.ContainsKey(sCurrentSection) Then oCurrentSection = m_oConfiguration.item(sCurrentSection) Else oCurrentSection = New System.Collections.Generic.Dictionary(Of String,String) m_oConfiguration.Add(sCurrentSection.ToLower, oCurrentSection) End If End If If oKeyValuePairRegExp.IsMatch(sRow) Then sNewKey = sRow.Substring(0, sRow.IndexOf("=")).trim.tolower If sRow.IndexOf("=") < sRow.Length - 2 Then sNewValue = sRow.Substring(sRow.IndexOf("=") + 1) Else sNewValue = String.Empty End If If oCurrentSection.ContainsKey(sNewKey) Then oCurrentSection.Item(sNewKey) = sNewValue Else oCurrentSection.Add(sNewKey, sNewValue) End If End If Next bTry = True Abbruch: Return bTry End Function Public Function TryGetProfileSetting(ProfileName As String, SettingName As String, ByRef Value As String) As Boolean Dim bTry As Boolean bTry = False Dim sKey As String Dim oProfileSection As System.Collections.Generic.Dictionary(Of String,String) = Nothing Dim bProfileExist As Boolean bProfileExist = False For Each sKey In m_oConfiguration.Keys If IsProfileSectionName(sKey) = True Then oProfileSection = m_oConfiguration.Item(sKey) If oProfileSection.ContainsKey(m_sProfileKeyDescription.ToLower) Then If String.Compare(ProfileName, oProfileSection.Item(m_sProfileKeyDescription.ToLower), True) = 0 Then bProfileExist = True Exit For End If End If End If Next If bProfileExist = False Then SetError("Es konnte kein BulkMailer Profil mit dem Namen '{0}' gefunden werden.", ProfileName) GoTo Abbruch End If If oProfileSection.ContainsKey(SettingName.Trim.ToLower) Then Value = oProfileSection.Item(SettingName.Trim.ToLower) Else SetError("Es konnte in der BulkMailer Konfiguration in dem Profil '{0}' keine Eintrag mit dem Namen '{1}' gefunden werden.", ProfileName, SettingName) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public ReadOnly Property Sections As System.Collections.Generic.Dictionary(Of String,System.Collections.Generic.Dictionary(Of String,String)) Get Return m_oConfiguration End Get End Property Public Function Exist As Boolean Return System.io.File.Exists(m_sConfigurationFile) End Function Private Function IsProfileSectionName(sSectionName As String) As Boolean Return sSectionName.ToLower.StartsWith(m_sProfileSectionNamePrefix.ToLower) End Function End Class #Region "Datenbank Manager" Private Class AddressDatabase Inherits MSAccessDatabase Private m_sTableAdressen As String Private m_sFieldACTID As String Private m_sFieldEMail As String Private m_sPKFieldAdresse As String Private m_sNotNullFieldMatchCode As String Private m_sCriteriaFieldGruppe As String Private m_sFieldNotEmptyGruppe As String Private m_sFieldNotEmptyCreateDate As String Private m_sFieldNotEmptySendInternetEncoding As String Private m_sFieldNotEmptyGender As String Private m_sFieldNotEmptyDefaultAddressIndex As String Private m_sFieldEditDate As String Private m_lGruppenIDUnbekannt As Integer Private m_lSendInternetEncodingKeine As Integer Private m_lGenderUnknown As Integer Private m_lDefaultAddressIndexBusiness As Integer Private m_sFormatMaskAccessDateTime As String Private m_sTableVerteiler As String Private m_sPKFieldVerteiler As String Private m_sFieldVerteiler As String Private m_sTableAdressen2Verteiler As String Private m_sFieldAdresseID As String Private m_sFieldVerteilerID As String Public Sub New(sFolderPath As String, sDatabaseName As String, sUserName As String, sUserPassword As String) MyBase.New(sFolderPath, sDatabaseName, sUserName, sUserPassword) m_sTableAdressen = "Adressen" m_sPKFieldAdresse = "ID" m_sFieldACTID = "User4" m_sFieldEmail = "EMail" m_sFieldNotEmptyGruppe = "Gruppe" m_sFieldNotEmptyCreateDate = "Record_Created" m_sFieldNotEmptySendInternetEncoding = "Send_Internet_Encoding" m_sFieldNotEmptyGender = "Gender" m_sFieldNotEmptyDefaultAddressIndex = "Default_Address_Index" m_sFieldEditDate = "Record_Changed" m_lGruppenIDUnbekannt = 1 m_lSendInternetEncodingKeine = 0 m_lGenderUnknown = 0 m_lDefaultAddressIndexBusiness = 2 m_sFormatMaskAccessDateTime = "\#yyyy\/MM\/dd hh:mm:ss\#" m_sTableVerteiler = "Verteiler" m_sPKFieldVerteiler = "ID" m_sFieldVerteiler = "Verteiler" m_sTableAdressen2Verteiler = "Adressen2Verteiler" m_sFieldAdresseID = "AdresseID" m_sFieldVerteilerID = "VerteilerID" End Sub ' Public Function TryGetMandantenTable(ByRef Table As System.Data.DataTable) As Boolean ' Return MyBase.TryGetTableData("KHKMandanten", Table) ' End Function ' Public Function TryGetAddressTable(ByRef Table As System.Data.DataTable) As Boolean ' Return MyBase.TryGetTableData(m_sTableAdressen, Table) ' End Function ' Public Function TryGetAddressSchema(ByRef SchemaTable As System.Data.DataTable) As Boolean ' Return MyBase.TryGetTableSchema(m_sTableAdressen, SchemaTable) ' End Function Public Function TryGetAddressIDFromActID(gActID As System.Guid, ByRef lAddressID As Integer, ByRef bActIDExist As Boolean) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sSQLSelect As String = "Select {0} From {1} Where {2} = {3};" Dim sValue As String = String.empty Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingAddressIDFromActID As String = "Es ist ein Fehler beim Abfragen der Adressen-ID von der Act!-ID '{0}' im Feld '{1}' in der Tabelle '{2}' aufgetreten." bActIDExist = False If Not TryGetSQLStringValueFromValue(gActID, sValue) Then SetError(sErrorWhileGettingAddressIDFromActID, gActID, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sPKFieldAdresse, m_sTableAdressen, m_sFieldACTID, sValue), oReturnData) = False Then SetError(sErrorWhileGettingAddressIDFromActID, gActID, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If If oReturnData.HasRows Then oReturnData.Read lAddressID = oReturnData.GetInt32(0) bActIDExist = True End If ' Gibt es einen weiteren Datensatz? If oReturnData.Read = True Then SetError("Die ActID '{0}' ist nicht eindeutig in dem Feld '{1}' in der Tabelle '{2}'.", gActID, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryGetAddressIDsWithActID(ByRef oActIDAddressIDList As System.Collections.Generic.Dictionary(Of System.Guid,Integer)) As Boolean Dim bTry As Boolean bTry = False ClearError ' Abfrage: AddressID, ACTID Dim sSQLSelect As String = "Select {0},{1} From {2} Where {1} Like '[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]-[0-9a-f][0-9a-f][0-9a-f][0-9a-f]-[0-9a-f][0-9a-f][0-9a-f][0-9a-f]-[0-9a-f][0-9a-f][0-9a-f][0-9a-f]-[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]';" Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingAddressIDsWithActID As String = "Es ist ein Fehler beim Abfragen der Adressen-IDs mit einer Act!-ID in der Tabelle '{0}' aufgetreten." oActIDAddressIDList = New System.Collections.Generic.Dictionary(Of System.Guid,Integer) If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sPKFieldAdresse, m_sFieldACTID, m_sTableAdressen), oReturnData) = False Then SetError(sErrorWhileGettingAddressIDsWithActID, m_sTableAdressen) GoTo Abbruch End If Dim oGuid As System.guid Dim lID As Integer If oReturnData.HasRows Then While oReturnData.Read = True lID = oReturnData.Getint32(0) If System.guid.TryParse(oReturnData.GetString(1), oGuid) = False Then SetError("In der Tabelle '{0}' ist eine ungültige Act!-ID '{1}'.", m_sTableAdressen, oReturnData.GetString(1)) End If If oACTIDAddressIDList.ContainsKey(oGuid) Then SetError("In der Tabelle '{0}' ist die Act!-ID '{1}' nicht eindeutig.", m_sTableAdressen, oGuid.ToString) GoTo Abbruch End If oACTIDAddressIDList.Add(oGuid, lID) End While End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryGetVerteilerIDFromVerteilerName(sVerteilerName As String, ByRef lVerteilerID As Integer, ByRef bVerteilerExist As Boolean) As Boolean Dim bTry As Boolean bTry = False ClearError ' Abfrage: AddressID, ACTID Dim sSQLSelect As String = "Select {0} From {1} Where {2} = {3};" Dim sValue As String = String.Empty Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingVerteilerIDFromVerteilerName As String = "Es ist ein Fehler beim Abfragen der Verteiler-ID mit dem Namen '{0}' in der Tabelle '{1}' aufgetreten." lVerteilerID = 0 bVerteilerExist = False If Not TryGetSQLStringValueFromValue(sVerteilerName, sValue) Then SetError(sErrorWhileGettingVerteilerIDFromVerteilerName, sVerteilerName, m_sTableVerteiler) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sPKFieldVerteiler, m_sTableVerteiler, m_sFieldVerteiler, sValue), oReturnData) = False Then SetError(sErrorWhileGettingVerteilerIDFromVerteilerName, sVerteilerName, m_sTableVerteiler) GoTo Abbruch End If If oReturnData.HasRows Then oReturnData.Read lVerteilerID = oReturnData.GetInt32(0) bVerteilerExist = True ' Gibt es einen weiteren Datensatz? If oReturnData.Read = True Then ' Nur Hinweis kein Abbruch durch Fehler Msgbox(String.Format("Es gibt im BulkMailer mehr als einen Verteiler mit dem Namen '{0}'. Es wird der Verteiler mit der ID '{1}' verwendet.", sVerteilerName, lVerteilerID), MsgBoxStyle.Exclamation, m_sScriptName) GoTo Abbruch End If End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryGetAddressValues(lAddressID As Integer, ByRef oFieldValueList As System.Collections.Generic.Dictionary(Of String,Object)) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sSQLSelect As String = "Select {0} From {1} Where {2} = {3};" Dim sFieldName As String Dim sFieldNames As System.Text.StringBuilder Dim sValue As String = String.empty Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingAddressValues As String = "Es ist ein Fehler beim Abfragen der Werte von dem Feldern in der Tabelle '{0}' von dem Datensatz mit der ID '{1}' aufgetreten." Dim i As Integer ' Textvariante der Feldnamenliste erstellen sFieldNames = New System.Text.StringBuilder For Each sFieldName In oFieldValueList.Keys If sFieldNames.Length > 0 Then sFieldNames.Append(",") End If sFieldNames.Append(String.Format("[{0}]", sFieldName)) Next ' Erstelle eine Textvariante von dem Key-Value (AddressID) If Not TryGetSQLStringValueFromValue(lAddressID, sValue) Then SetError(sErrorWhileGettingAddressValues, m_sTableAdressen, lAddressID) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, sFieldNames, m_sTableAdressen, m_sPKFieldAdresse, sValue), oReturnData) = False Then SetError(sErrorWhileGettingAddressValues, m_sTableAdressen, lAddressID) GoTo Abbruch End If If oReturnData.HasRows Then oReturnData.Read For i = 0 To oReturnData.FieldCount - 1 oFieldValueList(oReturnData.GetName(i)) = oReturnData(i) Next End If ' Gibt es einen weiteren Datensatz? If oReturnData.Read = True Then SetError("Die Adressen-ID '{0}' ist nicht eindeutig in dem Feld '{1}' in der Tabelle '{2}'.", lAddressID, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryGetAddressValue(lAddressID As Integer, sFieldName As String, ByRef oValue As Object) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sSQLSelect As String = "Select {0} From {1} Where {2} = {3};" Dim sValue As String = String.Empty Dim oReturnData As System.data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingAddressFieldValue As String = "Es ist ein Fehler beim Abfragen des Wertes von dem Feld '{0}' in der Tabelle '{1}' von dem Datensatz mit der ID '{3}' aufgetreten." If Not TryGetSQLStringValueFromValue(lAddressID, sValue) Then SetError(sErrorWhileGettingAddressFieldValue, sFieldName, m_sTableAdressen, lAddressID) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, sFieldName, m_sTableAdressen, m_sPKFieldAdresse, sValue), oReturnData) = False Then SetError(sErrorWhileGettingAddressFieldValue, sFieldName, m_sTableAdressen, lAddressID) GoTo Abbruch End If If oReturnData.HasRows Then oReturnData.Read oValue = oReturnData(0) End If ' Gibt es einen weiteren Datensatz? If oReturnData.Read = True Then SetError("Die AddressID '{0}' ist nicht eindeutig in dem Feld '{1}' in der Tabelle '{2}'.", lAddressID, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TrySetAddressValue(lAddressID As Integer, sFieldName As String, oValue As Object) As Boolean Dim sSQLUpdate As String = "Update {0} Set {1} = {2}, {3} = {4} Where {5} = {6};" Dim sValue As String = String.Empty Dim sErrorWhileSettingValueInFieldInTable As String = "Es ist ein Fehler beim Setzen des Wertes '{0}' für das Feld '{1}' in der Tabelle '{2}' aufgetreten." Dim lReturnValue As Integer TrySetAddressValue = False If Not TryGetSQLStringValueFromValue(oValue, sValue) Then SetError(sErrorWhileSettingValueInFieldInTable, oValue, sFieldname, m_sTableAdressen) GoTo Abbruch End If If TryExecuteSQLNonQuery(String.Format(sSQLUpdate, m_sTableAdressen, sFieldName, sValue, m_sFieldEditDate, Now.ToString(m_sFormatMaskAccessDateTime), m_sPKFieldAdresse, lAddressID), lReturnValue) = False Then SetError(sErrorWhileSettingValueInFieldInTable, sValue, sFieldname, m_sTableAdressen) GoTo Abbruch End If If lReturnValue <> 1 Then SetError(sErrorWhileSettingValueInFieldInTable, sValue, sFieldname, m_sTableAdressen) GoTo Abbruch End If TrySetAddressValue = True Abbruch: End Function Public Function TryCreateNewAddressItem(ByRef gActID As System.Guid) As Boolean Dim sErrorWhileCreatingNewAddressInTable As String = "Es ist ein Fehler beim Erstellen einer neuen Adresse in der Tabelle '{0}' aufgetreten." Dim sSQLInsert As String = "Insert Into {0}({1}) VALUES({2});" ' Primary Key Feld Variablen Dim oDataReader As System.Data.IDataReader = Nothing Dim lReturnValue As Integer TryCreateNewAddressItem = False ' Mit neuer ID eine neue Adresse erstellen. Dim sFieldNames As String Dim sValues As String sFieldNames = String.Format("{0},{1},{2},{3},{4},{5}", m_sFieldACTID, m_sFieldNotEmptyGruppe, m_sFieldNotEmptyCreateDate, m_sFieldNotEmptySendInternetEncoding, m_sFieldNotEmptyGender, m_sFieldNotEmptyDefaultAddressIndex) sValues = String.Format("'{0}',{1},{2},{3},{4},{5}", gActID.ToString, m_lGruppenIDUnbekannt, Now.ToString(m_sFormatMaskAccessDateTime), m_lSendInternetEncodingKeine, m_lGenderUnknown, m_lDefaultAddressIndexBusiness) 'Msgbox(String.Format(sSQLInsert, m_sTableAdressen, sFieldNames, sValues)) If Not TryExecuteSQLNonQuery(String.Format(sSQLInsert, m_sTableAdressen, sFieldNames, sValues), lReturnValue) Then SetError(sErrorWhileCreatingNewAddressInTable, m_sTableAdressen) GoTo Abbruch End If If lReturnValue <> 1 Then SetError(sErrorWhileCreatingNewAddressInTable, m_sTableAdressen) GoTo Abbruch End If TryCreateNewAddressItem = True Abbruch: End Function Public Function TryCreateNewVerteilerItem(sVerteiler As String) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sErrorWhileCreatingNewVerteilerInTable As String = "Es ist ein Fehler beim Erstellen eines neuen Verteilers in der Tabelle '{0}' aufgetreten." Dim sSQLInsert As String = "Insert Into {0}({1}) VALUES({2});" ' Primary Key Feld Variablen Dim oDataReader As System.Data.IDataReader = Nothing Dim lReturnValue As Integer ' Mit neuer ID eine neue Adresse erstellen. Dim sFieldNames As String Dim sValue As String Dim sValues As String sValue = String.empty If Not TryGetSQLStringValueFromValue(sVerteiler, sValue) Then SetError(sErrorWhileCreatingNewVerteilerInTable, m_sTableVerteiler) GoTo Abbruch End If sFieldNames = String.Format("{0}", m_sFieldVerteiler) sValues = String.Format("{0}", sValue) If Not TryExecuteSQLNonQuery(String.Format(sSQLInsert, m_sTableVerteiler, sFieldNames, sValues), lReturnValue) Then SetError(sErrorWhileCreatingNewVerteilerInTable, m_sTableVerteiler) GoTo Abbruch End If If lReturnValue <> 1 Then SetError(sErrorWhileCreatingNewVerteilerInTable, m_sTableVerteiler) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryRemoveRelationsForVerteilerID(lVerteilerID As Integer) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sErrorWhileRemovingRelationsForVerteilerID As String = "Es ist ein Fehler beim Entfernen der Verknüpfungen mit der VerteilerID '{0}' in der Tabelle '{1}' aufgetreten." Dim sSQLDelete As String = "Delete * From {0} Where {1} = {2};" Dim lReturnValue As Integer If Not TryExecuteSQLNonQuery(String.Format(sSQLDelete, m_sTableAdressen2Verteiler, m_sFieldVerteilerID, lVerteilerID), lReturnValue) Then SetError(sErrorWhileRemovingRelationsForVerteilerID, lVerteilerID, m_sTableAdressen2Verteiler) GoTo Abbruch End If If lReturnValue < 0 Then SetError(sErrorWhileRemovingRelationsForVerteilerID, lVerteilerID, m_sTableAdressen2Verteiler) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryCreateNewRelationForVerteilerIDAndAddressID(lVerteilerID As Integer, lAddressID As Integer) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sErrorWhileCreatingNewRelationForAddressIDAndVerteilerID As String = "Es ist ein Fehler beim Erstellen einer neuen Relation zwischen Adressen-ID '{0}' und Verteiler-ID '{1}' in der Tabelle '{2}' aufgetreten." Dim sSQLInsert As String = "Insert Into {0}({1}) VALUES({2});" ' Primary Key Feld Variablen Dim lReturnValue As Integer ' Mit neuer ID eine neue Adresse erstellen. Dim sFieldNames As String Dim sValues As String sFieldNames = String.Format("{0},{1}", m_sFieldAdresseID, m_sFieldVerteilerID) sValues = String.Format("{0},{1}", lAddressID, lVerteilerID) If Not TryExecuteSQLNonQuery(String.Format(sSQLInsert, m_sTableAdressen2Verteiler, sFieldNames, sValues), lReturnValue) Then SetError(sErrorWhileCreatingNewRelationForAddressIDAndVerteilerID, lAddressID, lVerteilerID, m_sTableAdressen2Verteiler) GoTo Abbruch End If If lReturnValue <> 1 Then SetError(sErrorWhileCreatingNewRelationForAddressIDAndVerteilerID, lAddressID, lVerteilerID, m_sTableAdressen2Verteiler) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryGetACTIDsFromEmail(sEmail As String, ByRef aACTID() As system.Guid) As Boolean Dim bTry As Boolean bTry = False ClearError Dim oACTIDs As system.Collections.Generic.List(Of System.GUID) Dim oGuid As System.guid Dim sSQLSelect As String = "Select {0} From {1} Where {2} = {3};" Dim sValue As String = String.empty Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingActIDsFromEmail As String = "Es ist ein Fehler beim Abfragen der Act!-IDs mit der E-Mail '{0}' aus dem Feld '{1}' in der Tabelle '{2}' aufgetreten." If Not TryGetSQLStringValueFromValue(sEmail, sValue) Then SetError(sErrorWhileGettingActIDsFromEmail, sEmail, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sFieldACTID, m_sTableAdressen, m_sFieldEMail, sValue), oReturnData) = False Then SetError(sErrorWhileGettingActIDsFromEmail, sEmail, m_sFieldACTID, m_sTableAdressen) GoTo Abbruch End If oACTIDs = New system.Collections.Generic.List(Of System.GUID) If oReturnData.HasRows Then While oReturnData.Read If Not oReturnData.IsDBNull(0) Then If system.guid.TryParse(oReturnData.GetString(0), oguid) = True Then oACTIDs.add(oguid) End If End If End While End If aACTID = Array.CreateInstance(GetType(System.Guid), oACTIDs.Count) oACTIDs.CopyTo(aACTID) bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function End Class Private Class ExcludeDatabase Inherits MSAccessDatabase Private m_sTableExlude As String Private m_sFieldID As String Private m_sFieldEmail As String Private m_sFieldReason As String Private m_sFieldCreated As String Public Sub New(sFolderPath As String, sDatabaseName As String, sUserName As String, sUserPassword As String) MyBase.New(sFolderPath, sDatabaseName, sUserName, sUserPassword) m_sTableExlude = "Exclude" m_sFieldID = "ID" m_sFieldEmail = "EMail" m_sFieldReason = "Reason" m_sFieldCreated = "created" End Sub Public Function TryGetExcludeLists(ByRef oExcludeListStatic As System.Collections.Generic.Dictionary(Of String,Exclusion), ByRef oExcludeListWildcard As System.Collections.Generic.List(Of Exclusion))As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = "Select * From {0};" Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingExclusionsFromTableX As String = "Es ist ein Fehler beim Abfragen der Ausschlüße aus der Tabelle '{0}' aufgetreten." If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableExlude), oReturnData) = False Then SetError(sErrorWhileGettingExclusionsFromTableX, m_sTableExlude) GoTo Abbruch End If oExcludeListStatic = New System.Collections.Generic.Dictionary(Of String,Exclusion) oExcludeListWildcard = New System.Collections.Generic.List(Of Exclusion) Dim oExclusion As Exclusion If oReturnData.HasRows Then While oReturnData.Read oExclusion = New Exclusion() If TryGetValue(oReturnData, m_sFieldID, oExclusion.BM_ID) = False Then GoTo Abbruch If TryGetValue(oReturnData, m_sFieldEmail, oExclusion.BM_EMail) = False Then GoTo Abbruch If TryGetValue(oReturnData, m_sFieldReason, oExclusion.BM_Reason) = False Then GoTo Abbruch If TryGetValue(oReturnData, m_sFieldCreated, oExclusion.BM_Created) = False Then GoTo Abbruch If oExclusion.isWildcard Then oExcludeListWildcard.Add(oExclusion) Else If Not oExcludeListStatic.ContainsKey(oExclusion.getKey()) Then oExcludeListStatic.Add(oExclusion.getKey, oExclusion) End If End If End While End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryCreateExcludeItem(oExclusion As Exclusion) As Boolean Dim bTry As Boolean bTry = False ClearError Dim sErrorWhileCreatingNewExclusionInTable As String = "Es ist ein Fehler beim Erstellen eines neuen Ausschlusses in der Tabelle '{0}' aufgetreten." Dim sSQLInsert As String = "Insert Into {0}({1}) VALUES({2});" ' Primary Key Feld Variablen Dim oDataReader As System.Data.IDataReader = Nothing Dim lReturnValue As Integer ' Mit neuer ID eine neue Adresse erstellen. Dim sFieldNames As String Dim sValue As String Dim sValues As String sValue = String.empty If Not TryGetSQLStringValueFromValue(oExclusion.BM_EMail, sValue) Then SetError(sErrorWhileCreatingNewExclusionInTable, m_sTableExlude) GoTo Abbruch End If sFieldNames = String.Format("{0}", m_sFieldEmail) sValues = String.Format("{0}", sValue) If Not TryGetSQLStringValueFromValue(oExclusion.BM_Reason, sValue) Then SetError(sErrorWhileCreatingNewExclusionInTable, m_sTableExlude) GoTo Abbruch End If sFieldNames &= String.Format(",{0}", m_sFieldReason) sValues &= String.Format(",{0}", sValue) If Not TryGetSQLStringValueFromValue(oExclusion.BM_Created, sValue) Then SetError(sErrorWhileCreatingNewExclusionInTable, m_sTableExlude) GoTo Abbruch End If sFieldNames &= String.Format(",{0}", m_sFieldCreated) sValues &= String.Format(",{0}", sValue) ' msgbox(String.Format(sSQLInsert, m_sTableExlude, sFieldNames, sValues)) If Not TryExecuteSQLNonQuery(String.Format(sSQLInsert, m_sTableExlude, sFieldNames, sValues), lReturnValue) Then SetError(sErrorWhileCreatingNewExclusionInTable, m_sTableExlude) GoTo Abbruch End If If lReturnValue <> 1 Then SetError(sErrorWhileCreatingNewExclusionInTable, m_sTableExlude) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryRemoveExcludeItem(oExclusion As Exclusion)As Boolean Dim bTry As Boolean = False ClearError bTry = True Dim sErrorWhileRemovingExcludeItem As String = "Es ist ein Fehler beim Entfernen der E-Mail-Adresse '{0}' in der Tabelle '{1}' aufgetreten." Dim sSQLDelete As String = "Delete * From {0} Where {1} Like {2};" Dim lReturnValue As Integer Dim sValue As String = String.empty If Not TryGetSQLStringValueFromValue(oExclusion.BM_EMail, sValue) Then SetError(sErrorWhileRemovingExcludeItem, oExclusion.BM_EMail, m_sTableExlude) GoTo Abbruch End If If Not TryExecuteSQLNonQuery(String.Format(sSQLDelete, m_sTableExlude, m_sFieldEmail, sValue), lReturnValue) Then SetError(sErrorWhileRemovingExcludeItem, oExclusion.BM_EMail, m_sTableExlude) GoTo Abbruch End If If lReturnValue < 0 Then SetError(sErrorWhileRemovingExcludeItem, oExclusion.BM_EMail, m_sTableExlude) GoTo Abbruch End If Abbruch: Return bTry End Function End Class Private Class MailingDatabase Inherits MSAccessDatabase Private m_sTableProjekte As String Private m_sTableAttachments As String Private m_sFieldID As String Private m_sFieldProjektID As String Private m_sFieldFileName As String Public Sub New(sFolderPath As String, sDatabaseName As String, sUserName As String, sUserPassword As String) MyBase.New(sFolderPath, sDatabaseName, sUserName, sUserPassword) m_sTableProjekte = "Projekte" m_sTableAttachments = "Attachments" m_sFieldID = "ID" m_sFieldProjektID = "ProjektID" m_sFieldFileName = "FileName" End Sub Public Function TryGetMailingsTree(ByRef oRootNode As MailingNode) As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = "Select * From {0} Order By FolderFlag, ParentID, ID;" Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingMailingsFromTableX As String = "Es ist ein Fehler beim Abfragen der Mailings aus der Tabelle '{0}' aufgetreten." If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableProjekte), oReturnData) = False Then SetError(sErrorWhileGettingMailingsFromTableX, m_sTableProjekte) GoTo Abbruch End If oRootNode = New MailingNode() oRootNode.Text = "Alle Mailings" Dim oMailingNode As mailingnode If oReturnData.HasRows Then While oReturnData.Read oMailingNode = New MailingNode() If TryGetValue(oReturnData, "ID", oMailingNode.BM_ID) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Titel", oMailingNode.BM_Titel) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Betreff", oMailingNode.BM_Betreff) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Nachricht", oMailingNode.BM_Nachricht) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Type", oMailingNode.BM_Type) = False Then GoTo Abbruch If TryGetValue(oReturnData, "FolderFlag", oMailingNode.BM_FolderFlag) = False Then GoTo Abbruch If TryGetValue(oReturnData, "LogDBPath", oMailingNode.BM_LogDBPath) = False Then GoTo Abbruch If TryGetValue(oReturnData, "ParentID", oMailingNode.BM_ParentID) = False Then GoTo Abbruch oMailingNode.Text = String.Format("{0}", oMailingNode.BM_Titel, oMailingNode.BM_FolderFlag) If oMailingNode.BM_FolderFlag Then oMailingNode.ImageIndex = 0 ' Icon Folder Else oMailingNode.ImageIndex = 1 ' Icon Envelope oMailingNode.SelectedImageIndex = 1 End If InsertTreeNode(oRootNode, oMailingNode) End While End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Public Function TryGetAttachmentsFromMailingID(lMailingID As Integer, ByRef oAttachments As System.Collections.Generic.List(Of Attachment)) As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = "Select * From {0} Where {1}={2};" Dim sValue As String = String.empty Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingAttachmentsFromMailingID As String = "Es ist ein Fehler beim Abfragen der Anlagen von dem Mailing mit der ID '{0}' aus der Tabelle '{1}' aufgetreten." If Not TryGetSQLStringValueFromValue(lMailingID, sValue) Then SetError(sErrorWhileGettingAttachmentsFromMailingID, lMailingID, m_sTableAttachments) GoTo Abbruch End If If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableAttachments, m_sFieldProjektID, sValue), oReturnData) = False Then SetError(sErrorWhileGettingAttachmentsFromMailingID, lMailingID, m_sTableAttachments) GoTo Abbruch End If Dim oAttachment As Attachment oAttachments = New System.Collections.Generic.List(Of Attachment) If oReturnData.HasRows Then While oReturnData.Read oAttachment = New Attachment If TryGetValue(oReturnData, m_sFieldFileName, oAttachment.BM_FileName) = False Then GoTo Abbruch oAttachments.Add(oAttachment) End While End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Private Sub InsertTreeNode(oParent As mailingNode, oNew As mailingnode) If oParent.BM_ID = oNew.BM_ParentID Then oParent.Nodes.Add(oNew) Exit Sub End If Dim oCurrent As mailingNode For Each oCurrent In oParent.Nodes InsertTreeNode(oCurrent, oNew) If Not oNew.Parent Is Nothing Then Exit Sub End If Next End Sub End Class Private Class LogDatabase Inherits MSAccessDatabase Private m_sTableLog As String Public Sub New(sFolderPath As String, sDatabaseName As String, sUserName As String, sUserPassword As String) MyBase.New(sFolderPath, sDatabaseName, sUserName, sUserPassword) m_sTableLog = "LogData" End Sub Public Function TryGetCountAll(ByRef lCount As Integer) As Boolean Return TryGetIntegerValue("Select Count(ID) From {0};", lCount) End Function Public Function TryGetCountStatusOK(ByRef lCount As Integer) As Boolean Return TryGetIntegerValue("Select Count(ID) From {0} Where StatusOK = True;", lCount) End Function Public Function TryGetCountStatusNotOK(ByRef lCount As Integer) As Boolean Return TryGetIntegerValue("Select Count(ID) From {0} Where StatusOK = False;", lCount) End Function Public Function TryGetMinDate(ByRef oDate As Date) As Boolean Return TryGetDateValue("Select Min(created) From {0};", oDate) End Function Public Function TryGetMaxDate(ByRef oDate As Date) As Boolean Return TryGetDateValue("Select Max(created) From {0};", oDate) End Function Public Function TryGetLogs(ByRef oLogs As System.Collections.Generic.List(Of LogItem)) As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = "Select * From {0}" Dim sErrorWhileGettingLogDataFromTableX As String = "Es ist ein Fehler beim Abfragen der Logdaten aus der Tabelle '{0}' aufgetreten." Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableLog), oReturnData) = False Then SetError(sErrorWhileGettingLogDataFromTableX, m_sTableLog) GoTo Abbruch End If oLogs = New System.Collections.Generic.List(Of LogItem) Dim oLogItem As LogItem If oReturnData.HasRows Then While oReturnData.Read oLogItem = New LogItem() If TryGetValue(oReturnData, "ID", oLogItem.BM_ID) = False Then GoTo Abbruch If TryGetValue(oReturnData, "EMail", oLogItem.BM_EMail) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Status", oLogItem.BM_Status) = False Then GoTo Abbruch If TryGetValue(oReturnData, "StatusOK", oLogItem.BM_StatusOK) = False Then GoTo Abbruch If TryGetValue(oReturnData, "Created", oLogItem.BM_created) = False Then GoTo Abbruch oLogs.add(oLogItem) End While End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Private Function TryGetIntegerValue(sSQL As String, ByRef lValue As Integer) As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = sSQL Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingLogDataFromTableX As String = "Es ist ein Fehler beim Abfragen der Logdaten aus der Tabelle '{0}' aufgetreten." If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableLog), oReturnData) = False Then SetError(sErrorWhileGettingLogDataFromTableX, m_sTableLog) GoTo Abbruch End If lValue = 0 If oReturnData.HasRows Then If oReturnData.Read lValue = oReturnData.GetInt32(0) End If End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function Private Function TryGetDateValue(sSQL As String, ByRef oDate As Date) As Boolean Dim bTry As Boolean = False ClearError Dim sSQLSelect As String = sSQL Dim oReturnData As System.Data.OleDb.OleDbDataReader = Nothing Dim sErrorWhileGettingLogDataFromTableX As String = "Es ist ein Fehler beim Abfragen der Logdaten aus der Tabelle '{0}' aufgetreten." If TryExecuteSQLQuery(String.Format(sSQLSelect, m_sTableLog), oReturnData) = False Then SetError(sErrorWhileGettingLogDataFromTableX, m_sTableLog) GoTo Abbruch End If oDate = Nothing If oReturnData.HasRows Then If oReturnData.Read oDate = oReturnData.GetDateTime(0) End If End If bTry = True Abbruch: If Not oReturnData Is Nothing AndAlso Not oReturnData.IsClosed Then oReturnData.Close End If Return bTry End Function End Class Private MustInherit Class MSAccessDatabase Inherits OLEDBManager Private m_sFolderPath As String Private m_sDatabaseName As String Private m_sUserName As String Private m_sUserPassword As String Private m_sConnectionStringMask As String Friend Sub New() MyBase.New m_sFolderPath = "" ' Bitte nur oben am Anfang des Scriptes einstellen m_sDatabaseName = "" ' Bitte nur oben am Anfang des Scriptes einstellen m_sUserName = "Admin" ' Bitte nur oben am Anfang des Scriptes einstellen m_sUserPassword = "" ' Bitte nur oben am Anfang des Scriptes einstellen m_sConnectionStringMask = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""{0}\{1}"";User ID={2};Password={3};Persist Security Info=True;" End Sub Friend Sub New(sFolderPath As String, sDatabaseName As String, sUserName As String, sUserPassword As String) Me.New m_sFolderPath = sFolderPath m_sDatabaseName = sDatabaseName If Not String.IsNullOrEmpty(sUserName) Then m_sUserName = sUserName End If m_sUserPassword = sUserPassword m_sConnectionString = String.Format(m_sConnectionStringMask, m_sFolderPath, m_sDatabaseName, m_sUserName, m_sUserPassword) End Sub End Class Private MustInherit Class OLEDBManager Inherits ErrorHandling.BaseErrorMessage Protected m_sConnectionString As String Protected m_cnCurrent As System.Data.OleDb.OleDbConnection Protected m_sName As String Protected m_oStatus As System.ComponentModel.Component Protected m_lCommandTimeOut As Integer Friend Sub New() MyBase.New() m_sConnectionString = String.Empty m_cnCurrent = Nothing m_oStatus = Nothing m_lCommandTimeOut = 360 End Sub Public Property ConnectionString() As String Get Return m_sConnectionString End Get Set(ByVal Value As String) m_sConnectionString = Value End Set End Property Public Function TryConnect() As Boolean TryConnect = False ClearError If String.IsNullOrEmpty(m_sConnectionString) Then SetError("Der Connection-String ist leer.") GoTo Abbruch End If If Not m_cnCurrent Is Nothing Then If m_cnCurrent.State = ConnectionState.Open Then GoTo Weiter 'Nicht jedesmal eine neue Connection aufbauen ''m_cnCurrent.Close() End If m_cnCurrent = Nothing End If Try m_cnCurrent = New System.Data.OleDb.OleDbConnection(m_sConnectionString) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Erstellen des 'Connection-Object' aufgetreten.") End Try Try m_cnCurrent.Open Catch ex As Exception SetError(ex, "Es ist keine Datenbankverbindung möglich.") GoTo Abbruch End Try Weiter: TryConnect = True Abbruch: End Function Public Sub Disconnect() If m_cnCurrent Is Nothing Then Exit Sub If m_cnCurrent.State = ConnectionState.Open Then m_cnCurrent.Close() End If m_cnCurrent = Nothing End Sub Public Function IsConnected() As Boolean If m_cnCurrent Is Nothing Then Return False If m_cnCurrent.State = ConnectionState.Open Then Return True Else Return False End If End Function Public ReadOnly Property State As String Get If m_cnCurrent Is Nothing Then Return String.empty Else Return m_cnCurrent.State.ToString End If End Get End Property Protected Function TryExecuteSQLQuery(ByVal sSQL As String, ByRef oDataReader As System.Data.IDataReader) As Boolean Dim oCommand As System.Data.IDbCommand ClearError() TryExecuteSQLQuery = False If TryConnect() = False Then SetError("Es ist ein Fehler beim Versuch eine SQL-Abfrage auszuführen aufgetreten.") GoTo Abbruch End If oCommand = New System.Data.OleDb.OleDbCommand ' Alternativer Weg zur Erstellung eines Commands 'oCommand = m_cnCurrent.CreateCommand oCommand.CommandType = CommandType.Text oCommand.Connection = m_cnCurrent oCommand.CommandText = sSQL oCommand.CommandTimeout = m_lCommandTimeOut Try oDataReader = oCommand.ExecuteReader(CommandBehavior.CloseConnection) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Ausführen einer SQL-Abfrage aufgetreten.") Return Nothing End Try TryExecuteSQLQuery = True Abbruch: End Function Protected Function TryExecuteSQLNonQuery(ByVal sSQL As String, ByRef ReturnValue As Integer) As Boolean Dim oCommand As System.Data.IDbCommand ClearError() TryExecuteSQLNonQuery = False If TryConnect() = False Then SetError("Es ist ein Fehler beim Ausführen eines SQL-Befehls aufgetreten.") GoTo Abbruch End If oCommand = New System.Data.OleDb.OleDbCommand oCommand.CommandType = CommandType.Text oCommand.Connection = m_cnCurrent oCommand.CommandText = sSQL oCommand.CommandTimeout = m_lCommandTimeOut 'Msgbox(sql) Try ReturnValue = oCommand.ExecuteNonQuery() Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Ausführen eines SQL-Befehls aufgetreten.") GoTo Abbruch End Try TryExecuteSQLNonQuery = True Abbruch: ' Eventuell Close Connection End Function Protected Function TryExecuteStoredProcedure(ByVal sProcedureName As String, ByRef oReturnDataReader As System.Data.IDataReader, ByVal ParamArray args() As System.Data.IDataParameter) As Boolean Dim oCommand As System.Data.IDbCommand Dim oParameter As System.Data.IDataParameter ClearError() TryExecuteStoredProcedure = False If TryConnect() = False Then SetError("Es ist ein Fehler beim Ausführen der StoredProcedure '{0}' aufgetreten.", sProcedureName) GoTo Abbruch End If oCommand = New System.Data.OleDb.OleDbCommand oCommand.CommandType = CommandType.StoredProcedure oCommand.Connection = m_cnCurrent oCommand.CommandText = sProcedureName oCommand.CommandTimeout = m_lCommandTimeOut For Each oParameter In args oCommand.Parameters.Add(oParameter) Next Try oReturnDataReader = oCommand.ExecuteReader() Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Ausführen der StoredProcedure '{0}' aufgetreten.", sProcedureName) GoTo Abbruch End Try For Each oParameter In args If oParameter.Direction = ParameterDirection.Output Then End If oCommand.Parameters.Add(oParameter) Next TryExecuteStoredProcedure = True Abbruch: ' Eventuell Close Connection End Function Protected Function TryExecuteStoredProcedure(ByVal sProcedureName As String, ByRef oReturnParameter As System.Data.IDataParameter, ByVal ParamArray args() As System.Data.IDataParameter) As Boolean Dim oCommand As System.Data.IDbCommand Dim oParameter As System.Data.IDataParameter ClearError() TryExecuteStoredProcedure = False If TryConnect() = False Then SetError("Es ist ein Fehler beim Ausführen der StoredProcedure '{0}' aufgetreten.", sProcedureName) GoTo Abbruch End If oCommand = New System.Data.OleDb.OleDbCommand oCommand.CommandType = CommandType.StoredProcedure oCommand.Connection = m_cnCurrent oCommand.CommandText = sProcedureName oCommand.CommandTimeout = m_lCommandTimeOut For Each oParameter In args oCommand.Parameters.Add(oParameter) Next oCommand.Parameters.Add(oReturnParameter) Try oCommand.ExecuteNonQuery() Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Ausführen der StoredProcedure '{0}' aufgetreten.", sProcedureName) GoTo Abbruch End Try TryExecuteStoredProcedure = True Abbruch: ' Eventuell Close Connection End Function Protected Function TryGetTableSchema(sTableName As String, ByRef oSchemaTable As System.Data.DataTable) As Boolean Dim sErrorWhileGettingSchemaOfTable As String = "Es ist ein Fehler beim Ermitteln des Schemas für die Tabelle '{0}' aufgetreten." TryGetTableSchema = False If TryConnect() = False Then SetError(sErrorWhileGettingSchemaOfTable, sTableName) GoTo Abbruch End If Try 'Return m_cnODBC.GetSchema("Tables", New String() {Nothing, Nothing, "sg_auf_alarm"}) oSchemaTable = m_cnCurrent.GetSchema("Columns", New String() {Nothing, Nothing, sTableName, Nothing}) Catch ex As Exception SetError(ex, sErrorWhileGettingSchemaOfTable, sTableName) GoTo Abbruch End Try If oSchemaTable Is Nothing Then SetError(sErrorWhileGettingSchemaOfTable, sTableName) GoTo Abbruch End If TryGetTableSchema = True Abbruch: Disconnect() End Function Protected Function TryGetTableData(sTableName As String, ByRef oDataTable As System.Data.DataTable) As Boolean Dim sErrorWhileGettingDataOfTable As String = "Es ist ein Fehler beim Ermitteln der Daten aus der Tabelle '{0}' aufgetreten." Dim oDataAdapter As System.Data.IDataAdapter Dim oDataSet As System.Data.DataSet TryGetTableData = False Dim SQL As String If TryConnect() = False Then SetError(sErrorWhileGettingDataOfTable, sTableName) GoTo Abbruch End If Try SQL = String.Format("select * from {0}", sTableName) oDataAdapter = New System.Data.OleDb.OleDbDataAdapter(SQL, m_cnCurrent) oDataSet = New System.data.DataSet oDataAdapter.Fill(oDataSet) oDataTable = oDataSet.Tables(0) Catch ex As Exception SetError(ex, sErrorWhileGettingDataOfTable, sTableName) GoTo Abbruch End Try TryGetTableData = True Abbruch: Disconnect() End Function Protected Function TryGetSQLStringValueFromValue(oValue As Object, ByRef SQLString As String) As Boolean TryGetSQLStringValueFromValue = False SQLString = String.Empty If oValue Is Nothing Then SQLString = "NULL" Else Select Case True Case TypeOf oValue Is String SQLString = "'" & oValue.ToString.Replace("'", "''") & "'" Case TypeOf oValue Is System.Guid SQLString = "'" & oValue.ToString & "'" Case TypeOf oValue Is Integer SQLString = oValue.ToString Case TypeOf oValue Is System.Decimal, TypeOf oValue Is Double SQLString = String.Format(New System.Globalization.CultureInfo("en-US").NumberFormat, "{0:G}", oValue) ' 12345.4567 Case TypeOf oValue Is System.DateTime SQLString = "'" & Format(oValue, "yyyy-MM-dd HH:mm:ss") & "'" Case Else SetError(String.Format("In den Daten ist ein nicht implementierter Typ '{0}' mit dem Wert '{1}' vorhanden.", oValue.GetType.ToString, oValue)) GoTo Abbruch End Select End If TryGetSQLStringValueFromValue = True Abbruch: End Function Protected Function TryGetValue(oData As System.Data.OleDb.OleDbDataReader, sFieldName As String, ByRef oValue As Object) As Boolean Dim bTry As Boolean = False Dim lFieldIndex As Integer If oData Is Nothing Then SetError("Es wurden keine Daten übergeben.") GoTo Abbruch End If If oData.HasRows = False Then SetError("Es wurden keine Daten gefunden.") GoTo Abbruch End If lFieldIndex = oData.GetOrdinal(sFieldName) If lFieldIndex < 0 Then SetError("Das Feld '{0}' ist nicht in den Daten vorhanden.", sFieldName) GoTo Abbruch End If Select Case True Case TypeOf oValue Is String If oData.IsDBNull(lFieldIndex) Then oValue = String.Empty Else oValue = oData.GetString(lFieldIndex) End If Case TypeOf oValue Is Integer If oData.IsDBNull(lFieldIndex) Then oValue = 0 Else oValue = oData.GetInt32(lFieldIndex) End If Case TypeOf oValue Is System.Enum If oData.IsDBNull(lFieldIndex) Then oValue = 0 Else oValue = oData.GetInt32(lFieldIndex) End If Case TypeOf oValue Is System.Boolean If oData.IsDBNull(lFieldIndex) Then oValue = False Else oValue = oData.GetBoolean(lFieldIndex) End If Case TypeOf oValue Is System.datetime If oData.IsDBNull(lFieldIndex) Then oValue = New Date(1969, 11, 7) Else oValue = oData.GetDateTime(lFieldIndex) End If Case Else SetError("Der Typ '{0}' ist nicht implementiert.", oValue.GetType.ToString) GoTo Abbruch End Select bTry = True Abbruch: Return bTry End Function End Class #End Region End Class #End Region #Region "Act2BulkMailer Configuration" Class Act2BulkMailerConfiguration Inherits ErrorHandling.BaseErrorMessage <System.ComponentModel.CategoryAttribute("Standard")> _ <ConfigValueAttribute("Name des BulkMailer Profil.", "Standardprofil", False)> _ Public BMProfile_Name As String <System.ComponentModel.CategoryAttribute("Standard")> _ <ConfigValueAttribute("Act! Kontakt-Feld für den Grund der Mitgliedschaft in der BulkMailer Ausschlußliste.", "Benutzer 10", False)> _ Public ACTField_ExcludeReason As String #Region "FieldMapping Properties" 'Field ID not mapable <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Titel", "", True)> Public BMField_Title As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Vorname", "", True)> Public BMField_FirstName As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld 2. Vorname", "", True)> Public BMField_SecondName As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Nachname", "", True)> Public BMField_LastName As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Spitzname", "", True)> Public BMField_NickName As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Anzeige-Name", "", True)> Public BMField_DisplayName As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Email", "E-Mail", False)> Public BMField_EMail As String 'Field Gruppe not mapable <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Land", "", True)> Public BMField_Private_Country As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Staat", "", True)> Public BMField_Private_State As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:PLZ", "", True)> Public BMField_Private_PostalCode As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Ort", "", True)> Public BMField_Private_City As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Strasse", "", True)> Public BMField_Private_Street As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Telefon", "", True)> Public BMField_Private_Phone As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Fax", "", True)> Public BMField_Private_Fax As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Mobil", "", True)> Public BMField_Private_Mobile As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Privat:Homepage", "", True)> Public BMField_Private_Homepage As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma", "", True)> Public BMField_Business_Company As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Titel", "", True)> Public BMField_Business_Title As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Abteilung", "", True)> Public BMField_Business_Department As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Bro", "", True)> Public BMField_Business_Office As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Land", "", True)> Public BMField_Business_Country As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Staat", "", True)> Public BMField_Business_State As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:PLZ", "", True)> Public BMField_Business_PostalCode As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Ort", "", True)> Public BMField_Business_City As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Strasse", "", True)> Public BMField_Business_Street As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Telefon", "", True)> Public BMField_Business_Phone As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Fax", "", True)> Public BMField_Business_Fax As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Pager", "", True)> Public BMField_Business_Pager As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:IP-Phone", "", True)> Public BMField_Business_IP_Phone As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Firma:Homepage", "", True)> Public BMField_Business_Homepage As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Kommentar", "", True)> Public BMField_Comment As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Geschlecht", "", True)> Public BMField_Gender As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Geburtstag", "", True)> Public BMField_Birthday As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Hochzeitstag", "", True)> Public BMField_Wedding_Day As String 'Field Default_Address_Index not mapable 'Field Send_Internet_Encoding not mapable <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Benutzerdefiniert 1", "", True)> Public BMField_User1 As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Benutzerdefiniert 2", "", True)> Public BMField_User2 As String <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Benutzerdefiniert 3", "", True)> Public BMField_User3 As String 'Field User4 not mapable <System.ComponentModel.CategoryAttribute("FieldMapping")><ConfigValueAttribute("Zuordnung für das BulkMailer Feld Benutzerdefiniert 5", "", True)> Public BMField_User5 As String 'Field Record_Changed not mapable 'Field Record_Created not mapable 'Field Auswahl not mapable 'Field Status not mapable #End Region Private m_sConfigName As String Private m_oToolTipList As System.Collections.Generic.Dictionary(Of String,String) Private m_oConfigStore As PickListConfigurationStore Private m_oACTApp As Act.UI.ActApplication Private m_sPrefixPropertyBMField As String Private Sub New() MyBase.New() m_sPrefixPropertyBMField = "BMField_" End Sub Public Sub New(oACTApp As Act.UI.ActApplication, sConfigName As String) Me.New() m_oACTApp = oACTApp m_sConfigName = sConfigName m_oToolTipList = New System.Collections.Generic.Dictionary(Of String,String) m_oConfigStore = New PickListConfigurationStore(oACTApp) End Sub Public Function TryLoadConfiguration() Dim bTry As Boolean Dim oFieldInfo As system.Reflection.FieldInfo Dim oAttributeConfigValue As New ConfigValueAttribute Dim lValue As Integer Dim sValue As String = String.Empty Dim dValue As Date bTry = False ClearError If m_oConfigStore.ConfigExist(m_sConfigName) = False Then If Msgbox(String.Format("Es existiert noch keine Dropdownliste '{0}' für die Konfigurationsdaten.", m_sConfigName) & vbcrlf & _ "Soll diese jetzt erstellt werden?", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, m_sScriptName) = MsgBoxResult.No Then SetError("Der Vorgang wurde abgebrochen.") GoTo Abbruch Else If m_oConfigStore.TryCreateConfig(m_sConfigName) = False Then SetError(m_oConfigStore, "Es konnte keine Dropdownliste für die Konfigurationsdaten erstellt werden.") GoTo Abbruch End If End If End If m_oToolTipList.Clear For Each oFieldInfo In Me.GetType.GetFields(System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.Public) ' Only properties from this class If oFieldInfo.DeclaringType Is Me.GetType Then If TryGetAttributeFromFieldInfo(oFieldInfo, oAttributeConfigValue) = False Then GoTo Abbruch End If m_oToolTipList.Add(oFieldInfo.Name, oAttributeConfigValue.Description) If m_oConfigStore.ValueExist(m_sConfigName, oFieldInfo.Name) = False Then If m_oConfigStore.TryCreateValue(m_sConfigName, oFieldInfo.Name, oAttributeConfigValue.DefaultValue.ToString) = False Then Me.SetError(m_oConfigStore.ErrorMessage) GoTo Abbruch End If End If Select Case oFieldInfo.FieldType.ToString.ToLower Case "system.string" If m_oConfigStore.TryGetValue(m_sConfigName, oFieldInfo.Name, sValue) = False Then Me.SetError(m_oConfigStore.ErrorMessage) End If oFieldInfo.SetValue(Me, sValue) ' Validation If oAttributeConfigValue.AllowEmpty = False And String.IsNullOrEmpty(sValue) = True Then Me.SetError("Der Konfigurationseintrag '{0}' hat keinen Wert.", oFieldInfo.Name) msgbox(Me.HasAnError) End If Case "system.integer", "system.int32" If m_oConfigStore.TryGetValue(m_sConfigName, oFieldInfo.Name, lValue) = False Then Me.SetError(m_oConfigStore.ErrorMessage) End If oFieldInfo.SetValue(Me, lValue) Case "system.date" If m_oConfigStore.TryGetValue(m_sConfigName, oFieldInfo.Name, dValue) = False Then Me.SetError(m_oConfigStore.ErrorMessage) End If oFieldInfo.SetValue(Me, dValue) Case Else Me.SetError("Der Typ '{0}' für den Konfigurationseintrag '{1}' ist nicht implementiert.", oFieldInfo.FieldType.ToString, oFieldInfo.Name) GoTo Abbruch End Select End If Next ' Any Validation Errors? If Me.HasAnError Then GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryEditConfiguration()As Boolean Dim bTry As Boolean bTry = False ClearError If m_oConfigStore.TryEditConfig(m_sConfigName, m_oToolTipList) = False Then GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryGetFieldMappings(ByRef oFieldMappings As System.Collections.Generic.Dictionary(Of String, Act.Framework.MutableEntities.MutableEntityFieldDescriptor)) As Boolean Dim bTry As Boolean bTry = False ClearError Dim oFieldInfo As System.Reflection.FieldInfo Dim oAttributeConfigValue As New ConfigValueAttribute Dim oAttributeCategory As New System.ComponentModel.CategoryAttribute Dim oValue As String Dim sBMFieldName As String Dim sActFieldDisplayName As String Dim oField As Act.Framework.MutableEntities.MutableEntityFieldDescriptor = Nothing oFieldMappings = New System.Collections.Generic.Dictionary(Of String,act.Framework.MutableEntities.MutableEntityFieldDescriptor) For Each oFieldInfo In Me.GetType.GetFields(System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.Public) ' Only properties from this class If oFieldInfo.DeclaringType Is Me.GetType Then If TryGetAttributeFromFieldInfo(oFieldInfo, oAttributeConfigValue) = False Then GoTo Abbruch End If If TryGetAttributeFromFieldInfo(oFieldInfo, oAttributeCategory) = False Then GoTo Abbruch End If If oAttributeCategory.Category <> "FieldMapping" Then Continue For End If oValue = oFieldInfo.GetValue(Me) If String.IsNullOrEmpty(oValue) Then Continue For End If sActFieldDisplayName = oValue.ToString If TryGetContactField(sActFieldDisplayName, oField) = False Then SetError("Es ist ein Fehler beim Erstellen der FieldMapping-Liste aufgetreten.") GoTo Abbruch End If sBMFieldName = oFieldInfo.Name If sBMFieldName.StartsWith(m_sPrefixPropertyBMField) Then sBMFieldName = sBMFieldName.Substring(m_sPrefixPropertyBMField.Length) End If oFieldMappings.Add(sBMFieldName, oField) End If Next bTry = True Abbruch: Return bTry End Function Public Function TryGetFieldExcludeReason(ByRef oField As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean Dim bTry As Boolean = False ClearError If TryGetContactField(Me.ACTField_ExcludeReason, oField) = False Then GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function TryGetFieldEmail(ByRef oField As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean Dim bTry As Boolean = False ClearError If TryGetContactField(Me.BMField_EMail, oField) = False Then GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function #Region "Private" Private Function TryGetContactField(sFieldDisplayName As String, ByRef oField As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean Dim bTry As Boolean bTry = False ClearError Dim i As Integer Dim aField() As act.Framework.MutableEntities.MutableEntityFieldDescriptor aField = m_oACTapp.ActFramework.Contacts.GetFieldDescriptors() oField = Nothing For i = 0 To aField.Length - 1 If String.Compare(aField(i).DisplayName, sFieldDisplayName, True) = 0 Then oField = aField(i) Exit For End If Next If oField Is Nothing Then SetError("Es konnte nicht das Act! Feld '{0}' gefunden werden.", sFieldDisplayName) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Private Function TryGetAttributeFromFieldInfo(ByVal oFieldInfo As System.Reflection.FieldInfo, ByRef oAttribute As System.Attribute) As Boolean Dim bTry As Boolean Dim aObjects() As Object bTry = False Try aObjects = oFieldInfo.GetCustomAttributes(oAttribute.GetType, False) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Ermitteln des Attributes '{0}' von dem Konfigurationswert '{1}' aufgetreten.", oAttribute.GetType.ToString, oFieldInfo.Name) GoTo Abbruch End Try If aObjects.Length > 0 Then oAttribute = aObjects(0) Else oAttribute = System.Activator.CreateInstance(oAttribute.GetType) End If bTry = True Abbruch: Return bTry End Function #End Region End Class Class ConfigValueAttribute Inherits Attribute Private m_sDescription As String Private m_oDefaultValue As Object Private m_bAllowEmpty As Boolean Public Sub New() MyBase.New() m_sDescription = String.Empty m_bAllowEmpty = True m_oDefaultValue = Nothing End Sub Public Sub New (Description As String) Me.New() SetProperties(Description, m_oDefaultValue, m_bAllowEmpty) End Sub Public Sub New (DefaultValue As Object) Me.New() SetProperties(m_sDescription, DefaultValue, m_bAllowEmpty) End Sub Public Sub New (Description As String, DefaultValue As Object) Me.New() SetProperties(Description, DefaultValue, m_bAllowEmpty) End Sub Public Sub New (Description As String, DefaultValue As Object, AllowEmpty As Boolean) Me.New() SetProperties(Description, DefaultValue, AllowEmpty) End Sub Private Sub SetProperties(Description As String, DefaultValue As Object, AllowEmpty As Boolean) m_sDescription = Description m_oDefaultValue = DefaultValue m_bAllowEmpty = AllowEmpty End Sub Public ReadOnly Property Description As String Get Return m_sDescription End Get End Property Public ReadOnly Property DefaultValue As Object Get Return m_oDefaultValue End Get End Property Public ReadOnly Property AllowEmpty As Boolean Get Return m_bAllowEmpty End Get End Property End Class Class PicklistConfigurationStore Inherits ErrorHandling.BaseErrorMessage Private m_oACTApp As Act.ui.ActApplication Public Sub New() MyBase.New() End Sub Public Sub New(oACTApp As Act.UI.ActApplication) Me.New m_oACTApp = oACTApp End Sub Public Function TryGetValue(sConfigName As String, sValueName As String, ByRef sValue As String) As Boolean Return TryGetPicklistValue(sConfigName, sValueName, sValue) End Function Public Function TryGetValue(sConfigName As String, sValueName As String, ByRef lValue As Integer) As Boolean Dim sValue As String = String.Empty TryGetValue = False If TryGetPicklistValue(sConfigName, sValueName, sValue) = False Then GoTo Abbruch End If If Integer.TryParse(sValue, lValue) = False Then SetError("Der hinterlegte Wert '{0}' für den Einstellungseintrag '{1}' in der '{2}' Konfiguration kann nicht in eine Ganzzahl konvertiert werden.", sValue, sValueName, sConfigName) GoTo Abbruch End If TryGetValue = True Abbruch: End Function Public Function TryGetValue(sConfigName As String, sValueName As String, ByRef dValue As Date) As Boolean Dim sValue As String = String.Empty TryGetValue = False If TryGetPicklistValue(sConfigName, sValueName, sValue) = False Then GoTo Abbruch End If If Date.TryParse(sValue, dValue) = False Then SetError("Der hinterlegte Wert '{0}' für den Einstellungseintrag '{1}' in der '{2}' Konfiguration kann nicht in ein Datum konvertiert werden.", sValue, sValueName, sConfigName) GoTo Abbruch End If TryGetValue = True Abbruch: End Function Public Function TrySetValue(sConfigName As String, sValueName As String, ByRef lValue As Integer) As Boolean TrySetValue = False If TrySetPicklistValue(sConfigName, sValueName, lValue.ToString) = False Then GoTo Abbruch End If TrySetValue = True Abbruch: End Function Public Function ConfigExist(sConfigName As String) As Boolean Return Not m_oACTapp.ActFramework.PickLists.GetPickListByName(sConfigName) Is Nothing End Function Public Function TryCreateConfig(sConfigName As String) As Boolean Dim bTry As Boolean bTry = False Try m_oACTApp.ACTFramework.PickLists.CreatePickList(Act.Framework.PickLists.PickListType.Character, sConfigName, "Diese Dropdownliste wird von einem AutoData-Skript verwendet. Bitte diese Liste nicht mit einem Feld verknüpfen.", True, False) Catch ex As Exception SetError(ex, "Es ist ein Fehler beim Erstellen der Dropdownliste '{0}' aufgetreten, die für die Konfiguration benötigt wird.", sConfigName) GoTo Abbruch End Try bTry = True Abbruch: Return bTry End Function Public Function TryEditConfig(sConfigName As String, oToolTipList As System.Collections.Generic.Dictionary(Of String,String)) Dim bTry As Boolean bTry = False ClearError Dim oConfigEditor As ConfigurationEditor oConfigEditor = New ConfigurationEditor(m_oACTApp, sConfigName, oToolTipList) If oConfigEditor.HasAnError Then SetError(oConfigEditor, "Die Bearbeitung der Konfiguration konnte nicht durchgeführt werden.") GoTo Abbruch End If If oConfigEditor.TryEdit = False Then SetError(oConfigEditor, "Die Bearbeitung der Konfiguration konnte nicht durchgeführt werden.") GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Public Function ValueExist(sConfigName As String, sValueName As String) As Boolean Dim oPicklist As Act.Framework.PickLists.PickList Dim oItem As Act.Framework.PickLists.PickListItem oPicklist = m_oACTApp.ACTFramework.PickLists.GetPickListByName(sConfigName) If oPicklist Is Nothing Then Return False End If oItem = oPicklist.Items.FindByStringValue(sValueName, True) If oItem Is Nothing Then Return False End If Return True End Function Public Function TryCreateValue(sConfigName As String, sValueName As String, sDefaultValue As String) As Boolean Dim oPicklist As Act.Framework.PickLists.PickList = Nothing Dim oItem As Act.Framework.PickLists.PickListItem = Nothing Dim bTry As Boolean bTry = False ClearError If TryGetPickList(sConfigName, oPicklist) = False Then GoTo Abbruch End If If String.IsNullOrEmpty(sValueName) Then SetError("Es fehlt der Name des Dropdownliste-Eintrages für den Konfigurationswert.") GoTo Abbruch End If oItem = oPicklist.Items.FindByStringValue(sValueName, True) If oItem Is Nothing Then Try oPicklist.Items.add(New Act.Framework.PickLists.PickListItem(sValueName, sDefaultValue)) m_oACTapp.actFramework.PickLists.UpdatePickList(oPicklist) Catch ex As Exception Seterror(ex, "Es ist ein Fehler beim Erstellen des Konfigurationswertes '{0}' in der Dropdownliste '{1}' aufgetreten.", sValueName, sConfigName) End Try End If bTry = True Abbruch: Return bTry End Function Private Function TryGetPickList(sPickListName As String, ByRef oPickList As Act.Framework.PickLists.PickList) As Boolean Dim bTry As Boolean bTry = False Me.ClearError If m_oACTApp Is Nothing Then SetError("Es fehlt das ACTApplication-Objekt.") GoTo Abbruch End If If String.IsNullOrEmpty(sPicklistName) Then SetError("Es fehlt der Name der Dropdownliste für die Konfiguration.") GoTo Abbruch End If oPicklist = m_oACTapp.ActFramework.PickLists.GetPickListByName(sPicklistName) If oPicklist Is Nothing Then SetError("Es konnte nicht die Dropdownliste '{0}' für die Konfiguration gefunden werden.", sPicklistName) GoTo Abbruch End If bTry = True Abbruch: Return bTry End Function Private Function TryGetPickListValue(sPickListName As String, sValueName As String, ByRef sValue As String) As Boolean Dim oPickList As Act.Framework.PickLists.PickList = Nothing Dim oItem As Act.Framework.PickLists.PickListItem Dim bTry As Boolean bTry = False Me.ClearError If TryGetPickList(sPickListName, oPickList) = False Then GoTo Abbruch End If If String.IsNullOrEmpty(sValueName) Then SetError("Es fehlt der Name des Dropdownliste-Eintrages für den Konfigurationswert.") GoTo Abbruch End If oItem = oPickList.Items.FindByStringValue(sValueName, True) If oItem Is Nothing Then SetError("Es konnte nicht der Eintrag '{0}' in der Dropdownliste '{1}' für die Konfiguration gefunden werden.", sValueName, sPickListName) GoTo Abbruch End If sValue = oItem.Description bTry = True Abbruch: Return bTry End Function Private Function TrySetPicklistValue(sPickListName As String, sValueName As String, ByRef sValue As String) As Boolean TrySetPicklistValue = False Dim oPicklist As Act.Framework.PickLists.PickList = Nothing Dim oItem As Act.Framework.PickLists.PickListItem Me.ClearError If TryGetPickList(sPickListName, oPicklist) = False Then GoTo Abbruch End If If String.IsNullOrEmpty(sValueName) Then SetError("Es fehlt der Name des Dropdownliste-Eintrages für den Konfigurationswert.") GoTo Abbruch End If oItem = oPicklist.Items.FindByStringValue(sValueName, True) If oItem Is Nothing Then SetError("Es konnte nicht der Eintrag '{0}' in der Dropdownliste '{1}' für die Konfiguration gefunden werden.", sValueName, sPicklistName) GoTo Abbruch End If oItem.Description = sValue m_oACTApp.ACTFramework.PickLists.UpdatePickList(oPicklist) TrySetPicklistValue = True Abbruch: End Function Class ConfigurationEditor Inherits ErrorHandling.BaseErrorMessage Private m_oACTApp As Act.UI.ActApplication Private m_oPicklist As Act.Framework.PickLists.PickList Private m_oDialog As ACT.UI.Picklist.EditPickListItemsDialog Private m_oEditor As Act.UI.PickList.PickListItemsEditor Private m_oGrid As C1.Win.C1FlexGrid.C1FlexGrid Private m_oToolTip As System.Windows.Forms.ToolTip Private m_oToolTipList As System.Collections.Generic.Dictionary(Of String,String) Private m_oContextMenuContactFieldNames As System.Windows.Forms.ContextMenuStrip Public Sub New(oACTApp As Act.ui.ActApplication, sPickListName As String, oToolTipList As System.Collections.Generic.Dictionary(Of String,String)) MyBase.New m_oACTApp = oACTApp m_oToolTipList = oToolTipList m_oDialog = New ACT.UI.Picklist.EditPickListItemsDialog m_oPicklist = m_oACTApp.ActFramework.PickLists.GetPickListByName(sPickListName) If m_oPicklist Is Nothing Then m_oError.SetError("Es konnte nicht die Konfiguartions-Dropdownliste mit dem Namen '{0}' gefunden werden.", sPickListName) GoTo Abbruch End If m_oDialog.PickListState = m_oPicklist.GetState m_oDialog.Text = sPickListName ' Reflectionpart Anfang Try m_oEditor = CType(Reflect.GetField(m_oDialog, "editor", False).GetValue(m_oDialog), Act.UI.PickList.PickListItemsEditor) m_oGrid = CType(Reflect.GetField(m_oEditor, "itemsGrid", False).GetValue(m_oEditor), C1.Win.C1FlexGrid.C1FlexGrid) Catch ex As exception SetError(ex, "Es konnte nicht der Editor und das Grid im EditPickListItemsDialog ermittelt werden.") GoTo Abbruch End Try ' ToolTip Objekt erstellen m_oToolTip = New System.Windows.Forms.ToolTip ' Label (Titel) und die Spaltenüberschriften anpassen und zwei Buttons ausblenden Dim oLabel As System.Windows.Forms.Label Dim oColumValueName As C1.Win.C1FlexGrid.Column Dim oColumValueDescription As C1.Win.C1FlexGrid.Column Dim oButtonAdd As System.Windows.Forms.Button Dim oButtonDelete As System.Windows.Forms.Button Dim oGroupboxLine As system.Windows.Forms.GroupBox oLabel = CType(Reflect.GetField(m_oDialog, "label2", False).GetValue(m_oDialog), System.Windows.Forms.Label) oButtonAdd = CType(Reflect.GetField(m_oEditor, "addItem", False).GetValue(m_oEditor), System.Windows.Forms.Button) oButtonDelete = CType(Reflect.GetField(m_oEditor, "deleteItem", False).GetValue(m_oEditor), System.Windows.Forms.Button) oGroupboxLine = CType(Reflect.GetField(m_oDialog, "groupBox1", False).GetValue(m_oDialog), System.Windows.Forms.Groupbox) oColumValueName = m_oGrid.Cols.Item(0) oColumValueDescription = m_oGrid.Cols.Item(1) oLabel.Text = "Klicken Sie mit der rechten Maustaste um eventuell eine Auswahl von Werten anzuzeigen." oColumValueName.Caption = "Name" oColumValueName.AllowEditing = False oColumValueDescription.Caption = "Wert" oButtonAdd.Visible = False oButtonDelete.Visible = False oGroupboxLine.Visible = False ' Editor mit Grid die Größenverhalten anpassen und ausrichten m_oGrid.Dock = DockStyle.Fill m_oEditor.Anchor = AnchorStyles.None m_oEditor.Left = 8 m_oEditor.Width = m_oDialog.Width - 2 * m_oEditor.Left m_oEditor.Anchor = AnchorStyles.Left Or AnchorStyles.Right Or AnchorStyles.Top Or AnchorStyles.Bottom m_oDialog.Icon = Icons.ResIcons.ACTOptimum_AutoData m_oDialog.FormBorderStyle = FormBorderStyle.Sizable ' Reflectionpart Ende ' Event Handler setzen AddHandler m_oGrid.SetupEditor, AddressOf C1FlexGrid_SetupEditor ' Wenn der Editor (Textbox) existiert kann das Kontextmenü geändert werden AddHandler m_oGrid.Click ,AddressOf C1FlexGrid_Click ' Bei einem Mausklick kann ' Extra: Ein Kontextmenu mit allen Kontakt-Feldern erstellen m_oContextMenuContactFieldNames = New System.Windows.Forms.ContextMenuStrip Dim i,j As Integer Dim aField() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor Dim sMenuText As String Dim oMenu As System.Windows.Forms.ToolStripMenuItem m_oToolTip.RemoveAll aField = m_oACTApp.ACTFramework.Contacts.GetMutableEntityFieldDescriptors() For i = 0 To aField.Length - 1 sMenuText = String.Empty Select Case aField(i).ACTFieldType Case Act.Framework.Database.FieldDataType.AnnualEvent,Act.Framework.Database.FieldDataType.Date,Act.Framework.Database.FieldDataType.DateTime,Act.Framework.Database.FieldDataType.Time sMenuText = aField(i).DisplayName Case Act.Framework.Database.FieldDataType.Calculated,Act.Framework.Database.FieldDataType.Currency,Act.Framework.Database.FieldDataType.Decimal,Act.Framework.Database.FieldDataType.Number,Act.Framework.Database.FieldDataType.TinyInt sMenuText = aField(i).DisplayName Case Act.Framework.Database.FieldDataType.Character,Act.Framework.Database.FieldDataType.Email,Act.Framework.Database.FieldDataType.InitialCaps,Act.Framework.Database.FieldDataType.Lowercase,Act.Framework.Database.FieldDataType.Uppercase,Act.Framework.Database.FieldDataType.Url sMenuText = aField(i).DisplayName Case Act.Framework.Database.FieldDataType.YesNo sMenuText = aField(i).DisplayName Case Act.Framework.Database.FieldDataType.Picture Case Act.Framework.Database.FieldDataType.Phone sMenuText = aField(i).DisplayName End Select If Not String.IsNullOrEmpty(sMenuText) Then oMenu = New System.Windows.Forms.ToolStripMenuItem(sMenuText, Nothing, AddressOf MenuItem_Click) oMenu.ToolTipText = String.Format("Act! Feld '{0}' ({1}, {2})", aField(i).DisplayName, aField(i).Name, aField(i).ACTFieldType.ToString) For j = 0 To m_oContextMenuContactFieldNames.Items.Count - 1 If oMenu.Text < m_oContextMenuContactFieldNames.Items(j).Text Then m_oContextMenuContactFieldNames.Items.Insert(j, oMenu) Exit For End If Next If j >= m_oContextMenuContactFieldNames.Items.Count Then m_oContextMenuContactFieldNames.Items.add(oMenu) End If End If Next Abbruch: End Sub Public Function TryEdit() As Boolean Dim bTry As Boolean bTry = False ClearError If m_oPicklist Is Nothing Then SetError("Es fehlt die Dorpdownliste.") GoTo Abbruch End If Dim lResult As System.Windows.Forms.DialogResult = m_oDialog.ShowDialog(m_oACTApp) If (lResult = DialogResult.OK) Then m_oPicklist.SetState(m_oDialog.PickListState) m_oACTApp.ActFramework.PickLists.UpdatePickList(m_oPicklist) End If bTry = True Abbruch: Return bTry End Function #Region "Event Handler" Private Sub C1FlexGrid_Click(sender As Object, e As EventArgs) Dim oColumValueName As C1.Win.C1FlexGrid.Column Dim oColumValueDescription As C1.Win.C1FlexGrid.Column Dim oValue As Object Dim sValueName As String If m_oGrid.MouseRow < 0 Then GoTo Abbruch End If oColumValueName = m_oGrid.Cols.Item(0) oColumValueDescription = m_oGrid.Cols.Item(1) m_oToolTip.RemoveAll m_oGrid.ContextMenu = Nothing oValue = m_oGrid.GetData(m_oGrid.MouseRow, oColumValueName.Index) If Not String.IsNullOrEmpty(oValue) Then sValueName = oValue.tostring If m_oToolTipList.ContainsKey(sValueName) Then m_oToolTip.SetToolTip(m_oGrid, m_oToolTipList.item(sValueName)) End If If sValueName.StartsWith("BMField_") Or sValueName.StartsWith("ACTField_") Then m_oGrid.ContextMenuStrip = m_oContextMenuContactFieldNames Else m_oGrid.ContextMenuStrip = Nothing End If End If Abbruch: End Sub Private Sub C1FlexGrid_SetupEditor(sender As Object, e As c1.Win.C1FlexGrid.RowColEventArgs) Dim oEditor As System.Windows.Forms.TextBox If Not m_oGrid.Editor Is Nothing Then oEditor = CType(m_oGrid.Editor, System.Windows.Forms.TextBox) End If End Sub Private Sub MenuItem_Click(sender As Object, e As EventArgs) Dim oMenu As System.Windows.Forms.ToolstripMenuItem Dim lSelectedRow As Integer Dim oSelectedRow As C1.win.C1FlexGrid.Row oMenu = CType(sender, System.Windows.Forms.ToolstripMenuItem) lSelectedRow = m_oGrid.RowSel oSelectedRow = m_oGrid.Rows.Item(lSelectedRow) ' In der zweiten Spalte in der aktuellen Zeile wird der Wert auf Menu.Text gesetzt m_oGrid.SetData(lSelectedRow, 1, oMenu.Text, True) ' In der Eigenschaft UserData eines Row Objektes ist das jeweilige ACT! PickListItem hinterlegt ' Bei diesem wird die Description auf den Menu.Text gesetzt CType(oSelectedRow.UserData, Act.Framework.PickLists.PickListItem).Description = oMenu.Text End Sub #End Region End Class End Class #End Region #Region "StatusManager" Class StatusManager Private m_frmStatus As System.Windows.Forms.Form Private WithEvents m_btnOK As System.Windows.Forms.Button Private WithEvents m_btnCancel As System.Windows.Forms.Button Private m_oProgress As System.Windows.Forms.ProgressBar Private m_txbInfo As System.Windows.Forms.TextBox Private m_oParentForm As System.Windows.Forms.Form Private m_oIcon As System.Drawing.Icon Private m_sTitle As System.String Private m_sState As System.String Private m_bCanceled As Boolean Public Sub New(ParentForm As System.Windows.Forms.Form, Icon As System.Drawing.Icon, Title As String) m_oParentForm = ParentForm m_oIcon = Icon m_sTitle = Title m_sState = "" End Sub Public Sub SetState(sState As String) m_sState = sState If m_frmStatus Is Nothing Then InitSatusForm m_frmStatus.Show(m_oParentForm) m_frmStatus.Top = m_oParentForm.top + m_oParentForm.Height \ 2 - m_frmStatus.Height \ 2 m_frmStatus.Left = m_oParentForm.left + m_oParentForm.width \ 2 - m_frmStatus.width \ 2 m_frmStatus.Focus End If If String.IsNullOrEmpty(m_sState) Then m_frmStatus.Text = m_sTitle Else m_frmStatus.Text = String.Format("{0} - {1}", m_sTitle, m_sState) End If End Sub Public Sub PrintStatus(Message As String) PrintStatus(Message, False) End Sub Public Sub PrintStatus(Message As String, NewLine As Boolean) If m_frmStatus Is Nothing Then InitSatusForm m_frmStatus.Show(m_oParentForm) m_frmStatus.Top = m_oParentForm.top + m_oParentForm.Height \ 2 - m_frmStatus.Height \ 2 m_frmStatus.Left = m_oParentForm.left + m_oParentForm.width \ 2 - m_frmStatus.width \ 2 m_frmStatus.Focus End If m_txbInfo.AppendText(Message) If newline Then m_txbInfo.AppendText(System.Environment.NewLine) End If m_frmStatus.Visible = True System.Windows.Forms.Application.DoEvents End Sub Public Sub PrintStatus(Message As String, Progress As Integer, MaxProgress As Integer) PrintStatus(Message, Progress, MaxProgress, False) End Sub Public Sub PrintStatus(Message As String, Progress As Integer, MaxProgress As Integer, Newline As Boolean) PrintStatus(Message, Newline) m_oProgress.Value = Progress m_oProgress.Maximum = MaxProgress System.Windows.Forms.Application.DoEvents End Sub Public Sub SetProgress(Progress As Integer) m_oProgress.Value = Progress System.Windows.Forms.Application.DoEvents End Sub Public Sub Close() If Not m_frmStatus Is Nothing Then If m_frmStatus.Visible = True Then m_frmStatus.Close End If End If End Sub Public Sub Hide() If Not m_frmStatus Is Nothing Then If m_frmStatus.Visible = True Then m_frmStatus.Visible = False System.Windows.Forms.Application.DoEvents End If End If End Sub Public Function ShowDialog(WithCancelButton As Boolean)As System.Windows.Forms.DialogResult If m_frmStatus Is Nothing Then InitSatusForm End If m_btnOK.Visible = True m_btnCancel.Visible = WithCancelButton m_frmStatus.Visible = False Return m_frmStatus.ShowDialog(m_oParentForm) End Function Public ReadOnly Property Canceled() As Boolean Get Return m_bCanceled End Get End Property Public Sub SetFocus() If Not m_frmStatus Is Nothing Then m_frmStatus.Focus End If End Sub Private Sub m_btnCancel_Clicked(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles m_btnCancel.Click If Msgbox("Soll der Vorgang abgebrochen werden?", MsgBoxStyle.YesNo Or MsgBoxStyle.Question, m_frmStatus.Text) = MsgBoxResult.Yes Then m_bCanceled = True End If End Sub Private Sub m_btnOK_Clicked(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles m_btnOK.Click m_frmStatus.Close End Sub Private Sub InitSatusForm m_btnOK = New System.Windows.Forms.Button With m_btnOK .Text = "OK" .DialogResult = DialogResult.OK .Dock = DockStyle.Bottom .Visible = False End With m_btnCancel = New System.Windows.Forms.Button With m_btnCancel .Text = "Abbruch" .DialogResult = DialogResult.Cancel .Dock = DockStyle.Bottom End With m_oProgress = New System.Windows.Forms.ProgressBar With m_oProgress .Value = 0 .Minimum = 0 .Maximum = 100 .Style = ProgressBarStyle.Blocks .Dock = DockStyle.Bottom End With m_txbInfo = New System.Windows.Forms.TextBox With m_txbInfo .Multiline = True .ScrollBars = ScrollBars.Both .Text = String.empty .Dock = DockStyle.Fill End With m_frmStatus = New System.Windows.Forms.Form m_frmStatus.SuspendLayout() With m_frmStatus .StartPosition = FormStartPosition.CenterParent .Width = 640 .Height = 480 .CancelButton = m_btnCancel .AcceptButton = m_btnOK .MinimumSize = New System.Drawing.Size(320, 240) .ControlBox = True .MinimizeBox = False .Icon = m_oIcon .Text = m_sTitle .ShowInTaskbar = False End With m_frmStatus.Controls.Add(m_txbInfo) m_frmStatus.Controls.Add(m_oProgress) m_frmStatus.Controls.Add(m_btnCancel) m_frmStatus.Controls.Add(m_btnOK) m_frmStatus.ResumeLayout() m_frmStatus.PerformLayout End Sub End Class #End Region #Region "FormAction" <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ Partial Class FormAction Inherits System.Windows.Forms.Form 'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. <System.Diagnostics.DebuggerNonUserCode()> _ Protected Overrides Sub Dispose(ByVal disposing As Boolean) Try If disposing AndAlso components IsNot Nothing Then components.Dispose() End If Finally MyBase.Dispose(disposing) End Try End Sub 'Wird vom Windows Form-Designer benötigt. Private components As System.ComponentModel.IContainer 'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich. 'Das Bearbeiten ist mit dem Windows Form-Designer möglich. 'Das Bearbeiten mit dem Code-Editor ist nicht möglich. <System.Diagnostics.DebuggerStepThrough()> _ Private Sub InitializeComponent() Me.lbTitle = New System.Windows.Forms.Label() Me.gbActionAct2BulkMailer = New System.Windows.Forms.GroupBox() Me.rbTransferCurrentLookupToExcludeList = New System.Windows.Forms.RadioButton() Me.rbCreateLookupFromExcludeList = New System.Windows.Forms.RadioButton() Me.LabelPreferences = New System.Windows.Forms.Label() Me.LabelBulkMailer2Act = New System.Windows.Forms.Label() Me.LabelAct2BulkMailer = New System.Windows.Forms.Label() Me.rbAttachMailingFilesToACTGroup = New System.Windows.Forms.RadioButton() Me.rbEditConfiguration = New System.Windows.Forms.RadioButton() Me.rbCreateActHistoriesFromLog = New System.Windows.Forms.RadioButton() Me.rbTransferCurrentGroupToAddressList = New System.Windows.Forms.RadioButton() Me.rbTransferCurrentLookupToAddressList = New System.Windows.Forms.RadioButton() Me.btnOK = New System.Windows.Forms.Button() Me.btnCancel = New System.Windows.Forms.Button() Me.rbRemoveContactFromExcludeList = New System.Windows.Forms.RadioButton() Me.gbActionAct2BulkMailer.SuspendLayout() Me.SuspendLayout() ' 'lbTitle ' Me.lbTitle.AutoSize = True Me.lbTitle.Location = New System.Drawing.Point(12, 9) Me.lbTitle.Name = "lbTitle" Me.lbTitle.Size = New System.Drawing.Size(184, 13) Me.lbTitle.TabIndex = 0 Me.lbTitle.Text = "Welche Aktion wollen Sie ausführen?" ' 'gbActionAct2BulkMailer ' Me.gbActionAct2BulkMailer.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _ Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbRemoveContactFromExcludeList) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbTransferCurrentLookupToExcludeList) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbCreateLookupFromExcludeList) Me.gbActionAct2BulkMailer.Controls.Add(Me.LabelPreferences) Me.gbActionAct2BulkMailer.Controls.Add(Me.LabelBulkMailer2Act) Me.gbActionAct2BulkMailer.Controls.Add(Me.LabelAct2BulkMailer) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbAttachMailingFilesToACTGroup) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbEditConfiguration) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbCreateActHistoriesFromLog) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbTransferCurrentGroupToAddressList) Me.gbActionAct2BulkMailer.Controls.Add(Me.rbTransferCurrentLookupToAddressList) Me.gbActionAct2BulkMailer.Location = New System.Drawing.Point(12, 37) Me.gbActionAct2BulkMailer.Name = "gbActionAct2BulkMailer" Me.gbActionAct2BulkMailer.Size = New System.Drawing.Size(450, 306) Me.gbActionAct2BulkMailer.TabIndex = 1 Me.gbActionAct2BulkMailer.TabStop = False Me.gbActionAct2BulkMailer.Text = "Aktionen" ' 'rbTransferCurrentLookupToExcludeList ' Me.rbTransferCurrentLookupToExcludeList.AutoSize = True Me.rbTransferCurrentLookupToExcludeList.Location = New System.Drawing.Point(21, 89) Me.rbTransferCurrentLookupToExcludeList.Name = "rbTransferCurrentLookupToExcludeList" Me.rbTransferCurrentLookupToExcludeList.Size = New System.Drawing.Size(339, 17) Me.rbTransferCurrentLookupToExcludeList.TabIndex = 3 Me.rbTransferCurrentLookupToExcludeList.TabStop = True Me.rbTransferCurrentLookupToExcludeList.Text = "Die aktuelle Su&che in die Ausschlußliste vom BulkMailer übertragen." Me.rbTransferCurrentLookupToExcludeList.UseVisualStyleBackColor = True ' 'rbCreateLookupFromExcludeList ' Me.rbCreateLookupFromExcludeList.AutoSize = True Me.rbCreateLookupFromExcludeList.Location = New System.Drawing.Point(21, 206) Me.rbCreateLookupFromExcludeList.Name = "rbCreateLookupFromExcludeList" Me.rbCreateLookupFromExcludeList.Size = New System.Drawing.Size(375, 17) Me.rbCreateLookupFromExcludeList.TabIndex = 8 Me.rbCreateLookupFromExcludeList.TabStop = True Me.rbCreateLookupFromExcludeList.Text = "Aus der A&usschlußliste vom BulkMailer eine aktuelle Suche in Act! erstellen." Me.rbCreateLookupFromExcludeList.UseVisualStyleBackColor = True ' 'LabelPreferences ' Me.LabelPreferences.AutoSize = True Me.LabelPreferences.Location = New System.Drawing.Point(6, 241) Me.LabelPreferences.Name = "LabelPreferences" Me.LabelPreferences.Size = New System.Drawing.Size(70, 13) Me.LabelPreferences.TabIndex = 9 Me.LabelPreferences.Text = "Einstellungen" ' 'LabelBulkMailer2Act ' Me.LabelBulkMailer2Act.AutoSize = True Me.LabelBulkMailer2Act.Location = New System.Drawing.Point(6, 144) Me.LabelBulkMailer2Act.Name = "LabelBulkMailer2Act" Me.LabelBulkMailer2Act.Size = New System.Drawing.Size(98, 13) Me.LabelBulkMailer2Act.TabIndex = 5 Me.LabelBulkMailer2Act.Text = "BulkMailer -> ACT!" ' 'LabelAct2BulkMailer ' Me.LabelAct2BulkMailer.AutoSize = True Me.LabelAct2BulkMailer.Location = New System.Drawing.Point(6, 27) Me.LabelAct2BulkMailer.Name = "LabelAct2BulkMailer" Me.LabelAct2BulkMailer.Size = New System.Drawing.Size(93, 13) Me.LabelAct2BulkMailer.TabIndex = 0 Me.LabelAct2BulkMailer.Text = " Act! -> BulkMailer" ' 'rbAttachMailingFilesToACTGroup ' Me.rbAttachMailingFilesToACTGroup.AutoSize = True Me.rbAttachMailingFilesToACTGroup.Location = New System.Drawing.Point(21, 183) Me.rbAttachMailingFilesToACTGroup.Name = "rbAttachMailingFilesToACTGroup" Me.rbAttachMailingFilesToACTGroup.Size = New System.Drawing.Size(391, 17) Me.rbAttachMailingFilesToACTGroup.TabIndex = 7 Me.rbAttachMailingFilesToACTGroup.TabStop = True Me.rbAttachMailingFilesToACTGroup.Text = "Die &Mailingvorlage und eventuelle Anlagen an die aktuelle Gruppe anhängen." Me.rbAttachMailingFilesToACTGroup.UseVisualStyleBackColor = True ' 'rbEditConfiguration ' Me.rbEditConfiguration.AutoSize = True Me.rbEditConfiguration.Location = New System.Drawing.Point(21, 257) Me.rbEditConfiguration.Name = "rbEditConfiguration" Me.rbEditConfiguration.Size = New System.Drawing.Size(241, 17) Me.rbEditConfiguration.TabIndex = 10 Me.rbEditConfiguration.TabStop = True Me.rbEditConfiguration.Text = "Die &Einstellungen von Act2BulkMailer ändern." Me.rbEditConfiguration.UseVisualStyleBackColor = True ' 'rbCreateActHistoriesFromLog ' Me.rbCreateActHistoriesFromLog.AutoSize = True Me.rbCreateActHistoriesFromLog.Location = New System.Drawing.Point(21, 160) Me.rbCreateActHistoriesFromLog.Name = "rbCreateActHistoriesFromLog" Me.rbCreateActHistoriesFromLog.Size = New System.Drawing.Size(330, 17) Me.rbCreateActHistoriesFromLog.TabIndex = 6 Me.rbCreateActHistoriesFromLog.TabStop = True Me.rbCreateActHistoriesFromLog.Text = "&Historien aus dem Sendeprotokoll eines Mailings in Act! erstellen." Me.rbCreateActHistoriesFromLog.UseVisualStyleBackColor = True ' 'rbTransferCurrentGroupToAddressList ' Me.rbTransferCurrentGroupToAddressList.AutoSize = True Me.rbTransferCurrentGroupToAddressList.Location = New System.Drawing.Point(21, 66) Me.rbTransferCurrentGroupToAddressList.Name = "rbTransferCurrentGroupToAddressList" Me.rbTransferCurrentGroupToAddressList.Size = New System.Drawing.Size(313, 17) Me.rbTransferCurrentGroupToAddressList.TabIndex = 2 Me.rbTransferCurrentGroupToAddressList.TabStop = True Me.rbTransferCurrentGroupToAddressList.Text = "Die aktuelle &Gruppe als Adressen zum BulkMailer übertragen." Me.rbTransferCurrentGroupToAddressList.UseVisualStyleBackColor = True ' 'rbTransferCurrentLookupToAddressList ' Me.rbTransferCurrentLookupToAddressList.AutoSize = True Me.rbTransferCurrentLookupToAddressList.Location = New System.Drawing.Point(21, 43) Me.rbTransferCurrentLookupToAddressList.Name = "rbTransferCurrentLookupToAddressList" Me.rbTransferCurrentLookupToAddressList.Size = New System.Drawing.Size(309, 17) Me.rbTransferCurrentLookupToAddressList.TabIndex = 1 Me.rbTransferCurrentLookupToAddressList.TabStop = True Me.rbTransferCurrentLookupToAddressList.Text = "Die aktuelle &Suche als Adressen zum BulkMailer übertragen." Me.rbTransferCurrentLookupToAddressList.UseVisualStyleBackColor = True ' 'btnOK ' Me.btnOK.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnOK.DialogResult = System.Windows.Forms.DialogResult.OK Me.btnOK.Location = New System.Drawing.Point(306, 349) Me.btnOK.Name = "btnOK" Me.btnOK.Size = New System.Drawing.Size(75, 23) Me.btnOK.TabIndex = 2 Me.btnOK.Text = "&OK" Me.btnOK.UseVisualStyleBackColor = True ' 'btnCancel ' Me.btnCancel.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel Me.btnCancel.Location = New System.Drawing.Point(387, 349) Me.btnCancel.Name = "btnCancel" Me.btnCancel.Size = New System.Drawing.Size(75, 23) Me.btnCancel.TabIndex = 3 Me.btnCancel.Text = "&Abbruch" Me.btnCancel.UseVisualStyleBackColor = True ' 'rbRemoveContactFromExcludeList ' Me.rbRemoveContactFromExcludeList.AutoSize = True Me.rbRemoveContactFromExcludeList.Location = New System.Drawing.Point(21, 112) Me.rbRemoveContactFromExcludeList.Name = "rbRemoveContactFromExcludeList" Me.rbRemoveContactFromExcludeList.Size = New System.Drawing.Size(365, 17) Me.rbRemoveContactFromExcludeList.TabIndex = 4 Me.rbRemoveContactFromExcludeList.TabStop = True Me.rbRemoveContactFromExcludeList.Text = "Den aktuellen &Kontakt aus der Ausschlußliste vom BulkMailer entfernen." Me.rbRemoveContactFromExcludeList.UseVisualStyleBackColor = True ' 'FormAction ' Me.AcceptButton = Me.btnOK Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.CancelButton = Me.btnCancel Me.ClientSize = New System.Drawing.Size(484, 386) Me.Controls.Add(Me.btnCancel) Me.Controls.Add(Me.btnOK) Me.Controls.Add(Me.gbActionAct2BulkMailer) Me.Controls.Add(Me.lbTitle) Me.MinimizeBox = False Me.MinimumSize = New System.Drawing.Size(500, 260) Me.Name = "FormAction" Me.ShowInTaskbar = False Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent Me.Text = "Act2BulkMailer" Me.gbActionAct2BulkMailer.ResumeLayout(False) Me.gbActionAct2BulkMailer.PerformLayout() Me.ResumeLayout(False) Me.PerformLayout() End Sub Friend WithEvents lbTitle As System.Windows.Forms.Label Friend WithEvents gbActionAct2BulkMailer As System.Windows.Forms.GroupBox Friend WithEvents rbEditConfiguration As System.Windows.Forms.RadioButton Friend WithEvents rbTransferCurrentGroupToAddressList As System.Windows.Forms.RadioButton Friend WithEvents rbTransferCurrentLookupToAddressList As System.Windows.Forms.RadioButton Friend WithEvents btnOK As System.Windows.Forms.Button Friend WithEvents btnCancel As System.Windows.Forms.Button Friend WithEvents rbAttachMailingFilesToACTGroup As System.Windows.Forms.RadioButton Friend WithEvents rbCreateActHistoriesFromLog As System.Windows.Forms.RadioButton Friend WithEvents rbCreateLookupFromExcludeList As System.Windows.Forms.RadioButton Friend WithEvents LabelPreferences As System.Windows.Forms.Label Friend WithEvents LabelBulkMailer2Act As System.Windows.Forms.Label Friend WithEvents LabelAct2BulkMailer As System.Windows.Forms.Label Friend WithEvents rbTransferCurrentLookupToExcludeList As System.Windows.Forms.RadioButton Friend WithEvents rbRemoveContactFromExcludeList As System.Windows.Forms.RadioButton End Class #End Region #Region "FormMailingSelection" <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ Partial Class FormMailingSelection Inherits System.Windows.Forms.Form 'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. <System.Diagnostics.DebuggerNonUserCode()> _ Protected Overrides Sub Dispose(ByVal disposing As Boolean) Try If disposing AndAlso components IsNot Nothing Then components.Dispose() End If Finally MyBase.Dispose(disposing) End Try End Sub 'Wird vom Windows Form-Designer benötigt. Private components As System.ComponentModel.IContainer 'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich. 'Das Bearbeiten ist mit dem Windows Form-Designer möglich. 'Das Bearbeiten mit dem Code-Editor ist nicht möglich. <System.Diagnostics.DebuggerStepThrough()> _ Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Me.tvMailings = New System.Windows.Forms.TreeView() Me.btnCancel = New System.Windows.Forms.Button() Me.btnOK = New System.Windows.Forms.Button() Me.lbInfo = New System.Windows.Forms.Label() Me.ilTree = New System.Windows.Forms.ImageList(Me.components) Me.SuspendLayout() ' 'tvMailings ' Me.tvMailings.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _ Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.tvMailings.Location = New System.Drawing.Point(12, 12) Me.tvMailings.Name = "tvMailings" Me.tvMailings.Size = New System.Drawing.Size(319, 328) Me.tvMailings.TabIndex = 0 ' 'btnCancel ' Me.btnCancel.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel Me.btnCancel.Location = New System.Drawing.Point(256, 407) Me.btnCancel.Name = "btnCancel" Me.btnCancel.Size = New System.Drawing.Size(75, 23) Me.btnCancel.TabIndex = 3 Me.btnCancel.Text = "&Abbruch" Me.btnCancel.UseVisualStyleBackColor = True ' 'btnOK ' Me.btnOK.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnOK.DialogResult = System.Windows.Forms.DialogResult.OK Me.btnOK.Location = New System.Drawing.Point(175, 407) Me.btnOK.Name = "btnOK" Me.btnOK.Size = New System.Drawing.Size(75, 23) Me.btnOK.TabIndex = 2 Me.btnOK.Text = "&OK" Me.btnOK.UseVisualStyleBackColor = True ' 'lbInfo ' Me.lbInfo.Anchor = CType(((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.lbInfo.Location = New System.Drawing.Point(12, 343) Me.lbInfo.Name = "lbInfo" Me.lbInfo.Size = New System.Drawing.Size(319, 51) Me.lbInfo.TabIndex = 1 Me.lbInfo.Text = "Info" ' 'ilTree ' Me.ilTree.ColorDepth = System.Windows.Forms.ColorDepth.Depth32Bit Me.ilTree.ImageSize = New System.Drawing.Size(16, 16) Me.ilTree.TransparentColor = System.Drawing.Color.Transparent ' 'FormMailingSelection ' Me.AcceptButton = Me.btnOK Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.CancelButton = Me.btnCancel Me.ClientSize = New System.Drawing.Size(344, 442) Me.Controls.Add(Me.lbInfo) Me.Controls.Add(Me.btnCancel) Me.Controls.Add(Me.btnOK) Me.Controls.Add(Me.tvMailings) Me.MinimizeBox = False Me.MinimumSize = New System.Drawing.Size(360, 320) Me.Name = "FormMailingSelection" Me.ShowInTaskbar = False Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent Me.Text = "Mailing-Auswahl" Me.ResumeLayout(False) End Sub Friend WithEvents tvMailings As System.Windows.Forms.TreeView Friend WithEvents btnCancel As System.Windows.Forms.Button Friend WithEvents btnOK As System.Windows.Forms.Button Friend WithEvents lbInfo As System.Windows.Forms.Label Friend WithEvents ilTree As System.Windows.Forms.ImageList End Class #End Region #Region "FormHistoryDetails" <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ Partial Class FormHistoryDetails Inherits System.Windows.Forms.Form 'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. <System.Diagnostics.DebuggerNonUserCode()> _ Protected Overrides Sub Dispose(ByVal disposing As Boolean) Try If disposing AndAlso components IsNot Nothing Then components.Dispose() End If Finally MyBase.Dispose(disposing) End Try End Sub 'Wird vom Windows Form-Designer benötigt. Private components As System.ComponentModel.IContainer 'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich. 'Das Bearbeiten ist mit dem Windows Form-Designer möglich. 'Das Bearbeiten mit dem Code-Editor ist nicht möglich. <System.Diagnostics.DebuggerStepThrough()> _ Private Sub InitializeComponent() Me.lbTitle = New System.Windows.Forms.Label() Me.TextBoxDetails = New System.Windows.Forms.TextBox() Me.btnCancel = New System.Windows.Forms.Button() Me.btnOK = New System.Windows.Forms.Button() Me.SuspendLayout() ' 'lbTitle ' Me.lbTitle.AutoSize = True Me.lbTitle.Location = New System.Drawing.Point(12, 9) Me.lbTitle.Name = "lbTitle" Me.lbTitle.Size = New System.Drawing.Size(278, 13) Me.lbTitle.TabIndex = 0 Me.lbTitle.Text = "Bitte geben Sie eventuelle Details für die Act! Historie ein." ' 'TextBoxDetails ' Me.TextBoxDetails.AcceptsReturn = True Me.TextBoxDetails.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _ Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.TextBoxDetails.Location = New System.Drawing.Point(15, 44) Me.TextBoxDetails.Multiline = True Me.TextBoxDetails.Name = "TextBoxDetails" Me.TextBoxDetails.ScrollBars = System.Windows.Forms.ScrollBars.Both Me.TextBoxDetails.Size = New System.Drawing.Size(317, 357) Me.TextBoxDetails.TabIndex = 1 ' 'btnCancel ' Me.btnCancel.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnCancel.DialogResult = System.Windows.Forms.DialogResult.Cancel Me.btnCancel.Location = New System.Drawing.Point(257, 407) Me.btnCancel.Name = "btnCancel" Me.btnCancel.Size = New System.Drawing.Size(75, 23) Me.btnCancel.TabIndex = 3 Me.btnCancel.Text = "&Abbruch" Me.btnCancel.UseVisualStyleBackColor = True ' 'btnOK ' Me.btnOK.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.btnOK.DialogResult = System.Windows.Forms.DialogResult.OK Me.btnOK.Location = New System.Drawing.Point(176, 407) Me.btnOK.Name = "btnOK" Me.btnOK.Size = New System.Drawing.Size(75, 23) Me.btnOK.TabIndex = 2 Me.btnOK.Text = "&OK" Me.btnOK.UseVisualStyleBackColor = True ' 'FormHistoryDetails ' Me.AcceptButton = Me.btnOK Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.CancelButton = Me.btnCancel Me.ClientSize = New System.Drawing.Size(344, 442) Me.Controls.Add(Me.btnCancel) Me.Controls.Add(Me.btnOK) Me.Controls.Add(Me.TextBoxDetails) Me.Controls.Add(Me.lbTitle) Me.MinimizeBox = False Me.MinimumSize = New System.Drawing.Size(360, 360) Me.Name = "FormHistoryDetails" Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent Me.Text = "Eingabe Historiendetails" Me.ResumeLayout(False) Me.PerformLayout() End Sub Friend WithEvents lbTitle As System.Windows.Forms.Label Friend WithEvents TextBoxDetails As System.Windows.Forms.TextBox Friend WithEvents btnCancel As System.Windows.Forms.Button Friend WithEvents btnOK As System.Windows.Forms.Button End Class #End Region Private Sub Dummy() 'Return String.Empty ACTOptimum_AutoData