'需求:
'1把ListBox里的文件,用Ftp方式上传到服务器.
'2上传时会创建独立的文件夹,方便日后管理
'3如果遇到重复的,要能提示是否覆盖
'思路:
'1以系统ID为前缀,为文件创建一个独立的文件夹
'2上传时检测该文件夹下是否存在同名的文件,提示是否覆盖
'3上传前把文件拷贝到本地路径,因为只读路径会因为不能创建缓存而上传失败
'4上传后,把本地缓存文件删除
'5更新行的附件清单
Dim LB As WinForm.ListBox = e.Form.Controls("ListBox_DocUpload")
Dim r As Row = Tables("ItemInfo").Current
If r IsNot Nothing Then
If r.Isnull("ItemID") =False Then '判断ID存在,因为要用这个创立独立文件夹
If lb.Items.Count > 0 Then '获取已经存在的附件清单,待会要追加内容
Dim FileList As List(of String) = r.DataRow.Lines("ItemDoc")
MHPicFtp.Close '为了防止之前的FTP错误没退出,使用FTP前先关闭一次
For i As Integer = 0 To LB.Items.Count - 1 '获取ListBox里所有要上传的内容
Dim name As String = LB.Items(i)
Dim LastG As Integer = name.LastIndexOf("\")
Dim LastD As Integer = name.LastIndexOf(".")
If LastD <> -1 Then
Dim FileName As String = name.SubString(LastG+1,(lastD -LastG-1)) '获取文件名,例如 财务报表
Dim HZ As String = name.SubString(lastD) '获取文件后缀,例如 .xls
'服务器端创建独立文件夹---
Dim SavePath As String ="【" & r.DataRow.DataTable.Name & "】\【" & r.DataRow.DataTable.Name & "-" & r("ItemID") & "】" '例如 【ItemInfo】\【ItemInfo-5】
QQClient.Send(":FTPNew" & SavePath & "FTPNew:")
Dim UploadPath As String = "\" & SavePath & "\" & FileName & HZ '设置上传后的存储路径,例如 \【ItemInfo】\【ItemInfo-5】\财务报表.xls
'服务器端创建独立文件夹---
Dim Send As Boolean = True '新建一个Boolean变量判断是否存在同名文件
If FileList.Contains(UploadPath) Then
If MessageBox.show("已存在重复的文件【" & FileName & "】,是否要覆盖?","提示",MessageBoxButtons.YesNo,MessageBoxIcon.Warning) = DialogResult.No Then
Send = False
End If
End If
If Send = True Then
'把文件拷贝到本地目录,因为上传只读权限的电脑里的文件时,会I/O无法读取而强制退出----
Dim TempFile As String =ProjectPath & "Temp\" & FileName & HZ
FileSys.CopyFile(LB.Items(i),TempFile,True)
'把文件拷贝到本地目录,因为上传只读权限的电脑里的文件时,会I/O无法读取而强制退出----
If MHPicFtp.Upload(TempFile,UploadPath,True) Then '上传该文件,成功的话就返回True.然后我们更新一下附件清单
If FileList.Contains(UploadPath) =False Then
FileList.Add(UploadPath)
End If
End If
'上传结束后删掉---
If FileSys.FileExists(TempFile) Then
FileSys.DeleteFile(TempFile,2,3)
End If
'上传结束后删掉---
End If
End If
Next
MHPicFtp.Close 'FTP用完就关闭,是个好习惯
r.DataRow.Lines("ItemDoc") =FileList
r.save
lb.Items.Clear
Else
MessageBox.show("请先把要上传的文件拖到框内")
End If
Else
MessageBox.show("系统编号不能为空")
End If
Else
MessageBox.show("请先选择行")
End If
加好友 
发短信
Post By：2019/1/14 10:26:00 [显示全部帖子]
此主题相关图片如下：1.png