Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)

Iniciado por Eleкtro, 18 Diciembre 2012, 22:23 PM

0 Miembros y 3 Visitantes están viendo este tema.

Eleкtro

#510
CÓMO OBTENER EL PRECIO DEL BITCOIN EN LA MONEDA QUE QUIERAS

Bueno, pues buscando alguna API gratuita y sin muchas limitaciones, encontré https://bitpay.com/api (de hecho, parece que no tiene ninguna limitación de peticiones por mes, pero no estoy completamente seguro.)

La sintaxis de la consulta es sencilla: "https://bitpay.com/api/rates/BTC/{NOMBRE_DE_MONEDA}" -así que primero creamos la siguiente enumeración con los nombres de monedas aceptados por la API (o en su defecto, un diccionario. como prefieran adaptarlo):

Código (vbnet) [Seleccionar]

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Specifies the ISO-4217 3-character currency codes.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
Public Enum Currencies As Integer

   ''' <summary>
   ''' UAE Dirham
   ''' </summary>
   AED

   ''' <summary>
   ''' Afghan Afghani
   ''' </summary>
   AFN

   ''' <summary>
   ''' Albanian Lek
   ''' </summary>
   ALL

   ''' <summary>
   ''' Armenian Dram
   ''' </summary>
   AMD

   ''' <summary>
   ''' Netherlands Antillean Guilder
   ''' </summary>
   ANG

   ''' <summary>
   ''' Angolan Kwanza
   ''' </summary>
   AOA

   ''' <summary>
   ''' Argentine Peso
   ''' </summary>
   ARS

   ''' <summary>
   ''' Australian Dollar
   ''' </summary>
   AUD

   ''' <summary>
   ''' Aruban Florin
   ''' </summary>
   AWG

   ''' <summary>
   ''' Azerbaijani Manat
   ''' </summary>
   AZN

   ''' <summary>
   ''' Bosnia-Herzegovina Convertible Mark
   ''' </summary>
   BAM

   ''' <summary>
   ''' Barbadian Dollar
   ''' </summary>
   BBD

   ''' <summary>
   ''' Bitcoin Cash
   ''' </summary>
   BCH

   ''' <summary>
   ''' Bangladeshi Taka
   ''' </summary>
   BDT

   ''' <summary>
   ''' Bulgarian Lev
   ''' </summary>
   BGN

   ''' <summary>
   ''' Bahraini Dinar
   ''' </summary>
   BHD

   ''' <summary>
   ''' Burundian Franc
   ''' </summary>
   BIF

   ''' <summary>
   ''' Bermudan Dollar
   ''' </summary>
   BMD

   ''' <summary>
   ''' Brunei Dollar
   ''' </summary>
   BND

   ''' <summary>
   ''' Bolivian Boliviano
   ''' </summary>
   BOB

   ''' <summary>
   ''' Brazilian Real
   ''' </summary>
   BRL

   ''' <summary>
   ''' Bahamian Dollar
   ''' </summary>
   BSD

   ''' <summary>
   ''' Bhutanese Ngultrum
   ''' </summary>
   BTN

   ''' <summary>
   ''' Botswanan Pula
   ''' </summary>
   BWP

   ''' <summary>
   ''' Belize Dollar
   ''' </summary>
   BZD

   ''' <summary>
   ''' Canadian Dollar
   ''' </summary>
   CAD

   ''' <summary>
   ''' Congolese Franc
   ''' </summary>
   CDF

   ''' <summary>
   ''' Swiss Franc
   ''' </summary>
   CHF

   ''' <summary>
   ''' Chilean Unit of Account (UF)
   ''' </summary>
   CLF

   ''' <summary>
   ''' Chilean Peso
   ''' </summary>
   CLP

   ''' <summary>
   ''' Chinese Yuan
   ''' </summary>
   CNY

   ''' <summary>
   ''' Colombian Peso
   ''' </summary>
   COP

   ''' <summary>
   ''' Costa Rican Colón
   ''' </summary>
   CRC

   ''' <summary>
   ''' Cuban Peso
   ''' </summary>
   CUP

   ''' <summary>
   ''' Cape Verdean Escudo
   ''' </summary>
   CVE

   ''' <summary>
   ''' Czech Koruna
   ''' </summary>
   CZK

   ''' <summary>
   ''' Djiboutian Franc
   ''' </summary>
   DJF

   ''' <summary>
   ''' Danish Krone
   ''' </summary>
   DKK

   ''' <summary>
   ''' Dominican Peso
   ''' </summary>
   DOP

   ''' <summary>
   ''' Algerian Dinar
   ''' </summary>
   DZD

   ''' <summary>
   ''' Egyptian Pound
   ''' </summary>
   EGP

   ''' <summary>
   ''' Ethiopian Birr
   ''' </summary>
   ETB

   ''' <summary>
   ''' Eurozone Euro
   ''' </summary>
   EUR

   ''' <summary>
   ''' Fijian Dollar
   ''' </summary>
   FJD

   ''' <summary>
   ''' Falkland Islands Pound
   ''' </summary>
   FKP

   ''' <summary>
   ''' Pound Sterling
   ''' </summary>
   GBP

   ''' <summary>
   ''' Georgian Lari
   ''' </summary>
   GEL

   ''' <summary>
   ''' Ghanaian Cedi
   ''' </summary>
   GHS

   ''' <summary>
   ''' Gibraltar Pound
   ''' </summary>
   GIP

   ''' <summary>
   ''' Gambian Dalasi
   ''' </summary>
   GMD

   ''' <summary>
   ''' Guinean Franc
   ''' </summary>
   GNF

   ''' <summary>
   ''' Guatemalan Quetzal
   ''' </summary>
   GTQ

   ''' <summary>
   ''' Guyanaese Dollar
   ''' </summary>
   GYD

   ''' <summary>
   ''' Hong Kong Dollar
   ''' </summary>
   HKD

   ''' <summary>
   ''' Honduran Lempira
   ''' </summary>
   HNL

   ''' <summary>
   ''' Croatian Kuna
   ''' </summary>
   HRK

   ''' <summary>
   ''' Haitian Gourde
   ''' </summary>
   HTG

   ''' <summary>
   ''' Hungarian Forint
   ''' </summary>
   HUF

   ''' <summary>
   ''' Indonesian Rupiah
   ''' </summary>
   IDR

   ''' <summary>
   ''' Israeli Shekel
   ''' </summary>
   ILS

   ''' <summary>
   ''' Indian Rupee
   ''' </summary>
   INR

   ''' <summary>
   ''' Iraqi Dinar
   ''' </summary>
   IQD

   ''' <summary>
   ''' Iranian Rial
   ''' </summary>
   IRR

   ''' <summary>
   ''' Icelandic Króna
   ''' </summary>
   ISK

   ''' <summary>
   ''' Jersey Pound
   ''' </summary>
   JEP

   ''' <summary>
   ''' Jamaican Dollar
   ''' </summary>
   JMD

   ''' <summary>
   ''' Jordanian Dinar
   ''' </summary>
   JOD

   ''' <summary>
   ''' Japanese Yen
   ''' </summary>
   JPY

   ''' <summary>
   ''' Kenyan Shilling
   ''' </summary>
   KES

   ''' <summary>
   ''' Kyrgystani Som
   ''' </summary>
   KGS

   ''' <summary>
   ''' Cambodian Riel
   ''' </summary>
   KHR

   ''' <summary>
   ''' Comorian Franc
   ''' </summary>
   KMF

   ''' <summary>
   ''' North Korean Won
   ''' </summary>
   KPW

   ''' <summary>
   ''' South Korean Won
   ''' </summary>
   KRW

   ''' <summary>
   ''' Kuwaiti Dinar
   ''' </summary>
   KWD

   ''' <summary>
   ''' Cayman Islands Dollar
   ''' </summary>
   KYD

   ''' <summary>
   ''' Kazakhstani Tenge
   ''' </summary>
   KZT

   ''' <summary>
   ''' Laotian Kip
   ''' </summary>
   LAK

   ''' <summary>
   ''' Lebanese Pound
   ''' </summary>
   LBP

   ''' <summary>
   ''' Sri Lankan Rupee
   ''' </summary>
   LKR

   ''' <summary>
   ''' Liberian Dollar
   ''' </summary>
   LRD

   ''' <summary>
   ''' Lesotho Loti
   ''' </summary>
   LSL

   ''' <summary>
   ''' Libyan Dinar
   ''' </summary>
   LYD

   ''' <summary>
   ''' Moroccan Dirham
   ''' </summary>
   MAD

   ''' <summary>
   ''' Moldovan Leu
   ''' </summary>
   MDL

   ''' <summary>
   ''' Malagasy Ariary
   ''' </summary>
   MGA

   ''' <summary>
   ''' Macedonian Denar
   ''' </summary>
   MKD

   ''' <summary>
   ''' Myanma Kyat
   ''' </summary>
   MMK

   ''' <summary>
   ''' Mongolian Tugrik
   ''' </summary>
   MNT

   ''' <summary>
   ''' Macanese Pataca
   ''' </summary>
   MOP

   ''' <summary>
   ''' Mauritanian Ouguiya
   ''' </summary>
   MRO

   ''' <summary>
   ''' Mauritian Rupee
   ''' </summary>
   MUR

   ''' <summary>
   ''' Maldivian Rufiyaa
   ''' </summary>
   MVR

   ''' <summary>
   ''' Malawian Kwacha
   ''' </summary>
   MWK

   ''' <summary>
   ''' Mexican Peso
   ''' </summary>
   MXN

   ''' <summary>
   ''' Malaysian Ringgit
   ''' </summary>
   MYR

   ''' <summary>
   ''' Mozambican Metical
   ''' </summary>
   MZN

   ''' <summary>
   ''' Namibian Dollar
   ''' </summary>
   NAD

   ''' <summary>
   ''' Nigerian Naira
   ''' </summary>
   NGN

   ''' <summary>
   ''' Nicaraguan Córdoba
   ''' </summary>
   NIO

   ''' <summary>
   ''' Norwegian Krone
   ''' </summary>
   NOK

   ''' <summary>
   ''' Nepalese Rupee
   ''' </summary>
   NPR

   ''' <summary>
   ''' New Zealand Dollar
   ''' </summary>
   NZD

   ''' <summary>
   ''' Omani Rial
   ''' </summary>
   OMR

   ''' <summary>
   ''' Panamanian Balboa
   ''' </summary>
   PAB

   ''' <summary>
   ''' Peruvian Nuevo Sol
   ''' </summary>
   PEN

   ''' <summary>
   ''' Papua New Guinean Kina
   ''' </summary>
   PGK

   ''' <summary>
   ''' Philippine Peso
   ''' </summary>
   PHP

   ''' <summary>
   ''' Pakistani Rupee
   ''' </summary>
   PKR

   ''' <summary>
   ''' Polish Zloty
   ''' </summary>
   PLN

   ''' <summary>
   ''' Paraguayan Guarani
   ''' </summary>
   PYG

   ''' <summary>
   ''' Qatari Rial
   ''' </summary>
   QAR

   ''' <summary>
   ''' Romanian Leu
   ''' </summary>
   RON

   ''' <summary>
   ''' Serbian Dinar
   ''' </summary>
   RSD

   ''' <summary>
   ''' Russian Ruble
   ''' </summary>
   RUB

   ''' <summary>
   ''' Rwandan Franc
   ''' </summary>
   RWF

   ''' <summary>
   ''' Saudi Riyal
   ''' </summary>
   SAR

   ''' <summary>
   ''' Solomon Islands Dollar
   ''' </summary>
   SBD

   ''' <summary>
   ''' Seychellois Rupee
   ''' </summary>
   SCR

   ''' <summary>
   ''' Sudanese Pound
   ''' </summary>
   SDG

   ''' <summary>
   ''' Swedish Krona
   ''' </summary>
   SEK

   ''' <summary>
   ''' Singapore Dollar
   ''' </summary>
   SGD

   ''' <summary>
   ''' Saint Helena Pound
   ''' </summary>
   SHP

   ''' <summary>
   ''' Sierra Leonean Leone
   ''' </summary>
   SLL

   ''' <summary>
   ''' Somali Shilling
   ''' </summary>
   SOS

   ''' <summary>
   ''' Surinamese Dollar
   ''' </summary>
   SRD

   ''' <summary>
   ''' São Tomé and Príncipe Dobra
   ''' </summary>
   STD

   ''' <summary>
   ''' Salvadoran Colón
   ''' </summary>
   SVC

   ''' <summary>
   ''' Syrian Pound
   ''' </summary>
   SYP

   ''' <summary>
   ''' Swazi Lilangeni
   ''' </summary>
   SZL

   ''' <summary>
   ''' Thai Baht
   ''' </summary>
   THB

   ''' <summary>
   ''' Tajikistani Somoni
   ''' </summary>
   TJS

   ''' <summary>
   ''' Turkmenistani Manat
   ''' </summary>
   TMT

   ''' <summary>
   ''' Tunisian Dinar
   ''' </summary>
   TND

   ''' <summary>
   ''' Tongan Paʻanga
   ''' </summary>
   TOP

   ''' <summary>
   ''' Turkish Lira
   ''' </summary>
   [TRY]

   ''' <summary>
   ''' Trinidad and Tobago Dollar
   ''' </summary>
   TTD

   ''' <summary>
   ''' New Taiwan Dollar
   ''' </summary>
   TWD

   ''' <summary>
   ''' Tanzanian Shilling
   ''' </summary>
   TZS

   ''' <summary>
   ''' Ukrainian Hryvnia
   ''' </summary>
   UAH

   ''' <summary>
   ''' Ugandan Shilling
   ''' </summary>
   UGX

   ''' <summary>
   ''' US Dollar
   ''' </summary>
   USD

   ''' <summary>
   ''' Uruguayan Peso
   ''' </summary>
   UYU

   ''' <summary>
   ''' Uzbekistan Som
   ''' </summary>
   UZS

   ''' <summary>
   ''' Venezuelan Bolívar Fuerte
   ''' </summary>
   VEF

   ''' <summary>
   ''' Vietnamese Dong
   ''' </summary>
   VND

   ''' <summary>
   ''' Vanuatu Vatu
   ''' </summary>
   VUV

   ''' <summary>
   ''' Samoan Tala
   ''' </summary>
   WST

   ''' <summary>
   ''' CFA Franc BEAC
   ''' </summary>
   XAF

   ''' <summary>
   ''' Silver (troy ounce)
   ''' </summary>
   XAG

   ''' <summary>
   ''' Gold (troy ounce)
   ''' </summary>
   XAU

   ''' <summary>
   ''' East Caribbean Dollar
   ''' </summary>
   XCD

   ''' <summary>
   ''' CFA Franc BCEAO
   ''' </summary>
   XOF

   ''' <summary>
   ''' CFP Franc
   ''' </summary>
   XPF

   ''' <summary>
   ''' Yemeni Rial
   ''' </summary>
   YER

   ''' <summary>
   ''' South African Rand
   ''' </summary>
   ZAR

   ''' <summary>
   ''' Zambian Kwacha
   ''' </summary>
   ZMW

   ''' <summary>
   ''' Zimbabwean Dollar
   ''' </summary>
   ZWL

End Enum


Y con eso, podemos hacer una función de uso genérico que tome como argumento un valor de la enumeración, usar la API y parsear el documento JSON devuelto para obtener el valor del Bitcoin:

Código (vbnet) [Seleccionar]
Imports System.Globalization
Imports System.IO
Imports System.Net
Imports System.Runtime.Serialization.Json
Imports System.Text
Imports System.Xml


Código (vbnet) [Seleccionar]
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets the price of 1 Bitcoin in the specified currency.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="currency">
''' The currency.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting price.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="HttpListenerException">
''' The returned Bitcoin rate info is empty due to an unknown error.
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Private Shared Function GetBitcoinPrice(ByVal currency As Currencies) As Decimal

   Dim uri As New Uri(String.Format("https://bitpay.com/api/rates/BTC/{0}", currency.ToString()))
   Dim req As WebRequest = WebRequest.Create(uri)

   Using res As WebResponse = req.GetResponse(),
         sr As New StreamReader(res.GetResponseStream()),
         xmlReader As XmlDictionaryReader =
             JsonReaderWriterFactory.CreateJsonReader(sr.BaseStream, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)

       Dim xml As XElement = XElement.Load(xmlReader)
       If (xml.IsEmpty) Then
           Dim errMsg As String = String.Format("The returned Bitcoin rate info is empty due to an unknown error. ""{0}""", uri.ToString())
           Throw New HttpListenerException(HttpStatusCode.NotFound, errMsg)
       End If

       Return Decimal.Parse(xml.<rate>.Value, NumberStyles.Currency, New NumberFormatInfo With {.CurrencyDecimalSeparator = "."})

   End Using

End Function


Modo de empleo:
Código (vbnet) [Seleccionar]
Dim price As Decimal = GetBitcoinPrice(Currencies.USD)
Console.WriteLine(price)


Saludos.








Eleкtro

#511
¿CÓMO OBTENER UNA REFERENCIA A TODOS LOS PROCESOS HIJO DE UN PROCESO?

Código (vbnet) [Seleccionar]
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets the child processes of the source <see cref="Process"/>.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="p">
''' The source <see cref="Process"/>.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="IEnumerable(Of Process)"/> containing the child processes.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Sahred Iterator Function GetChildProcesses(ByVal p As Process) As IEnumerable(Of Process)

   Dim scope As New ManagementScope("root\CIMV2")p.Id))
   Dim options As New EnumerationOptions With {
       .ReturnImmediately = True,
       .Rewindable = False,
       .DirectRead = True,
       .EnumerateDeep = False
   }

   Using mos As New ManagementObjectSearcher(scope, query, options),
         moc As ManagementObjectCollection = mos.Get()

       For Each mo As ManagementObject In moc
           Dim value As Object = mo.Properties("ProcessID").Value()
           If (value IsNot Nothing) Then
               Yield Process.GetProcessById(CInt(value))
           End If
       Next
   End Using

End Function


Modo de empleo:
Código (vbnet) [Seleccionar]
Dim mainProcess As Process = Process.GetProcessesByName("explorer").Single()
Dim childProcesses As IEnumerable(Of Process) = GetChildProcesses(mainProcess)

For Each p As Process In childProcesses
   Console.WriteLine(p.ProcessName)
Next


Saludos.








Eleкtro

#512
CÓMO OBTENER EL PRECIO DEL BITCOIN DE UNA CANTIDAD DE CUALQUIER CRIPTOMONEDA EN LA MONEDA QUE QUIERAS

Con el fin de ahorrar la escritura de código, reutilizaremos la enumeración que ya publiqué en este otro post:


( deben copiar y pegar la enumeración "Currencies" junto al código que mostraré a continuación para que funcione. )

En esta ocasión, la API que utilizaremos será: https://coinmarketcap.com/api/, la cual soporta muchas criptomonedas, aunque no muchas divisas.

Primero definiremos una interfáz con nombre ICryptoCurrency, que nos servirá para representar criptomonedas (Bitcoin, Ethereum, Litecoin, etcétera) y sus funcionalidades.

Código (vbnet) [Seleccionar]
Public Interface ICryptoCurrency

   ''' <summary>
   ''' Gets the canonical name of this <see cref="ICryptoCurrency"/>.
   ''' </summary>
   ReadOnly Property Name As String

   ''' <summary>
   ''' Gets the symbol of this <see cref="ICryptoCurrency"/>.
   ''' </summary>
   ReadOnly Property Symbol As String

   ''' <summary>
   ''' Gets the price equivalency for 1 amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
   ''' </summary>
   Function GetPrice(ByVal currency As Currencies) As Double

   ''' <summary>
   ''' Gets the price equivalency for the specified amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
   ''' </summary>
   Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double

   ''' <summary>
   ''' Asunchronously gets the price equivalency for 1 amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
   ''' </summary>
   Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double)

   ''' <summary>
   ''' Asynchronously gets the price equivalency for the specified amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
   ''' </summary>
   Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double)

End Interface


Seguidamente implementamos las criptomodas que queramos, en este caso el Bitcoin y Ethereum:

( para implementar más criptomonedas solo tienen que copiar y pegar la clase del Bitcoin o del Ethereum, modificar el nombre y el símbolo para la nueva criptomoneda, y lo demás dejarlo todo exactamente igual... )

Código (vbnet) [Seleccionar]
''' <summary>
''' Represents the Bitcoin (symbol: BTC) cryptocurrency.
''' </summary>
Public Class Bitcoin : Implements ICryptoCurrency

   Public Sub New()
   End Sub

   Public ReadOnly Property Name As String = "Bitcoin" Implements ICryptoCurrency.Name

   Public ReadOnly Property Symbol As String = "BTC" Implements ICryptoCurrency.Symbol

   ''' <summary>
   ''' Gets the price for 1 Bitcoins converted to the specified currency.
   ''' </summary>
   Public Overridable Function GetPrice(ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
       Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, 1, currency)
   End Function

   ''' <summary>
   ''' Gets the price for the specified amount of Bitcoins converted to the specified currency.
   ''' </summary>
   Public Overridable Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
       Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, amount, currency)
   End Function

   ''' <summary>
   ''' Asynchronously gets the price for 1 Bitcoins converted to the specified currency.
   ''' </summary>
   Public Overridable Async Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
       Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, 1, currency)
   End Function

   ''' <summary>
   ''' Asynchronously gets the price for the specified amount of Bitcoins converted to the specified currency.
   ''' </summary>
   Public Overridable Async Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
       Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, amount, currency)
   End Function

End Class


Código (vbnet) [Seleccionar]

''' <summary>
''' Represents the Ethereum (symbol: ETH) cryptocurrency.
''' </summary>
Public Class Ethereum : Implements ICryptoCurrency

   Public Sub New()
   End Sub

   Public ReadOnly Property Name As String = "Ethereum" Implements ICryptoCurrency.Name

   Public ReadOnly Property Symbol As String = "ETH" Implements ICryptoCurrency.Symbol

   ''' <summary>
   ''' Gets the price for 1 Ethereums converted to the specified currency.
   ''' </summary>
   Public Overridable Function GetPrice(ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
       Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, 1, currency)
   End Function

   ''' <summary>
   ''' Gets the price for the specified amount of Ethereums converted to the specified currency.
   ''' </summary>
   Public Overridable Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
       Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, amount, currency)
   End Function

   ''' <summary>
   ''' Asynchronously gets the price for 1 Ethereums converted to the specified currency.
   ''' </summary>
   Public Overridable Async Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
       Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, 1, currency)
   End Function

   ''' <summary>
   ''' Asynchronously gets the price for the specified amount of Ethereums converted to the specified currency.
   ''' </summary>
   Public Overridable Async Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
       Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, amount, currency)
   End Function

End Class


Por último, creamos una clase con nombre CryptoCurrencyUtil en la que declararemos las funciones GetCryptoCurrencyPrice y GetCryptoCurrencyPriceAsync:

Código (vbnet) [Seleccionar]
Public NotInheritable Class CryptoCurrencyUtil

   Private Sub New()
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the price of the specified cryptocurrency converted to the target currency.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="cryptoCurrency">
   ''' The source <see cref="ICryptoCurrency"/>.
   ''' </param>
   '''
   ''' <param name="amount">
   ''' The amount value of the source cryptocurrency.
   ''' </param>
   '''
   ''' <param name="currency">
   ''' The target currency.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting price.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="NotImplementedException">
   ''' The specified currency is not supported by this API.
   ''' </exception>
   '''
   ''' <exception cref="HttpListenerException">
   ''' The requested cryptocurrency rate info is empty due to an unknown error.
   ''' </exception>
   '''
   ''' <exception cref="FormatException">
   ''' Element name '{0}' not found. Unknown error reason.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Shared Function GetCryptoCurrencyPrice(ByVal cryptoCurrency As ICryptoCurrency, ByVal amount As Double, ByVal currency As Currencies) As Double

       Dim t As New Task(Of Double)(
           Function() As Double
               Return CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(cryptoCurrency, amount, currency).Result
           End Function)

       t.Start()
       t.Wait()

       Return t.Result

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Asynchronously gets the price of the specified cryptocurrency converted to the target currency.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="cryptoCurrency">
   ''' The source <see cref="ICryptoCurrency"/>.
   ''' </param>
   '''
   ''' <param name="amount">
   ''' The amount value of the source cryptocurrency.
   ''' </param>
   '''
   ''' <param name="currency">
   ''' The target currency.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting price.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="NotImplementedException">
   ''' The specified currency is not supported by this API.
   ''' </exception>
   '''
   ''' <exception cref="HttpListenerException">
   ''' The requested cryptocurrency rate info is empty due to an unknown error.
   ''' </exception>
   '''
   ''' <exception cref="FormatException">
   ''' Element name '{0}' not found. Unknown error reason.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Shared Async Function GetCryptoCurrencyPriceAsync(ByVal cryptoCurrency As ICryptoCurrency, ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double)

       Dim validCurrencies As String() =
       {
           "AUD", "BRL", "CAD", "CHF", "CLP", "CNY", "CZK", "DKK",
           "EUR", "GBP", "HKD", "HUF", "IDR", "ILS", "INR", "JPY",
           "KRW", "MXN", "MYR", "NOK", "NZD", "PHP", "PKR", "PLN",
           "RUB", "SEK", "SGD", "THB", "TRY", "TWD", "USD", "ZAR"
       }

       If Not validCurrencies.Contains(currency.ToString().ToUpper()) Then
           Throw New NotImplementedException("The specified currency is not supported by this API.",
                                             New ArgumentException("", paramName:="currency"))
       End If

       Dim uri As New Uri(String.Format("https://api.coinmarketcap.com/v1/ticker/{0}/?convert={1}",
                                        cryptoCurrency.Name, currency.ToString()))

       Dim req As WebRequest = WebRequest.Create(uri)
       Using res As WebResponse = Await req.GetResponseAsync(),
                 SR As New StreamReader(res.GetResponseStream()),
                 XmlReader As XmlDictionaryReader =
                     JsonReaderWriterFactory.CreateJsonReader(SR.BaseStream, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)

           Dim xml As XElement = XElement.Load(XmlReader)
           If (xml.IsEmpty) Then
               Dim errMsg As String = String.Format("The requested cryptocurrency rate info is empty due to an unknown error. ""{0}""", uri.ToString())
               Throw New HttpListenerException(HttpStatusCode.NotFound, errMsg)
           End If

           Dim elementName As String = String.Format("price_{0}", currency.ToString().ToLower())
           Dim element As XElement = xml.Element("item").Element(elementName)
           If (element Is Nothing) Then
               Throw New FormatException(String.Format("Element name '{0}' not found. Unknown error reason.", elementName))
           End If

           Dim price As Double = Double.Parse(element.Value, NumberStyles.Currency, New NumberFormatInfo With {.CurrencyDecimalSeparator = "."})
           Select Case amount
               Case Is = 1
                   Return price
               Case Is < 1
                   Return (price / (1 / amount))
               Case Else ' > 1
                   Return (price * amount)
           End Select

       End Using

   End Function

End Class


LISTO.

Modo de empleo para obtener la equivalencia de 1 bitcoins a dólares:
Código (vbnet) [Seleccionar]
Dim btc As New Bitcoin()
Dim price As Double = btc.GetPrice(Currencies.USD)
Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))


O tambien:
Código (vbnet) [Seleccionar]
Dim cryptoCurrency As ICryptoCurrency = New Bitcoin()
Dim price As Double = CryptoCurrencyUtil.GetCryptoCurrencyPrice(cryptoCurrency, 1, Currencies.USD)
Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))


Modo de empleo para obtener la equivalencia de 5.86 ethereums a dólares:
Código (vbnet) [Seleccionar]
Dim eth As New Ethereum()
Dim price As Double = eth.GetPrice(5.86, Currencies.USD)
Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))


O tambien:
Código (vbnet) [Seleccionar]
Dim cryptoCurrency As ICryptoCurrency = New Ethereum()
Dim price As Double = CryptoCurrencyUtil.GetCryptoCurrencyPrice(cryptoCurrency, 5.86, Currencies.USD)
Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))






EDITO:
Se me olvidaba comentar... que por supuesto el nombre de la criptomoneda debe ser soportado por la API en cuestión... o mejor dicho el identificador, el campo "id" (no el campo "name"), así que quizás quieran adaptar las representaciones de criptomonedas para añadirle una propiedad con nombre "id" para ese propósito...

Aquí pueden ver todos los campos que devuelve el documento JSON:

Nótese que en el caso de Bitcoin y Ethereum el nombre es igual que el identificador para la API, por eso lo he simplificado y no he implimentado el campo "Id", pero no todos los nombres son iguales que los identificadores, véase un ejemplo:
Cita de: https://api.coinmarketcap.com/v1/ticker/...
id   "bitcoin-cash"
name   "Bitcoin Cash"
...

Saludos.








Eleкtro

#513
Como obtener el uso de porcentaje de CPU de un proceso

Código (vbnet) [Seleccionar]

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the CPU percentage usage for the specified <see cref="Process"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting CPU percentage usage for the specified <see cref="Process"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Shared Function GetProcessCPUPercentUsage(ByVal p As Process) As Double

       Using perf As New PerformanceCounter("Process", "% Processor Time", p.ProcessName, True)
           perf.NextValue()
           Thread.Sleep(TimeSpan.FromMilliseconds(250)) ' Recommended value: 1 second
           Return (Math.Round(perf.NextValue() / Environment.ProcessorCount, 1))
       End Using

   End Function


primero hay que activar el uso de los contadores de rendimiento en el archivo de manifiesto de nuestra aplicación:
Código (xml,5,6,7,8,9) [Seleccionar]
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
...

 <system.net>
   <settings>
     <performanceCounters enabled="true"/>
   </settings>
 </system.net>

...
</configuration>


Modo de empleo:
Código (vbnet) [Seleccionar]
Do While True

   Using p As Process = Process.GetProcessesByName("NOMBRE DEL PROCESO").SingleOrDefault()
       Dim str As String =
           String.Format("Process Name: {0}; CPU Usage: {1}%",
                         p.ProcessName, GetProcessCPUPercentUsage(p))

       Console.WriteLine(str)
   End Using

Loop









Eleкtro

#514
¿Cómo hacer WordWrapping a un String?.

Teniendo un string, y una longitud máxima en pixels, esta función/extensión de método nos servirá para hacerle wordwrap a dicho string, y así ajustar las palabrás al límite de longitud especificado.

Código (vbnet) [Seleccionar]
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Wraps words of the source <see cref="String"/> to the
''' beginning of the next line when necessary to fit the specified pixel width.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Credits to @undejavue solution: <see href="https://stackoverflow.com/a/36803501/1248295"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source <see cref="String"/>.
''' </param>
'''
''' <param name="maxWidth">
''' The maximum width, in pixels.
''' </param>
'''
''' <param name="font">
''' The text font.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting string.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
<Extension>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Function WordWrap(ByVal sender As String, ByVal maxWidth As Integer, ByVal font As Font) As String

   Dim sourceLines() As String = sender.Split({" "c}, StringSplitOptions.None)
   Dim wrappedString As New Global.System.Text.StringBuilder()
   Dim actualLine As New Global.System.Text.StringBuilder()
   Dim actualWidth As Double = 0

   For Each line As String In sourceLines
       Dim lineWidth As Integer = TextRenderer.MeasureText(line & " ", font).Width
       actualWidth += lineWidth

       If (actualWidth > maxWidth) Then
           wrappedString.AppendLine(actualLine.ToString())
           actualLine.Clear()
           actualWidth = lineWidth
       End If

       actualLine.Append(line & " ")
   Next line

   If (actualLine.Length > 0) Then
       wrappedString.AppendLine(actualLine.ToString())
   End If

   Return wrappedString.ToString()

End Function


Ejemplo de uso:

Código (vbnet) [Seleccionar]
Dim tb As New TextBox With {
       .Multiline = True,
       .ScrollBars = ScrollBars.Both,
       .WordWrap = False,
       .Size = New Drawing.Size(width:=250, height:=200)
   }

Dim text As String = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
Dim wordWrappedText As String = text.WordWrap(tb.Width, tb.Font)

Me.Controls.Add(tb)
tb.Text = wordWrappedText

Console.WriteLine(wordWrappedText)











Eleкtro

#515
¿Cómo implementar funcionalidades de pausado y reanudado en un BackgroundWorker, y funcionalidades de iniciar y cancelar síncronas?.

Les presento el componente 'ElektroBackgroundWorker', es un BackgroundWorker extendido al que le añadí las funcionalidades ya mencionadas. Su modo de empleo es practicamente idéntico que un BackgroundWorker, tan solo mencionar que el equivalente al método 'BackgroundWorker.RunWorkerAsync()' es 'ElektroBackgroundWorker.RunAsync()'.

Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 02-February-2018
' ***********************************************************************

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

' Imports ElektroKit.Core.Threading.Enums

Imports System.ComponentModel
Imports System.Drawing
Imports System.Threading

#End Region

#Region " ElektroBackgroundWorker "

' Namespace Threading.Types

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' A extended <see cref="BackgroundWorker"/> component
   ''' with synchronous (blocking) run/cancellation support,
   ''' and asynchronous pause/resume features.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Friend WithEvents Worker As ElektroBackgroundWorker
   '''
   ''' Private Sub Button_Run_Click() Handles Button_Run.Click
   '''
   '''     If (Me.Worker IsNot Nothing) Then
   '''
   '''         Select Case Me.Worker.State
   '''             Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
   '''                 Me.Worker.Cancel()
   '''             Case Else
   '''                 ' Do Nothing.
   '''         End Select
   '''
   '''     End If
   '''
   '''     Me.Worker = New ElektroBackgroundWorker
   '''     Me.Worker.RunAsync()
   '''
   ''' End Sub
   '''
   ''' Private Sub Button_Pause_Click() Handles Button_Pause.Click
   '''     Me.Worker.RequestPause()
   ''' End Sub
   '''
   ''' Private Sub Button_Resume_Click() Handles Button_Resume.Click
   '''     Me.Worker.Resume()
   ''' End Sub
   '''
   ''' Private Sub Button_Cancel_Click() Handles Button_Cancel.Click
   '''     Me.Worker.Cancel()
   ''' End Sub
   '''
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;summary&gt;
   ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.DoWork"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
   ''' ''' &lt;/summary&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;param name="sender"&gt;
   ''' ''' The source of the event.
   ''' ''' &lt;/param&gt;
   ''' '''
   ''' ''' &lt;param name="e"&gt;
   ''' ''' The &lt;see cref="DoWorkEventArgs"/&gt; instance containing the event data.
   ''' ''' &lt;/param&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' &lt;DebuggerStepperBoundary&gt;
   ''' Private Sub Worker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) _
   ''' Handles Worker.DoWork
   '''
   '''     Dim progress As Integer
   '''
   '''     Dim lock As Object = ""
   '''     SyncLock lock
   '''
   '''         For i As Integer = 0 To 100
   '''             If (Me.Worker.CancellationPending) Then ' Cancel the background operation.
   '''                 e.Cancel = True
   '''                 Exit For
   '''
   '''             Else
   '''                 If (Me.Worker.PausePending) Then ' Pause the background operation.
   '''                     Me.Worker.Pause() ' Blocking pause call.
   '''                 End If
   '''
   '''                 Me.DoSomething()
   '''
   '''                 If Me.Worker.WorkerReportsProgress Then
   '''                     progress = i
   '''                     Me.Worker.ReportProgress(progress)
   '''                 End If
   '''
   '''             End If
   '''
   '''         Next i
   '''
   '''     End SyncLock
   '''
   '''     If (Me.Worker.WorkerReportsProgress) AndAlso Not (Me.Worker.CancellationPending) AndAlso (progress &lt; 100) Then
   '''         Me.Worker.ReportProgress(percentProgress:=100)
   '''     End If
   '''
   ''' End Sub
   '''
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;summary&gt;
   ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.ProgressChanged"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
   ''' ''' &lt;/summary&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;param name="sender"&gt;
   ''' ''' The source of the event.
   ''' ''' &lt;/param&gt;
   ''' '''
   ''' ''' &lt;param name="e"&gt;
   ''' ''' The &lt;see cref="ProgressChangedEventArgs"/&gt; instance containing the event data.
   ''' ''' &lt;/param&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' &lt;DebuggerStepperBoundary&gt;
   ''' Private Sub Worker_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) _
   ''' Handles Worker.ProgressChanged
   '''
   '''     Console.WriteLine(String.Format("Background Work Progress: {00}%", e.ProgressPercentage))
   '''
   ''' End Sub
   '''
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;summary&gt;
   ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.RunWorkerCompleted"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
   ''' ''' &lt;/summary&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' ''' &lt;param name="sender"&gt;
   ''' ''' The source of the event.
   ''' ''' &lt;/param&gt;
   ''' '''
   ''' ''' &lt;param name="e"&gt;
   ''' ''' The &lt;see cref="RunWorkerCompletedEventArgs"/&gt; instance containing the event data.
   ''' ''' &lt;/param&gt;
   ''' ''' ----------------------------------------------------------------------------------------------------
   ''' &lt;DebuggerStepperBoundary&gt;
   ''' Private Sub Worker_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) _
   ''' Handles Worker.RunWorkerCompleted
   '''
   '''     If (e.Cancelled) Then
   '''         Debug.WriteLine("Background work cancelled.")
   '''
   '''     ElseIf (e.Error IsNot Nothing) Then
   '''         Debug.WriteLine("Background work error.")
   '''
   '''     Else
   '''         Debug.WriteLine("Background work done.")
   '''
   '''     End If
   '''
   '''     Console.WriteLine(String.Format("State: {0}", Me.Worker.State.ToString()))
   '''
   ''' End Sub
   '''
   ''' &lt;DebuggerStepperBoundary&gt;
   ''' Private Sub DoSomething()
   '''     Thread.Sleep(TimeSpan.FromSeconds(1))
   ''' End Sub
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <seealso cref="BackgroundWorker" />
   ''' ----------------------------------------------------------------------------------------------------
   <DisplayName("ElektroBackgroundWorker")>
   <Description("A extended BackgroundWorker component, with synchronous (blocking) run/cancellation support, and asynchronous pause/resume features.")>
   <DesignTimeVisible(True)>
   <DesignerCategory("Component")>
   <ToolboxBitmap(GetType(Component), "Component.bmp")>
   <ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Require)>
   <DefaultEvent("DoWork")>
   Public Class ElektroBackgroundWorker : Inherits BackgroundWorker

#Region " Private Fields "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' A <see cref="ManualResetEvent"/> that serves to handle synchronous operations (Run, Cancel, Pause, Resume).
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Protected ReadOnly mreSync As ManualResetEvent

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' A <see cref="ManualResetEvent"/> that serves to handle asynchronous operations (RunAsync, CancelAsync, RequestPause).
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Protected ReadOnly mreAsync As ManualResetEvent

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Indicates whether the <see cref="BackGroundworker"/> has been initiated in synchronous mode.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Protected isRunSync As Boolean

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Indicates whether a synchronous cancellation operation is requested.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Protected isCancelSyncRequested As Boolean

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Indicates whether a (asynchronous) pause operation is requested.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Protected isPauseRequested As Boolean

#End Region

#Region " Properties "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value indicating whether the <see cref="ElektroBackgroundWorker"/> can report progress updates.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' <see langword="True"/> if can report progress updates; otherwise, <see langword="False"/>.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(False)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <Description("A value indicating whether the ElektroBackgroundWorker can report progress updates.")>
       Public Overloads ReadOnly Property WorkerReportsProgress As Boolean
           Get
               Return MyBase.WorkerReportsProgress
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value indicating whether the <see cref="ElektroBackgroundWorker"/> supports asynchronous cancellation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' <see langword="True"/> if supports asynchronous cancellation; otherwise, <see langword="False"/>.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(False)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <Description("A value indicating whether the ElektroBackgroundWorker supports asynchronous cancellation.")>
       Public Overloads ReadOnly Property WorkerSupportsCancellation As Boolean
           Get
               Return MyBase.WorkerSupportsCancellation
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the current state of a pending background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The current state of a pending background operation.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(False)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <Description("The current state of a pending background operation.")>
       Public ReadOnly Property State As ElektroBackgroundWorkerState
           <DebuggerStepThrough>
           Get
               Return Me.stateB
           End Get
       End Property
       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' ( Backing Field )
       ''' The current state of a pending background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Private stateB As ElektroBackgroundWorkerState = ElektroBackgroundWorkerState.Stopped

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value indicating whether the application has requested pause of a background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' <see langword="True"/> if the application has requested pause of a background operation;
       ''' otherwise, false.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(False)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <Description("A value indicating whether the application has requested pause of a background operation.")>
       Public ReadOnly Property PausePending As Boolean
           Get
               Return Me.isPauseRequested
           End Get
       End Property

#End Region

#Region " Constructors "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="ElektroBackgroundWorker"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerNonUserCode>
       Public Sub New()
           Me.mreSync = New ManualResetEvent(initialState:=False)
           Me.mreAsync = New ManualResetEvent(initialState:=True)
       End Sub

#End Region

#Region " Public Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Starts execution of a background operation.
       ''' <para></para>
       ''' It blocks the caller thread until the background work is done.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to run the BackgroundWorker, the background operation must be stopped or completed.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub Run()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.Stopped, ElektroBackgroundWorkerState.Completed
                       Me.isRunSync = True
                       MyBase.WorkerReportsProgress = False
                       MyBase.WorkerSupportsCancellation = False
                       MyBase.RunWorkerAsync()
                       Me.stateB = ElektroBackgroundWorkerState.Running
                       Me.mreSync.WaitOne()

                   Case Else
                       Throw New InvalidOperationException("In order to run the BackgroundWorker, the background operation must be stopped or completed.")

               End Select

           End If

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Asynchronously starts execution of a background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to run the BackgroundWorker, the background operation must be stopped or completed.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub RunAsync()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.Stopped, ElektroBackgroundWorkerState.Completed
                       MyBase.WorkerReportsProgress = True
                       MyBase.WorkerSupportsCancellation = True
                       MyBase.RunWorkerAsync()
                       Me.stateB = ElektroBackgroundWorkerState.Running

                   Case Else
                       Throw New InvalidOperationException("In order to run the BackgroundWorker, the background operation must be stopped or completed.")

               End Select

           End If

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Pause a pending background operation.
       ''' <para></para>
       ''' It blocks the caller thread until the background work is resumed.
       ''' To resume the background work, call the <see cref="ElektroBackgroundWorker.Resume"/> method.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to pause the BackgroundWorker, firstly a pause request should be made.
       ''' </exception>
       '''
       ''' <exception cref="InvalidOperationException">
       ''' In order to pause the BackgroundWorker, the background operation must be be running.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub Pause()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.Running
                       If (Me.PausePending) Then
                           Me.mreAsync.WaitOne(Timeout.Infinite)
                       Else
                           Throw New InvalidOperationException("In order to pause the BackgroundWorker, firstly a pause request should be made.")
                       End If

                   Case Else
                       Throw New InvalidOperationException("In order to pause the BackgroundWorker, the background operation must be running.")

               End Select

           End If

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Asynchronously requests to pause a pending background operation.
       ''' <para></para>
       ''' To pause the background work after requesting a pause,
       ''' call the <see cref="ElektroBackgroundWorker.Pause"/> method.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to request a pause of the BackgroundWorker, the background operation must be running.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub RequestPause()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.Running
                       Me.isPauseRequested = True
                       Me.stateB = ElektroBackgroundWorkerState.Paused
                       Me.mreAsync.Reset()

                   Case Else
                       Throw New InvalidOperationException("In order to request a pause of the BackgroundWorker, the background operation must be running..")

               End Select

           End If

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Resume a pending paused background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to resume the BackgroundWorker, the background operation must be paused.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub [Resume]()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.Paused
                       Me.stateB = ElektroBackgroundWorkerState.Running
                       Me.isPauseRequested = False
                       Me.mreAsync.Set()

                   Case Else
                       Throw New InvalidOperationException("In order to resume the BackgroundWorker, the background operation must be paused.")

               End Select

           End If

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Requests cancellation of a pending background operation.
       ''' <para></para>
       ''' It blocks the caller thread until the remaining background work is canceled.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to cancel the BackgroundWorker, the background operation must be running or paused.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Sub Cancel()

           Me.isCancelSyncRequested = True
           Me.CancelAsync()
           Me.mreSync.WaitOne()
           Me.isCancelSyncRequested = False

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Asynchronously requests cancellation of a pending background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="InvalidOperationException">
       ''' In order to cancel the BackgroundWorker, the background operation must be running or paused.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Overloads Sub CancelAsync()

           If (Me Is Nothing) Then
               Throw New ObjectDisposedException(objectName:="Me")

           Else
               Select Case Me.stateB

                   Case ElektroBackgroundWorkerState.CancellationPending
                       Exit Sub

                   Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
                       Me.mreAsync.Set() ' Resume thread if it is paused.
                       Me.stateB = ElektroBackgroundWorkerState.CancellationPending
                       MyBase.CancelAsync() ' Cancel it.

                   Case Else
                       Throw New InvalidOperationException("In order to cancel the BackgroundWorker, the background operation must be running or paused.")

               End Select

           End If

       End Sub

#End Region

#Region " Event Invocators "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Raises the <see cref="BackgroundWorker.DoWork"/> event.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="e">
       ''' An <see cref="EventArgs"/> that contains the event data.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       Protected Overrides Sub OnDoWork(e As DoWorkEventArgs)
           MyBase.OnDoWork(e)

           If (Me.isRunSync) OrElse (Me.isCancelSyncRequested) Then
               Me.mreSync.Set()
           End If
       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Raises the <see cref="BackgroundWorker.ProgressChanged"/> event.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="e">
       ''' An <see cref="ProgressChangedEventArgs"/> that contains the event data.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       Protected Overrides Sub OnProgressChanged(e As ProgressChangedEventArgs)
           MyBase.OnProgressChanged(e)
       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Raises the <see cref="BackgroundWorker.RunWorkerCompleted"/> event.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="e">
       ''' An <see cref="RunWorkerCompletedEventArgs"/> that contains the event data.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       Protected Overrides Sub OnRunWorkerCompleted(e As RunWorkerCompletedEventArgs)
           Me.stateB = ElektroBackgroundWorkerState.Completed
           MyBase.OnRunWorkerCompleted(e)
       End Sub

#End Region

#Region " Hidden Base Members "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Starts execution of a background operation.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       <EditorBrowsable(EditorBrowsableState.Never)>
       <DebuggerStepThrough>
       Public Overridable Shadows Sub RunWorkerAsync()
           MyBase.RunWorkerAsync()
       End Sub

#End Region

#Region " IDisposable Implementation "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
       ''' <para></para>
       ''' Releases unmanaged and, optionally, managed resources.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="isDisposing">
       ''' <see langword="True"/> to release both managed and unmanaged resources;
       ''' <see langword="False"/> to release only unmanaged resources.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Protected Overrides Sub Dispose(isDisposing As Boolean)
           MyBase.Dispose(isDisposing)

           If (isDisposing) Then
               Me.mreSync.SafeWaitHandle.Close()
               Me.mreSync.SafeWaitHandle.Dispose()
               Me.mreSync.Close()
               Me.mreSync.Dispose()

               Me.mreAsync.SafeWaitHandle.Close()
               Me.mreAsync.SafeWaitHandle.Dispose()
               Me.mreAsync.Close()
               Me.mreAsync.Dispose()

               Me.isRunSync = False
               Me.stateB = ElektroBackgroundWorkerState.Stopped
           End If

       End Sub

#End Region

   End Class

' End Namespace

#End Region


+

Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 02-February-2018
' ***********************************************************************

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

' Imports ElektroKit.Core.Threading.Types

#End Region

#Region " ElektroBackgroundWorker State "

' Namespace Threading.Enums

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Specifies the state of a <see cref="ElektroBackgroundWorker"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Public Enum ElektroBackgroundWorkerState As Integer

       ''' <summary>
       ''' The <see cref="ElektroBackgroundWorker"/> is stopped.
       ''' </summary>
       Stopped = 0

       ''' <summary>
       ''' The <see cref="ElektroBackgroundWorker"/> is running.
       ''' </summary>
       Running = 1

       ''' <summary>
       ''' The <see cref="ElektroBackgroundWorker"/> is paused.
       ''' </summary>
       Paused = 2

       ''' <summary>
       ''' The <see cref="ElektroBackgroundWorker"/> is pending on a cancellation.
       ''' </summary>
       CancellationPending = 3

       ''' <summary>
       ''' The <see cref="ElektroBackgroundWorker"/> is completed (stopped).
       ''' </summary>
       Completed = 4

   End Enum

' End Namespace

#End Region


Ejemplo de uso:

Código (vbnet) [Seleccionar]
Friend WithEvents Worker As ElektroBackgroundWorker

Private Sub Button_Run_Click() Handles Button_Run.Click

   If (Me.Worker IsNot Nothing) Then

       Select Case Me.Worker.State
           Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
               Me.Worker.Cancel()
           Case Else
               ' Do Nothing.
       End Select

   End If

   Me.Worker = New ElektroBackgroundWorker
   Me.Worker.RunAsync()

End Sub

Private Sub Button_Pause_Click() Handles Button_Pause.Click
   Me.Worker.RequestPause()
End Sub

Private Sub Button_Resume_Click() Handles Button_Resume.Click
   Me.Worker.Resume()
End Sub

Private Sub Button_Cancel_Click() Handles Button_Cancel.Click
   Me.Worker.Cancel()
End Sub

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Handles the <see cref="ElektroBackgroundWorker.DoWork"/> event of the <see cref="Worker"/> instance.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="DoWorkEventArgs"/> instance containing the event data.
''' </param>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Private Sub Worker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) _
Handles Worker.DoWork

   Dim progress As Integer

   Dim lock As Object = ""
   SyncLock lock

       For i As Integer = 0 To 100
           If (Me.Worker.CancellationPending) Then ' Cancel the background operation.
               e.Cancel = True
               Exit For

           Else
               If (Me.Worker.PausePending) Then ' Pause the background operation.
                   Me.Worker.Pause() ' Blocking pause call.
               End If

               Me.DoSomething()

               If Me.Worker.WorkerReportsProgress Then
                   progress = i
                   Me.Worker.ReportProgress(progress)
               End If

           End If

       Next i

   End SyncLock

   If (Me.Worker.WorkerReportsProgress) AndAlso Not (Me.Worker.CancellationPending) AndAlso (progress < 100) Then
       Me.Worker.ReportProgress(percentProgress:=100)
   End If

End Sub

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Handles the <see cref="ElektroBackgroundWorker.ProgressChanged"/> event of the <see cref="Worker"/> instance.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="ProgressChangedEventArgs"/> instance containing the event data.
''' </param>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Private Sub Worker_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) _
Handles Worker.ProgressChanged

   Console.WriteLine(String.Format("Background Work Progress: {00}%", e.ProgressPercentage))

End Sub

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Handles the <see cref="ElektroBackgroundWorker.RunWorkerCompleted"/> event of the <see cref="Worker"/> instance.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="RunWorkerCompletedEventArgs"/> instance containing the event data.
''' </param>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Private Sub Worker_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) _
Handles Worker.RunWorkerCompleted

   If (e.Cancelled) Then
       Debug.WriteLine("Background work cancelled.")

   ElseIf (e.Error IsNot Nothing) Then
       Debug.WriteLine("Background work error.")

   Else
       Debug.WriteLine("Background work done.")

   End If

   Console.WriteLine(String.Format("State: {0}", Me.Worker.State.ToString()))

End Sub

<DebuggerStepperBoundary>
Private Sub DoSomething()
   Thread.Sleep(TimeSpan.FromSeconds(1))
End Sub








Eleкtro

#516
¿Cómo crear y administrar una cuenta de correo deshechable/temporal?.

El siguiente código que voy a mostrar sirve para crear una cuenta de correo temporal usando el servicio https://10minutemail.com/, leer e-mails entrantes, y responderlos.

Hasta donde han llegado mis análisis y experimentos todo parece indicar que funciona como es esperado. Si encuentran algún problema háganmelo saber para corregir el código.

LO BUENO:

  • Renovación automática del tiempo de vida de la dirección deshechable. Dicho de otro modo: la dirección de correo NO expira... hasta que se libere la instancia de clase.
  • Implementación thread-safe.
  • Implementación orientada a eventos.
  • Funcionalidad para obtener y leer los correos entrantes.
  • Funcionalidad para responder a correos entrantes usando la dirección de correo deshechable.
  • Simple, abstracto, es muy sencillo de usar.

LO MALO:

  • No añadí soporte para leer archivos adjuntos en los mails recibidos.
  • No añadí soporte para responder a un destinatario de un mail recibido.
  • 10minutemail.com es un servicio gratuito y por ende también limitado, solo permite crear alrededor de 3-5 direccioens e-mail por minuto y por IP.
    Sin embargo, probablemente esta limitación se podría bypassear usando proxies.




1.

Primero de todo he creado una interfaz con nombre IDisposableMail, la cual podremos rehutilizar en el futuro para representar cualquier otro servicio de correo temporal similar a https://10minutemail.com/. Evidentemente pueden extender la interfaz si lo desean.

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.Net.Mail

#End Region

#Region " IDisposableMail "

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Represents a disposable mail address.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Wikipedia article: <see href="https://en.wikipedia.org/wiki/Disposable_email_address"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
Public Interface IDisposableMail

#Region " Events "

   ''' <summary>
   ''' Occurs when a new inbox message arrived.
   ''' </summary>
   Event MailMessageArrived As EventHandler(Of MailMessageArrivedEventArgs)

#End Region

#Region " (Public) Methods "

   ''' <summary>
   ''' Creates a new temporary mail address.
   ''' </summary>
   ''' <param name="updateInterval">
   ''' The time interval to check for new incoming mail messages.
   ''' </param>
   Sub CreateNew(ByVal updateInterval As TimeSpan)

   ''' <summary>
   ''' Renews the life-time for the current temporary mail address.
   ''' </summary>
   Sub Renew()

#End Region

#Region " (Private) Functions "

   ''' <summary>
   ''' Gets the mail address.
   ''' </summary>
   ''' <returns>
   ''' The mail address.
   ''' </returns>
   Function GetMailAddress() As MailAddress

   ''' <summary>
   ''' Gets the inbox message count.
   ''' </summary>
   ''' <returns>
   ''' The inbox message count.
   ''' </returns>
   Function GetMessageCount() As Integer

   ''' <summary>
   ''' Gets the inbox messages.
   ''' </summary>
   ''' <returns>
   ''' The inbox messages.
   ''' </returns>
   Function GetMessages() As IEnumerable(Of MailMessage)

   ''' <summary>
   ''' Gets the time left to expire the current temporary mail address.
   ''' </summary>
   ''' <returns>
   ''' The time left to expire the current temporary mail address.
   ''' </returns>
   Function GetExpirationTime() As TimeSpan

#End Region

End Interface

#End Region





2.

Para el evento IDisposableMail.MailMessageArrived creé la siguiente clase con nombre MailMessageArrivedEventArgs, la cual proveerá los datos del evento:

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.Net.Mail
Imports System.Runtime.InteropServices

#End Region

#Region " MailMessageArrivedEventArgs "

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Represents the event data for the <see cref="IDisposableMail.MailMessageArrived"/> event.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <seealso cref="EventArgs" />
''' ----------------------------------------------------------------------------------------------------
<ComVisible(True)>
Public NotInheritable Class MailMessageArrivedEventArgs : Inherits EventArgs

#Region " Properties "

   ''' <summary>
   ''' Gets the mail message.
   ''' </summary>
   ''' <value>
   ''' The mail message.
   ''' </value>
   Public ReadOnly Property MailMessage As MailMessage

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="MailMessageArrivedEventArgs"/> class.
   ''' </summary>
   ''' <param name="msg">
   ''' The mail message that arrived.
   ''' </param>
   Public Sub New(ByVal msg As MailMessage)
       Me.MailMessage = msg
   End Sub

#End Region

End Class

#End Region


3.

Seguidamente, extendí la clase WebClient para añadirle soporte para el uso de cookies, esto no es estrictamente necesario, la alternativa sería usar la clase HttpWeRequest y etc, pero de esta forma añadimos cierto nivel de abstracción adicional en la clase WebClient para poder utilizarla para este fin, y así podremos simplificar mucho el código necesario para escribir las solicitudes/requests al servicio de 10minutemail.com...

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.ComponentModel
Imports System.Drawing
Imports System.Net
Imports System.Runtime.InteropServices

#End Region

#Region " ElektroWebClient "

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Represents a <see cref="WebClient"/> with support for cookies.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Original idea taken from: http://www.codingvision.net/tips-and-tricks/c-webclient-with-cookies
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
<DisplayName("ElektroWebClient")>
<Description("A extended WebClient component, with support for cookies.")>
<DesignTimeVisible(False)>
<DesignerCategory("Component")>
<ToolboxBitmap(GetType(Component), "Component.bmp")>
<ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow)>
<ComVisible(True)>
Public Class ElektroWebClient : Inherits WebClient

#Region " Properties "

   ''' <summary>
   ''' Gets or sets a value indicating whether cookies are enabled.
   ''' </summary>
   ''' <value>
   ''' <see langword="True"/> if cookies are enabled; otherwise, <see langword="False"/>.
   ''' </value>
   Public Property CookiesEnabled As Boolean

   ''' <summary>
   ''' Gets the cookies.
   ''' </summary>
   ''' <value>
   ''' The cookies.
   ''' </value>
   Public ReadOnly Property Cookies As CookieContainer
       Get
           Return Me.cookiesB
       End Get
   End Property
   ''' <summary>
   ''' (Backing field)
   ''' <para></para>
   ''' The cookies.
   ''' </summary>
   Private cookiesB As CookieContainer

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="ElektroWebClient"/> class.
   ''' </summary>
   Public Sub New()
       MyBase.New()
   End Sub

#End Region

#Region " Inherited Methods "

   ''' <summary>
   ''' Returns a <see cref="WebRequest"/> object for the specified resource.
   ''' </summary>
   ''' <param name="address">
   ''' A <see cref="Uri"/> that identifies the resource to request.
   ''' </param>
   ''' <returns>
   ''' A new <see cref="WebRequest"/> object for the specified resource.
   ''' </returns>
   Protected Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest
       If Not (Me.CookiesEnabled) Then
           Return MyBase.GetWebRequest(address)
       End If

       Dim request As WebRequest = MyBase.GetWebRequest(address)
       If (TypeOf request Is HttpWebRequest) Then
           If (Me.cookiesB Is Nothing) Then
               Me.cookiesB = New CookieContainer()
           End If
           DirectCast(request, HttpWebRequest).CookieContainer = Me.cookiesB
       End If
       Return request
   End Function

#End Region

End Class

#End Region





4.

Esta es la última pieza de toda esta implementación, una clase con nombre TenMinuteMail que nos servirá para representar y administrar el correo deshechable...

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.Diagnostics.CodeAnalysis
Imports System.Linq
Imports System.Net
Imports System.Net.Mail
Imports System.Runtime.Serialization.Json
Imports System.Text
Imports System.Threading
Imports System.Web
Imports System.Xml

#End Region

#Region " TenMinuteMail "

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates and manages a temporary mail address using the https://10minutemail.com/ service.
''' <para></para>
''' Be aware the mail address will expire in approx. 10 minutes after calling the <see cref="TenMinuteMail.Dispose()"/> method.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <seealso cref="IDisposableMail"/>
''' <seealso cref="IDisposable"/>
''' ----------------------------------------------------------------------------------------------------
Public Class TenMinuteMail : Implements IDisposableMail, IDisposable

#Region " Properties "

   ''' <summary>
   ''' Gets the mail address.
   ''' </summary>
   ''' <value>
   ''' The mail address.
   ''' </value>
   Public ReadOnly Property MailAddress As MailAddress
       Get
           Return Me.mailAddressB
       End Get
   End Property
   ''' <summary>
   ''' (Backing field) The current mail address.
   ''' </summary>
   Private mailAddressB As MailAddress

   ''' <summary>
   ''' Gets the message count.
   ''' </summary>
   ''' <value>
   ''' The message count.
   ''' </value>
   Public ReadOnly Property MessageCount As Integer
       Get
           Return Me.GetMessageCount()
       End Get
   End Property

   ''' <summary>
   ''' Gets the inbox messages.
   ''' </summary>
   ''' <value>
   ''' The inbox messages.
   ''' </value>
   Public Overridable ReadOnly Property Messages As IEnumerable(Of MailMessage)
       Get
           Return Me.GetMessages()
       End Get
   End Property

   ''' <summary>
   ''' Gets the inbox message with the specified message id.
   ''' </summary>
   ''' <param name="id">
   ''' The message id.
   ''' </param>
   ''' <value>
   ''' The inbox message with the specified message id.
   ''' </value>
   Public Overridable ReadOnly Property Messages(ByVal id As String) As MailMessage
       Get
           Return Me.GetMessage(id)
       End Get
   End Property

   ''' <summary>
   ''' Gets a value indicating whether the temporary mail service is blocked.
   ''' <para></para>
   ''' If <see langword="True"/>,
   ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
   ''' <para></para>
   ''' And you must wait some minutes to be able use 10minutemail.com service again.
   ''' </summary>
   ''' <value>
   ''' If <see langword="True"/>,
   ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
   ''' <para></para>
   ''' And you must wait some minutes to be able use 10minutemail.com service again.; otherwise, <see langword="False"/>.
   ''' </value>
   Public ReadOnly Property IsBlocked As Boolean
       Get
           If Not (Me.isBlockedB) Then
               Me.isBlockedB = Me.GetIsBlocked()
           End If
           Return isBlockedB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing field)
   ''' <para></para>
   ''' Gets a value indicating whether the temporary mail service is blocked.
   ''' <para></para>
   ''' If <see langword="True"/>,
   ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
   ''' <para></para>
   ''' And you must wait some minutes to be able use 10minutemail.com service again.
   ''' </summary>
   Private isBlockedB As Boolean

#End Region

#Region " Fields "

#Region " Common "

   ''' <summary>
   ''' The <see cref="ElektroWebClient"/> instance that manage cookies and requests to https://10minutemail.com/.
   ''' </summary>
   Protected Client As ElektroWebClient

   ''' <summary>
   ''' A <see cref="Timer"/> instance that will renew the life-time of the temporary mail address,
   ''' and check for new incoming mail messages.
   ''' </summary>
   Protected TimerUpdate As Timer

   ''' <summary>
   ''' A counter to keep track of the current mail message count, and so detect new incoming mail messages.
   ''' </summary>
   Private messageCounter As Integer

#End Region

#Region " Uris "

   ''' <summary>
   ''' The Uri that points to the main site.
   ''' </summary>
   Protected uriBase As Uri

   ''' <summary>
   ''' The Uri that points to the address resource.
   ''' </summary>
   Protected uriAddress As Uri

   ''' <summary>
   ''' The Uri that points to the blocked resource.
   ''' </summary>
   Protected uriBlocked As Uri

   ''' <summary>
   ''' The Uri that points to the messagecount resource.
   ''' </summary>
   Protected uriMessageCount As Uri

   ''' <summary>
   ''' The Uri that points to the messages resource.
   ''' </summary>
   Protected uriMessages As Uri

   ''' <summary>
   ''' The Uri that points to the reply resource.
   ''' </summary>
   Protected uriReply As Uri

   ''' <summary>
   ''' The Uri that points to the reset resource.
   ''' </summary>
   Protected uriReset As Uri

   ''' <summary>
   ''' The Uri that points to the secondsleft resource.
   ''' </summary>
   Protected uriSecondsLeft As Uri

#End Region

#End Region

#Region " Events "

   ''' <summary>
   ''' Occurs when a new inbox message arrived.
   ''' </summary>
   Public Event MailMessageArrived As EventHandler(Of MailMessageArrivedEventArgs) Implements IDisposableMail.MailMessageArrived

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="TenMinuteMail"/> class.
   ''' </summary>
   <DebuggerStepThrough>
   Public Sub New()
       Me.New(TimeSpan.FromSeconds(10))
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="TenMinuteMail"/> class.
   ''' </summary>
   ''' <param name="updateInterval">
   ''' The time interval to check for new incoming messages.
   ''' <para></para>
   ''' Be aware that 10minutemail.com server's update interval are 10 seconds by default.
   ''' </param>
   ''' <exception cref="ArgumentException">
   ''' Update interval must be in range between 10 to 60 seconds. - updateInterval
   ''' </exception>
    <SuppressMessage("Microsoft.Usage", "CA2214:DoNotCallOverridableMethodsInConstructors", Justification:="Don't panic")>
   <DebuggerStepThrough>
   Public Sub New(ByVal updateInterval As TimeSpan)
       Me.uriBase = New Uri("https://10minutemail.com/")
       Me.uriAddress = New Uri(Me.uriBase, "/10MinuteMail/resources/session/address")
       Me.uriBlocked = New Uri(Me.uriBase, "/10MinuteMail/resources/session/blocked")
       Me.uriMessageCount = New Uri(Me.uriBase, "/10MinuteMail/resources/messages/messageCount")
       Me.uriMessages = New Uri(Me.uriBase, "/10MinuteMail/resources/messages")
       Me.uriReply = New Uri(Me.uriBase, "/10MinuteMail/resources/messages/reply")
       Me.uriReset = New Uri(Me.uriBase, "/10MinuteMail/resources/session/reset")
       Me.uriSecondsLeft = New Uri(Me.uriBase, "/10MinuteMail/resources/session/secondsLeft")

       Me.CreateNew(updateInterval)
   End Sub

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Creates a new temporary mail address.
   ''' </summary>
   ''' <param name="updateInterval">
   ''' The time interval to check for new incoming messages.
   ''' <para></para>
   ''' Be aware that 10minutemail.com server's update interval are 10 seconds by default.
   ''' </param>
   ''' <exception cref="ArgumentException">
   ''' Update interval must be in range between 10 to 60 seconds. - updateInterval
   ''' </exception>
   <DebuggerStepThrough>
   Public Overridable Sub CreateNew(ByVal updateInterval As TimeSpan) Implements IDisposableMail.CreateNew
       Dim totalMilliseconds As Integer = Convert.ToInt32(updateInterval.TotalMilliseconds)

       Select Case totalMilliseconds
           Case Is < 10000 ' 10 seconds.
               Throw New ArgumentException("Update interval must be in range between 10 to 60 seconds.", "updateInterval")

           Case Is > 60000 ' 1 minute.
               Throw New ArgumentException("Update interval must be in range between 10 to 60 seconds.", "updateInterval")

           Case Else
               If (Me.TimerUpdate IsNot Nothing) Then
                   Me.TimerUpdate.Change(Timeout.Infinite, Timeout.Infinite)
               End If

               If (Me.Client IsNot Nothing) Then
                   Me.Client.Dispose()
                   Me.Client = Nothing
               End If

               Me.isBlockedB = False
               Me.mailAddressB = Nothing
               Me.messageCounter = 0

               Me.Client = New ElektroWebClient() With {.CookiesEnabled = True, .Encoding = Encoding.UTF8}
               Me.mailAddressB = Me.GetMailAddress()
               Me.TimerUpdate = New Timer(AddressOf Me.UpdateTimer_CallBack, Me, totalMilliseconds, totalMilliseconds)

       End Select
   End Sub

   ''' <summary>
   ''' Replies to a <see cref="MailMessage"/> with the specified message id.
   ''' </summary>
   ''' <param name="msgId">
   ''' The message id of the <see cref="MailMessage"/>.
   ''' </param>
   '''
   ''' <param name="body">
   ''' The body.
   ''' </param>
   Public Overridable Sub Reply(ByVal msgId As String, ByVal body As String)
       Me.Reply(Me.Messages(msgId), body)
   End Sub

   ''' <summary>
   ''' Replies to the specified <see cref="MailMessage"/>.
   ''' </summary>
   ''' <param name="msg">
   ''' The <see cref="MailMessage"/>.
   ''' </param>
   '''
   ''' <param name="body">
   ''' The body.
   ''' </param>
   Public Overridable Sub Reply(ByVal msg As MailMessage, ByVal body As String)

       Dim msgId As String = msg.Headers.Item("msgId")
       Dim parameters As String = String.Format("messageId={0}&replyBody=""{1}""", msgId, HttpUtility.UrlEncode(body))

       Dim result As String
       SyncLock (Me.Client)
           Me.Client.Headers(HttpRequestHeader.ContentType) = "application/x-www-form-urlencoded"
           result = Me.Client.UploadString(Me.uriReply, "POST", parameters)
           Me.Client.Headers.Remove(HttpRequestHeader.ContentType)
       End SyncLock

       ' ToDo: need to improve...
       If Not String.IsNullOrEmpty(result) Then
           ' ...
       End If

   End Sub

#End Region

#Region " Private/Protected Methods "

   ''' <summary>
   ''' Gets the mail address.
   ''' </summary>
   ''' <returns>
   ''' The mail address.
   ''' </returns>
   ''' <exception cref="WebException">
   ''' You have requested too many temporary mail addresses from your IP address too quickly.
   ''' Please wait some minutes and try again.
   ''' </exception>
   <DebuggerStepThrough>
   Protected Overridable Function GetMailAddress() As MailAddress Implements IDisposableMail.GetMailAddress
       If (Me.IsBlocked) Then
           Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
       End If

       If (Me.mailAddressB Is Nothing) Then
           SyncLock (Me.Client)
               Dim value As String = Me.Client.DownloadString(Me.uriAddress)
               Me.mailAddressB = New MailAddress(value, "TenMinuteMail", Encoding.Default)
           End SyncLock
       End If

       Return Me.mailAddressB
   End Function

   ''' <summary>
   ''' Gets the inbox message count.
   ''' </summary>
   ''' <returns>
   ''' The inbox message count.
   ''' </returns>
   ''' <exception cref="WebException">
   ''' You have requested too many temporary mail addresses from your IP address too quickly.
   ''' Please wait some minutes and try again.
   ''' </exception>
   <DebuggerStepThrough>
   Protected Overridable Function GetMessageCount() As Integer Implements IDisposableMail.GetMessageCount
       If (Me.IsBlocked) Then
           Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
       End If

       SyncLock (Me.Client)
           Dim value As String = Me.Client.DownloadString(Me.uriMessageCount)
           Return Convert.ToInt32(value)
       End SyncLock
   End Function

   ''' <summary>
   ''' Gets the inbox message with the specified message id.
   ''' </summary>
   ''' <param name="id">
   ''' The message id.
   ''' </param>
   ''' <returns>
   ''' The inbox message with the specified message id.
   ''' </returns>
   ''' <exception cref="WebException">
   ''' You have requested too many temporary mail addresses from your IP address too quickly.
   ''' Please wait some minutes and try again.
   ''' </exception>
   <DebuggerStepThrough>
   Protected Overridable Function GetMessage(ByVal id As String) As MailMessage

       Return (From msg As MailMessage In Me.GetMessages()
               Where msg.Headers("msgId").Equals(id, StringComparison.OrdinalIgnoreCase)
              ).Single()

   End Function

   ''' <summary>
   ''' Gets the inbox messages.
   ''' </summary>
   ''' <returns>
   ''' The inbox messages.
   ''' </returns>
   ''' <exception cref="WebException">
   ''' You have requested too many temporary mail addresses from your IP address too quickly.
   ''' Please wait some minutes and try again.
   ''' </exception>
   <DebuggerStepThrough>
   Protected Overridable Iterator Function GetMessages() As IEnumerable(Of MailMessage) Implements IDisposableMail.GetMessages
       If (Me.IsBlocked) Then
           Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
       End If

       If (Me.GetMessageCount = 0) Then
           Exit Function
       End If

       SyncLock (Me.Client)

           Dim src As Byte() = Me.Client.DownloadData(Me.uriMessages)
           Using xmlReader As XmlDictionaryReader =
             JsonReaderWriterFactory.CreateJsonReader(src, 0, src.Length, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)

               Dim xml As XElement = XElement.Load(xmlReader)
               If (xml Is Nothing) Then
                   Exit Function
               End If

               For Each item As XElement In xml.Elements("item")

                   Dim recipientList As XElement = item.<recipientList>.Single()
                   Dim primaryFromAddress As String = item.<primaryFromAddress>.Value
                   Dim subject As String = item.<subject>.Value
                   Dim body As String = item.<bodyText>.Value
                   ' Get the message id. to identify and reply the message:
                   Dim id As String = item.<id>.Value

                   ' ToDO: attachment support.
                   ' Dim attachmentCount As Integer = Convert.ToInt32(item.<attachmentCount>.Value)
                   ' Dim attachments As XElement = item.<attachments>.Single()
                   ' ...
                   ' MailMessage.Attachments.Add(New Attachment( ... , MediaTypeNames.Application.Octet))

                   Dim msg As New MailMessage()
                   With msg
                       .BodyEncoding = Encoding.UTF8
                       ' .HeadersEncoding = Encoding.UTF8
                       .SubjectEncoding = Encoding.UTF8

                       .Headers.Add("msgId", id) ' store the message id. in the headers.
                       .From = New MailAddress(primaryFromAddress, "primaryFromAddress", Encoding.UTF8)
                       .Subject = subject
                       .IsBodyHtml = True
                       .Body = body
                   End With

                   For Each recipient As XElement In recipientList.Elements("item")
                       msg.To.Add(New MailAddress(recipient.Value))
                   Next recipient

                   Yield msg

               Next item

           End Using

       End SyncLock
   End Function

   ''' <summary>
   ''' Gets the time left to expire the current temporary mail address.
   ''' </summary>
   ''' <returns>
   ''' The time left to expire the current temporary mail address.
   ''' </returns>
   <DebuggerStepThrough>
   Protected Overridable Function GetExpirationTime() As TimeSpan Implements IDisposableMail.GetExpirationTime
       Throw New NotImplementedException("The implementation is not necessary for 10minutemail.com service.")
   End Function

   ''' <summary>
   ''' Gets a value indicating whether the current temporary mail is blocked.
   ''' <para></para>
   ''' If <see langword="True"/>,
   ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
   ''' <para></para>
   ''' And you must wait some minutes to be able use 10minutemail.com service again.
   ''' </summary>
   ''' <returns>
   ''' <para></para>
   ''' If <see langword="True"/>,
   ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
   ''' <para></para>
   ''' And you must wait some minutes to be able use 10minutemail.com service again.
   ''' </returns>
   <DebuggerStepThrough>
   Protected Overridable Function GetIsBlocked() As Boolean
       SyncLock (Me.Client)
           Dim value As String = Me.Client.DownloadString(Me.uriBlocked)
           Return CBool(value)
       End SyncLock
   End Function

   ''' <summary>
   ''' Renews the life-time for the current temporary mail address.
   ''' </summary>
   ''' <exception cref="WebException">
   ''' You have requested too many temporary mail addresses from your IP address too quickly.
   ''' Please wait some minutes and try again.
   ''' </exception>
   '''
   ''' <exception cref="NotSupportedException">
   ''' Unexpected response value: '{value}'
   ''' </exception>
   <DebuggerStepThrough>
   Protected Overridable Sub Renew() Implements IDisposableMail.Renew
       If (Me.IsBlocked) Then
           Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
       End If

       SyncLock (Me.Client)
           Dim value As String = Me.Client.DownloadString(Me.uriReset)
           If Not (value.Equals("reset", StringComparison.OrdinalIgnoreCase)) Then
               Throw New NotSupportedException(String.Format("Unexpected response value: '{0}'", value))
           End If
       End SyncLock
   End Sub

   ''' <summary>
   ''' Handles the calls from <see cref="TenMinuteMail.TimerUpdate"/>.
   ''' </summary>
   ''' <param name="state">
   ''' An object containing application-specific information relevant to the
   ''' method invoked by this delegate, or <see langword="Nothing"/>.
   ''' </param>
   Protected Overridable Sub UpdateTimer_CallBack(ByVal state As Object)

       If (Me.Client.IsBusy) Then
           Exit Sub
       End If

       SyncLock (Me.Client)
           Me.Renew()

           Dim oldMsgCount As Integer = Me.messageCounter
           Dim newMsgCount As Integer = Me.GetMessageCount()

           If (newMsgCount > oldMsgCount) Then
               Me.messageCounter = newMsgCount
               Dim messages As IEnumerable(Of MailMessage) = Me.GetMessages()

               For msgIndex As Integer = oldMsgCount To (newMsgCount - 1)
                   Me.OnMailMessageArrived(New MailMessageArrivedEventArgs(messages(msgIndex)))
               Next msgIndex
           End If
       End SyncLock

   End Sub

#End Region

#Region " Event Invocators "

   ''' <summary>
   ''' Raises the <see cref="TenMinuteMail.MailMessageArrived"/> event.
   ''' </summary>
   ''' <param name="e">
   ''' The <see cref="MailMessageArrivedEventArgs"/> instance containing the event data.
   ''' </param>
   Protected Overridable Sub OnMailMessageArrived(ByVal e As MailMessageArrivedEventArgs)

       If (Me.MailMessageArrivedEvent IsNot Nothing) Then
           RaiseEvent MailMessageArrived(Me, e)
       End If

   End Sub

#End Region

#Region " IDisposable Implementation "

   ''' <summary>
   ''' Flag to detect redundant calls when disposing.
   ''' </summary>
   Protected isDisposed As Boolean

   ''' <summary>
   ''' Releases all the resources used by this instance.
   ''' </summary>
   <DebuggerStepThrough>
   Public Sub Dispose() Implements IDisposable.Dispose
       Me.Dispose(isDisposing:=True)
       GC.SuppressFinalize(obj:=Me)
   End Sub

   ''' <summary>
   ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
   ''' Releases unmanaged and, optionally, managed resources.
   ''' </summary>
   ''' <param name="isDisposing">
   ''' <see langword="True"/>  to release both managed and unmanaged resources;
   ''' <see langword="False"/> to release only unmanaged resources.
   ''' </param>
   Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
       If Not (Me.isDisposed) AndAlso (isDisposing) Then
           Me.MailMessageArrivedEvent = Nothing

           Me.TimerUpdate.Dispose()
           Me.TimerUpdate = Nothing

           Me.Client.Dispose()
           Me.Client = Nothing

           Me.mailAddressB = Nothing
           Me.messageCounter = 0
           Me.isBlockedB = False

           Me.uriAddress = Nothing
           Me.uriBase = Nothing
           Me.uriBlocked = Nothing
           Me.uriMessageCount = Nothing
           Me.uriMessages = Nothing
           Me.uriReply = Nothing
           Me.uriReset = Nothing
           Me.uriSecondsLeft = Nothing
       End If

       Me.isDisposed = True
   End Sub

#End Region

End Class

#End Region





MODO DE EMPLEO

Un ejemplo simple para crear la dirección temporal y controlar la recepción de nuevos correos entrantes...

Código (vbnet) [Seleccionar]
Imports System.Net.Mail
Imports System.Text

Public NotInheritable Class Form1

   Private WithEvents TempMail As TenMinuteMail

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       Me.TempMail = New TenMinuteMail(TimeSpan.FromSeconds(10)) ' Set inbox notification interval to 10 sec.
       Console.WriteLine(String.Format("Your 10MinuteMail Address: '{0}'", Me.TempMail.MailAddress.Address))
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Handles the <see cref="TenMinuteMail.MailMessageArrived"/> event of the <see cref="Form1.TempMail"/> object.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="sender">
   ''' The source of the event.
   ''' </param>
   '''
   ''' <param name="e">
   ''' The <see cref="MailMessageArrivedEventArgs"/> instance containing the event data.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   Private Sub TempMail_MailMessageArrived(ByVal sender As Object, ByVal e As MailMessageArrivedEventArgs) _
   Handles TempMail.MailMessageArrived

       Dim sb As New StringBuilder()
       With sb
           .AppendLine()
           .AppendLine("NEW MAIL MESSAGE ARRIVED")
           .AppendLine("************************")
           .AppendLine()
           .AppendLine(String.Format("From...: {0}", e.MailMessage.From.Address))
           .AppendLine(String.Format("To.....: {0}", String.Join(";", (From msg As MailAddress In e.MailMessage.To))))
           .AppendLine(String.Format("Subject: {0}", e.MailMessage.Subject))
           .AppendLine(String.Format("Msg.Id.: {0}", e.MailMessage.Headers("msgId")))
           .AppendLine()
           .AppendLine("-------BODY START-------")
           .AppendLine(e.MailMessage.Body)
           .AppendLine("-------BODY END---------")
       End With

       Console.WriteLine(sb.ToString())

   End Sub

End Class


En el ejemplo provisto, el formato a mostrar cuando se recibe un nuevo correo sería algo parecido a esto:

NEW MAIL MESSAGE ARRIVED
************************

From...: elektrostudios@elhacker.net
To.....: z421459@mvrht.net
Subject: Hello Sir.
Msg.Id.: 6443119781926234531

-------BODY START-------
Hello World!
<br />
<br />
-------BODY END---------


nota: el cuerpo del mensaje se devuelve en formato HTML.

EDITO:
Para responder a un e-mail simplemente deben usar el método TenMinuteMail.Reply pasándole como argumento la instancia del mensaje al que quieren responder, o en su defecto un identificador de mensaje, el cual lo puede encontrar almacenado en la cabecera de un mensaje: MailMessage.Headers("msgId")

Saludos!








Eleкtro

#517
Un simple snippet donde se hace uso de Reflection para obtener los estilos de control aplicados en un tipo de control específico.

Código (vbnet) [Seleccionar]
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the value of the specified control style bit for the specified control.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="ctrl">
   ''' The source <see cref="Control"/>.
   ''' </param>
   '''
   ''' <param name="styles">
   ''' The <see cref="ControlStyles"/> bit to return the value from.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' <see langword="True"/> if the specified control style bit is set to <see langword="True"/>;
   ''' otherwise, <see langword="False"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetControlStyle(ByVal ctrl As Control, ByVal styles As ControlStyles) As Boolean

       Dim t As Type = ctrl.GetType()
       Dim method As MethodInfo = t.GetMethod("GetStyle", BindingFlags.NonPublic Or BindingFlags.Instance)

       Return CBool(method.Invoke(ctrl, {styles}))

   End Function


Con esto podemos determinar, por ejemplo, si un control acepta transparencia:

Código (vbnet) [Seleccionar]
dim value as boolean = GetControlStyle(Me.ListView1, ControlStyles.SupportsTransparentBackColor)




Otro snippet, para hacer lo opuesto, es decir, establecer el valor de un estilo de control:

Código (vbnet) [Seleccionar]
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Sets a specified <see cref="ControlStyles"/> flag to
''' either <see langword="True"/> or <see langword="False"/> for the source control.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="ctrl">
''' The source <see cref="Control"/>.
''' </param>
'''
''' <param name="style">
''' The <see cref="ControlStyles"/> bit to set.
''' </param>
'''
''' <param name="value">
''' <see langword="True"/> to apply the specified style to the control; otherwise, <see langword="False"/>.
''' </param>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Sub SetControlStyle(ByVal ctrl As Control, ByVal style As ControlStyles, ByVal value As Boolean)

    Dim t As Type = ctrl.GetType()
    Dim method As MethodInfo = t.GetMethod("SetStyle", BindingFlags.NonPublic Or BindingFlags.Instance)

    method.Invoke(ctrl, {style, value})

End Sub








Eleкtro

#518
Unas extensiones de método para obtener el ancho y alto del borde horizontal y vertical de un Form. Y también para obtener el tamaño de la barra de título (plus la opción de incluir el tamaño de los bordes de la ventana o no):

Código (vbnet) [Seleccionar]
<HideModuleName>
Public Module FormExtensions

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the size of the vertical border (the border of the left or right edge) of the source <see cref="Form"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Dim verticalBorderSize As Size = GetVerticalBorderSize(Me)
   ''' Console.WriteLine(String.Format("Vertical Border Width  = {0}", verticalBorderSize.Width))
   ''' Console.WriteLine(String.Format("Vertical Border Height = {0}", verticalBorderSize.Height))
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="f">
   ''' The source <see cref="Form"/>.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The size of the vertical border (the border of the left or right edge) of the source <see cref="Form"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <Extension>
   <EditorBrowsable(EditorBrowsableState.Always)>
   <DebuggerStepThrough>
   Public Function GetVerticalBorderSize(ByVal f As Form) As Size

       Select Case f.FormBorderStyle

           Case FormBorderStyle.None
               Return Size.Empty

           Case FormBorderStyle.Fixed3D
               Return New Size(SystemInformation.FixedFrameBorderSize.Width + SystemInformation.Border3DSize.Width,
                               f.Height)

           Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle, FormBorderStyle.FixedToolWindow
               Return New Size(SystemInformation.FixedFrameBorderSize.Width,
                               f.Height)

           Case Else
               Return New Size(SystemInformation.FrameBorderSize.Width,
                               f.Height)

       End Select

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the size of the horizontal border (the border of the top or bottom edge) of the source <see cref="Form"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Dim horizontalBorderSize As Size = GetHorizontalBorderSize(Me)
   ''' Console.WriteLine(String.Format("Horizontal Border Width  = {0}", horizontalBorderSize.Width))
   ''' Console.WriteLine(String.Format("Horizontal Border Height = {0}", horizontalBorderSize.Height))
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="f">
   ''' The source <see cref="Form"/>.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The size of the horizontal border (the border of the top or bottom edge) of the source <see cref="Form"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <Extension>
   <EditorBrowsable(EditorBrowsableState.Always)>
   <DebuggerStepThrough>
   Public Function GetHorizontalBorderSize(ByVal f As Form) As Size

       Select Case f.FormBorderStyle

           Case FormBorderStyle.None
               Return Size.Empty

           Case FormBorderStyle.Fixed3D
               Return New Size(f.Width,
                               SystemInformation.FixedFrameBorderSize.Height + SystemInformation.Border3DSize.Height)

           Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle, FormBorderStyle.FixedToolWindow
               Return New Size(f.Width,
                               SystemInformation.FixedFrameBorderSize.Height)

           Case Else
               Return New Size(f.Width,
                               SystemInformation.FrameBorderSize.Height)

       End Select

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the titlebar bounds of the source <see cref="Form"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Dim titleBarBoundsWithBorders As Rectangle = GetTitleBarBounds(Me, includeBorderSizes:=True)
   ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Width  = {0}", titleBarBoundsWithBorders.Width))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Height = {0}", titleBarBoundsWithBorders.Height))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Pos. X = {0}", titleBarBoundsWithBorders.X))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Pos. Y = {0}", titleBarBoundsWithBorders.Y))
   '''
   ''' Dim titleBarBoundsWithoutBorders As Rectangle = GetTitleBarBounds(Me, includeBorderSizes:=False)
   ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Width  = {0}", titleBarBoundsWithoutBorders.Width))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Height = {0}", titleBarBoundsWithoutBorders.Height))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Pos. X = {0}", titleBarBoundsWithoutBorders.X))
   ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Pos. Y = {0}", titleBarBoundsWithoutBorders.Y))
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="f">
   ''' The source <see cref="Form"/>.
   ''' </param>
   '''
   ''' <param name="includeBorderSizes">
   ''' If <see langword="True"/>, the titlebar bounds will include the bounds of the top, left and right border edges.
   ''' <para></para>
   ''' If <see langword="False"/>, the titlebar bounds will NOT include the bounds of the top, left and right border edges.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The titlebar bounds (including the border sizes) of the source <see cref="Form"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <Extension>
   <EditorBrowsable(EditorBrowsableState.Always)>
   <DebuggerStepThrough>
   Public Function GetTitleBarBounds(ByVal f As Form, ByVal includeBorderSizes As Boolean) As Rectangle

       If (includeBorderSizes) Then
           Select Case f.FormBorderStyle

               Case FormBorderStyle.None
                   Return Rectangle.Empty

               Case FormBorderStyle.Fixed3D
                   Return New Rectangle(New Point(0, 0),
                                        New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FixedFrameBorderSize.Height + SystemInformation.Border3DSize.Height))

               Case FormBorderStyle.FixedToolWindow
                   Return New Rectangle(New Point(0, 0),
                                        New Size(f.Width, SystemInformation.ToolWindowCaptionHeight + SystemInformation.FixedFrameBorderSize.Height))

               Case FormBorderStyle.SizableToolWindow
                   Return New Rectangle(New Point(0, 0),
                                        New Size(f.Width, SystemInformation.ToolWindowCaptionHeight + SystemInformation.FrameBorderSize.Height))

               Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle
                   Return New Rectangle(New Point(0, 0),
                                        New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FixedFrameBorderSize.Height))

               Case Else
                   Return New Rectangle(New Point(0, 0),
                                        New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FrameBorderSize.Height))

           End Select

       Else
           Dim verticalBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
           Dim horizontalBorderSize As Size = FormExtensions.GetHorizontalBorderSize(f)

           Select Case f.FormBorderStyle

               Case FormBorderStyle.None
                   Return Rectangle.Empty

               Case FormBorderStyle.FixedToolWindow, FormBorderStyle.SizableToolWindow
                   Return New Rectangle(New Point(verticalBorderSize.Width, horizontalBorderSize.Height),
                                    New Size(f.ClientRectangle.Width, SystemInformation.ToolWindowCaptionHeight))

               Case Else
                   Return New Rectangle(New Point(verticalBorderSize.Width, horizontalBorderSize.Height),
                                    New Size(f.ClientRectangle.Width, SystemInformation.CaptionHeight))

           End Select

       End If

   End Function

End Module


Lo he probado con todos los tipos de estilos de form, y temas de terceros, parece funcionar correctamente en todos los casos, pero no descarto quizás haber cometido algún error en alguno de los cálculos de algún estilo de form, si encuentran algo me avisan.

Aquí les dejo un test de unidad que utilicé:

Código (vbnet) [Seleccionar]
<TestMethod()>
Public Sub TestNonClientAreaMeasures()

   Using f As New Form With {.Size = New Size(100, 100)}

       For Each style As FormBorderStyle In [Enum].GetValues(GetType(FormBorderStyle))

           Console.WriteLine(String.Format("Testing form border style: {0}", style.ToString()))
           If (style = FormBorderStyle.None) Then
               ' Zero border size and no title bar, so nothing to do here.
               Continue For
           End If

           f.FormBorderStyle = style
           f.Show()

           Dim titlebarBounds As Rectangle = FormExtensions.GetTitleBarBounds(f, True) ' includes border bounds.
           Dim titlebarBoundsWitoutBorders As Rectangle = FormExtensions.GetTitleBarBounds(f, False) ' not includes border bounds.

           Dim verticalBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
           Dim horizontalBorderSize As Size = FormExtensions.GetHorizontalBorderSize(f)

           Dim formSize As Size = f.Bounds.Size ' includes non-client size.
           Dim formClientSize As Size = f.ClientRectangle.Size ' client size only.
           Dim formNonClientSize As New Size((formSize.Width - formClientSize.Width), ' non-client size only.
                                         (formSize.Height - formClientSize.Height))

           Assert.AreEqual(formNonClientSize.Width, (verticalBorderSize.Width * 2),
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Value of '{0} * 2' ({1}) and '{2}' ({3}) are not equal.",
                                     "verticalBorderSize.Width", (verticalBorderSize.Width * 2),
                                     "formNonClientSize.Width", formNonClientSize.Width))

           Assert.AreEqual(formClientSize.Width, titlebarBoundsWitoutBorders.Width,
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Value of '{0}' ({1}) and '{2}' ({3}) are not equal.",
                                     "titlebarBoundsWitoutBorders.Width", titlebarBoundsWitoutBorders.Width,
                                     "formClientSize.Width", formClientSize.Width))

           Assert.AreEqual(formSize.Width, titlebarBounds.Width,
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Value of '{0}' ({1}) and '{2}' ({3}) are not equal.",
                                     "titlebarBounds.Width", titlebarBounds.Width,
                                     "formSize.Width", formSize.Width))

           Assert.AreEqual(titlebarBounds.Height, (titlebarBoundsWitoutBorders.Height + horizontalBorderSize.Height),
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Sum of '{0} + {1}' ({2}) and '{3}' ({4}) are not equal.",
                                     "titlebarBoundsWitoutBorders.Height", "horizontalBorderSize.Height",
                                     (titlebarBoundsWitoutBorders.Height + horizontalBorderSize.Height),
                                     "titlebarBounds.Height", titlebarBounds.Height))

           Assert.AreEqual(formSize.Height, formClientSize.Height + titlebarBoundsWitoutBorders.Height + (horizontalBorderSize.Height * 2),
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Sum of '{0} + {1} + ({2} * 2)' ({3}) and '{4}' ({5}) are not equal.",
                                     "formClientSize.Height", "titlebarBoundsWitoutBorders.Height", "horizontalBorderSize.Height",
                                     formClientSize.Height + titlebarBoundsWitoutBorders.Height + (horizontalBorderSize.Height * 2),
                                     "formSize.Height", formSize.Height))

           Assert.AreEqual(formNonClientSize.Height, (titlebarBounds.Height + horizontalBorderSize.Height),
                       Environment.NewLine & Environment.NewLine &
                       String.Format("Sum of '{0} + {1}' ({2}) and '{3}' ({4}) are not equal.",
                                     "titlebarBounds.Height", "horizontalBorderSize.Height",
                                     (titlebarBounds.Height + horizontalBorderSize.Height),
                                     "formNonClientSize.Height", formNonClientSize.Height))

           f.Hide()
       Next style

   End Using

End Sub





Este método sirve para 'bloquear' la región visible de un Form, a los límites visibles de los controles hijos. El resultado es un Form con un fondo invisible y los controles visibles. Añadí una sobrecarga para poder especificar el tipo de control.

IMPORTANTE: este código utiliza las extensiones de método del módulo FormExtensions que compartí en este comentario más arriba... así que no se olviden de copiar ese código.

Código (vbnet) [Seleccionar]
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Locks the window region of the specified <see cref="Form"/> to the bounds of its child controls.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' LockFormRegionToControls(Me)
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="f">
   ''' The source <see cref="Form"/>.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="NotImplementedException">
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Sub LockFormRegionToControls(ByVal f As Form)

       LockFormRegionToControls(Of Control)(f)

   End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Locks the window region of the specified <see cref="Form"/> to the bounds of its child controls
    ''' of the specified <see cref="Type"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <example> This is a code example.
    ''' <code>
    ''' LockFormRegionToControls(Of Button)(Me)
    ''' </code>
    ''' </example>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <typeparam name="T">
    ''' The <see cref="Type"/> of control.
    ''' </typeparam>
    '''
    ''' <param name="f">
    ''' The source <see cref="Form"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <exception cref="NotImplementedException">
    ''' </exception>
    ''' ----------------------------------------------------------------------------------------------------
    Public Shared Sub LockFormRegionToControls(Of T As Control)(ByVal f As Form)

        Select Case f.FormBorderStyle

            Case FormBorderStyle.FixedToolWindow, FormBorderStyle.SizableToolWindow
                Throw New NotImplementedException()

            Case Else
                Dim vBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
                Dim tbBounds As Rectangle = FormExtensions.GetTitleBarBounds(f, includeBorderSizes:=True)

                Dim rects As IEnumerable(Of Rectangle) =
                    (From ctrl As T In f.Controls.OfType(Of T)()
                     Order By f.Controls.GetChildIndex(ctrl) Ascending
                     Select ctrl.Bounds)

                Using rgn As New Region(New Rectangle(0, 0, f.Width, f.Height))
                    rgn.MakeEmpty()

                    For Each rect As Rectangle In rects
                        rgn.Union(rect)
                    Next rect
                    rgn.Translate(vBorderSize.Width, tbBounds.Height)

                    If (f.Region IsNot Nothing) Then
                        f.Region.Dispose()
                    End If
                    f.Region = rgn
                End Using

        End Select

    End Sub









Eleкtro

#519
Un código simple y sencillo para obtener o establecer el modo de emulación de Internet Explorer en nuestra aplicación o para otra aplicación.

EDITO: código corregido, y refactorizado.

Código (vbnet) [Seleccionar]
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Specifies a Internet Explorer browser emulation mode.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <remarks>
   ''' <see href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
   ''' </remarks>
   ''' ----------------------------------------------------------------------------------------------------
   Public Enum IEBrowserEmulationMode As Integer

       ''' <summary>
       ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE7 Standards mode.
       ''' </summary>
       IE7 = 7000

       ''' <summary>
       ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE8 mode.
       ''' </summary>
       IE8 = 8000

       ''' <summary>
       ''' Webpages are displayed in IE8 Standards mode, regardless of the declared !DOCTYPE directive.
       ''' <para></para>
       ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
       ''' </summary>
       IE8Standards = 8888

       ''' <summary>
       ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.
       ''' </summary>
       IE9 = 9000

       ''' <summary>
       ''' Webpages are displayed in IE9 Standards mode, regardless of the declared !DOCTYPE directive.
       ''' <para></para>
       ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
       ''' </summary>
       IE9Standards = 9999

       ''' <summary>
       ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode.
       ''' </summary>
       IE10 = 10000

       ''' <summary>
       ''' Webpages are displayed in IE10 Standards mode, regardless of the !DOCTYPE directive.
       ''' </summary>
       IE10Standards = 10001

       ''' <summary>
       ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE11 edge mode.
       ''' </summary>
       IE11 = 11000

       ''' <summary>
       ''' Webpages are displayed in IE11 edge mode, regardless of the declared !DOCTYPE directive.
       ''' <para></para>
       ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
       ''' </summary>
       IE11Edge = 11001

   End Enum


+

Código (vbnet) [Seleccionar]
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Specifies a registry scope (a root key).
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Public Enum RegistryScope As Integer

       ''' <summary>
       ''' This refers to the HKEY_LOCAL_MACHINE (or HKLM) registry root key.
       ''' <para></para>
       ''' Configuration changes made on the subkeys of this root key will affect all users.
       ''' </summary>
       Machine = 0

       ''' <summary>
       ''' This refers to the HKEY_CURRENT_USER (or HKCU) registry root key.
       ''' <para></para>
       ''' Configuration changes made on the subkeys of this root key will affect only the current user.
       ''' </summary>
       CurrentUser = 1

   End Enum


+

Código (vbnet) [Seleccionar]
       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets or sets the Internet Explorer browser emulation mode for the current application.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example to get, set and verify the IE browser emulation mode for the current process.
       ''' <code>
       ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
       ''' Dim oldMode As IEBrowserEmulationMode
       ''' Dim newMode As IEBrowserEmulationMode
       '''
       ''' oldMode = BrowserEmulationMode(scope)
       ''' BrowserEmulationMode(scope) = IEBrowserEmulationMode.IE11Edge
       ''' newMode = BrowserEmulationMode(scope)
       '''
       ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
       ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
       '''
       ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
       ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
       ''' f.Controls.Add(wb)
       ''' f.Show()
       ''' wb.Navigate("http://www.whatversion.net/browser/")
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="scope">
       ''' The registry scope.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The Internet Explorer browser emulation mode.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public Shared Property BrowserEmulationMode(ByVal scope As RegistryScope) As IEBrowserEmulationMode
           <DebuggerStepThrough>
           Get
               Return AppUtil.GetIEBrowserEmulationMode(Process.GetCurrentProcess().ProcessName, scope)
           End Get
           <DebuggerStepThrough>
           Set(value As IEBrowserEmulationMode)
               AppUtil.SetIEBrowserEmulationMode(Process.GetCurrentProcess().ProcessName, scope, value)
           End Set
       End Property


+

Código (vbnet) [Seleccionar]

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Internet Explorer browser emulation mode for the specified process.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim processName As String = Process.GetCurrentProcess().ProcessName
       ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
       ''' Dim mode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(processName, scope)
       '''
       ''' Console.WriteLine(String.Format("Mode: {0} ({1})", mode, CStr(mode)))
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="processName">
       ''' The process name (eg. 'cmd.exe').
       ''' </param>
       '''
       ''' <param name="scope">
       ''' The registry scope.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="IEBrowserEmulationMode"/>.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="NotSupportedException">
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Function GetIEBrowserEmulationMode(ByVal processName As String, ByVal scope As RegistryScope) As IEBrowserEmulationMode

           processName = Path.GetFileNameWithoutExtension(processName)

           Using rootKey As RegistryKey = If(scope = RegistryScope.CurrentUser,
                                             RegistryKey.OpenBaseKey(RegistryHive.CurrentUser, RegistryView.Default),
                                             RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)),
                 subKey As RegistryKey = rootKey.CreateSubKey("Software\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION",
                                                              RegistryKeyPermissionCheck.ReadSubTree)

               Dim value As Integer =
                   CInt(subKey.GetValue(String.Format("{0}.exe", processName), 0, RegistryValueOptions.None))

               ' If no browser emulation mode is retrieved from registry, then return default version for WebBrowser control.
               If (value = 0) Then
                   Return IEBrowserEmulationMode.IE7
               End If

               If [Enum].IsDefined(GetType(IEBrowserEmulationMode), value) Then
                   Return DirectCast(value, IEBrowserEmulationMode)

               Else
                   Throw New NotSupportedException(String.Format("Unrecognized browser emulation version: {0}", value))

               End If

           End Using

       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Internet Explorer browser emulation mode for the specified process.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim p As Process = Process.GetCurrentProcess()
       ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
       ''' Dim mode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(p, scope)
       '''
       ''' Console.WriteLine(String.Format("Mode: {0} ({1})", mode, CStr(mode)))
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="p">
       ''' The process.
       ''' </param>
       '''
       ''' <param name="scope">
       ''' The registry scope.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="IEBrowserEmulationMode"/>.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="NotSupportedException">
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Function GetIEBrowserEmulationMode(ByVal p As Process, ByVal scope As RegistryScope) As IEBrowserEmulationMode

           Return AppUtil.GetIEBrowserEmulationMode(p.ProcessName, scope)

       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Sets the Internet Explorer browser emulation mode for the specified process.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim processName As String = Process.GetCurrentProcess().ProcessName
       ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
       ''' Dim oldMode As IEBrowserEmulationMode
       ''' Dim newMode As IEBrowserEmulationMode
       '''
       ''' oldMode = GetIEBrowserEmulationMode(processName, scope)
       ''' SetIEBrowserEmulationMode(processName, scope, IEBrowserEmulationMode.IE11Edge)
       ''' newMode = GetIEBrowserEmulationMode(processName, scope)
       '''
       ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
       ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
       '''
       ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
       ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
       ''' f.Controls.Add(wb)
       ''' f.Show()
       ''' wb.Navigate("http://www.whatversion.net/browser/")
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="processName">
       ''' The process name (eg. 'cmd.exe').
       ''' </param>
       '''
       ''' <param name="scope">
       ''' The registry scope.
       ''' </param>
       '''
       ''' <param name="mode">
       ''' The Internet Explorer browser emulation mode to set.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="NotSupportedException">
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub SetIEBrowserEmulationMode(ByVal processName As String, ByVal scope As RegistryScope, ByVal mode As IEBrowserEmulationMode)

           processName = Path.GetFileNameWithoutExtension(processName)

           Dim currentIEBrowserEmulationMode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(processName, scope)
           If (currentIEBrowserEmulationMode = mode) Then
               Exit Sub
           End If

           Using rootKey As RegistryKey = If(scope = RegistryScope.CurrentUser,
                                             RegistryKey.OpenBaseKey(RegistryHive.CurrentUser, RegistryView.Default),
                                             RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)),
                 regKey As RegistryKey = rootKey.CreateSubKey(
                           "Software\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION",
                           RegistryKeyPermissionCheck.ReadWriteSubTree)

               regKey.SetValue(String.Format("{0}.exe", processName),
                               DirectCast(mode, Integer), RegistryValueKind.DWord)

           End Using

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Sets the Internet Explorer browser emulation mode for the specified process.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim processName As Process = Process.GetCurrentProcess()
       ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
       ''' Dim oldMode As IEBrowserEmulationMode
       ''' Dim newMode As IEBrowserEmulationMode
       '''
       ''' oldMode = GetIEBrowserEmulationMode(p, scope)
       ''' SetIEBrowserEmulationMode(p, scope, IEBrowserEmulationMode.IE11Edge)
       ''' newMode = GetIEBrowserEmulationMode(p, scope)
       '''
       ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
       ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
       '''
       ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
       ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
       ''' f.Controls.Add(wb)
       ''' f.Show()
       ''' wb.Navigate("http://www.whatversion.net/browser/")
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="p">
       ''' The process.
       ''' </param>
       '''
       ''' <param name="scope">
       ''' The registry scope.
       ''' </param>
       '''
       ''' <param name="mode">
       ''' The Internet Explorer browser emulation mode to set.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="NotSupportedException">
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub SetIEBrowserEmulationMode(ByVal p As Process, ByVal scope As RegistryScope, ByVal mode As IEBrowserEmulationMode)

           AppUtil.SetIEBrowserEmulationMode(p.ProcessName, scope, mode)

       End Sub


Ejemplo de uso para obtener, establecer y verificar el modo de emulación del proceso actual:

Código (vbnet) [Seleccionar]

   Dim scope As RegistryScope = RegistryScope.CurrentUser
   Dim oldMode As IEBrowserEmulationMode
   Dim newMode As IEBrowserEmulationMode

   oldMode = BrowserEmulationMode(scope)
   BrowserEmulationMode(scope) = IEBrowserEmulationMode.IE11Edge
   newMode = BrowserEmulationMode(scope)

   Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
   Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))

   Dim f As New Form() With {.Size = New Size(1280, 720)}
   Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
   f.Controls.Add(wb)
   f.Show()
   wb.Navigate("http://www.whatversion.net/browser/")


Ejemplo de uso para obtener, establecer y verificar el modo de emulación de un proceso específico:

Código (vbnet) [Seleccionar]
   Dim processName As String = Process.GetCurrentProcess().ProcessName
   Dim scope As RegistryScope = RegistryScope.CurrentUser
   Dim oldMode As IEBrowserEmulationMode
   Dim newMode As IEBrowserEmulationMode

   oldMode = GetIEBrowserEmulationMode(processName, scope)
   SetIEBrowserEmulationMode(processName, scope, IEBrowserEmulationMode.IE11Edge)
   newMode = GetIEBrowserEmulationMode(processName, scope)

   Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
   Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))

   Dim f As New Form() With {.Size = New Size(1280, 720)}
   Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
   f.Controls.Add(wb)
   f.Show()
   wb.Navigate("http://www.whatversion.net/browser/")


Saludos.