frmmain.frm

高级卸载工具

    cmdlgIcon.DialogTitle = "请选择一个可执行文件或图标..."
    cmdlgIcon.filename = ""
    cmdlgIcon.CancelError = True
    cmdlgIcon.Filter = "程序, 图标 (*.exe, *.ico)|*.exe;*.ico"
    cmdlgIcon.Flags = cdlOFNOverwritePrompt
    cmdlgIcon.ShowOpen
 
    If Err Then
        Exit Sub
    End If
    If LCase$(Right$(cmdlgIcon.filename, 3)) = "ico" Then
        SaveString HKEY_LOCAL_MACHINE, UnInstallPath & lstview.SelectedItem.Key, "DisplayIcon", cmdlgIcon.filename
    Else
        SaveString HKEY_LOCAL_MACHINE, UnInstallPath & lstview.SelectedItem.Key, "DisplayIcon", cmdlgIcon.filename & ",0"
    End If
    mnu_refresh_Click
End Sub

Private Sub mnu_hlptopics_Click()
    'Show Help
    SendKeys "{F1}"
End Sub

'=========================================================================
' Handle Tool bar button click
'=========================================================================
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

    Select Case Button.index
        Case 1:
            Show_FormUninstall
        Case 3:
            Delete_Entry_Click
        Case 5:
            FrmInfo.Show vbModal, FrmMain
        Case 7:
            Mnu_ChangeIcon_Click
        Case 9:
            FrmReport.Show vbModal, FrmMain
        Case 11:
            mnu_NewPrg_Click
        Case 13:
            FrmUninstallLog.Show vbModal, Me
        Case 15:
            
            'Show Helpfile
            SendKeys "{F1}"
        Case 17:
            mnu_Exit_Click
    End Select
End Sub

'***********************************************************
' Size, LastUed On and Frequency releated Start
'***********************************************************
' Takes a byte and return the frquency of use
Private Function getFrequency(lngFrequency As Byte) As String
On Error GoTo errHandle:
    
    ' If less than 3 then rarely
    If lngFrequency < 3 Then
        getFrequency = "很少" ' "Rarely"
    ' If less than 10 then occasionaly
    ElseIf (lngFrequency >= 3) And (lngFrequency <= 10) Then
        getFrequency = "偶尔" ' "Occasionally"
    ' If greatert than 10 then frequently
    ElseIf lngFrequency > 10 Then
        getFrequency = "经常"  '"Frequently"
    End If
    Exit Function
errHandle:
End Function

' Takes four byte DWord and returns a formatted size in MB
Private Function getFileSize(byte1 As Byte, byte2 As Byte, byte3 As Byte, byte4 As Byte) As String
On Error GoTo errHandle:
    Dim lngSize As Long
    
    ' Convert DWord to long
    lngSize = lngSize + byte1
    lngSize = lngSize + (byte2 * 256#)
    lngSize = lngSize + (byte3 * 65536#)
    lngSize = lngSize + (byte4 * 16777216#)
    
    ' Format and return the string in MB
    getFileSize = Format$(lngSize / 1024 / 1024, "0.0") & " MB"
    Exit Function
errHandle:
    getFileSize = ""
End Function

' Show the last used On date
' Takes four byte DWord and returns a formatted date String
Private Function getLastUsedOn(byte1 As Byte, byte2 As Byte, byte3 As Byte, byte4 As Byte) As String
On Error GoTo errHandle:
    Dim stExpire As SYSTEMTIME, tYear As Long, dExpire As Date, lngLastusedOn As Long
    Dim strDate As String
    
    ' Convert the DWord to long
    lngLastusedOn = lngLastusedOn + byte1
    lngLastusedOn = lngLastusedOn + (byte2 * 256#)
    lngLastusedOn = lngLastusedOn + (byte3 * 65536#)
    lngLastusedOn = lngLastusedOn + (byte4 * 16777216#)
    
    strDate = CStr(lngLastusedOn)
    stExpire = MSIEDate(strDate, strDate)
    If stExpire.wYear > 9999 Then
        tYear = stExpire.wYear - 7999
    Else
        tYear = 0
    End If
    dExpire = DateSerial(stExpire.wYear - tYear, stExpire.wMonth, stExpire.wDay)
    
    ' In windows 200 the date is converted a day beofre so add 1 day
    If InStr(gstrOS, "2000") <> 0 Then
        dExpire = DateAdd("d", 1, dExpire)
    End If
    
    ' Return the formatted date
    getLastUsedOn = Format$(dExpire, "YYYY-MM-DD")
    Exit Function
errHandle:
    getLastUsedOn = ""
End Function

' Convert the date to proper format
Private Function MSIEDate(hiDateTime As String, loDateTime As String) As SYSTEMTIME
    Dim st As SYSTEMTIME
    Dim ft As FILETIME
    
    ft.dwHighDateTime = UnsignedToLong(CDbl(hiDateTime))
    ft.dwLowDateTime = UnsignedToLong(CDbl(loDateTime))
    FileTimeToSystemTime ft, st
    MSIEDate = st
End Function

' Converts a double value from unsigned
Function UnsignedToLong(Value As Double) As Long
    If Value < 0 Or Value >= OFFSET_4 Then
        Exit Function
    End If
    If Value <= MAXINT_4 Then
        UnsignedToLong = Value
    Else
        UnsignedToLong = Value - OFFSET_4
    End If
End Function

' Routine to select/highlight a program which matches the search keyword
' when the find button is pressed
Private Sub cmdFind_Click()
    Dim iKey As String, i As Integer, start As Integer

    ' Get the search string
    iKey = Trim$(txtFind)

    ' Start searching from the last seleted item
    start = lstview.SelectedItem.index

    ' If the searched is exhausted then start over
    If (LastSearch = iKey And Exhausted) Or (start = lstview.ListItems.Count) Then
        start = 1
    End If

    ' If a new keyword is searched then start from beginning
    If iKey <> LastSearch Then
        start = 1
    End If

    ' If searched is continued then start searching from the next item
    If start >= 1 And Not Exhausted Then
        start = start + 1
    End If

    ' Perform searh
    For i = start To lstview.ListItems.Count
        If InStr(1, UCase$(lstview.ListItems(i).Text), UCase$(iKey)) Then
            lstview.SetFocus
            lstview.ListItems(i).Selected = True
            lstview.ListItems(i).EnsureVisible
            lstview_Click
            Exhausted = False
            Exit For
        Else
            Exhausted = True
        End If
    Next
    
    ' Store the last search keyword
    LastSearch = iKey

    ' Display the message if nothing was found or search exhausted
    If Exhausted Then
        MsgBox "The Program You are looking for (" & iKey & ") was not found", vbInformation, App.Title
    End If
End Sub

Private Sub txtFind_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        cmdFind_Click
    End If
End Sub

'=========================================================================
' Menu Item :-  Install New Program
'=========================================================================
Private Sub mnu_NewPrg_Click()
    FrmNewEntry.Show vbModal, FrmMain
End Sub

'=========================================================================
' Menu Item :-  View Program Details
'=========================================================================
Private Sub mnu_prgdtls_Click()
    If lstview.SelectedItem Is Nothing Then
        Exit Sub
    End If
    FrmInfo.Show vbModal, FrmMain
End Sub

'=========================================================================
' Menu Item :-  Print and Save Audit Report
'=========================================================================
Private Sub mnu_PrntNSaveAudit_Click()
    FrmReport.Show vbModal, FrmMain
End Sub

'=========================================================================
' Menu Item :-  Refresh the applications.
'=========================================================================
Public Sub mnu_refresh_Click()
    showUnInstallList
End Sub

'=========================================================================
' Menu Item :-  Uninstall
'=========================================================================
Private Sub mnu_uninstallProg_Click()
    Show_FormUninstall
End Sub

'=========================================================================
' Menu Item :-  See uninstall log
'=========================================================================
Private Sub mnu_UninstLog_Click()
    FrmUninstallLog.Show vbModal, Me
End Sub

'=========================================================================
' Menu Item :-  Delete Entry
'=========================================================================
Private Sub mnu_DelFrmLst_Click()
    Delete_Entry_Click
End Sub


'=========================================================================
' Menu Item :-  Edit Programs
'=========================================================================
Private Sub mnu_EditPrgDtls_Click()
    Edit_Entry_Click
End Sub

'=========================================================================
' Menu Item :-  Exit Program
'=========================================================================
Private Sub mnu_Exit_Click()
    Unload Me
End Sub

'=========================================================================
' Menu Item :-  View as Small Icons
'=========================================================================
Private Sub mnu_SmllIcons_Click()
    lstview.View = lvwSmallIcon
    
    ' Uncheck all menu
    uncheckAll
    
    ' Check the current view related menu
    FrmMain.mnu_SmllIcons.Checked = True
End Sub

'=========================================================================
' Menu Item :-  View Details
'=========================================================================
Private Sub mnu_details_Click()
    lstview.View = lvwReport
    
    ' Uncheck all menu
    uncheckAll
    ' Check the current view related menu
    FrmMain.mnu_details.Checked = True
End Sub

'=========================================================================
' Menu Item :-  View as large icons
'=========================================================================
Private Sub mnu_LargeIcons_Click()
    lstview.View = lvwIcon
    
    ' Uncheck All menu
    uncheckAll
    
    ' Check the current view related menu
    FrmMain.mnu_LargeIcons.Checked = True
End Sub

'=========================================================================
' Menu Item :-  View as List
'=========================================================================
Private Sub mnu_list_Click()
    lstview.View = lvwList
    
    ' Uncheck all menu
    uncheckAll
    
    ' Check the current view related menu
    FrmMain.mnu_list.Checked = True
End Sub

'=========================================================================
' Menu Item :-  About
'=========================================================================
Private Sub mnu_about_Click()
    
    ' Show the about form
    FrmAbout.Show vbModal, Me
End Sub