Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long

Private Declare Function GetDriveType Lib "kernel32" _
     Alias "GetDriveTypeA" _
     (ByVal nDrive As String) As Long

Private Const DRIVE_UNKNOWN As Long = 0
Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6
      

Private Sub CreateDriveMenu()

   Dim c As Long
   Dim drvType As String
   Dim drvName As String
   Dim allDrives As String
   
  'get the list of all available drives
   allDrives = GetDriveString()
   
  'Separate the drive strings and add them
  'to the menu.
   Do Until allDrives = vbNullChar
   
     'strip off one drive item from allDrives
      drvName = StripNulls(allDrives)
      drvType = rgbGetDriveType(drvName)
      
     'add a new entry to the drive to the menu,
     'skipping menu array item 0
      If c > 0 Then Load mnuDriveDetails(c)
      
      mnuDriveDetails(c).Caption = drvName & " stats " & drvType
      mnuDriveDetails(c).Visible = True
      
      c = c + 1
      
   Loop
   
  'add a separator and a close option
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "-"
   
   c = c + 1
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "Close Tray Icon"

   c = c + 1
   Load mnuDriveDetails(c)
   mnuDriveDetails(c).Visible = True
   mnuDriveDetails(c).Caption = "Exit Drive Info"
   
  'uncomment this to hide the menu
  'zmnuDemo.Visible = False

End Sub


Private Sub ShellTrayRemove()

  'Remove the icon from the taskbar
   Call Shell_NotifyIcon(NIM_DELETE, NID)
   
End Sub


Private Sub Form_Load()
     
  'centre this form
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
   Dim msg As String
   msg = "Systray Tooltip && Popup Menu Demo." & vbCrLf & vbCrLf
   msg = msg & "Move the mouse over the systray 'drive'"
   msg = msg & " icon. The tooltip will appear." & vbCrLf & vbCrLf
   msg = msg & "Right-clicking displays the popup menu. "
   msg = msg & "Choose an option."
   
   Label2.Caption = msg

  'add an icon to the system tray
   If ShellTrayAdd = 1 Then

      CreateDriveMenu  'populate the menu with drive info
      SubClass Me.hwnd 'prepare to receive the systray events

   End If
End Sub


Private Function rgbGetDriveType(thisDrv As String) As String

 'returns string representing the type of drive.
 
   Select Case GetDriveType(thisDrv)
      Case DRIVE_UNKNOWN:  rgbGetDriveType = "[unknown]"
      Case DRIVE_NO_ROOT_DIR:   rgbGetDriveType = "[error: no root]"
      Case DRIVE_REMOVABLE:
         Select Case Left$(thisDrv, 1)
            Case "a", "b": rgbGetDriveType = "[floppy]"
            Case Else:     rgbGetDriveType = "[removable]"
         End Select
      
      Case DRIVE_FIXED:   rgbGetDriveType = "[hard drive]"
      Case DRIVE_REMOTE:  rgbGetDriveType = "[network]"
      Case DRIVE_CDROM:   rgbGetDriveType = "[CD-ROM]"
      Case DRIVE_RAMDISK: rgbGetDriveType = "[RAM disk]"
   End Select
  
End Function


Private Function GetDriveString() As String

  'returns string of available
  'drives each separated by a null
   Dim sBuffer As String
   
  'possible 26 drives, four characters each (including null)
   sBuffer = Space$(26 * 4)
  
  If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

     'trim the spaces, but do not 
     'trim off the trailing null!
      GetDriveString = Trim$(sBuffer)
      
   End If

End Function


Private Function StripNulls(startStrg As String) As String

  'Takes a string separated by a delimiter
  '(Chr$(0) here), and split off 1 item,
  'and shorten the string so that the
  'next item is ready for removal.
   Dim pos As Integer
   
   pos = InStr(startStrg, Chr$(0))
   
   If pos Then
      StripNulls = Mid(startStrg, 1, pos - 1)
      startStrg = Mid(startStrg, pos + 1)
      Exit Function
   End If
  
End Function


Public Function ShellTrayAdd() As Long

 'prepare the NOTIFYICONDATA type with the
 'required parameters:
 
 '.cbSize: Size of this structure, in bytes.
 '
 '.hwnd:   Handle of the window that will receive
 '         notification messages associated with
 '         an icon in the taskbar status area.
 '
 'uID:     Application-defined identifier of
 '         the taskbar icon. In an application
 '         with a single tray icon, this can be
 '         an arbitrary number.  For apps with
 '         multiple icons, each icon ID must be
 '         different as this member identifies
 '         which of the icons was selected.
 '
 '.uFlags: flags that indicate which of the other
 '         members contain valid data. This member
 '         can be a combination of the following:
 '         NIF_ICON    hIcon member is valid.
 '         NIF_MESSAGE uCallbackMessage member is valid.
 '         NIF_TIP     szTip member is valid.
 '
 'uCallbackMessage: Application-defined message identifier.
 '         The system uses this identifier for
 '         notification messages that it sends
 '         to the window identified in hWnd.
 '         These notifications are sent when a
 '         mouse event occurs in the bounding
 '         rectangle of the icon. (Note: 'callback'
 '         is a bit misused here (in the context of
 '         other callback demonstrations); there is
 '         no systray-specific callback defined -
 '         instead the form itself must be subclassed
 '         to respond to this message.
 '
 '.hIcon:  Handle to the icon to add, modify, or delete.
 '
 'szTip:   Tooltip text to display for the icon. Must
 '         be terminated with a Chr$(0).
 
 'Shell_NotifyIcon messages:
 'dwMessage: Message value to send. This parameter
 '           can be one of these values:
 '           NIM_ADD  Adds icon to status area
 '           NIM_DELETE  Deletes icon from status area
 '           NIM_MODIFY  Modifies icon in status area
 '
 'pnid:      Address of the prepared NOTIFYICONDATA.
 '           The content of the structure depends
 '           on the value of dwMessage.

   If NOTIFYICONDATA_SIZE = 0 Then SetShellVersion
    
   With NID
     .cbSize = NOTIFYICONDATA_SIZE
     .hwnd = frmMain.hwnd
     .uID = 125&
     .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     .uCallbackMessage = WM_MYHOOK
     .hIcon = Me.Icon
     .szTip = "VBnet System Tray Callback Demo" & Chr$(0)
   End With

   ShellTrayAdd = Shell_NotifyIcon(NIM_ADD, NID)

End Function


Private Sub UnSubClass()

  'restore the default message handling
  'before exiting
   If defWindowProc Then
      SetWindowLong frmMain.hWnd, GWL_WNDPROC, defWindowProc
      defWindowProc = 0
   End If
   
End Sub


Private Sub SubClass(hwnd As Long)

  'assign our own window message
  'procedure (WindowProc)
   On Error Resume Next
   defWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
   
End Sub


Private Sub Command1_Click()

  'call the unload event. This must execute
  'to un-subclass the form before exiting.
  'If you GPF on exiting, this is the reason!
  'Always save the project before running.
   Unload Me

End Sub


Private Sub Form_Unload(Cancel As Integer)

  'Remove the icon added to the taskbar
   ShellTrayRemove
   
  'remove subclassing
   UnSubClass
       
  'assure unloading proceeds
   Cancel = False
    
End Sub


Private Sub mnuDriveDetails_Click(Index As Integer)

   Dim currDrive As String

   Select Case Index
      
     'the last menu item - exit
      Case mnuDriveDetails.Count - 1
         
        'You can not end the app using an
        'Unload frmMain statement, as unloading
        'while the menu event is processing
        'will cause a GPF. So here, we'll cheat
        'and close by sending ourselves a WM_CLOSE
        'message after removing the tray icon!
        '
        'The PostMessage call sends a message as
        'though the user had pressed the X button
        'or the Close command from the System Menu
        'was chosen (QueryUnload UnloadMode
        'value = vbFormControlMenu)
         ShellTrayRemove
         Call PostMessage(frmMain.hwnd, WM_CLOSE, 0&, ByVal 0&)

     'the second-last menu item is selected - close icon
      Case mnuDriveDetails.Count - 2
         
        'nuke the systray item
         ShellTrayRemove
      
     'a drive stats item
      Case Else
      
        'pretty straight forward.
        '
        'get the drive from the caption (ie c:\)
        'pass to the drvInfo form and show.     
            
        'Once form 'drvInfo' gets the letter
        'and GetDriveStats is called, the form
        'retrieves the drive stats and creates
        'the stat details before displaying.
         currDrive = Left$(mnuDriveDetails(Index).Caption, 3)
                
         With drvInfo
            .DriveToGet currDrive
            .GetDriveStats
            .Show vbModal
         End With
   
   End Select
   
End Sub

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
   Alias "GetDiskFreeSpaceExA" _
   (ByVal lpcurrDrive As String, _
   lpFreeBytesAvailableToCaller As Currency, _
   lpTotalNumberOfBytes As Currency, _
   lpTotalNumberOfFreeBytes As Currency) As Long

'passed as a parameter from the main form
'menu click (to the sub 'DriveToGet')
Private workDrv As String


Private Sub Form_Load()

  'centre this form
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   
  'saves me searching all over the
  'place for the icon!
   Me.Icon = frmMain.Icon

End Sub 


Private Sub Command1_Click()

   Unload Me
   
End Sub


Public Sub DriveToGet(selectedDrive As String)

   workDrv = selectedDrive

End Sub


Public Sub GetDriveStats()

   Dim TotalBytes As Currency
   Dim TotalFree As Currency
   Dim FreeToCaller As Currency
   
  'some temp vars for calculations
   Dim tmp As Currency
   Dim tmpTotal As Currency
   Dim tmpFree As Currency
   
  'passed empty and filled in the
  'CreateChartStats sub
   Dim pcUsed As Single
   Dim pcFree As Single
   
  'get the drive space info
   Call GetDiskFreeSpaceEx(workDrv, FreeToCaller, TotalBytes, TotalFree)
   
  'since we're using a chart, the values
  'need to be turned into percentages (tmp)
  'and the chart filled
   
  'If values were returned (disk present),
  'calc the percentage free multiplying
  'the returned values of TotalBytes and
  'TotalFree by 10000 to adjust for the
  '4 decimal places that the currency
  'data type returns.
   tmpTotal = (TotalBytes * 10000)
   tmpFree = (TotalFree * 10000)

   If TotalBytes > 0 Then tmp = (tmpFree / tmpTotal)
   
  'now pass the drive and tmp (even if 0)
  'to the chart routine.  The sub returns
  'pcUsed and pcFree for use below.
   CreateChartStats workDrv, tmp, pcUsed, pcFree
   
  'show the results
   lbInfo(0).Caption> = Format$(tmpFree, "###,###,###,##0") & " bytes " & pcFree & "%"
   lbInfo(1).Caption = Format$(tmpTotal - tmpFree, "###,###,###,##0") & " bytes " & pcUsed & "%"
   lbInfo(2).Caption = Format$(tmpTotal, "###,###,###,##0") & " bytes"
   
End Sub


Private Sub CreateChartStats(workDrv As String, tmp, pcUsed, pcFree)

  'reduce the values to percent
   pcFree = Int(tmp * 100)
   pcUsed = Int(100 - pcFree)
   
  'and fill in a chart
   With MSChart1
      
      .chartType = 14
      .ShowLegend = False
      .ColumnCount = 2
      .RowCount = 1
      .RowLabel = "Drive " & UCase$(Left$(workDrv, 1))
      
      .Column = 1
      .Row = 1
      .Data = pcUsed
   
      .Column = 2
      .Row = 1
      .Data = pcFree
      
   End With
   
End Sub