frmmain.frm

图象压缩算法 图象压缩算法 图象压缩算法 图象压缩算法 图象压缩算法 图象压缩算法 图象压缩算法

End Sub
Private Sub mnuKillValue_Click()
    On Error Resume Next
    
    If Not IsObject(lastListItem) Then Exit Sub
    
    If (MsgBox("Are you sure you want to delete this value?", _
                                vbYesNo + vbQuestion, "Confirm") = vbYes) Then
            Regy.KillValue lastNode.Key, lastListItem.Text
            curValues = Replace(curValues, ":" & lastListItem.Text & ":", ":")
            lvwData.ListItems.Remove lastListItem.Index
            Set lastListItem = Nothing
            mnuModify.Enabled = False
            mnuKillValue.Enabled = False
    End If
End Sub
Private Sub mnuNewKey_Click() 'create key
    On Error Resume Next

    lastNode.Expanded = True
    DoEvents
    
    nCount = nCount + 1
    Load frmNewKey
    frmNewKey.KeyName = "New Key #" & CStr(nCount)
    frmNewKey.Caption = "New Key"
    frmNewKey.Show vbModal
    Unload frmNewKey
    
check:
    If frmNewKey.Canceled = False Then
        If InStr(1, opened, ":" & lastNode.Key & "\" & frmNewKey.KeyName & _
            ":", 1) > 1 Or InStr(1, curSubkeys, frmNewKey.KeyName, 1) Then
            MsgBox "Key with that name allready exists. Try something else.", vbExclamation, "New Key"
            Load frmNewKey
            frmNewKey.KeyName = frmNewKey.KeyName
            frmNewKey.Show vbModal
            Unload frmNewKey
            GoTo check
        Else
            Set nodX = tvwKeys.Nodes.Add(lastNode.Key, tvwChild, lastNode.Key & "\" & frmNewKey.KeyName, frmNewKey.KeyName, 1)
            curSubkeys = curSubkeys & frmNewKey.KeyName & ":"
            Regy.CreateKey nodX.Key
            nodX.Selected = True
        End If
    End If
    
End Sub
Private Sub mnuNewString_Click() 'write string
    
    sCount = sCount + 1
    
    Load frmString
    frmString.StringName = "New String Value #" & CStr(sCount)
    frmString.Caption = "New String"
    frmString.Show vbModal
    Unload frmString
    
check:
    If frmString.Canceled = False Then
        If InStr(1, curValues, frmString.StringName, 1) Then
            MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "New String"
            Load frmString
            frmString.StringName = frmString.StringName
            frmString.Show vbModal
            Unload frmString
            GoTo check
        Else
            Set lstX = lvwData.ListItems.Add(, , frmString.StringName, , 3)
            lstX.Tag = REG_SZ
            lstX.ListSubItems.Add , , Chr$(34) & frmString.StringValue & Chr$(34)
            curValues = curValues & frmString.StringName & ":"
            Regy.WriteString lastNode.Key, lstX.Text, frmString.StringValue
        End If
    End If
    
End Sub
Private Sub mnuNewBinary_Click() 'write binary
    
    Dim tmp As String
    
    bCount = bCount + 1
    
    Load frmBinary
    frmBinary.BinaryName = "New Binary Value #" & CStr(bCount)
    frmBinary.Caption = "New Binary"
    frmBinary.Show vbModal
    Unload frmBinary
    
check:
    If frmBinary.Canceled = False Then
        If InStr(1, curValues, frmBinary.BinaryName, 1) Then
            MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "New Binary"
            Load frmBinary
            frmBinary.BinaryName = frmBinary.BinaryName
            frmBinary.Show vbModal
            Unload frmBinary
            GoTo check
        Else
            Set lstX = lvwData.ListItems.Add(, , frmBinary.BinaryName, , 4)
            lstX.Tag = REG_BINARY
            tmp = frmBinary.BinaryValue
            If Len(tmp) = 0 Then
                tmp = "(zero-length binary value)"
            Else
                tmp = setSpaces(tmp)
            End If
            lstX.ListSubItems.Add , , tmp
            curValues = curValues & frmBinary.BinaryName & ":"
            Regy.WriteBinary lastNode.Key, lstX.Text, frmBinary.BinaryValue
        End If
    End If
    
End Sub
Private Sub mnuNewDWORD_Click() 'write dword
    
    dCount = dCount + 1
    
    Load frmDWORD
    frmDWORD.DWORDName = "New DWORD Value #" & CStr(dCount)
    frmDWORD.Caption = "New DWORD"
    frmDWORD.Show vbModal
    Unload frmDWORD
    
check:
    If frmDWORD.Canceled = False Then
        If InStr(1, curValues, frmDWORD.DWORDName, 1) Then
            MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "New DWORD"
            Load frmDWORD
            frmDWORD.DWORDName = frmDWORD.DWORDName
            frmDWORD.Show vbModal
            Unload frmDWORD
            GoTo check
        Else
            Set lstX = lvwData.ListItems.Add(, , frmDWORD.DWORDName, , 4)
            lstX.Tag = REG_DWORD
            lstX.ListSubItems.Add , , formatDWORD(frmDWORD.DWORDValue)
            curValues = curValues & frmDWORD.DWORDName & ":"
            Regy.WriteDWORD lastNode.Key, lstX.Text, CLng(frmDWORD.DWORDValue)
        End If
    End If
    
End Sub
Private Sub mnuModify_Click() 'modify value
    Dim tmp As String, def As Boolean, tmp2 As String
    
    On Error GoTo errh 'will not raise error when compiled
    
    If IsObject(lastListItem) Then
        curValues = Replace(curValues, ":" & lastListItem.Text & ":", ":")
        Select Case lastListItem.Tag
            Case REG_SZ
                def = lastListItem.Text = "(Default)"
                tmp = lastListItem.ListSubItems(1).Text
                Load frmString
                frmString.StringName = lastListItem.Text
                frmString.StringValue = Mid$(tmp, 2, Len(tmp) - 2)
                frmString.Caption = "Modify Value"
                frmString.Text1.Locked = def
                frmString.Show vbModal
                Unload frmString
checkSZ:
                If frmString.Canceled = False Then
                    If InStr(1, curValues, frmString.StringName, 1) Then
                        MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "Modify String"
                        Load frmString
                        frmString.StringName = frmString.StringName
                        frmString.StringValue = frmString.StringValue
                        frmString.Text1.Locked = def
                        frmString.Show vbModal
                        Unload frmString
                        GoTo checkSZ
                    Else
                        tmp = frmString.StringName
                        tmp2 = frmString.StringValue
                        If def Then
                            tmp = ""
                            If Len(Trim$(tmp2)) = 0 Then
                                tmp2 = ""
                                lastListItem.ListSubItems(1).Text = "(value not set)"
                                Regy.KillValue lastNode.Key, ""
                            Else
                                lastListItem.ListSubItems(1).Text = Chr$(34) & tmp2 & Chr$(34)
                                Regy.WriteString lastNode.Key, tmp, tmp2
                            End If
                        Else
                            Regy.WriteString lastNode.Key, tmp, tmp2
                            lastListItem.ListSubItems(1).Text = Chr$(34) & tmp2 & Chr$(34)
                        End If
                        lastListItem.Text = frmString.StringName
                        
                    End If
                End If
            Case REG_BINARY
                tmp = lastListItem.ListSubItems(1).Text
                Load frmBinary
                frmBinary.BinaryName = lastListItem.Text
                frmBinary.BinaryValue = tmp
                frmBinary.Caption = "Modify Value"
                frmBinary.Show vbModal
                Unload frmBinary
checkBIN:
                If frmBinary.Canceled = False Then
                    If InStr(1, curValues, frmBinary.BinaryName, 1) Then
                        MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "Modify Binary"
                        Load frmBinary
                        frmBinary.BinaryName = frmBinary.BinaryName
                        frmBinary.BinaryValue = frmBinary.BinaryValue
                        frmBinary.Show vbModal
                        Unload frmBinary
                        GoTo checkBIN
                    Else
                        tmp = frmBinary.BinaryValue
                        If Len(Trim$(tmp)) = 0 Then
                            tmp = ""
                            lastListItem.ListSubItems(1).Text = "(zero-length binary value)"
                        Else
                            lastListItem.ListSubItems(1).Text = setSpaces(tmp)
                        End If
                        
                        lastListItem.Text = frmBinary.BinaryName
                        Regy.WriteBinary lastNode.Key, frmBinary.BinaryName, tmp
                    End If
                End If
            Case REG_DWORD
                tmp = lastListItem.ListSubItems(1).Text
                Load frmDWORD
                frmDWORD.DWORDName = lastListItem.Text
                frmDWORD.DWORDValue = Mid$(tmp, 13, Len(tmp) - 13) 'only dec
                frmDWORD.Option1.Value = False
                frmDWORD.Option2.Value = True 'force decimal display
                frmDWORD.Caption = "Modify Value"
                frmDWORD.Show vbModal
                Unload frmDWORD
checkDWORD:
                If frmDWORD.Canceled = False Then
                    If InStr(1, curValues, frmDWORD.DWORDName, 1) Then
                        MsgBox "Value with that name allready exists. Try something else.", vbExclamation, "Modify DWORD"
                        Load frmDWORD
                        frmDWORD.DWORDName = frmDWORD.DWORDName
                        frmDWORD.DWORDValue = frmDWORD.DWORDValue
                        frmDWORD.Show vbModal
                        Unload frmDWORD
                        GoTo checkDWORD
                    Else
                        tmp = frmDWORD.DWORDValue
                        If Len(Trim$(tmp)) = 0 Then tmp = "0"
                        lastListItem.Text = frmDWORD.DWORDName
                        lastListItem.ListSubItems(1).Text = formatDWORD(CLng(tmp))
                        Regy.WriteDWORD lastNode.Key, frmDWORD.DWORDName, CLng(tmp)
                    End If
                End If
        End Select
        
        curValues = curValues & lastListItem.Text & ":"
        
    End If
errh:
End Sub
Private Sub mnuExport_Click()
    On Error Resume Next
    
    If lastNode.Key = "COMP" Then Exit Sub
    
    Dim ret As Long
    
    Load frmExport
    frmExport.StartKey = lastNode.Key
    frmExport.Show vbModal
    Unload frmExport
    
    If frmExport.Canceled = False Then
        Screen.MousePointer = vbHourglass
        ret = Regy.ExportToReg(frmExport.StartKey, frmExport.RegFile, frmExport.Include, txtExport)
        Screen.MousePointer = vbNormal
        Me.Caption = "Registry Editor"
        If ret = 0 Then 'error
            MsgBox "Error exporting to file.", vbCritical, "Error"
        End If
    End If
    
End Sub
Private Sub mnuImport_Click()
    On Error Resume Next
    
    Dim ret As Long
    
    cdImport.ShowOpen
    
    If Dir(cdImport.FileName) = "" Then
        MsgBox "File not exists!", vbExclamation, "Error"
        Exit Sub
    End If
    
    Screen.MousePointer = vbHourglass
    ret = Regy.ImportFromReg(cdImport.FileName)
    Screen.MousePointer = vbNormal
    
    If ret = 0 Then 'error
        MsgBox "Error importing file.", vbCritical, "Error"
    End If
End Sub
Private Sub popModify_Click()
    Call mnuModify_Click
End Sub
Private Sub popKillValue_Click()
    Call mnuKillValue_Click
End Sub
Private Sub pop2NewString_Click()
    Call mnuNewString_Click
End Sub
Private Sub pop2NewBinary_Click()
    Call mnuNewBinary_Click
End Sub
Private Sub pop2NewDWORD_Click()
    Call mnuNewDWORD_Click
End Sub
Private Sub popNewString_Click()
    Call mnuNewString_Click
End Sub
Private Sub popNewBinary_Click()
    Call mnuNewBinary_Click
End Sub
Private Sub popNewDWORD_Click()
    Call mnuNewDWORD_Click
End Sub
Private Sub popNewKey_Click()
    Call mnuNewKey_Click
End Sub
Private Sub popCopyPath_Click()
    Call mnuCopyName_Click
End Sub
Private Sub popKillKey_Click()
    Call mnuKillKey_Click
End Sub
Private Sub popExport_Click()
    Call mnuExport_Click
End Sub
Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
End Sub
Private Function setSpaces(sIn As String) As String
    Dim k As Long
    
    sIn = Replace(sIn, " ", "")
    If Len(sIn) Mod 2 <> 0 Then sIn = Left$(sIn, Len(sIn) - 1)
    
    For k = 1 To Len(sIn) Step 2
        setSpaces = setSpaces & Mid$(sIn, k, 2) & " "
    Next
    
    setSpaces = Left$(setSpaces, Len(setSpaces) - 1)
End Function