mftpx.ocx是一个不错的控件，只是不支持中文的路径和空格，比较让人恼火。
最后只能通过其他的手段来弥补他的这个不足。 首先当然要引用MFTPX.OCX 。 代码如下：   Private Declare Function ShellExecute()Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (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
 Const SW_SHOWNORMAL = 1
Dim fso As Scripting.FileSystemObject
Dim tmpFolder As String
Dim tmpFile_ As String
Dim tmpFullFile As String
  Private Sub Check1_Click()Sub Check1_Click()
If Check1.Value = 0 Then
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Else
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End If
 End Sub
'连接ftp
Private Sub Command1_Click()Sub Command1_Click()
mFtp1.Host = "192.168.31.189"
mFtp1.Port = "8088"
mFtp1.Connect "wy", "wy"
End Sub
'选择文件
Private Sub Command2_Click()Sub Command2_Click()
If Check1.Value = 1 Then Exit Sub
cd1.Filter = "word文件(*.doc)|*.doc|autocad图纸(*.dwg)|*.dwg|所有文件(*.*)|*.*"
cd1.DialogTitle = "选择要上传的文件"
cd1.ShowOpen
If cd1.FileName <> "" Then
Text1.Text = cd1.FileName
tmpFile = createFileName(cd1.FileTitle) & "." & Mid(cd1.FileTitle, InStr(cd1.FileTitle, ".") + 1)
tmpFullFile = tmpFolder & "" & tmpFile
fso.CopyFile cd1.FileName, tmpFullFile
End If
End Sub
'上传
Private Sub Command3_Click()Sub Command3_Click()
On Error GoTo errEnd
If Check1.Value = 1 Then Exit Sub
If mFtp1.State = 0 Then
Command1_Click
End If
If mFtp1.State = 1 Then
If InStr(cd1.FileTitle, ".") > 0 Then
Dim myName As String
pbar.Caption = "正在上传……"
pbar.Visible = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
mFtp1.PutFile tmpFullFile, tmpFile
appendFile tmpFile, cd1.FileTitle
fso.DeleteFile tmpFullFile
Text1.Text = ""
pbar.Caption = ""
pbar.Visible = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
End If
End If
Exit Sub
errEnd:
pbar.Caption = ""
pbar.Visible = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
MsgBox "出错了，错误提示：" & Err.Description
End Sub
'处理
Private Sub appendFile()Sub appendFile(ByVal newFileName As String, ByVal oldFileName As String)
Dim lstItem As ListItem
Set lstItem = ListView1.ListItems.Add(, , newFileName)
lstItem.SubItems(1) = oldFileName
lstItem.SubItems(2) = Now
End Sub
'构造文件名
Private Function createFileName()Function createFileName(ByVal str As String) As String
Dim newStr As String
newStr = ""
If str <> "" Then
newStr = CStr(Year(Date)) & fillCode(CStr(Month(Date)), 2) & fillCode(CStr(Day(Date)), 2) & fillCode(CStr(Hour(Time)), 2) & fillCode(CStr(Minute(Time)), 2) & fillCode(CStr(Second(Time)), 2)
newStr = newStr & CStr(CInt(Round(1000 * Rnd(Minute(Time) & Second(Time)))))
End If
createFileName = newStr
End Function
'给字符串前加 0 补码
Private Function fillCode()Function fillCode(ByVal str As String, ByVal fLen As Long) As String
fillCode = Mid(CStr(10 ^ (fLen - Len(str))), 2) & str
End Function
'删除
Private Sub Command4_Click()Sub Command4_Click()
If Check1.Value = 1 Then Exit Sub
If mFtp1.State = 0 Then
Command1_Click
End If
If mFtp1.State = 1 Then
If ListView1.ListItems.Count > 0 Then
If ListView1.SelectedItem <> "" Then
mFtp1.Delete ListView1.SelectedItem.Text
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End If
End If
End Sub
'打开文件
Private Sub Command5_Click()Sub Command5_Click()
If mFtp1.State = 0 Then
Command1_Click
End If
If mFtp1.State = 1 Then
If ListView1.ListItems.Count > 0 Then
If ListView1.SelectedItem <> "" Then
Dim myName As String
myName = tmpFolder & "" & ListView1.SelectedItem.SubItems(1)
If Not fso.FileExists(myName) Then
pbar.Caption = "正在下载……"
pbar.Visible = True
If Check1.Value = 0 Then
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
End If
mFtp1.GetFile ListView1.SelectedItem.Text, tmpFolder & "" & ListView1.SelectedItem.Text
fso.CopyFile tmpFolder & "" & ListView1.SelectedItem.Text, myName
fso.DeleteFile tmpFolder & "" & ListView1.SelectedItem.Text
End If
ShellExecute hwnd, "open", myName, vbNullString, vbNullString, 1
Text1.Text = ""
pbar.Caption = ""
pbar.Visible = False
If Check1.Value = 0 Then
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
End If
End If
End If
End If
End Sub
'装载表单
Private Sub Form_Load()Sub Form_Load()
Set fso = New Scripting.FileSystemObject
tmpFolder = "c:Northsnow070101"
If Not fso.FolderExists(tmpFolder) Then
fso.CreateFolder tmpFolder
End If
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add 1, "newfile", "NewFileName", ListView1.Width / 3, 0
ListView1.ColumnHeaders.Add 2, "oldfile", "OldFileName", ListView1.Width / 3, 0
ListView1.ColumnHeaders.Add 3, "udate", "UploadDate", ListView1.Width / 3, 0
ListView1.GridLines = True
ListView1.FullRowSelect = True
ListView1.LabelEdit = lvwManual
ListView1.MultiSelect = False
pbar.Visible = False
pbar.Caption = ""
End Sub
Private Sub Form_Unload()Sub Form_Unload(Cancel As Integer)
If fso.FolderExists(tmpFolder) Then
fso.DeleteFolder tmpFolder, True
End If
Set fso = Nothing
End Sub
运行界面： 请输入大于5个字符的标题 
本文来源：http://blog.csdn.net/precipitant/archive/2007/07/17/1694414.aspx
|
站内文章搜索
