elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP) (Moderador: kub0x)
| | | |-+  Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 ... 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 [43] 44 45 46 47 48 49 50 51 52 53 54 55 Ir Abajo Respuesta Imprimir
Autor Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)  (Leído 341,643 veces)
Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #420 en: 19 Agosto 2014, 10:37 am »

Obtiene las expresiones XPath de un documento Html, usando la librería HtmlAgilityPack.

PD: Si encuentran algún fallo porfavor reportármelo, no conozco mucho el tema de los XPath.



Código
  1.    ' Get Html XPaths
  2.    ' By Elektro
  3.    '
  4.    ' Example Usage:
  5.    '
  6.    ' Dim Document As New HtmlAgilityPack.HtmlDocument
  7.    ' Document.LoadHtml(IO.File.ReadAllText("C:\File.html"))
  8.    ' Dim XpathList As List(Of String) = GetHtmlXPaths(Document)
  9.    ' ListBox1.Items.AddRange((From XPath As String In XpathList Select XPath).ToArray)
  10.  
  11.    ''' <summary>
  12.    ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlDocument"/> document.
  13.    ''' </summary>
  14.    ''' <param name="Document">Indicates the <see cref="HtmlAgilityPack.HtmlDocument"/> document.</param>
  15.    ''' <returns>List(Of System.String).</returns>
  16.    Public Function GetHtmlXPaths(ByVal Document As HtmlAgilityPack.HtmlDocument) As List(Of String)
  17.  
  18.        Dim XPathList As New List(Of String)
  19.        Dim XPath As String = String.Empty
  20.  
  21.        For Each Child As HtmlAgilityPack.HtmlNode In Document.DocumentNode.ChildNodes
  22.  
  23.            If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
  24.                GetHtmlXPaths(Child, XPathList, XPath)
  25.            End If
  26.  
  27.        Next Child
  28.  
  29.        Return XPathList
  30.  
  31.    End Function
  32.  
  33.    ''' <summary>
  34.    ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlNode"/>.
  35.    ''' </summary>
  36.    ''' <param name="Node">Indicates the <see cref="HtmlAgilityPack.HtmlNode"/>.</param>
  37.    ''' <param name="XPathList">Indicates a ByReffered XPath list as a <see cref="List(Of String)"/>.</param>
  38.    ''' <param name="XPath">Indicates the current XPath.</param>
  39.    Private Sub GetHtmlXPaths(ByVal Node As HtmlAgilityPack.HtmlNode,
  40.                              ByRef XPathList As List(Of String),
  41.                              Optional ByVal XPath As String = Nothing)
  42.  
  43.        XPath &= Node.XPath.Substring(Node.XPath.LastIndexOf("/"c))
  44.  
  45.        Const ClassNameFilter As String = "[@class='{0}']"
  46.        Dim ClassName As String = Node.GetAttributeValue("class", String.Empty)
  47.  
  48.        If Not String.IsNullOrEmpty(ClassName) Then
  49.            XPath &= String.Format(ClassNameFilter, ClassName)
  50.        End If
  51.  
  52.        If Not XPathList.Contains(XPath) Then
  53.            XPathList.Add(XPath)
  54.        End If
  55.  
  56.        For Each Child As HtmlAgilityPack.HtmlNode In Node.ChildNodes
  57.  
  58.            If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
  59.                GetHtmlXPaths(Child, XPathList, XPath)
  60.            End If
  61.  
  62.        Next Child
  63.  
  64.    End Sub
  65.  


« Última modificación: 19 Agosto 2014, 10:42 am por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #421 en: 19 Agosto 2014, 12:02 pm »

Me encontré por ahí un ErrorProvider extendido, ya no recuerdo donde lo encontré, y la documentación es... bueno, muy pobre, pero es facil de usar y sencillo de entender a pesar de ello:

'Following class is inherited from basic ErrorProvider class
#Region "Error Provider Extended"
Public Class ErrorProviderExtended
    Inherits System.Windows.Forms.ErrorProvider
    Private _validationcontrols As New ValidationControlCollection
    Private _summarymessage As String = "Please enter following mandatory fields,"

    'This property will be used for displaying a summary message about all empty fields
    'Default value is "Please enter following mandatory fields,". You can set any other
    'message using this property.
    Public Property SummaryMessage() As String
        Get
            Return _summarymessage
        End Get
        Set(ByVal Value As String)
            _summarymessage = Value
        End Set
    End Property

    'Controls property is of type ValidationControlCollection which is inherited from CollectionBase
    'Controls holds all those objects which should be validated.
    Public Property Controls() As ValidationControlCollection
        Get
            Return _validationcontrols
        End Get
        Set(ByVal Value As ValidationControlCollection)
            _validationcontrols = Value
        End Set
    End Property

    'Following function returns true if all fields on form are entered.
    'If not all fields are entered, this function displays a message box which contains all those field names
    'which are empty and returns FALSE.
    Public Function CheckAndShowSummaryErrorMessage() As Boolean
        If Controls.Count <= 0 Then
            Return True
        End If
        Dim i As Integer
        Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
        Dim berrors As Boolean = False
        For i = 0 To Controls.Count - 1
            If Controls(i).Validate Then
                If Trim(Controls(i).ControlObj.text) = "" Then
                    msg &= "> " & Controls(i).DisplayName & vbNewLine
                    SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
                    berrors = True
                Else
                    SetError(Controls(i).ControlObj, "")
                End If
            Else
                SetError(Controls(i).ControlObj, "")
            End If
        Next
        If berrors Then
            System.Windows.Forms.MessageBox.Show(msg, "Missing Information", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Stop)
            Return False
        Else
            Return True
        End If
    End Function

    'Following function clears error messages from all controls.
    Public Sub ClearAllErrorMessages()
        Dim i As Integer
        For i = 0 To Controls.Count - 1
            SetError(Controls(i).ControlObj, "")
        Next
    End Sub

    'This function hooks validation event with all controls.
    Public Sub SetErrorEvents()
        Dim i As Integer
        For i = 0 To Controls.Count - 1
            AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
        Next
    End Sub

    'Following event is hooked for all controls, it sets an error message with the use of ErrorProvider.
    Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) 'Handles txtCompanyName.Validating
        If Controls(sender).Validate Then
            If Trim(sender.Text) = "" Then
                MyBase.SetError(sender, Controls(sender).ErrorMessage)
            Else
                MyBase.SetError(sender, "")
            End If
        End If
    End Sub
End Class
#End Region

'Following class is inherited from CollectionBase class. It is used for holding all Validation Controls.
'This class is collection of ValidationControl class objects.
'This class is used by ErrorProviderExtended class.
#Region "ValidationControlCollection"
Public Class ValidationControlCollection
    Inherits CollectionBase
    Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
        Get
            Return Me.List(ListIndex)
        End Get
        Set(ByVal Value As ValidationControl)
            Me.List(ListIndex) = Value
        End Set
    End Property


    Default Public Property Item(ByVal pControl As Object) As ValidationControl
        Get
            If IsNothing(pControl) Then
                Return Nothing
            End If

            If GetIndex(pControl.Name) < 0 Then
                Return New ValidationControl
            End If
            Return Me.List(GetIndex(pControl.Name))
        End Get
        Set(ByVal Value As ValidationControl)
            If IsNothing(pControl) Then Exit Property
            If GetIndex(pControl.Name) < 0 Then
                Exit Property
            End If
            Me.List(GetIndex(pControl.Name)) = Value
        End Set
    End Property
    Function GetIndex(ByVal ControlName As String) As Integer
        Dim i As Integer
        For i = 0 To Count - 1
            If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
                Return i
            End If
        Next
        Return -1
    End Function
    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pDisplayName
        obj.ErrorMessage = "Please enter " + pDisplayName
        Me.List.Add(obj)
    End Sub

    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pDisplayName
        obj.ErrorMessage = pErrorMessage
        Me.List.Add(obj)
    End Sub
    Public Sub Add(ByRef pControl As Object)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pControl.Name
        obj.ErrorMessage = "Please enter " + pControl.Name
        Me.List.Add(obj)
    End Sub
    Public Sub Add(ByVal pControl As ValidationControl)
        If IsNothing(pControl) Then Exit Sub
        Me.List.Add(pControl)
    End Sub
    Public Sub Remove(ByVal pControl As Object)
        If IsNothing(pControl) Then Exit Sub
        Dim i As Integer = Me.GetIndex(pControl.Name)
        If i >= 0 Then
            Me.List.RemoveAt(i)
        End If
    End Sub
End Class
#End Region

'ValidationControl class is used to hold any control from windows form.
'It holds any control in ControlObj property.
#Region "ValidationControl"
Public Class ValidationControl
    Private _control As Object
    Private _displayname As String
    Private _errormessage As String
    Private _validate As Boolean = True

    'Validate property decides weather control is to be validated. Default value is TRUE.
    Public Property Validate() As Boolean
        Get
            Return _validate
        End Get
        Set(ByVal Value As Boolean)
            _validate = Value
        End Set
    End Property

    'ControlObj is a control from windows form which is to be validated.
    'For example txtStudentName
    Public Property ControlObj() As Object
        Get
            Return _control
        End Get
        Set(ByVal Value As Object)
            _control = Value
        End Set
    End Property

    'DisplayName property is used for displaying summary message to user.
    'For example, for txtStudentName you can set 'Student Full Name' as field name.
    'This field name will be displayed in summary message.
    Public Property DisplayName() As String
        Get
            Return _displayname
        End Get
        Set(ByVal Value As String)
            _displayname = Value
        End Set
    End Property

    'ErrorMessage is also used for displaying summary message.
    'For example, you can enter 'Student Name is mandatory' as an error message.
    Public Property ErrorMessage() As String
        Get
            Return _errormessage
        End Get
        Set(ByVal Value As String)
            _errormessage = Value
        End Set
    End Property
End Class
#End Region



EDITO: Ya lo he documentado yo así rapidamente:

Código
  1. #Region "Error Provider Extended"
  2.  
  3. ''' <summary>
  4. ''' Provides a user interface for indicating that a control on a form has an error associated with it.
  5. ''' </summary>
  6. Public Class ErrorProviderExtended
  7.  
  8.    Inherits System.Windows.Forms.ErrorProvider
  9.    Private _validationcontrols As New ValidationControlCollection
  10.    Private _summarymessage As String = "Please enter following mandatory fields,"
  11.  
  12.    ''' <summary>
  13.    ''' Gets or sets the summary message.
  14.    ''' This property will be used for displaying a summary message about all empty fields.
  15.    ''' Default value is "Please enter following mandatory fields,".
  16.    ''' You can set any other message using this property.
  17.    ''' </summary>
  18.    ''' <value>The summary message.</value>
  19.    Public Property SummaryMessage() As String
  20.        Get
  21.            Return _summarymessage
  22.        End Get
  23.        Set(ByVal Value As String)
  24.            _summarymessage = Value
  25.        End Set
  26.    End Property
  27.  
  28.    ''' <summary>
  29.    ''' Gets or sets the controls which should be validated.
  30.    ''' </summary>
  31.    ''' <value>The controls.</value>
  32.    Public Property Controls() As ValidationControlCollection
  33.        Get
  34.            Return _validationcontrols
  35.        End Get
  36.        Set(ByVal Value As ValidationControlCollection)
  37.            _validationcontrols = Value
  38.        End Set
  39.    End Property
  40.  
  41.    ''' <summary>
  42.    ''' Checks the and show summary error message.
  43.    ''' </summary>
  44.    ''' <param name="ShowMessage">
  45.    ''' If set to <c>true</c>, This function displays a message box which contains all the field names which are empty.
  46.    ''' </param>
  47.    ''' <returns><c>true</c> if all fields on form are entered, <c>false</c> otherwise.</returns>
  48.    Public Function CheckAndShowSummaryErrorMessage(Optional ByVal ShowMessage As Boolean = False) As Boolean
  49.  
  50.        If Controls.Count <= 0 Then
  51.            Return True
  52.        End If
  53.  
  54.        Dim i As Integer
  55.        Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
  56.        Dim berrors As Boolean = False
  57.  
  58.        For i = 0 To Controls.Count - 1
  59.  
  60.            If Controls(i).Validate Then
  61.                If Trim(Controls(i).ControlObj.text) = "" Then
  62.                    If ShowMessage Then
  63.                        msg &= "> " & Controls(i).DisplayName & vbNewLine
  64.                    End If
  65.                    SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
  66.                    berrors = True
  67.                Else
  68.                    SetError(Controls(i).ControlObj, "")
  69.                End If
  70.            Else
  71.                SetError(Controls(i).ControlObj, "")
  72.            End If
  73.  
  74.        Next i
  75.  
  76.        If berrors Then
  77.            If ShowMessage Then
  78.                MessageBox.Show(msg, "Missing Information", MessageBoxButtons.OK, MessageBoxIcon.Stop)
  79.            End If
  80.            Return False
  81.        Else
  82.            Return True
  83.        End If
  84.  
  85.    End Function
  86.  
  87.    ''' <summary>
  88.    ''' Clears error messages from all controls.
  89.    ''' </summary>
  90.    Public Sub ClearAllErrorMessages()
  91.  
  92.        Dim i As Integer
  93.        For i = 0 To Controls.Count - 1
  94.            SetError(Controls(i).ControlObj, "")
  95.        Next
  96.  
  97.    End Sub
  98.  
  99.    ''' <summary>
  100.    ''' Hooks validation event with all controls.
  101.    ''' </summary>
  102.    Public Sub SetErrorEvents()
  103.  
  104.        Dim i As Integer
  105.        For i = 0 To Controls.Count - 1
  106.            AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
  107.        Next
  108.  
  109.    End Sub
  110.  
  111.    ''' <summary>
  112.    ''' Handles the Event event of the Validation control.
  113.    ''' This event is hooked for all controls,
  114.    ''' it sets an error message with the use of ErrorProvider
  115.    ''' </summary>
  116.    ''' <param name="sender">The source of the event.</param>
  117.    ''' <param name="e">The <see cref="System.ComponentModel.CancelEventArgs"/> instance containing the event data.</param>
  118.    Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)
  119.  
  120.        If Controls(sender).Validate Then
  121.            If Trim(sender.Text) = "" Then
  122.                MyBase.SetError(sender, Controls(sender).ErrorMessage)
  123.            Else
  124.                MyBase.SetError(sender, "")
  125.            End If
  126.        End If
  127.  
  128.    End Sub
  129.  
  130. End Class
  131.  
  132. #End Region
  133.  
  134. #Region "ValidationControlCollection"
  135.  
  136. ''' <summary>
  137. ''' This class is used for holding all Validation Controls.
  138. ''' This class is collection of 'ValidationControl' class objects.
  139. ''' This class is used by 'ErrorProviderExtended' class.
  140. ''' </summary>
  141. Public Class ValidationControlCollection : Inherits CollectionBase
  142.  
  143.    Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
  144.        Get
  145.            Return Me.List(ListIndex)
  146.        End Get
  147.        Set(ByVal Value As ValidationControl)
  148.            Me.List(ListIndex) = Value
  149.        End Set
  150.    End Property
  151.  
  152.    Default Public Property Item(ByVal pControl As Object) As ValidationControl
  153.        Get
  154.            If IsNothing(pControl) Then
  155.                Return Nothing
  156.            End If
  157.  
  158.            If GetIndex(pControl.Name) < 0 Then
  159.                Return New ValidationControl
  160.            End If
  161.            Return Me.List(GetIndex(pControl.Name))
  162.        End Get
  163.        Set(ByVal Value As ValidationControl)
  164.            If IsNothing(pControl) Then Exit Property
  165.            If GetIndex(pControl.Name) < 0 Then
  166.                Exit Property
  167.            End If
  168.            Me.List(GetIndex(pControl.Name)) = Value
  169.        End Set
  170.    End Property
  171.  
  172.    Function GetIndex(ByVal ControlName As String) As Integer
  173.        Dim i As Integer
  174.        For i = 0 To Count - 1
  175.            If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
  176.                Return i
  177.            End If
  178.        Next
  179.        Return -1
  180.    End Function
  181.  
  182.    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
  183.        If IsNothing(pControl) Then Exit Sub
  184.        Dim obj As New ValidationControl
  185.        obj.ControlObj = pControl
  186.        obj.DisplayName = pDisplayName
  187.        obj.ErrorMessage = "Please enter " + pDisplayName
  188.        Me.List.Add(obj)
  189.    End Sub
  190.  
  191.    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
  192.        If IsNothing(pControl) Then Exit Sub
  193.        Dim obj As New ValidationControl
  194.        obj.ControlObj = pControl
  195.        obj.DisplayName = pDisplayName
  196.        obj.ErrorMessage = pErrorMessage
  197.        Me.List.Add(obj)
  198.    End Sub
  199.  
  200.    Public Sub Add(ByRef pControl As Object)
  201.        If IsNothing(pControl) Then Exit Sub
  202.        Dim obj As New ValidationControl
  203.        obj.ControlObj = pControl
  204.        obj.DisplayName = pControl.Name
  205.        obj.ErrorMessage = "Please enter " + pControl.Name
  206.        Me.List.Add(obj)
  207.    End Sub
  208.  
  209.    Public Sub Add(ByVal pControl As ValidationControl)
  210.        If IsNothing(pControl) Then Exit Sub
  211.        Me.List.Add(pControl)
  212.    End Sub
  213.  
  214.    Public Sub Remove(ByVal pControl As Object)
  215.        If IsNothing(pControl) Then Exit Sub
  216.        Dim i As Integer = Me.GetIndex(pControl.Name)
  217.        If i >= 0 Then
  218.            Me.List.RemoveAt(i)
  219.        End If
  220.    End Sub
  221. End Class
  222.  
  223. #End Region
  224.  
  225. #Region "ValidationControl"
  226.  
  227. ''' <summary>
  228. ''' ValidationControl class is used to hold any control from windows form.
  229. ''' 'It holds any control in 'ControlObj' property.
  230. ''' </summary>
  231. Public Class ValidationControl
  232.  
  233.    Private _control As Object
  234.    Private _displayname As String
  235.    Private _errormessage As String
  236.    Private _validate As Boolean = True
  237.  
  238.    ''' <summary>
  239.    ''' Decides weather control is to be validated. Default value is TRUE.
  240.    ''' </summary>
  241.    ''' <value><c>true</c> if validate; otherwise, <c>false</c>.</value>
  242.    Public Property Validate() As Boolean
  243.        Get
  244.            Return _validate
  245.        End Get
  246.        Set(ByVal Value As Boolean)
  247.            _validate = Value
  248.        End Set
  249.    End Property
  250.  
  251.    ''' <summary>
  252.    ''' ControlObj is a Control from windows form which is to be validated.
  253.    ''' </summary>
  254.    ''' <value>The control object.</value>
  255.    Public Property ControlObj() As Object
  256.        Get
  257.            Return _control
  258.        End Get
  259.        Set(ByVal Value As Object)
  260.            _control = Value
  261.        End Set
  262.    End Property
  263.  
  264.    ''' <summary>
  265.    ''' DisplayName property is used for displaying summary message to user.
  266.    ''' This field name will be displayed in summary message.
  267.    ''' </summary>
  268.    ''' <value>The display name.</value>
  269.    Public Property DisplayName() As String
  270.        Get
  271.            Return _displayname
  272.        End Get
  273.        Set(ByVal Value As String)
  274.            _displayname = Value
  275.        End Set
  276.    End Property
  277.  
  278.    ''' <summary>
  279.    ''' ErrorMessage is also used for displaying summary message.
  280.    ''' </summary>
  281.    ''' <value>The error message.</value>
  282.    Public Property ErrorMessage() As String
  283.        Get
  284.            Return _errormessage
  285.        End Get
  286.        Set(ByVal Value As String)
  287.            _errormessage = Value
  288.        End Set
  289.    End Property
  290.  
  291. End Class
  292.  
  293. #End Region

Escribí este Form para probar su utilidad:



Código
  1. Public Class ErrorProviderExtended_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' The ErrorProviderExtended instance.
  5.    ''' </summary>
  6.    Private WithEvents MyErrorProvider As New ErrorProviderExtended
  7.  
  8.    ''' <summary>
  9.    ''' Control to validate its content.
  10.    ''' </summary>
  11.    Private WithEvents tbValue As New TextBox
  12.  
  13.    ''' <summary>
  14.    ''' Control that validates general errors.
  15.    ''' </summary>
  16.    Private WithEvents btValidator As New Button
  17.  
  18.    ''' <summary>
  19.    ''' Control that reports the current error message.
  20.    ''' </summary>
  21.    Private lblError As New Label
  22.  
  23.    ''' <summary>
  24.    ''' Control used to indicate a textbox hint.
  25.    ''' </summary>
  26.    Private lblHint As New Label
  27.  
  28.    ''' <summary>
  29.    ''' This value determines whether exists errors that need to be fixed.
  30.    ''' </summary>
  31.    Dim ErrorExists As Boolean = False
  32.  
  33.    Public Sub New()
  34.  
  35.        ' This call is required by the designer.
  36.        InitializeComponent()
  37.  
  38.        With Me.lblHint
  39.            .Location = New Point(10, 10)
  40.            .Text = "Type an 'Int32' value:"
  41.            .ForeColor = Color.WhiteSmoke
  42.            .AutoSize = True
  43.        End With
  44.  
  45.        With Me.tbValue
  46.            .Location = New Point(15, 25)
  47.            .Size = New Size(100, Me.tbValue.Height)
  48.        End With
  49.  
  50.        With Me.lblError
  51.            .Location = New Point(10, 50)
  52.            .Text = ""
  53.            .ForeColor = Color.WhiteSmoke
  54.            .AutoSize = True
  55.        End With
  56.  
  57.        With Me.btValidator
  58.            .Location = New Point(Me.lblError.Location.X, Me.lblError.Location.Y + 20)
  59.            .Text = "Validate"
  60.            .FlatStyle = FlatStyle.System
  61.        End With
  62.  
  63.        With Me
  64.            .MaximizeBox = False
  65.            .StartPosition = FormStartPosition.CenterScreen
  66.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  67.            .Size = New Point(220, 150)
  68.            .BackColor = Color.FromArgb(34, 34, 36)
  69.            .Controls.AddRange({Me.lblHint, Me.lblError, Me.tbValue, Me.btValidator})
  70.        End With
  71.  
  72.    End Sub
  73.  
  74.    Private Sub Test_Load() Handles Me.Load
  75.  
  76.        With MyErrorProvider
  77.            .Controls.Add(Me.tbValue, "Int32")
  78.            .Controls(Me.tbValue).Validate = True
  79.            .SummaryMessage = "Following fields are mandatory."
  80.        End With
  81.  
  82.        ' Change the textbox text to produce an intentional error.
  83.        tbValue.AppendText(" ")
  84.        tbValue.Clear()
  85.  
  86.    End Sub
  87.  
  88.    Private Sub Button1_Click() _
  89.    Handles btValidator.Click
  90.  
  91.        ' The following function checks all empty fields and returns TRUE if all fields are entered.
  92.        ' If any mandotary field is empty this function displays a message and returns FALSE.
  93.        If MyErrorProvider.CheckAndShowSummaryErrorMessage(ShowMessage:=True) Then
  94.  
  95.            If Not Me.ErrorExists Then
  96.                MessageBox.Show("Data submited successfully.", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
  97.            Else
  98.                MessageBox.Show("Data cannot be submited, fix the error(s).", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
  99.            End If
  100.  
  101.        End If
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Handles the TextChanged event of the tbValue control.
  107.    ''' </summary>
  108.    Private Sub tbValue_TextChanged(sender As Object, e As EventArgs) _
  109.    Handles tbValue.TextChanged
  110.  
  111.        Dim Value As String = sender.text
  112.  
  113.        If String.IsNullOrEmpty(Value) Then
  114.            MyErrorProvider.SetError(sender, "TextBox is empty.")
  115.  
  116.        ElseIf Not Single.TryParse(Value, New Single) Then
  117.            MyErrorProvider.SetError(sender, "The value cannot contain letters.")
  118.  
  119.        ElseIf Single.TryParse(Value, New Single) Then
  120.  
  121.            If Value > Integer.MaxValue Then
  122.                MyErrorProvider.SetError(sender, "Value is greater than " & CStr(Integer.MaxValue))
  123.            Else ' Remove the error.
  124.                MyErrorProvider.SetError(sender, String.Empty)
  125.            End If
  126.  
  127.        Else ' Remove the error.
  128.            MyErrorProvider.SetError(sender, String.Empty)
  129.  
  130.        End If
  131.  
  132.        Me.lblError.Text = MyErrorProvider.GetError(sender)
  133.  
  134.        If String.IsNullOrEmpty(Me.lblError.Text) Then
  135.            Me.lblError.Text = "No errors :)"
  136.            Me.ErrorExists = False
  137.        Else
  138.            Me.ErrorExists = True
  139.        End If
  140.  
  141.    End Sub
  142.  
  143. End Class
  144.  
  145.  
  146.  


« Última modificación: 19 Agosto 2014, 12:30 pm por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #422 en: 19 Agosto 2014, 22:06 pm »

Un ejemplo de uso de la librería MagicGraphics: http://www.codeproject.com/Articles/19188/Magic-Graphics







Escribí este Form para jugar un poco con la funcionalidad de esta librería, la verdad es que es muy sencillo.



Código
  1. Public Class MagicGraphics_Test
  2.  
  3.    Private WithEvents RotationTimer As New Timer With {.Enabled = True, .Interval = 25}
  4.  
  5.    Dim SC As MagicGraphics.ShapeContainer
  6.  
  7.    Private Sub Tst_Shown() Handles MyBase.Shown
  8.  
  9.        SC = New MagicGraphics.ShapeContainer(PictureBox1.CreateGraphics, PictureBox1.Width, PictureBox1.Height, Color.Black, PictureBox1.Image)
  10.        PictureBox1.Image = SC.BMP
  11.        SC.AutoFlush = False
  12.  
  13.        Dim Sq As New MagicGraphics.Rectangle(New Pen(Color.Black, 3), Brushes.Aqua, 60, 20, 50, 50)
  14.        Sq.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(60, 0), Color.Yellow, Color.Red)
  15.        SC.AddShape(Sq)
  16.        Dim El As New MagicGraphics.Ellipse(New Pen(Color.Black, 3), Brushes.Olive, 60, 88, 50, 71)
  17.        El.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(30, 0), Color.Red, Color.SteelBlue)
  18.        SC.AddShape(El)
  19.  
  20.        RotationTimer.Start()
  21.  
  22.    End Sub
  23.  
  24.  
  25.    Private Sub RotationTimer_Tick() Handles RotationTimer.Tick
  26.  
  27.        Static Direction As Integer = 1I ' 0 = Left, 1 = Right
  28.  
  29.        For X As Integer = 0I To (SC.ShapesL.Count - 1)
  30.  
  31.            Dim shp As MagicGraphics.Shape = SC.ShapesL(X)
  32.  
  33.            shp.Rotate(-8)
  34.  
  35.            If shp.Location.X > (PictureBox1.Width - shp.Width) Then
  36.                Direction = 1I ' Right
  37.  
  38.            ElseIf shp.Location.X < PictureBox1.Location.X Then
  39.                Direction = 0I ' Left
  40.  
  41.            End If
  42.  
  43.            If Direction = 0 Then
  44.                shp.Move(shp.Location.X + 2, shp.Location.Y)
  45.  
  46.            Else
  47.                shp.Move(shp.Location.X - 2, shp.Location.Y)
  48.  
  49.            End If
  50.  
  51.            ' Debug.WriteLine(String.Format("Shape {0} Rotation: {1}", CStr(X), shp.Rotation))
  52.  
  53.        Next X
  54.  
  55.        SC.Flush()
  56.  
  57.    End Sub
  58.  
  59. End Class
  60.  
En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #423 en: 20 Agosto 2014, 02:06 am »

He escrito este ejemplo para mostrar como se puede compartir un espacio de memoria que puede ser leido por diferentes aplicaciones:



Esta sería la aplicación número 1, creen un nuevo proyecto, copien y compilen este Form:

Código
  1. ' Example of sharing memory across different running applications.
  2. ' By Elektro
  3. '
  4. ' *************************
  5. ' This is the Application 1
  6. ' *************************
  7.  
  8. #Region " Imports "
  9.  
  10. Imports System.IO.MemoryMappedFiles
  11.  
  12. #End Region
  13.  
  14. #Region " Application 2 "
  15.  
  16. ''' <summary>
  17. ''' Class MemoryMappedFile_Form1.
  18. ''' This should be the Class used to compile our first application.
  19. ''' </summary>
  20. Public Class MemoryMappedFile_Form1
  21.  
  22.    ' The controls to create on execution-time.
  23.    Dim WithEvents btMakeFile As New Button ' Writes the memory.
  24.    Dim WithEvents btReadFile As New Button ' Reads the memory.
  25.    Dim tbMessage As New TextBox ' Determines the string to map into memory.
  26.    Dim tbReceptor As New TextBox ' Print the memory read's result.
  27.    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
  28.    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.
  29.  
  30.    ''' <summary>
  31.    ''' Indicates the name of our memory-file.
  32.    ''' </summary>
  33.    Private ReadOnly MemoryName As String = "My Memory-File Name"
  34.  
  35.    ''' <summary>
  36.    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
  37.    ''' </summary>
  38.    Private ReadOnly MemoryBufferSize As Integer = 1024I
  39.  
  40.    ''' <summary>
  41.    ''' Indicates the string to map in memory.
  42.    ''' </summary>
  43.    Private ReadOnly Property strMessage As String
  44.        Get
  45.            Return tbMessage.Text
  46.        End Get
  47.    End Property
  48.  
  49.    ''' <summary>
  50.    ''' Initializes a new instance of the <see cref="MemoryMappedFile_Form1"/> class.
  51.    ''' </summary>
  52.    Public Sub New()
  53.  
  54.        ' This call is required by the designer.
  55.        InitializeComponent()
  56.  
  57.        ' Set the properties of the controls.
  58.        With lbInfotbMessage
  59.            .Location = New Point(20, 10)
  60.            .Text = "Type in this TextBox the message to write in memory:"
  61.            .AutoSize = True
  62.            ' .Size = tbReceptor.Size
  63.        End With
  64.        With tbMessage
  65.            .Text = "Hello world from application one!"
  66.            .Location = New Point(20, 30)
  67.            .Size = New Size(310, Me.tbMessage.Height)
  68.        End With
  69.        With btMakeFile
  70.            .Text = "Write Memory"
  71.            .Size = New Size(130, 45)
  72.            .Location = New Point(20, 50)
  73.        End With
  74.        With btReadFile
  75.            .Text = "Read Memory"
  76.            .Size = New Size(130, 45)
  77.            .Location = New Point(200, 50)
  78.        End With
  79.        With tbReceptor
  80.            .Location = New Point(20, 130)
  81.            .Size = New Size(310, 100)
  82.            .Multiline = True
  83.        End With
  84.        With lbInfoButtons
  85.            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
  86.            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
  87.            .AutoSize = False
  88.            .Size = tbReceptor.Size
  89.        End With
  90.  
  91.        ' Set the Form properties.
  92.        With Me
  93.            .Text = "Application 1"
  94.            .Size = New Size(365, 300)
  95.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  96.            .MaximizeBox = False
  97.            .StartPosition = FormStartPosition.CenterScreen
  98.        End With
  99.  
  100.        ' Add the controls on the UI.
  101.        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
  107.    ''' </summary>
  108.    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
  109.    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
  110.    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
  111.    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())
  112.  
  113.        ' Create or open the memory-mapped file.
  114.        Dim MessageFile As MemoryMappedFile =
  115.            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  116.  
  117.        ' Write the byte-sequence into memory.
  118.        Using Writer As MemoryMappedViewAccessor =
  119.            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  120.  
  121.            ' Firstly fill with null all the buffer.
  122.            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)
  123.  
  124.            ' Secondly write the byte-data.
  125.            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)
  126.  
  127.        End Using ' Writer
  128.  
  129.    End Sub
  130.  
  131.    ''' <summary>
  132.    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
  133.    ''' </summary>
  134.    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
  135.    ''' <param name="BufferLength">The buffer-length to read in.</param>
  136.    ''' <returns>System.Byte().</returns>
  137.    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()
  138.  
  139.        Try
  140.            Using MemoryFile As MemoryMappedFile =
  141.                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)
  142.  
  143.                Using Reader As MemoryMappedViewAccessor =
  144.                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)
  145.  
  146.                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
  147.                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
  148.                    Return ReadBytes
  149.  
  150.                End Using ' Reader
  151.  
  152.            End Using ' MemoryFile
  153.  
  154.        Catch ex As IO.FileNotFoundException
  155.            Throw
  156.            Return Nothing
  157.  
  158.        End Try
  159.  
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Handles the 'Click' event of the 'btMakeFile' control.
  164.    ''' </summary>
  165.    Private Sub btMakeFile_Click() Handles btMakeFile.Click
  166.  
  167.        ' Get the byte-data to create the memory-mapped file.
  168.        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)
  169.  
  170.        ' Create the memory-mapped file.
  171.        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)
  172.  
  173.    End Sub
  174.  
  175.    ''' <summary>
  176.    ''' Handles the 'Click' event of the 'btReadFile' control.
  177.    ''' </summary>
  178.    Private Sub btReadFile_Click() Handles btReadFile.Click
  179.  
  180.  
  181.        Dim ReadBytes As Byte()
  182.  
  183.        Try ' Read the byte-sequence from memory.
  184.            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)
  185.  
  186.        Catch ex As IO.FileNotFoundException
  187.            Me.tbReceptor.Text = "Memory-mapped file does not exist."
  188.            Exit Sub
  189.  
  190.        End Try
  191.  
  192.        ' Convert the bytes to String.
  193.        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)
  194.  
  195.        ' Remove null chars (leading zero-bytes)
  196.        Message = Message.Trim({ControlChars.NullChar})
  197.  
  198.        ' Print the message.
  199.        tbReceptor.Text = Message
  200.  
  201.    End Sub
  202.  
  203. End Class
  204.  
  205. #End Region

Esta sería la aplicación número 2, creen un nuevo proyecto, copien y compilen este Form:

Código
  1. ' Example of sharing memory across different running applications.
  2. ' By Elektro
  3. '
  4. ' *************************
  5. ' This is the Application 2
  6. ' *************************
  7.  
  8. #Region " Imports "
  9.  
  10. Imports System.IO.MemoryMappedFiles
  11.  
  12. #End Region
  13.  
  14. #Region " Application 2 "
  15.  
  16. ''' <summary>
  17. ''' Class MemoryMappedFile_Form2.
  18. ''' This should be the Class used to compile our first application.
  19. ''' </summary>
  20. Public Class MemoryMappedFile_Form2
  21.  
  22.    ' The controls to create on execution-time.
  23.    Dim WithEvents btMakeFile As New Button ' Writes the memory.
  24.    Dim WithEvents btReadFile As New Button ' Reads the memory.
  25.    Dim tbMessage As New TextBox ' Determines the string to map into memory.
  26.    Dim tbReceptor As New TextBox ' Print the memory read's result.
  27.    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
  28.    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.
  29.  
  30.    ''' <summary>
  31.    ''' Indicates the name of our memory-file.
  32.    ''' </summary>
  33.    Private ReadOnly MemoryName As String = "My Memory-File Name"
  34.  
  35.    ''' <summary>
  36.    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
  37.    ''' </summary>
  38.    Private ReadOnly MemoryBufferSize As Integer = 1024I
  39.  
  40.    ''' <summary>
  41.    ''' Indicates the string to map in memory.
  42.    ''' </summary>
  43.    Private ReadOnly Property strMessage As String
  44.        Get
  45.            Return tbMessage.Text
  46.        End Get
  47.    End Property
  48.  
  49.    ''' <summary>
  50.    ''' Initializes a new instance of the <see cref="MemoryMappedFile_Form2"/> class.
  51.    ''' </summary>
  52.    Public Sub New()
  53.  
  54.        ' This call is required by the designer.
  55.        InitializeComponent()
  56.  
  57.        ' Set the properties of the controls.
  58.        With lbInfotbMessage
  59.            .Location = New Point(20, 10)
  60.            .Text = "Type in this TextBox the message to write in memory:"
  61.            .AutoSize = True
  62.            ' .Size = tbReceptor.Size
  63.        End With
  64.        With tbMessage
  65.            .Text = "Hello world from application two!"
  66.            .Location = New Point(20, 30)
  67.            .Size = New Size(310, Me.tbMessage.Height)
  68.        End With
  69.        With btMakeFile
  70.            .Text = "Write Memory"
  71.            .Size = New Size(130, 45)
  72.            .Location = New Point(20, 50)
  73.        End With
  74.        With btReadFile
  75.            .Text = "Read Memory"
  76.            .Size = New Size(130, 45)
  77.            .Location = New Point(200, 50)
  78.        End With
  79.        With tbReceptor
  80.            .Location = New Point(20, 130)
  81.            .Size = New Size(310, 100)
  82.            .Multiline = True
  83.        End With
  84.        With lbInfoButtons
  85.            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
  86.            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
  87.            .AutoSize = False
  88.            .Size = tbReceptor.Size
  89.        End With
  90.  
  91.        ' Set the Form properties.
  92.        With Me
  93.            .Text = "Application 2"
  94.            .Size = New Size(365, 300)
  95.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  96.            .MaximizeBox = False
  97.            .StartPosition = FormStartPosition.CenterScreen
  98.        End With
  99.  
  100.        ' Add the controls on the UI.
  101.        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
  107.    ''' </summary>
  108.    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
  109.    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
  110.    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
  111.    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())
  112.  
  113.        ' Create or open the memory-mapped file.
  114.        Dim MessageFile As MemoryMappedFile =
  115.            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  116.  
  117.        ' Write the byte-sequence into memory.
  118.        Using Writer As MemoryMappedViewAccessor =
  119.            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  120.  
  121.            ' Firstly fill with null all the buffer.
  122.            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)
  123.  
  124.            ' Secondly write the byte-data.
  125.            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)
  126.  
  127.        End Using ' Writer
  128.  
  129.    End Sub
  130.  
  131.    ''' <summary>
  132.    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
  133.    ''' </summary>
  134.    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
  135.    ''' <param name="BufferLength">The buffer-length to read in.</param>
  136.    ''' <returns>System.Byte().</returns>
  137.    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()
  138.  
  139.        Try
  140.            Using MemoryFile As MemoryMappedFile =
  141.                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)
  142.  
  143.                Using Reader As MemoryMappedViewAccessor =
  144.                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)
  145.  
  146.                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
  147.                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
  148.                    Return ReadBytes
  149.  
  150.                End Using ' Reader
  151.  
  152.            End Using ' MemoryFile
  153.  
  154.        Catch ex As IO.FileNotFoundException
  155.            Throw
  156.            Return Nothing
  157.  
  158.        End Try
  159.  
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Handles the 'Click' event of the 'btMakeFile' control.
  164.    ''' </summary>
  165.    Private Sub btMakeFile_Click() Handles btMakeFile.Click
  166.  
  167.        ' Get the byte-data to create the memory-mapped file.
  168.        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)
  169.  
  170.        ' Create the memory-mapped file.
  171.        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)
  172.  
  173.    End Sub
  174.  
  175.    ''' <summary>
  176.    ''' Handles the 'Click' event of the 'btReadFile' control.
  177.    ''' </summary>
  178.    Private Sub btReadFile_Click() Handles btReadFile.Click
  179.  
  180.  
  181.        Dim ReadBytes As Byte()
  182.  
  183.        Try ' Read the byte-sequence from memory.
  184.            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)
  185.  
  186.        Catch ex As IO.FileNotFoundException
  187.            Me.tbReceptor.Text = "Memory-mapped file does not exist."
  188.            Exit Sub
  189.  
  190.        End Try
  191.  
  192.        ' Convert the bytes to String.
  193.        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)
  194.  
  195.        ' Remove null chars (leading zero-bytes)
  196.        Message = Message.Trim({ControlChars.NullChar})
  197.  
  198.        ' Print the message.
  199.        tbReceptor.Text = Message
  200.  
  201.    End Sub
  202.  
  203. End Class
  204.  
  205. #End Region

Ahora ya solo tienen que ejecutar ambas aplicaciones para testear.

Saludos!
En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #424 en: 21 Agosto 2014, 13:03 pm »

Una class para ordenar los items de un listview según la columna:



Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-20-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ListView Column-Sorter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class ListViewColumnSorter_TestForm : Inherits form
  13. '
  14. '    ''' <summary>
  15. '    ''' The listview to sort.
  16. '    ''' </summary>
  17. '    Private WithEvents LV As New ListView
  18. '
  19. '    ''' <summary>
  20. '    ''' The 'ListViewColumnSorter' instance.
  21. '    ''' </summary>
  22. '    Private Sorter As New ListViewColumnSorter
  23. '
  24. '    ''' <summary>
  25. '    ''' Initializes a new instance of the <see cref="ListViewColumnSorter_TestForm"/> class.
  26. '    ''' </summary>
  27. '    Public Sub New()
  28. '
  29. '        ' This call is required by the designer.
  30. '        InitializeComponent()
  31. '
  32. '        With LV ' Set the Listview properties.
  33. '
  34. '            ' Set the sorter, our 'ListViewColumnSorter'.
  35. '            .ListViewItemSorter = Sorter
  36. '
  37. '            ' The sorting default direction.
  38. '            .Sorting = SortOrder.Ascending
  39. '
  40. '            ' Set the default sort-modifier.
  41. '            Sorter.SortModifier = ListViewColumnSorter.SortModifiers.SortByText
  42. '
  43. '            ' Add some columns.
  44. '            .Columns.Add("Text").Tag = ListViewColumnSorter.SortModifiers.SortByText
  45. '            .Columns.Add("Numbers").Tag = ListViewColumnSorter.SortModifiers.SortByNumber
  46. '            .Columns.Add("Dates").Tag = ListViewColumnSorter.SortModifiers.SortByDate
  47. '
  48. '            ' Adjust the column sizes.
  49. '            For Each col As ColumnHeader In LV.Columns
  50. '                col.Width = 100I
  51. '            Next
  52. '
  53. '            ' Add some items.
  54. '            .Items.Add("hello").SubItems.AddRange({"1", "11/11/2000"})
  55. '            .Items.Add("yeehaa!").SubItems.AddRange({"2", "11-11-2000"})
  56. '            .Items.Add("El3ktr0").SubItems.AddRange({"10", "9/9/1999"})
  57. '            .Items.Add("wow").SubItems.AddRange({"100", "21/08/2014"})
  58. '
  59. '            ' Visual-Style things.
  60. '            .Dock = DockStyle.Fill
  61. '            .View = View.Details
  62. '            .FullRowSelect = True
  63. '
  64. '        End With
  65. '
  66. '        With Me ' Set the Form properties.
  67. '
  68. '            .Size = New Size(400, 200)
  69. '            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  70. '            .MaximizeBox = False
  71. '            .StartPosition = FormStartPosition.CenterScreen
  72. '            .Text = "ListViewColumnSorter TestForm"
  73. '
  74. '        End With
  75. '
  76. '        ' Add the Listview to UI.
  77. '        Me.Controls.Add(LV)
  78. '
  79. '    End Sub
  80. '
  81. '    ''' <summary>
  82. '    ''' Handles the 'ColumnClick' event of the 'ListView1' control.
  83. '    ''' </summary>
  84. '    Private Sub ListView1_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _
  85. '    Handles LV.ColumnClick
  86. '
  87. '        ' Dinamycaly sets the sort-modifier to sort the column by text, number, or date.
  88. '        Sorter.SortModifier = sender.columns(e.Column).tag
  89. '
  90. '        ' Determine whether clicked column is already the column that is being sorted.
  91. '        If e.Column = Sorter.Column Then
  92. '
  93. '            ' Reverse the current sort direction for this column.
  94. '            If Sorter.Order = SortOrder.Ascending Then
  95. '                Sorter.Order = SortOrder.Descending
  96. '
  97. '            Else
  98. '                Sorter.Order = SortOrder.Ascending
  99. '
  100. '            End If ' Sorter.Order
  101. '
  102. '        Else
  103. '
  104. '            ' Set the column number that is to be sorted, default to ascending.
  105. '            Sorter.Column = e.Column
  106. '            Sorter.Order = SortOrder.Ascending
  107. '
  108. '        End If ' e.Column
  109. '
  110. '        ' Perform the sort with these new sort options.
  111. '        sender.Sort()
  112. '
  113. '    End Sub
  114. '
  115. 'End Class
  116.  
  117. #End Region
  118.  
  119. #Region " Imports "
  120.  
  121. Imports System.Text.RegularExpressions
  122. Imports System.ComponentModel
  123.  
  124. #End Region
  125.  
  126. #Region " ListView Column-Sorter "
  127.  
  128. ''' <summary>
  129. ''' Performs a sorting comparison.
  130. ''' </summary>
  131. Public Class ListViewColumnSorter : Implements IComparer
  132.  
  133. #Region " Objects "
  134.  
  135.    '''' <summary>
  136.    '''' Indicates the comparer instance.
  137.    '''' </summary>
  138.    Private Comparer As Object = New TextComparer
  139.  
  140. #End Region
  141.  
  142. #Region " Properties "
  143.  
  144.    ''' <summary>
  145.    ''' Gets or sets the number of the column to which to apply the sorting operation (Defaults to '0').
  146.    ''' </summary>
  147.    Public Property Column As Integer
  148.        Get
  149.            Return Me._Column
  150.        End Get
  151.        Set(ByVal value As Integer)
  152.            Me._Column = value
  153.        End Set
  154.    End Property
  155.    Private _Column As Integer = 0I
  156.  
  157.    ''' <summary>
  158.    ''' Gets or sets the order of sorting to apply.
  159.    ''' </summary>
  160.    Public Property Order As SortOrder
  161.        Get
  162.            Return Me._Order
  163.        End Get
  164.        Set(ByVal value As SortOrder)
  165.            Me._Order = value
  166.        End Set
  167.    End Property
  168.    Private _Order As SortOrder = SortOrder.None
  169.  
  170.    ''' <summary>
  171.    ''' Gets or sets the sort modifier.
  172.    ''' </summary>
  173.    ''' <value>The sort modifier.</value>
  174.    Public Property SortModifier As SortModifiers
  175.        Get
  176.            Return Me._SortModifier
  177.        End Get
  178.        Set(ByVal value As SortModifiers)
  179.            Me._SortModifier = value
  180.        End Set
  181.    End Property
  182.    Private _SortModifier As SortModifiers = SortModifiers.SortByText
  183.  
  184. #End Region
  185.  
  186. #Region " Enumerations "
  187.  
  188.    ''' <summary>
  189.    ''' Specifies a comparison result.
  190.    ''' </summary>
  191.    Public Enum ComparerResult As Integer
  192.  
  193.        ''' <summary>
  194.        ''' 'X' is equals to 'Y'.
  195.        ''' </summary>
  196.        Equals = 0I
  197.  
  198.        ''' <summary>
  199.        ''' 'X' is less than 'Y'.
  200.        ''' </summary>
  201.        Less = -1I
  202.  
  203.        ''' <summary>
  204.        ''' 'X' is greater than 'Y'.
  205.        ''' </summary>
  206.        Greater = 1I
  207.  
  208.    End Enum
  209.  
  210.    ''' <summary>
  211.    ''' Indicates a Sorting Modifier.
  212.    ''' </summary>
  213.    Public Enum SortModifiers As Integer
  214.  
  215.        ''' <summary>
  216.        ''' Treats the values &#8203;&#8203;as text.
  217.        ''' </summary>
  218.        SortByText = 0I
  219.  
  220.        ''' <summary>
  221.        ''' Treats the values &#8203;&#8203;as numbers.
  222.        ''' </summary>
  223.        SortByNumber = 1I
  224.  
  225.        ''' <summary>
  226.        ''' Treats valuesthe values &#8203;&#8203;as dates.
  227.        ''' </summary>
  228.        SortByDate = 2I
  229.  
  230.    End Enum
  231.  
  232. #End Region
  233.  
  234. #Region " Private Methods "
  235.  
  236.    ''' <summary>
  237.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  238.    ''' </summary>
  239.    ''' <param name="x">The first object to compare.</param>
  240.    ''' <param name="y">The second object to compare.</param>
  241.    ''' <returns>
  242.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  243.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  244.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  245.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  246.    ''' </returns>
  247.    Private Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
  248.  
  249.        Dim CompareResult As ComparerResult = ComparerResult.Equals
  250.        Dim LVItemX, LVItemY As ListViewItem
  251.  
  252.        ' Cast the objects to be compared
  253.        LVItemX = DirectCast(x, ListViewItem)
  254.        LVItemY = DirectCast(y, ListViewItem)
  255.  
  256.        Dim strX As String = If(Not LVItemX.SubItems.Count <= Me._Column,
  257.                               LVItemX.SubItems(Me._Column).Text,
  258.                               Nothing)
  259.  
  260.        Dim strY As String = If(Not LVItemY.SubItems.Count <= Me._Column,
  261.                                LVItemY.SubItems(Me._Column).Text,
  262.                                Nothing)
  263.  
  264.        Dim listViewMain As ListView = LVItemX.ListView
  265.  
  266.        ' Calculate correct return value based on object comparison
  267.        If listViewMain.Sorting <> SortOrder.Ascending AndAlso listViewMain.Sorting <> SortOrder.Descending Then
  268.  
  269.            ' Return '0' to indicate they are equal
  270.            Return ComparerResult.Equals
  271.  
  272.        End If
  273.  
  274.        If Me._SortModifier.Equals(SortModifiers.SortByText) Then
  275.  
  276.            ' Compare the two items
  277.            If LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
  278.                CompareResult = Me.Comparer.Compare(Nothing, Nothing)
  279.  
  280.            ElseIf LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count > Me._Column Then
  281.                CompareResult = Me.Comparer.Compare(Nothing, strY)
  282.  
  283.            ElseIf LVItemX.SubItems.Count > Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
  284.                CompareResult = Me.Comparer.Compare(strX, Nothing)
  285.  
  286.            Else
  287.                CompareResult = Me.Comparer.Compare(strX, strY)
  288.  
  289.            End If
  290.  
  291.        Else ' Me._SortModifier IsNot 'SortByText'
  292.  
  293.            Select Case Me._SortModifier
  294.  
  295.                Case SortModifiers.SortByNumber
  296.                    If Me.Comparer.GetType <> GetType(NumericComparer) Then
  297.                        Me.Comparer = New NumericComparer
  298.                    End If
  299.  
  300.                Case SortModifiers.SortByDate
  301.                    If Me.Comparer.GetType <> GetType(DateComparer) Then
  302.                        Me.Comparer = New DateComparer
  303.                    End If
  304.  
  305.                Case Else
  306.                    If Me.Comparer.GetType <> GetType(TextComparer) Then
  307.                        Me.Comparer = New TextComparer
  308.                    End If
  309.  
  310.            End Select
  311.  
  312.            CompareResult = Comparer.Compare(strX, strY)
  313.  
  314.        End If ' Me._SortModifier.Equals(...)
  315.  
  316.        ' Calculate correct return value based on object comparison
  317.        If Me._Order = SortOrder.Ascending Then
  318.            ' Ascending sort is selected, return normal result of compare operation
  319.            Return CompareResult
  320.  
  321.        ElseIf Me._Order = SortOrder.Descending Then
  322.            ' Descending sort is selected, return negative result of compare operation
  323.            Return (-CompareResult)
  324.  
  325.        Else
  326.            ' Return '0' to indicate they are equal
  327.            Return 0I
  328.  
  329.        End If ' Me._Order = ...
  330.  
  331.    End Function
  332.  
  333. #End Region
  334.  
  335. #Region " Hidden Methods "
  336.  
  337.    ''' <summary>
  338.    ''' Serves as a hash function for a particular type.
  339.    ''' </summary>
  340.    <EditorBrowsable(EditorBrowsableState.Never)>
  341.    Public Shadows Sub GetHashCode()
  342.    End Sub
  343.  
  344.    ''' <summary>
  345.    ''' Determines whether the specified System.Object instances are considered equal.
  346.    ''' </summary>
  347.    <EditorBrowsable(EditorBrowsableState.Never)>
  348.    Public Shadows Sub Equals()
  349.    End Sub
  350.  
  351.    ''' <summary>
  352.    ''' Gets the System.Type of the current instance.
  353.    ''' </summary>
  354.    ''' <returns>The exact runtime type of the current instance.</returns>
  355.    <EditorBrowsable(EditorBrowsableState.Never)>
  356.    Public Shadows Function [GetType]()
  357.        Return Me.GetType
  358.    End Function
  359.  
  360.    ''' <summary>
  361.    ''' Returns a String that represents the current object.
  362.    ''' </summary>
  363.    <EditorBrowsable(EditorBrowsableState.Never)>
  364.    Public Shadows Sub ToString()
  365.    End Sub
  366.  
  367. #End Region
  368.  
  369. End Class
  370.  
  371. #End Region
  372.  
  373. #Region " Comparers "
  374.  
  375. #Region " Text "
  376.  
  377. ''' <summary>
  378. ''' Performs a text comparison.
  379. ''' </summary>
  380. Public Class TextComparer : Inherits CaseInsensitiveComparer
  381.  
  382. #Region " Enumerations "
  383.  
  384.    ''' <summary>
  385.    ''' Specifies a comparison result.
  386.    ''' </summary>
  387.    Public Enum ComparerResult As Integer
  388.  
  389.        ''' <summary>
  390.        ''' 'X' is equals to 'Y'.
  391.        ''' </summary>
  392.        Equals = 0I
  393.  
  394.        ''' <summary>
  395.        ''' 'X' is less than 'Y'.
  396.        ''' </summary>
  397.        Less = -1I
  398.  
  399.        ''' <summary>
  400.        ''' 'X' is greater than 'Y'.
  401.        ''' </summary>
  402.        Greater = 1I
  403.  
  404.    End Enum
  405.  
  406. #End Region
  407.  
  408. #Region " Methods "
  409.  
  410.    ''' <summary>
  411.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  412.    ''' </summary>
  413.    ''' <param name="x">The first object to compare.</param>
  414.    ''' <param name="y">The second object to compare.</param>
  415.    ''' <returns>
  416.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  417.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  418.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  419.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  420.    ''' </returns>
  421.    Friend Shadows Function Compare(ByVal x As Object, ByVal y As Object) As Integer
  422.  
  423.        ' Null parsing.
  424.        If x Is Nothing AndAlso y Is Nothing Then
  425.            Return ComparerResult.Equals ' X is equals to Y.
  426.  
  427.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  428.            Return ComparerResult.Less ' X is less than Y.
  429.  
  430.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  431.            Return ComparerResult.Greater ' X is greater than Y.
  432.  
  433.        End If
  434.  
  435.        ' String parsing:
  436.        If (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' True and True
  437.            Return [Enum].Parse(GetType(ComparerResult),
  438.                                MyBase.Compare(x, y))
  439.  
  440.        ElseIf (TypeOf x Is String) AndAlso Not (TypeOf y Is String) Then ' True and False
  441.            Return ComparerResult.Greater ' X is greater than Y.
  442.  
  443.        ElseIf Not (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' False and True
  444.            Return ComparerResult.Less ' X is less than Y.
  445.  
  446.        Else ' False and False
  447.            Return ComparerResult.Equals
  448.  
  449.        End If
  450.  
  451.    End Function
  452.  
  453. #End Region
  454.  
  455. End Class
  456.  
  457. #End Region
  458.  
  459. #Region " Numeric "
  460.  
  461. ''' <summary>
  462. ''' Performs a numeric comparison.
  463. ''' </summary>
  464. Public Class NumericComparer : Implements IComparer
  465.  
  466. #Region " Enumerations "
  467.  
  468.    ''' <summary>
  469.    ''' Specifies a comparison result.
  470.    ''' </summary>
  471.    Public Enum ComparerResult As Integer
  472.  
  473.        ''' <summary>
  474.        ''' 'X' is equals to 'Y'.
  475.        ''' </summary>
  476.        Equals = 0I
  477.  
  478.        ''' <summary>
  479.        ''' 'X' is less than 'Y'.
  480.        ''' </summary>
  481.        Less = -1I
  482.  
  483.        ''' <summary>
  484.        ''' 'X' is greater than 'Y'.
  485.        ''' </summary>
  486.        Greater = 1I
  487.  
  488.    End Enum
  489.  
  490. #End Region
  491.  
  492. #Region " Methods "
  493.  
  494.    ''' <summary>
  495.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  496.    ''' </summary>
  497.    ''' <param name="x">The first object to compare.</param>
  498.    ''' <param name="y">The second object to compare.</param>
  499.    ''' <returns>
  500.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  501.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  502.    ''' Less than 0: <paramref name="x" /> is less than <paramref name="y"/>.
  503.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  504.    ''' </returns>
  505.    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _
  506.    Implements IComparer.Compare
  507.  
  508.        ' Null parsing.
  509.        If x Is Nothing AndAlso y Is Nothing Then
  510.            Return ComparerResult.Equals ' X is equals to Y.
  511.  
  512.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  513.            Return ComparerResult.Less ' X is less than Y.
  514.  
  515.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  516.            Return ComparerResult.Greater ' X is greater than Y.
  517.  
  518.        End If
  519.  
  520.        ' The single variables to parse the text.
  521.        Dim SingleX, SingleY As Single
  522.  
  523.        ' Single parsing:
  524.        If Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' True and True
  525.            Return [Enum].Parse(GetType(ComparerResult),
  526.                                SingleX.CompareTo(SingleY))
  527.  
  528.        ElseIf Single.TryParse(x, SingleX) AndAlso Not Single.TryParse(y, SingleY) Then ' True and False
  529.            Return ComparerResult.Greater ' X is greater than Y.
  530.  
  531.        ElseIf Not Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' False and True
  532.            Return ComparerResult.Less ' X is less than Y.
  533.  
  534.        Else ' False and False
  535.            Return [Enum].Parse(GetType(ComparerResult),
  536.                                x.ToString.CompareTo(y.ToString))
  537.  
  538.        End If
  539.  
  540.    End Function
  541.  
  542. #End Region
  543.  
  544. End Class
  545.  
  546. #End Region
  547.  
  548. #Region " Date "
  549.  
  550. ''' <summary>
  551. ''' Performs a date comparison.
  552. ''' </summary>
  553. Public Class DateComparer : Implements IComparer
  554.  
  555. #Region " Enumerations "
  556.  
  557.    ''' <summary>
  558.    ''' Specifies a comparison result.
  559.    ''' </summary>
  560.    Public Enum ComparerResult As Integer
  561.  
  562.        ''' <summary>
  563.        ''' 'X' is equals to 'Y'.
  564.        ''' </summary>
  565.        Equals = 0I
  566.  
  567.        ''' <summary>
  568.        ''' 'X' is less than 'Y'.
  569.        ''' </summary>
  570.        Less = -1I
  571.  
  572.        ''' <summary>
  573.        ''' 'X' is greater than 'Y'.
  574.        ''' </summary>
  575.        Greater = 1I
  576.  
  577.    End Enum
  578.  
  579. #End Region
  580.  
  581. #Region " Methods "
  582.  
  583.    ''' <summary>
  584.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  585.    ''' </summary>
  586.    ''' <param name="x">The first object to compare.</param>
  587.    ''' <param name="y">The second object to compare.</param>
  588.    ''' <returns>
  589.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  590.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  591.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  592.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  593.    ''' </returns>
  594.    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
  595.  
  596.        ' Null parsing.
  597.        If x Is Nothing AndAlso y Is Nothing Then
  598.            Return ComparerResult.Equals ' X is equals to Y.
  599.  
  600.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  601.            Return ComparerResult.Less ' X is less than Y.
  602.  
  603.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  604.            Return ComparerResult.Greater ' X is greater than Y.
  605.  
  606.        End If
  607.  
  608.        ' The Date variables to parse the text.
  609.        Dim DateX, DateY As Date
  610.  
  611.        ' Date parsing:
  612.        If Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' True and True
  613.            Return [Enum].Parse(GetType(ComparerResult),
  614.                                DateX.CompareTo(DateY))
  615.  
  616.        ElseIf Date.TryParse(x, DateX) AndAlso Not Date.TryParse(y, DateY) Then ' True and False
  617.            Return ComparerResult.Greater ' X is greater than Y.
  618.  
  619.        ElseIf Not Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' False and True
  620.            Return ComparerResult.Less ' X is less than Y.
  621.  
  622.        Else ' False and False
  623.            Return [Enum].Parse(GetType(ComparerResult),
  624.                                x.ToString.CompareTo(y.ToString))
  625.  
  626.        End If
  627.  
  628.    End Function
  629.  
  630. #End Region
  631.  
  632. End Class
  633.  
  634. #End Region
  635.  
  636. #End Region
En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #425 en: 21 Agosto 2014, 13:58 pm »

Unos métodos de uso genérico para utilizar la librería IconLib ( http://www.codeproject.com/Articles/16178/IconLib-Icons-Unfolded-MultiIcon-and-Windows-Vista ) para crear iconos o leer las capas de un icono.

PD: Hay que modificar un poco el source (escrito en C#) para permitir la creación de iconos de 512 x 512 (es facil, busquen un if con "256" y añadan el valor "512" a la enumeración de formatos de iconos), pero por otro lado no hay ningún problema para leer este tamaño de icono sin realizar modificaciones.



Código
  1.    ' Create Icon
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    ' Dim IconFile As IconLib.SingleIcon = CreateIcon("C:\Image.ico", IconLib.IconOutputFormat.All)
  7.    ' For Each IconLayer As IconLib.IconImage In IconFile
  8.    '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
  9.    '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
  10.    '     Application.DoEvents()
  11.    '     Threading.Thread.Sleep(750)
  12.    ' Next IconLayer
  13.    '
  14.    ''' <summary>
  15.    ''' Creates an icon with the specified image.
  16.    ''' </summary>
  17.    ''' <param name="imagefile">Indicates the image.</param>
  18.    ''' <param name="format">Indicates the icon format.</param>
  19.    ''' <returns>IconLib.SingleIcon.</returns>
  20.    Public Function CreateIcon(ByVal imagefile As String,
  21.                               Optional ByVal format As IconLib.IconOutputFormat =
  22.                                                        IconLib.IconOutputFormat.All) As IconLib.SingleIcon
  23.  
  24.        Dim sIcon As IconLib.SingleIcon = New IconLib.MultiIcon().Add("Icon1")
  25.        sIcon.CreateFrom(imagefile, format)
  26.  
  27.        Return sIcon
  28.  
  29.    End Function
  30.  
  31.    ' Get Icon-Layers
  32.    ' By Elektro
  33.    '
  34.    ' Usage Examples:
  35.    '
  36.    ' For Each IconLayer As IconLib.IconImage In GetIconLayers("C:\Image.ico")
  37.    '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
  38.    '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
  39.    '     Application.DoEvents()
  40.    '     Threading.Thread.Sleep(750)
  41.    ' Next IconLayer
  42.    '
  43.    ''' <summary>
  44.    ''' Gets all the icon layers inside an icon file.
  45.    ''' </summary>
  46.    ''' <param name="iconfile">Indicates the icon file.</param>
  47.    ''' <returns>IconLib.SingleIcon.</returns>
  48.    Public Function GetIconLayers(ByVal iconfile As String) As IconLib.SingleIcon
  49.  
  50.        Dim mIcon As IconLib.MultiIcon = New IconLib.MultiIcon()
  51.        mIcon.Load(iconfile)
  52.  
  53.        Return mIcon.First
  54.  
  55.    End Function
  56.  
« Última modificación: 21 Agosto 2014, 14:03 pm por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #426 en: 22 Agosto 2014, 20:08 pm »

Por algún motivo no me puedo instalar el MS Office así que tuve que buscar alguna alternativa para poder seguir desarrollando con manejo de Excel sin interop, y di con esta magnifica librería, NPOI:



http://npoi.codeplex.com/

Tomé los ejemplos oficiales en C# y escribí los siguientes ejemplos en VB.NET



Crear un workbook:

Código
  1. #Region " Create a WorkBook "
  2.  
  3.        ' Create the excel workbook.
  4.        Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.        ' Create a sheet.
  7.        Dim sheet As ISheet = workbook.CreateSheet("Sheet A1")
  8.  
  9.        ' Create a cell.
  10.        Dim cell As ICell = sheet.CreateRow(0).CreateCell(0)
  11.  
  12.        ' Set cell value.
  13.        cell.SetCellValue("This is a test")
  14.  
  15.        ' Set the width of column A1.
  16.        sheet.SetColumnWidth(0, 50 * 256)
  17.  
  18.        ' Set the height of row A1.
  19.        sheet.CreateRow(0).Height = 200
  20.  
  21.        ' Save changes.
  22.        Using sw As IO.FileStream = IO.File.Create(".\Create a Workbook Example.xlsx")
  23.            workbook.Write(sw)
  24.        End Using
  25.  
  26. #End Region



Deinifir la cabecera y el pie de página:

Código
  1. #Region " Set Header and Footer "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create a sheet.
  6.  
  7.    With sheet
  8.  
  9.    ' Create a cell and add a value.
  10.        .CreateRow(0).CreateCell(1).SetCellValue("test")
  11.  
  12.    ' Set header text.
  13.        .Header.Left = HSSFHeader.Page
  14.  
  15.    ' Page is a static property of HSSFHeader and HSSFFooter.
  16.        .Header.Center = "This is a test sheet"
  17.  
  18.    ' Set footer text.
  19.        .Footer.Left = "Copyright NPOI Team"
  20.        .Footer.Right = "created by Tony Qu&#65288;&#30655;&#26480;&#65289;"
  21.  
  22.    End With
  23.  
  24.     Save changes.
  25.    Using sw As IO.FileStream = IO.File.Create(".\Header-Footer Example.xlsx")
  26.        workbook.Write(sw)
  27.    End Using
  28.  
  29. #End Region



Añadir comentarios a una celda:

Código
  1. #Region " Add Comments "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("some comments") ' Create the first sheet.
  6.  
  7.    ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
  8.    Dim patr As IDrawing = sheet.CreateDrawingPatriarch()
  9.  
  10.    ' Create a cell in row 3.
  11.    Dim cell1 As ICell = sheet.CreateRow(3).CreateCell(1)
  12.    cell1.SetCellValue(New XSSFRichTextString("Hello, World"))
  13.  
  14.    ' Create a richtext to use it in the comment.
  15.    Dim strComment As New XSSFRichTextString("This is saying you hello")
  16.  
  17.    ' Create the richtext font style.
  18.    Dim font As IFont = workbook.CreateFont()
  19.    With font
  20.        .FontName = "Arial"
  21.        .FontHeightInPoints = 10
  22.        .Boldweight = CShort(FontBoldWeight.Bold)
  23.        .Color = HSSFColor.Red.Index
  24.    End With
  25.  
  26.    ' Apply font style to the text in the comment.
  27.    strComment.ApplyFont(font)
  28.  
  29.    ' Create a comment, Anchor defines size and position of the comment in worksheet.
  30.    Dim comment1 As IComment = patr.CreateCellComment(New XSSFClientAnchor(0, 0, 0, 0, 4, 2, 6, 5))
  31.    With comment1
  32.  
  33.    ' Set comment text.
  34.        .[String] = strComment
  35.  
  36.    ' Set comment author.
  37.        .Author = "Elektro"
  38.  
  39.    ' By default comments are hidden. This one is always visible.
  40.        .Visible = True
  41.  
  42.    End With
  43.  
  44.    '* The first way to assign comment to a cell is via CellComment method:
  45.    cell1.CellComment = comment1
  46.    '* The second way to assign comment to a cell is to implicitly specify its row and column.
  47.    '* Note: It is possible to set row and column of a non-existing cell.
  48.    comment1.Row = 3
  49.    comment1.Column = 1
  50.  
  51.    ' Save changes.
  52.    Using sw As IO.FileStream = IO.File.Create(".\Comment Example.xlsx")
  53.        workbook.Write(sw)
  54.    End Using
  55.  
  56. #End Region



Definir propiedades personalizadas:

Código
  1. #Region " Set Custom Properties "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As XSSFWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Get the properties.
  8.    Dim props As POIXMLProperties = workbook.GetProperties()
  9.  
  10.    With props ' Set some default properties.
  11.        .CoreProperties.Title = "Properties Example"
  12.        .CoreProperties.Creator = "Elektro"
  13.        .CoreProperties.Created = DateTime.Now
  14.    End With
  15.  
  16.    ' Set a custom property.
  17.    If Not props.CustomProperties.Contains("My Property Name") Then
  18.        props.CustomProperties.AddProperty("My Property Name", "Hello World!")
  19.    End If
  20.  
  21.    ' Save changes.
  22.    Using sw As IO.FileStream = IO.File.Create(".\Properties Example.xlsx")
  23.        workbook.Write(sw)
  24.    End Using
  25.  
  26. #End Region



Rellenar el color de fondo de una celda:

Código
  1. #Region " Fill Cell Background "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.    ' Create a sheet.
  7.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  8.  
  9.    ' Create a cell.
  10.    Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)
  11.  
  12.    ' Set the cell text.
  13.    cell1.SetCellValue("Hello")
  14.  
  15.    ' Set the Background Style.
  16.    Dim style As ICellStyle = workbook.CreateCellStyle()
  17.    With style
  18.        .FillForegroundColor = IndexedColors.Blue.Index
  19.        .FillPattern = FillPattern.BigSpots
  20.        .FillBackgroundColor = IndexedColors.Pink.Index
  21.    End With
  22.  
  23.    ' Fill the cell background.
  24.    cell1.CellStyle = style
  25.  
  26.    ' Save changes.
  27.    Using sw As IO.FileStream = IO.File.Create(".\Fill background Example.xlsx")
  28.        workbook.Write(sw)
  29.    End Using
  30.  
  31. #End Region



Añadir un hyperlink:

Código
  1. #Region " Add HyperLinks "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim cell As ICell = Nothing
  6.    Dim sheet As ISheet = workbook.CreateSheet("Hyperlinks") ' Create the first sheet.
  7.  
  8.    ' Set the Hyperlink style.
  9.    Dim HyperLinkStyle As ICellStyle = workbook.CreateCellStyle()
  10.    Dim HyperLinkFont As IFont = workbook.CreateFont()
  11.    HyperLinkFont.Underline = FontUnderlineType.[Single]
  12.    HyperLinkFont.Color = HSSFColor.Blue.Index
  13.    HyperLinkStyle.SetFont(HyperLinkFont)
  14.  
  15.    ' Link to an URL.
  16.    Dim LinkURL As New XSSFHyperlink(HyperlinkType.Url) With {.Address = "http://poi.apache.org/"}
  17.    cell = sheet.CreateRow(0).CreateCell(0)
  18.    With cell
  19.        .SetCellValue("URL Link")
  20.        .Hyperlink = LinkURL
  21.        .CellStyle = HyperLinkStyle
  22.    End With
  23.  
  24.    ' Link to a file.
  25.    Dim LinkFile As New XSSFHyperlink(HyperlinkType.File) With {.Address = "link1.xls"}
  26.    cell = sheet.CreateRow(1).CreateCell(0)
  27.    With cell
  28.        .SetCellValue("File Link")
  29.        .Hyperlink = LinkFile
  30.        .CellStyle = HyperLinkStyle
  31.    End With
  32.  
  33.    ' Link to an e-amil.
  34.    Dim LinkMail As New XSSFHyperlink(HyperlinkType.Email) With {.Address = "mailto:poi@apache.org?subject=Hyperlinks"}
  35.    With cell
  36.        cell = sheet.CreateRow(2).CreateCell(0)
  37.        .SetCellValue("Email Link")
  38.        .Hyperlink = LinkMail
  39.        .CellStyle = HyperLinkStyle
  40.    End With
  41.  
  42.    ' Link to a place in the workbook.
  43.    Dim LinkSheet As New XSSFHyperlink(HyperlinkType.Document) With {.Address = "'Target ISheet'!A1"}
  44.    Dim sheet2 As ISheet = workbook.CreateSheet("Target ISheet") ' Create a target sheet.
  45.    sheet2.CreateRow(0).CreateCell(0).SetCellValue("Target ICell") ' Create a target cell.
  46.    With cell
  47.        cell = sheet.CreateRow(3).CreateCell(0)
  48.        .SetCellValue("Worksheet Link")
  49.        .Hyperlink = LinkSheet
  50.        .CellStyle = HyperLinkStyle
  51.    End With
  52.  
  53.    ' Save changes.
  54.    Using sw As IO.FileStream = IO.File.Create(".\HyperLink Example.xlsx")
  55.        workbook.Write(sw)
  56.    End Using
  57.  
  58. #End Region



Establecer el estilo de fuente:

Código
  1. #Region " Set Font style "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Create a cell style.
  8.    Dim style1 As ICellStyle = workbook.CreateCellStyle()
  9.  
  10.    ' Create a font style.
  11.    Dim font1 As IFont = workbook.CreateFont()
  12.    With font1 ' underlined, italic, red color, fontsize=20
  13.        .Color = IndexedColors.Red.Index
  14.        .IsItalic = True
  15.        .Underline = FontUnderlineType.[Double]
  16.        .FontHeightInPoints = 20
  17.    End With
  18.  
  19.    ' bind font1 with style1
  20.    style1.SetFont(font1)
  21.  
  22.    ' Create a cell, add text, and apply the font.
  23.    Dim cell1 As ICell = sheet1.CreateRow(1).CreateCell(1)
  24.    With cell1
  25.        .SetCellValue("Hello World!")
  26.        .CellStyle = style1
  27.    End With
  28.  
  29.    ' Save changes.
  30.    Using sw As IO.FileStream = IO.File.Create(".\Font-Style Example.xlsx")
  31.        workbook.Write(sw)
  32.    End Using
  33.  
  34. #End Region



Establecer el tipo de fuente para texto con formato (rich text):

Código
  1. #Region " Set Font style RichText "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Create a cell with rich text.
  8.    Dim cell1 As ICell = sheet1.CreateRow(0).CreateCell(0)
  9.  
  10.    ' Create a richtext.
  11.    Dim richtext As New XSSFRichTextString("Microsoft OfficeTM")
  12.  
  13.    ' Create a font style.
  14.    Dim font1 As IFont = workbook.CreateFont()
  15.    With font1
  16.        .FontHeightInPoints = 12
  17.    End With
  18.    richtext.ApplyFont(0, 16, font1) ' apply font to "Microsoft Office".
  19.  
  20.    ' Create a font style.
  21.    Dim font2 As IFont = workbook.CreateFont()
  22.    With font2
  23.        .TypeOffset = FontSuperScript.Super
  24.        .IsItalic = True
  25.        .Color = IndexedColors.Blue.Index
  26.        .FontHeightInPoints = 8
  27.    End With
  28.    richtext.ApplyFont(16, 18, font2) ' apply font to "TM"
  29.  
  30.    ' Add the richtext into the cell.
  31.    cell1.SetCellValue(richtext)
  32.  
  33.    ' Save changes.
  34.    Using sw As IO.FileStream = IO.File.Create(".\Font-Style RichText Example.xlsx")
  35.        workbook.Write(sw)
  36.    End Using
  37.  
  38. #End Region



Añadir una tabla:

Código
  1. #Region " Add a Table "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet1"), XSSFSheet) ' Create the first sheet.
  6.  
  7.    ' Create a cell with text.
  8.    sheet1.CreateRow(0).CreateCell(0).SetCellValue("This is a Sample")
  9.  
  10.    ' Create a table.
  11.    Dim x As Integer = 1
  12.    For i As Integer = 1 To 15
  13.    Dim row As IRow = sheet1.CreateRow(i)
  14.        For j As Integer = 0 To 14
  15.            row.CreateCell(j).SetCellValue(System.Math.Max(System.Threading.Interlocked.Increment(x), x - 1))
  16.        Next j
  17.    Next i
  18.    Dim table As XSSFTable = sheet1.CreateTable()
  19.    table.Name = "Tabella1"
  20.    table.DisplayName = "Tabella1"
  21.  
  22.    ' Save changes.
  23.    Using sw As IO.FileStream = IO.File.Create(".\Table Example.xlsx")
  24.        workbook.Write(sw)
  25.    End Using
  26.  
  27. #End Region



Formatear el valor de una celda:

Código
  1. #Region " Format Cell Data "
  2.  
  3.    Private Sub Test() Handles MyBase.Shown
  4.  
  5.        ' Create the excel workbook.
  6.        Dim workbook As IWorkbook = New XSSFWorkbook()
  7.  
  8.        ' Create a sheet.
  9.        Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  10.  
  11.        ' Create the format instance.
  12.        Dim format As IDataFormat = workbook.CreateDataFormat()
  13.  
  14.        ' Increase the width of Column A.
  15.        sheet.SetColumnWidth(0, 5000)
  16.  
  17.        ' Create a row and put some cells in it. Rows are 0 based.
  18.        Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)
  19.        Dim cell2 As ICell = sheet.CreateRow(1).CreateCell(0)
  20.        Dim cell3 As ICell = sheet.CreateRow(2).CreateCell(0)
  21.        Dim cell4 As ICell = sheet.CreateRow(3).CreateCell(0)
  22.        Dim cell5 As ICell = sheet.CreateRow(4).CreateCell(0)
  23.        Dim cell6 As ICell = sheet.CreateRow(5).CreateCell(0)
  24.        Dim cell7 As ICell = sheet.CreateRow(6).CreateCell(0)
  25.  
  26.        ' Format the cell values.
  27.  
  28.        ' [Cell1]
  29.        ' Number format with 2 digits after the decimal point. eg: "1.20"
  30.        SetValueAndFormat(workbook, cell1, 1.2, HSSFDataFormat.GetBuiltinFormat("0.00"))
  31.  
  32.        ' [Cell2]
  33.        ' RMB currency format with comma. eg: "¥20,000"
  34.        SetValueAndFormat(workbook, cell2, 20000, format.GetFormat("¥#,##0"))
  35.  
  36.        ' [Cell3]
  37.        ' Scentific number format. eg: "3.15E+00"
  38.        SetValueAndFormat(workbook, cell3, 3.151234, format.GetFormat("0.00E+00"))
  39.  
  40.        ' [Cell4]
  41.        ' Percent format, 2 digits after the decimal point. eg: "99.33%"
  42.        SetValueAndFormat(workbook, cell4, 0.99333, format.GetFormat("0.00%"))
  43.  
  44.        ' [Cell5]
  45.        ' Phone number format. eg: "021-65881234"
  46.        SetValueAndFormat(workbook, cell5, 2165881234UI, format.GetFormat("000-00000000"))
  47.  
  48.        ' [Cell6]:
  49.        ' Formula value with datetime style.
  50.        cell6.CellFormula = "DateValue(""2005-11-11"")+TIMEVALUE(""11:11:11"")"
  51.        Dim cellStyle6 As ICellStyle = workbook.CreateCellStyle()
  52.        cellStyle6.DataFormat = HSSFDataFormat.GetBuiltinFormat("m/d/yy h:mm")
  53.        cell6.CellStyle = cellStyle6
  54.  
  55.        ' [Cell7]:
  56.        ' Display current time in AM/PM format.
  57.        SetDate(workbook, cell7, DateTime.Now, format.GetFormat("[$-409]h:mm:ss AM/PM;@"))
  58.  
  59.        ' Save changes.
  60.        Using sw As IO.FileStream = IO.File.Create(".\Formula Example.xlsx")
  61.            workbook.Write(sw)
  62.        End Using
  63.  
  64.    End Sub
  65.  
  66.    Private Shared Sub SetValueAndFormat(ByVal workbook As IWorkbook,
  67.                                         ByVal cell As ICell,
  68.                                         ByVal value As Double,
  69.                                         ByVal formatId As Short)
  70.  
  71.        cell.SetCellValue(value)
  72.        Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
  73.        cellStyle.DataFormat = formatId
  74.        cell.CellStyle = cellStyle
  75.  
  76.    End Sub
  77.  
  78.    Private Shared Sub SetDate(ByVal workbook As IWorkbook,
  79.                               ByVal cell As ICell,
  80.                               ByVal value As DateTime,
  81.                               ByVal formatId As Short)
  82.  
  83.        'set value for the cell
  84.        If Not value = Nothing Then
  85.            cell.SetCellValue(value)
  86.        End If
  87.  
  88.        Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
  89.        cellStyle.DataFormat = formatId
  90.        cell.CellStyle = cellStyle
  91.  
  92.    End Sub
  93.  
  94. #End Region



Ocultar una fila o una columna:

Código
  1. #Region " Hide row or column "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.    ' Create a sheet.
  7.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  8.  
  9.    ' Create some rows.
  10.    Dim r1 As IRow = sheet.CreateRow(0)
  11.    Dim r2 As IRow = sheet.CreateRow(1)
  12.    Dim r3 As IRow = sheet.CreateRow(2)
  13.    Dim r4 As IRow = sheet.CreateRow(3)
  14.    Dim r5 As IRow = sheet.CreateRow(4)
  15.  
  16.    ' Hide IRow 2.
  17.    r2.ZeroHeight = True
  18.  
  19.    ' Hide column C.
  20.    sheet.SetColumnHidden(2, True)
  21.  
  22.    ' Save changes.
  23.    Using sw As IO.FileStream = IO.File.Create(".\Hide Row or Column Example.xlsx")
  24.        workbook.Write(sw)
  25.    End Using
  26.  
  27. #End Region



Añadir una imagen:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As ISheet = workbook.CreateSheet("PictureSheet")
  6.  
  7.        ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
  8.        Dim patriarch As IDrawing = sheet.CreateDrawingPatriarch()
  9.  
  10.        ' Create the anchor.
  11.        Dim anchor As New XSSFClientAnchor(500, 200, 0, 0, 2, 2, 4, 7)
  12.        anchor.AnchorType = 2
  13.  
  14.        ' Load the picture and get the picture index in the workbook.
  15.        Dim imageId As Integer = LoadImage("C:\Users\Administrador\Desktop\4t0n.png", workbook)
  16.        Dim picture As XSSFPicture = DirectCast(patriarch.CreatePicture(anchor, imageId), XSSFPicture)
  17.  
  18.        ' Reset the image to the original size.
  19.        ' Note: Resize will reset client anchor you set.
  20.        'picture.Resize();  
  21.  
  22.        ' Save changes.
  23.        Using sw As IO.FileStream = IO.File.Create(".\Add Picture Example.xlsx")
  24.            workbook.Write(sw)
  25.        End Using
  26.  
  27.  
  28.    Public Shared Function LoadImage(path As String, wb As IWorkbook) As Integer
  29.        Dim file As New FileStream(path, FileMode.Open, FileAccess.Read)
  30.        Dim buffer As Byte() = New Byte(file.Length - 1) {}
  31.        file.Read(buffer, 0, CInt(file.Length))
  32.        Return wb.AddPicture(buffer, PictureType.JPEG)
  33.    End Function



Unir celdas:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  6.  
  7.        ' Create a cell.
  8.        Dim cell As ICell = sheet.CreateRow(1).CreateCell(1)
  9.        cell.SetCellValue(New XSSFRichTextString("This is a test of merging"))
  10.  
  11.        ' Merge B2 cell with C2 cell.
  12.        sheet.AddMergedRegion(New CellRangeAddress(1, 1, 1, 2))
  13.  
  14.        ' Save changes.
  15.        Using sw As IO.FileStream = IO.File.Create(".\Merge Cells Example.xlsx")
  16.            workbook.Write(sw)
  17.        End Using



Proteger con contraseña:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet A1"), XSSFSheet)
  6.  
  7.        With sheet ' Lock accessing excel operations.
  8.            .LockFormatRows()
  9.            .LockFormatCells()
  10.            .LockFormatColumns()
  11.            .LockDeleteColumns()
  12.            .LockDeleteRows()
  13.            .LockInsertHyperlinks()
  14.            .LockInsertColumns()
  15.            .LockInsertRows()
  16.        End With
  17.  
  18.        ' Set the password to unprotect:
  19.        Dim password As String = "Your Password"
  20.        sheet.ProtectSheet(password)
  21.  
  22.        ' Save changes.
  23.        Using sw As IO.FileStream = IO.File.Create(".\Protect Cells Example.xlsx")
  24.            workbook.Write(sw)
  25.        End Using


EDITO:


Como leer un workbook:

Código
  1.        ' The existing workbook filepath.
  2.        Dim WorkBookFile As String = "C:\MyWorkBook.xlsx"
  3.  
  4.        ' Create the excel workbook instance.
  5.        Dim workbook As IWorkbook = Nothing
  6.  
  7.        ' Load the workbook.
  8.        Using file As New IO.FileStream(WorkBookFile, IO.FileMode.Open, IO.FileAccess.Read)
  9.            workbook = New XSSFWorkbook(file)
  10.        End Using
  11.  
  12.        ' Get the first sheet.
  13.        Dim sheet As ISheet = workbook.GetSheetAt(0)
  14.  
  15.        ' Get the first row.
  16.        Dim row As IRow = sheet.GetRow(0)
  17.  
  18.        ' Create a cell.
  19.        Dim cell As ICell = row.CreateCell(1)
  20.  
  21.        ' Get the cell value.
  22.        If String.IsNullOrEmpty(cell.StringCellValue) Then ' If value is emty then...
  23.  
  24.            ' Set cell value.
  25.            cell.SetCellValue("This is a test")
  26.  
  27.        End If
  28.  
  29.        ' Save changes.
  30.        Using sw As IO.FileStream = IO.File.Create(WorkBookFile)
  31.            workbook.Write(sw)
  32.        End Using
« Última modificación: 23 Agosto 2014, 12:50 pm por Eleкtro » En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #427 en: 30 Agosto 2014, 19:45 pm »

Una versión actualizada de mi Reg-Editor

Contiene todo tipo de métodos para el manejo del registro de Windows.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-30-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Class1.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' -----------
  13. ' Create Key:
  14. ' -----------
  15. ' RegEdit.CreateKey("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
  16. ' RegEdit.CreateKey("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
  17. '
  18. ' -----------
  19. ' Delete Key:
  20. ' -----------
  21. ' RegEdit.DeleteKey("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
  22. ' RegEdit.DeleteKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
  23. '
  24. ' -------------
  25. ' Delete Value:
  26. ' -------------
  27. ' RegEdit.DeleteValue("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
  28. ' RegEdit.DeleteValue("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
  29. '
  30. ' ----------
  31. ' Get Value:
  32. ' ----------
  33. ' Dim Data As String = RegEdit.GetValue("HKCU\Software\MyProgram", "Value name"))
  34. ' Dim Data As String = RegEdit.GetValue("HKEY_CURRENT_USER\Software\MyProgram", "Value name"))
  35. '
  36. ' ----------
  37. ' Set Value:
  38. ' ----------
  39. ' RegEdit.SetValue("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)               ' Create/Replace "Value Name" with "Data" as string data
  40. ' RegEdit.SetValue("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
  41. '
  42. ' -----------
  43. ' Export Key:
  44. ' -----------
  45. ' RegEdit.ExportKey("HKLM", "C:\HKLM.reg")                  ' Export entire "HKEY_LOCAL_MACHINE" Tree to "C:\HKLM.reg" file.
  46. ' RegEdit.ExportKey("HKLM\Software\7-zip\", "C:\7-zip.reg") ' Export entire "7-zip" Tree to "C:\7-zip.reg" file.
  47. '
  48. ' ------------
  49. ' Import File:
  50. ' ------------
  51. ' RegEdit.ImportRegFile("C:\Registry_File.reg") ' Install a registry file.
  52. '
  53. ' ------------
  54. ' Jump To Key:
  55. ' ------------
  56. ' RegEdit.JumpToKey("HKLM")                               ' Opens Regedit at "HKEY_LOCAL_MACHINE" Root.
  57. ' RegEdit.JumpToKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Opens Regedit at "HKEY_LOCAL_MACHINE\Software\7-zip" tree.
  58. '
  59. ' -----------
  60. ' Exist Key?:
  61. ' -----------
  62. ' MsgBox(RegEdit.ExistKey("HKCU\software") ' Checks if "Software" Key exist.
  63.  
  64. ' -------------
  65. ' Exist Value?:
  66. ' -------------
  67. ' MsgBox(RegEdit.ExistValue("HKLM\software\7-zip", "Path") ' Checks if "Path" value exist.
  68. '
  69. ' ------------
  70. ' Exist Data?:
  71. ' ------------
  72. ' MsgBox(RegEdit.ExistData("HKLM\software\7-zip", "Path") ' Checks if "Path" value have empty data.
  73. '
  74. ' ---------
  75. ' Copy Key:
  76. ' ---------
  77. ' RegEdit.CopyKey("HKCU\Software\7-Zip", "HKCU\Software\7-zip Backup") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-zip Backup"
  78. '
  79. ' -----------
  80. ' Copy Value:
  81. ' -----------
  82. ' RegEdit.CopyValue("HKLM\software\7-zip", "path", "HKLM\software\7-zip", "path_backup") ' Copies "Path" value with their data to "HKLM\software\7-zip" "path_backup".
  83. '
  84. ' -------------------
  85. ' SetUserAccessKey:
  86. ' -------------------
  87. ' RegEdit.SetUserAccessKey("HKCU\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access})
  88. ' RegEdit.SetUserAccessKey("HKEY_CURRENT_USER\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access, RegEdit.ReginiUserAccess.Creator_Full_Access, RegEdit.ReginiUserAccess.System_Full_Access})
  89.  
  90. #End Region
  91.  
  92. #Region " Imports "
  93.  
  94. Imports Microsoft.Win32
  95. Imports System.IO
  96. Imports System.Text
  97.  
  98. #End Region
  99.  
  100. #Region " RegEdit "
  101.  
  102. ''' <summary>
  103. ''' Contains registry related methods.
  104. ''' </summary>
  105. Public Class RegEdit
  106.  
  107. #Region " Enumerations "
  108.  
  109.    ''' <summary>
  110.    ''' Specifies an User identifier for Regini.exe command.
  111.    ''' </summary>
  112.    Public Enum ReginiUserAccess As Integer
  113.  
  114.        Administrators_Full_Access = 1I
  115.  
  116.        Administrators_Read_Access = 2I
  117.  
  118.        Administrators_Read_and_Write_Access = 3I
  119.  
  120.        Administrators_Read_Write_and_Delete_Access = 4I
  121.  
  122.        Administrators_Read_Write_and_Execute_Access = 20I
  123.  
  124.        Creator_Full_Access = 5I
  125.  
  126.        Creator_Read_and_Write_Access = 6I
  127.  
  128.        Interactive_User_Full_Access = 21I
  129.  
  130.        Interactive_User_Read_and_Write_Access = 22I
  131.  
  132.        Interactive_User_Read_Write_and_Delete_Access = 23I
  133.  
  134.        Power_Users_Full_Access = 11I
  135.  
  136.        Power_Users_Read_and_Write_Access = 12I
  137.  
  138.        Power_Users_Read_Write_and_Delete_Access = 13I
  139.  
  140.        System_Full_Access = 17I
  141.  
  142.        System_Operators_Full_Access = 14I
  143.  
  144.        System_Operators_Read_and_Write_Access = 15I
  145.  
  146.        System_Operators_Read_Write_and_Delete_Access = 16I
  147.  
  148.        System_Read_Access = 19I
  149.  
  150.        System_Read_and_Write_Access = 18I
  151.  
  152.        World_Full_Access = 7I
  153.  
  154.        World_Read_Access = 8I
  155.  
  156.        World_Read_and_Write_Access = 9I
  157.  
  158.        World_Read_Write_and_Delete_Access = 10I
  159.  
  160.    End Enum
  161.  
  162. #End Region
  163.  
  164. #Region " Public Methods "
  165.  
  166. #Region " Create "
  167.  
  168.    ''' <summary>
  169.    ''' Creates a new registry key.
  170.    ''' </summary>
  171.    ''' <param name="Key">Indicates the registry key.</param>
  172.    Public Shared Sub CreateKey(ByVal Key As String)
  173.  
  174.        Using Reg As RegistryKey = GetRoot(Key)
  175.  
  176.            Reg.CreateSubKey(GetPath(Key), RegistryKeyPermissionCheck.Default, RegistryOptions.None)
  177.  
  178.        End Using
  179.  
  180.    End Sub
  181.  
  182. #End Region
  183.  
  184. #Region " Delete "
  185.  
  186.    ''' <summary>
  187.    ''' Deletes a registry key.
  188.    ''' </summary>
  189.    ''' <param name="Key">Indicates the registry key.</param>
  190.    Public Shared Sub DeleteKey(ByVal Key As String)
  191.  
  192.        Using Reg As RegistryKey = GetRoot(Key)
  193.  
  194.            Reg.DeleteSubKeyTree(GetPath(Key), throwOnMissingSubKey:=False)
  195.  
  196.        End Using
  197.  
  198.    End Sub
  199.  
  200.    ''' <summary>
  201.    ''' Delete a registry value.
  202.    ''' </summary>
  203.    ''' <param name="Key">Indicates the registry key.</param>
  204.    ''' <param name="Value">Indicates the registry value.</param>
  205.    Public Shared Sub DeleteValue(ByVal Key As String,
  206.                                  ByVal Value As String)
  207.  
  208.        Using Reg As RegistryKey = GetRoot(Key)
  209.  
  210.            Reg.OpenSubKey(GetPath(Key), writable:=False).
  211.                DeleteValue(Value, throwOnMissingValue:=False)
  212.  
  213.        End Using
  214.  
  215.    End Sub
  216.  
  217. #End Region
  218.  
  219. #Region " Get "
  220.  
  221.    ''' <summary>
  222.    ''' Gets the data of a registry value.
  223.    ''' </summary>
  224.    ''' <param name="Key">Indicates the registry key.</param>
  225.    ''' <param name="Value">Indicates the registry value.</param>
  226.    ''' <returns>The registry data.</returns>
  227.    Public Shared Function GetValue(ByVal Key As String,
  228.                                    ByVal Value As String) As Object
  229.  
  230.        Using Reg As RegistryKey = GetRoot(Key)
  231.  
  232.            Return Reg.OpenSubKey(GetPath(Key), writable:=False).
  233.                       GetValue(Value, defaultValue:=Nothing)
  234.  
  235.        End Using
  236.  
  237.    End Function
  238.  
  239. #End Region
  240.  
  241. #Region " Set "
  242.  
  243.    ''' <summary>
  244.    ''' Set the data of a registry value.
  245.    ''' If the Key or value doesn't exist it will be created.
  246.    ''' </summary>
  247.    ''' <param name="Key">Indicates the registry key.</param>
  248.    ''' <param name="Value">Indicates the registry value.</param>
  249.    ''' <param name="Data">Indicates the registry data.</param>
  250.    ''' <param name="DataType">Indicates the type of data.</param>
  251.    Public Shared Sub SetValue(ByVal Key As String,
  252.                               ByVal Value As String,
  253.                               ByVal Data As Object,
  254.                               Optional ByVal DataType As RegistryValueKind = RegistryValueKind.Unknown)
  255.  
  256.        Using Reg As RegistryKey = GetRoot(Key)
  257.  
  258.            Select Case DataType
  259.  
  260.                Case RegistryValueKind.Unknown
  261.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  262.                        SetValue(Value, Data)
  263.  
  264.                Case RegistryValueKind.Binary
  265.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  266.                        SetValue(Value, Encoding.ASCII.GetBytes(Data), RegistryValueKind.Binary)
  267.  
  268.                Case Else
  269.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  270.                        SetValue(Value, Data, DataType)
  271.  
  272.            End Select
  273.  
  274.        End Using
  275.  
  276.    End Sub
  277.  
  278. #End Region
  279.  
  280. #Region " Exist "
  281.  
  282.    ''' <summary>
  283.    ''' Determines whether a Key exists.
  284.    ''' </summary>
  285.    ''' <param name="Key">Indicates the registry key.</param>
  286.    ''' <returns><c>true</c> if key exist, <c>false</c> otherwise.</returns>
  287.    Public Shared Function ExistKey(ByVal Key As String) As Boolean
  288.  
  289.        Dim RootKey As RegistryKey = GetRoot(Key)
  290.        Dim KeyPath As String = GetPath(Key)
  291.  
  292.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  293.            Return False
  294.        End If
  295.  
  296.        Using Reg As RegistryKey = RootKey
  297.  
  298.            Return RootKey.OpenSubKey(KeyPath, writable:=False) IsNot Nothing
  299.  
  300.        End Using
  301.  
  302.    End Function
  303.  
  304.    ''' <summary>
  305.    ''' Determines whether a value exists.
  306.    ''' </summary>
  307.    ''' <param name="Key">Indicates the registry key.</param>
  308.    ''' <param name="Value">Indicates the registry value.</param>
  309.    ''' <returns><c>true</c> if value exist, <c>false</c> otherwise.</returns>
  310.    Public Shared Function ExistValue(ByVal Key As String, ByVal Value As String) As Boolean
  311.  
  312.        Dim RootKey As RegistryKey = GetRoot(Key)
  313.        Dim KeyPath As String = GetPath(Key)
  314.  
  315.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  316.            Return False
  317.        End If
  318.  
  319.        Using Reg As RegistryKey = RootKey
  320.  
  321.            Return RootKey.OpenSubKey(KeyPath, writable:=False).
  322.                           GetValue(Value, defaultValue:=Nothing) IsNot Nothing
  323.  
  324.        End Using
  325.  
  326.    End Function
  327.  
  328.    ''' <summary>
  329.    ''' Determines whether data exists in a registry value.
  330.    ''' </summary>
  331.    ''' <param name="Key">Indicates the registry key.</param>
  332.    ''' <param name="Value">Indicates the registry value.</param>
  333.    ''' <returns><c>true</c> if data exist, <c>false</c> otherwise.</returns>
  334.    Public Shared Function ExistData(ByVal Key As String, ByVal Value As String) As Boolean
  335.  
  336.        Dim RootKey As RegistryKey = GetRoot(Key)
  337.        Dim KeyPath As String = GetPath(Key)
  338.  
  339.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  340.            Return False
  341.        End If
  342.  
  343.        Using Reg As RegistryKey = RootKey
  344.  
  345.            Return Not String.IsNullOrEmpty(RootKey.OpenSubKey(KeyPath, writable:=False).
  346.                                                    GetValue(Value, defaultValue:=Nothing))
  347.  
  348.        End Using
  349.  
  350.    End Function
  351.  
  352. #End Region
  353.  
  354. #Region " Copy "
  355.  
  356.    ''' <summary>
  357.    ''' Copy a key tree to another location on the registry.
  358.    ''' </summary>
  359.    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
  360.    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
  361.    Public Shared Sub CopyKey(ByVal OldKey As String,
  362.                              ByVal NewKey As String)
  363.  
  364.        Using OldReg As RegistryKey = GetRoot(OldKey).OpenSubKey(GetPath(OldKey), writable:=False)
  365.  
  366.            CreateKey(NewKey)
  367.  
  368.            Using NewReg As RegistryKey = GetRoot(NewKey).OpenSubKey(GetPath(NewKey), writable:=True)
  369.  
  370.                CopySubKeys(OldReg, NewReg)
  371.  
  372.            End Using ' NewReg
  373.  
  374.        End Using ' OldReg
  375.  
  376.    End Sub
  377.  
  378.    ''' <summary>
  379.    ''' Copies a value with their data to another location on the registry.
  380.    ''' If the Key don't exist it will be created automatically.
  381.    ''' </summary>
  382.    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
  383.    ''' <param name="OldValue">Indicates the registry value to be copied from.</param>
  384.    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
  385.    ''' <param name="NewValue">Indicates the registry value to be pasted from.</param>
  386.    Public Shared Sub CopyValue(ByVal OldKey As String,
  387.                                ByVal OldValue As String,
  388.                                ByVal NewKey As String,
  389.                                ByVal NewValue As String)
  390.  
  391.        CreateKey(Key:=NewKey)
  392.        SetValue(Key:=NewKey, Value:=NewValue, Data:=GetValue(OldKey, OldValue), DataType:=RegistryValueKind.Unknown)
  393.  
  394.    End Sub
  395.  
  396. #End Region
  397.  
  398. #Region " Process dependant methods "
  399.  
  400.    ''' <summary>
  401.    ''' Opens Regedit process and jumps at the specified key.
  402.    ''' </summary>
  403.    ''' <param name="Key">Indicates the registry key.</param>
  404.    Public Shared Sub JumpToKey(ByVal Key As String)
  405.  
  406.        Using Reg As RegistryKey = GetRoot(Key)
  407.  
  408.            SetValue(Key:="HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit",
  409.                     Value:="LastKey",
  410.                     Data:=String.Format("{0}\{1}", Reg.Name, GetPath(Key)),
  411.                     DataType:=RegistryValueKind.String)
  412.  
  413.        End Using
  414.  
  415.        Process.Start(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Regedit.exe"))
  416.  
  417.    End Sub
  418.  
  419.    ''' <summary>
  420.    ''' Imports a registry file.
  421.    ''' </summary>
  422.    ''' <param name="RegFile">The registry file to import.</param>
  423.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  424.    Public Shared Function ImportRegFile(ByVal RegFile As String) As Boolean
  425.  
  426.        Using proc As New Process With {
  427.            .StartInfo = New ProcessStartInfo() With {
  428.                  .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
  429.                  .Arguments = String.Format("Import ""{0}""", RegFile),
  430.                  .CreateNoWindow = True,
  431.                  .WindowStyle = ProcessWindowStyle.Hidden,
  432.                  .UseShellExecute = False
  433.                }
  434.            }
  435.  
  436.            proc.Start()
  437.            proc.WaitForExit()
  438.  
  439.            Return Not CBool(proc.ExitCode)
  440.  
  441.        End Using
  442.  
  443.    End Function
  444.  
  445.    ''' <summary>
  446.    ''' Exports a key to a registry file.
  447.    ''' </summary>
  448.    ''' <param name="Key">Indicates the registry key.</param>
  449.    ''' <param name="OutputFile">Indicates the output file.</param>
  450.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  451.    Public Shared Function ExportKey(ByVal Key As String, ByVal OutputFile As String) As Boolean
  452.  
  453.        Using Reg As RegistryKey = GetRoot(Key)
  454.  
  455.            Using proc As New Process With {
  456.                    .StartInfo = New ProcessStartInfo() With {
  457.                          .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
  458.                          .Arguments = String.Format("Export ""{0}\{1}"" ""{2}"" /y", Reg.Name, GetPath(Key), OutputFile),
  459.                          .CreateNoWindow = True,
  460.                          .WindowStyle = ProcessWindowStyle.Hidden,
  461.                          .UseShellExecute = False
  462.                        }
  463.                    }
  464.  
  465.                proc.Start()
  466.                proc.WaitForExit()
  467.  
  468.                Return Not CBool(proc.ExitCode)
  469.  
  470.            End Using
  471.  
  472.        End Using
  473.  
  474.    End Function
  475.  
  476.    ''' <summary>
  477.    ''' Modifies the user permissions of a registry key.
  478.    ''' </summary>
  479.    ''' <param name="Key">Indicates the registry key.</param>
  480.    ''' <param name="UserAccess">Indicates the user-access.</param>
  481.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  482.    Public Shared Function SetUserAccessKey(ByVal Key As String, ByVal UserAccess() As ReginiUserAccess) As Boolean
  483.  
  484.        Dim tmpFile As String = Path.Combine(Path.GetTempPath(), "Regini.ini")
  485.  
  486.        Dim PermissionString As String =
  487.            String.Format("[{0}]",
  488.                          String.Join(" "c, UserAccess.Cast(Of Integer)))
  489.  
  490.        Using TextFile As New StreamWriter(path:=tmpFile, append:=False, encoding:=Encoding.Default)
  491.  
  492.            Using Reg As RegistryKey = GetRoot(Key)
  493.  
  494.                TextFile.WriteLine(String.Format("""{0}\{1}"" {2}", Reg.Name, GetPath(Key), PermissionString))
  495.  
  496.            End Using ' Reg
  497.  
  498.        End Using ' TextFile
  499.  
  500.        Using proc As New Process With {
  501.            .StartInfo = New ProcessStartInfo() With {
  502.                   .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Regini.exe"),
  503.                   .Arguments = ControlChars.Quote & tmpFile & ControlChars.Quote,
  504.                   .CreateNoWindow = True,
  505.                   .WindowStyle = ProcessWindowStyle.Hidden,
  506.                   .UseShellExecute = False
  507.                }
  508.            }
  509.  
  510.            proc.Start()
  511.            proc.WaitForExit()
  512.  
  513.            Return Not CBool(proc.ExitCode)
  514.  
  515.        End Using
  516.  
  517.    End Function
  518.  
  519. #End Region
  520.  
  521. #End Region
  522.  
  523. #Region " Private Methods "
  524.  
  525. #Region " Get "
  526.  
  527.    ''' <summary>
  528.    ''' Gets the registry root of a key.
  529.    ''' </summary>
  530.    ''' <param name="Key">Indicates the registry key.</param>
  531.    ''' <returns>The registry root.</returns>
  532.    Private Shared Function GetRoot(ByVal Key As String) As RegistryKey
  533.  
  534.        Select Case Key.ToUpper.Split("\").First
  535.  
  536.            Case "HKCR", "HKEY_CLASSES_ROOT"
  537.                Return Registry.ClassesRoot
  538.  
  539.            Case "HKCC", "HKEY_CURRENT_CONFIG"
  540.                Return Registry.CurrentConfig
  541.  
  542.            Case "HKCU", "HKEY_CURRENT_USER"
  543.                Return Registry.CurrentUser
  544.  
  545.            Case "HKLM", "HKEY_LOCAL_MACHINE"
  546.                Return Registry.LocalMachine
  547.  
  548.            Case "HKEY_PERFORMANCE_DATA"
  549.                Return Registry.PerformanceData
  550.  
  551.            Case Else
  552.                Return Nothing
  553.  
  554.        End Select
  555.  
  556.    End Function
  557.  
  558.    ''' <summary>
  559.    ''' Returns the registry path of a key.
  560.    ''' </summary>
  561.    ''' <param name="Key">Indicates the registry key.</param>
  562.    ''' <returns>The registry path.</returns>
  563.    Private Shared Function GetPath(ByVal Key As String) As String
  564.  
  565.        If String.IsNullOrEmpty(Key) Then
  566.            Return String.Empty
  567.        End If
  568.  
  569.        Dim KeyPath As String = Key.Substring(Key.IndexOf("\"c) + 1I)
  570.  
  571.        If KeyPath.EndsWith("\"c) Then
  572.            KeyPath = KeyPath.Substring(0I, KeyPath.LastIndexOf("\"c))
  573.        End If
  574.  
  575.        Return KeyPath
  576.  
  577.    End Function
  578.  
  579. #End Region
  580.  
  581. #Region " Copy "
  582.  
  583.    ''' <summary>
  584.    ''' Copies the sub-keys of the specified registry key.
  585.    ''' </summary>
  586.    ''' <param name="OldKey">Indicates the old key.</param>
  587.    ''' <param name="NewKey">Indicates the new key.</param>
  588.    Private Shared Sub CopySubKeys(ByVal OldKey As RegistryKey, ByVal NewKey As RegistryKey)
  589.  
  590.        ' Copy Values
  591.        For Each Value As String In OldKey.GetValueNames()
  592.  
  593.            NewKey.SetValue(Value, OldKey.GetValue(Value))
  594.  
  595.        Next Value
  596.  
  597.        ' Copy Subkeys
  598.        For Each SubKey As String In OldKey.GetSubKeyNames()
  599.  
  600.            CreateKey(String.Format("{0}\{1}", NewKey.Name, SubKey))
  601.            CopySubKeys(OldKey.OpenSubKey(SubKey, writable:=False), NewKey.OpenSubKey(SubKey, writable:=True))
  602.  
  603.        Next SubKey
  604.  
  605.    End Sub
  606.  
  607. #End Region
  608.  
  609. #End Region
  610.  
  611. End Class
  612.  
  613. #End Region
En línea


Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.701



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #428 en: 4 Septiembre 2014, 18:31 pm »

BetfairUtil

Con esta class pueden analizar los próximos eventos de un mercado de futbol de la página Betfair, para meterlos por ejemplo como DataSource de un GridView:



Nota: es necesaria la librería HtmlAgilityPack.


Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 09-01-2014
  4. ' ***********************************************************************
  5. ' <copyright file="BetfairUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Imports "
  11.  
  12. Imports HtmlAgilityPack
  13. Imports System.Web
  14.  
  15. #End Region
  16.  
  17. ''' <summary>
  18. ''' Contains web related methods for Betfair.
  19. ''' </summary>
  20. Public Class BetfairUtil
  21.  
  22. #Region " XPath Expressions "
  23.  
  24.    ''' <summary>
  25.    ''' XPath to locate the coming-up events grid.
  26.    ''' </summary>
  27.    Private Shared ReadOnly XPathComingUpGrid As String = "//*/ul[1][@class='event-list']/li[@class='avb-row COMING_UP']/*"
  28.  
  29.    ''' <summary>
  30.    ''' XPath to locate the home team name.
  31.    ''' </summary>
  32.    Private Shared ReadOnly XPathHomeTeam As String = ".//span[@class='home-team-name']"
  33.  
  34.    ''' <summary>
  35.    ''' XPath to locate the away team name.
  36.    ''' </summary>
  37.    Private Shared ReadOnly XPathAwayTeam As String = ".//span[@class='away-team-name']"
  38.  
  39.    ''' <summary>
  40.    ''' XPath to locate the day which the teams will play.
  41.    ''' </summary>
  42.    Private Shared ReadOnly XPathPlayDay As String = ".//span[@class='date']"
  43.  
  44.    ''' <summary>
  45.    ''' XPath to locate the hour at which the teams will play.
  46.    ''' </summary>
  47.    Private Shared ReadOnly XPathPlayHour As String = XPathPlayDay
  48.  
  49.    ''' <summary>
  50.    ''' XPath to locate the odds value 1.
  51.    ''' </summary>
  52.    Private Shared ReadOnly XPathOddResult1 As String = ".//*/li[@class='selection sel-0']/*/span['ui-runner-price*']"
  53.  
  54.    ''' <summary>
  55.    ''' XPath to locate the odds value 2.
  56.    ''' </summary>
  57.    Private Shared ReadOnly XPathOddResult2 As String = ".//*/li[@class='selection sel-1']/*/span['ui-runner-price*']"
  58.  
  59.    ''' <summary>
  60.    ''' XPath to locate the odds value 3.
  61.    ''' </summary>
  62.    Private Shared ReadOnly XPathOddResult3 As String = ".//*/li[@class='selection sel-2']/*/span['ui-runner-price*']"
  63.  
  64. #End Region
  65.  
  66. #Region " Types "
  67.  
  68.    ''' <summary>
  69.    ''' Specifies an event info.
  70.    ''' </summary>
  71.    Public Class BetfairEventInfo
  72.  
  73.        ''' <summary>
  74.        ''' Gets or sets the home team name.
  75.        ''' </summary>
  76.        ''' <value>The home team name.</value>
  77.        Public Property HomeTeam As String
  78.  
  79.        ''' <summary>
  80.        ''' Gets or sets the away team name.
  81.        ''' </summary>
  82.        ''' <value>The away team name.</value>
  83.        Public Property AwayTeam As String
  84.  
  85.        ''' <summary>
  86.        ''' Gets or sets the day which the teams will play.
  87.        ''' </summary>
  88.        ''' <value>The day which the teams will play.</value>
  89.        Public Property PlayDay As String
  90.  
  91.        ''' <summary>
  92.        ''' Gets or sets the hour at which the teams will play.
  93.        ''' </summary>
  94.        ''' <value>The hour at which the teams will play.</value>
  95.        Public Property PlayHour As String
  96.  
  97.        ''' <summary>
  98.        ''' Gets or sets the odds value for result '1'.
  99.        ''' (which depending on the Betfair section could be the value for column-names: "1", "Yes" or "More than...")
  100.        ''' </summary>
  101.        ''' <value>The odds value for result '1'.</value>
  102.        Public Property Result1 As Double
  103.  
  104.        ''' <summary>
  105.        ''' Gets or sets the odds value for result '2'.
  106.        ''' (which depending on the Betfair section could be the value for column-names: "X", "No" or "Less than...")
  107.        ''' </summary>
  108.        ''' <value>The odds value for result '2'.</value>
  109.        Public Property Result2 As Double
  110.  
  111.        ''' <summary>
  112.        ''' (which depending on the Betfair section could be the value for column-names: "2")
  113.        ''' </summary>
  114.        ''' <value>The odds value for result 'X'.</value>
  115.        Public Property ResultX As Double
  116.  
  117.    End Class
  118.  
  119. #End Region
  120.  
  121. #Region " Public Methods "
  122.  
  123.    ''' <summary>
  124.    ''' Gets the coming-up events from a Betfair page.
  125.    ''' </summary>
  126.    ''' <param name="HtmlSource">The Betfair webpage raw Html source-code to parse the events.</param>
  127.    ''' <returns>List(Of EventInfo).</returns>
  128.    ''' <exception cref="System.Exception">Node not found in the html source-code, maybe there is any coming-up event?</exception>
  129.    Public Shared Function GetComingUpEvents(ByVal HtmlSource As String) As List(Of BetfairEventInfo)
  130.  
  131.        ' The event collection to add events.
  132.        Dim EventInfoList As New List(Of BetfairEventInfo)
  133.  
  134.        ' The current event info.
  135.        Dim EventInfo As BetfairEventInfo
  136.  
  137.        ' Initialize the HtmlDoc object.
  138.        Dim Doc As New HtmlDocument
  139.  
  140.        ' Load the Html document.
  141.        Doc.LoadHtml(HtmlSource)
  142.  
  143.        ' A temporal node to determine whether the node exist.
  144.        Dim tempNode As HtmlNode
  145.  
  146.        ' The HtmlDocument nodes to analyze.
  147.        Dim Nodes As HtmlNodeCollection
  148.  
  149.        ' Select the Teams nodes.
  150.        Nodes = Doc.DocumentNode.SelectNodes(XPathComingUpGrid)
  151.  
  152.        If Nodes Is Nothing Then ' Node not found in the html source-code.
  153.            Throw New Exception("Node not found in the html source-code, maybe there is any coming-up event?")
  154.            Return Nothing
  155.        End If
  156.  
  157.        ' Loop trough the nodes.
  158.        For Each Node As HtmlNode In Nodes
  159.  
  160.            EventInfo = New BetfairEventInfo
  161.  
  162.            ' Retrieve and set the home team name.
  163.            EventInfo.HomeTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathHomeTeam).InnerText.
  164.                                                        Replace("(W)", String.Empty).
  165.                                                        Replace("(HT)", String.Empty).
  166.                                                        Replace("(QAT)", String.Empty).
  167.                                                        Replace("(Uru)", String.Empty).
  168.                                                        Replace("(Ecu)", String.Empty).
  169.                                                        Replace("(Bol)", String.Empty).
  170.                                                        Trim)
  171.  
  172.            ' Retrieve and set the away team name.
  173.            EventInfo.AwayTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathAwayTeam).InnerText.
  174.                                                        Replace("(W)", String.Empty).
  175.                                                        Replace("(HT)", String.Empty).
  176.                                                        Replace("(QAT)", String.Empty).
  177.                                                        Replace("(Uru)", String.Empty).
  178.                                                        Replace("(Ecu)", String.Empty).
  179.                                                        Replace("(Bol)", String.Empty).
  180.                                                        Trim)
  181.  
  182.            ' Retrieve and set the day which the teams will play.
  183.            tempNode = Node.SelectSingleNode(XPathPlayDay)
  184.            If tempNode IsNot Nothing Then
  185.  
  186.                EventInfo.PlayDay = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayDay).
  187.                                                           InnerText.
  188.                                                           Trim)
  189.  
  190.                ' This value can contains different words or one word;
  191.                ' Such as: "Mañana 14:00" or "14:00" or "03 Sep 14".
  192.                ' If the value is only the hour, the day is today.
  193.                If EventInfo.PlayDay Like "##:##" Then
  194.                    EventInfo.PlayDay = "Hoy"
  195.  
  196.                ElseIf EventInfo.PlayDay Like "Mañana*" Then
  197.                    EventInfo.PlayDay = EventInfo.PlayDay.Split(" "c).First
  198.  
  199.                End If
  200.  
  201.                If Not EventInfo.PlayDay Like "## *" Then
  202.  
  203.                    ' Retrieve and set the hour at which the teams will play.
  204.                    EventInfo.PlayHour = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayHour).
  205.                                                                InnerText.
  206.                                                                Trim.
  207.                                                                Split(" "c).Last)
  208.                Else
  209.                    EventInfo.PlayHour = "N/A" ' Unknown, the hour is not displayed.
  210.                End If
  211.  
  212.            Else
  213.                EventInfo.PlayDay = "Error"
  214.                EventInfo.PlayHour = "Error"
  215.  
  216.            End If
  217.  
  218.            ' Retrieve and set the odds for result '1'.
  219.            tempNode = Node.SelectSingleNode(XPathOddResult1) ' Test whether the node exists.
  220.            If tempNode IsNot Nothing Then
  221.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
  222.                OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
  223.                OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
  224.                    EventInfo.Result1 = 0
  225.  
  226.                Else
  227.                    EventInfo.Result1 = Node.SelectSingleNode(XPathOddResult1).InnerText.Trim().Replace(".", ",")
  228.                End If
  229.  
  230.            Else
  231.                EventInfo.Result1 = 0
  232.            End If
  233.  
  234.            ' Retrieve and set the odds for result '2'.
  235.            tempNode = Node.SelectSingleNode(XPathOddResult2) ' Test whether the node exists.
  236.            If tempNode IsNot Nothing Then
  237.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
  238.                OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
  239.                OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
  240.                    EventInfo.Result2 = 0
  241.  
  242.                Else
  243.                    EventInfo.Result2 = Node.SelectSingleNode(XPathOddResult2).InnerText.Trim().Replace(".", ",")
  244.  
  245.                End If
  246.  
  247.            Else
  248.                EventInfo.Result2 = 0
  249.            End If
  250.  
  251.            ' Retrieve and set the odds for result 'X'.
  252.            tempNode = Node.SelectSingleNode(XPathOddResult3) ' Test whether the node exists.
  253.            If tempNode IsNot Nothing Then
  254.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode