📄 词库合并.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1
Caption = "海鹰词库编辑(注意词库格式)"
ClientHeight = 4305
ClientLeft = 60
ClientTop = 450
ClientWidth = 5790
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 4305
ScaleWidth = 5790
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Height = 2535
Left = 120
TabIndex = 3
Top = 1680
Width = 5535
Begin VB.CommandButton Command5
Caption = "dat词库转txt（仅支持Unicode格式,从Seek=0处开始）"
Height = 495
Left = 120
TabIndex = 5
Top = 1200
Width = 5295
End
Begin VB.CommandButton Command3
Caption = "dat词库转txt（仅支持Unicode格式,特征为“FFFFFFFF”）"
Height = 495
Left = 120
TabIndex = 4
Top = 600
Width = 5295
End
End
Begin VB.CommandButton Command4
Caption = "Exit"
Height = 495
Left = 4320
TabIndex = 2
Top = 240
Width = 735
End
Begin VB.CommandButton Command2
Caption = "重码过滤（仅支持ANSI格式）"
Height = 495
Left = 120
TabIndex = 1
Top = 840
Width = 3495
End
Begin VB.CommandButton Command1
Caption = "合并词库（仅支持ANSI格式）"
Height = 495
Left = 120
TabIndex = 0
Top = 240
Width = 3495
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 720
Top = 240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo End1
Dim File1 As String
Dim File2 As String
Dim File3 As String
Dim data1 As String
Dim data(0 To 999, 0 To 999, 0 To 3) As String
Dim i As Long, j As Long, k As Long, l As Long, seeki As Long
i = 0
j = 0
k = 0
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.txt|*.txt"
CommonDialog1.DialogTitle = "打开第一词库"
CommonDialog1.ShowOpen
File1 = CommonDialog1.FileName
CommonDialog1.DialogTitle = "打开第二词库"
CommonDialog1.ShowOpen
File2 = CommonDialog1.FileName
CommonDialog1.DialogTitle = "新词库（忽略相同部分）保存路径设置"
CommonDialog1.ShowSave
File3 = CommonDialog1.FileName
Open File1 For Input As #1
Do While Not EOF(1)
i = i + 1
If i > 999 Then
j = j + 1
i = i - 1000
End If
If j > 999 Then
j = j - 1000
k = k + 1
End If
Input #1, data(i, j, k)
Loop
Close
seeki = k * 1000000 + j * 1000 + i
Open File2 For Input As #2
Open File3 For Output As #3
Do While Not EOF(2)
Input #2, data1
i = 0
j = 0
k = 0
For l = 0 To seeki
i = i + 1
If i > 999 Then
j = j + 1
i = i - 1000
End If
If j > 999 Then
j = j - 1000
k = k + 1
End If
If data1 = data(i, j, k) Then Exit For
Next
If l - 1 = seeki Then
Print #3, data1
Me.Caption = data1
DoEvents
End If
Loop
Close
MsgBox "Done"
Exit Sub
End1:
Close
MsgBox Error
End Sub
Private Sub Command2_Click()
On Error GoTo End2
Dim File1 As String
Dim File2 As String
Dim data1 As String
Dim data(0 To 999, 0 To 999, 0 To 3) As String
Dim i As Long, j As Long, k As Long, l As Long, seeki As Long
Dim ii As Long, jj As Long, kk As Long, ll As Long, sameNum As Long
i = 0
j = 0
k = 0
sameNum = 0
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.txt|*.txt"
CommonDialog1.DialogTitle = "打开词库"
CommonDialog1.ShowOpen
File1 = CommonDialog1.FileName
CommonDialog1.DialogTitle = "新词库保存路径设置"
CommonDialog1.ShowSave
File2 = CommonDialog1.FileName
Open File1 For Input As #1
Do While Not EOF(1)
i = i + 1
If i > 999 Then
j = j + 1
i = i - 1000
End If
If j > 999 Then
j = j - 1000
k = k + 1
End If
Input #1, data(i, j, k)
Loop
Close
seeki = k * 1000000 + j * 1000 + i
i = 0
j = 0
k = 0
For l = 0 To seeki
i = i + 1
If i > 999 Then
j = j + 1
If j > 999 Then
j = j - 1000
k = k + 1
End If
i = i - 1000
Me.Caption = l & "/" & seeki
DoEvents
End If
ii = i
jj = j
kk = k
data1 = data(i, j, k)
If data1 <> "" Then
For ll = l To seeki
ii = ii + 1
If ii > 999 Then
jj = jj + 1
If jj > 999 Then
jj = jj - 1000
kk = kk + 1
End If
ii = ii - 1000
End If
If data(ii, jj, kk) = data1 Then
data(ii, jj, kk) = ""
sameNum = sameNum + 1
End If
Next
End If
Next
Open File2 For Output As #2
i = 0
j = 0
k = 0
For l = 0 To seeki
i = i + 1
If i > 999 Then
j = j + 1
If j > 999 Then
j = j - 1000
k = k + 1
End If
i = i - 1000
End If
data1 = data(i, j, k)
If data1 <> "" Then Print #2, data1
Next
Close
MsgBox "Done" & Chr(13) & Chr(10) & "Total DataLine= " & seeki & " sameNumber= " & sameNum
Exit Sub
End2:
Close
MsgBox Error
End Sub
Private Sub Command3_Click() '本命令处理格式为“0100 6100 0100 E55D 02006100610001000F5F03006100610061000100E55D0400...”地词库数据，即以Unicode格式为基础，Int类型地数据，格式为：词库编码长度+词库编码+词条长度+词条。判别标志为“FFFFFFFF”
'On Error GoTo End3
Dim File1 As String
Dim File2 As String
Dim data1 As Integer, data2 As Integer, i As Integer
Dim Enter As Long, Space As Integer
Dim data(1 To 2, 1 To 33) As Integer
Dim filezise As Long
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.MB|*.mb|*.*|*.*"
CommonDialog1.DialogTitle = "打开词库"
CommonDialog1.ShowOpen
File1 = CommonDialog1.FileName
CommonDialog1.DialogTitle = "新词库保存路径设置"
CommonDialog1.ShowSave
File2 = CommonDialog1.FileName
data1 = -257
Enter = 655373
Space = 32
filesise = FileLen(File1)
Open File1 For Binary As #1
Do While Seek(1) < filesise
Get 1, , data1
If data1 = -1 Then
Get 1, , data1
If data1 = -1 Then
Me.Caption = "Star"
DoEvents
Open File2 For Binary As #2
Put 2, , data1
Do While Seek(1) < filesise
Get 1, , data1
For i = 1 To data1
Get 1, , data(1, i)
Next
Get 1, , data2
For i = 1 To data2
Get 1, , data(2, i)
Next
For i = 1 To data2
Put 2, , data(2, i)
Next
Put 2, , Space
For i = 1 To data1
Put 2, , data(1, i)
Next
Put 2, , Enter
Me.Caption = Seek(1) & " / " & filesise
DoEvents
Loop
Close #2
MsgBox "Done"
End If
End If
Loop
Close
Exit Sub
End3:
Close
MsgBox Error
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click() '对于无法通过标志数据判断词库起始位置地情况，可用UltraEdit截取出来，再用本命令处理
'On Error GoTo End4
Dim File1 As String
Dim File2 As String
Dim data1 As Integer, data2 As Integer, i As Integer
Dim Enter As Long, Space As Integer
Dim data(1 To 2, 1 To 33) As Integer
Dim filezise As Long
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.MB|*.mb|*.*|*.*"
CommonDialog1.DialogTitle = "打开词库"
CommonDialog1.ShowOpen
File1 = CommonDialog1.FileName
CommonDialog1.DialogTitle = "新词库保存路径设置"
CommonDialog1.ShowSave
File2 = CommonDialog1.FileName
data1 = -257
Enter = 655373
Space = 32
filesise = FileLen(File1)
Open File1 For Binary As #1
Open File2 For Binary As #2
Put 2, , data1
Do While Seek(1) < filesise
Get 1, , data1
For i = 1 To data1
Get 1, , data(1, i)
Next
Get 1, , data2
For i = 1 To data2
Get 1, , data(2, i)
Next
For i = 1 To data2
Put 2, , data(2, i)
Next
Put 2, , Space
For i = 1 To data1
Put 2, , data(1, i)
Next
Put 2, , Enter
Me.Caption = Seek(1) & " / " & filesise
DoEvents
Loop
Close #2
MsgBox "Done"
Close
Exit Sub
End4:
Close
MsgBox Error
End Sub
Private Sub Command6_Click()
MsgBox ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -