📄 frmdocuments.frm
字号:
BackStyle = 0 'Transparent
Caption = "内容简介："
Height = 255
Left = 60
TabIndex = 10
Top = 2430
Width = 1095
End
Begin VB.Label Label11
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "关键词："
Height = 255
Left = 60
TabIndex = 9
Top = 2070
Width = 1095
End
Begin VB.Label Label10
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "项目类别："
Height = 255
Left = 60
TabIndex = 8
Top = 1740
Width = 1095
End
Begin VB.Label Label9
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "单位："
Height = 255
Left = 60
TabIndex = 7
Top = 1380
Width = 1095
End
Begin VB.Label Label8
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "作者："
Height = 255
Left = 60
TabIndex = 6
Top = 1020
Width = 1095
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "主题："
Height = 255
Left = 60
TabIndex = 5
Top = 660
Width = 1095
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "标题："
Height = 255
Left = 60
TabIndex = 4
Top = 300
Width = 1095
End
End
Begin VB.Frame Frame1
BackColor = &H00C0E0FF&
Caption = "[文档检索]"
Height = 3735
Left = 120
TabIndex = 1
Top = 420
Width = 9435
Begin MSComctlLib.ImageList ImageList1
Left = 2760
Top = 2940
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDocuments.frx":025C
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDocuments.frx":06AE
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDocuments.frx":0B00
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDocuments.frx":0F52
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView tvwDir
Height = 2775
Left = 180
TabIndex = 28
Top = 720
Width = 3555
_ExtentX = 6271
_ExtentY = 4895
_Version = 393217
LabelEdit = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
End
Begin MSComctlLib.ListView ListView1
Height = 3315
Left = 3960
TabIndex = 26
Top = 240
Width = 5295
_ExtentX = 9340
_ExtentY = 5847
View = 3
LabelEdit = 1
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.Label lblPath
Caption = "lblPath"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 29
Top = 360
Width = 3555
End
End
Begin VB.Label Label3
Caption = "1"
DataField = "编号"
DataSource = "Adodc1"
Height = 255
Left = -74700
TabIndex = 27
Top = 3960
Width = 1455
End
Begin VB.OLE OLE1
DataField = "内容"
DataSource = "Data1"
Height = 3135
Left = -74820
TabIndex = 3
Top = 4260
Width = 9195
End
End
End
Attribute VB_Name = "frmDocuments"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' True if Cancel was pressed to close this form
Public CancelPressed As Boolean
' this is used by many routines in the module
Public FSO As New Scripting.FileSystemObject
Public fld As Scripting.Folder
Public fil As Scripting.File
Public dr As Scripting.Drive
Private m_Path As String
Private Sub DirRefresh()
Dim rootNode As Node, nd As Node
On Error Resume Next
' add the "My Computer" root (expanded)
Set rootNode = tvwDir.Nodes.Add(, , "\\MyComputer", "我的电脑", 1)
rootNode.Expanded = True
' add all the drives, with a plus sign
For Each dr In FSO.Drives
If dr.Path <> "A:" Then
Err.Clear
Set nd = tvwDir.Nodes.Add(rootNode.Key, tvwChild, dr.Path & "\", dr.Path & "\", 2)
If Err = 0 Then AddDummyChild nd
End If
Next
End Sub
' the Path currently selected
Property Get Path() As String
Path = m_Path
End Property
Private Sub Adodc1_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
On Error Resume Next
End Sub
Private Sub Combo2_Click()
txtFields(9).Text = Combo2.Text
End Sub
Private Sub Combo3_Click()
txtFields(12).Text = Combo3.Text
End Sub
Private Sub Combo4_Click()
txtFields(13).Text = Combo4.Text
End Sub
Private Sub Command1_Click()
Dim strFile As String
Dim curs As String
Dim temps As New ADODB.Recordset
Adodc1.Recordset.UpdateBatch adAffectAllChapters
curs = "select max(编号) as ID from 文档信息表 "
With temps
.Open curs, Adodc1.ConnectionString, adOpenKeyset, adLockOptimistic
End With
curs = "编号 = " & temps.Fields("ID").Value
strFile = Label24.Caption
Data1.RecordSource = "select 编号, 内容 from 文档信息表 where " & curs
Data1.Refresh
OLE1.CreateEmbed strFile
OLE1.Update
Data1.UpdateRecord
DataGrid1.Refresh
temps.Close
MsgBox "您的文档已经保存完毕，可以查阅了。", vbInformation, "We Link Zone"
End Sub
Private Sub Command2_Click()
Adodc1.Recordset.Delete
End Sub
Private Sub Command3_Click()
Unload fMainForm.ActiveForm
fMainForm.Picture2.Visible = True
End Sub
Private Sub Command4_Click()
Adodc1.Recordset.AddNew
txtFields(2).Text = GetSetting("wlf", "DM", "UserName", Default:="")
End Sub
Private Sub DataCombo1_Click(Area As Integer)
txtFields(4).Text = DataCombo1.BoundText
End Sub
Private Sub DataGrid1_DblClick()
Dim curs As String
curs = "编号 = " & Adodc1.Recordset.Fields("编号").Value
Data1.RecordSource = "select 内容 from 文档信息表 where " & curs
Data1.Refresh
OLE1.Refresh
End Sub
Private Sub Form_Load()
With Data1
.DefaultType = 1
.Connect = "ODBC;DSN=DM;UID=;PWD=;"
.RecordSource = "文档信息表"
End With
With Adodc1
.ConnectionString = "DSN=DM;UID=;PWD=;"
End With
ListView1.ColumnHeaders.Clear
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "目录", 2000
ListView1.ColumnHeaders.Add , , "名称", 1500
ListView1.ColumnHeaders.Add , , "大小", 1000
ListView1.ColumnHeaders.Add , , "类型", 1500
ListView1.ColumnHeaders.Add , , "完成时间", 2000
DirRefresh
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Adodc1.Recordset.AddNew
txtFields(0).Text = Item.SubItems(1)
txtFields(7).Text = FormatDateTime(Item.SubItems(4), vbLongDate)
txtFields(11).Text = Now
Label24.Caption = Item.Text & "\" & Item.SubItems(1)
Label26.Caption = Item.SubItems(3)
txtFields(2).Text = GetSetting("wlf", "DM", "UserName", Default:="")
End Sub
Sub AddDummyChild(nd As Node)
' add a dummy child node, if necessary
If nd.children = 0 Then
' dummy nodes' Text property is "***"
tvwDir.Nodes.Add nd.Index, tvwChild, , "***"
End If
End Sub
Private Sub tvwDir_Click()
m_Path = tvwDir.SelectedItem.Key
lblPath.Caption = tvwDir.SelectedItem.Key
End Sub
Private Sub tvwDir_Expand(ByVal Node As MSComctlLib.Node)
' a node if being expanded
Dim nd As Node
' exit if the node had been already expanded in the past
If Node.children = 0 Or Node.children > 1 Then Exit Sub
' also exit if it doesn't have a dummy child node
If Node.Child.Text <> "***" Then Exit Sub
' remove the dummy child item
tvwDir.Nodes.Remove Node.Child.Index
' add all the subdirs of this Node object
AddSubdirs Node
End Sub
Private Sub AddSubdirs(ByVal Node As MSComctlLib.Node)
' add all the subdirs under a node
Dim nd As Node
' the path in the node is hold in its key property
' cycle on all its subdirectories
For Each fld In FSO.GetFolder(Node.Key).SubFolders
Set nd = tvwDir.Nodes.Add(Node, tvwChild, fld.Path, fld.Name, 3)
nd.ExpandedImage = 4
' if this directory has subfolders, add a "+" sign
If fld.SubFolders.Count Then AddDummyChild nd
Next
End Sub
Private Sub tvwDir_NodeClick(ByVal Node As MSComctlLib.Node)
Dim li As ListItem
Dim sb As String
sb = Right(Node.FullPath, Len(Node.FullPath) - 5)
ListView1.ListItems.Clear
For Each fil In FSO.GetFolder(sb).Files
Set li = ListView1.ListItems.Add(, , fil.ParentFolder)
li.ListSubItems.Add , , fil.Name
li.ListSubItems.Add , , fil.Size
li.ListSubItems.Add , , fil.Type
li.ListSubItems.Add , , FormatDateTime(fil.DateLastModified, 1)
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -