'In Form1 'Beispiel: VB .Net - Windows XP Schluessel in der Registrierdatenbank aendern. Papierkorb umbenennen. 'Hinweis : Beim Start des Beispiels wird der Schluessel ausgelesen und in der .xml Datei test.xml im ' Anwendungspfad gespeichert. ' ' Option Explicit On Option Strict On 'Benoetigte Referenzen Imports Microsoft.Win32 Imports System.Xml Imports System.IO Imports System.Reflection Imports System.Environment Public Class Form1 ''' <summary> ''' Anwendungspfad ermitteln ''' </summary> Public Class Helper Public Shared ReadOnly Property AppPath() As String Get Dim Path As String = Application.StartupPath If Path.EndsWith("\") = False Then Path &= "\" Return Path End Get End Property End Class ''' <summary> ''' Betriebsystem ermitteln. Dieses Beispiel laeuft nur unter WinXP ''' </summary> Public Class OS ' Windows 98 Windows Me Windows NT 4.0 Windows 2000 Windows XP Win. Server 2003 Windows Vista o.Longhorn Server 'Platform 1 1 2 2 2 2 2 'Version.Major 4 4 4 5 5 5 6 'Version.Minor 10 90 0 0 1 2 0 Public Shared Function IsWindowsXP() As Boolean Dim OS As OperatingSystem = Environment.OSVersion Dim Result As Boolean = OS.Platform = PlatformID.Win32NT AndAlso _ ((OS.Version.Major = 5 AndAlso OS.Version.Minor = 1)) If Result Then Return True Else Return False End If End Function End Class ''' <summary> ''' Neuen Wert setzen. 'Eintrag unter XP = @C:\WINDOWS\system32\SHELL32.dll,-8964 ''' </summary> Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Result As String Result = Me.TextBox1.Text.TrimStart Result = Result.TrimEnd Me.TextBox1.Text = Result Dim hKey As RegistryKey = Nothing Me.Button3.Enabled = True If TextBox1.TextLength > 4 Then Try hKey = Registry.ClassesRoot.OpenSubKey(REG_PART, True) hKey.SetValue(REG_KEY, Me.TextBox1.Text) MessageBox.Show("Aenderung wurde vorgenommen.", "Info") Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") Finally If hKey IsNot Nothing Then hKey.Close() End Try Else MessageBox.Show("Der neue Name muss mind. 5 Zeichen beinhalten.", "Info") End If End Sub ''' <summary> ''' Initialisierung aller benoetigten Parameter ''' </summary> Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load If OS.IsWindowsXP() = False Then MessageBox.Show("Das zugrundeliegende OS wird nicht unterstuetzt. Beispiel wird beendet.", "Info") Application.Exit() End If Dim ptResult As String = String.Empty With Me .CenterToScreen() .MaximizeBox = False .Text = "Papierkorb - Beschriftung aendern" .Button1.Text = "Beschriftung Papierkorbes aendern" .Button2.Text = "XML - Datei mit den alten Beschriftungen einlesen" .Button3.Enabled = False .Button3.Text = "Desktop aktualisieren um die Aenderung anzuzeigen" With Me.TextBox1 .MaxLength = 20 .Text = "Alte Muelltonne" End With End With Dim IsValue As Boolean = Me.GetPaperBinValue(ptResult) Debug.WriteLine(ptResult) Dim Result As Boolean = Me.WriteOldContentToXMLFile(Path.Combine(Helper.AppPath, "test.xml"), ptResult) If Result Then Me.Label1.Text = Result.ToString() & " - " & "Datei [test.xml] wurde im Anwendungspfad angelegt." If IsValue Then Me.Label2.Text = "Alter Name des Papierkorbes ist: " & ptResult Else Me.Label2.Text = "Schluesselwert konnte nicht ermittelt werden." End If Else Me.Label1.Text = "XML Datei konnte nicht angelegt werden..." End If End Sub ''' <summary> ''' Unterschluessel in der Registrierdatenbank ''' </summary> Private Const REG_PART As String = "CLSID\{645FF040-5081-101B-9F08-00AA002F954E}" ''' <summary> ''' Eintragsname in der Registrierdatenbank ''' </summary> ''' <remarks></remarks> Private Const REG_KEY As String = "LocalizedString" ''' <summary> ''' Registrierdatenbankeintrag ermitteln ''' </summary> Private Function GetPaperBinValue(ByRef ptResult As String) As Boolean Dim hKey As RegistryKey = Nothing Try hKey = Registry.ClassesRoot.OpenSubKey(REG_PART, False) If hKey Is Nothing Then Return False ptResult = CType(hKey.GetValue(REG_KEY), String) Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") Finally If hKey IsNot Nothing Then hKey.Close() End Try Return True End Function ''' <summary> ''' XML Datei anlegen ''' </summary> Private Function WriteOldContentToXMLFile(ByVal Filename As String, ByVal Data As String) As Boolean Try Dim TList As New List(Of List(Of String)) Dim [XmlSerializer] As New Serialization.XmlSerializer(GetType(List(Of List(Of String)))) If File.Exists(Filename) Then Dim ReadXML As FileStream = File.Open(Filename, FileMode.Open) TList = CType([XmlSerializer].Deserialize(ReadXML), _ Global.System.Collections.Generic.List( _ Of Global.System.Collections.Generic.List( _ Of String _ ))) ReadXML.Close() End If Dim InputData As New List(Of String) InputData.Add(Data) InputData.Reverse() TList.Add(InputData) Dim OutputStream As FileStream = File.Open(Filename, FileMode.Create) [XmlSerializer].Serialize(OutputStream, TList) OutputStream.Close() If File.Exists(Filename) Then Return True Else Return False End If Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info - " & MethodBase.GetCurrentMethod().Name()) End Try Return False End Function ''' <summary> ''' Text der XML Datei fuer Form2 verfuegbar machen ''' </summary> Public ReadOnly Property GetText() As String Get Try Dim Filename As String = Path.Combine(Helper.AppPath, "test.xml") If File.Exists(Filename) Then Return ReadSavedDataFromXMLFile(Filename) Else MessageBox.Show("Datei wurde nicht gefunden...", "Info") End If Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try Return "" End Get End Property ''' <summary> ''' Form aufrufen. Zur Anzeige der angelegten XML Datei ''' </summary> Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button2.Click Dim frm As Form Try frm = New Form2 frm.ShowDialog() Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Sub ''' <summary> ''' Angelegte XML Datei auslesen ''' </summary> ''' <param name="Filename"></param> Private Function ReadSavedDataFromXMLFile(ByVal Filename As String) As String Try Dim TList As New List(Of List(Of String)) Dim [XmlSerializer] As New Serialization.XmlSerializer(GetType(List(Of List(Of String)))) If File.Exists(Filename) Then Dim ReadXML As FileStream = File.Open(Filename, FileMode.Open) TList = CType([XmlSerializer].Deserialize(ReadXML), _ Global.System.Collections.Generic.List( _ Of Global.System.Collections.Generic.List( _ Of String _ ))) ReadXML.Close() End If Dim OutputData As String = "" For Each items As List(Of String) In TList For Each item As String In items OutputData &= item & System.Environment.NewLine Next Next Return OutputData Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info - " & MethodBase.GetCurrentMethod().Name()) End Try Return Nothing End Function ''' <summary> ''' Benoetigte Api Funktion zum aktualisieren des Desktops ''' </summary> Private Declare Sub SHChangeNotify Lib "Shell32.dll" _ ( _ ByVal wEventID As Int32, _ ByVal uFlags As Int32, _ ByVal dwItem1 As Int32, _ ByVal dwItem2 As Int32 _ ) ''' <summary> ''' Benoetigte Konstanten zur Api Funktion ''' </summary> Private Const SHCNE_ASSOCCHANGED As Int32 = &H8000000I Private Const SHCNF_IDLIST As Int32 = &H0I ''' <summary> ''' Desktop aktualisieren ''' </summary> Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button3.Click SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0) End Sub End Class 'In Form2 Public Class Form2 Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load With Me .CenterToScreen() End With Try Me.TextBox1.Text = Form1.GetText() Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Sub End Class