急~急~~急~~~利用Wininet编制的FTP上传DEMO为什么只能上传到根目录下呢？在线等~~
代码如下，无论我怎么设置路径，每次都直接传到FTP的根目录去了，各位高手帮小弟看一下吧，先谢谢啦
Option Explicit
'调用设置环境
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
'连接服务器
Private 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 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 Boolean
Private 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 Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Boolean
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const scuseragent = "vb wininet"
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Dim hOpen As Long
Dim hConnection As Long
Private mRst As ADODB.Recordset
Public Function SetDirectory(ip As String, userName As String, Password As String, ByVal h As String)
Dim ret As Boolean
hOpen = TestServer
If hOpen <> 0 Then
hConnection = InterConnection(ip, userName, Password)
If hConnection <> 0 Then
ret = FtpSetCurrentDirectory(hConnection, h)
SetDirectory = ret
Else
SetDirectory = False
End If
Else
SetDirectory = False
End If
InternetCloseHandle hConnection
InternetCloseHandle hOpen
End Function
'上传文件
Public Function UpLoadFile(ip As String, Filename As String, userName As String, Password As String) As Boolean
Dim ShortName As String
Dim ret As Boolean
ShortName = GetShortName(Filename)
hOpen = TestServer
If hOpen <> 0 Then
hConnection = InterConnection(ip, userName, Password)
If hConnection <> 0 Then
ret = FtpPutFile(hConnection, Filename, ShortName, 2, 0)
UpLoadFile = ret
Else
UpLoadFile = False
End If
Else
UpLoadFile = False
End If
InternetCloseHandle hConnection
InternetCloseHandle hOpen
End Function
'远程更名
Public Function RenameFile(ip As String, Filename As String, NewName As String, userName As String, Password As String) As Boolean
Dim ret As Boolean
hOpen = TestServer
If hOpen <> 0 Then
hConnection = InterConnection(ip, userName, Password)
If hConnection <> 0 Then
ret = FtpRenameFile(hConnection, Filename, NewName)
RenameFile = ret
Else
RenameFile = False
End If
Else
RenameFile = False
End If
InternetCloseHandle hConnection
InternetCloseHandle hOpen
End Function
'调用设置环境
Private Function TestServer() As Long
Dim i As Long
' i = InternetOpen(scuseragent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
i = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
TestServer = i
End Function
'连接服务器
Private Function InterConnection(ip As String, userName As String, Password As String) As Long
Dim i As Long
i = InternetConnect(hOpen, ip, 0, userName, Password, 1, INTERNET_FLAG_PASSIVE, 0)
InterConnection = i
End Function
'得到文件的短文件名
Private Function GetShortName(Filename As String) As String
Dim sTemp() As String
sTemp = Split(Filename, "\")
If UBound(sTemp) > 0 Then
GetShortName = sTemp(UBound(sTemp))
Else
GetShortName = ""
End If
End Function
Private Sub CmdCreate_Click() '创建文件,本地直接以".tmp"后缀存储,发送文件,远程修改文件名后缀为".MT"
Dim myStream As New ADODB.Stream, i As String, j As String, m As String, n As String, k As String, x As Integer, f As String
Dim pPhone As String, pContent As String, pReference As String, pRegion As String, pSessionId As String, pMenu As String, pSessionEnabled As String, pExpireHour As String, pAppId As String
pPhone = Trim(txtTelnum.Text)
pContent = txtContent.Text
pReference = ""
pRegion = txtAreaID.Text
pSessionId = ""
pMenu = ""
pSessionEnabled = False
pExpireHour = 24
myStream.Charset = "UTF-8"
myStream.LineSeparator = adLF
myStream.Open
For x = 1 To 3
i = pPhone + "#%" + pContent + "#%" + pReference + "#%" + pRegion + "#%" + pSessionId + "#%" + pMenu + "#%" + pSessionEnabled + "#%" + pExpireHour
myStream.WriteText i, adWriteLine
x = x + 1
Next
pAppId = txtSYSID.Text
j = pAppId & "#" & pRegion & "#" & Format(Now, "yyyyMMddhhmmss") + 1000 & ".MT"
m = "c:\" & j & ".tmp"
myStream.SaveToFile m, adSaveCreateNotExist
myStream.Close
f = txtDir.Text
Call SetDirectory(txtIP.Text, txtUser.Text, txtPWD.Text, f)
Call UpLoadFile(txtIP.Text, m, txtUser.Text, txtPWD.Text)
k = j & ".tmp"
n = j
Call RenameFile(txtIP.Text, k, n, txtUser.Text, txtPWD.Text)
End Sub
[解决办法]
FtpSetCurrentDirectory 和上传操作要在同一个连接中才有效！
假如现实情况，你要给某人打电话，但是不知道他的分机。
于是，你拨通他公司的电话，告诉前台，我要找某某，然后马上就挂了。
接下来你再拨通他公司的电话，接电话的肯定是你要找的某某？
