form1.frm

新手学习vb语言的实用资料于其对计算机语言做出相应了解的教材

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "PC监视器"
   ClientHeight    =   5715
   ClientLeft      =   6240
   ClientTop       =   2640
   ClientWidth     =   4740
   ClipControls    =   0   'False
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5715
   ScaleWidth      =   4740
   Begin VB.Timer tmrFlashMe 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   960
      Top             =   4710
   End
   Begin VB.TextBox Text1 
      Height          =   2895
      Left            =   240
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Text            =   "Form1.frx":030A
      Top             =   480
      Width           =   4155
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' Brought to you by Brad Martinez
'   http://members.aol.com/btmtz/vb
'   http://www.mvps.org/ccrp
'
' Code was written in and formatted for 8pt MS San Serif
'
' ====================================================================
' Demonstrates how to receive shell change notifications (ala "what happens when the
' SHChangeNotify API is called?")
'
' Interpretation of the shell's undocumented functions SHChangeNotifyRegister (ordinal 2)
' and SHChangeNotifyDeregister (ordinal 4) would not have been possible without the
' assistance of James Holderness. For a complete (and probably more accurate) overview
' of shell change notifcations, please refer to James' "Shell Notifications" page at
' http://www.geocities.com/SiliconValley/4942/
' ====================================================================
'

Private Sub Form_Load()
  If SubClass(hWnd) Then
    If IsIDE Then
      Text1 = "**IMPORTANT**" & vbCrLf & _
                    "本窗口为 subclassed.不要用VB 的结束按钮或" & vbCrLf & _
                   "结束菜单命令\或关闭VB来关闭它,只能通过它自" & vbCrLf & _
                   "己的系统菜单关闭它." & vbCrLf & vbCrLf & Text1

    End If
    Call SHNotify_Register(hWnd)
  Else
    Text1 = "Uh..., it's supposed to work... :-)"
  End If
  Move Screen.Width - Width, Screen.Height - Height
End Sub

Private Function IsIDE() As Boolean
  On Error GoTo Out
  Debug.Print 1 / 0
Out:
  IsIDE = Err
End Function

Private Sub Form_Unload(Cancel As Integer)
  Call SHNotify_Unregister
  Call UnSubClass(hWnd)
End Sub

Private Sub Form_Resize()
  On Error GoTo Out
  Text1.Move 0, 0, ScaleWidth, ScaleHeight
Out:
End Sub

Public Sub NotificationReceipt(wParam As Long, lParam As Long)
  Dim sOut As String
  Dim shns As SHNOTIFYSTRUCT
  
  sOut = SHNotify_GetEventStr(lParam) & vbCrLf
  
  ' Fill the SHNOTIFYSTRUCT from it's pointer.
  MoveMemory shns, ByVal wParam, Len(shns)
      
  ' lParam is the ID of the notication event, one of the SHCN_EventIDs.
  Select Case lParam
      
    ' ================================================================
    ' For the SHCNE_FREESPACE event, dwItem1 points to what looks like a 10 byte
    ' struct. The first two bytes are the size of the struct, and the next two members
    ' equate to SHChangeNotify's dwItem1 and dwItem2 params. The dwItem1 member
    ' is a bitfield indicating which drive(s) had it's (their) free space changed. The bitfield
    ' is identical to the bitfield returned from a GetLogicalDrives call, i.e, bit 0 = A:\, bit
    ' 1 = B:\, 2, = C:\, etc. Since VB does DWORD alignment when MoveMemory'ing
    ' to a struct, we'll extract the bitfield directly from it's memory location.
    Case SHCNE_FREESPACE
      Dim dwDriveBits As Long
      Dim wHighBit As Integer
      Dim wBit As Integer
      
      MoveMemory dwDriveBits, ByVal shns.dwItem1 + 2, 4

      ' Get the zero based position of the highest bit set in the bitmask
      ' (essentially determining the value's highest complete power of 2).
      ' Use floating point division (we want the exact values from the Logs)
      ' and remove the fractional value (the fraction indicates the value of
      ' the last incomplete power of 2, which means the bit isn't set).
      wHighBit = Int(Log(dwDriveBits) / Log(2))
      
      For wBit = 0 To wHighBit
        ' If the bit is set...
        If (2 ^ wBit) And dwDriveBits Then
          
          ' The bit is set, get it's drive string
          sOut = sOut & Chr$(vbKeyA + wBit) & ":\" & vbCrLf

        End If
      Next
      
    ' ================================================================
    ' shns.dwItem1 also points to a 10 byte struct. The struct's second member (after the
    ' struct's first WORD size member) points to the system imagelist index of the image
    ' that was updated.
    Case SHCNE_UPDATEIMAGE
      Dim iImage As Long
      
      MoveMemory iImage, ByVal shns.dwItem1 + 2, 4
      sOut = sOut & "Index of image in system imagelist: " & iImage & vbCrLf
    
    ' ================================================================
    ' Everything else except SHCNE_ATTRIBUTES is the pidl(s) of the changed item(s).
    ' For SHCNE_ATTRIBUTES, neither item is used. See the description of the values
    ' for the wEventId parameter of the SHChangeNotify API function for more info.
    Case Else
      Dim sDisplayname As String
      
      If shns.dwItem1 Then
        sDisplayname = GetDisplayNameFromPIDL(shns.dwItem1)
        If Len(sDisplayname) Then
          sOut = sOut & "first item displayname: " & sDisplayname & vbCrLf
          sOut = sOut & "first item path: " & GetPathFromPIDL(shns.dwItem1) & vbCrLf
        Else
          sOut = sOut & "first item is invalid" & vbCrLf
        End If
      End If
    
      If shns.dwItem2 Then
        sDisplayname = GetDisplayNameFromPIDL(shns.dwItem2)
        If Len(sDisplayname) Then
          sOut = sOut & "second item displayname: " & sDisplayname & vbCrLf
          sOut = sOut & "second item path: " & GetPathFromPIDL(shns.dwItem2) & vbCrLf
        Else
          sOut = sOut & "second item is invalid" & vbCrLf
        End If
      End If
  
  End Select
  
  Text1 = Text1 & sOut & vbCrLf
  Text1.SelStart = Len(Text1)
  tmrFlashMe = True

End Sub

Private Sub tmrFlashMe_Timer()   ' initial settings: Interval = 1, Enabled = False
  Static nCount As Integer
  
  If nCount = 0 Then tmrFlashMe.Interval = 200
  nCount = nCount + 1
  Call FlashWindow(hWnd, True)
  
  ' Reset everything after 3 flash cycles
  If nCount = 6 Then
    nCount = 0
    tmrFlashMe.Interval = 1
    tmrFlashMe = False
  End If

End Sub