frmmanager.frm

档案管理系统源码VB档案管理系统源码VB

  
  '定位上次分隔条
  If Val(GetSetting(App.EXEName, "Config", "Split")) < 1500 Then
    imgSplit.Left = 1500
   Else
    imgSplit.Left = Val(GetSetting(App.EXEName, "Config", "Split"))
  End If
  '安装列表
  cmdLoad_Click
  '使搜索有效
  frmMain.Toolbar1.Buttons(9).Enabled = True
  frmMain.Toolbar1.Buttons(11).Enabled = False
  
  subPurView '安装权限
  
End Sub

Private Sub Form_Resize()

  On Error Resume Next
  If Me.Height < 3000 Then Me.Height = 3000
  If Me.Width < 3000 Then Me.Width = 3000
  SizeControls imgSplit.Left
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  '使按钮无效
  frmMain.Toolbar1.Buttons(9).Enabled = False
  frmMain.Toolbar1.Buttons(5).Enabled = False
  frmMain.Toolbar1.Buttons(6).Enabled = False
  frmMain.Toolbar1.Buttons(7).Enabled = False
  frmMain.Toolbar1.Buttons(11).Enabled = True
  
  IT = False
  
End Sub

Private Sub imgSplit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With imgSplit
        SliptBar.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    SliptBar.Visible = True
    MDown = True
    
End Sub

Private Sub imgSplit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim lPos As Single

    If MDown Then
        lPos = X + imgSplit.Left
        If lPos < sglSplitLimit Then
            SliptBar.Left = sglSplitLimit
        ElseIf lPos > Me.ScaleWidth - sglSplitLimit Then
            SliptBar.Left = Me.ScaleWidth - sglSplitLimit
        Else
            SliptBar.Left = lPos
        End If
    End If

End Sub

Private Sub imgSplit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    SizeControls SliptBar.Left
    SliptBar.Visible = False
    MDown = False
    SaveSetting App.EXEName, "Config", "Split", imgSplit.Left
    
End Sub

Sub SizeControls(X As Single)
    
    On Error Resume Next
    
    '设置 Width 属性
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    TreeView.Width = X
    imgSplit.Left = X
    ListView.Left = X + 40
    ListView.Width = Me.Width - (TreeView.Width - 30)
    
    TreeView.Height = Me.ScaleHeight
    
    ListView.Top = TreeView.Top
    
    ListView.Height = TreeView.Height
    imgSplit.Top = TreeView.Top
    imgSplit.Height = TreeView.Height
    
End Sub

Public Sub cmdLoad_Click()
    
    Me.MousePointer = 11
    '清除右边的项目内容
    lblFileCaption.Caption = "档案仓库"
    txtFields(1).Text = ""
    txtFields(2).Text = ""
    txtFields(3).Text = ""
    txtFields(0).Text = ""
    frmMain.Toolbar1.Buttons(5).Enabled = False
    frmMain.Toolbar1.Buttons(6).Enabled = False
    frmMain.Toolbar1.Buttons(7).Enabled = False
    MnuAddFile.Enabled = False
    MnuModifyFile.Enabled = False
    MnuDeleteFile.Enabled = False
    MnuOpenFile.Enabled = False
    
    Dim rsPublishers As Recordset, rsTitles As Recordset
    Dim IntIndex
    TreeView.Nodes.Clear   '清除原有的数据
    '配置TreeView
    TreeView.Sorted = True
    Set mNode = TreeView.Nodes.Add
    With mNode
     .Text = "档案仓库"
     .Tag = "FileManager"
     .Image = "Closed"
    End With
    TreeView.LabelEdit = 1
     
    Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
    Set rsPublishers = mdbFile.OpenRecordset("Catalog", dbOpenDynaset)
        
    Do Until rsPublishers.EOF
       
       Set mNode = TreeView.Nodes.Add(1, tvwChild, rsPublishers!Name, CStr(rsPublishers!Name), "SClosed")
        mNode.Tag = "File"
        IntIndex = mNode.Index
        If strSearchString <> "" Then '查询时
         Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'" & strSearchString)
          Else
         Set rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers!Name & "'")
        End If
        Do Until rsTitles.EOF
            Set mNode = TreeView.Nodes.Add(IntIndex, tvwChild)
            mNode.Text = rsTitles!档案号
            mNode.Key = rsTitles!档案号
            mNode.Tag = "SFile"
            mNode.Image = "File"
            rsTitles.MoveNext
        Loop
        rsPublishers.MoveNext   ' Move to next Publishers record.
    Loop
    
    TreeView.Nodes(1).Sorted = True
    TreeView.Nodes(1).Expanded = True
    
    '释放数据库
    rsTitles.Close
    rsPublishers.Close
    mdbFile.Close
    Set mdbFile = Nothing
    
    '取消所有档案操作
     MnuAddFile.Enabled = False
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     Me.MousePointer = 0
    
End Sub

Private Sub ListView_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

 If lShow = False Then Exit Sub '已经隐藏时退出
 lLeft.Visible = False
 lRight.Visible = False
 lTop.Visible = False
 lBottom.Visible = False
 lShow = False
 
End Sub

Private Sub ListView_Resize()

  lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
  lblLine.Width = ListView.ScaleWidth
  lblLine.Left = -20
  Label2.Left = -20
  Label2.Width = ListView.ScaleWidth
  
End Sub

Public Sub MnuAddFile_Click()

   Me.MousePointer = 11
      frmNewForm.Show 1
   Me.MousePointer = 0
   
End Sub

Public Sub MnuDeleteFile_Click()

 If MsgBox("真的要删除档案吗？     " & vbCrLf & vbclrf & vbCrLf & strFileID & " [是/否]？     ", vbYesNo + vbCritical + vbDefaultButton2, "档案删除后将不能恢复!") = vbNo Then Exit Sub
    
    Dim strTemp As String
    
    DBEngine.BeginTrans
    
    Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
    strTemp = "Delete * From Detail Where Name='" & strFileType & "' And 档案号='" & strFileID & "'"
    mdbFile.Execute strTemp
    mdbFile.Close
    Set mdbFile = Nothing
    DBEngine.CommitTrans
    
    '刷新数据
    Call cmdLoad_Click
   frmMain.Toolbar1.Buttons(5).Enabled = False
   frmMain.Toolbar1.Buttons(6).Enabled = False
   frmMain.Toolbar1.Buttons(7).Enabled = False
   MnuAddFile.Enabled = False
   MnuModifyFile.Enabled = False
   MnuDeleteFile.Enabled = False
     
End Sub

Private Sub MnuExit_Click()
  
  Unload frmMain
  
End Sub

Private Sub MnuFolder_Click()

  Me.MousePointer = 11
     frmCatalog.Show 1
  Me.MousePointer = 0
  
End Sub

Public Sub MnuModifyFile_Click()

  Me.MousePointer = 11
  frmModifyForm.Show 1
  Me.MousePointer = 0
  
End Sub

Private Sub MnuOpenFile_Click()

  Call picEditFile_Click
  
End Sub

Private Sub MnuRefresh_Click()

  strSearchString = ""  '查询条件为空
  Call cmdLoad_Click
   
End Sub

Private Sub MnuReturn_Click()

   Unload Me
   
End Sub

Public Sub MnuSearchFile_Click()

  Me.MousePointer = 11
     frmSearchForm.Show 1
  Me.MousePointer = 0
  
End Sub

Private Sub picEditFile_Click()

  On Error Resume Next
  '编辑档案
  Dim retVal As Long
  
  retVal = ShellExecute(Me.hwnd, "Open", txtFields(1).Text, "", App.Path + "\File", 1)
  
  If retVal = 2 Then  '文件不存在
     MsgBox "下面文件没有找到：    " & vbCrLf & vbCrLf & txtFields(1).Text & "    ", vbInformation, "档案管理系统"
     Exit Sub
  End If
  
  If retVal = 31 Then '文件不能打开时
     If MsgBox("系统不能自动打开下面文件：    " & vbCrLf & vbCrLf & txtFields(1).Text & _
      vbCrLf & vbCrLf & "是否使用其它Open方法试试,(是/否)?      ", vbYesNo + vbQuestion, "档案管理系统") = vbNo Then
      Exit Sub
     Else
      '使用Explorer打开文件
      retVal = Shell("Explorer.Exe " & txtFields(1).Text, vbNormalFocus)
     End If
  End If
  
End Sub

Private Sub picEditFile_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

 lTop.BorderColor = &H808080
 lBottom.BorderColor = &HFFFFFF
 
End Sub

Private Sub picEditFile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
 If lShow = True Then Exit Sub  '已经显示时退出
 
 lLeft.Visible = True
 lRight.Visible = True
 lTop.Visible = True
 lBottom.Visible = True
 lShow = True
 
End Sub

Private Sub picEditFile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 lTop.BorderColor = &HFFFFFF
 lBottom.BorderColor = &H808080
 
End Sub

Private Sub TreeView_Collapse(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Closed"
  If Node.Tag = "File" Then Node.Image = "SClosed"

End Sub

Private Sub TreeView_Expand(ByVal Node As ComctlLib.Node)
  
  If Node.Tag = "FileManager" Then Node.Image = "Open"
  If Node.Tag = "File" Then Node.Image = "SOpen"
  
End Sub

Private Sub TreeView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Button = 2 Then
     PopupMenu MnuControl
  End If
  
End Sub

Private Sub TreeView_NodeClick(ByVal Node As ComctlLib.Node)

   lblFileCaption.Caption = Node.Text
   lblFileCaption.Left = (ListView.Width - lblFileCaption.Width) / 2
   
  If Node.Tag = "SFile" Then
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = True
     MnuDeleteFile.Enabled = True
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = True
     frmMain.Toolbar1.Buttons(7).Enabled = True
     subPurView '安装权限
   Else
     MnuAddFile.Enabled = False
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = False
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
  End If
  
   If Node.Tag = "SFile" And strHistory <> Node.Text Then
      If Trim(Node.Text) <> "" Then
         LoadData (Node.Text) '安装数据库
         strHistory = Node.Text
         If Trim(txtFields(1).Text) <> "" And PurView <> "只能添加" Then
            MnuOpenFile.Enabled = True
         Else
            MnuOpenFile.Enabled = False
         End If
      End If
   End If
   
   If Node.Tag <> "SFile" Then
      txtFields(0).Text = ""
      txtFields(1).Text = ""
      txtFields(2).Text = ""
      txtFields(3).Text = ""
      strHistory = ""
      MnuOpenFile.Enabled = False
   End If
   
   '安装ID与类型,但为根目录时跳过
   If Node.Text = "档案仓库" Then
     ElseIf Node.Tag = "File" Then
       MnuAddFile.Enabled = True
       frmMain.Toolbar1.Buttons(5).Enabled = True
       strFileType = Node.Text
       strFileID = ""
     Else
       strFileType = Node.Parent.Text
       strFileID = Node.Text
   End If
      
End Sub

Private Sub LoadData(strTemp As String)
  
   If PurView = "只能添加" Then Exit Sub
   
   Set mdbFile = OpenDatabase(ConData, False, False, ConStr)
   Dim rsTitles As Recordset
    Set rsTitles = mdbFile.OpenRecordset("Select * From Detail Where 档案号='" & strTemp & "'", dbOpenDynaset)
    
        txtFields(0).Text = rsTitles!Name
        txtFields(1).Text = rsTitles!文件名
        txtFields(2).Text = rsTitles!文件说明
        txtFields(3).Text = rsTitles!参考说明
     rsTitles.Close
     mdbFile.Close
    Set mdbFile = Nothing
   
End Sub

Private Sub txtFields_Change(Index As Integer)

  If Trim(txtFields(1).Text) = "" Then
     picEditFile.Visible = False
   Else
     picEditFile.Visible = True
  End If
  
End Sub

Private Sub txtFields_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If lShow = False Then Exit Sub '已经隐藏时退出

 lLeft.Visible = False
 lRight.Visible = False
 lTop.Visible = False
 lBottom.Visible = False
 lShow = False
 
End Sub

Private Sub subPurView()

 '权限控制
Select Case PurView
   Case "只能添加"
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
     MnuSearchFile.Enabled = False
     frmMain.Toolbar1.Buttons(9).Enabled = False
   Case "不能修改"
     MnuAddFile.Enabled = True
     MnuModifyFile.Enabled = False
     MnuDeleteFile.Enabled = False
     frmMain.Toolbar1.Buttons(5).Enabled = True
     frmMain.Toolbar1.Buttons(6).Enabled = False
     frmMain.Toolbar1.Buttons(7).Enabled = False
   Case "可以修改"
     '没有
   Case "超级权限"
     '没有权限限制
End Select

End Sub

Private Function LocalPath(strFileName As String) As String

  strFileName = Trim(strFileName)
  
  Dim X As Integer
      X = 1
  For X = 1 To Len(strFileName)
      If InStr(1, Right(strFileName, X), "\", vbTextCompare) Then
         Exit For
      End If
  Next
    
  If X > Len(strFileName) Then
     LocalPath = CurDir()
  Else
     LocalPath = Left(strFileName, Len(strFileName) - X)
  End If
   
End Function