persia_hrn
سه شنبه 03 مرداد 1396, 01:35 صبح
با سلام خدمت دوستان و اساتید محترم .
قصدم از ایجاد این تاپیک این بود که راه ایجاد تغییرات در پنجره Notification Area Icons رو توسط ایجاد تغییر در کلیدهای رجیستری جویا بشم ( البته واسه یه برنامه ی بخصوص ).
البته یه خورده گشتم و تنها کدی که پیدا کردم رو در پایین میذارم ، البته کد فکر کنم به زبان C باشه و خواهش میکنم اگه این امکان برای دوستان هست ، کد زیر رو به زبان دلفی برگردونن شاید به کار دوستان دیگه هم مثل من بیاد .
قبلاً از همکاریتون ممنونم .
Function AlwaysShowNotifyIcon(ByVal WhenToShow As Byte) As Boolean
Dim x As Integer = 0
Dim myHolderString As String
Dim encText As System.Text.UTF8Encoding = New System.Text.UTF8Encoding()
Try
Dim myRegistryKeyAsByte As Byte() = Nothing
Dim myRegistryKeyAsString As String = ""
Try
myRegistryKeyAsByte = ReadCURKByte("Software\Microsoft\Windows\CurrentVersion\Explorer \TrayNotify", "IconStreams", Nothing)
For x = 0 To UBound(myRegistryKeyAsByte)
myHolderString = DoubleToHex(myRegistryKeyAsByte(x))
Select Case myHolderString.Length
Case 0
myRegistryKeyAsString += "00"
Case 1
myRegistryKeyAsString += "0" + myHolderString
Case 2
myRegistryKeyAsString += myHolderString
End Select
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Dim myTempAppPathAsByte As Byte()
myTempAppPathAsByte = encText.GetBytes(My.Application.Info.DirectoryPath .ToString & "\" & My.Application.Info.AssemblyName)
Dim myAppPathAsByte(UBound(myTempAppPathAsByte) * 2) As Byte
Dim myAppPathAsString As String = ""
Try
For x = 0 To UBound(myAppPathAsByte)
If x Mod 2 = 0 Then
myAppPathAsByte(x) = myTempAppPathAsByte(CInt(x / 2))
Else
myAppPathAsByte(x) = 0
End If
Next
For x = 0 To UBound(myAppPathAsByte)
myHolderString = DoubleToHex(myAppPathAsByte(x))
Select Case myHolderString.Length
Case 0
myAppPathAsString += "00"
Case 1
myAppPathAsString += "0" + myHolderString
Case 2
myAppPathAsString += myHolderString
End Select
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Dim myPosition As Long = InStr(myRegistryKeyAsString, myAppPathAsString) - 1
If myPosition > 0 Then
myRegistryKeyAsByte(CInt(myPosition / 2 - 20)) = WhenToShow
WriteCURKByteValue("Software\Microsoft\Windows\CurrentVersion\Explorer \TrayNotify", "IconStreams", myRegistryKeyAsByte)
Dim ExplorerProcess As Process = Nothing
For Each p As Process In Process.GetProcesses
If p.ProcessName.ToString = "explorer" Then
ExplorerProcess = p
Exit For
Else
ExplorerProcess = Nothing
End If
Next
If Not ExplorerProcess Is Nothing Then
ExplorerProcess.Kill()
Threading.Thread.Sleep(2000)
End If
Else
Return False
End If
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
End Function
Private Function DoubleToHex(ByVal x As Double) As String
DoubleToHex = ""
Dim lrem As Double
While x > 0
lrem = x - Int(x / 16) * 16
DoubleToHex = Hex(lrem) & DoubleToHex
x = Int(x / 16)
End While
End Function
قصدم از ایجاد این تاپیک این بود که راه ایجاد تغییرات در پنجره Notification Area Icons رو توسط ایجاد تغییر در کلیدهای رجیستری جویا بشم ( البته واسه یه برنامه ی بخصوص ).
البته یه خورده گشتم و تنها کدی که پیدا کردم رو در پایین میذارم ، البته کد فکر کنم به زبان C باشه و خواهش میکنم اگه این امکان برای دوستان هست ، کد زیر رو به زبان دلفی برگردونن شاید به کار دوستان دیگه هم مثل من بیاد .
قبلاً از همکاریتون ممنونم .
Function AlwaysShowNotifyIcon(ByVal WhenToShow As Byte) As Boolean
Dim x As Integer = 0
Dim myHolderString As String
Dim encText As System.Text.UTF8Encoding = New System.Text.UTF8Encoding()
Try
Dim myRegistryKeyAsByte As Byte() = Nothing
Dim myRegistryKeyAsString As String = ""
Try
myRegistryKeyAsByte = ReadCURKByte("Software\Microsoft\Windows\CurrentVersion\Explorer \TrayNotify", "IconStreams", Nothing)
For x = 0 To UBound(myRegistryKeyAsByte)
myHolderString = DoubleToHex(myRegistryKeyAsByte(x))
Select Case myHolderString.Length
Case 0
myRegistryKeyAsString += "00"
Case 1
myRegistryKeyAsString += "0" + myHolderString
Case 2
myRegistryKeyAsString += myHolderString
End Select
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Dim myTempAppPathAsByte As Byte()
myTempAppPathAsByte = encText.GetBytes(My.Application.Info.DirectoryPath .ToString & "\" & My.Application.Info.AssemblyName)
Dim myAppPathAsByte(UBound(myTempAppPathAsByte) * 2) As Byte
Dim myAppPathAsString As String = ""
Try
For x = 0 To UBound(myAppPathAsByte)
If x Mod 2 = 0 Then
myAppPathAsByte(x) = myTempAppPathAsByte(CInt(x / 2))
Else
myAppPathAsByte(x) = 0
End If
Next
For x = 0 To UBound(myAppPathAsByte)
myHolderString = DoubleToHex(myAppPathAsByte(x))
Select Case myHolderString.Length
Case 0
myAppPathAsString += "00"
Case 1
myAppPathAsString += "0" + myHolderString
Case 2
myAppPathAsString += myHolderString
End Select
Next
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Dim myPosition As Long = InStr(myRegistryKeyAsString, myAppPathAsString) - 1
If myPosition > 0 Then
myRegistryKeyAsByte(CInt(myPosition / 2 - 20)) = WhenToShow
WriteCURKByteValue("Software\Microsoft\Windows\CurrentVersion\Explorer \TrayNotify", "IconStreams", myRegistryKeyAsByte)
Dim ExplorerProcess As Process = Nothing
For Each p As Process In Process.GetProcesses
If p.ProcessName.ToString = "explorer" Then
ExplorerProcess = p
Exit For
Else
ExplorerProcess = Nothing
End If
Next
If Not ExplorerProcess Is Nothing Then
ExplorerProcess.Kill()
Threading.Thread.Sleep(2000)
End If
Else
Return False
End If
Catch ex As Exception
Debug.WriteLine(ex.Message)
Return False
End Try
End Function
Private Function DoubleToHex(ByVal x As Double) As String
DoubleToHex = ""
Dim lrem As Double
While x > 0
lrem = x - Int(x / 16) * 16
DoubleToHex = Hex(lrem) & DoubleToHex
x = Int(x / 16)
End While
End Function