@lmarza
No revivas posts de hace 4 años, gracias.
Ya dispones de una variable con ese formato:
No revivas posts de hace 4 años, gracias.
Ya dispones de una variable con ese formato:
Código [Seleccionar]
Echo %DATE%
- Bienvenido a Test Foro de elhacker.net SMF 2.1.
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
#8992
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
8 Mayo 2013, 11:14 AM
Una class con funciones para realizar todo tipo de operaciones en el Registro de Windows:
- Crear clave
- Eliminar clave
- Crear valor
- Eliminar valor
- Obtener los datos de un valor
- Exportar clave
- Importar archivo
- Saltar a clave (abrir Regedit en clave específica)
- Comprobar si un valor existe
- Comprobar si los datos de un valor están vacíos
- Copiar clave a otro lugar del registro
- Copiar valor a otro lugar del registro
- Establecer permisos de usuario para una clave
- Crear clave
- Eliminar clave
- Crear valor
- Eliminar valor
- Obtener los datos de un valor
- Exportar clave
- Importar archivo
- Saltar a clave (abrir Regedit en clave específica)
- Comprobar si un valor existe
- Comprobar si los datos de un valor están vacíos
- Copiar clave a otro lugar del registro
- Copiar valor a otro lugar del registro
- Establecer permisos de usuario para una clave
Código (vbnet) [Seleccionar]
#Region " RegEdit "
' [ RegEdit Functions ]
'
' // By Elektro H@cker
'
' Examples :
'
' -----------
' Create Key:
' -----------
' RegEdit.Create_Key("HKCU\Software\MyProgram") ' Creates "HKCU\Software\MyProgram"
' RegEdit.Create_Key("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
'
' -----------
' Delete Key:
' -----------
' RegEdit.Delete_Key("HKLM\Software\7-zip") ' Deletes the "7-zip" tree including subkeys
' RegEdit.Delete_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
'
' -------------
' Delete Value:
' -------------
' RegEdit.Delete_Value("HKCU\Software\7-Zip", "Lang") ' Deletes "Lang" Value
' RegEdit.Delete_Value("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
'
' ----------
' Get Value:
' ----------
' Dim Data As String = RegEdit.Get_Value("HKCU\Software\MyProgram", "Value name"))
' Dim Data As String = RegEdit.Get_Value("HKEY_CURRENT_USER\Software\MyProgram", "Value name"))
'
' ----------
' Set Value:
' ----------
' RegEdit.Set_Value("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
' RegEdit.Set_Value("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
'
' -----------
' Export Key:
' -----------
' RegEdit.Export_Key("HKLM", "C:\HKLM.reg") ' Export entire "HKEY_LOCAL_MACHINE" Tree to "C:\HKLM.reg" file.
' RegEdit.Export_Key("HKLM\Software\7-zip\", "C:\7-zip.reg") ' Export entire "7-zip" Tree to "C:\7-zip.reg" file.
'
' ------------
' Import File:
' ------------
' RegEdit.Import_RegFile("C:\Registry_File.reg") ' Install a registry file.
'
' ------------
' Jump To Key:
' ------------
' RegEdit.Jump_To_Key("HKLM") ' Opens Regedit at "HKEY_LOCAL_MACHINE" Root.
' RegEdit.Jump_To_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Opens Regedit at "HKEY_LOCAL_MACHINE\Software\7-zip" tree.
'
' -------------
' Exist Value?:
' -------------
' MsgBox(RegEdit.Exist_Value("HKLM\software\7-zip", "Path") ' Checks if "Path" value exist.
'
' ------------
' Exist Data?:
' ------------
' MsgBox(RegEdit.Exist_Data("HKLM\software\7-zip", "Path") ' Checks if "Path" value have empty data.
'
' ---------
' Copy Key:
' ---------
' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", Nothing, "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-Zip"
' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", Nothing) ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\"
' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", Nothing, Nothing) ' Copies "HKCU\Software\7-Zip" to "HKLM\"
' RegEdit.Copy_Key("HKCU", "\Software\", "\7-Zip\", "HKLM", "\Software\", "\7-zip\") ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
'
' -----------
' Copy Value:
' -----------
' RegEdit.Copy_Value("HKLM\software\7-zip", "path", "HKLM\software\7-zip", "path_backup") ' Copies "Path" value with their data to "HKLM\software\7-zip" "path_backup".
'
' -----------
' Set_UserAccess_Key:
' -----------
' RegEdit.Set_UserAccess_Key("HKCU\Software\7-Zip", {RegEdit.RegUserAccess.Administrators_Full_Access})
' RegEdit.Set_UserAccess_Key("HKEY_CURRENT_USER\Software\7-Zip", {RegEdit.RegUserAccess.Administrators_Full_Access, RegEdit.RegUserAccess.Creator_Full_Access, RegEdit.RegUserAccess.System_Full_Access})
#Region " RegEdit Class "
Public Class RegEdit
''' <summary>
''' Create a new registry key.
''' </summary>
Public Shared Function Create_Key(ByVal RegKey As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
Dim KeyPath As String = Get_Key_Path(RegKey)
Try
RootKey.CreateSubKey(KeyPath)
RootKey.Close()
RootKey.Dispose()
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Delete a registry key.
''' </summary>
Public Shared Function Delete_Key(ByVal RegKey As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
Dim KeyPath As String = Get_Key_Path(RegKey)
Try
RootKey.DeleteSubKeyTree(KeyPath)
RootKey.Close()
RootKey.Dispose()
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Delete a registry key.
''' </summary>
Public Shared Function Delete_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
Dim KeyPath As String = Get_Key_Path(RegKey)
Try
RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
RootKey.Close()
RootKey.Dispose()
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Get the data of a registry value.
''' </summary>
Public Shared Function Get_Value(ByVal RegKey As String, ByVal RegValue As String) As String
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
Try
Return My.Computer.Registry.GetValue(KeyPath, RegValue, Nothing)
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Set the data of a registry value.
''' If the Key or value don't exist it will be created automatically.
''' </summary>
Public Shared Function Set_Value(ByVal RegKey As String, _
ByVal RegValue As String, _
ByVal RegData As String, _
ByVal RegDataType As Microsoft.Win32.RegistryValueKind) As Boolean
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
Try
If RegDataType = Microsoft.Win32.RegistryValueKind.Binary Then
My.Computer.Registry.SetValue(KeyPath, RegValue, System.Text.Encoding.ASCII.GetBytes(RegData), Microsoft.Win32.RegistryValueKind.Binary)
Else
My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
End If
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Export a registry key (including sub-keys) to a file.
''' </summary>
Public Shared Function Export_Key(ByVal RegKey As String, ByVal OutputFile As String) As Boolean
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
Try
Dim Regedit As New Process()
Dim Regedit_Info As New ProcessStartInfo()
Regedit_Info.FileName = "Reg.exe"
Regedit_Info.Arguments = "Export " & """" & KeyPath & """" & " " & """" & OutputFile & """" & " /y"
Regedit_Info.CreateNoWindow = True
Regedit_Info.WindowStyle = ProcessWindowStyle.Hidden
Regedit_Info.UseShellExecute = False
Regedit.StartInfo = Regedit_Info
Regedit.Start()
Regedit.WaitForExit()
If Regedit.ExitCode <> 0 Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Import a registry file.
''' </summary>
Public Shared Function Import_RegFile(ByVal RegFile As String) As Boolean
If IO.File.Exists(RegFile) Then
Try
Dim Regedit As New Process()
Dim Regedit_Info As New ProcessStartInfo()
Regedit_Info.FileName = "Reg.exe"
Regedit_Info.Arguments = "Import " & """" & RegFile & """"
Regedit_Info.CreateNoWindow = True
Regedit_Info.WindowStyle = ProcessWindowStyle.Hidden
Regedit_Info.UseShellExecute = False
Regedit.StartInfo = Regedit_Info
Regedit.Start()
Regedit.WaitForExit()
If Regedit.ExitCode <> 0 Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
Else
' MsgBox("File don't exist")
Return False
End If
End Function
''' <summary>
''' Open Regedit at specific key.
''' </summary>
Public Shared Function Jump_To_Key(ByVal RegKey As String) As Boolean
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
Try
Set_Value("HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit", "LastKey", "" & KeyPath & "", Microsoft.Win32.RegistryValueKind.String)
Process.Start("Regedit.exe")
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Check if a value exist.
''' </summary>
Public Shared Function Exist_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
Dim KeyPath As String = Get_Key_Path(RegKey)
Try
If RootKey.OpenSubKey(KeyPath, False).GetValue(RegValue) = String.Empty Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Check if a value have empty data.
''' </summary>
Public Shared Function Exist_Data(ByVal RegKey As String, ByVal RegValue As String) As Boolean
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
Try
If My.Computer.Registry.GetValue(KeyPath, RegValue, Nothing) = Nothing Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Copy a key tree to another location of the registry.
''' </summary>
Public Shared Function Copy_Key(ByVal OldRootKey As String, _
ByVal OldPath As String, _
ByVal OldName As String, _
ByVal NewRootKey As String, _
ByVal NewPath As String, _
ByVal NewName As String) As Boolean
If OldPath Is Nothing Then OldPath = ""
If NewRootKey Is Nothing Then NewRootKey = OldRootKey
If NewPath Is Nothing Then NewPath = ""
If NewName Is Nothing Then NewName = ""
If OldRootKey.EndsWith("\") Then OldRootKey = OldRootKey.Substring(0, OldRootKey.Length - 1)
If NewRootKey.EndsWith("\") Then NewRootKey = NewRootKey.Substring(0, NewRootKey.Length - 1)
If OldPath.StartsWith("\") Then OldPath = OldPath.Substring(1, OldPath.Length - 1)
If OldPath.EndsWith("\") Then OldPath = OldPath.Substring(0, OldPath.Length - 1)
If NewPath.StartsWith("\") Then NewPath = NewPath.Substring(1, NewPath.Length - 1)
If NewPath.EndsWith("\") Then NewPath = NewPath.Substring(0, NewPath.Length - 1)
If OldName.StartsWith("\") Then OldName = OldName.Substring(1, OldName.Length - 1)
If OldName.EndsWith("\") Then OldName = OldName.Substring(0, OldName.Length - 1)
If NewName.StartsWith("\") Then NewName = NewName.Substring(1, NewName.Length - 1)
If NewName.EndsWith("\") Then NewName = NewName.Substring(0, NewName.Length - 1)
Dim OrigRootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(OldRootKey)
Dim DestRootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(NewRootKey)
Dim oldkey As Microsoft.Win32.RegistryKey = OrigRootKey.OpenSubKey(OldPath + "\" + OldName, True)
Dim newkey As Microsoft.Win32.RegistryKey = DestRootKey.OpenSubKey(NewPath, True).CreateSubKey(NewName)
Reg_Copy_SubKeys(oldkey, newkey)
Return True
End Function
Private Shared Sub Reg_Copy_SubKeys(OrigKey As Microsoft.Win32.RegistryKey, DestKey As Microsoft.Win32.RegistryKey)
Dim ValueNames As String() = OrigKey.GetValueNames()
Dim SubKeyNames As String() = OrigKey.GetSubKeyNames()
For i As Integer = 0 To ValueNames.Length - 1
Application.DoEvents()
DestKey.SetValue(ValueNames(i), OrigKey.GetValue(ValueNames(i)))
Next
For i As Integer = 0 To SubKeyNames.Length - 1
Application.DoEvents()
Reg_Copy_SubKeys(OrigKey.OpenSubKey(SubKeyNames(i), True), DestKey.CreateSubKey(SubKeyNames(i)))
Next
End Sub
''' <summary>
''' Copy a value with their data to another location of the registry.
''' If the Key don't exist it will be created automatically.
''' </summary>
Public Shared Function Copy_Value(ByVal RegKey As String, ByVal RegValue As String, _
ByVal NewRegKey As String, ByVal NewRegValue As String) As Boolean
Dim OldRootKey As String = Get_Root_Key(RegKey).ToString
Dim OldKeyPath As String = OldRootKey & "\" & Get_Key_Path(RegKey)
Dim NewRootKey As String = Get_Root_Key(NewRegKey).ToString
Dim NewKeyPath As String = NewRootKey & "\" & Get_Key_Path(NewRegKey)
Dim RegData = Get_Value(OldKeyPath, RegValue)
Try
Set_Value(NewKeyPath, NewRegValue, RegData, Microsoft.Win32.RegistryValueKind.Unknown)
Return True
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
''' <summary>
''' Valid User identifiers for Regini.exe command.
''' </summary>
Public Enum RegUserAccess As Short
Administrators_Full_Access = 1
Administrators_Read_Access = 2
Administrators_Read_and_Write_Access = 3
Administrators_Read_Write_and_Delete_Access4
Administrators_Read_Write_and_Execute_Access = 20
Creator_Full_Access = 5
Creator_Read_and_Write_Access = 6
Interactive_User_Full_Access = 21
Interactive_User_Read_and_Write_Access = 22
Interactive_User_Read_Write_and_Delete_Access = 23
Power_Users_Full_Access = 11
Power_Users_Read_and_Write_Access = 12
Power_Users_Read_Write_and_Delete_Access = 13
System_Full_Access = 17
System_Operators_Full_Access = 14
System_Operators_Read_and_Write_Access = 15
System_Operators_Read_Write_and_Delete_Access = 16
System_Read_Access = 19
System_Read_and_Write_Access = 18
World_Full_Access = 7
World_Read_Access = 8
World_Read_and_Write_Access = 9
World_Read_Write_and_Delete_Access = 10
End Enum
''' <summary>
''' Modify the User permissions of a registry key.
''' </summary>
Public Shared Function Set_UserAccess_Key(ByVal RegKey As String, ByVal RegUserAccess() As RegUserAccess) As Boolean
Dim PermissionString As String = Nothing
Dim RootKey As String = Get_Root_Key(RegKey).ToString
Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
For Each user In RegUserAccess
Application.DoEvents()
PermissionString += " " & user
Next
PermissionString = "[" & PermissionString & "]"
PermissionString = PermissionString.Replace("[ ", "[")
Try
Using TextFile As New IO.StreamWriter(System.IO.Path.GetTempPath() & "Regini.ini", False, System.Text.Encoding.ASCII)
TextFile.WriteLine("""" & KeyPath & """" & " " & PermissionString)
End Using
Dim Regini As New Process()
Dim Regini_Info As New ProcessStartInfo()
Regini_Info.FileName = "Regini.exe"
MsgBox(PermissionString)
MsgBox("Regini.exe " & """" & System.IO.Path.GetTempPath() & "Regini.ini" & """")
Regini_Info.Arguments = """" & System.IO.Path.GetTempPath() & "Regini.ini" & """"
Regini_Info.CreateNoWindow = True
Regini_Info.WindowStyle = ProcessWindowStyle.Hidden
Regini_Info.UseShellExecute = False
Regini.StartInfo = Regini_Info
Regini.Start()
Regini.WaitForExit()
If Regini.ExitCode <> 0 Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
' Throw New Exception(ex.Message)
Return False
End Try
End Function
' Returns the RootKey formatted
Private Shared Function Get_Root_Key(ByVal RegKey As String) As Microsoft.Win32.RegistryKey
Select Case RegKey.ToUpper.Split("\").First
Case "HKCR", "HKEY_CLASSES_ROOT" : Return Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : Return Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : Return Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : Return Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : Return Microsoft.Win32.Registry.PerformanceData
Case Else : Return Nothing
End Select
End Function
' Returns the KeyPath formatted
Private Shared Function Get_Key_Path(ByVal RegKey As String) As String
Dim KeyPath As String = String.Empty
For i As Integer = 1 To RegKey.Split("\").Length - 1
Application.DoEvents()
KeyPath += RegKey.Split("\")(i) & "\"
Next
If Not KeyPath.Contains("\") Then KeyPath = KeyPath & "\"
KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
Return KeyPath
End Function
End Class
#End Region
#End Region
#8993
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 21:08 PM
Una class para trabajar con StringCases por ejemplo para renombrar archivos de forma masiva a TitleCase,
contiene las funciones que posteé hace un tiempo, y le he añadido el "InvertedCase".
contiene las funciones que posteé hace un tiempo, y le he añadido el "InvertedCase".
Código (vbnet) [Seleccionar]
#Region " StringCase Class "
Public Class StringCase
' [ StringCase Functions ]
'
' // By Elektro H@cker
'
' Examples :
' MsgBox(StringCase.Titlecase("THiS is a TeST"))
' MsgBox(StringCase.DelimitedCase_Lower("THiS is a TeST", ";"))
' MsgBox(StringCase.InvertedCase("HeLLo"))
' Var = StringCase.WordCase(Var)
''' <summary>
''' Convert to LowerCase [Ex: ab cd ef]
''' </summary>
Public Shared Function LowerCase(ByVal Text As String) As String
Return Text.ToLower
End Function
''' <summary>
''' Convert to UpperCase [Ex: AB CD EF]
''' </summary>
Public Shared Function UpperCase(ByVal Text As String) As String
Return Text.ToUpper
End Function
''' <summary>
''' Convert to Titlecase [Ex: Ab cd ef]
''' </summary>
Public Shared Function Titlecase(ByVal Text As String) As String
Return Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase)
End Function
''' <summary>
''' Convert to WordCase [Ex: Ab Cd Ef]
''' </summary>
Public Shared Function WordCase(ByVal Text As String) As String
Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text)
End Function
''' <summary>
''' Convert to CamelCase (And first letter to Lower) [Ex: abCdEf]
''' </summary>
Public Shared Function CamelCase_First_Lower(ByVal Text As String) As String
Return Char.ToLower(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
End Function
''' <summary>
''' Convert to CamelCase (And first letter to Upper) [Ex: AbCdEf]
''' </summary>
Public Shared Function CamelCase_First_Upper(ByVal Text As String) As String
Return Char.ToUpper(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
End Function
''' <summary>
''' Convert to MixedCase (And first letter to Lower) [Ex: aB Cd eF]
''' </summary>
Public Shared Function MixedCase_First_Lower(ByVal Text As String) As String
Dim MixedString As String = Nothing
For X As Integer = 0 To Text.Length - 1
Application.DoEvents()
Dim c As Char = Text(X)
If (X / 2).ToString.Contains(",") Then _
MixedString += c.ToString.ToUpper _
Else MixedString += c.ToString.ToLower
Next
Return MixedString
End Function
''' <summary>
''' Convert to MixedCase (And first letter to Upper) [Ex: Ab cD Ef]
''' </summary>
Public Shared Function MixedCase_First_Upper(ByVal Text As String) As String
Dim MixedString As String = Nothing
For X As Integer = 0 To Text.Length - 1
Application.DoEvents()
Dim c As Char = Text(X)
If (X / 2).ToString.Contains(",") Then _
MixedString += c.ToString.ToLower _
Else MixedString += c.ToString.ToUpper
Next
Return MixedString
End Function
''' <summary>
''' Convert to MixedCase (And first letter of each word to Lower) [Ex: aB cD eF]
''' </summary>
Public Shared Function MixedCase_Word_Lower(ByVal Text As String) As String
Dim MixedString As String = Nothing
Dim Count As Integer = 1
For X As Integer = 0 To Text.Length - 1
Application.DoEvents()
Dim c As Char = Text(X)
If Not c = " " Then Count += 1 Else Count = 1
If (Count / 2).ToString.Contains(",") Then _
MixedString += c.ToString.ToUpper _
Else MixedString += c.ToString.ToLower
Next
Return MixedString
End Function
''' <summary>
''' Convert to MixedCase (And first letter of each word to Upper) [Ex: Ab Cd Ef]
''' </summary>
Public Shared Function MixedCase_Word_Upper(ByVal Text As String) As String
Dim MixedString As String = Nothing
Dim Count As Integer = 1
For X As Integer = 0 To Text.Length - 1
Application.DoEvents()
Dim c As Char = Text(X)
If Not c = " " Then Count += 1 Else Count = 1
If (Count / 2).ToString.Contains(",") Then _
MixedString += c.ToString.ToLower _
Else MixedString += c.ToString.ToUpper
Next
Return MixedString
End Function
''' <summary>
''' Convert to DelimitedCase (And All letters to Lower) [Ex: ab-cd-ef]
''' </summary>
Public Shared Function DelimitedCase_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
Return rgx.Replace(Text.ToLower, Delimiter)
End Function
''' <summary>
''' Convert to DelimitedCase (And All letters to Upper) [Ex: AB-CD-EF]
''' </summary>
Public Shared Function DelimitedCase_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
Return rgx.Replace(Text.ToUpper, Delimiter)
End Function
''' <summary>
''' Convert to DelimitedCase (And first letter to Upper) [Ex: Ab-cd-ef]
''' </summary>
Public Shared Function DelimitedCase_Title(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
Return rgx.Replace(Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase), Delimiter)
End Function
''' <summary>
''' Convert to DelimitedCase (And first letter of each word to Lower) [Ex: aB-cD-eF]
''' </summary>
Public Shared Function DelimitedCase_Mixed_Word_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
Dim MixedString As String = Nothing
Dim Count As Integer = 1
For X As Integer = 0 To Text.Length - 1
Application.DoEvents()
Dim c As Char = Text(X)
If Not c = " " Then Count += 1 Else Count = 1
If (Count / 2).ToString.Contains(",") Then _
MixedString += c.ToString.ToUpper _
Else MixedString += c.ToString.ToLower
Next
Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
Return rgx.Replace(MixedString, Delimiter)
End Function
''' <summary>
''' Convert to DelimitedCase (And first letter of each word to Upper) [Ex: Ab-Cd-Ef]
''' </summary>
Public Shared Function DelimitedCase_Mixed_Word_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
Return rgx.Replace(System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text), Delimiter)
End Function
''' <summary>
''' Covert string to InvertedCase [Ex: HeLLo -> hEllO ]
''' </summary>
Public Shared Function InvertedCase(ByVal Text As String) As String
Dim InvertedString As String = String.Empty
For Each character In Text
Application.DoEvents()
If Char.IsUpper(character) Then
InvertedString += character.ToString.ToLower
Else : InvertedString += character.ToString.ToUpper
End If
Next
Return InvertedString
End Function
End Class
#End Region
#8994
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 19:42 PM
Mi versión modificada del "FileInfo"
Código (vbnet) [Seleccionar]
#Region " Get File Info "
' [ Get File Info Function ]
'
' // By Elektro H@cker
'
' Examples:
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.DriveLetter))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortName))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortPath))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name_Length))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension_Length))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName_Length))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory_Length))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName_Length))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileSize))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileVersion))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_Enum))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_String))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.CreationTime))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastAccessTime))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastModifyTime))
' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Has_Extension))
Public Enum FileInfo
Name ' Filename without extension
Extension_With_Dot ' File-Extension (with dot included)
Extension_Without_Dot ' File-Extension (without dot)
FileName ' Filename.extension
Directory ' Directory name
DriveLetter ' Drive letter (only 1 letter)
FullName ' Directory path + Filename
ShortName ' DOS8.3 Filename
ShortPath ' DOS8.3 Path Name
Name_Length ' Length of Filename without extension
Extension_With_Dot_Length ' Length of File-Extension (with dot included)
Extension_Without_Dot_Length ' Length of File-Extension (without dot)
FileName_Length ' Length of Filename.extension
Directory_Length ' Length of Directory name
FullName_Length ' Length of Directory path + Filename
FileSize ' Size in Bytes
FileVersion ' Version for DLL or EXE files
Attributes_Enum ' Attributes in Integer format
Attributes_String ' Attributes in String format
CreationTime ' Date Creation time
LastAccessTime ' Date Last Access time
LastModifyTime ' Date Last Modify time
Has_Extension ' Checks if file have a file-extension.
End Enum
Private Function Get_File_Info(ByVal File As String, ByVal Information As FileInfo)
Dim File_Info = My.Computer.FileSystem.GetFileInfo(File)
Select Case Information
Case FileInfo.Name : Return File_Info.Name.Substring(0, File_Info.Name.LastIndexOf("."))
Case FileInfo.Extension_With_Dot : Return File_Info.Extension
Case FileInfo.Extension_Without_Dot : Return File_Info.Extension.Split(".").Last
Case FileInfo.FileName : Return File_Info.Name
Case FileInfo.Directory : Return File_Info.DirectoryName
Case FileInfo.DriveLetter : Return File_Info.Directory.Root.ToString.Substring(0, 1)
Case FileInfo.FullName : Return File_Info.FullName
Case FileInfo.ShortName : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortName
Case FileInfo.ShortPath : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortPath
Case FileInfo.Name_Length : Return File_Info.Name.Length
Case FileInfo.Extension_With_Dot_Length : Return File_Info.Extension.Length
Case FileInfo.Extension_Without_Dot_Length : Return File_Info.Extension.Split(".").Last.Length
Case FileInfo.FileName_Length : Return File_Info.Name.Length
Case FileInfo.Directory_Length : Return File_Info.DirectoryName.Length
Case FileInfo.FullName_Length : Return File_Info.FullName.Length
Case FileInfo.FileSize : Return File_Info.Length
Case FileInfo.FileVersion : Return CreateObject("Scripting.FileSystemObject").GetFileVersion(File)
Case FileInfo.Attributes_Enum : Return File_Info.Attributes
Case FileInfo.Attributes_String : Return File_Info.Attributes.ToString
Case FileInfo.CreationTime : Return File_Info.CreationTime
Case FileInfo.LastAccessTime : Return File_Info.LastAccessTime
Case FileInfo.LastModifyTime : Return File_Info.LastWriteTime
Case FileInfo.Has_Extension : Return IO.Path.HasExtension(File)
Case Else : Return Nothing
End Select
End Function
#End Region
#8995
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 19:17 PM
Una class para usar SevenZipSharp de forma sencilla para "comprimir/descomprimir/Crear un SFX/obtener información de zips" y mostrando el progreso de las operaciones.
Código (vbnet) [Seleccionar]
#Region " SevenZipSharp Class "
' [ SevenZipSharp Functions ]
'
' // By Elektro H@cker
'
' Instructions :
' 1. Add a reference to "SevenZipSharp.dll".
' 2. Add the "7z.dll" or "7z64.dll" files to the project.
' 3. Add the "7z.sfx" and "7zCon.sfx" files to the project for SFX compression.
'
' Examples :
'
' --------
' Extract:
' --------
' SevenZipSharp.Extract("C:\File.7zip") ' Will be extracted in the same dir.
' SevenZipSharp.Extract("C:\File.7zip", "C:\Extracted\") ' Will be extracted in "C:\Extracted\".
' SevenZipSharp.Extract("C:\File.7zip", , "Password") ' Will be extracted with the given password.
'
' --------
' Compress:
' ---------
' SevenZipSharp.Compress("C:\File.txt") ' File will be compressed in the same dir.
' SevenZipSharp.Compress("C:\File.txt", "C:\Compressed\File.7z") ' File will be compressed in "C:\Compressed\".
' SevenZipSharp.Compress("C:\Folder\", , , , , , "Password") ' Folder will be compressed with the given password.
' SevenZipSharp.Compress("C:\File.txt", , OutArchiveFormat.Zip, , CompressionMethod.Lzma, CompressionLevel.Ultra)
'
' --------
' Compress SFX:
' -------------
' SevenZipSharp.Compress_SFX("C:\File.txt") ' File will be compressed in the same dir.
' SevenZipSharp.Compress_SFX("C:\File.txt", "C:\Compressed\File.exe") ' File will be compressed in "C:\Compressed\".
' SevenZipSharp.Compress_SFX("C:\Folder\", , , , , , , "Password") ' Folder will be compressed with the given password.
' SevenZipSharp.Compress_SFX("C:\File.txt", , SevenZipSharp_SFX_Module.Console, CompressionLevel.Fast)
'
' --------
' File Info:
' ----------
' MsgBox(SevenZipSharp.FileInfo("C:\Test.7z", SevenZip_Info.Format))
' For Each FileName In SevenZipSharp.FileInfo("C:\Test.zip", SevenZip_Info.Internal_Files_FileNames) : MsgBox(FileName) : Next
'
' ------------
' * Progress *
' ------------
' Dim WithEvents SevenZipProgress_Timer As New Timer
' Private Sub SevenZipProgress_Timer_Tick(sender As Object, e As EventArgs) Handles SevenZipProgress_Timer.Tick
' ProgressBar1.Value = SevenZipSharp.SevenZip_Current_Progress
' If ProgressBar1.Value = 100 Then
' ' ...
' End If
' End Sub
Imports SevenZip
Public Class SevenZipSharp
Public Shared SevenZipDLL As String = "7z.dll"
Public Shared SevenZip_Current_Progress As Short = 0
#Region " SevenZipSharp Extract "
Public Shared Function Extract(ByVal InputFile As String, _
Optional ByVal OutputDir As String = Nothing, _
Optional ByVal Password As String = "Nothing") As Boolean
SevenZip_Current_Progress = 0
Try
' Set library path
SevenZipExtractor.SetLibraryPath(SevenZipDLL)
' Create extractor and specify the file to extract
Dim Extractor As SevenZipExtractor = New SevenZipExtractor(InputFile, Password)
' Specify the output path where the files will be extracted
If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
' Add Progress Handler
AddHandler Extractor.Extracting, AddressOf SevenZipSharp_Extract_Progress
' Check for password matches
If Extractor.Check() Then
' Start the extraction
Extractor.BeginExtractArchive(OutputDir)
Else
Return False ' Bad password
End If
Return True ' File extracted
Extractor.Dispose()
Catch ex As Exception
'Return False ' File not extracted
Throw New Exception(ex.Message)
End Try
End Function
Private Shared Sub SevenZipSharp_Extract_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
SevenZip_Current_Progress = e.PercentDone
' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
End Sub
#End Region
#Region " SevenZipSharp Compress "
Public Shared Function Compress(ByVal Input_DirOrFile As String, _
Optional ByVal OutputFileName As String = Nothing, _
Optional ByVal Format As OutArchiveFormat = OutArchiveFormat.SevenZip, _
Optional ByVal CompressionMode As CompressionMode = CompressionMode.Create, _
Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.Lzma, _
Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
Optional ByVal VolumeSize As Long = Nothing, _
Optional ByVal Password As String = Nothing) As Boolean
SevenZip_Current_Progress = 0
Try
' Set library path
SevenZipCompressor.SetLibraryPath(SevenZipDLL)
' Create compressor
Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
' Set compression parameters
Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
Compressor.CompressionMethod = CompressionMethod ' Compression method
Compressor.ArchiveFormat = Format ' Compression file format
Compressor.CompressionMode = CompressionMode ' Append files to compressed file or overwrite the compressed file.
Compressor.DirectoryStructure = True ' Preserve the directory structure.
Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
If Not VolumeSize = Nothing Then
If Format = OutArchiveFormat.SevenZip Then Compressor.VolumeSize = VolumeSize _
Else Throw New Exception("Multi volume option is only avaliable for 7zip format")
End If
' Get File extension
Dim CompressedFileExtension As String = Nothing
Select Case Compressor.ArchiveFormat
Case OutArchiveFormat.SevenZip : CompressedFileExtension = ".7z"
Case OutArchiveFormat.BZip2 : CompressedFileExtension = ".bz"
Case OutArchiveFormat.GZip : CompressedFileExtension = ".gzip"
Case OutArchiveFormat.Tar : CompressedFileExtension = ".tar"
Case OutArchiveFormat.XZ : CompressedFileExtension = ".xz"
Case OutArchiveFormat.Zip : CompressedFileExtension = ".zip"
End Select
' Add Progress Handler
AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
' Removes the end slash ("\") if given for a directory
If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
' Generate the OutputFileName if any is given.
If OutputFileName Is Nothing Then _
OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & CompressedFileExtension).Replace("\\", "\")
' Check if given argument is Dir or File ...then start the compression
If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
If Not Password Is Nothing Then
Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
Else
Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
End If
ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
If Not Password Is Nothing Then
Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
Else
Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
End If
End If
Catch ex As Exception
'Return False ' File not compressed
Throw New Exception(ex.Message)
End Try
Return True ' File compressed
End Function
Private Shared Sub SevenZipSharp_Compress_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
SevenZip_Current_Progress = e.PercentDone
' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
End Sub
#End Region
#Region " SevenZipSharp Compress SFX "
Enum SevenZipSharp_SFX_Module
Normal
Console
End Enum
Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
Optional ByVal OutputFileName As String = Nothing, _
Optional ByVal SFX_Module As SevenZipSharp_SFX_Module = SevenZipSharp_SFX_Module.Normal, _
Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
Optional ByVal Password As String = Nothing) As Boolean
SevenZip_Current_Progress = 0
' Create the .7z file
Try
' Set library path
SevenZipCompressor.SetLibraryPath(SevenZipDLL)
' Create compressor
Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
' Set compression parameters
Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
Compressor.CompressionMethod = CompressionMethod.Lzma ' Compression Method
Compressor.ArchiveFormat = OutArchiveFormat.SevenZip ' Compression file format
Compressor.CompressionMode = CompressionMode.Create ' Append files to compressed file or overwrite the compressed file.
Compressor.DirectoryStructure = True ' Preserve the directory structure.
Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
' Add Progress Handler
AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
' Removes the end slash ("\") if given for a directory
If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
' Generate the OutputFileName if any is given.
If OutputFileName Is Nothing Then
OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".tmp").Replace("\\", "\")
Else
OutputFileName = OutputFileName & ".tmp"
End If
' Check if given argument is Dir or File ...then start the compression
If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
If Not Password Is Nothing Then
Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
Else
Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
End If
ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
If Not Password Is Nothing Then
Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
Else
Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
End If
End If
' Create the SFX file
' Create the SFX compressor
Dim compressorSFX As SevenZipSfx = New SevenZipSfx(SfxModule.Default)
' Set SFX Module path
If SFX_Module = SevenZipSharp_SFX_Module.Normal Then
compressorSFX.ModuleFileName = ".\7z.sfx"
ElseIf SFX_Module = SevenZipSharp_SFX_Module.Console Then
compressorSFX.ModuleFileName = ".\7zCon.sfx"
End If
' Start the compression
' Generate the OutputFileName if any is given.
Dim SFXOutputFileName As String
If OutputFileName.ToLower.EndsWith(".exe.tmp") Then
SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4)
Else
SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4) & ".exe"
End If
compressorSFX.MakeSfx(OutputFileName, SFXOutputFileName)
' Delete the 7z tmp file
Try : IO.File.Delete(OutputFileName) : Catch : End Try
Catch ex As Exception
'Return False ' File not compressed
Throw New Exception(ex.Message)
End Try
Return True ' File compressed
End Function
Private Shared Sub SevenZipSharp_Compress_SFX_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
SevenZip_Current_Progress = e.PercentDone
' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
End Sub
#End Region
#Region " SevenZipSharp FileInfo "
Enum File_Info
FileName
Format
Size_In_Bytes
Internal_Files_FileNames
Total_Internal_Files
End Enum
Public Shared Function FileInfo(ByVal InputFile As String, ByVal Info As File_Info)
Try
' Set library path
SevenZip.SevenZipExtractor.SetLibraryPath(SevenZipDLL)
' Create extractor and specify the file to extract
Dim Extractor As SevenZip.SevenZipExtractor = New SevenZip.SevenZipExtractor(InputFile)
' Return info
Select Case Info
Case File_Info.FileName
Return Extractor.FileName
Case File_Info.Format
Return Extractor.Format
Case File_Info.Size_In_Bytes
Return Extractor.PackedSize
Case File_Info.Total_Internal_Files
Return Extractor.FilesCount
Case File_Info.Internal_Files_FileNames
Dim FileList As New List(Of String)
For Each Internal_File In Extractor.ArchiveFileData
FileList.Add(Internal_File.FileName)
Next
Return FileList
Case Else
Return Nothing
End Select
Extractor.Dispose()
Catch ex As Exception
' Return nothing
Throw New Exception(ex.Message)
End Try
End Function
#End Region
End Class
#End Region
Una class para usar DotNetZip de forma sencilla para "comprimir/descomprimir/Crear un SFX" y mostrando el progreso en las operaciones.
Código (vbnet) [Seleccionar]
#Region " DotNetZip Class "
' [ DotNetZip Functions ]
'
' // By Elektro H@cker
'
' Instructions :
' 1. Add a reference to "Ionic.Zip.dll".
'
' Examples :
'
' --------
' Extract:
' --------
' DotNetZip_Extract("C:\File.zip")
' DotNetZip_Extract("C:\File.zip", "C:\Folder\Test\", , "MyPassword")
'
' ---------
' Compress:
' ---------
' DotNetZip_Compress("C:\File.txt")
' DotNetZip_Compress("C:\Folder")
' DotNetZip_Compress("C:\Folder", "C:\Folder\Test.zip", , CompressionLevel.BestCompression, "Password", EncryptionAlgorithm.WinZipAes256)
'
' -------------
' Compress SFX:
' -------------
' DotNetZip_Compress_SFX("C:\File.txt")
' DotNetZip_Compress_SFX("C:\Folder")
'
' DotNetZip_Compress_SFX( _
' "C:\File.txt", "C:\Test.exe", , CompressionLevel.BestCompression, _
' "MyPassword", EncryptionAlgorithm.WinZipAes256, , , _
' ExtractExistingFileAction.OverwriteSilently, , , , _
' System.IO.Path.GetFileName("notepad.exe") _
' )
'
' ------------
' * Progress *
' ------------
' Dim WithEvents DotNetZip_Progress_Timer As New Timer
' Private Sub DotNetZip_Progress_Timer_Tick(sender As Object, e As EventArgs) Handles DotNetZip_Progress_Timer.Tick
' Label1.Text = DotNetZip.CurrentFileName
' ProgressBar1.Value = DotNetZip.DotNetZip_Current_Progress
' If ProgressBar1.Value = 100 Then
' ' ...
' End If
' End Sub
Imports Ionic.Zip
Imports Ionic.Zlib
Public Class DotNetZip
#Region " DotNetZip Extract "
Public Shared DotNetZip_Current_Progress As Short = 0
Public Shared ZipFileCount As Long = 0
Public Shared ExtractedFileCount As Long = 0
Public Shared CurrentFileName As String = String.Empty
Public Shared Function Extract(ByVal InputFile As String, _
Optional ByVal OutputDir As String = Nothing, _
Optional ByVal Overwrite As ExtractExistingFileAction = ExtractExistingFileAction.DoNotOverwrite, _
Optional ByVal Password As String = "Nothing" _
) As Boolean
DotNetZip_Current_Progress = 0
ZipFileCount = 0
ExtractedFileCount = 0
CurrentFileName = String.Empty
Try
' Create Extractor
Dim Extractor As ZipFile = ZipFile.Read(InputFile)
' Set Extractor parameters
Extractor.Password = Password ' Zip Password
Extractor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
Extractor.ZipErrorAction = ZipErrorAction.Throw
' Specify the output path where the files will be extracted
If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
' Add Progress
AddHandler Extractor.ExtractProgress, AddressOf DotNetZip_Extract_Progress ' Progress Handler
For Each Entry As ZipEntry In Extractor.Entries
Application.DoEvents()
ZipFileCount += 1
Next ' Total bytes size of Zip
ZipFileCount = Extractor.Entries.Count ' Total files inside Zip
' Start the extraction
For Each Entry As ZipEntry In Extractor.Entries
Application.DoEvents()
Entry.Extract(OutputDir, Overwrite)
Next
ZipFileCount = 0 : ExtractedFileCount = 0 ' Reset vars
Extractor.Dispose()
Return True ' File Extracted
Catch ex As Exception
' Return False ' File not extracted
MsgBox(ex.Message)
Throw New Exception(ex.Message)
End Try
End Function
Private Shared Sub DotNetZip_Extract_Progress(ByVal sender As Object, ByVal e As ExtractProgressEventArgs)
If e.EventType = ZipProgressEventType.Extracting_BeforeExtractEntry Then
CurrentFileName = e.CurrentEntry.FileName
ExtractedFileCount += 1
DotNetZip_Current_Progress = ((100 / ZipFileCount) * ExtractedFileCount)
ElseIf e.EventType = ZipProgressEventType.Extracting_AfterExtractEntry Then
If ExtractedFileCount = ZipFileCount Then
'MessageBox.Show("Extraction Done: " & vbNewLine & _
' e.ArchiveName) ' Uncompression finished
End If
End If
End Sub
#End Region
#Region " DotNetZip Compress "
Public Shared Function Compress(ByVal Input_DirOrFile As String, _
Optional ByVal OutputFileName As String = Nothing, _
Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
Optional ByVal Password As String = Nothing, _
Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None _
) As Boolean
DotNetZip_Current_Progress = 0
ZipFileCount = 0
ExtractedFileCount = 0
CurrentFileName = String.Empty
Try
' Create compressor
Dim Compressor As ZipFile = New ZipFile
' Set compression parameters
Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
Compressor.CompressionMethod = CompressionMethod ' Compression method
Compressor.Password = Password ' Zip Password
Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then _
Compressor.Encryption = EncryptionAlgorithm.None _
Else Compressor.Encryption = Encrypt_Password ' Encryption for Zip password.
' Add Progress Handler
AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_Progress
' Removes the end slash ("\") if is given for a directory.
If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
' Generate the OutputFileName if any is given.
If OutputFileName Is Nothing Then _
OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".zip").Replace("\\", "\")
' Check if given argument is Dir or File ...then start the compression
If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
Compressor.AddDirectory(Input_DirOrFile)
ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
Compressor.AddFile(Input_DirOrFile)
End If
Compressor.Save(OutputFileName)
Compressor.Dispose()
Catch ex As Exception
' Return False ' File not compressed
MsgBox(ex.Message)
' Throw New Exception(ex.Message)
End Try
Return True ' File compressed
End Function
Private Shared Sub DotNetZip_Compress_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
Application.DoEvents()
If e.EventType = ZipProgressEventType.Saving_Started Then
ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
DotNetZip_Current_Progress = 100
End If
End Sub
#End Region
#Region " DotNetZip Compress SFX "
Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
Optional ByVal OutputFileName As String = Nothing, _
Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
Optional ByVal Password As String = Nothing, _
Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None, _
Optional ByVal Extraction_Directory As String = ".\", _
Optional ByVal Silent_Extraction As Boolean = False, _
Optional ByVal Overwrite_Files As ExtractExistingFileAction = ExtractExistingFileAction.InvokeExtractProgressEvent, _
Optional ByVal Delete_Extracted_Files_After_Extraction As Boolean = False, _
Optional ByVal Icon As String = Nothing, _
Optional ByVal Window_Title As String = Nothing, _
Optional ByVal Window_Style As SelfExtractorFlavor = SelfExtractorFlavor.WinFormsApplication, _
Optional ByVal Command_Line_Argument As String = Nothing _
) As Boolean
DotNetZip_Current_Progress = 0
ZipFileCount = 0
ExtractedFileCount = 0
CurrentFileName = String.Empty
Try
' Create compressor
Dim Compressor As ZipFile = New ZipFile
' Set compression parameters
Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
' Compression method
Compressor.Password = Password ' Zip Password
Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then
Compressor.Encryption = EncryptionAlgorithm.None ' No encryption because no password.
Compressor.CompressionMethod = CompressionMethod ' Set any compression method.
Else
Compressor.Encryption = Encrypt_Password ' Set Encryption for Zip password.
Compressor.CompressionMethod = CompressionMethod.Deflate ' Set deflate method to don't destroy the SFX if AES encryption.
End If
Dim SFX_Options As New SelfExtractorSaveOptions()
SFX_Options.DefaultExtractDirectory = Extraction_Directory
SFX_Options.Quiet = Silent_Extraction
SFX_Options.ExtractExistingFile = ExtractExistingFileAction.OverwriteSilently
SFX_Options.RemoveUnpackedFilesAfterExecute = Delete_Extracted_Files_After_Extraction
SFX_Options.Flavor = Window_Style
SFX_Options.PostExtractCommandLine = Command_Line_Argument
If Not Icon Is Nothing Then SFX_Options.IconFile = Icon
If Not Window_Title Is Nothing Then SFX_Options.SfxExeWindowTitle = Window_Title
' Add Progress Handler
AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_SFX_Progress
' Removes the end slash ("\") if is given for a directory.
If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
' Generate the OutputFileName if any is given.
If OutputFileName Is Nothing Then _
OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".exe").Replace("\\", "\")
' Check if given argument is Dir or File ...then start the compression
If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
Compressor.AddDirectory(Input_DirOrFile)
ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
Compressor.AddFile(Input_DirOrFile)
End If
Compressor.SaveSelfExtractor(OutputFileName, SFX_Options)
Compressor.Dispose()
Catch ex As Exception
'Return False ' File not compressed
Throw New Exception(ex.Message)
End Try
Return True ' File compressed
End Function
Private Shared Sub DotNetZip_Compress_SFX_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
Application.DoEvents()
If e.EventType = ZipProgressEventType.Saving_Started Then
ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
DotNetZip_Current_Progress = 100
End If
End Sub
#End Region
End Class
#End Region #8996
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 15:13 PM
Una class para compilar otros proyectos en tiempo de ejecución.
Código [Seleccionar]
#Region " FrameWork Compiler "
' [ FrameWork Compiler Function ]
'
' // By Elektro H@cker
'
' Examples :
' FrameWorkCompiler.FW_Compile("C:\Projects\Project.vbj", FrameWorkCompiler.CompilerVersion.FW_3_5_x86)
' FrameWorkCompiler.FW_Compile("C:\Projects\Project.sln", FrameWorkCompiler.CompilerVersion.FW_4_0_x64)
#Region " FrameWork Compiler Class "
Public Class FrameWorkCompiler
Shared FrameWork_Location As String = Nothing ' Directory location of selected FrameWork version
''' <summary>
''' The FrameWork compiler version.
''' </summary>
Public Enum CompilerVersion
FW_1_0_x86
FW_1_1_x86
FW_2_0_x86
FW_3_0_x86
FW_3_5_x86
FW_4_0_x86
FW_2_0_x64
FW_3_0_x64
FW_3_5_x64
FW_4_0_x64
End Enum
''' <summary>
''' Compile a .NET project/solution.
''' </summary>
Public Shared Function FW_Compile(ByVal SolutionFile As String, ByVal FrameWorkCompiler As CompilerVersion) As Boolean
Select Case FrameWorkCompiler
Case CompilerVersion.FW_1_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v1.0.3705")
Case CompilerVersion.FW_1_1_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v1.1.4322")
Case CompilerVersion.FW_2_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v2.0.50727")
Case CompilerVersion.FW_3_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v3.0")
Case CompilerVersion.FW_3_5_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v3.5")
Case CompilerVersion.FW_4_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v4.0.30319")
Case CompilerVersion.FW_2_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v2.0.50727")
Case CompilerVersion.FW_3_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v3.0")
Case CompilerVersion.FW_3_5_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v3.5")
Case CompilerVersion.FW_4_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v4.0.30319")
Case Else : Return False
End Select
Try
Dim FWCompiler As New Process()
Dim FWCompiler_Info As New ProcessStartInfo()
FWCompiler_Info.FileName = IO.Path.Combine(FrameWork_Location, "msbuild.exe")
FWCompiler_Info.Arguments = "/nologo /noautoresponse /verbosity:quiet " & """" & SolutionFile & """"
FWCompiler_Info.UseShellExecute = False
FWCompiler_Info.CreateNoWindow = True
FWCompiler_Info.WindowStyle = ProcessWindowStyle.Hidden
FWCompiler_Info.RedirectStandardOutput = True
FWCompiler.StartInfo = FWCompiler_Info
FWCompiler.Start()
FWCompiler.WaitForExit()
' Dim ErrorOutput As String = FWCompiler.StandardOutput.ReadToEnd()
' MsgBox(ErrorOutput)
If FWCompiler.ExitCode <> 0 Then
Return False
Else
Return True
End If
Catch ex As Exception
' MsgBox(ex.Message)
Return False
End Try
End Function
End Class
#End Region
#End Region
#8997
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 15:09 PM
Los snippets que posteé hace tiempo para hacer modificaciones en el registro, los he optimizado para simplificar su uso y evitar errores de sintaxis.
PD: Ahora permite añadir datos binários.
PD: Ahora permite añadir datos binários.
Código (vbnet) [Seleccionar]
#Region " Reg Create Key "
' [ Reg Create Key Function ]
'
' // By Elektro H@cker
'
' Examples :
'
' Reg_Create_Key("HKCU\Software\MyProgram") ' Creates "HKCU\Software\MyProgram"
' Reg_Create_Key("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
Public Function Reg_Create_Key(ByVal RegKey As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
Dim KeyPath As String = Nothing
' Gets the RootKey
Select Case RegKey.ToUpper.Split("\").First
Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
Case Else : Return False
End Select
' Gets the KeyPath
For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
Try
RootKey.CreateSubKey(KeyPath)
RootKey.Close()
Return True
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
End Function
#End RegionCódigo (vbnet) [Seleccionar]
#Region " Reg Delete Key "
' [ Reg Delete Key Function ]
'
' // By Elektro H@cker
'
' Examples :
' Reg_Delete_Key("HKLM\Software\7-zip") ' Deletes the "7-zip" tree including subkeys
' Reg_Delete_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
Public Function Reg_Delete_Key(ByVal RegKey As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
Dim KeyPath As String = Nothing
' Gets the RootKey
Select Case RegKey.ToUpper.Split("\").First
Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
Case Else : Return False
End Select
' Gets the KeyPath
For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
Try
RootKey.DeleteSubKeyTree(KeyPath)
RootKey.Close()
Return True
Catch ex As Exception
' Throw New Exception(ex.Message)
Return False
End Try
End Function
#End RegionCódigo (vbnet) [Seleccionar]
#Region " Reg Delete Value "
' [ Reg Delete Value Function ]
'
' // By Elektro H@cker
'
' Examples :
' Reg_Delete_Value("HKCU\Software\7-Zip", "Lang") ' Deletes "Lang" Value
' Reg_Delete_Value("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
Public Function Reg_Delete_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
Dim KeyPath As String = Nothing
' Gets the RootKey
Select Case RegKey.ToUpper.Split("\").First
Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
Case Else : Return False
End Select
' Gets the KeyPath
For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
Try
RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
RootKey.Close()
Return True
Catch ex As Exception
' Throw New Exception(ex.Message)
Return False
End Try
End Function
#End RegionCódigo (vbnet) [Seleccionar]
#Region " Reg Set Value "
' [ Reg Set Value Function ]
'
' // By Elektro H@cker
'
' Examples :
' Reg_Set_Value("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
' Reg_Set_Value("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
Public Function Reg_Set_Value(ByVal RegKey As String, _
ByVal RegValue As String, _
ByVal RegData As String, _
ByVal RegDataType As Microsoft.Win32.RegistryValueKind) As Boolean
Dim RootKey As String = Nothing
Dim KeyPath As String = Nothing
' Gets the RootKey
Select Case RegKey.ToUpper.Split("\").First
Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = "HKEY_CLASSES_ROOT"""
Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = "HKEY_CURRENT_CONFIG"
Case "HKCU", "HKEY_CURRENT_USER" : RootKey = "HKEY_CURRENT_USER"
Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = "HKEY_LOCAL_MACHINE"
Case "HKEY_PERFORMANCE_DATA" : RootKey = "HKEY_PERFORMANCE_DATA"
Case Else : Return False
End Select
' Gets the KeyPath
For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
KeyPath = RootKey & "\" & KeyPath
Try
If RegDataType = Microsoft.Win32.RegistryValueKind.Binary Then
My.Computer.Registry.SetValue(KeyPath, RegValue, System.Text.Encoding.ASCII.GetBytes(RegData), Microsoft.Win32.RegistryValueKind.Binary)
Else
My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
End If
Return True
Catch ex As Exception
' Throw New Exception(ex.Message)
Return False
End Try
End Function
#End Region
#8998
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 15:05 PM
Devuelve el formato de una URL de una localización de Google Maps
Devuelve la URL de una localización de Google Maps (Por coordenadas)
Crear un archivo Dummy
Cambiar el fondo de pantalla
Centrar el Form a la pantalla del escritorio
Comprobar si ya hay abierta una instancia de la aplicación:
Código (vbnet) [Seleccionar]
#Region " Get Google Maps URL "
' [ Get Google Maps URL Function ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Get_Google_Maps_URL("Valencia", "España")) ' Result: "http://Maps.google.com/?q=Valencia,+España,+"
' WebBrowser1.Navigate(Get_Google_Maps_URL("Valencia", "Spain"))
Private Function Get_Google_Maps_URL(Optional ByVal City As String = Nothing, _
Optional ByVal State As String = Nothing, _
Optional ByVal Street As String = Nothing, _
Optional ByVal Zipcode As String = Nothing) As String
Dim queryAddress As New System.Text.StringBuilder()
queryAddress.Append("http://Maps.google.com/?q=")
' Build street part of query string
If Street IsNot Nothing Then
Street = Street.Replace(" ", "+")
queryAddress.Append(Street + "," & "+")
End If
' Build city part of query string
If City IsNot Nothing Then
City = City.Replace(" ", "+")
queryAddress.Append(City + "," & "+")
End If
' Build state part of query string
If State IsNot Nothing Then
State = State.Replace(" ", "+")
queryAddress.Append(State + "," & "+")
End If
' Build zip code part of query string
If Zipcode IsNot Nothing Then
queryAddress.Append(Zipcode)
End If
' Return the URL
Return queryAddress.ToString
End Function
#End RegionDevuelve la URL de una localización de Google Maps (Por coordenadas)
Código (vbnet) [Seleccionar]
#Region " Get Google Maps Coordinates URL "
' [ Get Google Maps Coordinates URL Function ]
'
' // By Elektro H@cker
'
' Examples :
' MsgBox(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744)) ' Result: http://Maps.google.com/?q=39.4767%2C0.3744
' webBrowser1.Navigate(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744))
Private Function Get_Google_Maps_Coordinates_URL(ByVal Latitude As Double, ByVal Longitude As Double) As String
Dim queryAddress As New System.Text.StringBuilder()
queryAddress.Append("http://Maps.google.com/?q=")
' Build latitude part of query string
queryAddress.Append(Latitude.ToString.Replace(",", ".") + "%2C")
' Build longitude part of query string
queryAddress.Append(Longitude.ToString.Replace(",", "."))
' Return the URL
Return queryAddress.ToString
End FunctionCrear un archivo Dummy
Código (vbnet) [Seleccionar]
#Region " Make Dummy File "
' [ Make Dummy File Function ]
'
' Examples :
' Make_Dummy_File("C:\Test.dummy", 100) ' Creates a dummy file of 100 bytes
Private Function Make_Dummy_File(ByVal File As String, ByVal Size As Int64) As Boolean
Try
Using DummyFile As New IO.FileStream(File, IO.FileMode.Create)
DummyFile.SetLength(Size)
End Using
Catch ex As Exception
' MsgBox(ex.Message)
Return False
End Try
Return True
End Function
#End RegionCambiar el fondo de pantalla
Código (vbnet) [Seleccionar]
#Region " Set Desktop Wallpaper "
' [ Set Desktop Wallpaper Function ]
'
' Examples :
' MsgBox(Wallpaper.SupportFitFillWallpaperStyles)
' MsgBox(Wallpaper.SupportJpgAsWallpaper)
' Set_Desktop_Wallpaper("C:\Image.jpg", WallpaperStyle.Fill)
Private Function Set_Desktop_Wallpaper(ByVal Image As String, ByVal Style As WallpaperStyle) As Boolean
Try
If Wallpaper.SupportFitFillWallpaperStyles AndAlso Wallpaper.SupportJpgAsWallpaper Then
Wallpaper.SetDesktopWallpaper(Image, Style)
End If
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
Return True
End Function
' Wallpaper.vb Class
#Region " Wallpaper Class "
'*********************************** Module Header ***********************************'
' Module Name: Wallpaper.vb
' Project: VBSetDesktopWallpaper
' Copyright (c) Microsoft Corporation.
'
' Wallpaper.SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)
'
' This is the key method that sets the desktop wallpaper. The method body is composed
' of configuring the wallpaper style in the registry and setting the wallpaper with
' SystemParametersInfo.
'
'*************************************************************************************'
Imports Microsoft.Win32
Imports System.Environment
Imports System.Drawing.Imaging
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Public Class Wallpaper
''' <summary>
''' Determine if .jpg files are supported as wallpaper in the current
''' operating system. The .jpg wallpapers are not supported before
''' Windows Vista.
''' </summary>
Public Shared ReadOnly Property SupportJpgAsWallpaper()
Get
Return (Environment.OSVersion.Version >= New Version(6, 0))
End Get
End Property
''' <summary>
''' Determine if the fit and fill wallpaper styles are supported in the
''' current operating system. The styles are not supported before
''' Windows 7.
''' </summary>
Public Shared ReadOnly Property SupportFitFillWallpaperStyles()
Get
Return (Environment.OSVersion.Version >= New Version(6, 1))
End Get
End Property
''' <summary>
''' Set the desktop wallpaper.
''' </summary>
''' <param name="path">Path of the wallpaper</param>
''' <param name="style">Wallpaper style</param>
Public Shared Sub SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)
' Set the wallpaper style and tile.
' Two registry values are set in the Control Panel\Desktop key.
' TileWallpaper
' 0: The wallpaper picture should not be tiled
' 1: The wallpaper picture should be tiled
' WallpaperStyle
' 0: The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
' 2: The image is stretched to fill the screen
' 6: The image is resized to fit the screen while maintaining the aspect
' ratio. (Windows 7 and later)
' 10: The image is resized and cropped to fill the screen while
' maintaining the aspect ratio. (Windows 7 and later)
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)
Select Case style
Case WallpaperStyle.Tile
key.SetValue("WallpaperStyle", "0")
key.SetValue("TileWallpaper", "1")
Exit Select
Case WallpaperStyle.Center
key.SetValue("WallpaperStyle", "0")
key.SetValue("TileWallpaper", "0")
Exit Select
Case WallpaperStyle.Stretch
key.SetValue("WallpaperStyle", "2")
key.SetValue("TileWallpaper", "0")
Exit Select
Case WallpaperStyle.Fit ' (Windows 7 and later)
key.SetValue("WallpaperStyle", "6")
key.SetValue("TileWallpaper", "0")
Exit Select
Case WallpaperStyle.Fill ' (Windows 7 and later)
key.SetValue("WallpaperStyle", "10")
key.SetValue("TileWallpaper", "0")
Exit Select
End Select
key.Close()
' If the specified image file is neither .bmp nor .jpg, - or -
' if the image is a .jpg file but the operating system is Windows Server
' 2003 or Windows XP/2000 that does not support .jpg as the desktop
' wallpaper, convert the image file to .bmp and save it to the
' %appdata%\Microsoft\Windows\Themes folder.
Dim ext As String = System.IO.Path.GetExtension(path)
If ((Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso _
Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) _
OrElse _
(ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso _
(Not SupportJpgAsWallpaper))) Then
Using image As Image = image.FromFile(path)
path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", _
Environment.GetFolderPath(SpecialFolder.ApplicationData), _
System.IO.Path.GetFileNameWithoutExtension(path))
image.Save(path, ImageFormat.Bmp)
End Using
End If
' Set the desktop wallpapaer by calling the Win32 API SystemParametersInfo
' with the SPI_SETDESKWALLPAPER desktop parameter. The changes should
' persist, and also be immediately visible.
If Not Wallpaper.SystemParametersInfo(20, 0, path, 3) Then
Throw New Win32Exception
End If
End Sub
<DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
Private Shared Function SystemParametersInfo( _
ByVal uiAction As UInt32, _
ByVal uiParam As UInt32, _
ByVal pvParam As String, _
ByVal fWinIni As UInt32) _
As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Private Const SPI_SETDESKWALLPAPER As UInt32 = 20
Private Const SPIF_SENDWININICHANGE As UInt32 = 2
Private Const SPIF_UPDATEINIFILE As UInt32 = 1
End Class
Public Enum WallpaperStyle
Tile
Center
Stretch
Fit
Fill
End Enum
#End Region
#End RegionCentrar el Form a la pantalla del escritorio
Código (vbnet) [Seleccionar]
#Region " Center Form To Desktop "
' [ Center Form To Desktop ]
'
' // By Elektro H@cker
'
' Examples :
' Center_Form_To_Desktop(Me)
Private Sub Center_Form_To_Desktop(ByVal Form As Form)
Dim Desktop_RES As System.Windows.Forms.Screen = System.Windows.Forms.Screen.PrimaryScreen
Me.Location = New Point((Desktop_RES.Bounds.Width - Form.Width) / 2, (Desktop_RES.Bounds.Height - Form.Height) / 2)
End Sub
#End RegionComprobar si ya hay abierta una instancia de la aplicación:
Código (vbnet) [Seleccionar]
#Region " My Application Is Already Running "
' [ My Application Is Already Running Function ]
'
' // By Elektro H@cker
'
' Examples :
' MsgBox(My_Application_Is_Already_Running)
' If My_Application_Is_Already_Running() Then Application.Exit()
Public Declare Function CreateMutexA Lib "Kernel32.dll" (ByVal lpSecurityAttributes As Integer, ByVal bInitialOwner As Boolean, ByVal lpName As String) As Integer
Public Declare Function GetLastError Lib "Kernel32.dll" () As Integer
Public Function My_Application_Is_Already_Running() As Boolean
'Attempt to create defualt mutex owned by process
CreateMutexA(0, True, Process.GetCurrentProcess().MainModule.ModuleName.ToString)
Return (GetLastError() = 183) ' 183 = ERROR_ALREADY_EXISTS
End Function
#End Region
#8999
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 14:55 PM
Ejemplo de un comentário de sumário (o Method description):
Ejemplo de un Select case para comparar 2 o más strings (el equivalente al OR):
Concatenar texto en varios colores en la consola
Añade la aplicación actual al inicio de sesión de windows:
Convierte un array de bytes a string
Convierte un string a aray de bytes
Añade una cuenta de usuario al sistema:
Código (vbnet) [Seleccionar]
Public Class MyClass
''' <summary>
''' A description for this variable [Default: False].
''' </summary>
Public Shared MyVariable As Boolean = False
End classEjemplo de un Select case para comparar 2 o más strings (el equivalente al OR):
Código (vbnet) [Seleccionar]
Select Case Variable.ToUpper
Case "HELLO"
MsgBox("You said HELLO.")
Case "BYE", "HASTALAVISTA"
MsgBox("You said BYE or HASTALAVISTA.")
Case Else
MsgBox("You said nothing.")
End SelectConcatenar texto en varios colores en la consola
Código (vbnet) [Seleccionar]
#Region " Write Color Text "
' [ Write Color Text ]
'
' // By Elektro H@cker
'
' Examples:
' Write_Color_Text("TestString A", ConsoleColor.Cyan)
' Write_Color_Text(" + ", ConsoleColor.Green)
' Write_Color_Text("TestString B" & vbNewLine, ConsoleColor.White, ConsoleColor.DarkRed)
' Console.ReadLine()
Private Sub Write_Color_Text(ByVal Text As String, _
Optional ByVal ForeColor As System.ConsoleColor = ConsoleColor.White, _
Optional ByVal BackColor As System.ConsoleColor = ConsoleColor.Black)
Console.ForegroundColor = ForeColor
Console.BackgroundColor = BackColor
Console.Write(Text)
Console.ForegroundColor = ConsoleColor.White
Console.BackgroundColor = ConsoleColor.Black
End Sub
#End RegionAñade la aplicación actual al inicio de sesión de windows:
Código (vbnet) [Seleccionar]
#Region " Add Application To Startup "
' [ Add Application To Startup Function ]
'
' // By Elektro H@cker
'
' Examples :
' Add_Application_To_Startup(Startup_User.All_Users)
' Add_Application_To_Startup(Startup_User.Current_User)
' Add_Application_To_Startup(Startup_User.Current_User, "Application Name", """C:\ApplicationPath.exe""" & " -Arguments")
Public Enum Startup_User
Current_User
All_Users
End Enum
Private Function Add_Application_To_Startup(ByVal Startup_User As Startup_User, _
Optional ByVal Application_Name As String = Nothing, _
Optional ByVal Application_Path As String = Nothing) As Boolean
If Application_Name Is Nothing Then Application_Name = Process.GetCurrentProcess().MainModule.ModuleName
If Application_Path Is Nothing Then Application_Path = Application.ExecutablePath
Try
Select Case Startup_User
Case Startup_User.All_Users
My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
Case Startup_User.Current_User
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
End Select
Catch ex As Exception
' Throw New Exception(ex.Message)
Return False
End Try
Return True
End Function
#End RegionConvierte un array de bytes a string
Código (vbnet) [Seleccionar]
#Region " Byte-Array To String "
' [ Byte-Array To String Function ]
'
' // By Elektro H@cker
'
' Examples :
' Dim Bytes() As Byte = {84, 101, 115, 116} ' T, e, s, t
' MsgBox(Byte_Array_To_String(Bytes)) ' Result: Test
Private Function Byte_Array_To_String(ByVal Byte_Array As Byte()) As String
Return System.Text.Encoding.ASCII.GetString(Byte_Array)
End Function
#End RegionConvierte un string a aray de bytes
Código (vbnet) [Seleccionar]
#Region " String to Byte-Array "
' [ String to Byte-Array Function ]
'
' // By Elektro H@cker
'
' Examples :
' Dim Bytes() As Byte = String_to_Byte_Array("Test") ' Byte = {84, 101, 115, 116}
Private Function String_to_Byte_Array(ByVal Text As String) As Byte()
Return System.Text.Encoding.ASCII.GetBytes(Text)
End Function
#End RegionAñade una cuenta de usuario al sistema:
Código (vbnet) [Seleccionar]
#Region " Add User Account "
' [ Add User Account Function ]
'
' // By Elektro H@cker
'
' Examples :
' MsgBox(Add_User_Account("New User"))
' Add_User_Account("New User", "MyPass")
Private Function Add_User_Account(ByVal UserName As String, Optional ByVal Password As String = Nothing) As Boolean
Dim Net_User As New Process()
Dim Net_User_Info As New ProcessStartInfo()
Net_User_Info.FileName = "CMD.exe"
Net_User_Info.Arguments = "/C NET User " & "" & UserName & "" & " " & "" & Password & "" & " /ADD"
Net_User_Info.WindowStyle = ProcessWindowStyle.Hidden
Net_User.StartInfo = Net_User_Info
Net_User.Start()
Net_User.WaitForExit()
Select Case Net_User.ExitCode
Case 0 : Return True ' Account created
Case 2 : Return False ' Account already exist
Case Else : Return False ' Unknown error
End Select
End Function
#End Region
#9000
.NET (C#, VB.NET, ASP) / Re: Librería de Snippets !! (Posteen aquí sus snippets)
7 Mayo 2013, 14:50 PM
Detectar que botón del mouse se ha pinchado:
Modificar la opacidad del Form cuando se arrastra desde la barra de título:
Convertir "&H" a entero:
Convertir un SID al nombre dle usuario o al dominio+nombre
Copia una clave con sus subclaves y valores, a otro lugar del registro.
Código (vbnet) [Seleccionar]
Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles MyBase.MouseClick
Select Case e.Button().ToString.ToLower
Case "left" ' Left mouse clicked
MsgBox("Left mouse clicked")
Case "right" ' Right mouse clicked
MsgBox("Right mouse clicked")
Case "middle" ' Middle mouse clicked
MsgBox("Middle mouse clicked")
End Select
End SubModificar la opacidad del Form cuando se arrastra desde la barra de título:
Código (vbnet) [Seleccionar]
' Set opacity when moving the form from the TitleBar
Protected Overrides Sub DefWndProc(ByRef message As System.Windows.Forms.Message)
' -- Trap left mouse click down on titlebar
If CLng(message.Msg) = &HA1 Then
If Me.Opacity <> 0.5 Then Me.Opacity = 0.5
' -- Trap left mouse click up on titlebar
ElseIf CLng(message.Msg) = &HA0 Then
If Me.Opacity <> 1.0 Then Me.Opacity = 1.0
End If
MyBase.DefWndProc(message)
End SubConvertir "&H" a entero:
Código (vbnet) [Seleccionar]
#Region " Win32Hex To Int "
' [ Win32Hex To Int Function ]
'
' // By Elektro H@cker
'
' Examples:
' MsgBox(Win32Hex_To_Int(&H2S)) ' Result: 2
' MsgBox(Win32Hex_To_Int(&HFF4)) ' 4084
Private Function Win32Hex_To_Int(ByVal Win32Int As Int32) As Int32
Return CInt(Win32Int)
End Function
#End Region Convertir un SID al nombre dle usuario o al dominio+nombre
Código (vbnet) [Seleccionar]
#Region " Get SID UserName "
' [ Get SID UserName ]
'
' Examples:
' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: UserName
' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: DomainName\UserName
Private Declare Unicode Function ConvertStringSidToSidW Lib "advapi32.dll" (ByVal StringSID As String, ByRef SID As IntPtr) As Boolean
Private Declare Unicode Function LookupAccountSidW Lib "advapi32.dll" (ByVal lpSystemName As String, ByVal SID As IntPtr, ByVal Name As System.Text.StringBuilder, ByRef cbName As Long, ByVal DomainName As System.Text.StringBuilder, ByRef cbDomainName As Long, ByRef psUse As Integer) As Boolean
Shared Function Get_SID_UserName(ByVal SID As String, Optional ByVal Get_Domain_Name As Boolean = False) As String
Const size As Integer = 255
Dim domainName As String
Dim userName As String
Dim cbUserName As Long = size
Dim cbDomainName As Long = size
Dim ptrSID As New IntPtr(0)
Dim psUse As Integer = 0
Dim bufName As New System.Text.StringBuilder(size)
Dim bufDomain As New System.Text.StringBuilder(size)
If ConvertStringSidToSidW(SID, ptrSID) Then
If LookupAccountSidW(String.Empty, _
ptrSID, bufName, _
cbUserName, bufDomain, _
cbDomainName, psUse) Then
userName = bufName.ToString
domainName = bufDomain.ToString
If Get_Domain_Name Then
Return String.Format("{0}\{1}", domainName, userName)
Else
Return userName
End If
Else
Return ""
End If
Else
Return ""
End If
End Function
#End RegionCopia una clave con sus subclaves y valores, a otro lugar del registro.
Código (vbnet) [Seleccionar]
#Region " Reg Copy Key "
' [ Reg Copy Key Function ]
'
' // By Elektro H@cker
'
' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
' Reg_Copy_Key("HKCU", "Software", "7-Zip", Nothing, "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-Zip"
' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", Nothing) ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\"
' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", Nothing, Nothing) ' Copies "HKCU\Software\7-Zip" to "HKLM\"
' Reg_Copy_Key("HKCU", "\Software\", "\7-Zip\", "HKLM", "\Software\", "\7-zip\") ' (Detects bad syntax) Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
Private Function Reg_Copy_Key(ByVal OldRootKey As String, _
ByVal OldPath As String, _
ByVal OldName As String, _
ByVal NewRootKey As String, _
ByVal NewPath As String, _
ByVal NewName As String) As Boolean
If OldPath Is Nothing Then OldPath = ""
If NewRootKey Is Nothing Then NewRootKey = OldRootKey
If NewPath Is Nothing Then NewPath = ""
If NewName Is Nothing Then NewName = ""
If OldRootKey.EndsWith("\") Then OldRootKey = OldRootKey.Substring(0, OldRootKey.Length - 1)
If NewRootKey.EndsWith("\") Then NewRootKey = NewRootKey.Substring(0, NewRootKey.Length - 1)
If OldPath.StartsWith("\") Then OldPath = OldPath.Substring(1, OldPath.Length - 1)
If OldPath.EndsWith("\") Then OldPath = OldPath.Substring(0, OldPath.Length - 1)
If NewPath.StartsWith("\") Then NewPath = NewPath.Substring(1, NewPath.Length - 1)
If NewPath.EndsWith("\") Then NewPath = NewPath.Substring(0, NewPath.Length - 1)
If OldName.StartsWith("\") Then OldName = OldName.Substring(1, OldName.Length - 1)
If OldName.EndsWith("\") Then OldName = OldName.Substring(0, OldName.Length - 1)
If NewName.StartsWith("\") Then NewName = NewName.Substring(1, NewName.Length - 1)
If NewName.EndsWith("\") Then NewName = NewName.Substring(0, NewName.Length - 1)
Dim OrigRootKey As Microsoft.Win32.RegistryKey = Nothing
Dim DestRootKey As Microsoft.Win32.RegistryKey = Nothing
Select Case OldRootKey.ToUpper
Case "HKCR", "HKEY_CLASSES_ROOT" : OrigRootKey = Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : OrigRootKey = Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : OrigRootKey = Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : OrigRootKey = Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : OrigRootKey = Microsoft.Win32.Registry.PerformanceData
Case Else : Return False
End Select
Select Case NewRootKey.ToUpper
Case "HKCR", "HKEY_CLASSES_ROOT" : DestRootKey = Microsoft.Win32.Registry.ClassesRoot
Case "HKCC", "HKEY_CURRENT_CONFIG" : DestRootKey = Microsoft.Win32.Registry.CurrentConfig
Case "HKCU", "HKEY_CURRENT_USER" : DestRootKey = Microsoft.Win32.Registry.CurrentUser
Case "HKLM", "HKEY_LOCAL_MACHINE" : DestRootKey = Microsoft.Win32.Registry.LocalMachine
Case "HKEY_PERFORMANCE_DATA" : DestRootKey = Microsoft.Win32.Registry.PerformanceData
Case Else : Return False
End Select
Dim oldkey As Microsoft.Win32.RegistryKey = OrigRootKey.OpenSubKey(OldPath + "\" + OldName, True)
Dim newkey As Microsoft.Win32.RegistryKey = DestRootKey.OpenSubKey(NewPath, True).CreateSubKey(NewName)
Reg_Copy_SubKeys(oldkey, newkey)
Return True
End Function
Private Sub Reg_Copy_SubKeys(OrigKey As Microsoft.Win32.RegistryKey, DestKey As Microsoft.Win32.RegistryKey)
Dim ValueNames As String() = OrigKey.GetValueNames()
Dim SubKeyNames As String() = OrigKey.GetSubKeyNames()
For i As Integer = 0 To ValueNames.Length - 1
Application.DoEvents()
DestKey.SetValue(ValueNames(i), OrigKey.GetValue(ValueNames(i)))
Next
For i As Integer = 0 To SubKeyNames.Length - 1
Application.DoEvents()
Reg_Copy_SubKeys(OrigKey.OpenSubKey(SubKeyNames(i), True), DestKey.CreateSubKey(SubKeyNames(i)))
Next
End Sub
#End Region