home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Notificati214300262009.psc / frmNotifyArea.frm < prev    next >
Text File  |  2009-02-06  |  9KB  |  301 lines
  1. VERSION 5.00
  2. Begin VB.Form frmNotifyArea 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   9930
  5.    ClientLeft      =   60
  6.    ClientTop       =   750
  7.    ClientWidth     =   11985
  8.    Icon            =   "frmNotifyArea.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   9930
  11.    ScaleWidth      =   11985
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin VB.TextBox Text1 
  14.       BeginProperty Font 
  15.          Name            =   "Courier New"
  16.          Size            =   8.25
  17.          Charset         =   0
  18.          Weight          =   400
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   495
  24.       Left            =   0
  25.       MultiLine       =   -1  'True
  26.       ScrollBars      =   3  'Both
  27.       TabIndex        =   0
  28.       Text            =   "frmNotifyArea.frx":0D4A
  29.       Top             =   0
  30.       Width           =   1215
  31.    End
  32.    Begin VB.Menu mnuFile 
  33.       Caption         =   "File"
  34.       Begin VB.Menu mnuSave 
  35.          Caption         =   "Save"
  36.       End
  37.       Begin VB.Menu Dummy 
  38.          Caption         =   "-"
  39.       End
  40.       Begin VB.Menu mnuExit 
  41.          Caption         =   "Exit"
  42.       End
  43.    End
  44. End
  45. Attribute VB_Name = "frmNotifyArea"
  46. Attribute VB_GlobalNameSpace = False
  47. Attribute VB_Creatable = False
  48. Attribute VB_PredeclaredId = True
  49. Attribute VB_Exposed = False
  50. Option Explicit
  51.  
  52. 'Start        Length   Type   Type_Data
  53. '--------------------------------------------------
  54. '0                20   Data
  55. '&H0014 / 20     522   Path   Unicode
  56. '&H021C / 540     16   Data
  57. '&H022C / 556    526   Title  Unicode
  58. '--------------------------------------------------
  59. 'Record Length  1084
  60.  
  61. 'Set manually, have to logoff / logon
  62. 'Set in registry, stop and restart explorer works
  63.  
  64. Private aByte() As Byte
  65.  
  66. 'Enter here
  67. Private Sub Form_Load()
  68.    Dim lRet    As Boolean
  69.    Dim x       As Long
  70.    Dim cTxt    As String
  71.    Dim cBehave As String
  72.    '
  73.    frmDemo.Enabled = False
  74.    
  75.    Me.Caption = " Notification Area - " & _
  76.                 App.Major & "." & _
  77.                 App.Minor & "." & _
  78.                 App.Revision
  79.    
  80.    lRet = REG_GetBinary_BYTE(HKEY_CURRENT_USER, _
  81.                              "Software\Microsoft\Windows\CurrentVersion\Explorer\TrayNotify", _
  82.                              "IconStreams", _
  83.                              aByte())
  84.    
  85.    Text1.Text = vbCrLf & "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\TrayNotify\IconStreams (REG_BINARY)" & vbCrLf & vbCrLf
  86.    Text1.Text = Text1.Text & "Start           Length   Values          Data_Type" & vbCrLf
  87.    Text1.Text = Text1.Text & "-------------------------------------------------------" & vbCrLf
  88.    Text1.Text = Text1.Text & "&H0000 /   0        20   Data Area       Byte" & vbCrLf
  89.    Text1.Text = Text1.Text & "&H0014 /  20       522   FileSpec        Unicode String" & vbCrLf
  90.    Text1.Text = Text1.Text & "&H021C / 540        16   Data Area       Byte" & vbCrLf
  91.    Text1.Text = Text1.Text & "&H022C / 556       526   Title (ToolTip) Unicode String" & vbCrLf
  92.    Text1.Text = Text1.Text & "-------------------------------------------------------" & vbCrLf
  93.    Text1.Text = Text1.Text & "Record Length     1084" & vbCrLf & vbCrLf
  94.    Text1.Text = Text1.Text & "&H0220: Hide when Inactive = 0, Always Hide = 1, Always Show = 0" & vbCrLf
  95.    Text1.Text = Text1.Text & "&H0224: Hide when Inactive = 0, Always Hide = 1, Always Show = 2" & vbCrLf & vbCrLf
  96.    Text1.Text = Text1.Text & Chr(34) & "Past Item" & Chr(34) & " if process is not running." & vbCrLf
  97.    Text1.Text = Text1.Text & "Change registry, stop and restart " & Chr(34) & "Explorer" & Chr(34) & " to set changes." & vbCrLf
  98.    Text1.Text = Text1.Text & "Remove " & Chr(34) & "Past Items," & Chr(34) & " delete " & Chr(34) & "IconStreams" & Chr(34) & " and " & Chr(34) & "PastIconsStream" & Chr(34) & " registry values and logoff." & vbCrLf
  99.    Text1.Text = Text1.Text & "Right click " & Chr(34) & "Start" & Chr(34) & ", " & Chr(34) & "Properties" & Chr(34) & ", " & Chr(34) & "Taskbar" & Chr(34) & ", " & Chr(34) & "Customize" & Chr(34) & " to manually view settings." & vbCrLf & vbCrLf
  100.    
  101.    For x = 0 To UBound(aByte) Step 1084
  102.       'ToolTip &H022C to &H043C
  103.       cTxt = GetText(x, 556, 1084)
  104.       If cTxt <> "" Then
  105.          Text1.Text = Text1.Text & Right("  " & Str(Int(x / 1083 + 1)), 2) & ". " & cTxt & vbCrLf
  106.       
  107.          'Path &H0014 to &H020A
  108.          cTxt = GetText(x, 20, 522)
  109.          Text1.Text = Text1.Text & "    " & cTxt & vbCrLf
  110.          
  111.          'Data &H0000 to &H0014
  112.          cTxt = GetData(x, 0, 19)
  113.          Text1.Text = Text1.Text & "    &H0000 " & cTxt & vbCrLf
  114.          
  115.          'Data &H021C to &H022C
  116.          cTxt = GetData(x, 540, 555)
  117.          Text1.Text = Text1.Text & "    &H021C " & cTxt & vbCrLf
  118.          
  119.          'Data &H0224 HI = 0, AH = 1, AS = 2
  120.          cTxt = GetData(x, &H220, 548)
  121.  
  122.          Select Case Val(cTxt)
  123.             Case 0
  124.                cBehave = "Hide when Inactive"
  125.                
  126.             Case 100000001
  127.                cBehave = "Always Hide"
  128.                
  129.             Case 2
  130.                cBehave = "Always Show"
  131.                
  132.          End Select
  133.          
  134.          'Test for Past Item
  135.          If Not IsProcessRun(GetText(x, 20, 522)) Then
  136.             cBehave = "Past Item - " & cBehave
  137.          End If
  138.          
  139.          Text1.Text = Text1.Text & "    &H0220 " & cTxt & " &H0224 - " & cBehave & vbCrLf
  140.          
  141.          Text1.Text = Text1.Text & vbCrLf
  142.       End If
  143.    Next
  144.    
  145. End Sub
  146.  
  147. 'Resize
  148. Private Sub Form_Resize()
  149.    Text1.Width = Me.ScaleWidth
  150.    Text1.Height = Me.ScaleHeight
  151.    
  152. End Sub
  153.  
  154. 'ControlBox
  155. Private Sub Form_Unload(Cancel As Integer)
  156.    frmDemo.Enabled = True
  157.    
  158. End Sub
  159.  
  160. 'Get unicode text from byte array
  161. Private Function GetText(ByVal nRec As Long, ByVal nStrt As Long, ByVal nStop As Long) As String
  162.    Dim cTxt As String
  163.    Dim i    As Long
  164.    Dim Y    As Long
  165.    '
  166.    For Y = nStrt To nStop
  167.       i = nRec + Y
  168.       If i > UBound(aByte) Then
  169.          Exit For
  170.       End If
  171.       cTxt = cTxt & Chr(aByte(i))
  172.    Next
  173.    cTxt = StrConv(cTxt, vbFromUnicode)
  174.    cTxt = TrimWithoutPrejudice(cTxt)
  175.    
  176.    GetText = cTxt
  177.    
  178. End Function
  179.  
  180. 'Get hex from byte array
  181. Private Function GetData(ByVal nRec As Long, ByVal nStrt As Long, ByVal nStop As Long) As String
  182.    Dim cTxt As String
  183.    Dim i    As Long
  184.    Dim Y    As Long
  185.    '
  186.    For Y = nStrt To nStop
  187.       i = nRec + Y
  188.       If i > UBound(aByte) Then
  189.          Exit For
  190.       End If
  191.       If cTxt = "" Then
  192.          cTxt = cTxt & Right("00" & Hex(aByte(i)), 2)
  193.       Else
  194.          cTxt = cTxt & " " & Right("00" & Hex(aByte(i)), 2)
  195.       End If
  196.    Next
  197.    
  198.    GetData = cTxt
  199.    
  200. End Function
  201.  
  202. 'Eliminate non-printable characters
  203. Private Function TrimWithoutPrejudice(ByVal InputString As String) As String
  204.    Dim sAns  As String
  205.    Dim sWkg  As String
  206.    Dim sChar As String
  207.    Dim lLen  As Long
  208.    Dim lCtr  As Long
  209.    '
  210.    sAns = InputString
  211.    lLen = Len(InputString)
  212.    
  213.    If lLen > 0 Then
  214.       'Ltrim
  215.       For lCtr = 1 To lLen
  216.          sChar = Mid(sAns, lCtr, 1)
  217.          If Asc(sChar) > 32 Then
  218.             Exit For
  219.          End If
  220.       Next
  221.    
  222.       sAns = Mid(sAns, lCtr)
  223.       lLen = Len(sAns)
  224.    
  225.       'Rtrim
  226.       If lLen > 0 Then
  227.          For lCtr = lLen To 1 Step -1
  228.             sChar = Mid(sAns, lCtr, 1)
  229.             If Asc(sChar) > 32 Then
  230.                Exit For
  231.             End If
  232.          Next
  233.       End If
  234.       sAns = Left$(sAns, lCtr)
  235.    End If
  236.    
  237.    TrimWithoutPrejudice = sAns
  238.  
  239. End Function
  240.  
  241. 'Is process running
  242. Private Function IsProcessRun(ByVal cFileSpec As String) As Boolean
  243.    Dim Process As Object
  244.    '
  245.    cFileSpec = Right(cFileSpec, Len(cFileSpec) - InStrRev(cFileSpec, "\"))
  246.    For Each Process In GetObject("winmgmts:"). _
  247.       ExecQuery("select * from Win32_Process where name='" & cFileSpec & "'")
  248.       IsProcessRun = True
  249.    Next
  250.       
  251. End Function
  252.  
  253. 'File > Save menu
  254. Private Sub mnuSave_Click()
  255.    Dim nFno As Integer
  256.    '
  257.    nFno = FreeFile
  258.    Open App.Path & "\Notification Area.txt" For Output As #nFno
  259.    Print #nFno, Text1.Text
  260.    Close #nFno
  261.    MsgBox "Text Saved to File in Current Folder", vbInformation
  262.    
  263. End Sub
  264.  
  265. 'File > Exit menu
  266. Private Sub mnuExit_Click()
  267.    Unload Me
  268.    
  269. End Sub
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.