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 = 1Dim fso As Scripting.FileSystemObjectDim tmpFolder As StringDim tmpFile_ As StringDim 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'连接ftpPrivate 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 SuberrEnd: pbar.Caption = "" pbar.Visible = False Command1.Enabled = True Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True MsgBox "出错了，错误提示：" & Err.DescriptionEnd 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) = NowEnd 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 = newStrEnd 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) & strEnd 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 IfEnd 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 IfEnd 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 SubPrivate Sub Form_Unload()Sub Form_Unload(Cancel As Integer) If fso.FolderExists(tmpFolder) Then fso.DeleteFolder tmpFolder, True End If Set fso = NothingEnd Sub
运行界面：
请输入大于5个字符的标题
