关于inet控件上传文件的问题

Question

我的程序代码如下,在VB中执行可以成功,但编译后安装在本机上时,停留在"Case icReceivingResponse '7该控件正在接收主机的响应"处,不再响应。请大家帮忙！Private Sub Command9_Click()
'netcs为包含所需信息的数组,wp为文件名
On Error Resume Next
Kill App.Path & "\ja.txt"
With Inet1
  .URL = "ftp://" & netcs(5)
  .UserName = netcs(7)
  .Password = netcs(8)
  .Execute , "put " & App.Path & "\" & WP & " " & netcs(6) & "/" & WP
  Do While .StillExecuting
    DoEvents
  Loop
  .Execute , "get " & netcs(6) & "/" & WP & " " & App.Path & "\" & "ja.txt"
  Do While .StillExecuting
    DoEvents
  Loop
  .Execute , "close"
End With
end subPrivate Sub Inet1_StateChanged(ByVal State As Integer)
Dim temp As String
Select Case State
  Case icNone              '0无状态可报告
  
  Case icResolvingHost     '1该控件正在查询所指定的主机的IP地址
    temp = "正在查找..."
  Case icHostResolved      '2该控件已找到指定主机的IP地址
    temp = "已找到IP地址"
  Case icConnecting        '3该控件正在与主机连接
    temp = "正在连接..."
  Case icConnected         '4该控件已与主机连接成功
    temp = "连接成功"
  Case icRequesting        '5该控件正在向主机发送请求
    temp = "正在发送请求..."
  Case icRequestSent       '6该控件发送请求已成功
    temp = "发送请求成功"
  Case icReceivingResponse '7该控件正在接收主机的响应
    temp = "正在接收主机的响应"
  Case icResponseReceived  '8该控件已成功接收主机的响应
    temp = "已接收主机的响应"
  Case icDisconnecting     '9该控件正在解除与主机的连接
    temp = "正在解除与主机的连接..."
  Case icDisconnected      '10该控件已解除与主机的连接
    temp = "已解除与主机的连接"
  Case icError             '11与主机通讯时出现错误
    temp = Inet1.ResponseCode & Inet1.ResponseInfo
  Case icResponseCompleted '12该请求已经完成,并且所有数据已经接收到
    temp = "已接收到数据"
  End Select
Label3.Caption = temp
End Sub

Answer 1

采用采用ftp代码,代码我贴出来给你,如下:
' Chris wujiawen July 2002
'
Private Const MAX_PATH = 260Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Public Function RenameFile(ByVal ExistingName As String, ByVal NewName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'
' If not connected, raise an error
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::RenameFile", ERRNOCONNECTION
    End If
   
    bRet = FtpRenameFile(mlConnection, ExistingName, NewName)
'
' Raise an error if we couldn't rename the file (most likely that
' a file with the new name already exists
'
    If bRet = False Then
        sError = ERRNORENAME
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        RenameFile = False
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        Err.Raise errCannotRename, "CGFTP::RenameFile", sError
    End If
    
    RenameFile = True
        Exit FunctionvbErrorHandler:
    Err.Raise Err.Number, "cFTP::RenameFile", Err.DescriptionEnd FunctionPublic Function DeleteFile(ByVal ExistingName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'
' Check for a connection
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::DeleteFile", ERRNOCONNECTION
    End If
    
    bRet = FtpDeleteFile(mlConnection, ExistingName)
'
' Raise an error if the file couldn't be deleted
'
    If bRet = False Then
        sError = ERRNODELETE
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        Err.Raise errCannotDelete, "CGFTP::DeleteFile", sError
    End If
    
    DeleteFile = True    Exit FunctionvbErrorHandler:
    Err.Raise Err.Number, "cFTP::DeleteFile", Err.DescriptionEnd Function

Answer 2

Private Sub RemoteChDir(ByVal sDir As String)
On Error GoTo vbErrorHandler
'
' Remote Change Directory Command through WININET
'
    Dim sPathFromRoot As String
    Dim bRet As Boolean
    Dim sError As String
'
' Needs standard Unix Convention
'
    sDir = Replace(sDir, "\", "/")
'
' Check for a connection
'
    If mlConnection = 0 Then
        On Error GoTo 0
        Err.Raise errNotConnectedToSite, "CGFTP::RemoteChDir", ERRNOCONNECTION
        Exit Sub
    End If
    
    If Len(sDir) = 0 Then
        Exit Sub
    Else
        sPathFromRoot = sDir
        If Len(sPathFromRoot) = 0 Then
            sPathFromRoot = "/"
        End If
        bRet = FtpSetCurrentDirectory(mlConnection, sPathFromRoot)
'
' If we couldn't change directory - raise an error
'
        If bRet = False Then
            sError = ERRCHANGEDIRSTR
            sError = Replace(sError, "%s", sDir)
            On Error GoTo 0
            Err.Raise errNoDirChange, "CGFTP::ChangeDirectory", sError
        End If
    End If    Exit SubvbErrorHandler:
    Err.Raise Err.Number, "cFTP::RemoteChDir", Err.DescriptionEnd SubPrivate Function GetINETErrorMsg(ByVal ErrNum As Long) As String
    Dim lError As Long
    Dim lLen As Long
    Dim sBuffer As String
'
' Get Extra Info from the WinInet.DLL
'
    If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
'
' Get Message Size and Number
'
        InternetGetLastResponseInfo lError, vbNullString, lLen
        sBuffer = String$(lLen + 1, vbNullChar)
'
' Get Message
'
        InternetGetLastResponseInfo lError, sBuffer, lLen
        GetINETErrorMsg = vbCrLf & sBuffer
    End If
End Function
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Const ERROR_NO_MORE_FILES = 18
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
    
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
      lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As LongPrivate Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
      ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPrivate Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
      ByVal lpszRemoteFile As String, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPrivate Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
    ByVal sProxyBypass As String, ByVal lFlags As Long) As Long' Use registry access settings.
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_INVALID_PORT_NUMBER = 0Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H1
Private Const INTERNET_FLAG_PASSIVE = &H8000000Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
    ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1
'private Const INTERNET_SERVICE_GOPHER = 2
'private Const INTERNET_SERVICE_HTTP = 3Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000Private Declare Function FtpOpenFile Lib "wininet.dll" Alias _
        "FtpOpenFileA" (ByVal hFtpSession As Long, _
        ByVal sFileName As String, ByVal lAccess As Long, _
        ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
    
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias _
    "FtpRenameFileA" (ByVal hFtpSession As Long, _
    ByVal sExistingName As String, _
    ByVal sNewName As String) As Boolean
   
' Closes a single Internet handle or a subtree of Internet handles.
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer