<?xml version="1.0" encoding="utf-16" standalone="yes"?>
<!--Created: 02.10.2018 14:52:56-->
<!--ACTOptimumVersion: 6.0.6842.17098-->
<ACTOptimumItems ACTOptimumVersion="6.0.6842.17098" Created="02.10.2018 14:52:56">
    <AutoDataMenu Created="02.10.2018 14:52:56" ClassName="Melville_Schellmann.ACTOptimum6.Plugin.MenuItemAutoData" PrefClassVersion="1.0" ACTOptimumVersion="6.0.6842.17098">
        <GlobalPref>True</GlobalPref>
        <NeededRole>2</NeededRole>
        <Name>MarkerMap</Name>
        <Tooltip>Zeigt die geocodierten Kontakte der aktuellen Suche in Google Maps an.</Tooltip>
        <Description>Zeigt die geocodierten Kontakte der aktuellen Suche in Google Maps an.</Description>
        <CommandBar>Connected Menus</CommandBar>
        <Menu>act-ui://com.act/application/menu/contact</Menu>
        <Index>-1</Index>
        <Separator>False</Separator>
        <Shortcut>None</Shortcut>
        <SourceCode>' #ScriptName: MarkerMap
    ' #Description: Überträgt die aktuelle Kontaktsuche bzw. Auswahl in eine Google-Maps Karte
    ' #Copyright: © 2015-2018 by Melville-Schellmann
    ' #Author: Robert Schellmann, rs@melville-schellmann.de
    ' #Version: 0.97 (02.10.2018) Neue Option für Google API Key hinzugefügt
    ' #Version: 0.96 (12.01.2018) Verwendung vom HTTP-Proxy, wenn nötig
    ' #Version: 0.95 (19.12.2017) Zusätzliche Option eines Feldes, in dem die Farbe für die Markierungen hinterlegt werden können
    ' #Version: 0.94 (20.09.2017) Filterung von CR und LF Zeichen in ACT! Feldinhalten wie Telefon und Email
    ' #Version: 0.93 (04.11.2015) Erweiterung auf Labels mit kleinen Buchstaben und 2000 Xe, Kein Fehler bei leeren Telefonnummern
    ' #Version: 0.91 (14.09.2015) ACT! Felder können auch
    ' #Version: 0.9 (31.08.2015) s.o.
    
    Dim sFieldNameLng As String = "Benutzer 9" ' Name des Feldes in dem der Längengrad der Geo-Koordinaten steht
    Dim sFieldNameLat As String = "Benutzer 10" ' Name des Feldes in dem der Breitengrad der Geo-Koordinaten steht
    Dim sFieldNameTitle As String = "Firma" ' Name des Feldes, dessen Inhalt als Titel der Marke verwendet wird
    Dim sFieldNamesDetails As String = "Kontakt,Telefon,E-Mail" ' Name der Felder (mit Komma getrennt), deren Inhalte als Detailtext verwendet werden
    Dim sFieldNameColor As String = "Benutzer 2" ' Name des Feldes in dem die zu verwendene Farbe für die Markierung enthalten ist
    Dim sDefaultTitle As String = "Dummy" ' Falls der Titel leer, ist wird dieser Text verwendet
    Dim sDefaultBackgroundColor As String = "#FFBA6F" ' Standradfarbe ein helles Orange
    Dim sDefaultBorderColor As String = "DimGrey" ' Standardumrandungsfarbe ein dunkles Grau
    Dim sAPIKey As String = "" ' Google API Key

    ' ----------------------------------------------------------------------------------------------------------------------------
    ' Ab hier bitte keine Änderungen durchführen
    ' ----------------------------------------------------------------------------------------------------------------------------
    
    m_sScript = "MarkerMap"
    m_oACTApp = ACTApp
    
    Dim sHTMLFileName As String = "MarkerMap.htm"
    Dim sLabels As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890abcdefghijklmnopqrstuvwxyz" + (New System.Text.StringBuilder(2000)).Append("X", 2000).ToString()
    Dim sURLBase As String = "http://www.servicetransparent.de/service/markermap/" 
    Dim sHTMLPage As String = "markermap.htm"
    Dim sReplacementMarkJSONData As String = "// custom data //"
    Dim sReplacementMarkCultureData As String = "// custom culture //"
    Dim sGoogleAPIUrl = "https://maps.googleapis.com/maps/api/js?&amp;libraries=drawing,geometry"
    Dim sCulture = "de"
    
    Dim sHtml As String
    Dim sPath As String
    
    Dim oEntities As Act.Framework.MutableEntities.MutableEntityList
    Dim oEntity As act.Framework.MutableEntities.MutableEntity
    
    Dim sJavaScript As System.Text.StringBuilder
    Dim oFieldLng As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oFieldLat As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oFieldTitle As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oFieldDetails As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oFieldsDetails As System.Collections.Generic.List(Of Act.Framework.MutableEntities.MutableEntityFieldDescriptor)
    Dim oFieldColor As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    Dim oPhoneField As Act.Framework.Phones.PhoneNumberFieldDescriptor
    Dim oPhoneNumber As Act.Framework.Phones.PhoneNumber
    
    Dim dLng As Decimal
    Dim dLat As Decimal
    Dim sLabel As String
    Dim sTitle As String
    Dim sDetails As String
    Dim sColor As String
    Dim bBadColorErrorOccurred As Boolean
    Dim bBadCoordinateErrorOccurred As Boolean
    
    Dim aFieldNameDetails() As String
    Dim lFieldIndex As Integer

    If TryGetMutableFieldDescriptor(Act.Framework.CustomEntities.ParentEntity.Contacts, sFieldNameLng, oFieldLng) = False Then
      GoTo Abbruch
    End If
    If TryGetMutableFieldDescriptor(Act.Framework.CustomEntities.ParentEntity.Contacts, sFieldNameLat, oFieldLat) = False Then
      GoTo Abbruch
    End If
    If TryGetMutableFieldDescriptor(Act.Framework.CustomEntities.ParentEntity.Contacts, sFieldNameTitle, oFieldTitle) = False Then
      GoTo Abbruch
    End If
    
    If Not String.IsNullOrEmpty(sFieldNameColor) Then
      If TryGetMutableFieldDescriptor(Act.Framework.CustomEntities.ParentEntity.Contacts, sFieldNameColor, oFieldColor) = False Then
        GoTo Abbruch
      End If
    End If
    
    aFieldNameDetails = sFieldNamesDetails.Split(New Char(){","c}, StringSplitOptions.RemoveEmptyEntries)
    oFieldsDetails = New System.Collections.Generic.List(Of Act.Framework.MutableEntities.MutableEntityFieldDescriptor)
    sDetails = String.Empty
    For lFieldIndex = 0 To aFieldNameDetails.Length - 1
      If TryGetMutableFieldDescriptor(Act.Framework.CustomEntities.ParentEntity.Contacts, aFieldNameDetails(lFieldIndex), oFieldDetails) = False Then
        GoTo Abbruch
      End If
      oFieldsDetails.Add(oFieldDetails)
    Next
    
    sPath = System.Environment.GetFolderPath(System.Environment.SpecialFolder.Desktop)
    sPath = System.IO.Path.Combine(sPath, sHTMLFileName)
    
    If TypeOf(m_oACTApp.CurrentView) Is act.UI.IContactListView Then
      CType(m_oACTApp.CurrentView, act.UI.IContactListView).GetSelectedContacts
      oEntities = CType(m_oACTApp.CurrentView, act.UI.IContactListView).GetSelectedContacts
      If oEntities Is Nothing OrElse oEntities.Count = 1 Then
        oEntities = m_oACTApp.ApplicationState.CurrentContactList  
      End If
    Else
      oEntities = m_oACTApp.ApplicationState.CurrentContactList  
    End If
    If oEntities Is Nothing OrElse oEntities.Count &lt; 2 Then
      MsgBox(String.Format("Es müssen sich mindestens 2 Datensätze in der aktuellen Suche befinden bzw. markiert sein."), MsgBoxStyle.Information, m_sScript)
      GoTo Abbruch
    End If
    If oEntities.Count &gt; sLabels.Length Then
      MsgBox(String.Format("Die maximale Anzahl an Datensätzen beträgt {0}. In der aktuellen Suche befinden sich {1} Datensätze bzw. sind markiert.", _
        sLabels.Length, oEntities.Count), MsgBoxStyle.Information, m_sScript)
      GoTo Abbruch
    End If

    sJavaScript = New System.Text.StringBuilder
    sJavaScript.AppendLine("s="""";")
    
    Dim sErrors As System.Text.StringBuilder
    Dim aTitles As System.Collections.Generic.Dictionary(Of String,String)
    Dim lUniqueCounter As Integer
    Dim i As Integer
    Dim bIsOneAppended As Boolean
    
    sErrors = New System.Text.StringBuilder
    bIsOneAppended = False
    
    sJavaScript.AppendLine("s += '{';")
    sJavaScript.AppendLine("s += '""markers"": [';")
    
    aTitles = New System.Collections.Generic.Dictionary(Of String,String)
    
    bBadColorErrorOccurred = False
    bBadCoordinateErrorOccurred = False
    
    For i = 0 To  oEntities.Count - 1
      oEntity = oEntities.GetEntity(i)
      sLabel = sLabels.Substring(i, 1)
      
      ' Validate Title, must be unique      
      sTitle = oFieldTitle.GetValue(oEntity)
      If String.IsNullOrEmpty(sTitle) Then
        sTitle = sDefaultTitle
      End If
      If aTitles.ContainsKey(sTitle) Then
        lUniqueCounter = 1
        Do
          lUniqueCounter += 1
        Loop Until Not aTitles.ContainsValue(String.Format("{0} ({1})", sTitle, lUniqueCounter))
        sTitle = String.Format("{0} ({1})", sTitle, lUniqueCounter)
      End If
      aTitles.Add(sTitle, sTitle)

      ' Validate latitude
      If String.IsNullOrEmpty(oFieldLng.GetValue(oEntity)) Then
        sErrors.AppendLine(String.Format("In dem Datensatz '{0}' ist der Inhalt des Feldes '{1}' leer.", sTitle, sFieldNameLng))
      Else
        If Decimal.TryParse(oFieldLng.GetValue(oEntity), dLng) = False Then
          sErrors.AppendLine(String.Format("In dem Datensatz '{0}' ist der Inhalt '{1}' des Feldes '{2}' kein Längengrad.", sTitle, oFieldLng.GetValue(oEntity).ToString, sFieldNameLng))
          bBadCoordinateErrorOccurred = True
        End If
      End If
      
      ' Validate longitude
      If String.IsNullOrEmpty(oFieldLat.GetValue(oEntity)) Then
        sErrors.AppendLine(String.Format("In dem Datensatz '{0}' ist der Inhalt des Feldes '{1}' leer.", sTitle, sFieldNameLat))
      Else
        If String.IsNullOrEmpty(oFieldLat.GetValue(oEntity)) OrElse Decimal.TryParse(oFieldLat.GetValue(oEntity), dLat) = False Then
          sErrors.AppendLine(String.Format("In dem Datensatz '{0}' ist der Inhalt '{1}' des Feldes '{2}' kein Breitengrad.", sTitle, oFieldLat.GetValue(oEntity).ToString, sFieldNameLat))
          bBadCoordinateErrorOccurred = True
        End If
      End If

      ' Validate color
      sColor = sDefaultBackgroundColor
      If Not String.IsNullOrEmpty(sFieldNameColor) Then
        If Not String.IsNullOrEmpty(oFieldColor.GetValue(oEntity)) Then
          sColor = FilterBadChars(oFieldColor.GetValue(oEntity))
          If Not IsValidColor(sColor) Then
            sErrors.AppendLine(String.Format("In dem Datensatz '{0}' ist der Inhalt '{1}' des Feldes '{2}' kein gültiger Farbwert.", sTitle, sColor, sFieldNameColor))
            bBadColorErrorOccurred = True
          End If
        End If
      End If
      
      ' Creating the details for the marker info window
      sDetails = String.Empty
      For Each oFieldDetails In oFieldsDetails
        If Not String.IsNullOrEmpty(oFieldDetails.GetValue(oEntity)) Then
          If Not String.IsNullOrEmpty(sDetails) Then
            sDetails &amp;= "&lt;br /&gt;"
          End If
          Select Case  oFieldDetails.ACTFieldType
            Case  Act.Framework.Database.FieldDataType.Phone
              oPhoneField = m_oACTApp.ActFramework.PhoneManager.GetPhoneNumberFieldDescriptor(oFieldDetails.Name)
              oPhoneNumber = TryCast(oPhoneField.GetValue(oEntity), act.framework.phones.phonenumber)
              sDetails &amp;= String.Format("{0}: &lt;a href=""tel:+{1}{2}""&gt;{3}&lt;/a&gt;", _
                oFieldDetails.DisplayName, _
                oPhoneNumber.CountryCode, _
                GetRawNumberWithoutZero(oPhoneNumber.RawNumber), _
                FilterBadChars(oFieldDetails.GetValue(oEntity)))
            Case Act.Framework.Database.FieldDataType.Email
              sDetails &amp;= String.Format("{0}: &lt;a href=""mailto:{1}""&gt;{2}&lt;/a&gt;", _ 
                oFieldDetails.DisplayName, _
                FilterBadChars(oFieldDetails.GetValue(oEntity)), _
                FilterBadChars(oFieldDetails.GetValue(oEntity)))
            Case Act.Framework.Database.FieldDataType.Url
              sDetails &amp;= String.Format("{0}: &lt;a href=""{1}""&gt;{2}&lt;/a&gt;", _ 
                oFieldDetails.DisplayName, _
                FilterBadChars(oFieldDetails.GetValue(oEntity)), _
                FilterBadChars(oFieldDetails.GetValue(oEntity)))
            Case Else
              sDetails &amp;= oFieldDetails.DisplayName &amp; ": " &amp; oFieldDetails.GetValue(oEntity)     
          End Select
        End If
      Next
      If Not String.IsNullOrEmpty(sDetails) Then
        sDetails &amp;= "&lt;br /&gt;"
      End If
      sDetails &amp;= String.Format("&lt;a href=""actremote://showcontact/{0}""&gt;In Act! anzeigen&lt;/a&gt;", oEntity.ID.ToString)
      
      ' Creating the JavaScript code for the JSON data
      If bIsOneAppended Then
        sJavaScript.AppendLine(("s += ',';"))
      End If
      sJavaScript.AppendLine("s += '{';")
      sJavaScript.AppendLine(String.Format("s += '""title"": ""{0}"",';", GetJavaScriptString(sTitle)))
      sJavaScript.AppendLine(String.Format("s += '""label"": ""{0}"",';", GetJavaScriptString(sLabel)))
      sJavaScript.AppendLine(String.Format("s += '""fillColor"": ""{0}"",';", GetJavaScriptString(sColor)))
      sJavaScript.AppendLine(String.Format("s += '""strokeColor"": ""{0}"",';", GetJavaScriptString(sDefaultBorderColor)))
      sJavaScript.AppendLine(String.Format("s += '""content"": ""{0}"",';", GetJavaScriptString(sDetails)))
      sJavaScript.AppendLine(String.Format("s += '""lat"": {0},';", dLat.ToString(System.Globalization.CultureInfo.CreateSpecificCulture("en"))))
      sJavaScript.AppendLine(String.Format("s += '""lng"": {0}';", dLng.ToString(System.Globalization.CultureInfo.CreateSpecificCulture("en"))))
      sJavaScript.AppendLine(("s += '}';"))
      bIsOneAppended = True
    Next    
    sJavaScript.AppendLine(("s += ']';"))
    sJavaScript.AppendLine(("s += '}';"))
    
    If Not String.IsNullOrEmpty(sErrors.ToString) Then
      MsgBox("Beim Vorbereiten der Daten sind folgende Fehler aufgetreten:" &amp; vbcrlf &amp; sErrors.ToString, MsgBoxStyle.Information, m_sScript)
      If bBadCoordinateErrorOccurred Then
        If MsgBox("Um korrekte Geokoordinaten für die Datensätze zu ermitteln verwenden Sie bitte das AutoData-Skript 'GeoCode'." &amp; vbcrlf &amp; _
          "Wollen Sie das Skript von der Internetseite www.melville-schellmann.de downloaden?", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, m_sScript) = MsgBoxResult.Yes Then
          Process.Start("http://www.melville-schellmann.de/m_vbscript_autodata.htm#ADB_GeoCode")
        End If
      End If
      If bBadColorErrorOccurred Then
        If MsgBox("Um korrekte Farbwerte für die Datensätze zu erhalten verwenden Sie bitte die Farbnamen bzw. HTML-Farbcodes auf der Internetseite www.w3schools.com." &amp; vbcrlf &amp; _
          "Wollen Sie diese Internetseite aufrufen?", MsgBoxStyle.Question Or MsgBoxStyle.YesNo, m_sScript) = MsgBoxResult.Yes Then
          Process.Start("https://www.w3schools.com/colors/colors_names.asp")
        End If
      End If
      GoTo Abbruch
    End If
    
    If TryGetHTMLCodeFromURL(String.Format("{0}{1}", sURLBase, sHTMLPage), sHtml) = False Then
      GoTo Abbruch
    End If
    
    ' Insert URL base to script sources
    sHtml = sHtml.Replace("&lt;script src=""scripts", "&lt;script src=""" &amp; sURLBase &amp; "scripts")
    ' Insert URL base to css sources
    sHtml = sHtml.Replace("&lt;link href=""content", "&lt;link href=""" &amp; sURLBase &amp; "content")
    sHtml = sHtml.Replace("&lt;link href=""styles", "&lt;link href=""" &amp; sURLBase &amp; "styles")

    'Insert JSON Data In the HTML-Code
    sHtml = sHtml.Replace(sReplacementMarkJSONData, sJavaScript.ToString)

    'Insert culture Data In the HTML-Code
    sHtml = sHtml.Replace(sReplacementMarkCultureData, String.Format("return '{0}';", sCulture))
    
    'Insert Google API Url
    If Not String.IsNullOrEmpty(sAPIKey) Then
      If sHtml.IndexOf(sGoogleAPIUrl) &lt; 0 Then
        Msgbox(String.Format("Die Google API url '{0}' wurde nicht in der HTML-Seite gefunden.", sGoogleAPIUrl), MsgBoxStyle.Exclamation, m_sScript)
        GoTo Abbruch
      End If
      sHtml = sHtml.Replace(sGoogleAPIUrl, sGoogleAPIUrl &amp; String.Format("&amp;key={0}", sAPIKey))
    End If
    

    System.IO.File.WriteAllText(sPath, sHtml)
    
    System.Diagnostics.Process.Start(sPath)    
    
    Abbruch:
  End Sub
  
  Private Shared m_sScript As String
  Private Shared m_oACTApp As Act.UI.ActApplication
  
  Private Shared Function FilterBadChars(Value As Object) As String
    Dim sValue As String
    If Value Is Nothing Then
      Return String.Empty
    End If
    If String.IsNullOrEmpty(Value) Then
      Return String.Empty
    End If
    sValue = Value.ToString
    sValue = sValue.Replace(vbcr, String.Empty)
    sValue = sValue.Replace(vblf, String.Empty)
    Return sValue
  End Function

  Private Shared Function GetJavaScriptString (Value  As String) As String
    Dim i As Integer
    Dim c As Char
    Dim aChars() As Char
    Dim sNew As New system.Text.StringBuilder
    If String.IsNullOrEmpty(Value) Then
      Return String.Empty
    End If
    Value = Value.Replace(Environment.NewLine, "&lt;br /&gt;")   
    aChars = Value.ToCharArray
    
    For i = 0 To aChars.Length - 1
      c = aChars(i)
      Select Case c  
        Case "'"c
          sNew.Append("\'")
        Case "\"c
          sNew.Append("\\\\")
        Case """"c
          sNew.Append("\\""")
        Case Else
          sNew.Append(c)
      End Select
    Next
    Return sNew.ToString
  End Function
  Private Shared Function IsValidColor(sValue As String) As Boolean
    Dim sAllowedColorNames As String
    Dim sAllowedHexChars As String
    Dim i As Integer
    
    IsValidColor = False
    If String.IsNullOrEmpty(sValue) Then
      GoTo Abbruch
    End If
    sValue = sValue.Trim
    If sValue.Length = 0 Then
      GoTo Abbruch
    End If
    If sValue.Substring(0, 1) = "#" Then
      If sValue.Length = 1 Then
        GoTo Abbruch
      End If
      sValue = sValue.Substring(1)
      sAllowedHexChars = "0123456789abcdef"
      For i = 0 To sValue.ToLower.Length - 1
        If Not sAllowedHexChars.IndexOf(sValue.chars(i)) &gt;= 0 Then
          GoTo Abbruch
        End If
      Next
    Else
      sValue &amp;= ","
      sAllowedColorNames = "AliceBlue,AntiqueWhite,Aqua,Aquamarine,Azure,Beige,Bisque,Black,BlanchedAlmond,Blue,BlueViolet,Brown,BurlyWood,CadetBlue,Chartreuse,Chocolate,Coral,CornflowerBlue,Cornsilk,Crimson,Cyan,DarkBlue,DarkCyan,DarkGoldenRod,DarkGray,DarkGrey,DarkGreen,DarkKhaki,DarkMagenta,DarkOliveGreen,DarkOrange,DarkOrchid,DarkRed,DarkSalmon,DarkSeaGreen,DarkSlateBlue,DarkSlateGray,DarkSlateGrey,DarkTurquoise,DarkViolet,DeepPink,DeepSkyBlue,DimGray,DimGrey,DodgerBlue,FireBrick,FloralWhite,ForestGreen,Fuchsia,Gainsboro,GhostWhite,Gold,GoldenRod,Gray,Grey,Green,GreenYellow,HoneyDew,HotPink,IndianRed,Indigo,Ivory,Khaki,Lavender,LavenderBlush,LawnGreen,LemonChiffon,LightBlue,LightCoral,LightCyan,LightGoldenRodYellow,LightGray,LightGrey,LightGreen,LightPink,LightSalmon,LightSeaGreen,LightSkyBlue,LightSlateGray,LightSlateGrey,LightSteelBlue,LightYellow,Lime,LimeGreen,Linen,Magenta,Maroon,MediumAquaMarine,MediumBlue,MediumOrchid,MediumPurple,MediumSeaGreen,MediumSlateBlue,MediumSpringGreen,MediumTurquoise,MediumVioletRed,MidnightBlue,MintCream,MistyRose,Moccasin,NavajoWhite,Navy,OldLace,Olive,OliveDrab,Orange,OrangeRed,Orchid,PaleGoldenRod,PaleGreen,PaleTurquoise,PaleVioletRed,PapayaWhip,PeachPuff,Peru,Pink,Plum,PowderBlue,Purple,RebeccaPurple,Red,RosyBrown,RoyalBlue,SaddleBrown,Salmon,SandyBrown,SeaGreen,SeaShell,Sienna,Silver,SkyBlue,SlateBlue,SlateGray,SlateGrey,Snow,SpringGreen,SteelBlue,Tan,Teal,Thistle,Tomato,Turquoise,Violet,Wheat,White,WhiteSmoke,Yellow,YellowGreen,"
      If Not sAllowedColorNames.ToLower.IndexOf(sValue.ToLower) &gt;= 0 Then
        GoTo Abbruch
      End If
    End If
    IsValidColor = True
    Abbruch:
  End Function
  Private Shared Function GetRawNumberWithoutZero(sNumber As String) As String
    Dim i As Integer
    Dim sChar As String
    Dim sNewNumber As String
    Dim sDigits As String = "0123456789"
    If sNumber Is Nothing Then
      sNumber = String.Empty
    End If
    sNewNumber = String.Empty
    For i = 0 To snumber.Length - 1
      sChar = sNumber.Substring(i, 1)
      If sDigits.IndexOf(sChar) &gt;= 0 Then 
        If  String.IsNullOrEmpty(sNewNumber) And sChar = "0" Then
          ' Ignore first zero
        Else
          sNewNumber &amp;= sChar
        End If
      End If
    Next
    Return sNewNumber    
  
  End Function
  Private Shared Function TryGetMutableFieldDescriptor(ParentEntity As Act.Framework.CustomEntities.ParentEntity, ByVal FieldName As String, ByRef FieldDescriptor As Act.Framework.MutableEntities.MutableEntityFieldDescriptor) As Boolean
    Dim lFieldIndex As Integer
    Dim aFields() As Act.Framework.MutableEntities.MutableEntityFieldDescriptor
    
    TryGetMutableFieldDescriptor = False
    FieldDescriptor = Nothing
    
    Select Case ParentEntity
      Case Act.Framework.CustomEntities.ParentEntity.Contacts
        aFields = m_oACTApp.ActFramework.contacts.GetFieldDescriptors()  
      Case Act.Framework.CustomEntities.ParentEntity.Companies
        aFields = m_oACTApp.ActFramework.Companies.GetFieldDescriptors()  
      Case Act.Framework.CustomEntities.ParentEntity.Groups
        aFields = m_oACTApp.ActFramework.Groups.GetFieldDescriptors()  
      Case Act.Framework.CustomEntities.ParentEntity.Opportunities
        aFields = m_oACTApp.ActFramework.Opportunities.GetFieldDescriptors()  
    End Select
    
    For lFieldIndex = 0 To aFields.Length - 1
      If String.Compare(FieldName, aFields(lFieldIndex).DisplayName, True) = 0 Then
        FieldDescriptor = aFields(lFieldIndex)
        Return True
      End If
    Next
    Msgbox(String.Format("Für die Entität '{0}' konnte nicht das Feld '{1}' gefunden werden.", ParentEntity.ToString, FieldName), MsgBoxStyle.Exclamation, m_sScript)
    Return False
  End Function
  
  Private Shared Function TryGetHTMLCodeFromURL(sURL As String, ByRef sHtmlCode As String) As Boolean
    
    TryGetHTMLCodeFromURL = False
    
    Dim oHTTPRequest As System.Net.HttpWebRequest
    Dim oHTTPResponse As System.Net.HttpWebResponse
    Dim oResponseStream As System.IO.Stream
    Dim aPuffer(8191) As Byte
    Dim lCountIndex As Integer
    Dim lCountBytes As Integer
    Dim oEncoder As System.Text.Encoding
    Dim oStringBuilder As System.Text.StringBuilder
    Dim sErrWhileGettingHTMLCode As String = "Es ist ein Fehler beim Ermitteln des HTML-Codes von Seite '{0}' aufgetreten."

    Dim oUri As System.Uri
    Dim oProxy As System.Net.IWebProxy
    Dim oProxyUri As System.Uri
    
    oUri = New System.Uri(sURL)
    ' System Proxy verwenden
    oProxy = System.Net.HttpWebRequest.GetSystemWebProxy()
    ' Ist Proxy bei der URL nötig?
    If Not oProxy.IsBypassed(oUri) Then
      oProxyUri = oProxy.GetProxy(oUri)
      oHTTPRequest = System.Net.WebRequest.Create(oURI)
      oProxy.Credentials = System.Net.CredentialCache.DefaultNetworkCredentials
      oHTTPRequest.Proxy = oProxy
    Else
      oHTTPRequest = CType(System.Net.WebRequest.Create(oUri), System.Net.HttpWebRequest)
    End If
    
    sHTMLCode = String.Empty
    Try
      oHTTPRequest.UserAgent = String.Format("Mozilla/5.0 (compatible; MSIE 9.0; {0}; Trident/5.0", System.Environment.OSVersion)
      oHTTPRequest.Accept = "text/html"
      oHTTPRequest.ContentType = "charset=UTF-8"
    Catch ex As Exception
      Msgbox(String.Format(sErrWhileGettingHTMLCode, sURL) &amp; vbcrlf &amp; ex.Message, MsgBoxStyle.Exclamation, m_sScript)
      GoTo Abbruch
    End Try
    Try
      oHTTPResponse = CType(oHTTPRequest.GetResponse, System.Net.HttpWebResponse)
    Catch ex As Exception
      Msgbox(String.Format(sErrWhileGettingHTMLCode, sURL) &amp; vbcrlf &amp; ex.Message, MsgBoxStyle.Exclamation, m_sScript)
      GoTo Abbruch
    End Try
    oResponseStream = oHTTPResponse.GetResponseStream
    lCountIndex = 0
    If oHTTPResponse.ContentType.ToLower.IndexOf("utf-8") &gt; 0 Then
      oEncoder = System.Text.Encoding.UTF8
    Else
      oEncoder = System.Text.Encoding.UTF7
    End If
    oStringBuilder = New System.Text.StringBuilder
    Try
      Do
        lCountBytes = oResponseStream.Read(aPuffer, 0, aPuffer.Length)
        If lCountIndex = 0 And lCountBytes &gt; 0 Then
          If oEncoder.GetString(aPuffer, 0, lCountBytes).ToLower.IndexOf("utf-8") &gt; 0 Then
            oEncoder = System.Text.Encoding.UTF8
          End If
        End If
        If lCountBytes &gt; 0 Then
          oStringBuilder.Append(oEncoder.GetString(aPuffer, 0, lCountBytes))
          System.Windows.Forms.Application.DoEvents()
        End If
        lCountIndex += 1
      Loop Until lCountBytes = 0
    Catch ex As Exception
      Msgbox(String.Format(sErrWhileGettingHTMLCode, sURL) &amp; vbcrlf &amp; ex.Message, MsgBoxStyle.Exclamation, m_sScript)
    End Try
    sHTMLCode = oStringBuilder.ToString

    TryGetHTMLCodeFromURL = True
    
    Abbruch:
  End Function
  
  
  Sub Dummy ()</SourceCode>
        <IconName>pin_red</IconName>
    </AutoDataMenu>
</ACTOptimumItems>