最近做的一个项目客户需要存储一些附件,本想使用系统内置的FTP功能,但需要在服务器搭建FTP服务,还需要写代码来管理上传的文件,用系统自身带的FTP管理不能有效的管理各自的文件,故放弃使用FTP功能。前几天在论坛求助请狐爸给个关于二进制存储文件的例子,没有想到马上就出来了,欣喜
,狐爸的效率还是很高的,在此代表狐友赞一个
昨天晚上研究9.22版本关于二进制存储的例子,发现同一行的一个字段只能存储一个文件,而我可能需要存储多个文件,而且文件类型不定,所以用同一行数据来存储多个文件是不可能实现 的,所以考虑到使用一个子表专门来存储附件信息动态添加、删除,通过主键关联附件。
因为项目是用的SQL,涉及客户数据,所以不方便将项目上传,现将实现方法,及代码,通过图文的形式上传论坛共享,希望对此部分有需求的狐友有所帮助。高手请绕道、勿喷!有更好的方法请大家跟帖,共同改进!
资产主表与资产附件表通过资产内码关联。
效果图:
此主题相关图片如下:qq截图20140922094133.png
附件列表是通过 LISTBOX实现
附件数据结构:
此主题相关图片如下:1.png
LISTBOX图片预览:
此主题相关图片如下:2.png
代码 :
'Dim s As String = e.Sender.Items
'MessageBox.Show(e.Sender.SelectedItem)
Dim pbx As WinForm.PictureBox = Forms("资产增加").Controls("PictureBox1")
If e.Sender.ComboList = ""
Return
End If
If Tables("资产主表").Current Is Nothing Then
pbx.Image = Nothing
Else
' 判断选择的是不是 图片格式,如果不是 则不执行代码
Dim dt As DataRow = DataTables("资产附件").Find("附件名称='" & e.Sender.SelectedItem & "' and 资产内码='" & Tables("资产主表").Current("资产内码") & "'")
If dt IsNot Nothing '必须要判断不然 报错
Dim nm() As String = e.Sender.SelectedItem.split(".")
Dim tpjh As String = "bmp,jpg,png,gif"
If tpjh.Contains(nm(nm.Length-1)) Then '如果是图片格式则显示
pbx.Image = dt.SQlLoadImage("附件内容") '从后台提取照片并显示
Else
pbx.Image = Nothing
End If
End If
End If
主表显示附件列表 代码:
此主题相关图片如下:3.png
增加附件代码:
If Tables("资产主表").Current Is Nothing Then
Return
End If
If Tables("资产主表").Current.Locked = True
MessageBox.Show("请点击修改资产后再执行本操作!~","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Return
End If
Dim dr As DataRow = Tables("资产主表").Current.DataRow
Dim dlg As New OpenFileDialog
dlg.Filter = "图形文件|*.*"
If dlg.ShowDialog = DialogResult.OK Then
Dim fj As DataRow =DataTables("资产附件").AddNew
fj("资产内码")= dr("资产内码")
Dim mc() As String = dlg.FileName.Split("\")
fj("附件名称")=mc(mc.Length-1)
Dim s() As String = dlg.FileName.Split(".") '获取扩展名,防止文件名中含有.?这样可以取最后一个数组内容加.获取扩展名
fj("扩展名")= "." & s(s.Length-1)
DataTables("资产附件").save
fj.SQLInsertFile("附件内容",dlg.FileName) '插入文件
End If
'刷新列表
Dim lbx As WinForm.ListBox = Forms("资产增加").Controls("ListBox1")
lbx.ComboList = DataTables("资产附件").GetComboListString("附件名称","资产内码='" & Tables("资产主表").Current("资产内码") & "'")
删除附件代码:
If Tables("资产主表").Current Is Nothing Then
Return
End If
If Tables("资产主表").Current.Locked = True
MessageBox.Show("请点击修改资产后再执行本操作!~","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Return
End If
Dim lbx As WinForm.ListBox = e.Form.Controls("ListBox1")
If MessageBox.Show("确认删除附件:" & lbx.SelectedItem & "吗?","删除提示",MessageBoxButtons.YesNo,MessageBoxIcon.Question)=6 Then
DataTables("资产附件").SQLDeleteFor("资产内码='" & Tables("资产主表").Current("资产内码") & "' and 附件名称='" & lbx.SelectedItem & "'")
MessageBox.Show("删除成功!","删除提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If
''刷新列表
lbx.ComboList = DataTables("资产附件").SQLGetComboListString("附件名称","资产内码='" & Tables("资产主表").Current("资产内码") & "'")
打开附件代码:
If Tables("资产主表").Current Is Nothing Then
Return
End If
Dim lbx As WinForm.ListBox = e.Form.Controls("ListBox1")
If lbx.SelectedItem Is Nothing
MessageBox.Show("请先选择要打开的附件再执行本操作!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Return
End If
Dim dr As DataRow = DataTables("资产附件").Find("附件名称='" & lbx.SelectedItem & "' and 资产内码='" & Tables("资产主表").Current("资产内码") & "'")
Dim fl As String = ProjectPath & lbx.SelectedItem
If dr.SQLLoadFile("附件内容",fl) Then '如果提取文件成功
Dim Proc As New Process '打开文件
Proc.File = fl
Proc.Start()
Else
Messagebox.Show("附件提取失败,可能并不存在附件!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
[此贴子已经被作者于2014-9-22 10:14:29编辑过]