为什么这段FTP程序不支持中文?

付长松_华为云MVP 2004-08-04 08:24:57
Imports System.Net
Imports System.Net.Sockets
Imports System.IO
Imports System.Text
Imports Microsoft.VisualBasic
Imports System.Runtime.Remoting.Messaging

Public Class cFTP

Private mTCPClient As New TcpClient
Private mNetStream As NetworkStream
Private mBytes() As Byte
Private intBytesRec As Int64
Private mDataStream As NetworkStream
Private mTCPData As New TcpClient


Private mServerAddr As IPAddress
Private mFTPPort As Int32 = 21
Private mConnected As Boolean = False
Private mFTPResponse As String

Public Event ServerReplied(ByVal ServerReply As String)
Public Event ServerCalled(ByVal CallMsg As String)
Public Event ErrorOccured(ByVal ErrorCode As Integer, ByVal ErrMessage As String)
Public Event Transferring(ByVal intTransferred As Integer, ByVal intTotalFile As Integer)

Public Enum EC As Integer
NoError = 0
BuildConnectionFailed = 1
ConnectionClosingFailed = 2
DirListFailed = 3
ProttectedChannelFailed = 4
DownloadFailed = 5
UploadFailed = 6
FTPCommandFailed = 7
FTPGetFileFailed = 8
FTPPutFileFailed = 9
InvalidEntry = 30
ServerImproper = 31
ServerRejectedUser = 32
ServerRejectedPass = 33
ServerDeniedDirList = 34
InvalidFileLength = 35
DownUpLoadFailure = 36
UnknownError = 9999
End Enum

'FTP Server IP
ReadOnly Property ServerAddress() As IPAddress
Get
ServerAddress = mServerAddr
End Get
End Property

'FTP Port
ReadOnly Property FTPPort() As Int32
Get
FTPPort = mFTPPort
End Get
End Property

'Connection State
ReadOnly Property Connected() As Boolean
Get
Connected = mConnected
End Get
End Property

'FTP Server return info
ReadOnly Property FTPResponse() As String
Get
FTPResponse = mFTPResponse
mFTPResponse = ""
End Get
End Property

' Class constructor
Public Sub New(ByVal ServerAddr As IPAddress, ByVal FtpPort As Int32)
BuildConnection(ServerAddr, FtpPort)
End Sub

' Class constructor overloaded
Public Sub New(ByVal ServerAddr As String, ByVal FtpPort As Int32)
Try
BuildConnection(Dns.Resolve(ServerAddr).AddressList(0), FtpPort)
Catch err As Exception
MsgBox(err.ToString())
Me.Dispose()
End Try
End Sub

Public Delegate Sub DnsCallback(ByVal ar As IAsyncResult)

' Class destructor
Protected Sub Dispose()
If Not mConnected Then
Call Close()
End If
End Sub

'Build FTP connection
Private Sub BuildConnection(ByVal ServerAddr As IPAddress, ByVal FtpPort As Int32)
Dim strTemp As String

If FtpPort <= 0 Or FtpPort > 65535 Then
RaiseEvent ErrorOccured(EC.InvalidEntry, "Port number must be between 1 and 65535!")
Exit Sub
End If
'
mServerAddr = ServerAddr
mFTPPort = FtpPort
'
Try
mTCPClient.Connect(ServerAddr, FtpPort)
mNetStream = mTCPClient.GetStream()
strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "220 " Then
If strTemp.Substring(0, 3) = "220" Then
GetResponse()
Else
RaiseEvent ErrorOccured(EC.ServerImproper, "Serever replied improperly during connection!")
End If
End If
mConnected = True
Catch err As Exception
RaiseEvent ErrorOccured(EC.BuildConnectionFailed, err.ToString())
End Try
End Sub

'
Public Sub Close()
If mConnected Then
Erase mBytes
Try
mBytes = Encoding.ASCII.GetBytes("QUIT" & vbCrLf)
mNetStream.Write(mBytes, 0, mBytes.Length)
Call GetResponse()
mTCPClient.Close()
Catch err As Exception
RaiseEvent ErrorOccured(EC.ConnectionClosingFailed, err.ToString())
Finally
mConnected = False
End Try
End If
End Sub

'Get FTP server response
Private Function GetResponse() As String
Dim strTemp As String

Do
ReDim mBytes(mTCPClient.ReceiveBufferSize)
intBytesRec = mNetStream.Read(mBytes, 0, CInt(mTCPClient.ReceiveBufferSize))
strTemp = strTemp & Encoding.ASCII.GetString(mBytes, 0, intBytesRec)
Loop While mNetStream.DataAvailable
If strTemp.Length > 0 Then
RaiseEvent ServerReplied(strTemp)
End If
mFTPResponse = mFTPResponse & strTemp
GetResponse = strTemp
End Function

'Login
Public Sub IdVerify(ByVal strID As String, ByVal strPW As String)
Dim strTemp As String

If mConnected Then
'ID
If strID.Length = 0 Then
strID = "anonymous"
End If
strTemp = "USER " & strID & vbCrLf
RaiseEvent ServerCalled(strTemp)
mBytes = Encoding.ASCII.GetBytes(strTemp)
mNetStream.Write(mBytes, 0, mBytes.Length)
strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "331 " Then
RaiseEvent ErrorOccured(EC.ServerRejectedUser, "Server rejected user " & strID & "!")
Exit Sub
End If
'password
strTemp = "PASS " & strPW & vbCrLf
RaiseEvent ServerCalled(strTemp)
mBytes = Encoding.ASCII.GetBytes(strTemp)
mNetStream.Write(mBytes, 0, mBytes.Length)
strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "230 " Then
RaiseEvent ErrorOccured(EC.ServerRejectedPass, "Incorrect password! Server rejected password...")
Exit Sub
End If
Application.DoEvents()
If mNetStream.DataAvailable Then
Call GetResponse()
End If
End If
End Sub

'Directory list from FTP server
Public Function DirList(Optional ByVal cDirectory As String = "..") As String
Dim priSM As New MemoryStream
Dim strTemp As String
Dim intport As Int32

If mConnected Then
Try
intPort = cmdPasv2Port()
If cDirectory = ".." Then
strTemp = "LIST -aL" & vbCrLf
Else
strTemp = "LIST " & cDirectory & vbCrLf
End If
RaiseEvent ServerCalled(strTemp)
mBytes = Encoding.ASCII.GetBytes(strTemp)
mNetStream.Write(mBytes, 0, mBytes.Length)
strTemp = GetResponse()
priSM = GetInfo(intPort)
DirList = Encoding.ASCII.GetString(priSM.ToArray, 0, priSM.Length)

strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "150 " Then
RaiseEvent ErrorOccured(EC.ServerDeniedDirList, "Server denied DirListCommand!")
End If
Catch err As Exception
RaiseEvent ErrorOccured(EC.DirListFailed, err.ToString())
End Try
End If
End Function
...全文
178 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
速马 2004-08-26
  • 打赏
  • 举报
回复
Encoding.ASCII -> Encoding.Default或者Encoding.UTF8
  • 打赏
  • 举报
回复
up
  • 打赏
  • 举报
回复
up
  • 打赏
  • 举报
回复
If mConnected Then
Try
FtpCommand("TYPE I")
intPort = cmdPasv2Port()
FtpCommand("RETR " & strFile)

priSM = OtherPortGet(intPort, intSize)
b = priSM.ToArray()
sw = File.OpenWrite("D:\Setup.exe")
sw.Write(b, 0, b.Length)
sw.Close()
FtpGetFile = priSM

strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "226 " Then
RaiseEvent ErrorOccured(EC.DownUpLoadFailure, "Transfer failure!")
End If
Catch err As Exception
RaiseEvent ErrorOccured(EC.FTPGetFileFailed, err.ToString())
End Try
End If
End Function

' FTP upload
Public Function FtpPutFile(ByVal strFile As String, ByVal strDest As String, ByVal intSize As Long) As MemoryStream
Dim priSM As New MemoryStream
Dim strTemp As String
Dim i, j As Int16
Dim intPort As Int32

If mConnected Then
Try
strTemp = FtpCommand("TYPE I")
intPort = cmdPasv2Port()
strTemp = FtpCommand("STOR " & strDest)
i = mFTPResponse.LastIndexOf(")", mFTPResponse.Length - 1)
j = mFTPResponse.LastIndexOf("(", i)
i = mFTPResponse.IndexOf(" ", j)
strTemp = mFTPResponse.Substring(j + 1, i - j - 1)

priSM = OtherPortPut(intPort, strFile, intSize)
FtpPutFile = priSM

strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "226 " Then
RaiseEvent ErrorOccured(EC.DownUpLoadFailure, "Transfer failure!")
End If
Catch err As Exception
RaiseEvent ErrorOccured(EC.FTPPutFileFailed, err.ToString())
End Try
End If
End Function

'File details from FTP server
Public Function FileDet(ByVal strFN As String) As String
Dim priSM As New MemoryStream
Dim strTemp As String
Dim intPort As Int32

If mConnected Then
Try
intPort = cmdPasv2Port()
strTemp = "LIST " & strFN & vbCrLf
RaiseEvent ServerCalled(strTemp)
mBytes = Encoding.ASCII.GetBytes(strTemp)
mNetStream.Write(mBytes, 0, mBytes.Length)
priSM = GetInfo(intPort)
FileDet = Encoding.ASCII.GetString(priSM.ToArray, 0, priSM.Length)

strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "150 " Then
RaiseEvent ErrorOccured(EC.ServerDeniedDirList, "Server denied DirListCommand!")
End If
Catch err As Exception
RaiseEvent ErrorOccured(EC.DirListFailed, err.ToString())
End Try
End If
End Function

'Get data through the secondary port
Private Function GetInfo(ByVal intDataPort As Int32, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
Dim strTemp As String
Dim i As Int64
Dim priSM As New MemoryStream

If BytesWillRec >= 0 Then
Try
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = intBytesRec
If BytesWillRec = 0 Then
Do While mDataStream.DataAvailable
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = i + intBytesRec
Beep()
Application.DoEvents()
Loop
Else
Do While i < BytesWillRec
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = i + intBytesRec
Loop
End If

GetInfo = priSM
mTCPData.Close()
Catch err As Exception
RaiseEvent ErrorOccured(EC.DownloadFailed, err.ToString())
End Try
Else
RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid file length!")
End If
End Function

Public Function FolderOp(ByVal cName As String, Optional ByVal bCreate As Boolean = True) As Boolean
If bCreate Then
FolderOp = (FtpCommand("MKD " & cName).Substring(0, 4) = "257 ")
Else
FolderOp = (FtpCommand("RMD " & cName).Substring(0, 4) = "250 ")
End If
End Function

Public Function RenameFile(ByVal cOldName As String, ByVal cNewName As String) As Boolean
Dim b As Boolean

b = (FtpCommand("RNFR " & cOldName).Substring(0, 4) = "350 ")
b = b And (FtpCommand("RNTO " & cNewName).Substring(0, 4) = "250 ")
RenameFile = b
End Function

Public Function DeleteFile(ByVal cFileName As String) As Boolean
DeleteFile = (FtpCommand("DELE " & cFileName).Substring(0, 4) = "250 ")
End Function

Public Sub New()

End Sub
End Class
  • 打赏
  • 举报
回复

' Switches Server in prottectiive mode by opening a secondary data transfer port.
Public Function cmdPasv2Port() As Int32
Dim i, j As Int32
Dim strTemp As String

If mConnected Then
'
Erase mBytes
strTemp = "PASV" & vbCrLf
RaiseEvent ServerCalled(strTemp)
mBytes = Encoding.ASCII.GetBytes(strTemp)
Try
mNetStream.Write(mBytes, 0, mBytes.Length)
strTemp = GetResponse()
If strTemp.Substring(0, 4) <> "227 " Then
Call GetResponse()
End If

strTemp = mFTPResponse
i = strTemp.LastIndexOf(",")
j = strTemp.LastIndexOf(")")
cmdPasv2Port = CInt(strTemp.Substring(i + 1, j - i - 1))
strTemp = strTemp.Substring(1, i - 1)
j = i
i = strTemp.LastIndexOf(",")
cmdPasv2Port = 256 * CInt(strTemp.Substring(i + 1, j - i - 2)) + cmdPasv2Port
mTCPData = New TcpClient(mServerAddr.ToString, cmdPasv2Port)
mTCPData.ReceiveBufferSize = 16384
mDataStream = mTCPData.GetStream()
Catch err As Exception
MsgBox(err.Message, , "BibI")
' RaiseEvent ErrorOccured(EC.ProttectedChannelFailed, err.ToString())
End Try
End If
End Function

'Get data through the secondary port
Private Function OtherPortGet(ByVal intDataPort As Int32, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
Dim strTemp As String
Dim i As Int64
Dim priSM As New MemoryStream

If BytesWillRec >= 0 Then
Try
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = intBytesRec
RaiseEvent Transferring(i, BytesWillRec)
If BytesWillRec = 0 Then
Do While mDataStream.DataAvailable
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = i + intBytesRec
RaiseEvent Transferring(i, BytesWillRec)
Beep()
Application.DoEvents()
Loop
Else
Do While i < BytesWillRec
ReDim mBytes(mTCPData.ReceiveBufferSize)
intBytesRec = mDataStream.Read(mBytes, 0, CInt(mTCPData.ReceiveBufferSize))
priSM.Write(mBytes, 0, intBytesRec)
i = i + intBytesRec
RaiseEvent Transferring(i, BytesWillRec)
Loop
End If

OtherPortGet = priSM
mTCPData.Close()
Catch err As Exception
RaiseEvent ErrorOccured(EC.DownloadFailed, err.ToString())
End Try
Else
RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid file length!")
End If
End Function

'Put data through the secondary port
Private Function OtherPortPut1(ByVal intDataPort As Int32, ByVal strFN As String, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
Dim strTemp As String
Dim i As Int64
Dim priSM As New MemoryStream
Dim priSM1 As FileStream
Dim intTmp As Integer

If BytesWillRec >= 0 Then
Try
ReDim mBytes(FileLen(strFN))

priSM1 = File.OpenRead(strFN)
intBytesRec = priSM1.Read(mBytes, 0, FileLen(strFN))
intTmp = 16384
Do While i < mBytes.Length
If mBytes.Length - i < 16384 Then
intTmp = mBytes.Length - i
End If
priSM.Write(mBytes, i, intTmp)
priSM.WriteTo(mDataStream)
i += intTmp
Application.DoEvents()
Loop


mDataStream.Close()
OtherPortPut1 = priSM
mTCPData.Close()
Catch err As Exception
RaiseEvent ErrorOccured(EC.UploadFailed, err.ToString())
End Try
Else
RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid declared file length!")
End If
End Function

'Put data through the secondary port
Private Function OtherPortPut(ByVal intDataPort As Int32, ByVal strFN As String, Optional ByVal BytesWillRec As Int64 = 0) As MemoryStream
Dim strTemp As String
Dim i As Int64
Dim priSM As New MemoryStream
Dim priSM1 As FileStream
Dim intTmp As Integer

If BytesWillRec >= 0 Then
Try
ReDim mBytes(FileLen(strFN))

priSM1 = File.OpenRead(strFN)
intBytesRec = priSM1.Read(mBytes, 0, FileLen(strFN))
priSM.Write(mBytes, 0, mBytes.Length - 1)
priSM.WriteTo(mDataStream)


mDataStream.Close()
OtherPortPut = priSM
mTCPData.Close()
Catch err As Exception
RaiseEvent ErrorOccured(EC.UploadFailed, err.ToString())
End Try
Else
RaiseEvent ErrorOccured(EC.InvalidFileLength, "Invalid declared file length!")
End If
End Function

' Sends general command to server
Public Function FtpCommand(ByVal strCommand As String) As String
If mConnected Then
Try
Erase mBytes
RaiseEvent ServerCalled(strCommand & vbCrLf)
mBytes = Encoding.ASCII.GetBytes(strCommand & vbCrLf)
mNetStream.Write(mBytes, 0, mBytes.Length)
FtpCommand = GetResponse()
Catch err As Exception
RaiseEvent ErrorOccured(EC.FTPCommandFailed, err.ToString())
End Try
End If
End Function

'FTP Download
Public Function FtpGetFile(ByVal strFile As String, ByVal strDest As String, ByVal intSize As Long) As MemoryStream
Dim priSM As New MemoryStream
Dim strTemp As String
Dim i, j As Int16
Dim intPort As Int32
Dim sw As FileStream
Dim b() As Byte

16,549

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧