<?xml version="1.0" encoding="utf-16" standalone="yes"?>
<!--Created: 12.01.2018 14:19:16-->
<!--ACTOptimumVersion: 6.0.6499.18021-->
<ACTOptimumItems ACTOptimumVersion="6.0.6499.18021" Created="19.12.2017 12:32:22">
    <AutoDataMenu Created="19.12.2017 12:32:22" ClassName="Melville_Schellmann.ACTOptimum6.Plugin.MenuItemAutoData" PrefClassVersion="1.0" ACTOptimumVersion="6.0.6499.18021">
        <GlobalPref>True</GlobalPref>
        <NeededRole>2</NeededRole>
        <Name>MarkerMap</Name>
        <Tooltip>Displays the geocoded contacts of the current lookup in Google Maps.</Tooltip>
        <Description>Displays the geocoded contacts of the current lookup in Google Maps.</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: Shows the current contact lookup or contact sekection in a Google map
    ' #Copyright: © 2015-2018 by Melville-Schellmann
    ' #Author: Robert Schellmann, rs@melville-schellmann.de
    ' #Version: 0.97 (02.10.2018) Added new option for Google API Key
    ' #Version: 0.96 (12.01.2018) Using http proxy, if configured
    ' #Version: 0.95 (19.12.2017) Additional new field option to define the color for the markers
    ' #Version: 0.94 (20.09.2017) Removes CR and LF characters in ACT! field values like phone and email
	' #Version: 0.93 (04.11.2015) Extend labels with lower case characters and 2000 Xs. No error while empty phone fields
    ' #Version: 0.91 (14.09.2015) ACT! fields can contain the ' character or a enter/new line character
    ' #Version: 0.9 (31.08.2015) s.o.
    
    Dim sFieldNameLng As String = "User 3" ' Name of the field containing the latidude value of the coordinates
    Dim sFieldNameLat As String = "User 4" ' Name of the field containing the longitude value of the coordinates
    Dim sFieldNameTitle As String = "Company" ' Name of the field that is used for the title of the Google Maps marker
    Dim sFieldNamesDetails As String = "Contact,Phone,E-mail" ' Name of the fields (comma seperated) that is used for the content of the Goolge Maps marker info window
    Dim sFieldNameColor As String = "" ' Name of the field containing the color of the markers
    Dim sDefaultTitle As String = "Dummy" ' Default value that is used when the title field is empty (s.o.)
    Dim sDefaultBackgroundColor As String = "#FFBA6F" ' Default color for the markers, a light orange
    Dim sDefaultBorderColor As String = "DimGrey" ' Default color for the border, a dark grey
    Dim sAPIKey As String = "" ' Google API Key

    ' ----------------------------------------------------------------------------------------------------------------------------
    ' From here please not make any changes 
    ' ----------------------------------------------------------------------------------------------------------------------------
    
    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 = "en"
    
    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("The current lookup must have two records or selected records."), MsgBoxStyle.Information, m_sScript)
      GoTo Abbruch
    End If
    If oEntities.Count &gt; sLabels.Length Then
      MsgBox(String.Format("The maximum number of records is {0}. The current lookup have {1} records or selected records.", _
        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("The field '{1}' of record '{0}' is empty.", sTitle, sFieldNameLng))
      Else
        If Decimal.TryParse(oFieldLng.GetValue(oEntity), dLng) = False Then
          sErrors.AppendLine(String.Format("The record '{0}' contains '{1}' in the field '{2}'. This is not a valid longitude.", 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("The field '{1}' of record '{0}' is empty.", sTitle, sFieldNameLat))
      Else
        If String.IsNullOrEmpty(oFieldLat.GetValue(oEntity)) OrElse Decimal.TryParse(oFieldLat.GetValue(oEntity), dLat) = False Then
          sErrors.AppendLine(String.Format("The record '{0}' contains '{1}' in the field '{2}'. This is not a valid latidude.", 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("The record '{0}' contains '{1}' in the field '{2}'. This is not a valid color.", 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;Show in Act!&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("Some errors occurred while validating the data:" &amp; vbcrlf &amp; sErrors.ToString, MsgBoxStyle.Information, m_sScript)
      If bBadCoordinateErrorOccurred Then
        If MsgBox("To determine correct geographic coordinates for the records, please use the AutoData script 'GeoCode'." &amp; vbcrlf &amp; _
          "Do you want to download the script from the website www.melville-schellmann.de?", 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("Please use color names or values documented on the website www.w3schools.com." &amp; vbcrlf &amp; _
          "Do you want to open this website?", 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("Unable to find the Google API url '{0}' in the HTML page.", 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("Unable to find the field '{1}' in the entity '{0}'.", 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 = "An error occurred while getting the HTML code from the URL '{0}'."

    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>