We Keep Coding

Adding Power Queries to Excel using c#

I want to replicate the following code from VBA into c# VSTO:
M_Script = LoadTextFile(qname, wk)
qSource = workbook_path & "\" & qname & ".csv"
Dim qry As WorkbookQuery
Set qry = wk.Queries.Item(qname)
qry.Formula = M_Script
Set qry = wk.Queries.Add(qname, M_Script, qSource)
wk.Connections.Add2 "Query - " & query.Name, _
"Connection to the '" & query.Name & "' query in the workbook.", _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name _
, """" & query.Name & """", 6, True, False
Is there an easy equivalent? I could not find the wk.Queries. I don't want the data to be loaded into the worksheet but create only a connection to the query.
Thanks in advance!

I ended up using the following approach. Though it's not really c# and I hope I will find a better solution at some point.
VSTO Documentation is really sub-standard.
public void addQuery(string m_script_path, string query_name, Excel.Workbook wk)
{
VBComponent newStandardModule;
if(wk.VBProject.VBComponents.Count==0){
newStandardModule = wk.VBProject.VBComponents.Add(Microsoft.Vbe.Interop.vbext_ComponentType.vbext_ct_StdModule);
}
else
{
newStandardModule = wk.VBProject.VBComponents.Item(1);
}
var codeModule = newStandardModule.CodeModule;
// add vba code to module
var lineNum = codeModule.CountOfLines + 1;
var macroName = "addQuery";
var codeText = "Public Sub " + macroName + "()" + "\r\n";
codeText += "M_Script = CreateObject(\"Scripting.FileSystemObject\").OpenTextFile(\""+m_script_path+"\", 1).ReadAll" + "\r\n";
codeText += "ActiveWorkbook.Queries.Add Name:=\""+ query_name+"\", Formula:=M_Script\r\n";
codeText += "ActiveWorkbook.Connections.Add2 _\r\n";
codeText += "\"Query - test\", _\r\n";
codeText += "\"Connection to the '" + query_name + "' query in the workbook.\", _\r\n";
codeText += "\"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" + query_name + ";Extended Properties=\" _\r\n";
codeText += ", \"\"\"" + query_name + "\"\"\", 6, True, False\r\n";
codeText += "End Sub";
codeModule.InsertLines(lineNum, codeText);
var macro = string.Format("{0}.{1}", newStandardModule.Name, macroName);
wk.Application.Run(macro);
codeModule.DeleteLines(lineNum, 9);
}

embedded images sent via outlook with html body are not shown on smartphones

i have made a lot of search over the net but could not find any solution for that issue.
my desktop app need to send an email via users outlook.
everything is working properly except that the embedded images are missing on smartphones(tested on iphone and few android phones).
also tested on outlook client outside the local network (i am mentioning this because the 'src' of the html image is on the local network of the sender) and everything is working properly (i`m using "cid" for the path), so the problem is probably not the path of the image.
here are the importent parts of my test code:
Public Sub Test()
Dim file As String = "\\netapp2\Public\All\INTERNET PROJECTS\Pf-PMS\jonathana\DIVISION REPORT 25-12-2015(2)\DIVISION REPORT 25-12-2015-04-58-45.xlsm"
Dim filetosave As String = "\\netapp2\Public\All\INTERNET PROJECTS\Pf-PMS\jonathana\DIVISION REPORT 25-12-2015(4)\IMAGES"
Dim a() As String = {filetosave & "\backlog.png", filetosave & "\Teams.png", filetosave & "\q.png"}
Dim b = "<div>" _
& "<p>" _
& "text*text*text " & Now.ToString & "<br/><br/>" & "text*text*text" _
& "<br/>" _
& "text*text*text" _
& "<br/>" _
& "text*text*text" _
& "<br/>" _
& "<br/>" _
& "<u><b>text*text*text</u></b> " _
& "<br/>" _
& "<img alt='BACKLOG TABLE' hspace=0 src='cid:backlog.png' align=baseline border=0> " _
& "<br/>" _
& "</p>" _
& "</div> " _
& "<br/>" _
& "<br/>" _
& "<div> " _
& "<p>" _
& "<u><b>text*text*text </u></b>" _
& "<br/>" _
& "<IMG alt='ORANGE TEAMS DISTRIBUTION' hspace=0 src='cid:Teams.png' align=baseline border=0> " _
& "<br/>" _
& "</p>" _
& "</div> " _
& "<br/>" _
& "<br/>" _
& "<div> " _
& "<p>" _
& "<u><b>text*text*text </u></b>" _
& "<br/>" _
& "<IMG alt='DISTRIBUTION' hspace=0 src='cid:q.png' align=baseline border=0> " _
& "<br/>" _
& "</p>" _
& "</div> " _
& "<br/>"
Dim subject As String = text*text*text"
SendHtmlEmailMessegeWithMultipleAtachments(subject, b, GeneralInformation.InfoStructue.UserEmail & ";XXX#012.net.il", "", "DIVISION_REPORT", a)
End Sub
Sub SendHtmlEmailMessegeWithMultipleAtachments(ByVal sSubject As String, ByVal sBody As String, ByVal sTo As String, ByVal sCC As String, _
ByVal sDisplayname As String, Optional ByVal sFilename() As String = Nothing)
Try
Dim oApp As Interop.Outlook._Application
oApp = New Interop.Outlook.Application
Dim oMsg As Interop.Outlook._MailItem
oMsg = oApp.CreateItem(Interop.Outlook.OlItemType.olMailItem)
oMsg.Subject = sSubject
oMsg.To = sTo
oMsg.CC = sCC
oMsg.HTMLBody = "<html><body dir=RTL>" & sBody & "</body></html>"
Dim strN As String = sDisplayname
If sFilename.Length > 0 Then
Dim sBodyLen As Integer = Int(sBody.Length)
Dim oAttachs As Interop.Outlook.Attachments = oMsg.Attachments
Dim oAttach As Interop.Outlook.Attachment
For Each itm In sFilename
oAttach = oAttachs.Add(itm.ToString)
Next
End If
oMsg.Save()
oMsg.Send()
oApp = Nothing
oMsg = Nothing
IsOpen = Nothing
Catch ex As Exception
MsgBox("ERROR:" & ex.ToString, vbCritical + vbMsgBoxRight, "ERROR")
End Try

You must set the PR_ATTACH_CONTENT_ID property to the value matching the cid attribute for the image in the HTML body.
oAttach = oAttachs.Add(itm.ToString)
oAttach.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "backlog.png'

How to: Check if current user is member of ‘domain admins’

I need to verify that a provided username is a Domain Administrator in c#.
Any idea's on how to do this?

You can use WindowsIdentity to get the current user.
Then create a WindowsPrincipal with the WindowsIdentity.
And check WindowsPrincipal.IsInRole(WindowsBuiltInRole.Administrator)
Hope this can help you.
EDIT : I just see the ASP tag now... This link could help you, same thing but for ASP.

Function ADUserInfo(sLogonUser, cOption)
Dim oConnection
Dim oCommand
Dim oRoot
Dim oDomain
Dim sADsPath
Dim sDomain
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
Set oConnection = CreateObject("ADODB.Connection")
With oConnection
.Provider = "ADsDSOObject"
.Mode = "1" 'Read
.Properties("Encrypt Password") = True
.Open "Active Directory Provider"
End With
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
Set oRoot = GetObject("LDAP://" & sDomain & "/rootdse")
Set oDomain = GetObject("LDAP://" & sDomain & "/" & oRoot.Get("defaultNamingContext"))
sADsPath = "<" & oDomain.ADsPath & ">"
Select Case lcase(cOption)
Case "groups"
ADUserInfo = ADUserGroups(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Case "name"
ADUserInfo = ADUserName(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Case "supervisor"
End Select
End Function
Function ADUserGroups(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Dim sFilter
Dim sAttribsToReturn
Dim sDepth
Dim sDomainSID
Dim vObjectSID
Dim sObjectSID
Dim sGroupRID
Dim iPrimaryGroupID
Dim oPrimaryGroup
Dim oRS
Dim value
Dim cGroups
Dim sDomain
Dim sLogonName
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
sAttribsToReturn = "memberOf,primaryGroupID,objectSID"
sDepth = "subTree"
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
Set oRS = ocommand.Execute
' Only one user should meet the criteria
If (oRS.RecordCount = 1) Then
' Get that user's info
For i = 0 To oRS.Fields.Count - 1
If (oRS.Fields(i).Name = "memberOf") Then
' I've never seen this field come back with more than
' ONE value, but the original code I started with
' treated the memberOf property as though it was a
' collection. So, I've left it a collection until
' I can verify it. KLW
cGroups = ""
For Each value In oRS.Fields(i).Value
cGroups = cGroups & replace(split(value,",")(0),"CN=","") & ";"
Next
ElseIf (oRS.Fields(i).Name = "primaryGroupID") Then
' need this to get the PrimaryGroup after other group membership has been obtained
' (Primary Group ID and Object SID ID needed to get the primary group)
iPrimaryGroupID = oRS.Fields(i).Value
ElseIf (oRS.Fields(i).Name = "objectSID") Then
' adVarBinary -- need this to get the PrimaryGroup.
' It is not included in the memberOf group list
vObjectSID = oRS.Fields(i).Value
sObjectSID = SDDL_SID(vObjectSID)
End If
Next
' The primary group is not included in memberOf...
' We have the SDDL form of the user's SID.
' Remove the user's RID ( the last sub authority)
' up to the "-"
'
sDomainSID = Mid(sObjectSID, 1, (InStrREV(sObjectSID,"-")))
' Build the SID of the Primary group
' from the domainSID and the Primary Group RID in
' the PrimaryGroupID.
'
sGroupRID = StrRID(iPrimaryGroupID)
sDomainSID = sDomainSID & sGroupRID
' Get the primary group
'
set oPrimaryGroup = GetObject("LDAP://" & sDomain & "/<SID=" & sDomainSID & ">")
cGroups = replace(split(oPrimaryGroup.Get("DistinguishedName"),",")(0),"CN=","") & ";" & cGroups
ADUserGroups = cGroups
End If
End Function
Function ADUserName(sLogonUser, oConnection, oCommand, oRoot, oDomain, sADsPath)
Dim sFilter
Dim sAttribsToReturn
Dim sDepth
Dim sDomainSID
Dim vObjectSID
Dim sObjectSID
Dim sGroupRID
Dim iPrimaryGroupID
Dim oPrimaryGroup
Dim oRS
Dim value
Dim sDomain
Dim sLogonName
sDomain = Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1)
sLogonName = Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)
sFilter = "(&(objectCategory=Person)(objectClass=user)(sAMAccountName=" & sLogonName & "))"
sAttribsToReturn = "distinguishedName"
sDepth = "subTree"
ocommand.CommandText = sADsPath & ";" & sFilter & ";" & sAttribsToReturn & ";" & sDepth
Set oRS = ocommand.Execute
' Only one user should meet the criteria
If (oRS.RecordCount = 1) Then
' Get that user's info
For i = 0 To oRS.Fields.Count - 1
If (oRS.Fields(i).Name = "distinguishedName") Then
ADUserName = replace(split(oRS.Fields(i).Value,",")(0),"CN=","")
End If
Next
End If
End Function
function SDDL_SID ( oSID )
dim IssueAuthorities(11)
Dim SubAuthorities
Dim strSDDL
Dim IssueIndex
Dim Revision
Dim i, j, k, index, p2, subtotal, dblSubAuth
IssueAuthorities(0) = "-0-0"
IssueAuthorities(1) = "-1-0"
IssueAuthorities(2) = "-2-0"
IssueAuthorities(3) = "-3-0"
IssueAuthorities(4) = "-4"
IssueAuthorities(5) = "-5"
IssueAuthorities(6) = "-?"
IssueAuthorities(7) = "-?"
IssueAuthorities(8) = "-?"
IssueAuthorities(9) = "-?"
' First byte is the revision value
'
Revision = ascb(midB(osid,1,1))
' Second byte is the number of sub authorities in the
' SID
'
SubAuthorities = CInt(ascb(midb(oSID,2,1)))
strSDDL = "S-" & Revision
IssueIndex = CInt(ascb(midb(oSID,8,1)))
strSDDL = strSDDL & IssueAuthorities(IssueIndex)
index = 9
i = index
for k = 1 to SubAuthorities
p2 = 0
subtotal = 0
for j = 1 to 4
dblSubAuth = CDbl(ascb(midb(osid,i,1))) * (2^p2)
subTotal = subTotal + dblSubAuth
p2 = p2 + 8
i = i + 1
next
' Convert the value to a string, add it to the SDDL Sid and continue
'
strSDDL = strSDDL & "-" & cstr(subTotal)
next
SDDL_SID = strSDDL
end function
function Get_HexString( oSID )
Dim outStr, i, b
outStr = ""
for i = 0 to Ubound(oSid)
b = hex(ascb(midb(oSid,i+1,1)))
if( len(b) = 1 ) then b = "0" & b
outStr = outStr & b
next
Get_HexString = outStr
end function
function StrRID( inVal )
dim dLocal
if( (inVal and &H80000000) <> 0 ) then
dLocal = CDbl((inval and &H7FFFFFFF))
dLocal = dLocal + 2^31
StrRID = cstr(dLocal)
else
StrRID = Cstr(inVal)
end if
end function

filesystemwatcher chrome cache in Visual basic [duplicate]

I've made a program in Visual Basic 2010, that monitors and write down changes in a folder eg. when a file deletes, when a file renames, when a file creates and which files, but it's a problem. I've writed the code to make a new line when another change is made, when a change is made, it writes it down to a file named log.txt, but the log only looks like "File log.txt has been modified" because the program, when it write changes to the log, it changes the log.txt to write down the log, but the strange is, it deletes everything in the document and writes "File log..txt has been modified" even if I have writed in the code to make a new line before writing. Can someone help me with this problem? Here's the code:
Imports System.IO
Imports System.Diagnostics
Public Class Form1
Public watchfolder As FileSystemWatcher
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
watchfolder = New System.IO.FileSystemWatcher()
'this is the path we want to monitor
watchfolder.Path = TextBox1.Text
'Add a list of Filter we want to specify
'make sure you use OR for each Filter as we need to
'all of those
watchfolder.NotifyFilter = IO.NotifyFilters.DirectoryName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or _
IO.NotifyFilters.FileName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or _
IO.NotifyFilters.Attributes
' add the handler to each event
AddHandler watchfolder.Changed, AddressOf logchange
AddHandler watchfolder.Created, AddressOf logchange
AddHandler watchfolder.Deleted, AddressOf logchange
' add the rename handler as the signature is different
AddHandler watchfolder.Renamed, AddressOf logrename
'Set this property to true to start watching
watchfolder.EnableRaisingEvents = True
Button1.Enabled = False
Button2.Enabled = True
'End of code for btn_start_click
End Sub
Private Sub logchange(ByVal source As Object, ByVal e As _
System.IO.FileSystemEventArgs)
If e.ChangeType = IO.WatcherChangeTypes.Changed Then
Dim writer As New IO.StreamWriter("log.txt")
writer.WriteLine(Chr(13) & "File" + " " + e.FullPath + " " + "has been modified")
writer.Close()
End If
If e.ChangeType = IO.WatcherChangeTypes.Created Then
Dim writer As New IO.StreamWriter("log.txt")
writer.WriteLine(Chr(13) & "File" + " " + e.FullPath + " " + "has been created")
writer.Close()
End If
If e.ChangeType = IO.WatcherChangeTypes.Deleted Then
Dim writer As New IO.StreamWriter("log.txt")
writer.WriteLine(Chr(13) & "Filde" + " " + e.FullPath + " " + "has been deleted")
writer.Close()
End If
End Sub
Public Sub logrename(ByVal source As Object, ByVal e As _
System.IO.RenamedEventArgs)
Dim writer As New IO.StreamWriter("log.txt")
writer.WriteLine(Chr(13) & "File" + " " + e.FullPath + "has been renamed to" + " " + e.Name)
writer.Close()
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
' Stop watching the folder
watchfolder.EnableRaisingEvents = False
Button1.Enabled = True
Button2.Enabled = False
End Sub
End Class

When you open your streamwriter, you are not telling it to append, so it overwrites:
Dim writer As New IO.StreamWriter("log.txt", True)
Also, you dont need a new stream for each activity:
Dim msg as string= Environment.NewLine & "File " & e.FullPath & " "
Select case e.ChangeType
case IO.WatcherChangeTypes.Created
msg &= "has been created"
case IO.WatcherChangeTypes.Deleted
msg &= "has been deleted"
...etc
End Select
Dim writer As New IO.StreamWriter("log.txt", True)
writer.WriteLine(msg)
writer.Close()
..you could also leave the stream open until the watcher ends
You probably should exempt logging changes to log.txt, so test e.FullPath:
If System.Io.Path.GetFileName(e.FullPath).ToLower = "log.text" Then Exit Sub

Now the program in working! Thank you MPelletier and Plutonix for the amazing help! Here is the complete code:
Imports System.IO
Imports System.Diagnostics
Public Class Form1
Public watchfolder As FileSystemWatcher
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
watchfolder = New System.IO.FileSystemWatcher()
watchfolder.IncludeSubdirectories = True
watchfolder.Path = TextBox1.Text
watchfolder.NotifyFilter = IO.NotifyFilters.DirectoryName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or _
IO.NotifyFilters.FileName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or _
IO.NotifyFilters.Attributes
AddHandler watchfolder.Changed, AddressOf logchange
AddHandler watchfolder.Created, AddressOf logchange
AddHandler watchfolder.Deleted, AddressOf logchange
AddHandler watchfolder.Renamed, AddressOf logrename
watchfolder.EnableRaisingEvents = True
Button1.Enabled = False
Button2.Enabled = True
End Sub
Private Sub logchange(ByVal source As Object, ByVal e As _
System.IO.FileSystemEventArgs)
If System.IO.Path.GetFileName(e.FullPath).ToLower = "log.txt" Then Exit Sub
Dim msg As String = Environment.NewLine & "File " & e.FullPath & " "
Select Case e.ChangeType
Case IO.WatcherChangeTypes.Created
msg &= "has been created" + " " + "Time:" + " " + Format(TimeOfDay)
Case IO.WatcherChangeTypes.Deleted
msg &= "has been deleted" + " " + "Time:" + " " + Format(TimeOfDay)
Case IO.WatcherChangeTypes.Changed
msg &= "has been modified" + " " + "Time:" + " " + Format(TimeOfDay)
End Select
Dim writer As New IO.StreamWriter("log.txt", True)
writer.WriteLine(msg)
writer.Close()
End Sub
Public Sub logrename(ByVal source As Object, ByVal e As _
System.IO.RenamedEventArgs)
Select e.ChangeType
Case IO.WatcherChangeTypes.Created
Exit Sub
Case IO.WatcherChangeTypes.Changed
Exit Sub
Case IO.WatcherChangeTypes.Deleted
Exit Sub
Case Else
Dim msgrn As String = Environment.NewLine & "File " + e.OldName + " "
msgrn &= "has been renamed to" + " " + e.Name + " " + "Time:" + " " + Format(TimeOfDay)
Dim writer As New IO.StreamWriter("log.txt", True)
writer.WriteLine(msgrn)
writer.Close()
End Select
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
watchfolder.EnableRaisingEvents = False
Button1.Enabled = True
Button2.Enabled = False
End Sub
Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Me.Hide()
MsgBox("To close it later, don't open the program again, press CTRL+ALT+DELETE and press Start Task Manager or something like that, and go to processes and kill FolderMonitor.exe or what you have named the file", 0 + 64, "FolderMonitor")
End Sub
End Class

Mute Vb/c++/C# application

I need to mute my application because it's using 5 webbrowsers and navigates to sites with flash, this can cause a lot of annoying sound , so I searched everywhere but no luck
I want to know if there is a way to mute either my application or my webbrowsers either through vb code or whatever other language (I will make a plug-in).
Thanks in advance for your help.

On Windows Vista and later, you can set an individual application's sound volume by calling a function inside winmm.dll
[DllImport("winmm.dll")]
private static extern int waveOutSetVolume(IntPtr hwo, uint dwVolume);
And call following static method:
public static void MuteApplication()
{
int NewVolume = 0;
uint NewVolumeAllChannels = (((uint)NewVolume & 0x0000ffff) | ((uint)NewVolume << 16));
waveOutSetVolume(IntPtr.Zero, NewVolumeAllChannels);
}

I think that you will need to set the configuration of IExplorer which is the process who plays that sounds.
You could set a flag to don't play sound using registry:
At this key:
HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main
Value name:
Play_Background_Sounds
Data:
no
Time ago I did a class to manage Regedit operations, you can use it like this:
RegEdit.Set_Value("HKCU\Software\Microsoft\Internet Explorer\Main", _
"Play_Background_Sounds", _
"no", _
Microsoft.Win32.RegistryValueKind.String)
RegEdit.Set_Value("HKCU\Software\Microsoft\Internet Explorer\Main", _
"Play_Background_Sounds", _
"yes", _
Microsoft.Win32.RegistryValueKind.String)
Here is the Class:
#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 Key?:
' -----------
' MsgBox(RegEdit.Exist_Key("HKCU\software") ' Checks if "Software" Key exist.
' -------------
' 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
Private Shared RootKey As Microsoft.Win32.RegistryKey = Nothing
Private Shared KeyPath As String = String.Empty
''' <summary>
''' Create a new registry key.
''' </summary>
Public Shared Function Create_Key(ByVal RegKey As String) As Boolean
RootKey = Get_Root_Key(RegKey)
KeyPath = Get_Key_Path(RegKey)
Try
RootKey.CreateSubKey(KeyPath)
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
RootKey = Get_Root_Key(RegKey)
KeyPath = Get_Key_Path(RegKey)
Try
RootKey.DeleteSubKeyTree(KeyPath)
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
RootKey = Get_Root_Key(RegKey)
KeyPath = Get_Key_Path(RegKey)
Try
RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
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
RootKey = Get_Root_Key(RegKey)
KeyPath = RootKey.ToString & "\" & Get_Key_Path(RegKey)
RootKey.Dispose()
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
RootKey = Get_Root_Key(RegKey)
KeyPath = RootKey.ToString & "\" & 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)
RootKey.Dispose()
Else
My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
RootKey.Dispose()
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
Regedit.Dispose()
Return False
Else
Regedit.Dispose()
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
Regedit.Dispose()
Return False
Else
Regedit.Dispose()
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
RootKey = Get_Root_Key(RegKey)
KeyPath = RootKey.ToString & "\" & 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)
RootKey.Dispose()
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>
''' Checks if a Key exist.
''' </summary>
Public Shared Function Exist_Key(ByVal RegKey As String) As Boolean
RootKey = Get_Root_Key(RegKey)
KeyPath = Get_Key_Path(RegKey)
If RootKey Is Nothing OrElse KeyPath Is Nothing Then Return False
If RootKey.OpenSubKey(KeyPath, False) Is Nothing Then
RootKey.Dispose()
Return False
Else
RootKey.Dispose()
Return True
End If
End Function
''' <summary>
''' Checks if a value exist.
''' </summary>
Public Shared Function Exist_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
RootKey = Get_Root_Key(RegKey)
KeyPath = Get_Key_Path(RegKey)
Try
If RootKey.OpenSubKey(KeyPath, False).GetValue(RegValue) = String.Empty Then
RootKey.Dispose()
Return False
Else
RootKey.Dispose()
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
RootKey = Get_Root_Key(RegKey)
KeyPath = RootKey.ToString & "\" & Get_Key_Path(RegKey)
Try
If My.Computer.Registry.GetValue(KeyPath, RegValue, Nothing) = Nothing Then
RootKey.Dispose()
Return False
Else
RootKey.Dispose()
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 = String.Empty
RootKey = Get_Root_Key(RegKey)
KeyPath = RootKey.ToString & "\" & 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.Default)
TextFile.WriteLine("""" & KeyPath & """" & " " & PermissionString)
End Using
Dim Regini As New Process()
Dim Regini_Info As New ProcessStartInfo()
Regini_Info.FileName = "Regini.exe"
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
RootKey.Dispose()
Regini.Dispose()
Return False
Else
RootKey.Dispose()
Regini.Dispose()
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
If RegKey Is Nothing Then Return Nothing
Dim Path As String = String.Empty
For i As Integer = 1 To RegKey.Split("\").Length - 1
' Application.DoEvents()
Path &= RegKey.Split("\")(i) & "\"
Next
If Not Path.Contains("\") Then Path = Path & "\"
Path = Path.Substring(0, Path.LastIndexOf("\"))
Return Path
End Function
End Class
#End Region
#End Region