frmmanager.vb

一个用vb开发的档案管理程序

        'MnuOpenFile
        '
        Me.MnuOpenFile.Enabled = False
        Me.MnuOpenFile.Index = 10
        Me.MnuOpenFile.Shortcut = System.Windows.Forms.Shortcut.CtrlO
        Me.MnuOpenFile.Text = "&E 打开档案关联的文件"
        '
        'MnuReturnX
        '
        Me.MnuReturnX.Index = 1
        Me.MnuReturnX.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MnuReturn, Me.Line601, Me.MnuExit})
        Me.MnuReturnX.Text = "关闭选择^&O)"
        '
        'MnuReturn
        '
        Me.MnuReturn.Index = 0
        Me.MnuReturn.Shortcut = System.Windows.Forms.Shortcut.CtrlR
        Me.MnuReturn.Text = "返回首页(&R)"
        '
        'Line601
        '
        Me.Line601.Index = 1
        Me.Line601.Text = "-"
        '
        'MnuExit
        '
        Me.MnuExit.Index = 2
        Me.MnuExit.Shortcut = System.Windows.Forms.Shortcut.CtrlX
        Me.MnuExit.Text = "退出系统(&X)"
        '
        'frmManager
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.BackColor = System.Drawing.Color.FromArgb(CType(224, Byte), CType(224, Byte), CType(224, Byte))
        Me.ClientSize = New System.Drawing.Size(930, 417)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.SliptBar, Me.TreeView, Me.ListView, Me.imlSmallIcons, Me.imgSplit})
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Location = New System.Drawing.Point(4, 42)
        Me.Menu = Me.MainMenu1
        Me.Name = "frmManager"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.WindowsDefaultBounds
        Me.Text = "档案管理中心"
        Me.WindowState = System.Windows.Forms.FormWindowState.Maximized
        CType(Me.TreeView, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ListView.ResumeLayout(False)
        CType(Me.imlSmallIcons, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.Label1, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.txtFields, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As frmManager
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As frmManager
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New frmManager()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	Dim SL As Integer
	Dim MDown, lShow As Boolean
	Dim mNode As ComctlLib.Node
	Dim mdbFile As DAO.Database
	Dim strHistory As String
	
	Const sglSplitLimit As Short = 500
	
	Public Sub frmManager_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		IT = True
		TreeView.Top = 0
		TreeView.Left = 0
		
		'定位上次分隔条
		If Val(GetSetting(VB6.GetExeName(), "Config", "Split")) < 1500 Then
			imgSplit.Left = VB6.TwipsToPixelsX(1500)
		Else
			imgSplit.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "Config", "Split")))
		End If
		'安装列表
		cmdLoad_Click()
        '使搜索有效
        frmmain.
		frmMain.DefInstance.Toolbar1.Buttons(9).Enabled = True
		frmMain.DefInstance.Toolbar1.Buttons(11).Enabled = False
		
		subPurView() '安装权限
		
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 frmManager.Resize。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub frmManager_Resize(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Resize
		
		On Error Resume Next
		If VB6.PixelsToTwipsY(Me.Height) < 3000 Then Me.Height = VB6.TwipsToPixelsY(3000)
		If VB6.PixelsToTwipsX(Me.Width) < 3000 Then Me.Width = VB6.TwipsToPixelsX(3000)
		SizeControls((VB6.PixelsToTwipsX(imgSplit.Left)))
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmManager.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub frmManager_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		'使按钮无效
		frmMain.DefInstance.Toolbar1.Buttons(9).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(11).Enabled = True
		
		IT = False
		
	End Sub
	
	Private Sub imgSplit_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles imgSplit.MouseDown
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		With imgSplit
			SliptBar.SetBounds(.Left, .Top, VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(.Width) \ 2), VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(.Height) - 20))
		End With
		SliptBar.Visible = True
		MDown = True
		
	End Sub
	
	Private Sub imgSplit_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles imgSplit.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		Dim lPos As Single
		
		If MDown Then
			lPos = X + VB6.PixelsToTwipsX(imgSplit.Left)
			If lPos < sglSplitLimit Then
				SliptBar.Left = VB6.TwipsToPixelsX(sglSplitLimit)
			ElseIf lPos > VB6.PixelsToTwipsX(Me.ClientRectangle.Width) - sglSplitLimit Then 
				SliptBar.Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(Me.ClientRectangle.Width) - sglSplitLimit)
			Else
				SliptBar.Left = VB6.TwipsToPixelsX(lPos)
			End If
		End If
		
	End Sub
	
	Private Sub imgSplit_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles imgSplit.MouseUp
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		SizeControls((VB6.PixelsToTwipsX(SliptBar.Left)))
		SliptBar.Visible = False
		MDown = False
		SaveSetting(VB6.GetExeName(), "Config", "Split", CStr(VB6.PixelsToTwipsX(imgSplit.Left)))
		
	End Sub
	
	Sub SizeControls(ByRef X As Single)
		
		On Error Resume Next
		
		'设置 Width 属性
		If X < 1500 Then X = 1500
		If X > (VB6.PixelsToTwipsX(Me.Width) - 1500) Then X = VB6.PixelsToTwipsX(Me.Width) - 1500
		TreeView.Width = VB6.TwipsToPixelsX(X)
		imgSplit.Left = VB6.TwipsToPixelsX(X)
		ListView.Left = VB6.TwipsToPixelsX(X + 40)
		ListView.Width = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(Me.Width) - (VB6.PixelsToTwipsX(TreeView.Width) - 30))
		
		TreeView.Height = Me.ClientRectangle.Height
		
		ListView.Top = TreeView.Top
		
		ListView.Height = TreeView.Height
		imgSplit.Top = TreeView.Top
		imgSplit.Height = TreeView.Height
		
	End Sub
	
	Public Sub cmdLoad_Click()
		
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		'清除右边的项目内容
		lblFileCaption.Text = "档案仓库"
		txtFields(1).Text = ""
		txtFields(2).Text = ""
		txtFields(3).Text = ""
		txtFields(0).Text = ""
		frmMain.DefInstance.Toolbar1.Buttons(5).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(6).Enabled = False
		frmMain.DefInstance.Toolbar1.Buttons(7).Enabled = False
		MnuAddFile.Enabled = False
		MnuModifyFile.Enabled = False
		MnuDeleteFile.Enabled = False
		MnuOpenFile.Enabled = False
		
		Dim rsPublishers, rsTitles As DAO.Recordset
		Dim IntIndex As Object
		TreeView.Nodes.Clear() '清除原有的数据
		'配置TreeView
		TreeView.Sorted = True
		mNode = TreeView.Nodes.Add
		With mNode
			.Text = "档案仓库"
			.Tag = "FileManager"
			.Image = "Closed"
		End With
		TreeView.LabelEdit = 1
		
		mdbFile = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		rsPublishers = mdbFile.OpenRecordset("Catalog", DAO.RecordsetTypeEnum.dbOpenDynaset)
		
		Do Until rsPublishers.EOF
			
			mNode = TreeView.Nodes.Add(1, ComctlLib.TreeRelationshipConstants.tvwChild, rsPublishers.Fields("Name"), CStr(rsPublishers.Fields("Name").Value), "SClosed")
			mNode.Tag = "File"
			'UPGRADE_WARNING: 未能解析对象 IntIndex 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			IntIndex = mNode.Index
			If strSearchString <> "" Then '查询时
				rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers.Fields("Name").Value & "'" & strSearchString)
			Else
				rsTitles = mdbFile.OpenRecordset("Select * from Detail Where Name ='" & rsPublishers.Fields("Name").Value & "'")
			End If
			Do Until rsTitles.EOF
				mNode = TreeView.Nodes.Add(IntIndex, ComctlLib.TreeRelationshipConstants.tvwChild)
				mNode.Text = rsTitles.Fields("档案号").Value
				mNode.Key = rsTitles.Fields("档案号").Value
				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()
		'UPGRADE_NOTE: 在对对象 mdbFile 进行垃圾回收前，不可以销毁该对象。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1029"'
		mdbFile = Nothing
		
		'取消所有档案操作
		MnuAddFile.Enabled = False
		MnuModifyFile.Enabled = False
		MnuDeleteFile.Enabled = False
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Private Sub ListView_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles ListView.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		
		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(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles ListView.Resize
		
		lblFileCaption.Left = VB6.TwipsToPixelsX((VB6.PixelsToTwipsX(ListView.Width) - VB6.PixelsToTwipsX(lblFileCaption.Width)) / 2)
		lblLine.Width = ListView.ClientRectangle.Width
		lblLine.Left = VB6.TwipsToPixelsX(-20)
		Label2.Left = VB6.TwipsToPixelsX(-20)
		Label2.Width = ListView.ClientRectangle.Width
		
	End Sub
	
	Public Sub MnuAddFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAddFile.Popup
		MnuAddFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuAddFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuAddFile.Click
		
		Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
		frmNewForm.DefInstance.ShowDialog()
		Me.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Public Sub MnuDeleteFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuDeleteFile.Popup
		MnuDeleteFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub MnuDeleteFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MnuDeleteFile.Click
		Dim vbclrf As Object
		
		'UPGRADE_WARNING: 未能解析对象 vbclrf 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
		If MsgBox("真的要删除档案吗？     " & vbCrLf & vbclrf & vbCrLf & strFileID & " [是/否]？     ", MsgBoxStyle.YesNo + MsgBoxStyle.Critical + MsgBoxStyle.DefaultButton2, "档案删除后将不能恢复!") = MsgBoxResult.No Then Exit Sub
		
		Dim strTemp As String
		
		DAODBEngine_definst.BeginTrans()
		
		mdbFile = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		strTemp = "Delete * From Detail Where Name='" & strFileType & "' And 档案号='" & strFileID & "'"
		mdbFile.Execute(strTemp)
		mdbFile.Close()
		'UPGRADE_NOTE: 在对对象 mdbFile 进行垃圾回收前，不可以销毁该对象。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1029"'
		mdbFile = Nothing
		DAODBEngine_definst.CommitTrans()