VB+MFTPX.OCX访问ftp服务器的小例子

el/2024/4/20 15:38:24

  mftpx.ocx是一个不错的控件,只是不支持中文的路径和空格,比较让人恼火。最后只能通过其他的手段来弥补他的这个不足。 

  首先当然要引用MFTPX.OCX 。

  代码如下:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongByVal lpOperation As StringByVal lpFile As StringByVal lpParameters As StringByVal lpDirectory As StringByVal nShowCmd As LongAs 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()
 
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()
   mFtp1.Host 
= "192.168.31.189"
   mFtp1.Port 
= "8088"
   mFtp1.Connect 
"wy""wy"
End Sub


'选择文件
Private 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()
   
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(ByVal newFileName As StringByVal 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(ByVal str As StringAs 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(ByVal str As StringByVal fLen As LongAs String
    fillCode 
= Mid(CStr(10 ^ (fLen - Len(str))), 2& str
End Function


'删除
Private 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()
   
   
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()
   
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 / 30
   ListView1.ColumnHeaders.Add 
2"oldfile""OldFileName", ListView1.Width / 30
   ListView1.ColumnHeaders.Add 
3"udate""UploadDate", ListView1.Width / 30
   ListView1.GridLines 
= True
   ListView1.FullRowSelect 
= True
   ListView1.LabelEdit 
= lvwManual
   ListView1.MultiSelect 
= False
   pbar.Visible 
= False
   pbar.Caption 
= ""
End Sub


Private Sub Form_Unload(Cancel As Integer)
   
If fso.FolderExists(tmpFolder) Then
     fso.DeleteFolder tmpFolder, 
True
   
End If
   
Set fso = Nothing
End Sub



 

运行界面:

请输入大于5个字符的标题


http://www.ngui.cc/el/1460881.html

相关文章

C#中导出数据到EXCEL的简单例子

这几天没事在网上闲逛的时候看到类似的代码&#xff0c;花了点时间测试了一下。觉得不错。简单的整理一下。 在项目中需要引用&#xff1a;COM&#xff1a;Microsoft Office 11.0 Object Library COM&#xff1a;Microsoft Excel 11.0 Object Library 简单封装的代码类&#…

vb.net 开发 excel Addin学习(1)---- 准备

安装 vs.net2005 安装 microsoft visual studio 2005 tools for office runtime microsoft visual studio 2005 tools for office runtime language pack 安装office2003 sp2 .net 支持 创建一个项目 .net 中新建一个 其他项目类型 &#xff0d;…

Pl/SQL中的SPLIT函数

据我了解&#xff0c;PL/SQL 中没有split函数&#xff0c;需要自己写。 代码&#xff1a; createorreplacetype type_split astableofvarchar2(50); --创建一个  type  &#xff0c;如果为了使split函数具有通用性&#xff0c;请将其size 设大些。--创建functioncreateorr…

Pl/SQL中的数组

pl/sql中实现数组的应用也很简单。 下面是一个简单的例子&#xff1a; createorreplaceprocedurearray_test isTYPE type_arrry ISTABLEOFVARCHAR2(50); --array type_arrry:type_arrry(null,null);array type_arrry:type_arrry(); i integer:0;beginarray.extend(10); ar…

Oracle中 Alter Table 语句的使用

alter table 的功能是修改表格。包括重名命&#xff0c;加减字段,修改字段类型和大小&#xff0c;处理 约束等等。本例子之处理表名和字段&#xff0c;代码如下&#xff1a; createtableliu(a varchar2(20),b number(2))altertableliu rename tojinrename jin tocaialtertablec…

oracle中猜分字符串成多个字段

有一个数据表&#xff0c;其中的一个字段比较长&#xff0c;是由多个属性组成&#xff0c;例如&#xff1a; SQL>selectcode_string,项目名称,code_value fromcode_standard;CODE_STRING 项目名称 CODE_VALUE-------------------- ---------…

vb.net 开发 excel Addin学习(2)---- 工具栏 和 菜单

做excel插件开发&#xff0c;可能需要为excel添加自定义的工具栏和菜单。这个也是非常的简单的。 自定义工具栏的代码&#xff1a; PublicClass ConnectClass Connect Implements Extensibility.IDTExtensibility2 Dim app As Excel.Application Dim wb As Exce…

vb.net 开发 excel Addin学习(3)---- 菜单 的 操作

遍历菜单&#xff1a; PublicClass ConnectClass Connect Implements Extensibility.IDTExtensibility2 Dim app As Excel.Application Dim addInInstance As Object Dim mainMenuBar As Microsoft.Office.Core.CommandBar Dim newEntryBar As Microso…

vb.net 开发 excel Addin 学习(4)---- 菜单 的 及联及图标

创建级联菜单 PublicClass ConnectClass Connect Implements Extensibility.IDTExtensibility2 Dim app As Excel.Application Dim addInInstance As Object Dim mainMenuBar As Microsoft.Office.Core.CommandBar Dim newEntryBar As Microsoft.Office.Cor…

vb.net 开发 excel Addin 学习(5)---- 几个小问题

在做 excel Addin 开发的时候越到了几个小问题。总结一下。 一&#xff0c;Addin 无缘无故不加载。没有任何痕迹可查询。  解决方法&#xff1a;  可能是Excel禁止了你的addin&#xff0c;也就是你的addin被列入了黑名单&#xff0c;如果真是这样&#xff0c;看一下下面的(…