📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "自动赋词标引系统"
ClientHeight = 8205
ClientLeft = 150
ClientTop = 720
ClientWidth = 9180
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8205
ScaleWidth = 9180
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "文章内容"
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5895
Left = 120
TabIndex = 9
Top = 1920
Width = 8895
Begin VB.TextBox content
Height = 5175
Left = 240
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 10
Top = 480
Width = 8295
End
End
Begin VB.Frame Frame1
Caption = "关联词词频列表："
Height = 1815
Left = 6360
TabIndex = 7
Top = 0
Width = 2655
Begin VB.ListBox List1
Height = 1140
Left = 120
TabIndex = 8
Top = 360
Width = 2415
End
End
Begin VB.ListBox List2
Height = 4740
Left = 8400
TabIndex = 6
Top = 2280
Visible = 0 'False
Width = 615
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 7320
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox txtkeyword
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 5
Top = 1200
Width = 4335
End
Begin VB.TextBox title
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 3
Top = 720
Width = 4335
End
Begin VB.TextBox subject
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 1
Text = "经济管理"
Top = 240
Width = 4335
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "版权所有 ◎2004-2005 02信管课程设计第三小组"
Height = 255
Left = 5040
TabIndex = 11
Top = 7920
Width = 3975
End
Begin VB.Label Label3
Caption = "关键字："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 4
Top = 1200
Width = 735
End
Begin VB.Label Label2
Caption = "标题："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 2
Top = 720
Width = 735
End
Begin VB.Label Label1
Caption = "主题："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 0
Top = 240
Width = 735
End
Begin VB.Menu style
Caption = "标引类别"
Begin VB.Menu ecnomic
Caption = "经济综合类"
End
End
Begin VB.Menu open
Caption = "打开文件"
End
Begin VB.Menu work
Caption = "标引文章"
End
Begin VB.Menu save
Caption = "保存标引信息"
End
Begin VB.Menu find
Caption = "已标引文章查询"
End
Begin VB.Menu about
Caption = "关于"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public LastRecord As Integer
Public FirstRecord As Integer
Public filename As String
Private Sub about_Click()
aboutdf.Show
End Sub
Private Sub find_Click()
frmselect.Show
End Sub
Private Sub Form_Load()
work.Enabled = False
save.Enabled = False
End Sub
Private Sub open_Click()
content.Text = ""
txtkeyword.Text = ""
List1.Clear
List2.Clear
FirstRecord = 1
LastRecord = 1
On Error Resume Next
With CommonDialog1
.DialogTitle = "选择文件"
.Filter = "All Files文本文件(*.txt)|*.txt"
.ShowOpen
If Len(.filename) = 0 Then
Exit Sub
Else
Dim f As Integer
Dim sline As String
f = FreeFile
filename = CommonDialog1.filename
On Error Resume Next
Open filename For Input As #f
title.Text = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
Do Until EOF(1)
Line Input #f, sline
content.Text = content.Text + sline + vbCrLf
Loop
Close #f
End If
End With
work.Enabled = True
End Sub
Private Sub save_Click()
Dim cn As New ADODB.Connection
Set cn = New ADODB.Connection
cn.Provider = "microsoft.jet.oledb.4.0"
cn.open App.Path & "\data.mdb"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
Dim sql1 As String
Dim num As Integer
sql = "select * from 结果"
rs.open sql, cn, 2, 3
rs.AddNew
rs.Fields(1) = title.Text
rs.Fields(2) = txtkeyword.Text
rs.Update
MsgBox "保存成功！"
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Private Sub wfind_Click()
frmselect.Show
frmselect.txtkeyword1.SetFocus
End Sub
Private Sub work_Click()
'///////////////////////////////词频统计部分/////////////////////////
Dim keyword As String
Dim id As String
Dim sstring As String
Dim cn As New ADODB.Connection
Set cn = New ADODB.Connection
cn.Provider = "microsoft.jet.oledb.4.0"
cn.open App.Path & "\data.mdb"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
sql = "select 词,编号 from 关联词表"
rs.open sql, cn, 2, 3
While Not rs.EOF
keyword = rs.Fields(0)
id = rs.Fields(1)
Dim f As Integer
f = FreeFile
Open filename For Input As #f
Do Until EOF(1)
Dim cishu As Integer
cishu = 0
Line Input #f, sline
slen = Len(sline)
For i = 1 To slen
sstring = Mid(sline, i, Len(keyword))
If (StrComp(sstring, keyword, vbTextCompare) = 0) Then cishu = cishu + 1
Next
If cishu > 0 Then
List2.AddItem id & cishu
End If
Loop
List1.AddItem id & "—>" & keyword & "—>" & cishu
Close #f
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
'/////////////////////////////////综合权值的计算///////////////////////////
Dim cn1 As New ADODB.Connection
Set cn1 = New ADODB.Connection
cn1.Provider = "microsoft.jet.oledb.4.0"
cn1.open App.Path & "\data.mdb"
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
Dim result As Double
Dim sql1 As String
Dim sql2 As String
sql2 = "select 编号,综合权值 from 叙词表"
rs1.open sql2, cn1, 2, 3
If List2.List(0) = "" Then
MsgBox "标引文章不属于该类别！"
content.Text = ""
title.Text = ""
List1.Clear
Exit Sub
End If
While Not rs1.EOF
result = 0
id = rs1.Fields("编号")
For i = 0 To List2.ListCount - 1
times = Val(Right(List2.List(i), Len(List2.List(i)) - 4))
If (Left(id, 1) = Left(List2.List(i), 1)) Then
If (id = Left(List2.List(i), 4)) Then
result = times * 1 + result
Else
result = result + times * 0.3
End If
rs1.Fields("综合权值") = result
rs1.Update
End If
Next
rs1.MoveNext
Wend
rs1.Close
Set rs1 = Nothing
cn1.Close
Set cn1 = Nothing
'////////////////////////////////抽取输出标引词//////////////////////////////
Dim cn2 As New ADODB.Connection
Set cn2 = New ADODB.Connection
cn2.Provider = "microsoft.jet.oledb.4.0"
cn2.open App.Path & "\data.mdb"
Dim rs2 As ADODB.Recordset
Set rs2 = New ADODB.Recordset
Dim sql3 As String
sql3 = "select 叙词 from 叙词表 order by 综合权值 DESC"
rs2.open sql3, cn2, 2, 3
ii = 0
Do Until rs2.EOF
txtkeyword.Text = txtkeyword.Text & rs2.Fields(0) & " "
ii = ii + 1
rs2.MoveNext
If ii = 3 Then
Exit Do
End If
Loop
rs2.Close
'//////////////////////////叙词表综合权值赋为0////////////////////////////
Dim sql4 As String
sql4 = "select 综合权值 from 叙词表"
rs2.open sql4, cn2, 2, 3
While Not rs2.EOF
rs2.Fields(0) = 0
rs2.Update
rs2.MoveNext
Wend
If txtkeyword.Text <> "" Then
work.Enabled = False
save.Enabled = True
End If
rs2.Close
Set rs2 = Nothing
cn2.Close
Set cn2 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -