|
一、 引言
对于工程项目管理来说，工程文件资料管理是其中一项重要的工作，其保密性也是一项至关重要的内容。好的资料管理能显著提高工程建设过程中资料审查的工作效率，电子文件能否很好地得到存取也是保密所需要考虑的内容。
二、 实现思路
为能更好地做好文件资料的管理，采用以下几点原则：
1.考虑各工作站大多都安装了Office2000以上版本的软件，采用Access数据库来存取文件。
2.采用流对象保存和显示各类文件，同一类的内容可以作为一个压缩文件保存到数据库的一条记录里，在数据库的表里采用长二进制的形式用一个OLE对象字段类型来保存文件内容，并对每个归档文件按类别进行编号保存。
3.读取文件时采用调用一个自定义的打开文件函数shellfile()的形式完成。在打开文件时考虑文件是否在临时目录里已经存在，避免程序代码出现错误。
4.考虑程序的通用性，可由用户指定其原始文件的存放路径，程序按用户指定的路径来进行文件读取。设定一个临时文件夹d:\lzzl在读取并打开文件时临时存放，在关闭打开的文件时，清空此文件夹下的所有文件。
三、 程序设计
向数据库里写文件的界面如图1所示。
图1
界面采用常用的一些控件，在程序里以字符串形式定义了其与数据库的连接。读取文件的界面设计如图2所示。
图2
通过有条件的查询，得到想要的结果，在“list”控件里显示查询的结果文件名称，在datagrid控件里显示查询到的记录信息。选中list里的结果，再操作“打开文件”按钮来调用函数完成打开数据库里的文件的过程。
四、 文件存取
1.文件写入数据库的实例
Dim cn0 As ADODB.Connection '定义连接
Dim rs0 As ADODB.Recordset '定义记录集
Dim strcn0 As String
Private Sub Combo1_LostFocus()
If Combo1.Text = "综合" Then Text1 = "2972901"
If Combo1.Text = "酸轧" Then Text1 = "2972902"
If Combo1.Text = "连退" Then Text1 = "2972903"
If Combo1.Text = "热镀锌1" Then Text1 = "2972904"
If Combo1.Text = "热镀锌2" Then Text1 = "2972905"
If Combo1.Text = "彩涂" Then Text1 = "2972906"
If Combo1.Text = "精整" Then Text1 = "2972907"
If Combo1.Text = "其它" Then Text1 = "2972908"
Combo2.Enabled = True
End Sub
If Combo2.Text = "综合类" Then Text1 = Text1 & "01"
If Combo2.Text = "总图、运输" Then Text1 = Text1 & "02"
If Combo2.Text = "工艺" Then Text1 = Text1 & "03"
If Combo2.Text = "土建" Then Text1 = Text1 & "04"
If Combo2.Text = "给排水" Then Text1 = Text1 & "05"
If Combo2.Text = "采暖、通风" Then Text1 = Text1 & "06"
If Combo2.Text = "热力燃气" Then Text1 = Text1 & "07"
If Combo2.Text = "计控、电讯" Then Text1 = Text1 & "08"
If Combo2.Text = "供电、电气" Then Text1 = Text1 & "09"
If Combo2.Text = "设备、设备安装" Then Text1 = Text1 & "10"
If Combo2.Text = "其它专业" Then Text1 = Text1 & "11"
Combo2.Enabled = False
Dim a1, a2 As String
a2 = "000"
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 资料信息 " & _
"WHERE 文件编号 like '%" & Trim(Text1) & "%' order by 文件编号", strcn0, , , adCmdText '选择条件
Do While Not rs0.EOF
a1 = Mid(rs0!文件编号, 10, 3)
If a2 <= a1 Then a2 = a1
rs0.MoveNext
Loop
rs0.Close
Dim s1 As String
If a2 + 1 < 10 Then s1 = "00" & a2 + 1
If a2 + 1 >= 10 And a2 + 1 < 100 Then s1 = "0" & a2 + 1
If a2 + 1 >= 100 And a2 + 1 < 1000 Then s1 = a2 + 1
Text1 = Mid(Text1, 1, 9) & s1
End Sub
Private Sub Command1_Click()
If Trim(Text1) = "" Then
MsgBox "此文件编号不允许为空！", vbOKOnly + vbCritical, "警告"
Exit Sub
End If
'查看此文件是否存在
If Trim(Text5) <> "" Then
Dim astr As String
astr = Dir(Text5 & Text4)
If astr = "" Then
MsgBox "此文件不在指定的文件夹里，请核对！", vbOKOnly, "提示"
Exit Sub
End If
End If
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 资料信息 " & _
"WHERE 文件编号='" & Trim(Text1) & "' ", strcn0, , , adCmdText '选择条件
If rs0.EOF Then
rs0.AddNew
rs0!工程项目名 = Trim(Combo1)
rs0!基建档案类名 = Trim(Combo2)
rs0!文件编号 = Trim(Text1)
rs0!收件人 = Trim(Text2)
rs0!发件人 = Trim(Text3)
rs0!资料名 = Trim(Text4)
rs0!存放路径 = Trim(Text5)
rs0!文件说明 = Trim(Text6)
rs0!文本归档位置 = Trim(Text7)
rs0!收到时间 = Format(DTPicker0, "yyyy-mm-dd")
rs0!转交时间 = Format(DTPicker1, "yyyy-mm-dd")
rs0!归档时间 = Format(DTPicker2, "yyyy-mm-dd")
rs0!归档人 = Trim(Text11)
rs0!拟定密级 = Trim(Combo3)
rs0.UpdateBatch
rs0.Close
'写文件到数据库字段wj
If Trim(Text4) <> "" And Trim(Text5) <> "" Then
Dim iStm As ADODB.Stream
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile Text5 & Text4
End With
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 资料信息 WHERE 文件编号='" & Trim(Text1) & "' ", strcn0, , , adCmdText '选择条件
rs0!wj = iStm.Read
rs0.UpdateBatch
rs0.Close
'完成后关闭对象
iStm.Close
'删除原文件
Kill Text5 & Text4
End If
MsgBox "此文件编号归档保存完成！", vbOKOnly, "提示"
Else
MsgBox "此文件编号已经存在，请核对后处理！", vbOKOnly + vbCritical, "提示"
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And Not (TypeOf Me.ActiveControl Is Command) Then
SendKeys "{TAB}"
End If
If KeyCode = vbKeyEscape Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Set cn0 = New ADODB.Connection
'连接信息赋予字符串
strcn0 = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=" & App.Path & "\datebase.mdb"
Catalog=" & App.Path & "\DateBase"
cn0.Open strcn0
Set rs0 = New ADODB.Recordset
Set rs0.ActiveConnection = cn0
rs0.CursorType = adOpenKeyset
rs0.LockType = adLockBatchOptimistic
Text11.Text = name1
DTPicker1.Value = Now
DTPicker2.Value = Now
DTPicker0.Value = Now
End Sub
2.从数据库里读取文件并浏览的过程实例
Dim cn0 As ADODB.Connection '定义连接
Dim rs0, Rs1 As ADODB.Recordset '定义记录集
Dim strcn0, str1 As String
Dim a0 As String '记录打开的文件
Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
If Trim(Text1) <> "" Then str1 = "SELECT * FROM 资料信息 where 资料名 like '%" & Trim(Text1) & "%' "
If Trim(Text2) <> "" Then
If str1 <> "" Then
str1 = str1 & " and 文件编号 like '%" & Text2 & "%' "
Else
str1 = "SELECT * FROM 资料信息 where 文件编号 like '%" & Text2 & "%' "
End If
End If
If Trim(Text3) <> "" Then
If str1 <> "" Then
str1 = str1 & " and 文件说明 like '%" & Text3 & "%' "
Else
str1 = "SELECT * FROM 资料信息 where 文件说明 like '%" & Text3 & "%' "
End If
End If
If str1 = "" Then str1 = " SELECT * FROM 资料信息 "
If rs0.State = adStateOpen Then rs0.Close
rs0.Open str1, strcn0, , , adCmdText '选择条件
If Not rs0.EOF Then
rs0.MoveFirst
List1.Clear
Do While Not rs0.EOF
If Not IsNull(rs0!存放路径) And rs0!存放路径 <> "" Then
List1.AddItem rs0!存放路径 & rs0!资料名
End If
rs0.MoveNext
Loop
Set DataGrid1.DataSource = rs0
Else
MsgBox "没有满足要求的文件资料！", vbOKOnly, "提示"
Exit Sub
End If
End Sub
Private Sub Command2_Click()
If List1.Text <> "" Then
'读取数据库里的字段wj里的文件
Dim iStm As ADODB.Stream
'得到最新添加的纪录
If Rs1.State = adStateOpen Then Rs1.Close
Rs1.Open str1, strcn0, adOpenKeyset, adLockReadOnly
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write Rs1!wj
'这里注意了,如果当前目录下存在此文件,会报一个文件写入失败的错误.
Dim astr As String
astr = Dir("d:\lzzl\*.*")
If astr <> "" Then Kill "d:\lzzl\*.*"
.SaveToFile List1.Text
End With
iStm.Close
Call Shellfile(List1.Text) 'rs0!存放路径 & rs0!资料名)
Rs1.Close
Else
MsgBox "请注意！您没有选择需要打开的文件！", vbOKOnly + vbCritical, "提示"
End If
End Sub
Private Sub Form_Load()
Set cn0 = New ADODB.Connection
strcn0 = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=lzzl;Initial Catalog=" & App.Path & "\DateBase"
cn0.Open strcn0
Set rs0 = New ADODB.Recordset
Set rs0.ActiveConnection = cn0
rs0.CursorType = adOpenKeyset
rs0.LockType = adLockBatchOptimistic
Set Rs1 = New ADODB.Recordset
Set Rs1.ActiveConnection = cn0
Rs1.CursorType = adOpenKeyset
Rs1.LockType = adLockBatchOptimistic
End Sub
Function Shellfile(strFile As String)
Const SE_ERR_NOASSOC = 31
Dim lngRet As Long
lngRet = ShellExecuteA(0&, "open", strFile, vbNullString, vbNullString, vbNormalFocus)
If lngRet = SE_ERR_NOASSOC Then
'显示打开方式窗口
CallShellExecuteA(0&,vbNullString,"RUNDLL32.EXE","shell32.dll,OpenAs_RunDLL " _
& strFile, vbNullString, vbNormalFocus)
End If
MsgBox "浏览完此文件请及时关闭文件，然后再点此确定按钮！", vbOKOnly, "提示"
End Function
Private Sub Form_Unload(Cancel As Integer)
Dim astr As String
astr = Dir("d:\lzzl\*.*")’d:\lzzl是临时文件夹
If astr <> "" Then Kill "d:\lzzl\*.*"
End Sub
这里只是列出了关键控件的执行代码，读者自己根据实际情况来补充完善。
五、结语
本程序代码在中文版VB6、Access 2003及WindowsXP SP2环境下测试通过，在冷轧工程资料管理中得到实际应用，并在一定程度上提高了文件保密的安全性。
|
