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

[Eleкtro]

¿Cómo obtener las cookies del sitio web activo en una instancia del control WebBrowser?

Esta idea se me ocurrió por la necesidad de loguearme de forma interactiva (me refiero, manualmente mediante un WebBrowser) a un sitio web que tiene captcha y una pregunta aleatoria de seguridad... por lo cual iba a ser costoso o inviable automatizar la obtención de la cookie de la sesión mediante solicitudes POST en background.

Este código no tiene nada de especial, simplemente es una alternativa de uso para en lugar de utilizar la propiedad WebBrowser.Document.Cookie, la cual devuelve un String, con este código podemos obtener directamente una instancia de la clase CookieContainer o CookieCollection.

Este es el código:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Contains custom extension methods to use with <see cref="WebBrowser"/> control.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
<HideModuleName>
Public Module WebBrowserExtensions

#Region " Public Extension Methods "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets a <see cref="CookieContainer"/> containing the stored cookies for the active website
   ''' in the source <see cref="WebBrowser"/>.
   ''' (that is, the active opened document in the <see cref="WebBrowser.Document"/> property).
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Public Class Form1
   '''
   '''     Private uri As New Uri("https://foro.elhacker.net/")
   '''
   '''     Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
   '''         Me.WebBrowser1.ScriptErrorsSuppressed = True
   '''         Me.WebBrowser1.Navigate(uri)
   '''     End Sub
   '''
   '''     Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
   '''
   '''         Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
   '''         If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
   '''             Exit Sub
   '''         End If
   '''
   '''         Dim cookies As CookieContainer = GetCookieContainer(wb)
   '''         For Each cookie As Cookie In cookies.GetCookies(Me.uri)
   '''             Console.WriteLine(cookie.ToString())
   '''         Next cookie
   '''
   '''     End Sub
   '''
   ''' End Class
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="wb">
   ''' The source <see cref="WebBrowser"/>.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting <see cref="CookieContainer"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   <Extension>
   <EditorBrowsable(EditorBrowsableState.Always)>
   Public Function GetCookieContainer(ByVal wb As WebBrowser) As CookieContainer
       Dim uri As Uri = wb.Url
       Dim cookieContainer As New CookieContainer()
       Dim cookies As String() = wb.Document.Cookie.Split({";"c}, StringSplitOptions.None)

       For Each cookie As String In cookies
           Dim name As String = cookie.Substring(0, cookie.IndexOf("="c)).TrimStart(" "c)
           Dim value As String = cookie.Substring(cookie.IndexOf("="c) + 1)
           cookieContainer.Add(uri, New Cookie(name, value, "/", uri.Host))
       Next cookie

       Return cookieContainer
   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets a <see cref="CookieCollection"/> containing the stored cookies for the active website
   ''' in the source <see cref="WebBrowser"/>.
   ''' (that is, the active opened document in the <see cref="WebBrowser.Document"/> property).
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <example> This is a code example.
   ''' <code>
   ''' Public Class Form1
   '''
   '''     Private uri As New Uri("https://foro.elhacker.net/")
   '''
   '''     Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
   '''         Me.WebBrowser1.ScriptErrorsSuppressed = True
   '''         Me.WebBrowser1.Navigate(uri)
   '''     End Sub
   '''
   '''     Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
   '''
   '''         Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
   '''
   '''         If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
   '''             Exit Sub
   '''         End If
   '''
   '''         Dim cookies As CookieCollection = GetCookieCollection(wb)
   '''         For Each cookie As Cookie In cookies
   '''             Console.WriteLine(cookie.ToString())
   '''         Next cookie
   '''
   '''     End Sub
   '''
   ''' End Class
   ''' </code>
   ''' </example>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="wb">
   ''' The source <see cref="WebBrowser"/>.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting <see cref="CookieCollection"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   <Extension>
   <EditorBrowsable(EditorBrowsableState.Always)>
   Public Function GetCookieCollection(ByVal wb As WebBrowser) As CookieCollection

       Dim uri As Uri = wb.Url
       Return Cookies.GetCookieContainer(wb).GetCookies(uri)

   End Function

#End Region

End Module

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

Imports WebBrowserExtensions

Public Class Form1

   Private uri As New Uri("https://www.domain.com/")

   Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
       Me.WebBrowser1.ScriptErrorsSuppressed = True
       Me.WebBrowser1.Navigate(uri)
   End Sub

   Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

       Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
       If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
           Exit Sub
       End If

       Dim cookies As CookieContainer = wb.GetCookieContainer()
       For Each cookie As Cookie In cookies.GetCookies(Me.uri)
           Console.WriteLine(cookie.ToString())
       Next cookie

   End Sub

End Class

[Eleкtro]

¿Cómo imprimir documentos de texto de forma sencilla?.

He hecho dos versiones, una básica, y la otra avanzada.

PrintDocumentBasic

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Prints a text document.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <seealso cref="IDisposable" />
''' ----------------------------------------------------------------------------------------------------
Public Class PrintDocumentBasic : Implements IDisposable

#Region " Private Fields "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' A <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Protected documentStream As StreamReader

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' The <see cref="System.Drawing.Printing.PrintDocument"/> component to print the document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Protected WithEvents PrintDocument As PrintDocument

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' The <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
   ''' information about how a document is printed, including the printer that prints it.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Protected PrinterSettings As PrinterSettings

#End Region

#Region " Properties "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the document file path.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The document file path.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public ReadOnly Property Filepath As String

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the text encoding.
   ''' <para></para>
   ''' If no encoding is specified, the default system encoding will be used.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The text encoding.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property Encoding As Encoding

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the name of the printer device.
   ''' <para></para>
   ''' If no printer name is specified, the default printer device will be used.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The name of the printer device.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property PrinterName As String
       Get
           Return Me.printerNameB
       End Get
       Set(ByVal value As String)
           If Not String.IsNullOrEmpty(value) Then
               Me.PrinterSettings.PrinterName = Me.PrinterName
           Else
               ' Reset the 'PrinterSettings.PrinterName' property to avoid 'PrinterSettings.IsValid' return False.
               Me.PrinterSettings = New PrinterSettings()
           End If
       End Set
   End Property
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' ( Backing Field )
   ''' <para></para>
   ''' The name of the printer device.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Private printerNameB As String

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the text font.
   ''' <para></para>
   ''' Default font is: [Font: Name=Arial, Size=10, Units=3, GdiCharSet=1, GdiVerticalFont=False]
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The text font.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property Font As Font

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the text color.
   ''' <para></para>
   ''' Default color is: <see cref="System.Drawing.Color.Black"/>
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The text color.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property Color As Color

#End Region

#Region " Constructors "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Prevents a default instance of the <see cref="PrintDocumentBasic"/> class from being created.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerNonUserCode>
   Private Sub New()
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Initializes a new instance of the <see cref="PrintDocumentBasic"/> class.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="filepath">
   ''' The document file path.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="FileNotFoundException">
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Sub New(ByVal filepath As String)
       Me.New(filepath, encoding:=Nothing)
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Initializes a new instance of the <see cref="PrintDocumentBasic"/> class.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="filepath">
   ''' The document file path.
   ''' </param>
   '''
   ''' <param name="encoding">
   ''' The text encoding.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="FileNotFoundException">
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Sub New(ByVal filepath As String, ByVal encoding As Encoding)
       Me.PrintDocument = New PrintDocument() With {
           .DocumentName = filepath
       }

       Me.Filepath = filepath
       Me.Color = Color.Black

       Me.PrinterName = ""

       If (encoding Is Nothing) Then
           Me.documentStream = New StreamReader(filepath, detectEncodingFromByteOrderMarks:=True)
           Me.Encoding = Me.documentStream.CurrentEncoding
       Else
           Me.Encoding = encoding
           Me.documentStream = New StreamReader(filepath, encoding, detectEncodingFromByteOrderMarks:=False)
       End If
   End Sub

#End Region

#Region " Public Methods "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Prints the current document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="IOException">
   ''' No printer device is installed.
   ''' </exception>
   '''
   ''' <exception cref="ArgumentException">
   ''' Printer name is not valid.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Overridable Sub Print()

       If (PrinterSettings.InstalledPrinters.Count = 0) Then
           Throw New IOException("No printer device is installed.")
       End If

       If Not String.IsNullOrEmpty(Me.PrinterSettings.PrinterName) AndAlso Not (Me.PrinterSettings.IsValid) Then
           Throw New Exception("Printer name is not valid.")
       End If

       Me.PrintDocument.PrinterSettings = Me.PrinterSettings
       Me.PrintDocument.Print()

   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Cancels the print job for the current document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="Exception">
   ''' Print job not found.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Overridable Sub CancelPrint()

       Dim scope As New ManagementScope("root\CIMV2")
       Dim query As New SelectQuery(String.Format("SELECT * FROM Win32_PrintJob WHERE Document = '{0}'", Me.PrintDocument.DocumentName))
       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()

           If (moc.Count = 0) Then
               Throw New Exception("Print job not found.")
           End If

           For Each mo As ManagementObject In moc
               mo.Delete()
           Next mo

       End Using

   End Sub

#End Region

#Region " Event-Handlers "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event
   ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="sender">
   ''' The source of the event.
   ''' </param>
   '''
   ''' <param name="e">
   ''' The <see cref="PrintEventArgs"/> instance containing the event data.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepperBoundary>
   Protected Overridable Sub PrintDocument_BeginPrint(ByVal sender As Object, ByVal e As PrintEventArgs) Handles PrintDocument.BeginPrint
       If (Me.Font Is Nothing) Then
           Me.Font = New Font("Arial", 10.0F, FontStyle.Regular)
       End If
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.QueryPageSettings"/> event
   ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="sender">
   ''' The source of the event.
   ''' </param>
   '''
   ''' <param name="e">
   ''' The <see cref="QueryPageSettingsEventArgs"/> instance containing the event data.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepperBoundary>
   Protected Overridable Sub PrintDocument_QueryPageSettings(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs) Handles PrintDocument.QueryPageSettings

   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event
   ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="sender">
   ''' The source of the event.
   ''' </param>
   '''
   ''' <param name="e">
   ''' The <see cref="PrintPageEventArgs"/> instance containing the event data.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepperBoundary>
   Protected Overridable Sub PrintDocument_PrintPage(ByVal sender As Object, ByVal e As PrintPageEventArgs) Handles PrintDocument.PrintPage

       ' Page settings.
       Dim brush As New SolidBrush(Me.Color)
       Dim stringFormat As New StringFormat()
       Dim leftMargin As Single = e.MarginBounds.Left
       Dim topMargin As Single = e.MarginBounds.Top

       ' Calculate the number of lines per page.
       Dim linesPerPage As Single = (e.MarginBounds.Height / Me.Font.GetHeight(e.Graphics))

       ' Iterate over the file, printing each line.
       Dim line As String = Nothing
       Dim count As Integer
       While (count < linesPerPage)
           line = Me.documentStream.ReadLine()
           If (line Is Nothing) Then
               Exit While
           End If
           Dim yPos As Single = (topMargin + count * Me.Font.GetHeight(e.Graphics))
           e.Graphics.DrawString(line, Me.Font, brush, leftMargin, yPos, stringFormat)
           count += 1
       End While

       brush.Dispose()
       stringFormat.Dispose()

       ' If more lines exist, print another page.
       e.HasMorePages = (line IsNot Nothing)

   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.EndPrint"/> event
   ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="sender">
   ''' The source of the event.
   ''' </param>
   '''
   ''' <param name="e">
   ''' The <see cref="PrintEventArgs"/> instance containing the event data.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepperBoundary>
   Protected Overridable Sub PrintDocument_EndPrint(ByVal sender As Object, ByVal e As PrintEventArgs) Handles PrintDocument.EndPrint

   End Sub

#End Region

#Region " IDisposable Implementation "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Flag to detect redundant calls when disposing.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Private isDisposed As Boolean = False

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Releases all the resources used by this <see cref="PrintDocumentBasic"/> 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.
   ''' </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 Overridable Sub Dispose(ByVal isDisposing As Boolean)

       If (Not Me.isDisposed) AndAlso (isDisposing) Then
           If (Me.PrintDocument IsNot Nothing) Then
               Me.PrintDocument.Dispose()
               Me.PrintDocument = Nothing
           End If

           If (Me.documentStream IsNot Nothing) Then
               Me.documentStream.Close()
               Me.documentStream = Nothing
           End If

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

       End If

       Me.isDisposed = True

   End Sub

#End Region

End Class

MODO DE EMPLEO:

Código (vbnet) [Seleccionar] Expandir

Using printBasic As New PrintDocumentBasic("C:\Document.txt", Encoding.Default)
   printBasic.PrinterName = ""
   printBasic.Font = New Font("Arial", 10.0F, FontStyle.Regular)
   printBasic.Color = Color.Black

   printBasic.Print()
   ' printBasic.CancelPrint()
End Using



PrintDocumentExpert

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Prints a text document.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <seealso cref="IDisposable" />
''' ----------------------------------------------------------------------------------------------------
Public Class PrintDocumentExpert : Implements IDisposable

#Region " Private Fields "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' The <see cref="System.Drawing.Printing.PrintDocument"/> component to print the document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Protected WithEvents PrintDocument As PrintDocument

#End Region

#Region " Properties "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the document file path.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The document file path.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public ReadOnly Property Filepath As String

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the text encoding.
   ''' <para></para>
   ''' If no encoding is specified, the default system encoding will be used.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The text encoding.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property Encoding As Encoding

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public ReadOnly Property DocumentStream As StreamReader

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
   ''' information about how a document is printed, including the printer that prints it.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
   ''' information about how a document is printed, including the printer that prints it.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property PrinterSettings As PrinterSettings

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property BeginPrintEventHandler As PrintEventHandler

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="System.Drawing.Printing.QueryPageSettingsEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.QueryPageSettings"/> event.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property QueryPageSettingsEventHandler As QueryPageSettingsEventHandler

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="System.Drawing.Printing.PrintPageEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="System.Drawing.Printing.PrintPageEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property PrintPageEventHandler As PrintPageEventHandler

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets the <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
   ''' <see cref="System.Drawing.Printing.PrintDocument.EndPrint"/> event.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   Public Property EndPrintEventHandler As PrintEventHandler

#End Region

#Region " Constructors "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Prevents a default instance of the <see cref="PrintDocumentExpert"/> class from being created.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerNonUserCode>
   Private Sub New()
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Initializes a new instance of the <see cref="PrintDocumentExpert"/> class.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="filepath">
   ''' The document file path.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="FileNotFoundException">
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Sub New(ByVal filepath As String)
       Me.New(filepath, encoding:=Nothing)
   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Initializes a new instance of the <see cref="PrintDocumentExpert"/> class.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="filepath">
   ''' The document file path.
   ''' </param>
   '''
   ''' <param name="encoding">
   ''' The text encoding.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="FileNotFoundException">
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Sub New(ByVal filepath As String, ByVal encoding As Encoding)
       Me.PrintDocument = New PrintDocument() With {
           .DocumentName = filepath
       }

       Me.Filepath = filepath

       If (encoding Is Nothing) Then
           Me.DocumentStream = New StreamReader(filepath, detectEncodingFromByteOrderMarks:=True)
           Me.Encoding = Me.DocumentStream.CurrentEncoding
       Else
           Me.Encoding = encoding
           Me.DocumentStream = New StreamReader(filepath, encoding, detectEncodingFromByteOrderMarks:=False)
       End If
   End Sub

#End Region

#Region " Public Methods "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Prints the current document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="IOException">
   ''' No printer device is installed.
   ''' </exception>
   '''
   ''' <exception cref="Exception">
   ''' Printer name is not valid.
   ''' </exception>
   '''
   ''' <exception cref="Exception">
   ''' The 'PrintDocumentExpert.PrintPageEventHandler' property must be set before calling the 'PrintDocumentExpert.Print()' method.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Overridable Sub Print()

       If (PrinterSettings.InstalledPrinters.Count = 0) Then
           Throw New IOException("No printer device is installed.")
       End If

       If Not String.IsNullOrEmpty(Me.PrinterSettings.PrinterName) AndAlso Not (Me.PrinterSettings.IsValid) Then
           Throw New Exception("Printer name is not valid.")
       End If

       If (Me.PrintPageEventHandler Is Nothing) Then
           Throw New Exception("The 'PrintDocumentExpert.PrintPageEventHandler' property must be set before calling the 'PrintDocumentExpert.Print()' method.")
       End If

       AddHandler Me.PrintDocument.BeginPrint, Me.BeginPrintEventHandler
       AddHandler Me.PrintDocument.QueryPageSettings, Me.QueryPageSettingsEventHandler
       AddHandler Me.PrintDocument.PrintPage, Me.PrintPageEventHandler
       AddHandler Me.PrintDocument.EndPrint, Me.EndPrintEventHandler

       Me.PrintDocument.PrinterSettings = Me.PrinterSettings
       Me.PrintDocument.Print()

       RemoveHandler Me.PrintDocument.BeginPrint, Me.BeginPrintEventHandler
       RemoveHandler Me.PrintDocument.QueryPageSettings, Me.QueryPageSettingsEventHandler
       RemoveHandler Me.PrintDocument.PrintPage, Me.PrintPageEventHandler
       RemoveHandler Me.PrintDocument.EndPrint, Me.EndPrintEventHandler

   End Sub

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Cancels the print job for the current document.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <exception cref="Exception">
   ''' Print job not found.
   ''' </exception>
   ''' ----------------------------------------------------------------------------------------------------
   <DebuggerStepThrough>
   Public Overridable Sub CancelPrint()

       Dim scope As New ManagementScope("root\CIMV2")
       Dim query As New SelectQuery(String.Format("SELECT * FROM Win32_PrintJob WHERE Document = '{0}'", Me.PrintDocument.DocumentName))
       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()

           If (moc.Count = 0) Then
               Throw New Exception("Print job not found.")
           End If

           For Each mo As ManagementObject In moc
               mo.Delete()
           Next mo

       End Using

   End Sub

#End Region

#Region " IDisposable Implementation "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Flag to detect redundant calls when disposing.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Private isDisposed As Boolean = False

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Releases all the resources used by this <see cref="PrintDocumentBasic"/> 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.
   ''' </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 Overridable Sub Dispose(ByVal isDisposing As Boolean)

       If (Not Me.isDisposed) AndAlso (isDisposing) Then

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

           If (Me.DocumentStream IsNot Nothing) Then
               Me.DocumentStream.Close()
           End If

       End If

       Me.isDisposed = True

   End Sub

#End Region

End Class

MODO DE EMPLEO:

Código (vbnet) [Seleccionar] Expandir

Public Module Module1

   Private printExpert As PrintDocumentExpert

   Public Sub Main()

       printExpert = New PrintDocumentExpert("C:\Document.txt", Encoding.Default)

       Using printExpert
           printExpert.PrinterSettings = New PrinterSettings With {
                   .PrinterName = "My Printer Name"
               }

           printExpert.BeginPrintEventHandler = AddressOf PrintDocument_BeginPrint
           printExpert.QueryPageSettingsEventHandler = AddressOf PrintDocument_QueryPageSettings
           printExpert.PrintPageEventHandler = AddressOf PrintDocument_PrintPage
           printExpert.EndPrintEventHandler = AddressOf PrintDocument_EndPrint

           printExpert.Print()
       End Using

   End Sub

   Public Sub PrintDocument_BeginPrint(ByVal sender As Object, ByVal e As PrintEventArgs)
   End Sub

   Public Sub PrintDocument_QueryPageSettings(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs)
   End Sub

   Public Sub PrintDocument_PrintPage(ByVal sender As Object, ByVal e As PrintPageEventArgs)
       ' Page settings.
       Dim font As New Font("Arial", 10.0F, FontStyle.Regular)
       Dim brush As New SolidBrush(Color.Green)
       Dim stringFormat As New StringFormat()
       Dim leftMargin As Single = e.MarginBounds.Left
       Dim topMargin As Single = e.MarginBounds.Top

       ' Calculate the number of lines per page.
       Dim linesPerPage As Single = (e.MarginBounds.Height / font.GetHeight(e.Graphics))

       ' Iterate over the file, printing each line.
       Dim line As String = Nothing
       Dim count As Integer
       While (count < linesPerPage)
           line = printExpert.DocumentStream.ReadLine()
           If (line Is Nothing) Then
               Exit While
           End If
           Dim yPos As Single = (topMargin + count * font.GetHeight(e.Graphics))
           e.Graphics.DrawString(line, font, brush, leftMargin, yPos, stringFormat)
           count += 1
       End While

       font.Dispose()
       brush.Dispose()
       stringFormat.Dispose()

       ' If more lines exist, print another page.
       e.HasMorePages = (line IsNot Nothing)
   End Sub

   Public Sub PrintDocument_EndPrint(ByVal sender As Object, ByVal e As PrintEventArgs)
   End Sub

End Module

MODO DE EMPLEO ALTERNATIVO:

Código (vbnet) [Seleccionar] Expandir

Public Sub Main()

   Dim printExpert As PrintDocumentExpert = Nothing

   Dim beginPrintEventHandler As PrintEventHandler =
       Sub(ByVal sender As Object, ByVal e As PrintEventArgs)
       End Sub

   Dim queryPageSettingsEventHandler As QueryPageSettingsEventHandler =
       Sub(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs)
       End Sub

   Dim printPageEventHandler As PrintPageEventHandler =
   Sub(ByVal sender As Object, ByVal e As PrintPageEventArgs)
       ' Page settings.
       Dim font As New Font("Arial", 10.0F, FontStyle.Regular)
       Dim brush As New SolidBrush(Color.Green)
       Dim stringFormat As New StringFormat()
       Dim leftMargin As Single = e.MarginBounds.Left
       Dim topMargin As Single = e.MarginBounds.Top

       ' Calculate the number of lines per page.
       Dim linesPerPage As Single = (e.MarginBounds.Height / font.GetHeight(e.Graphics))

       ' Iterate over the file, printing each line.
       Dim line As String = Nothing
       Dim count As Integer
       While (count < linesPerPage)
           line = printExpert.DocumentStream.ReadLine()
           If (line Is Nothing) Then
               Exit While
           End If
           Dim yPos As Single = (topMargin + count * font.GetHeight(e.Graphics))
           e.Graphics.DrawString(line, font, brush, leftMargin, yPos, stringFormat)
           count += 1
       End While

       font.Dispose()
       brush.Dispose()
       stringFormat.Dispose()

       ' If more lines exist, print another page.
       e.HasMorePages = (line IsNot Nothing)
   End Sub

   Dim endPrintEventHandler As PrintEventHandler =
       Sub(ByVal sender As Object, ByVal e As PrintEventArgs)
       End Sub

   printExpert = New PrintDocumentExpert("C:\Document.txt", Encoding.Default)
   Using printExpert
       printExpert.PrinterSettings = New PrinterSettings With {
           .PrinterName = "My Printer Name"
       }

       printExpert.BeginPrintEventHandler = beginPrintEventHandler
       printExpert.QueryPageSettingsEventHandler = queryPageSettingsEventHandler
       printExpert.PrintPageEventHandler = printPageEventHandler
       printExpert.EndPrintEventHandler = endPrintEventHandler

       printExpert.Print()
   End Using

End Sub

[Eleкtro]

¿Cómo determinar el porcentaje de escala de grises (a.k.a Grayscale ) en una imagen?

El siguiente algoritmo sirve para determinar el porcentaje de presencia de escala de grises en una imagen, y con ese pocertaje el programador puede tener la libertad de considerar si la imagen es en escala de grises o no lo es; por ejemplo si una imagen de 256x256px de compone de un 80% de píxeles con color en escala de grises (es decir ROJO = VERDE = AZUL), quizás queramos tratar ese tipo de imagen como una imagen en escala de grises, aunque solo lo sea parcialmente.

La necesidad de usar esta metodología basada en porcentajes tiene un buen motivo, y es que cualquier imagen desaturada probablemente la querramos considerar como una imagen en escala de grises, aunque por definición no lo sea, como por ejemplo estas imagenes de aquí abajo las cuales NO son en escala de grises (la paleta entera de colores)...





son imágenes desaturadas pero probablemente ese tipo de imágenes las querramos considerar como escala de grises en muchos escenarios para diferenciarlas del resto de imágenes...¿verdad?, es por ello que este tipo de metodología me pareció más útil y versatil para necesidades generales, aunque obviamente es un procedmiento más lento que otros al tener que analizar pixel por pixel para calcular un porcentaje de presencia de píxeles en escala de grises...

En fin, aquí abajo os dejo el código, pero debo avisar de que todavía NO está del todo acabado ni perfeccionado, me falta refactorizarlo y arreglar algunas pequeñas cosas, como por ejemplo aumentar la compatibilidad de formatos, analizar los píxeles del padding del stride ( https://msdn.microsoft.com/en-us/library/windows/desktop/aa473780(v=vs.85).aspx ), y tener en cuenta imágenes GIF con múltiples dimensiones (que no frames). Pero por el momento este código es algo que funciona bien para obtener los resultados esperados dentro de un margen de error aceptable, así que es una solución más que suficiente para los escenarios más simples y comunes.

EDITO: código mejorado

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Analyzes each pixel of the spcified image, counts all the pixels that are within the grayscale RGB range,
''' then calculates a percentage of the total grayscale presence in the image.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)
'''
'''     Using img As Image = Image.FromFile(file.FullName)
'''         Dim percent As Double = GetGrayScalePixelPercentOfImage(img)
'''         Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)
'''
'''         Console.WriteLine(strFormat)
'''     End Using
'''
''' Next file
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="img">
''' The source image.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting percentage of grayscale pixels in the source image.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetGrayScalePixelPercentOfImage(ByVal img As Image) As Double
   Return GetGrayScalePixelPercentOfImage(img, dimensionIndex:=0)
End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Analyzes each pixel of the spcified image, counts all the pixels that are within the grayscale RGB range,
''' then calculates a percentage of the total grayscale presence in the image.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)
'''
'''     Using img As Image = Image.FromFile(file.FullName)
'''         Dim percent As Double = GetGrayScalePixelPercentOfImage(img, dimensionIndex:=0)
'''         Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)
'''
'''         Console.WriteLine(strFormat)
'''     End Using
'''
''' Next file
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="img">
''' The source image.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting percentage of grayscale pixels in the source image.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetGrayScalePixelPercentOfImage(ByVal img As Image, ByVal dimensionIndex As Integer) As Double

   Select Case img.PixelFormat

       Case Imaging.PixelFormat.Format16bppGrayScale
           Return 100.0R

       Case Else
           Dim bmp As Bitmap = DirectCast(img, Bitmap)

           Dim pixelFormat As Imaging.PixelFormat = Imaging.PixelFormat.Format32bppArgb
           Dim bytesPerPixel As Integer = 4 ' PixelFormat.Format32bppArgb
           Dim pixelCount As Integer = (bmp.Width * bmp.Height)

           Dim framesGrayscalePercents As New List(Of Double)

           Dim dimensionCount As Integer = bmp.FrameDimensionsList.Count
           If (dimensionIndex > (dimensionCount - 1))Then
               Throw New IndexOutOfRangeException("The specified 'dimensionIndex' value is greater than the dimension count in the source image.")
           End If

           Dim frameDimension As New FrameDimension(bmp.FrameDimensionsList(dimensionIndex))
           Dim frameCount As Integer = bmp.GetFrameCount(frameDimension)

           For frameIndex As Integer = 0 To (frameCount - 1)

               bmp.SelectActiveFrame(frameDimension, frameIndex)

               ' Lock the bitmap bits.
               Dim rect As New Rectangle(Point.Empty, bmp.Size)
               Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, pixelFormat)

               ' Get the address of the first row.
               Dim address As IntPtr = bmpData.Scan0

               ' Declare an array to hold the bytes of the bitmap.
               Dim numBytes As Integer = (Math.Abs(bmpData.Stride) * rect.Height)
               Dim rawImageData As Byte() = New Byte(numBytes - 1) {}

               ' Copy the RGB values into the array.
               Marshal.Copy(address, rawImageData, 0, numBytes)

               ' Unlock the bitmap bits.
               bmp.UnlockBits(bmpData)

               ' Iterate the pixels.
               Dim grayscalePixelCount As Long ' of current frame.
               For i As Integer = 0 To (rawImageData.Length - bytesPerPixel) Step bytesPerPixel

                   ' Dim alpha As Byte = rawImageData(i + 3)
                   Dim red As Byte = rawImageData(i + 2)
                   Dim green As Byte = rawImageData(i + 1)
                   Dim blue As Byte = rawImageData(i)

                   If (red = green) AndAlso (green = blue) AndAlso (blue = red) Then
                       grayscalePixelCount += 1
                   End If

               Next i

               Dim frameGrayscalePercent As Double = ((grayscalePixelCount / pixelCount) * 100)
               framesGrayscalePercents.Add(frameGrayscalePercent)

               grayscalePixelCount = 0
           Next frameIndex

           Return (framesGrayscalePercents.Sum() / frameCount)

   End Select

End Function

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)

   Using img As Image = Image.FromFile(file.FullName)
       Dim percent As Double = GetGrayScalePixelPercentOfImage(img)
       Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)

       Console.WriteLine(strFormat)
   End Using

Next file

Salida de ejecución:

Código [Seleccionar] Expandir

...
[100.00%]: 3066279034_22e5cf9106_o.gif
[  0.00%]: 32.gif
[  3.30%]: 3680650203a3998289_f47a.gif
[  8.11%]: 3Gg9L8.gif
[100.00%]: 3mp3z4riv4.gif
[  1.14%]: 4291d5bb0f6574cdd24dfbf8962f2f28-p1.gif
[  2.22%]: 4e3149ff0114b_af0234434ffb9e48ce1edc3af6ce1a2c.gif
[ 13.42%]: 4e4d24314abf8_d4acae20ee9fe20f019927b098a8e8e6.gif
[ 28.13%]: 4e7b20c8d03fc_e93059b97d764b1681534f714c318ba7.gif
[  4.43%]: 4e92c46d124de_aa5135da3b32b8eee8a80aa2a2550f5d.gif
[  0.68%]: 5055.gif
[100.00%]: 506c602fd749e_a2c439e67bf77d03ba94a914d8927f4a.gif
[100.00%]: 511d0b2580b20_abd567e0d431dd00bb7bc162eb4d171c.gif
[  2.34%]: 520374123e3d3_285a501b39852024a053090a304647ca.gif
[  2.74%]: 543ea44def8f2_a3e09112b3710ce306ddf167991604e1.gif
...

¿Cómo determinar si una imagen está en escala de grises?

Si buscan una solución más sofisticada que la mia hecha en WinForms, recomiendo encarecidamente usar este código en WPF:

• StackOverflow.com: How to determine if an Image is Grayscale in C# or VB.NET?

Su solución y la mia tienen distintos objetivos aunque a priori parezcan "lo mismo", su solución tiene como propósito determinar si una imagen es en escala de grises por definición, mientras que la mia lo que hace es determinar el porcentaje de presencia de píxeles en escala de grises de una imagen, y por ello su solución devolverá resultados "inesperados" según el tipo de imagen (imagen en blanco y negro, en colores vivos, escala de grises, o simples imagenes desaturadas), pero eso no quita que su solución sea EXCELENTE, de hecho, es mucho mejor que mi solución en el caso de que no deseamos considerar imágenes desaturadas como escala de grises sino que solo queramos trabajar con imágenes en escala de grises por definición técnica.

Saludos!

[Eleкtro]

Comparto el código fuente de FHM Crawler, mejorado y documentado... (bueno, me he visto obligado a simplificar y recortar la documentación por el límite de caracteres del foro)

Aquí el programa original:

• https://foro.elhacker.net/net/sourcecode_fhm_crawler_freehardmusiccom-t482152.0.html

Aquí el nuevo algoritmo reutilizable:

AlbumInfo.vb

Código (vbnet) [Seleccionar] Expandir

#Region " Imports "

Imports System.Collections.ObjectModel

#End Region

Namespace FHM

   ''' <summary>Represents the information of an album crawled with <see cref="FHM.Crawler"/>.</summary>
   Public NotInheritable Class AlbumInfo

#Region " Properties "

       ''' <summary>Gets the album identifier (that is used in the 'sobiid' and 'sobi2id' parameters).</summary>
       Public ReadOnly Property Id As String

       ''' <summary>Gets the album <see cref="Uri"/>.</summary>
       Public ReadOnly Property Uri As Uri

       ''' <summary>Gets the artist name.</summary>
       Public ReadOnly Property Artist As String

       ''' <summary>Gets the album title.</summary>
       Public ReadOnly Property Title As String

       ''' <summary>Gets the country of the band/artist.</summary>
       Public ReadOnly Property Country As String

       ''' <summary>Gets the music genre.</summary>
       Public ReadOnly Property Genre As String

       ''' <summary>Gets the year that the album has been released.</summary>
       Public ReadOnly Property Year As Integer

       ''' <summary>Gets the urls to download the album. It can be a single url, or multiple of them.</summary>
       Public ReadOnly Property DownloadLinks As ReadOnlyCollection(Of String)

#End Region

#Region " Constructors "

       Private Sub New()
       End Sub

       ''' <summary>Initializes a new instance of the <see cref="AlbumInfo"/> class.</summary>
       ''' <param name="id">The album identifier>.</param>
       ''' <param name="uri">The album <see cref="Uri"/>.</param>
       ''' <param name="artist">The artist name.</param>
       ''' <param name="title">The album title.</param>
       ''' <param name="country">The country of the band/artist.</param>
       ''' <param name="genre">The music genre.</param>
       ''' <param name="year">The year that the album has been released.</param>
       ''' <param name="downloadLinks">The urls to download the album. It can be a single url, or multiple of them.</param>
       Public Sub New(id As String, uri As Uri,
                      artist As String, title As String,
                      country As String, genre As String, year As Integer,
                      downloadLinks As IEnumerable(Of String))

           Me.Id = id
           Me.Uri = uri
           Me.Artist = artist
           Me.Title = title
           Me.Country = country
           Me.Genre = genre
           Me.Year = year
           Me.DownloadLinks = New ReadOnlyCollection(Of String)(downloadLinks)

       End Sub

#End Region

   End Class

End Namespace

SearchQuery.vb

Código (vbnet) [Seleccionar] Expandir


#Region " Imports "

Imports System.Collections.Specialized

Imports ElektroKit.Core.Extensions.NameValueCollection

#End Region

Namespace FHM

   ''' <summary>Represents a search query of the http://freehardmusic.com/ website,
   ''' that is managed by the <see cref="FHM.Crawler.FetchAlbums()"/>
   ''' and <see cref="FHM.Crawler.FetchAlbumsAsync()"/> methods.
   ''' <para></para>
   ''' Note that a search query can be performed in two different ways:
   ''' <para></para>
   ''' 1. An artist-name based search (<see cref="SearchQuery.Artist"/>).
   ''' <para></para>
   ''' 2. A non-artist name based search. That is, a custom search based on country (<see cref="SearchQuery.Country"/>),
   ''' genre (<see cref="SearchQuery.Genre"/>) or year criterias (<see cref="SearchQuery.Year"/>);
   ''' this kind of search can combine the three mentioned criterias, but not the artist name (<see cref="SearchQuery.Artist"/>).
   Public NotInheritable Class SearchQuery

#Region " Properties "

       ''' <summary>Gets or sets the artist name.</summary>
       Public Property Artist As String
           Get
               Return Me.artistB
           End Get
           <DebuggerStepThrough>
           Set(value As String)
               If Not (Me.countryB.Equals("all", StringComparison.OrdinalIgnoreCase)) OrElse
                  Not (Me.genreB.Equals("all", StringComparison.OrdinalIgnoreCase)) OrElse
                  Not (Me.yearB.Equals("all", StringComparison.OrdinalIgnoreCase)) Then

                   Throw New ArgumentException("To perform an artist-name based search, you must set the value of Country, Genre and Year properties to ""all"" before setting the Artist property.", paramName:=NameOf(value))
               End If
               Me.artistB = value
           End Set
       End Property
       Private artistB As String

       ''' <summary>Gets or sets the country of the band/artist.</summary>
       Public Property Country As String
           Get
               Return Me.countryB
           End Get
           <DebuggerStepThrough>
           Set(value As String)
               If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
                   Throw New ArgumentException("To perform a country based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
               End If
               Me.countryB = value
           End Set
       End Property
       Private countryB As String

       ''' <summary>Gets or sets the music genre.</summary>
       Public Property Genre As String
           Get
               Return Me.genreB
           End Get
           <DebuggerStepThrough>
           Set(value As String)
               If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
                   Throw New ArgumentException("To perform a genre based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
               End If
               Me.genreB = value
           End Set
       End Property
       Private genreB As String

       ''' <summary>Gets or sets the year that the album has been released.</summary>
       Public Property Year As String
           Get
               Return Me.yearB
           End Get
           <DebuggerStepThrough>
           Set(value As String)
               If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
                   Throw New ArgumentException("To perform a year based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
               End If
               Me.yearB = value
           End Set
       End Property
       Private yearB As String

       ''' <summary>Gets the <see cref="Uri"/> that represents this search query.</summary>
       Public ReadOnly Property Uri As Uri
           Get
               Return Me.Uri(searchPage:=0)
           End Get
       End Property

       ''' <summary>Gets the <see cref="Uri"/> that represents this search query.</summary>
       ''' <param name="searchPage">The index of the search page parameter.</param>
       Public ReadOnly Property Uri(searchPage As Integer) As Uri
           Get
               Return New Uri(Me.ToString(searchPage), UriKind.Absolute)
           End Get
       End Property

#End Region

#Region " Constructors "

       Private Sub New()
       End Sub

       ''' <summary>Initializes a new instance of the <see cref="SearchQuery"/> class.</summary>
       ''' <param name="artist">The artist name.</param>
       Public Sub New(artist As String)
           Me.artistB = artist
           Me.genreB = "all"
           Me.countryB = "all"
           Me.yearB = "all"
       End Sub

       ''' <summary>Initializes a new instance of the <see cref="SearchQuery"/> class.</summary>
       ''' <param name="genre">The music genre. Default value is: "all"</param>
       ''' <param name="country">The country of the band/artist. Default value is: "all"</param>
       ''' <param name="year">The year that the album has been released. Default value is: "all"</param>
       Public Sub New(Optional genre As String = "all",
                      Optional country As String = "all",
                      Optional year As String = "all")

           Me.artistB = ""
           Me.genreB = genre
           Me.countryB = country
           Me.yearB = year
       End Sub

#End Region

#Region " Public Methods "

       ''' <summary>Resets the current search query to its default values.</summary>
       <DebuggerStepThrough>
       Public Sub Reset()
           Me.Artist = ""
           Me.Country = "all"
           Me.Genre = "all"
           Me.Year = "all"
       End Sub

       ''' <summary>Returns a <see cref="String"/> that represents the search query.</summary>
       ''' <returns>A <see cref="String"/> that represents the search query.</returns>
       Public Overrides Function ToString() As String
           Return Me.ToString(searchPage:=0)
       End Function

       ''' <summary>Returns a <see cref="String"/> that represents the search query.</summary>
       ''' <param name="searchPage">The index of the search page parameter.</param>
       ''' <returns>A <see cref="String"/> that represents the search query.</returns>
       Public Overloads Function ToString(searchPage As Integer) As String

           If (searchPage < 0) Then
               Throw New ArgumentException("Positive integer value is required.", paramName:=NameOf(searchPage))
           End If

           Dim params As New NameValueCollection From {
               {"field_band", Me.Artist},
               {"field_country", Me.Country},
               {"field_genre", Me.Genre},
               {"field_year", Me.Year},
               {"option", "com_sobi2"},
               {"search", "Search"},
               {"searchphrase", "exact"},
               {"sobi2Search", ""},
               {"sobi2Task", "axSearch"},
               {"SobiCatSelected_0", "0"},
               {"sobiCid", "0"},
               {"SobiSearchPage", searchPage}
           }

           Return params.ToQueryString(New Uri("http://freehardmusic.com/index.php"))

       End Function

#End Region

   End Class

End Namespace

PageCrawlBeginEventArgs.vb

Código (vbnet) [Seleccionar] Expandir


Namespace FHM

   ''' <summary>Represents the event data of the <see cref="FHM.Crawler.PageCrawlBegin"/> event.</summary>
   Public NotInheritable Class PageCrawlBeginEventArgs : Inherits EventArgs

#Region " Properties "

       ''' <summary>Gets the search query used.</summary>
       Public ReadOnly Property SearchQuery As SearchQuery

       ''' <summary>Gets the index of the search page being crawled.</summary>
       Public ReadOnly Property SearchPage As Integer

#End Region

#Region " Constructors "

       Private Sub New()
       End Sub

       ''' <summary>Initializes a new instance of the <see cref="PageCrawlBeginEventArgs"/> class.</summary>
       ''' <param name="searchQuery">The search query used.</param>
       ''' <param name="searchPage">The index of the search page.</param>
       Public Sub New(searchQuery As SearchQuery, searchPage As Integer)
           Me.SearchQuery = searchQuery
           Me.SearchPage = searchPage
       End Sub

#End Region

   End Class

End Namespace

PageCrawlEndEventArgs.vb

Código (vbnet) [Seleccionar] Expandir


Namespace FHM

   ''' <summary>Represents the event data of the <see cref="FHM.Crawler.PageCrawlEnd"/> event.</summary>
   Public NotInheritable Class PageCrawlEndEventArgs : Inherits EventArgs

#Region " Properties "

       ''' <summary>Gets the search query used.</summary>
       Public ReadOnly Property SearchQuery As SearchQuery

       ''' <summary>Gets the index of the search page crawled.</summary>
       Public ReadOnly Property SearchPage As Integer

       ''' <summary>Gets a collection of <see cref="AlbumInfo"/> that contains the information of the albums that were crawled.</summary>
       Public ReadOnly Property Albums As ReadOnlyCollection(Of AlbumInfo)

#End Region

#Region " Constructors "

       Private Sub New()
       End Sub

       ''' <summary>Initializes a new instance of the <see cref="PageCrawlEndEventArgs"/> class.</summary>
       ''' <param name="searchQuery">The search query used.</param>
       ''' <param name="searchPage">The index of the search page crawled.</param>
       ''' <param name="albums">A collection of <see cref="AlbumInfo"/> that contains the information of the albums that were crawled.</param>
       Public Sub New(searchQuery As SearchQuery, searchPage As Integer, albums As ICollection(Of AlbumInfo))
           Me.SearchQuery = searchQuery
           Me.SearchPage = searchPage
           Me.Albums = New ReadOnlyCollection(Of AlbumInfo)(albums)
       End Sub

#End Region

   End Class

End Namespace

Crawler.vb

Código (vbnet) [Seleccionar] Expandir

#Region " Imports "

Imports System.Collections.Specialized
Imports System.Text.RegularExpressions

Imports HtmlDocument = HtmlAgilityPack.HtmlDocument
Imports HtmlNode = HtmlAgilityPack.HtmlNode
Imports HtmlNodeCollection = HtmlAgilityPack.HtmlNodeCollection

Imports ElektroKit.Core.Extensions.NameValueCollection

#End Region

Namespace FHM

   ''' <summary>A crawler that searchs and collect albums (its download links) from the http://freehardmusic.com/ website.</summary>
   Public Class Crawler : Implements IDisposable

#Region " Private Fields "

       ''' <summary>The <see cref="Uri"/> that points to "http://freehardmusic.com/".</summary>
       Protected ReadOnly uriBase As New Uri("http://freehardmusic.com/")

       ''' <summary>The <see cref="Uri"/> that points to "http://freehardmusic.com/index2.php".</summary>
       Protected ReadOnly uriIndex As New Uri(Me.uriBase, "/index2.php")

       ''' <summary>Flag that determines whether this <see cref="Crawler"/> is busy in a pending fetch operation.</summary>
       Protected isFetching As Boolean

       ''' <summary>The <see cref="CancellationToken"/> instance that cancels a pending fetch operation
       ''' started by a call of <see cref="Crawler.FetchAlbumsAsync()"/>.</summary>
       Protected cancelToken As CancellationToken

       ''' <summary>The <see cref="CancellationTokenSource"/> instance that signals to <see cref="Crawler.cancelToken"/>.</summary>
       Protected cancelTokenSrc As CancellationTokenSource

#End Region

#Region " Properties "

       ''' <summary>Gets the search query.</summary>
       Public ReadOnly Property SearchQuery As SearchQuery

#End Region

#Region " Events "

       ''' <summary>Occurs when a page is about to be crawled.</summary>
       Public Event PageCrawlBegin As EventHandler(Of PageCrawlBeginEventArgs)

       ''' <summary>Occurs when a page is crawled.</summary>
       Public Event PageCrawlEnd As EventHandler(Of PageCrawlEndEventArgs)

#End Region

#Region " Constructors "

       ''' <summary>Initializes a new instance of the <see cref="Crawler"/> class.</summary>
       Public Sub New()
           Me.SearchQuery = New SearchQuery()
           Me.cancelTokenSrc = New CancellationTokenSource()
           Me.cancelToken = Me.cancelTokenSrc.Token
       End Sub

#End Region

#Region " Public Methods "

       ''' <summary>Gets the count of the albums found using the current search query.</summary>
       ''' <returns>The count of the albums found using the current search query.</returns>
       <DebuggerStepThrough>
       Public Overridable Function GetAlbumCount() As Integer
           Dim t As Task(Of Integer) = Task.Run(Of Integer)(AddressOf Me.GetAlbumCountAsync)
           t.Wait()

           Return t.Result
       End Function

       ''' <summary>Asynchronously gets the count of the albums found using the current search query.</summary>
       ''' <returns>The count of the albums found using the current search query.</returns>
       <DebuggerStepThrough>
       Public Overridable Async Function GetAlbumCountAsync() As Task(Of Integer)
           Dim query As String = Me.SearchQuery.ToString(searchPage:=0)
           Dim uriSearch As New Uri(query)
           Dim htmlSourceCode As String = String.Empty
           Using wc As New WebClient
               htmlSourceCode = Await wc.DownloadStringTaskAsync(uriSearch)
           End Using

           Dim htmldoc As New HtmlDocument
           htmldoc.LoadHtml(htmlSourceCode)

           Dim xPathResultString As String = "//div[@id='mainbody']/table[1]/tr[2]/td"

           Dim node As HtmlNode = htmldoc.DocumentNode.SelectSingleNode(xPathResultString)

           Dim text As String = node.InnerText
           text = Regex.Replace(text, "\n", "", RegexOptions.None)    ' Remove new lines.
           text = Regex.Replace(text, "\t", " "c, RegexOptions.None)  ' Replace tabs for white-spaces.
           text = Regex.Replace(text, "\s+", " "c, RegexOptions.None) ' Replace duplicated white-spaces.

           Dim albumCount As Integer = CInt(Regex.Match(text, "\d+", RegexOptions.None).Value)
           Return albumCount
       End Function

       ''' <summary>Fetch any album found using the current search query.</summary>
       <DebuggerStepThrough>
       Public Overridable Sub FetchAlbums()
           Dim t As Task = Task.Run(AddressOf Me.FetchAlbumsAsync)
           t.Wait()
       End Sub

       ''' <summary>Asynchronously fetch any album found using the current search query.</summary>
       ''' <returns>Returns <see langword="False"/> if the fetch operation was canceled by a call to
       ''' <see cref="Crawler.CancelFetchAlbumsAsync()"/> method.</returns>
       <DebuggerStepThrough>
       Public Overridable Async Function FetchAlbumsAsync() As Task(Of Boolean)
           If (Me.isFetching) Then
               Throw New Exception("Another fetch operation is already running in background.")
           End If
           Me.isFetching = True

           Me.cancelTokenSrc.Dispose()
           Me.cancelTokenSrc = New CancellationTokenSource()
           Me.cancelToken = Me.cancelTokenSrc.Token

           Dim albumCount As Integer = Await Me.GetAlbumCountAsync()
           If (albumCount = 0) Then
               Me.isFetching = False
               Return True
           End If

           Dim maxPages As Integer = ((albumCount \ 10) + 1) ' 10 albums per page.
           For i As Integer = 0 To (maxPages - 1)
               Dim query As String = Me.SearchQuery.ToString(searchPage:=i)
               Dim uriSearch As New Uri(query)
               Dim htmlSourceCode As String = String.Empty
               Using wc As New WebClient
                   htmlSourceCode = Await wc.DownloadStringTaskAsync(uriSearch)
               End Using

               If (Me.cancelToken.IsCancellationRequested) Then
                   Me.isFetching = False
                   Return False
               End If

               Me.OnPageCrawlBegin(New PageCrawlBeginEventArgs(Me.SearchQuery, i))
               Await Me.ParseHtmlSourceCode(i, htmlSourceCode)
           Next i

           Me.isFetching = False
           Return True
       End Function

       ''' <summary>Aborts a pending fetch operation started by a call to <see cref="Crawler.FetchAlbumsAsync()"/> function.</summary>
       <DebuggerStepThrough>
       Public Sub CancelFetchAlbumsAsync()
           If Not (Me.isFetching) Then
               Throw New Exception("No fetch operation is running.")
           End If

           If (Me.cancelToken.IsCancellationRequested) Then
               ' Handle redundant cancellation calls to CancelFetchAlbums()...
               Me.cancelToken.ThrowIfCancellationRequested()
           End If

           Me.cancelTokenSrc.Cancel()
       End Sub

       ''' <summary>Resets the current search query (<see cref="Crawler.SearchQuery"/>) to its default values.</summary>
       <DebuggerStepThrough>
       Public Sub ResetSearchQuery()
           Me.SearchQuery.Reset()
       End Sub

#End Region

#Region " Event-Invocators "

       ''' <summary>Raises the <see cref="Crawler.PageCrawlBegin"/> event.</summary>
       ''' <param name="e">The <see cref="PageCrawlBeginEventArgs"/> instance containing the event data.</param>
       Protected Overridable Sub OnPageCrawlBegin(e As PageCrawlBeginEventArgs)
           If (Me.PageCrawlBeginEvent IsNot Nothing) Then
               RaiseEvent PageCrawlBegin(Me, e)
           End If
       End Sub

       ''' <summary>Raises the <see cref="Crawler.PageCrawlEnd"/> event.</summary>
       ''' <param name="e">The <see cref="PageCrawlBeginEventArgs"/> instance containing the event data.</param>
       Protected Overridable Sub OnPageCrawlEnd(e As PageCrawlEndEventArgs)
           If (Me.PageCrawlEndEvent IsNot Nothing) Then
               RaiseEvent PageCrawlEnd(Me, e)
           End If
       End Sub

#End Region

#Region " Private Methods "

       ''' <summary>Parses the html source code to crawl the albums.</summary>
       ''' <param name="searchPage">The index of the search page.</param>
       ''' <param name="htmlSourceCode">The html source code to parse.</param>
       ''' <returns>Returns <see langword="True"/> if the operation succed; otherwise, <see langword="False"/>.</returns>
       <DebuggerStepperBoundary>
       Private Async Function ParseHtmlSourceCode(searchPage As Integer, htmlSourceCode As String) As Task(Of Boolean)

           Dim albums As New Collection(Of AlbumInfo)

           Dim xPathTable As String = "//table[@class='vicard']"
           Dim xPathArtist As String = ".//tr/td/span[@class='sobi2Listing_field_band']"
           Dim xPathCountry As String = ".//table[@class='vicard2']/tr/td[@class='goods']/table[@class='goods']/tr/td/img"
           Dim xPathGenre As String = ".//tr[3]/td/table/tr/td[2]/table/tr/td"
           Dim xPathYear As String = ".//tr/td/span[@class='sobi2Listing_field_year']"
           Dim xPathTitle As String = ".//tr/td/p[@class='sobi2ItemTitle']/a[@title]"
           Dim xPathUrl As String = ".//table[@class='vicard2']/tr/td/a[@href]"

           Dim htmldoc As New HtmlDocument
           Try
             htmldoc.LoadHtml(htmlSourceCode)
           Catch ex As Exception
               Return False
           End Try

           Dim nodes As HtmlNodeCollection = htmldoc.DocumentNode.SelectNodes(xPathTable)
           If (nodes.Count = 0) Then
               Return False
           End If

           For Each node As HtmlNode In nodes
               Dim artist As String
               Dim title As String
               Dim country As String
               Dim genre As String
               Dim year As String

               Dim albumId As String
               Dim albumUrl As String

               Try
                   artist = node.SelectSingleNode(xPathArtist).InnerText
                   artist = Encoding.UTF8.GetString(Encoding.Default.GetBytes(artist))
                   artist = HttpUtility.HtmlDecode(artist)
                   artist = New CultureInfo("en-US").TextInfo.ToTitleCase(artist.Trim(" "c).ToLower())
               Catch ex As Exception
                   artist = "unknown"
               End Try

               Try
                   title = node.SelectSingleNode(xPathTitle).GetAttributeValue("title", "")
                   title = Encoding.UTF8.GetString(Encoding.Default.GetBytes(title))
                   title = HttpUtility.HtmlDecode(title)
                   title = New CultureInfo("en-US").TextInfo.ToTitleCase(title.Trim(" "c).ToLower())
               Catch ex As Exception
                   title = "unknown"
               End Try

               Try
                   country = node.SelectSingleNode(xPathCountry).GetAttributeValue("src", "unknown")
                   country = Path.GetFileNameWithoutExtension(country)
                   country = New CultureInfo("en-US").TextInfo.ToTitleCase(country.ToLower())
               Catch ex As Exception
                   country = "unknown"
               End Try

               Try
                   genre = node.SelectSingleNode(xPathGenre).InnerText
                   genre = Regex.Replace(genre, "\n", "", RegexOptions.None)    ' Remove new lines.
                   genre = Regex.Replace(genre, "\t", " "c, RegexOptions.None)  ' Replace tabs for white-spaces.
                   genre = Regex.Replace(genre, "\s+", " "c, RegexOptions.None) ' Replace duplicated white-spaces.
                   genre = New CultureInfo("en-US").TextInfo.ToTitleCase(genre.Trim(" "c).ToLower())
               Catch ex As Exception
                   genre = "unknown"
               End Try

               Try
                   year = node.SelectSingleNode(xPathYear).InnerText.Trim(" "c)
               Catch ex As Exception
                   year = "unknown"
               End Try

               Try
                   albumUrl = node.SelectSingleNode(xPathUrl).GetAttributeValue("href", "").Trim(" "c)
                   albumUrl = HttpUtility.HtmlDecode(albumUrl)
               Catch ex As Exception
                   Continue For
               End Try

               albumId = HttpUtility.ParseQueryString(New Uri(albumUrl).Query)("sobi2Id")

               Dim downloadUrlParams As New NameValueCollection From {
                   {"sobiid", albumId},
                   {"sobi2Task", "addSRev"},
                   {"no_html", "1"},
                   {"option", "com_sobi2"},
                   {"rvote", "1"}
               }

               Dim downloadLinks As List(Of String)
               Try
                   Using wc As New WebClient()
                       htmlSourceCode = Await wc.DownloadStringTaskAsync(New Uri(downloadUrlParams.ToQueryString(Me.uriIndex)))
                   End Using

                   Dim xDoc As XDocument = XDocument.Parse(htmlSourceCode)
                   Dim elements As IEnumerable(Of XElement) = xDoc.<rev>
                   downloadLinks = New List(Of String) From {
                       elements.<msg>.Value,
                       elements.<msg2>.Value,
                       elements.<msg3>.Value,
                       elements.<msg4>.Value,
                       elements.<msg5>.Value,
                       elements.<msg6>.Value,
                       elements.<msg7>.Value,
                       elements.<msg8>.Value,
                       elements.<msg9>.Value,
                       elements.<msg10>.Value,
                       elements.<msg11>.Value,
                       elements.<msg12>.Value,
                       elements.<msg13>.Value
                   }
               Catch ex As Exception
                   Continue For
               End Try

               downloadLinks = (From item As String In downloadLinks
                                Where Not String.IsNullOrWhiteSpace(item)
                                Select item.TrimEnd(" "c)
                               ).ToList()

               Dim albumInfo As New AlbumInfo(albumId, New Uri(albumUrl, UriKind.Absolute),
                                              artist, title, country, genre, year,
                                              downloadLinks)

               albums.Add(albumInfo)
           Next node

           Me.OnPageCrawlEnd(New PageCrawlEndEventArgs(Me.SearchQuery, searchPage, albums))
           Return True
       End Function

#End Region

#Region " IDisposable Implementation "

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

       ''' <summary>Releases all the resources used by this <see cref="Crawler"/>.</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.</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 Overridable Sub Dispose(isDisposing As Boolean)
           If (Not Me.isDisposed) AndAlso (isDisposing) Then
               If (Me.cancelTokenSrc IsNot Nothing) Then
                   Me.cancelTokenSrc.Dispose()
                   Me.cancelTokenSrc = Nothing
               End If
               Me.cancelToken = Nothing
               Me.isFetching = False
               Me.ResetSearchQuery()
           End If

           Me.isDisposed = True
       End Sub

#End Region

   End Class

End Namespace

NameValueCollectionExtensions.vb

• https://pastebin.com/kUWBFzgB

[Eleкtro]

Ejemplo de uso del FHM Crawler que compartí en este otro post: https://foro.elhacker.net/net/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2158878#msg2158878

Código (vbnet) [Seleccionar] Expandir

Imports FHM

Public Module Module1

   Private WithEvents FHMCrawler As New Crawler
   Private mre As New ManualResetEvent(initialState:=False)

   Public Sub Main()
       FHMCrawler.SearchQuery.Artist = "Paramore"

       Console.WriteLine("URL: {0}", FHMCrawler.SearchQuery.ToString())
       Console.WriteLine()
       Console.WriteLine("Retrieving Album count...")
       Dim albumCount As Integer = FHMCrawler.GetAlbumCount()
       Console.WriteLine("Album Count: {0}", albumCount)
       Console.WriteLine()
       Console.WriteLine("Begin crawling, please wait...")
       Fetch()
       mre.WaitOne()
       Console.WriteLine("Done!. Press any key to exit...")
       Console.ReadKey()
   End Sub

   Public Async Sub Fetch()
       Dim success As Boolean = Await FHMCrawler.FetchAlbumsAsync()
       mre.Set()
   End Sub

   <DebuggerStepperBoundary>
   Private Sub FHMCrawler_BeginPageCrawl(ByVal sender As Object, e As PageCrawlBeginEventArgs) Handles FHMCrawler.PageCrawlBegin
       Console.WriteLine("[+] Begin crawling page with index: {0}", e.SearchPage)
       Console.WriteLine()
   End Sub

   <DebuggerStepperBoundary>
   Private Sub FHMCrawler_EndPageCrawl(ByVal sender As Object, e As PageCrawlEndEventArgs) Handles FHMCrawler.PageCrawlEnd
       For Each albumInfo As AlbumInfo In e.Albums
           Dim sb As New StringBuilder()
           sb.AppendLine(String.Format("Artist Name.....: {0}", albumInfo.Artist))
           sb.AppendLine(String.Format("Album Title.....: {0}", albumInfo.Title))
           sb.AppendLine(String.Format("Album Year......: {0}", albumInfo.Year))
           sb.AppendLine(String.Format("Album Country...: {0}", albumInfo.Country))
           sb.AppendLine(String.Format("Album Genre.....: {0}", albumInfo.Genre))
           sb.AppendLine(String.Format("Album Id........: {0}", albumInfo.Id))
           sb.AppendLine(String.Format("Album Url.......: {0}", albumInfo.Uri.AbsoluteUri))
           sb.AppendLine(String.Format("Download Link(s): {0}", String.Format("{{ {0} }}", String.Join(", ", albumInfo.DownloadLinks))))
           Console.WriteLine(sb.ToString())
       Next albumInfo
       Console.WriteLine("[+] End crawling page with index: {0}", e.SearchPage)
       Console.WriteLine()
   End Sub

End Module

Output:

URL: http://freehardmusic.com/index.php?field_band=Paramore&field_country=all&field_genre=all&field_year=all&option=com_sobi2&search=Search&searchphrase=exact&sobi2Search=&sobi2Task=axSearch&SobiCatSelected_0=0&sobiCid=0&SobiSearchPage=0

Retrieving Album count...
Album Count: 13

Begin crawling, please wait...

• Begin crawling page with index: 0
  
  Artist Name.....: Paramore
  Album Title.....: After Laughter
  Album Year......: 2017
  Album Country...: Unitedstates
  Album Genre.....: Pop Rock
  Album Id........: 750762
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=750762
  Download Link(s): { https://mega.nz/#!cL5DjAyT!yUxVz9-L_E5qLgsUnlrQyu2TTkBjHFy3Qo4rthK6wso }
  
  Artist Name.....: Paramore
  Album Title.....: Ignorance (Single)
  Album Year......: 2009
  Album Country...: Unitedstates
  Album Genre.....: Female Vocal, Punk-Rock
  Album Id........: 706939
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706939
  Download Link(s): { http://www.mediafire.com/file/z4blihr29e08o9v/P_I-Single+14-12-16.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Decode (Single)
  Album Year......: 2008
  Album Country...: Unitedstates
  Album Genre.....: Emo, Punk-Rock
  Album Id........: 706938
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706938
  Download Link(s): { http://www.mediafire.com/file/flmfffs94s6coc7/P_D-Single+14-12-16.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Misery Business Ep
  Album Year......: 2007
  Album Country...: Unitedstates
  Album Genre.....: Emo, Female Vocal, Punk-Rock
  Album Id........: 706937
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706937
  Download Link(s): { http://www.mediafire.com/file/rbn99qf5vcypzmb/P_MB-EP+14-12-16.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Hallelujah Ep
  Album Year......: 2007
  Album Country...: Unitedstates
  Album Genre.....: Emo, Female Vocal, Punk-Rock
  Album Id........: 706936
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706936
  Download Link(s): { http://www.mediafire.com/file/vzmjxy7dzbvz0wu/P_H-EP+14-12-16.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Acoustic Ep [Unnoficial]
  Album Year......: 2008
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 679494
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=679494
  Download Link(s): { https://yadi.sk/d/t3uohja1iGahE }
  
  Artist Name.....: Paramore
  Album Title.....: The Summer Tic [Ep]
  Album Year......: 2006
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 679493
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=679493
  Download Link(s): { https://yadi.sk/d/hfBw4_6SiGZpz }
  
  Artist Name.....: Paramore
  Album Title.....: The Final Riot!
  Album Year......: 2008
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669959
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669959
  Download Link(s): { http://www.mediafire.com/download/9agyx5hwzha6qsi/PTFR.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Brand New Eyes
  Album Year......: 2009
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669957
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669957
  Download Link(s): { http://www.mediafire.com/download/2151e2bj7qtjaki/PBNE.rar }
  
  Artist Name.....: Paramore
  Album Title.....: The Singles Club Ep
  Album Year......: 2011
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669955
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669955
  Download Link(s): { http://www.mediafire.com/download/b6q2c7nyxdca00n/PSC.rar }
  
  
• End crawling page with index: 0
  
  
• Begin crawling page with index: 1
  
  Artist Name.....: Paramore
  Album Title.....: Pararmore
  Album Year......: 2013
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669953
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669953
  Download Link(s): { http://www.mediafire.com/download/y11109qmik6icj4/PP.rar }
  
  Artist Name.....: Paramore
  Album Title.....: Riot!
  Album Year......: 2007
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669949
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669949
  Download Link(s): { http://www.mediafire.com/download/dyc03s9vokkogv7/PR.rar }
  
  Artist Name.....: Paramore
  Album Title.....: All We Know Is Falling
  Album Year......: 2005
  Album Country...: Unitedstates
  Album Genre.....: Power Pop, Pop Rock, Punk-Rock
  Album Id........: 669948
  Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669948
  Download Link(s): { http://www.mediafire.com/download/nsbiuigwij7y5tf/PAWKIF.rar }
  
  
• End crawling page with index: 1
  
  Done!. Press any key to exit...[/font]
  

Otro output addicional:

Código [Seleccionar] Expandir

Search Params: field_band=h%c3%a9roes+del+silencio&field_country=all&field_genre=all&field_year=all

Uri: http://freehardmusic.com/index.php?field_band=h%C3%A9roes+del+silencio&field_country=all&field_genre=all&field_year=all&option=com_sobi2&search=Search&searchphrase=exact&sobi2Search=&sobi2Task=axSearch&SobiCatSelected_0=0&sobiCid=0&SobiSearchPage=0

Retrieving Album count...
Album Count: 21

Begin crawling, please wait...
[+] Begin crawling page with index: 0

Artist Name.....: Héroes Del Silencio
Album Title.....: The Platinum Collection (Compilation)
Album Year......: 2006
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770138
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770138
Download Link(s): { https://mega.nz/#!5yAE0ZpA!IFhADBkkKHgEN4Gghum-h9iKbQlH6N3owXymDokmF4Q }

Artist Name.....: Héroes Del Silencio
Album Title.....: Tesoro - Concert In Valencia 27Th October 2007 (Video)
Album Year......: 2008
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770135
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770135
Download Link(s): { https://mega.nz/#!834HAAiY!S7NDexqPxuPU6nEVv9PriekUi3MN3O2oBCtrTd2Nx8Y }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senda '91 (Live)
Album Year......: 1991
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770129
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770129
Download Link(s): { https://mega.nz/#!8uAC1DIS!tctPPSySY6I2v7kteAahx6iKlDVs8R5WnrWvXUBtqaM }

Artist Name.....: Héroes Del Silencio
Album Title.....: En Directo
Album Year......: 1989
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770127
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770127
Download Link(s): { https://mega.nz/#!wnJwmYpD!XIFosoFfCar5UTAAjgORH0QHW8jm5ELRqZGK4UTNMfU }

Artist Name.....: Héroes Del Silencio
Album Title.....: Héroes Del Silencio (Compilation)
Album Year......: 1999
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770126
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770126
Download Link(s): { https://mega.nz/#!47R2jKqD!WmwbU3DvhVoBcZvf2IMPMATpAC_woGtKiBo_YzTp3eo }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senderos De Traición (25Th Anniversary Edition)
Album Year......: 2015
Album Country...: Spain
Album Genre.....: Rock And Roll
Album Id........: 703496
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=703496
Download Link(s): { https://www.mediafire.com/?gwyzc4pvvhjdiax }

Artist Name.....: Héroes Del Silencio
Album Title.....: Volveremos (Compilation)
Album Year......: 2016
Album Country...: Spain
Album Genre.....: Rock And Roll
Album Id........: 703259
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=703259
Download Link(s): { http://www.mediafire.com/file/sh9pr3uvb86my6b/703259.rar }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Espíritu Del Vino (20Th Anniversary Edition)
Album Year......: 2012
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700503
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700503
Download Link(s): { https://mega.nz/#!lgESxaJb!5K3YpWZ1Znq5EhZij9ltPd1GLaTaH_dSePXm5pCN6dg }

Artist Name.....: Héroes Del Silencio
Album Title.....: Antología Audiovisual (Compilation)
Album Year......: 2004
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700490
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700490
Download Link(s): { https://mega.nz/#!w8FUDQhb!COgXmh-uPayeSk5k1mpHrdIy5VziIIvTO7iaW0MfmTM }

Artist Name.....: Héroes Del Silencio
Album Title.....: Entre Dos Tierras (Ep)
Album Year......: 1992
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700488
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700488
Download Link(s): { https://mega.nz/#!7V1H3T4L!1q_o2lLp-b6Ky2p7P_minriRplYwUc8WRdSi7K24aes }

[+] End crawling page with index: 0

[+] Begin crawling page with index: 1

Artist Name.....: Héroes Del Silencio
Album Title.....: Héroes Del Silencio (Ep)
Album Year......: 1986
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700487
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700487
Download Link(s): { https://mega.nz/#!GNkTyZwA!0EXRDQwIpyG5BoVoY5zCnkonnAe3ZzFJmD4hwfmi-og, https://mega.nz/#!ljZ13RRK!u36qptAkX9XJN2LNKKZYTk25o-6kC4vgp1TXZ5wDRyo }

Artist Name.....: Heroés Del Silencio
Album Title.....: Live In Germany (Live)
Album Year......: 2011
Album Country...: Spain
Album Genre.....: Pop Rock, Alternative Rock
Album Id........: 691258
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=691258
Download Link(s): { https://mega.nz/#!84oxmBgB!q1x4NuAd79OUAyp4X7O5Da0b0KFwWwOoFNKqGGFQHW8 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Canciones '84 - '96 (Compilation)
Album Year......: 2000
Album Country...: Spain
Album Genre.....: Classic Rock
Album Id........: 675749
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=675749
Download Link(s): { https://mega.nz/#!8uI0iBBD!3SFYXCJRse5ijwmC9TLgTtfhL8Jr__t3-qSI7IPurSI }

Artist Name.....: Héroes Del Silencio
Album Title.....: Tour 2007 (Live)
Album Year......: 2007
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 639726
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639726
Download Link(s): { https://mega.co.nz/#!t81VUIxT!Y5qEQUR5C8wIA69pH4w90DWRCxN8dcKsCVSFmCT46P8 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Rarezas (Compilation)
Album Year......: 1998
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 639724
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639724
Download Link(s): { http://www.mediafire.com/download/v6oyrrh7un9o8t0/HDS98-R.gif, https://mega.co.nz/#!pgUlFC5Y!M3KOBFXZb5ZoN1TD-KRHOhl1mzIwm5WoQjqtsbncevk }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Ruido Y La Furia (Live)
Album Year......: 2005
Album Country...: Spain
Album Genre.....: Rock And Roll, Hard Rock
Album Id........: 639723
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639723
Download Link(s): { https://mega.co.nz/#!N1tgEIhA!FhSGL1xaktCN1HphZuOJFn5EmRhetkfS8bUpAB47KCY }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Mar No Cesa
Album Year......: 1988
Album Country...: Spain
Album Genre.....: Pop Rock
Album Id........: 46543
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=46543
Download Link(s): { http://www.mediafire.com/?no7d4y5vp2btna6 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Para Siempre (Live)
Album Year......: 1996
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 43036
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=43036
Download Link(s): { http://www.mediafire.com/?q73ip21df7qb19d }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senderos De Traición
Album Year......: 1990
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37296
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37296
Download Link(s): { https://mega.co.nz/#!ok0UQIrB!bfQdCTtlLd4Rh7MIptTvfnPFDI9oBEd-ZvotzILoCFw }

Artist Name.....: Héroes Del Silencio
Album Title.....: Avalancha
Album Year......: 1995
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37292
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37292
Download Link(s): { https://mega.nz/#!Fc4zEaia!-5LYB3ueWHoZB890f34zsW_aTUTrsFQAwIvbpcZH4as }

[+] End crawling page with index: 1

[+] Begin crawling page with index: 2

Artist Name.....: Héroes Del Silencio
Album Title.....: El Espíritu Del Vino
Album Year......: 1993
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37253
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37253
Download Link(s): { https://mega.nz/#!0ZxC2LiJ!D1Rl95lm9sgz9RGxEPSmGSrW8ZvzVH5VckbDOJ81GnA }

[+] End crawling page with index: 2

Done!. Press any key to exit...


[Eleкtro]

Obtener un valor aleatorio de tipo Single (float en C#), Double o Decimal dentro de un rango mínimo y máximo específico.



He implementado esta solución mediante un módulo de extensiones de método para la clase System.Random

La lista de miembros disponibles son los siguientes:

• Random.NextSingle() As Single
• Random.NextSingle(Single) As Single
• Random.NextSingle(Single, Single) As Single
• Random.NextDouble(Double) As Double
• Random.NextDouble(Double, Double) As Double
• Random.NextDecimal() As Decimal
• Random.NextDecimal(Decimal) As Decimal
• Random.NextDecimal(Decimal, Decimal) As Decimal

El código fuente:

Código (vbnet) [Seleccionar] Expandir

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports System.ComponentModel
Imports System.Runtime.CompilerServices

#End Region

#Region " Random Extensions "

Namespace Extensions

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Contains custom extension methods to use with the <see cref="Random"/> type.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   <ImmutableObject(True)>
   <HideModuleName>
   Public Module RandomExtensions

#Region " Public Extension Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Single"/> value.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Single"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextSingle(ByVal sender As Random) As Single
           Return CSng(sender.NextDouble())
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Single"/> value between zero and the maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Single"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextSingle(ByVal sender As Random, ByVal maxValue As Single) As Single
           Return NextSingle(sender, 0.0F, maxValue)
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Single"/> value between the minimum and maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="minValue">
       ''' The minimum value.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Single"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextSingle(ByVal sender As Random, ByVal minValue As Single, ByVal maxValue As Single) As Single
           Return NextSingle(sender) * (maxValue - minValue) + minValue
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Double"/> value between zero and the maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Double"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextDouble(ByVal sender As Random, ByVal maxValue As Double) As Double
           Return NextDouble(sender, 0.0R, maxValue)
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Double"/> value between the minimum and maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="minValue">
       ''' The minimum value.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Double"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextDouble(ByVal sender As Random, ByVal minValue As Double, ByVal maxValue As Double) As Double
           Return sender.NextDouble() * (maxValue - minValue) + minValue
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Decimal"/> value.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Decimal"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextDecimal(ByVal sender As Random) As Decimal
           Return NextDecimal(sender, Decimal.MaxValue)
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Decimal"/> value between zero and the maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Decimal"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextDecimal(ByVal sender As Random, ByVal maxValue As Decimal) As Decimal
           Return NextDecimal(sender, Decimal.Zero, maxValue)
       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Returns a non-negative <see cref="Decimal"/> value between the minimum and maximum specified.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="sender">
       ''' The source <see cref="Random"/>.
       ''' </param>
       '''
       ''' <param name="minValue">
       ''' The minimum value.
       ''' </param>
       '''
       ''' <param name="maxValue">
       ''' The maximum value.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Decimal"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       <Extension>
        <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function NextDecimal(ByVal sender As Random, ByVal minValue As Decimal, ByVal maxValue As Decimal) As Decimal
           Dim nextSample As Decimal = NextDecimalSample(sender)
           Return maxValue * nextSample + minValue * (1 - nextSample)
       End Function

#End Region

#Region " Private Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Provides a random <see cref="Decimal"/> value
       ''' in the range: [0.0000000000000000000000000000, 0.9999999999999999999999999999)
       ''' with (theoretical) uniform and discrete distribution.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://stackoverflow.com/a/28860710/1248295"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="rng">
       ''' The source <see cref="Random"/>.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting <see cref="Decimal"/> value.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
        <DebuggerStepperBoundary>
       Private Function NextDecimalSample(ByVal rng As Random) As Decimal
           Dim sample As Decimal = 1D
           ' After ~200 million tries this never took more than one attempt
           ' but it Is possible To generate combinations Of a, b, and c
           ' With the approach below resulting In a sample >= 1.
           Do While (sample >= 1D)
               Dim a As Integer = rng.Next(0, Integer.MaxValue)
               Dim b As Integer = rng.Next(0, Integer.MaxValue)
               Dim c As Integer = rng.Next(542101087) ' The high bits of 0.9999999999999999999999999999m are 542101086.
               sample = New Decimal(a, b, c, False, 28)
           Loop
           Return sample
       End Function

#End Region

   End Module

End Namespace

#End Region

[Eleкtro]

¿Cómo obtener las contraseñas de Google Chrome?

En relación a este post: https://foro.elhacker.net/dudas_generales/leer_cookies_de_chrome_y_su_valor-t482292.0.html;msg2159271#msg2159271 - he decidido desarrollar este algoritmo para recuperar contraseñas de Google Chrome. La recuperación tiene limitaciones en escenarios específicos debido a la naturaleza del tipo de cifrado; si quieren saber más acerca de eso, lean el post en el enlace que he compartido arriba.

Para poder utilizar este código, deben añadir una referencia a la librería System.Security.dll, y System.Data.SQLite.dll: https://system.data.sqlite.org/index.html/doc/trunk/www/downloads.wiki

Código (vbnet) [Seleccionar] Expandir

Imports System
Imports System.Collections.Generic
Imports System.Data
Imports System.Data.SQLite
Imports System.IO
Imports System.Net
Imports System.Security.Cryptography
Imports System.Text

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets the Google Chrome logins stored for the current user.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim loginsFile As New FileInfo("C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data")
''' Dim logins As IEnumerable(Of NetworkCredential) =
'''     From login As NetworkCredential In
'''         GetGoogleChromeLogins(loginsFile, "_NULL_", "_NULL_", "_UNDECRYPTABLE_")
'''     Order By login.Domain Ascending
'''
''' For Each login As NetworkCredential In logins
'''     Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
''' Next login
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="loginDataFile">
''' The "Logins Data" file that stores the user logins.
''' <para></para>
''' This file is typically located at: 'C:\Users\{USERNAME}\AppData\Local\Google\Chrome\User Data\Default'.
''' </param>
'''
''' <param name="defaultIfUsernameEmpty">
''' A default value to assign for an empty username.
''' </param>
'''
''' <param name="defaultIfPasswordEmpty">
''' A default value to assign for an empty password.
''' </param>
'''
''' <param name="defaultIfPasswordUndecryptable">
''' A default value to assign for a undecryptable password.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="IEnumerable(Of NetworkCredential)"/> containing the user logins.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Public Shared Function GetGoogleChromeLogins(ByVal loginDataFile As FileInfo,
                                            Optional ByVal defaultIfUsernameEmpty As String = "",
                                            Optional ByVal defaultIfPasswordEmpty As String = "",
                                            Optional ByVal defaultIfPasswordUndecryptable As String = ""
                                            ) As IEnumerable(Of NetworkCredential)

   Return GetGoogleChromeLogins(loginDataFile.FullName, defaultIfUsernameEmpty, defaultIfPasswordEmpty, defaultIfPasswordUndecryptable)

End Function

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets the Google Chrome logins stored for the current user.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim loginDataPath As String = "C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data"
''' Dim logins As IEnumerable(Of NetworkCredential) =
'''     From login As NetworkCredential In
'''         GetGoogleChromeLogins(loginDataPath, "_NULL_", "_NULL_", "_UNDECRYPTABLE_")
'''     Order By login.Domain Ascending
'''
''' For Each login As NetworkCredential In logins
'''     Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
''' Next login
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="loginDataPath">
''' The full path to "Logins Data" file that stores the user logins.
''' <para></para>
''' This file is typically located at: 'C:\Users\{USERNAME}\AppData\Local\Google\Chrome\User Data\Default'.
''' </param>
'''
''' <param name="defaultIfUsernameEmpty">
''' A default value to assign for an empty username.
''' </param>
'''
''' <param name="defaultIfPasswordEmpty">
''' A default value to assign for an empty password.
''' </param>
'''
''' <param name="defaultIfPasswordUndecryptable">
''' A default value to assign for a undecryptable password.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="IEnumerable(Of NetworkCredential)"/> containing the user logins.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Public Shared Iterator Function GetGoogleChromeLogins(ByVal loginDataPath As String,
                                                     Optional ByVal defaultIfUsernameEmpty As String = "",
                                                     Optional ByVal defaultIfPasswordEmpty As String = "",
                                                     Optional ByVal defaultIfPasswordUndecryptable As String = ""
                                                     ) As IEnumerable(Of NetworkCredential)

   Dim sqlConnectionString As String = String.Format("data source={0};New=True;UseUTF16Encoding=True", loginDataPath)
   Dim sqlCommandText As String = "SELECT origin_url, username_value, password_value FROM 'logins'"
   Dim textEncoding As New UTF8Encoding(encoderShouldEmitUTF8Identifier:=True)

   Using dt As New DataTable(),
       sqlConnection As New SQLiteConnection(sqlConnectionString),
       sqlCommand As New SQLiteCommand(sqlCommandText, sqlConnection),
       sqlAdapter As New SQLiteDataAdapter(sqlCommand)
       sqlAdapter.Fill(dt)

       For Each row As DataRow In dt.Rows
           Dim domain As String = row("origin_url")

           Dim userName As String = row("username_value")
           If String.IsNullOrEmpty(userName) Then
               userName = defaultIfUsernameEmpty
           End If

           Dim passwordEncrypted As Byte() = DirectCast(row("password_value"), Byte())
           Dim passwordDecrypted As Byte()
           Dim passwordString As String = String.Empty

           Try
               passwordDecrypted = ProtectedData.Unprotect(passwordEncrypted, Nothing, DataProtectionScope.CurrentUser)
               passwordString = textEncoding.GetString(passwordDecrypted)

           Catch ex As CryptographicException When (ex.HResult = -2146893813) ' Key not valid for use in specified state.
               ' This means the current user can't decrypt the encrypted data,
               ' because the encryption key was derived using a different user credential.
               passwordString = defaultIfPasswordUndecryptable

           Catch ex As Exception
               Throw

           Finally
               If String.IsNullOrEmpty(passwordString) Then
                   passwordString = defaultIfPasswordEmpty
               End If

           End Try

           Yield New NetworkCredential(userName, passwordString, domain)
       Next row

   End Using

End Function

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

Dim loginDataPath As String = "C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data"
Dim logins As IEnumerable(Of NetworkCredential) =
   From login As NetworkCredential In
       GetGoogleChromeLogins(loginDataPath, "", "", "_UNDECRYPTABLE_")
   Order By login.Domain Ascending

For Each login As NetworkCredential In logins
   Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
Next login

Ejemplo de salida del programa... ya se lo pueden imaginar:

chrome://wmn/accounts/gmail; UserName; Password
chrome://wmn/accounts/hotmail; UserName; Password
http://foro.elhacker.net/; UserName; Password
http://forum.doom9.org/; UserName; Password
http://forum.soundarea.org/; UserName; Password
http://forums.nvidia.com/; UserName; Password
...

Saludos!.

[Eleкtro]

¿Cómo interoperar entre el sistema operativo huésped de una máquina virtual de VMWare, y el sistema operativo anfitrión?.

Me encargaron un trabajo que consistia en diseñar una GUI para monitorizar máquinas virtuales de VMWare y realizar ciertas cosas dentro de cada sistema operativo huésped, y... bueno, aunque ni por asomo tenía la obligación de currármelo tanto como vereis a continuacion, pero ya sabeis que siempre que me gusta una idea intento implementarla de forma sofisticada (dentro de mis capacidades) y reutilizable para el futuro, me gusta hacer las cosas lo mejor posible (repito, dentro de mis capacidades), y esto es lo que acabé haciendo...

Este sistema o implementación depende del programa command-line vmrun.exe de VMWare, de otra forma sería practicamente inviable hacer esto ya sea en .NET o en un lenguaje de bajo nivel sin pasar meses o años de dedicación en el estudio e investigación; vmrun nos facilitará por completo la tarea de identificar las máquinas virtuales de VMWare que están en ejecución en el sistema operativo anfitrión, y realizar operaciones de I/O en las mismas, como copiar archivos del S.O. anfitrión al huésped o viceversa, enviar pulsaciones del teclado (o mejor dicho enviar cadenas de texto), o ejecutar programas y scripts, tomar capturas de pantalla, o administrar las carpetas compartidas y las imágenes (snapshots) de la VM, entre otras cosas. Implementé casi todas las funcionalidades de vmrun.

Como único inconveniente debo aclarar que este sistema no soporta máquinas virtuales compartidas (esas que podemos colocar en el directorio del usuario público como recurso compartido de red), y esta limitación es simplemente por pura ignorancia, ya que no he logrado averiguar la sintaxis correcta de vmrun para indicarle que el host es LOCALHOST, siempre que lo intento (ej. vmrun.exe -T ws-shared -h LOCALHOST ... ) el programa me dice que no ha logrado conectar con el servidor xD, así que si alguien sabe cual es la sintaxis le agradecería que me lo dijese para poder adaptar y mejorar este código.

Aquí lo tenen todo:

GuestOsCredential.vb

Código (vbnet) [Seleccionar] Expandir

''' <summary>
''' Represents the username/password login data for the running guest operating system of a VMWare's virtual machine.
''' </summary>
Public NotInheritable Class GuestOsCredential

#Region " Properties "

   ''' <summary>
   ''' Gets or sets the account username.
   ''' </summary>
   Public Property Username As String

   ''' <summary>
   ''' Gets or sets the account password.
   ''' </summary>
   Public Property Password As String

#End Region

#Region " Constructors "

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

#End Region

End Class

VmRunProgramFlags.vb

Código (vbnet) [Seleccionar] Expandir

''' <summary>
''' Specifies the behavior of a program that is executed by VMWare's vmrun.exe application.
''' </summary>
<Flags>
Public Enum VmRunProgramFlags

   ''' <summary>
   ''' Run the program using the default behavior.
   ''' </summary>
   None = 1

   ''' <summary>
   ''' Returns a prompt immediately after the program starts in the guest operating system, rather than waiting for it to finish.
   ''' <para></para>
   ''' This option is useful for interactive programs.
   ''' </summary>
   NoWait = 2

   ''' <summary>
   ''' Ensures that the program window is visible, not minimized, in the guest operating system.
   ''' <para></para>
   ''' This option has no effect on Linux.
   ''' </summary>
   ActiveWindow = 4

   ''' <summary>
   ''' Forces interactive guest login.
   ''' <para></para>
   ''' This option is useful for Windows VISTA guests to make the program visible in he console window.
   ''' </summary>
   Interactive = 8

End Enum

VmRunException.vb

Código (vbnet) [Seleccionar] Expandir

''' <summary>
''' The exception that Is thrown When a call to VMWare's vmrun.exe application exits with an error.
''' </summary>
<Serializable>
<XmlRoot(NameOf(VmRunException))>
<ImmutableObject(True)>
Public NotInheritable Class VmRunException : Inherits Exception

#Region " Properties "

   ''' <summary>
   ''' Gets the exit code of VMWare's vmrun.exe application.
   ''' </summary>
   Public ReadOnly Property ExitCode As Integer

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Prevents a default instance of the <see cref="VmRunException"/> class from being created.
   ''' </summary>
   Private Sub New()
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the System.Exception class with a specified error message.
   ''' </summary>
   ''' <param name="message">
   ''' The message that describes the error.
   ''' </param>
   <DebuggerNonUserCode>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Private Sub New(ByVal message As String)
       MyBase.New(message)
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the System.Exception class with a specified error message
   ''' and a reference to the inner exception that is the cause of this exception.
   ''' </summary>
   ''' <param name="message">
   ''' The message that describes the error.
   ''' </param>
   '''
   ''' <param name="innerException">
   ''' The exception that is the cause of the current exception,
   ''' or <see langword="Nothing"/> if no inner exception is specified.
   ''' </param>
   <DebuggerNonUserCode>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Private Sub New(ByVal message As String, ByVal innerException As Exception)
       MyBase.New(message, innerException)
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the System.Exception class with a specified error message and exit code.
   ''' </summary>
   ''' <param name="message">
   ''' The error message thrown by VMWare's vmrun.exe application.
   ''' </param>
   '''
   ''' <param name="exitCode">
   ''' The exit code of VMWare's vmrun.exe application
   ''' </param>
   Public Sub New(ByVal message As String, ByVal exitCode As Integer)
       MyBase.New(message)
       Me.ExitCode = exitCode
   End Sub

#End Region

End Class

VmSharedFolderInfo.vb

Código (vbnet) [Seleccionar] Expandir

''' <summary>
''' Represents a shared folder of a VMWare's virtual machine.
''' </summary>
Public NotInheritable Class VmSharedFolderInfo

#Region " Properties "

   ''' <summary>
   ''' Gets or sets the share name.
   ''' </summary>
   Public Property Name As String

   ''' <summary>
   ''' Gets or sets the shared directory on host operating system.
   ''' </summary>
   Public Property HostDirectory As DirectoryInfo

   ''' <summary>
   ''' Gets or sets a value that determine whether this shared folder is enabled.
   ''' </summary>
   Public Property Enabled As Boolean

   ''' <summary>
   ''' Gets or sets a value that determine whether this shared folder allows read access.
   ''' </summary>
   Public Property ReadAccess As Boolean

   ''' <summary>
   ''' Gets or sets a value that determine whether this shared folder allows write access.
   ''' </summary>
   Public Property WriteAccess As Boolean

   ''' <summary>
   ''' Gets or sets the expiration time of this shared folder.
   ''' </summary>
   Public Property Expiration As String

#End Region

#Region " Constructors "

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

#End Region

End Class

VMWareVirtualMachine.vb

Código (vbnet) [Seleccionar] Expandir


''' <summary>
''' Represents a VMWare Virtual Machine.
''' </summary>
Public NotInheritable Class VMWareVirtualMachine

#Region " Properties "

   ''' <summary>
   ''' Gets .vmx file of this VM.
   ''' </summary>
   Public ReadOnly Property VmxFile As FileInfo

   ''' <summary>
   ''' Gets or sets the username and password of the running user-account in the guest operating system of this VM.
   ''' <para></para>
   ''' The credential is required to perform some I/O operations with VMWare's vmrun.exe program.
   ''' So you must set this credential before using vmrun.exe.
   ''' </summary>
   Public Property GuestOsCredential As GuestOsCredential

   ''' <summary>
   ''' Gets a value that determine whether this VM is a shared VM.
   ''' </summary>
   Public ReadOnly Property IsSharedVm As Boolean

   ''' <summary>
   ''' Gets the display name of this VM.
   ''' </summary>
   Public ReadOnly Property DisplayName As String
       Get
           Return Me.displayNameB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the display name of this VM.
   ''' </summary>
   Private displayNameB As String

   ''' <summary>
   ''' Gets the version of the guest operating system of this VM.
   ''' </summary>
   Public ReadOnly Property OsVersion As String
       Get
           Return Me.osVersionB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the version of the guest operating system of this VM.
   ''' </summary>
   Private osVersionB As String

   ''' <summary>
   ''' Gets the firmware type of this VM. It can be: BIOS, or UEFI.
   ''' </summary>
   Public ReadOnly Property Firmware As String
       Get
           Return Me.firmwareB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the firmware type of this VM. It can be: BIOS, or UEFI.
   ''' </summary>
   Private firmwareB As String

   ''' <summary>
   ''' Gets a value that determine whether secureboot is enabled for UEFI firmware mode.
   ''' </summary>
   Public ReadOnly Property SecureBootEnabled As Boolean
       Get
           Return Me.secureBootEnabledB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets a value that determine whether secureboot is enabled for UEFI firmware mode.
   ''' </summary>
   Private secureBootEnabledB As Boolean

   ''' <summary>
   ''' Gets the hardware version of this VM.
   ''' </summary>
   ''' <remarks>
   ''' See for more info about virtual machine hardware versions: <see href="https://kb.vmware.com/s/article/1003746"/>
   ''' </remarks>
   Public ReadOnly Property VmHardwareVersion As Integer
       Get
           Return Me.vmHardwareVersionB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the hardware version of this VM.
   ''' </summary>
   Private vmHardwareVersionB As Integer

   ''' <summary>
   ''' Gets the total memory size of this VM, in megabytes.
   ''' </summary>
   Public ReadOnly Property MemorySize As Integer
       Get
           Return Me.memorySizeB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the total memory size of this VM, in megabytes.
   ''' </summary>
   Private memorySizeB As Integer

   ''' <summary>
   ''' Gets the total graphics memory size of this VM, in megabytes.
   ''' </summary>
   Public ReadOnly Property GraphicsMemorySize As Integer
       Get
           Return Me.graphicsMemorySizeB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the total graphics memory size of this VM, in megabytes.
   ''' </summary>
   Private graphicsMemorySizeB As Integer

   ''' <summary>
   ''' Gets a value that determine whether 3D graphics hardware acceleration is enabled in this VM.
   ''' </summary>
   Public ReadOnly Property GraphicsHardwareAccelerationEnabled As Boolean
       Get
           Return Me.graphicsHardwareAccelerationEnabledB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets a value that determine whether 3D graphics hardware acceleration is enabled in this VM.
   ''' </summary>
   Private graphicsHardwareAccelerationEnabledB As Boolean

   ''' <summary>
   ''' Gets the amount of processor cores of this VM.
   ''' </summary>
   Public ReadOnly Property TotalProcessorCores As Integer
       Get
           Return Me.totalProcessorCoresB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the amount of processor cores of this VM.
   ''' </summary>
   Private totalProcessorCoresB As Integer

   ''' <summary>
   ''' Gets the amount of cores per processor of this VM.
   ''' </summary>
   Public ReadOnly Property CoresPerProcessor As Integer
       Get
           Return Me.coresPerProcessorB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the amount of cores per processor of this VM.
   ''' </summary>
   Private coresPerProcessorB As Integer

   ''' <summary>
   ''' Gets the amount of processors of this VM.
   ''' <para></para>
   ''' The resulting value is the division between <see cref="VMWareVirtualMachine.TotalProcessorCores"/> \ <see cref="VMWareVirtualMachine.CoresPerProcessor"/>.
   ''' </summary>
   Public ReadOnly Property ProcessorCount As Integer
       Get
           Return (Me.TotalProcessorCores \ Me.CoresPerProcessor)
       End Get
   End Property

   ''' <summary>
   ''' Gets the shared folders of this VM.
   ''' </summary>
   Public ReadOnly Property SharedFolders As ReadOnlyCollection(Of VmSharedFolderInfo)
       Get
           Return Me.sharedFoldersB
       End Get
   End Property
   ''' <summary>
   ''' ( Backing Fields )
   ''' <para></para>
   ''' Gets the shared folders of this VM.
   ''' </summary>
   Private sharedFoldersB As ReadOnlyCollection(Of VmSharedFolderInfo)


#End Region

#Region " Constructors "

   ''' <summary>
   ''' Prevents a default instance of the <see cref="VMWareVirtualMachine"/> class from being created.
   ''' </summary>
   Private Sub New()
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="VMWareVirtualMachine"/> class.
   ''' </summary>
   ''' <param name="vmxFilePath">
   ''' The full path to the .vmx file.
   ''' </param>
   '''
   ''' <param name="isSharedVm">
   ''' A value that determine whether the VM is a shared VM.
   ''' </param>
   Public Sub New(ByVal vmxFilePath As String, ByVal isSharedVm As Boolean)
       Me.VmxFile = New FileInfo(vmxFilePath)
       Me.IsSharedVm = isSharedVm
       Me.GuestOsCredential = New GuestOsCredential()

       Me.Refresh()
   End Sub

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Refresh the state (the properties) of this <see cref="VMWareVirtualMachine"/>.
   ''' </summary>
   ''' <exception cref="FileNotFoundException">
   ''' .vmx file not found.
   ''' </exception>
   Public Sub Refresh()
       If Not (Me.VmxFile.Exists) Then
           Throw New FileNotFoundException(".vmx file not found.", Me.VmxFile.FullName)
       End If

       Me.VmxFile.Refresh()

       Dim sharedFoldersDict As New Dictionary(Of String, VmSharedFolderInfo)

       Using sr As StreamReader = Me.VmxFile.OpenText()

           Dim line As String
           Do Until sr.EndOfStream
               line = sr.ReadLine().Trim()

               Select Case True

                   Case line.ToLower().StartsWith("displayname")
                       Me.displayNameB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})

                   Case line.ToLower().StartsWith("firmware")
                       Me.firmwareB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})

                   Case line.ToLower().StartsWith("guestos")
                       Me.osVersionB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})

                   Case line.ToLower().StartsWith("memsize")
                       Me.memorySizeB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower().StartsWith("numvcpus")
                       Me.totalProcessorCoresB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower().StartsWith("cpuid.corespersocket")
                       Me.coresPerProcessorB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower().StartsWith("svga.graphicsmemorykb")
                       Me.graphicsMemorySizeB = (CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})) \ 1000)

                   Case line.ToLower().StartsWith("virtualhw.version")
                       Me.vmHardwareVersionB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower().StartsWith("uefi.secureboot.enabled")
                       Me.secureBootEnabledB = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower().StartsWith("mks.enable3d")
                       Me.graphicsHardwareAccelerationEnabledB = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

                   Case line.ToLower() Like "sharedfolder#*.?*"
                       Me.ParseSharedFolderLine(line, sharedFoldersDict)

               End Select

           Loop

       End Using

       Me.sharedFoldersB = New ReadOnlyCollection(Of VmSharedFolderInfo)(sharedFoldersDict.Values.ToArray())
       sharedFoldersDict.Clear()
   End Sub

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Parses a line of the .vmx file that contains a shared folder field and value.
   ''' </summary>
   ''' <param name="line">
   ''' The line to parse.
   ''' </param>
   '''
   ''' <param name="refSharedFoldersDict">
   ''' A <see cref="Dictionary(Of String, SharedFolderInfo)"/> that will be used to set the corresponding <see cref="VmSharedFolderInfo"/> member.
   ''' </param>
   Private Sub ParseSharedFolderLine(ByVal line As String, ByRef refSharedFoldersDict As Dictionary(Of String, VmSharedFolderInfo))

       Dim key As String = line.ToLower().Substring(0, line.IndexOf("."c))
       If Not refSharedFoldersDict.ContainsKey(key) Then
           refSharedFoldersDict.Add(key, New VmSharedFolderInfo())
       End If

       Select Case True

           Case line.ToLower() Like "sharedfolder#*.enabled*"
               refSharedFoldersDict(key).Enabled = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

           Case line.ToLower() Like "sharedfolder#*.expiration*"
               refSharedFoldersDict(key).Expiration = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})

           Case line.ToLower() Like "sharedfolder#*.guestname*"
               refSharedFoldersDict(key).Name = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})

           Case line.ToLower() Like "sharedfolder#*.hostpath*"
               refSharedFoldersDict(key).HostDirectory = New DirectoryInfo(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

           Case line.ToLower() Like "sharedfolder#*.readaccess*"
               refSharedFoldersDict(key).ReadAccess = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

           Case line.ToLower() Like "sharedfolder#*.writeaccess*"
               refSharedFoldersDict(key).WriteAccess = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))

       End Select

   End Sub

#End Region

End Class

VMRunWrapper.vb

El código es demasiado largo como para poder insertarlo en este post, así que les dejo un enlace a pastebin...

https://pastebin.com/AWieMiSG

Código mejorado con funciones asincrónicas:
https://pastebin.com/EXS0MQRR

Un pequeño fallo de formato de sintaxis ha sido corregido en el método "InstallVmWareTools":

• https://pastebin.com/F2mSNq6g

Un ejemplo de uso cualquiera:

Código (vbnet) [Seleccionar] Expandir

'***********************************************************************************************************************************
'
'This is a code example that demonstrates how to get the running virtual machines, then run a program on each guest operating system.
'
'***********************************************************************************************************************************

Private vmRun As VmRunWrapper

Private Async Sub Test()

   Me.vmRun = New VmRunWrapper("C:\Program Files (x86)\VMWare\VMware VIX\vmrun.exe")

   Dim vmCount As Integer = Await Me.vmRun.GetRunningVmCountAsync()
   If (vmCount > 0) Then

       Dim vms As ReadOnlyCollection(Of VMWareVirtualMachine) = Await Me.vmRun.GetRunningVmsAsync()

       For Each vm As VMWareVirtualMachine In vms

           ' Check whether VMWare-Tools are installed in the VM.
           ' The VmWare-Tools are required by some of the functionalities of vmrun.exe program.
           Dim isVMWareToolsInstalled As Boolean = Await Me.vmRun.IsVmWareToolsInstalledAsync(vm)
           Console.WriteLine("VM Name: {0}; IsVMWareToolsInstalled: {1}'", vm.DisplayName, isVMWareToolsInstalled)

           If Not isVMWareToolsInstalled Then
               Me.vmRun.InstallVmWareTools(vm)
               Continue For
           End If

           ' A valid guest username and password (if any) is required in order to use some of the functionalities of vmrun.exe program.
           vm.GuestOsCredential.Username = "guest username"
           vm.GuestOsCredential.Password = "guest password"

           Try
               ' Run a random program on the guest operating system.
               Me.vmRun.ProcessRun(vm, "C:\program.exe", VmRunProgramFlags.NoWait Or VmRunProgramFlags.ActiveWindow Or VmRunProgramFlags.Interactive, "")

           Catch ex As VmRunException
               Throw

           Catch ex As Exception
               Throw

           End Try

       Next

   End If

End Sub

[enipx]

Hello, @Electro Actually i saw your works and i was very impressed and i want you to take part in a project based on vb.net and c#, It will be a pleasure if you give me maybe your Whatsapp or Skype contact so we can talk more, I have private message you can check your inbox

[Serapis]

¿Cómo interoperar entre el sistema operativo huésped de una máquina virtual de VMWare, y el sistema operativo anfitrión?.
...
Como único inconveniente debo aclarar que este sistema no soporta máquinas virtuales compartidas (esas que podemos colocar en el directorio del usuario público como recurso compartido de red), y esta limitación es simplemente por pura ignorancia, ya que no he logrado averiguar la sintaxis correcta de vmrun para indicarle que el host es LOCALHOST, siempre que lo intento (ej. vmrun.exe -T ws-shared -h LOCALHOST ... ) el programa me dice que no ha logrado conectar con el servidor xD, así que si alguien sabe cual es la sintaxis le agradecería que me lo dijese para poder adaptar y mejorar este código.
...

Una búsqeuda rápida me ofrece este pdf, que puede servirte... (no lo he descargado).
https://www.vmware.com/support/developer/vix-api/vix170_vmrun_command.pdf