frmmain.frm

高级卸载工具

        If GetDWORDValue(HKEY_LOCAL_MACHINE, UnInstallPath & colKeys(lngCount), "NoRemove") <> 1 Then
            ' Get the uninstall command
            strUninstallCommand = GetStringValue(HKEY_LOCAL_MACHINE, UnInstallPath & colKeys(lngCount), "UninstallString")
            ' Get the display name
            strDisplayName = GetStringValue(HKEY_LOCAL_MACHINE, UnInstallPath & colKeys(lngCount), "DisplayName")
            ' If both are present then show the key
            If (LenB(strDisplayName) <> 0) And (LenB(strUninstallCommand) <> 0) Then
                ' Clear the variables
                strSize = ""
                strFrequency = ""
                lngCounterLarge = 1
                lngCounterSmall = 1
                strLastUsedOn = ""
                blnARPFound = False
                
                strDisplayIcon = GetStringValue(HKEY_LOCAL_MACHINE, UnInstallPath & colKeys(lngCount), "DisplayIcon")
                ' If 98 then no need to show lastused size etc.
                If InStr(gstrOS, "98") = 0 Then
                    ' If the value is present or that key then set the boolean
                    ' retrieve the binary data for that key it is of 552 bytes
                    If GetBinaryValue(HKEY_LOCAL_MACHINE, ARPCache & colKeys(lngCount), "SlowInfoCache", sBuffer) = True Then
                        blnARPFound = True
                    End If
                End If
                
                ' First check if the key has DisplayIcon value
                If LenB(strDisplayIcon) = 0 Then
                    ' If not then try to retrieve the icon of the application from the slowinfocache
                    If blnARPFound = True Then
                        ' Check if the data has an application name
                        If sBuffer(4) <> 0 Then
                            strEXEName = ""
                            ' Retrieve the application name
                            For i = 28 To UBound(sBuffer)
                                strEXEName = strEXEName & Chr$(sBuffer(i))
                            Next
                            ' It is in unicode format so convert it
                            strEXEName = StrConv(strEXEName, vbFromUnicode)
                            strEXEName = StripNull(strEXEName)
                            ' Check if the application path exits
                            If PathFileExists(strEXEName) <> 0 Then
                                ' If so then retrieve the default icon for the application
                                getIcon strEXEName, lngCounterLarge, lngCounterSmall, 0
                            End If
                        End If
                    End If
                Else
                    strDisplayIcon = Replace(strDisplayIcon, Chr$(34), "")
                    ' If the application path has an icon index then seperate path and icon index
                    If InStr(strDisplayIcon, ",") <> 0 Then
                        strIconIndex = Mid$(strDisplayIcon, InStrRev(strDisplayIcon, ",") + 1)
                        If IsNumeric(strIconIndex) Then
                            getIcon Mid$(strDisplayIcon, 1, InStrRev(strDisplayIcon, ",") - 1), lngCounterLarge, lngCounterSmall, CLng(strIconIndex)
                        End If
                    Else
                        ' If no index of the icon then retrieve the default icon of the application
                        strIconIndex = "0"
                        getIcon strDisplayIcon, lngCounterLarge, lngCounterSmall, CLng(strIconIndex)
                    End If
                End If
                                
                ' If binary data is found for the key
                If blnARPFound = True Then
                    
                    ' Check if the value is not invalid. Invalid value contains all FF
                    If sBuffer(11) <> 255 Then
                        ' Get the size from DWORD
                        strSize = getFileSize(sBuffer(8), sBuffer(9), sBuffer(10), sBuffer(11))
                    End If
                    
                    ' Check if value is valid and get the frequency
                    If sBuffer(24) <> 255 Then
                        strFrequency = getFrequency(sBuffer(24))
                    End If
                    ' Check if valid
                    If (sBuffer(23) <> 0) And (sBuffer(23) <> 255) Then
                        ' Retreive the lastused on Date from DWORD
                        strLastUsedOn = getLastUsedOn(sBuffer(20), sBuffer(21), sBuffer(22), sBuffer(23))
                    End If
                End If
                
                ' Set the data in listview
                Set lstvItem = lstview.ListItems.Add(, colKeys(lngCount), strDisplayName, lngCounterLarge, lngCounterSmall)
                lstvItem.SubItems(1) = strSize
                lstvItem.SubItems(2) = strLastUsedOn
                lstvItem.SubItems(3) = strFrequency
                lstvItem.SubItems(4) = strUninstallCommand
            End If
        End If
    Next
    ' Clean the collection from memory
    Set colKeys = Nothing
    
    ' Set the current view back
    lstview.View = lngPrevView
    
    ' Show the listview
    lstview.Visible = True
    
    ' Click on the first item to be appeared as selected
    If lstview.ListItems.Count > 0 Then
        If lstview.Visible = True Then
            lstview.SetFocus
        End If
        lstview.ListItems(1).Selected = True
        lstview_Click
    End If
    
    ' Set the appropriate menu checked for the current view of listview
    uncheckAll
    If lngPrevView = 0 Then
        FrmMain.mnu_LargeIcons.Checked = True
    ElseIf lngPrevView = 1 Then
        FrmMain.mnu_SmllIcons.Checked = True
    ElseIf lngPrevView = 2 Then
        FrmMain.mnu_list.Checked = True
    ElseIf lngPrevView = 3 Then
        FrmMain.mnu_details.Checked = True
    End If
    
    ' Show the count in status bar
    StatusBar.Panels(1).Text = lstview.ListItems.Count & " 个程序可供卸载."
End Sub

' Parameters:
' strEXEName - File (EXE or DLL) containing icons
' lngLCounter - Counter for the large Icon of the file
' lngSCounter - Counter for the small Icon of the file
' lngIndex - Position of the icon to be retrieved
' Returns: All parameters are passed by ref so set accordingly

Private Sub getIcon(strEXEName As String, lngLCounter As Long, lngSCounter As Long, lngIndex As Long)
On Error GoTo errHandle:
    Dim hlargeicon As Long, hsmallicon As Long

    ' IPicture requires a reference to "Standard OLE Types"
    Dim pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID

    If ExtractIconEx(strEXEName, lngIndex, hlargeicon, hsmallicon, 1) > 0 Then
    
        ' Fill in with IDispatch Interface ID
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        
        ' Fill Pic with necessary parts
        With pic
            .Size = Len(pic) ' Length of structure
            .tType = vbPicTypeIcon ' Type of Picture (bitmap)
            .hBmp = hlargeicon ' Handle to bitmap
        End With
        
        ' Create Picture object
        Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
        
        ' Add the large icon in image list
        ImgLarge.ListImages.Add , , IPic
        
        ' Fill in with IDispatch Interface ID
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        
        ' Fill Pic with necessary parts
        With pic
            .Size = Len(pic) ' Length of structure
            .tType = vbPicTypeIcon ' Type of Picture (bitmap)
            .hBmp = hsmallicon  ' Handle to bitmap
        End With
        
        ' Create Picture object.
        Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
        
        ' Add the small icon in image list
        ImgSmall.ListImages.Add , , IPic
        DestroyIcon hsmallicon
        DestroyIcon hlargeicon
        
        ' Increase the counter to the new icon
        lngLCounter = ImgLarge.ListImages.Count
        lngSCounter = ImgSmall.ListImages.Count
    Else
        ' Failed to the counter will be of default icon
        lngLCounter = 1
        lngSCounter = 1
    End If
    Exit Sub
errHandle:
    lngLCounter = 1
    lngSCounter = 1
End Sub

'=========================================================================
' Display the uninstall information about the selected prorgram
'=========================================================================
Public Sub Show_FormUninstall()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    FrmUninstaller.Show vbModal, FrmMain
    Set FrmUninstaller = Nothing
End Sub
Public Sub Get_Uninstall()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    ' Call the uninstaller command
     WinExec lstview.SelectedItem.SubItems(4), 1
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    App.HelpFile = App.Path & "\Add Remove Platinum 2004.chm"
End Sub

'=========================================================================
' Form Load Event
' - Resize the form
' - Refreshes the uninstall list
' - Display the initail time
'=========================================================================
Private Sub Form_Load()
On Error Resume Next
    App.HelpFile = App.Path & "\Add Remove Platinum 2004.chm"
    showUnInstallList
End Sub

'=========================================================================
' Resize the controls to fit on the screen on any given resolution
'=========================================================================
Private Sub Form_Resize()
On Error Resume Next
    lstview.Width = Me.Width - (picSideMenu.Width + 50)
    lstview.Height = Me.Height - 1960
    picSideMenu.Height = Me.Height - 1960
    StatusBar.Top = Me.Height - 1960
End Sub

'=========================================================================
' When the application is closed.
' exclusively close all application and clear the global variables
'=========================================================================
Private Sub Form_Unload(Cancel As Integer)
    Dim Form As Form
    
    For Each Form In Forms
        If Form.name <> Me.name Then
            Unload Form
            Set Form = Nothing
        End If
    Next Form
End Sub

'=========================================================================
' Delete an entry from the registry
'=========================================================================
Private Sub Delete_Entry_Click()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    
    ' Show the form
    FrmDeleteEntry.Show vbModal, FrmMain
End Sub

'=========================================================================
' Edit the selected program
'=========================================================================
Private Sub Edit_Entry_Click()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    FrmEditEntry.Show vbModal, FrmMain
End Sub

'Show the info in left hand pane
Public Sub lstview_Click()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    lblExclaim.Caption = "您选择的程序是:(" & lstview.SelectedItem.Text & "), 程序可以从您的计算机中卸载.单击卸载按钮或者双击图标."
End Sub

' Sort the listview according to the column header clicked by user
Private Sub lstview_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    With lstview                ' Change to the name of the list view
        Static iLast As Integer, iCur As Integer
        .Sorted = True
        iCur = ColumnHeader.index - 1
        If iCur = iLast Then .SortOrder = IIf(.SortOrder = 1, 0, 1)
        .SortKey = iCur
        iLast = iCur
    End With
End Sub

' Call the uninstall form if user double clicks
Private Sub lstview_DblClick()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    Call Show_FormUninstall
End Sub

'=========================================================================
' Show the popup menu
'=========================================================================
Private Sub lstview_MouseUP(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    If Button = 2 Then
        PopupMenu mnu_Uninstall
    End If
End Sub

' Uncheck all menu item before checking the new menu
' used when user changes the current view of listview
Private Sub uncheckAll()
    FrmMain.mnu_LargeIcons.Checked = False
    FrmMain.mnu_SmllIcons.Checked = False
    FrmMain.mnu_list.Checked = False
    FrmMain.mnu_details.Checked = False
End Sub

Private Sub Mnu_ChangeIcon_Click()
On Error Resume Next
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If