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

<< < (3/119) > >>

Eleкtro:
Para una aplicación necesité dividir el tamaño de unos MEgaBytes entre la capacidad de un DVD5, así que ya puestos he hecho este snippet que divide el tamaño entre varios formatos de discos, para la próxima ocasión.

PD: Las medidas están sacadas de la Wikipedia, para los más...  :-X

Saludos.

Código
   ' Usage:
   '
   ' MsgBox(ConvertToDiscSize(737280000, "Bytes", "CD"))
   ' MsgBox(ConvertToDiscSize(700, "MB", "CD"))
   ' MsgBox(Math.Ceiling(ConvertToDiscSize(6.5, "GB", "DVD")))
   ' MsgBox(ConvertToDiscSize(40, "GB", "BR").ToString.Substring(0, 3) & " Discs")
 
#Region " Convert To Disc Size function"
   Private Function ConvertToDiscSize(ByVal FileSize As Double, ByVal FileKindSize As String, ByVal To_DiscKindCapacity As String)
 
       ' KindSize Measures:
       ' --------------------------
       ' Bytes
       ' KB
       ' MB
       ' GB
 
       ' ToDiscKind Measures:
       ' -----------------------------
       ' CD
       ' CD800
       ' CD900
       ' DVD
       ' DVD-DL
       ' BR
       ' BR-DL
       ' BR-3L
       ' BR-4L
       ' BR-MD
       ' BR-MD-DL
 
 
       ' Bytes
       If FileKindSize.ToUpper = "BYTES" Then
           If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 737280000 ' CD Standard
           If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 829440393.216 ' CD 800 MB
           If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 912383803.392 ' CD 900 MB
           If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4700000000 ' DVD Standard (DVD5
           If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8500000000 ' DVD Double Layer (DVD9)
           If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 25025314816 ' BluRay Standard
           If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 50050629632 ' BluRay Double Layer
           If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 100103356416 ' BluRay x3 Layers
           If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 128001769472 ' BluRay x4 Layers
           If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7791181824 ' BluRay MiniDisc Standard
           If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 15582363648 ' BluRay MiniDisc Double Layer
 
           ' KB
       ElseIf FileKindSize.ToUpper = "KB" Then
           If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 720000 ' CD Standard
           If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 810000.384 ' CD 800 MB
           If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 890999.808 ' CD 900 MB
           If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4589843.75 ' DVD Standard (DVD5)
           If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8300781.25 ' DVD Double Layer (DVD9)
           If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 24438784 ' BluRay Standard
           If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 48877568 ' BluRay Double Layer
           If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 97757184 ' BluRay x3 Layers
           If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 125001728 ' BluRay x4 Layers
           If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7608576 ' BluRay MiniDisc Standard
           If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 15217152 ' BluRay MiniDisc Double Layer
 
           ' MB
       ElseIf FileKindSize.ToUpper = "MB" Then
           If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 703.125 ' CD Standard
           If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 791.016 ' CD 800 MB
           If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 870.117 ' CD 900 MB
           If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4482.26929 ' DVD Standard (DVD5)
           If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8106.23169 ' DVD Double Layer (DVD9)
           If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 23866 ' BluRay Standard
           If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 47732 ' BluRay Double Layer
           If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 95466 ' BluRay x3 Layers
           If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 122072 ' BluRay x4 Layers
           If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7430.25 ' BluRay MiniDisc Standard
           If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 14860.5 ' BluRay MiniDisc Double Layer
 
           ' GB
       ElseIf FileKindSize.ToUpper = "GB" Then
           If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 0.68665 ' CD Standard
           If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 0.77248 ' CD 800 MB
           If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 0.84972 ' CD 900 MB
           If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4.37722 ' DVD Standard (DVD5)
           If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 7.91624 ' DVD Double Layer (DVD9)
           If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 23.30664 ' BluRay Standard
           If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 46.61328 ' BluRay Double Layer
           If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 93.22852 ' BluRay x3 Layers
           If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 119.21094 ' BluRay x4 Layers
           If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7.2561 ' BluRay MiniDisc Standard
           If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 14.51221 ' BluRay MiniDisc Double Layer
       End If
 
       Return Nothing ' Argument measure not found
 
   End Function
#End Region

Eleкtro:
He actualizado el pack de Snippets en el post principal (Antes eran 76, ahora 114)

Si alguien quiere que incluya un pack con sus snippets en el post principal porfavor que me pase los snippets en formato de snippet (Archivo.snippet).

Y añado este snippet, un delimitador de strings, es parecido al método "Split", pero bajo mi opinión lo he mejorado bastante!

· Acepta 1 o 2 delimitadores,
· Opción de IgnoreCase
· Delimitar de izquierda a derecha o de derecha a izquierda.

Saludos!

Código
#Region " Delimit_String Function "
 
   ' // By Elektro H@ker
   '
   ' USAGE:
   '
   ' MsgBox(Delimit_String("Welcome to my new house", "to")) ' my new house
   ' MsgBox(Delimit_String("Welcome to my new house", "to", "house")) ' my new
   ' MsgBox(Delimit_String("Welcome to my new house", "TO", "HoUSe", True)) ' my new
   ' MsgBox(Delimit_String("Welcome to my new house", "house", "to", , "Left")) ' my new
   ' MsgBox(Delimit_String("Welcome to my new house", "TO", "HoUSe", False)) ' False
   ' MsgBox(Delimit_String("Welcome to my new house", "to", "to", , "Left")) ' Index was outside bounds of the array
 
   Private Function Delimit_String(ByVal STR As String, ByVal Delimiter_A As String, Optional ByVal Delimiter_B As String = "", Optional ByVal Ignore_Case As Boolean = False, Optional ByVal Left_Or_Right As String = "Right")
       Dim Compare_Method As Integer = 0 ' Don't ignore case
       If Ignore_Case = True Then Compare_Method = 1 ' Ignore Case
 
       If Not Left_Or_Right.ToUpper = "LEFT" And Not Left_Or_Right.ToUpper = "RIGHT" _
           Then Return False ' Returns false if the Left_Or_Right argument is in incorrect format
 
       If Compare_Method = 0 Then
           If Not STR.Contains(Delimiter_A) Or Not STR.Contains(Delimiter_B) _
               Then Return False ' Returns false if one of the delimiters in NormalCase can 't be found
       Else
           If Not STR.ToUpper.Contains(Delimiter_A.ToUpper) Or Not STR.ToUpper.Contains(Delimiter_B.ToUpper) _
           Then Return False ' Returns false if one of the delimiters in IgnoreCase can 't be found
       End If
 
       Try
           If Left_Or_Right.ToUpper = "LEFT" Then STR = Split(STR, Delimiter_A, , Compare_Method)(0) _
               Else If Left_Or_Right.ToUpper = "RIGHT" Then STR = Split(STR, Delimiter_A, , Compare_Method)(1)
 
           If Delimiter_B IsNot Nothing Then
               If Left_Or_Right.ToUpper = "LEFT" Then STR = Split(STR, Delimiter_B, , Compare_Method)(1) _
                Else If Left_Or_Right.ToUpper = "RIGHT" Then STR = Split(STR, Delimiter_B, , Compare_Method)(0)
           End If
 
           Return STR ' Returns the splitted string
       Catch ex As Exception
           Return ex.Message ' Returns exception if index is out of range
       End Try
   End Function
 
#End Region

Eleкtro:
Otro convertidor, en esta ocasión un convertidor de tiempo, ms, segundos, minutos, horas.


Código
#Region " Convert Time Function"
 
   ' // By Elektro H@cker
   '
   ' MsgBox(Convert_Time(1, "h", "m"))
   ' MsgBox(Convert_Time(1, "h", "s"))
   ' MsgBox(Convert_Time(1, "h", "ms"))
   ' MsgBox(Convert_Time(6000, "milliseconds", "seconds"))
   ' MsgBox(Convert_Time(6000, "seconds", "minutes"))
   ' MsgBox(Convert_Time(6000, "minutes", "hours"))
 
   Private Function Convert_Time(ByVal Time As Int64, ByVal Input_Time_Format As String, ByVal Output_Time_Format As String)
       Dim Time_Span As New TimeSpan
       If Input_Time_Format.ToUpper = "MS" Or Output_Time_Format.ToUpper = "MILLISECONDS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerMillisecond * Time)
       If Input_Time_Format.ToUpper = "S" Or Output_Time_Format.ToUpper = "SECONDS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerSecond * Time)
       If Input_Time_Format.ToUpper = "M" Or Output_Time_Format.ToUpper = "MINUTES" Then Time_Span = New TimeSpan(TimeSpan.TicksPerMinute * Time)
       If Input_Time_Format.ToUpper = "H" Or Output_Time_Format.ToUpper = "HOURS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerHour * Time)
       If Output_Time_Format.ToUpper = "MS" Or Output_Time_Format.ToUpper = "MILLISECONDS" Then Return Time_Span.TotalMilliseconds
       If Output_Time_Format.ToUpper = "S" Or Output_Time_Format.ToUpper = "SECONDS" Then Return Time_Span.TotalSeconds
       If Output_Time_Format.ToUpper = "M" Or Output_Time_Format.ToUpper = "MINUTES" Then Return Time_Span.TotalMinutes
       If Output_Time_Format.ToUpper = "H" Or Output_Time_Format.ToUpper = "HOURS" Then Return Time_Span.TotalHours
       Return False ' Returns false if argument is in incorrect format
   End Function
 
#End Region
 

Eleкtro:
Set_PC_State

Código
   ' // By Elektro H@cker
 
   ' USAGE:
   '
   ' Set_PC_State(RESET)
   ' Set_PC_State(SUSPEND, 30, "I'm suspending your system.")
   ' Set_PC_State(LOG_OFF)
   ' Set_PC_State(HIBERN)
   ' Set_PC_State(ABORT)
 
#Region " Set PC State "
 
   Const RESET As String = " -R "
   Const SUSPEND As String = " -S "
   Const LOG_OFF As String = " -L "
   Const HIBERN As String = " -H "
   Const ABORT As String = " -A "
 
   Private Function Set_PC_State(ByVal PowerState_Action As String, Optional ByVal TimeOut As Integer = 1, Optional ByVal COMMENT As String = "")
 
       Dim Shutdown_Command As New ProcessStartInfo
       Shutdown_Command.FileName = "Shutdown.exe"
 
       Try
           If PowerState_Action = ABORT Or PowerState_Action = HIBERN Or PowerState_Action = LOG_OFF Then
               Shutdown_Command.Arguments = PowerState_Action ' Windows don't allow TimeOut or Comment options for HIBERN, LOG_OFF or ABORT actions.
           ElseIf PowerState_Action = RESET Or PowerState_Action = SUSPEND Then
               If Not COMMENT = "" Then
                   If COMMENT.Length > 512 Then COMMENT = COMMENT.Substring(0, 512) ' Only 512 chars are allowed for comment
                   Shutdown_Command.Arguments = PowerState_Action & " -T " & TimeOut & " /C " & COMMENT
               Else
                   Shutdown_Command.Arguments = PowerState_Action & " -T " & TimeOut
               End If
               Shutdown_Command.WindowStyle = ProcessWindowStyle.Hidden
               Process.Start(Shutdown_Command)
               Return True
           End If
       Catch ex As Exception
           Return ex.Message
       End Try
 
       Return Nothing ' Invalid argument
   End Function
 
#End Region




Día local:

Código
Dim Today as string = My.Computer.Clock.LocalTime.DayOfWeek ' In English language
 
Dim Today as string = System.Globalization.DateTimeFormatInfo.CurrentInfo.GetDayName(Date.Today.DayOfWeek) ' In system language



String is URL?

Código
   ' USAGE:
   '
   ' If String_Is_URL("http://google.com") Then MsgBox("Valid url!") Else MsgBox("Invalid url!")
 
#Region " String Is URL Function "
 
   Private Function String_Is_URL(ByVal STR As String)
       Dim URL_Pattern As String = "^(http|https):/{2}[a-zA-Z./&\d_-]+"
       Dim URL_RegEx As New System.Text.RegularExpressions.Regex(URL_Pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.ExplicitCapture)
       If URL_RegEx.IsMatch(STR) Then Return True Else Return False
   End Function
 
#End Region



G-Mail Sender (Envía emails)

Código
   ' USAGE:
   '
   ' GMail_Sender("Your_Email@Gmail.com", "Your_Password", "Email Subject", "Message Body", "Destiny@Email.com")
 
#Region " GMail Sender function "
 
   Private Function GMail_Sender(ByVal Gmail_Username As String, ByVal Gmail_Password As String, ByVal Email_Subject As String, ByVal Email_Body As String, ByVal Email_Destiny As String)
       Try
           Dim MailSetup As New System.Net.Mail.MailMessage
           MailSetup.Subject = Email_Subject
           MailSetup.To.Add(Email_Destiny)
           MailSetup.From = New System.Net.Mail.MailAddress(Gmail_Username)
           MailSetup.Body = Email_Body
           Dim SMTP As New System.Net.Mail.SmtpClient("smtp.gmail.com")
           SMTP.Port = 587
           SMTP.EnableSsl = True
           SMTP.Credentials = New Net.NetworkCredential(Gmail_Username, Gmail_Password)
           SMTP.Send(MailSetup)
           Return True ' Email is sended OK
       Catch ex As Exception
           Return ex.Message ' Email can't be sended
       End Try
   End Function
 
#End Region

Eleкtro:
Get OS Version

Código
       Dim OS_Version As String = System.Environment.OSVersion.ToString
       MsgBox(OS_Version)


String Is Email

Código
   ' // By Elektro H@cker
   '
   ' USAGE:
   '
   ' MsgBox(String_Is_Email("User@Email.com"))
 
#Region " String Is Email Function "
 
   Private Function String_Is_Email(ByVal Email_String As String)
       Dim Emaill_RegEx As New System.Text.RegularExpressions.Regex("^[A-Za-z0-9][A-Za-z0-9]+\@[A-Za-z0-9]+\.[A-Za-z0-9][A-Za-z0-9]+$")
       If Emaill_RegEx.IsMatch(Email_String) Then Return True Else Return False
   End Function
 
#End Region


Get Random Password

Código
   ' USAGE:
   '
   ' MsgBox(Get_Random_Password(8))
   ' MsgBox(Get_Random_Password(36))
 
#Region " Get Random Password Function "
 
   Public Function Get_Random_Password(ByVal Password_Length As Double) As String
       Dim New_Password As String = System.Guid.NewGuid.ToString
       If Password_Length <= 0 OrElse Password_Length > New_Password.Length Then
           Throw New ArgumentException("Length must be between 1 and " & New_Password.Length)
       End If
       Return New_Password.Substring(0, Password_Length)
   End Function
 
#End Region


Get Printers

Código
   ' // By Elektro H@cker
   '
   ' USAGE:
   '
   '  For Each Printer_Name In Get_Printers() : MsgBox(Printer_Name) : Next
 
   Private Function Get_Printers()
       Dim Printer_Array As New List(Of String)
       Try
           For Each Printer_Name As String In System.Drawing.Printing.PrinterSettings.InstalledPrinters : Printer_Array.Add(Printer_Name) : Next
       Catch ex As Exception
           If ex.Message.Contains("RPC") Then Return "RPC Service is not avaliable"
       End Try
       Return Printer_Array
   End Function

Navegación

[0] Índice de Mensajes

[#] Página Siguiente

[*] Página Anterior