mainform.frm

光盘管家

Open "cdrom.cds" For Input As #1
Do While Not EOF(1)
Line Input #1, cdroms
If Left(cdroms, 3) = "光盘库" Then
    TreeView1.Nodes.Add "光盘库", tvwChild, cdroms, Mid(cdroms, 4), 3, 2
End If
If Left(cdroms, 3) = "子光盘" Then
   Dim Pos As Single
   Dim SubCdromName As String, CdromStyle As String
   Pos = InStr(1, cdroms, "@@@@@***##")
   If Pos > 0 Then
      Pos = Pos + 10
      SubCdromName = Mid(cdroms, Pos)
      CdromStyle = Mid(cdroms, 4, Pos - 14)
      Set nox = TreeView1.Nodes.Add(CdromStyle, tvwChild, "子光盘" + CdromStyle + "@@@@@***##" + SubCdromName, SubCdromName)
      nox.Image = 1
   End If
End If
skey = "@@@@@***##查找结果@@@@@***##"
If cdroms = skey Then
   TreeView1.Nodes.Add , , cdroms, "查找结果", 5
End If
If Left(cdroms, 24) = skey And Len(cdroms) > 24 Then
   TreeView1.Nodes.Add skey, tvwChild, cdroms, Mid(cdroms, 25), 1
End If
Loop
Close 1
TreeView1.Nodes(1).Expanded = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 2 Or UnloadMode = 3 Then
   WriteToDisk
   MsgBox "不能这样退出程序,会造成数据文件的丢失!", vbCritical
   Cancel = True
   Exit Sub
End If
If vbYes = MsgBox("是否真的要退出?", vbQuestion + vbYesNo) Then
  WriteToDisk
  Cancel = False
Else
  Cancel = True
End If
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 1 Then
If Me.Width - TreeView1.Left - TreeView1.Width - Picture1.Width - 180 > 1800 Then
   TreeView2.Width = Me.Width - TreeView1.Left - TreeView1.Width - Picture1.Width - 130
   Label1.Width = TreeView2.Width
   RichTextBox1.Width = TreeView2.Width
Else
   TreeView2.Width = 1800
   Label1.Width = 1800
   Me.Width = TreeView1.Width + TreeView1.Left + Picture1.Width + TreeView2.Width + 130
   RichTextBox1.Width = 1800
End If
If Me.Height - 2000 < 1800 Then
   Me.Height = 2000 + 1800
End If
TreeView1.Height = Me.Height - 520 - 475
TreeView2.Height = TreeView1.Height - RichTextBox1.Height - Label2.Height - Label1.Height - 220
Picture1.Height = TreeView1.Height
Label2.Top = 520 + Label1.Height + TreeView2.Height + 200
RichTextBox1.Top = 520 + Label1.Height + TreeView2.Height + Label2.Height + 250
End If
End Sub

Private Sub mnuAddCdrom_Click()
            If TreeView1.Nodes(1).Children <= 0 Then
               MsgBox "没有光盘类别，请先添加光盘类别!", vbExclamation
               Exit Sub
            End If
reinput:
            CdromName = InputBox("请给要新增的光盘取个名:" + Chr(13) + Chr(13) + "(一般为光盘正面的标签文字，以方便查找!)")
            CdromName = Trim(CdromName)
            If Trim(CdromName) <> "" Then
               For i = 1 To TreeView1.Nodes.Count
                   If Left(TreeView1.Nodes(i).Key, 24) <> "@@@@@***##查找结果@@@@@***##" Then
                   If Trim(CdromName) = TreeView1.Nodes.Item(i) Then
                       MsgBox "光盘 " + Chr(34) + CdromName + Chr(34) + " 已存在光盘库中" + Chr(13) + Chr(13) + "请重新输入光盘名或按<取消>结束!", vbExclamation
                       GoTo reinput
                   End If
                   End If
               Next
               Load AddCdrom
               AddCdrom.Show vbModal
               WriteToDisk
            End If

End Sub

Private Sub mnuAddStyle_Click()
reinput:
Dim AddStyle As String
AddStyle = InputBox("请输入新增加的类别名:")
If Trim(AddStyle) <> "" Then
   For i = 1 To TreeView1.Nodes.Count
     If Left(TreeView1.Nodes(i).Key, 24) <> "@@@@@***##查找结果@@@@@***##" Then
       If Trim(AddStyle) = TreeView1.Nodes.Item(i).Text Then
          MsgBox "光盘库中已有类别或光盘 " + Chr(34) + AddStyle + Chr(34) + Chr(13) + Chr(13) + "请重新输入类别名,或按＜取消＞结束!", vbExclamation
          GoTo reinput
       End If
    End If
   Next
   Set nox = TreeView1.Nodes.Add("光盘库", tvwChild, "光盘库" + Trim(AddStyle), Trim(AddStyle))
   nox.Image = 3
   WriteToDisk
End If
End Sub

Private Sub mnuCdromEditMx_Click()
CdromText = RichTextBox1.Text
RichTextBox1.Locked = False
RichTextBox1.SetFocus
End Sub

Private Sub mnuCdromFind_Click()
Info = "(" + TreeView1.SelectedItem.Parent.Text + ") " + TreeView1.SelectedItem.Text
CdromName = TreeView1.SelectedItem.Text
Load Find
Find.Show vbModal
WriteToDisk
End Sub

Private Sub mnuCdromMove_Click()
If TreeView1.Nodes(1).Children > 1 Then
   Load CdromRemoveTo
   CdromRemoveTo.Show vbModal
   WriteToDisk
Else
   MsgBox "没有其它类别供移动!", vbExclamation
End If
End Sub


Private Sub mnuDeleteCdrom_Click()
   If vbYes = MsgBox("是否真的要删除光盘 " + Chr(34) + TreeView1.SelectedItem + Chr(34), vbQuestion + vbYesNo) Then
      DeleteCdrom
   End If
End Sub

Private Sub mnuDeleteStyle_Click()
If TreeView1.SelectedItem.Text <> "光盘库" Then
   If vbYes = MsgBox("是否真的要删除类别 " + Chr(34) + TreeView1.SelectedItem + Chr(34), vbQuestion + vbYesNo) Then
      For i = 2 To TreeView1.Nodes.Count
          If TreeView1.Nodes.Item(i).Key = TreeView1.SelectedItem.Key Then
             Exit For
          End If
      Next
      If TreeView1.Nodes(i).Children > 0 Then
         Set nox = TreeView1.Nodes(i).Child
         For j = 1 To TreeView1.Nodes(i).Children
             If Dir(nox.Text + ".cdo") <> "" Then
                Kill nox.Text + ".cdo"
             End If
             If Dir(nox.Text + ".mx") <> "" Then
                Kill nox.Text + ".mx"
             End If
             Set nox = nox.Next
         Next
      End If
      TreeView1.Nodes.Remove i
      TreeView2.Nodes.Clear
      WriteToDisk
      RichTextBox1.Text = ""
   End If
Else
   MsgBox "不能删除主键 " + Chr(34) + "光盘库" + Chr(34), vbExclamation
End If
End Sub


Private Sub mnuFindResultDelete_Click()
If vbNo = MsgBox("是否要删除　" + Mid(mnuFindResultDelete.Caption, 3) + "     ", vbQuestion + vbYesNo) Then
   Exit Sub
End If
mykey = "@@@@@***##查找结果@@@@@***##"
If Left(TreeView1.SelectedItem.Key, 24) = mykey And Len(TreeView1.SelectedItem.Key) > 24 Then
   If Dir(TreeView1.SelectedItem.Text + ".fnd") <> "" Then
      Kill TreeView1.SelectedItem.Text + ".fnd"
   End If
   For i = 1 To TreeView1.Nodes.Count
       If TreeView1.Nodes(i).Key = TreeView1.SelectedItem.Key Then
          TreeView1.Nodes.Remove i
          TreeView2.Nodes.Clear
          Exit For
       End If
   Next
   WriteToDisk
   Exit Sub
End If
If TreeView1.SelectedItem.Key = mykey Then
    sfiles = Dir("*.fnd")
    Do While sfiles <> ""
       Kill sfiles
       sfiles = Dir
    Loop
End If
  For i = 1 To TreeView1.Nodes.Count
       If TreeView1.Nodes(i).Key = mykey Then
          TreeView1.Nodes.Remove i
          TreeView2.Nodes.Clear
          MainForm.Toolbar1.Buttons("find").Enabled = True
          Exit For
       End If
   Next
   WriteToDisk
End Sub

Private Sub mnuRenameCdrom_Click()
reinput:
      Dim RenameCdrom As String
      RenameCdrom = InputBox("光盘　" + Chr(34) + TreeView1.SelectedItem.Text + Chr(34) + " 重命名为：", , TreeView1.SelectedItem.Text)
      If Trim(RenameCdrom) <> "" Then
         For i = 1 To TreeView1.Nodes.Count
           If Left(TreeView1.Nodes(i).Key, 24) <> "@@@@@***##查找结果@@@@@***##" Then
             If Trim(RenameCdrom) = TreeView1.Nodes.Item(i).Text Then
                MsgBox "光盘库中已有光盘或类别 " + Chr(34) + RenameCdrom + Chr(34) + Chr(13) + Chr(13) + "请重新输入光盘名!或按＜取消＞结束", vbExclamation
                GoTo reinput
             End If
           End If
         Next
         If Dir(RenameCdrom + ".cdo") <> "" Then
            If vbNo = MsgBox("光盘镜像文件 " + RenameCdrom + " 已存在!是否真的要覆盖?", vbYesNo + vbQuestion) Then
               Exit Sub
            End If
            Kill RenameCdrom + ".cdo"
         End If
         If Dir(RenameCdrom + ".mx") <> "" Then
            Kill RenameCdrom + ".mx"
         End If
         If Dir(TreeView1.SelectedItem.Text + ".cdo") <> "" Then
            Name TreeView1.SelectedItem.Text + ".cdo" As RenameCdrom + ".cdo"
         End If
         
         If Dir(TreeView1.SelectedItem.Text + ".mx") <> "" Then
            Name TreeView1.SelectedItem.Text + ".mx" As RenameCdrom + ".mx"
         End If
         TreeView1.SelectedItem.Text = Trim(RenameCdrom)
         TreeView1.SelectedItem.Key = "子光盘" + TreeView1.SelectedItem.Parent.Key + "@@@@@***##" + Trim(RenameCdrom)
         WriteToDisk
      End If

End Sub

Private Sub mnuRenameStyle_Click()
If TreeView1.SelectedItem.Text <> "光盘库" Then
reinput:
      Dim RenameStyle As String
      RenameStyle = InputBox("类别　" + Chr(34) + TreeView1.SelectedItem.Text + Chr(34) + " 重命名为：", , TreeView1.SelectedItem.Text)
      If Trim(RenameStyle) <> "" Then
         For i = 1 To TreeView1.Nodes.Count
           If Left(TreeView1.Nodes(i).Key, 24) <> "@@@@@***##查找结果@@@@@***##" Then
             If Trim(RenameStyle) = TreeView1.Nodes.Item(i) Then
                MsgBox "光盘库中已有类别或光盘 " + Chr(34) + RenameStyle + Chr(34) + Chr(13) + Chr(13) + "请重新输入类别名!或按＜取消＞结束", vbExclamation
                GoTo reinput
             End If
           End If
         Next
         Set nox = TreeView1.SelectedItem.Child
         For i = 1 To TreeView1.SelectedItem.Children
             nox.Key = "子光盘光盘库" + RenameStyle + "@@@@@***##" + nox.Text
             Set nox = nox.Next
         Next
         TreeView1.SelectedItem.Text = Trim(RenameStyle)
         TreeView1.SelectedItem.Key = "光盘库" + Trim(RenameStyle)
         WriteToDisk
      End If
Else
   MsgBox "不能重命名主键 " + Chr(34) + "光盘库" + Chr(34), vbExclamation
End If
End Sub



Private Sub mnuStyleFind_Click()
If TreeView1.SelectedItem.Text = "光盘库" Then
   havecdrom = False
   Dim noddx As Node
   Set noddx = TreeView1.SelectedItem.Child
   For i = 1 To TreeView1.SelectedItem.Children
       If noddx.Children Then
          havecdrom = True
          Exit For
      End If
         Set noddx = noddx.Next
   Next
   If havecdrom Then
      CdromName = "光盘库"
      Info = "整个光盘库"
   Else
      MsgBox "整个光盘库中没有光盘，用不着查找!", vbInformation
      Exit Sub
   End If
Else
   If TreeView1.SelectedItem.Parent.Text = "光盘库" Then
      If TreeView1.SelectedItem.Children < 1 Then
         MsgBox "类别（" + TreeView1.SelectedItem.Text + "）中没有光盘，用不着查找!", vbInformation
         Exit Sub
      End If
      Info = "类别 (" + TreeView1.SelectedItem.Text + ")"
      CdromName = TreeView1.SelectedItem.Text