|
|
这段不是我写的代码.
给自己好好学习~~
  Code
1 ' This class permits you to perform direct connections to FTP sites in Visual Basic. NET.
2 ' The class supports the following FTP commands:
3 ' - Upload a file
4 ' - Download a file
5 ' - Create a directory
6 ' - Remove a directory
7 ' - Change directory
8 ' - Remove a file
9 ' - Rename a file
10 ' - Set the user name of the remote user
11 ' - Set the password of the remote user
12 Imports System
13 Imports System.Net
14 Imports System.IO
15 Imports System.Text
16 Imports System.Net.Sockets
17 'FTP Class
18 Public Class clsFTP
19 #Region "Class Variable Declarations"
20 Private m_sRemoteHost, m_sRemotePath, m_sRemoteUser As String
21 Private m_sRemotePassword, m_sMess As String
22 Private m_iRemotePort, m_iBytes As Int32
23 Private m_objClientSocket As Socket
24 Private m_iRetValue As Int32
25 Private m_bLoggedIn As Boolean
26 Private m_sMes, m_sReply As String
27 'Set the size of the packet that is used to read and to write data to the FTP server
28 'to the following specified size.
29 Public Const BLOCK_SIZE = 512
30 Private m_aBuffer(BLOCK_SIZE) As Byte
31 Private ASCII As Encoding = Encoding.ASCII
32 Public flag_bool As Boolean
33 'General variable declaration
34 Private m_sMessageString As String
35 Private log_text_box As TextBox
36
37
38 #End Region
39 #Region "Class Constructors"
40 ' Main class constructor
41 Public Sub New()
42 m_sRemoteHost = "microsoft"
43 m_sRemotePath = "."
44 m_sRemoteUser = "anonymous"
45 m_sRemotePassword = ""
46 m_sMessageString = ""
47 m_iRemotePort = 21
48 m_bLoggedIn = False
49 End Sub
50 ' Parameterized constructor
51 Public Sub New(ByVal sRemoteHost As String, _
52 ByVal sRemotePath As String, _
53 ByVal sRemoteUser As String, _
54 ByVal sRemotePassword As String, _
55 ByVal iRemotePort As Int32)
56 m_sRemoteHost = sRemoteHost
57 m_sRemotePath = sRemotePath
58 m_sRemoteUser = sRemoteUser
59 m_sRemotePassword = sRemotePassword
60 m_sMessageString = ""
61 m_iRemotePort = 21
62 m_bLoggedIn = False
63 End Sub
64 #End Region
65 #Region "Public Properties"
66 'Set or Get the name of the FTP server that you want to connect to.
67 Public Property RemoteHostFTPServer() As String
68 'Get the name of the FTP server.
69 Get
70 Return m_sRemoteHost
71 End Get
72 'Set the name of the FTP server.
73 Set(ByVal Value As String)
74 m_sRemoteHost = Value
75 End Set
76 End Property
77 'Set or Get the FTP port number of the FTP server that you want to connect to.
78 Public Property RemotePort() As Int32
79 'Get the FTP port number.
80 Get
81 Return m_iRemotePort
82 End Get
83 'Set the FTP port number.
84 Set(ByVal Value As Int32)
85 m_iRemotePort = Value
86 End Set
87 End Property
88 'Set or Get the remote path of the FTP server that you want to connect to.
89 Public Property RemotePath() As String
90 'Get the remote path.
91 Get
92 Return m_sRemotePath
93 End Get
94 'Set the remote path.
95 Set(ByVal Value As String)
96 m_sRemotePath = Value
97 End Set
98 End Property
99 'Set the remote password of the FTP server that you want to connect to.
100 Public Property RemotePassword() As String
101 Get
102 Return m_sRemotePassword
103 End Get
104 Set(ByVal Value As String)
105 m_sRemotePassword = Value
106 End Set
107 End Property
108 'Set or Get the remote user of the FTP server that you want to connect to.
109 Public Property RemoteUser() As String
110 Get
111 Return m_sRemoteUser
112 End Get
113 Set(ByVal Value As String)
114 m_sRemoteUser = Value
115 End Set
116 End Property
117 'Set the class messagestring.
118 Public Property MessageString() As String
119 Get
120 Return m_sMessageString
121 End Get
122 Set(ByVal Value As String)
123 m_sMessageString = Value
124 End Set
125 End Property
126
127 'Set the class messagestring.
128 Public Property LogTextBox() As TextBox
129 Get
130 Return log_text_box
131 End Get
132 Set(ByVal Value As TextBox)
133 log_text_box = Value
134 End Set
135 End Property
136
137 #End Region
138 #Region "Public Subs and Functions"
139 'Return a list of files from the file system. Return these files in a string() array.
140 Public Function GetFileList(ByVal sMask As String) As String()
141 Dim cSocket As Socket
142 Dim bytes As Int32
143 Dim seperator As Char = ControlChars.Lf
144 Dim mess() As String
145 m_sMes = ""
146 'Check to see if you are logged on to the FTP server.
147 If (Not (m_bLoggedIn)) Then
148 Login()
149 End If
150 cSocket = CreateDataSocket()
151 'Send an FTP command.
152 SendCommand("NLST " & sMask)
153 If (Not (m_iRetValue = 150 Or m_iRetValue = 125)) Then
154 MessageString = m_sReply
155 Throw New IOException(m_sReply.Substring(4))
156 End If
157 m_sMes = ""
158 Do While (True)
159 m_aBuffer.Clear(m_aBuffer, 0, m_aBuffer.Length)
160 bytes = cSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
161 m_sMes += ASCII.GetString(m_aBuffer, 0, bytes)
162 If (bytes < m_aBuffer.Length) Then
163 Exit Do
164 End If
165 Loop
166 mess = m_sMes.Split(seperator)
167 cSocket.Close()
168 ReadReply()
169 If (m_iRetValue <> 226) Then
170 MessageString = m_sReply
171 Throw New IOException(m_sReply.Substring(4))
172 End If
173 Return mess
174 End Function
175 ' Get the size of the file on the FTP server.
176 Public Function GetFileSize(ByVal sFileName As String) As Long
177 Dim size As Long
178 If (Not (m_bLoggedIn)) Then
179 Login()
180 End If
181 'Send an FTP command.
182 SendCommand("SIZE " & sFileName)
183 size = 0
184 If (m_iRetValue = 213) Then
185 size = Int64.Parse(m_sReply.Substring(4))
186 Else
187 MessageString = m_sReply
188 Throw New IOException(m_sReply.Substring(4))
189 End If
190 Return size
191 End Function
192 'Log on to the FTP server.
193 Public Function Login() As Boolean
194 m_objClientSocket = _
195 New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
196 Dim ep As New IPEndPoint(Dns.Resolve(m_sRemoteHost).AddressList(0), m_iRemotePort)
197 Try
198 m_objClientSocket.Connect(ep)
199 Catch ex As Exception
200 MessageString = m_sReply
201 Throw New IOException("Cannot connect to the remote server")
202 End Try
203 ReadReply()
204 If (m_iRetValue <> 220) Then
205 CloseConnection()
206 MessageString = m_sReply
207 Throw New IOException(m_sReply.Substring(4))
208 End If
209 'Send an FTP command to send a user logon ID to the server.
210 SendCommand("USER " & m_sRemoteUser)
211 If (Not (m_iRetValue = 331 Or m_iRetValue = 230)) Then
212 Cleanup()
213 MessageString = m_sReply
214 Throw New IOException(m_sReply.Substring(4))
215 End If
216 If (m_iRetValue <> 230) Then
217 'Send an FTP command to send a user logon password to the server.
218 SendCommand("PASS " & m_sRemotePassword)
219 If (Not (m_iRetValue = 230 Or m_iRetValue = 202)) Then
220 Cleanup()
221 MessageString = m_sReply
222 Throw New IOException(m_sReply.Substring(4))
223 End If
224 End If
225 m_bLoggedIn = True
226 'Call the ChangeDirectory user-defined function to change the directory to the
227 'remote FTP folder that is mapped.
228 ChangeDirectory(m_sRemotePath)
229 'Return the final result.
230 Return m_bLoggedIn
231 End Function
232 'If the value of mode is true, set binary mode for downloads. Otherwise, set ASCII mode.
233 Public Sub SetBinaryMode(ByVal bMode As Boolean)
234 If (bMode) Then
235 'Send the FTP command to set the binary mode.
236 '(TYPE is an FTP command that is used to specify representation type.)
237 SendCommand("TYPE I")
238 Else
239 'Send the FTP command to set ASCII mode.
240 '(TYPE is an FTP command that is used to specify representation type.)
241 SendCommand("TYPE A")
242 End If
243 If (m_iRetValue <> 200) Then
244 MessageString = m_sReply
245 Throw New IOException(m_sReply.Substring(4))
246 End If
247 End Sub
248 ' Download a file to the local directory of the assembly. Keep the same file name.
249 Public Sub DownloadFile(ByVal sFileName As String)
250 DownloadFile(sFileName, "", False)
251 End Sub
252 ' Download a remote file to the local directory of the Assembly. Keep the same file name.
253 Public Sub DownloadFile(ByVal sFileName As String, _
254 ByVal bResume As Boolean)
255 DownloadFile(sFileName, "", bResume)
256 End Sub
257 'Download a remote file to a local file name. You must include a path.
258 'The local file name will be created or will be overwritten, but the path must exist.
259 Public Sub DownloadFile(ByVal sFileName As String, _
260 ByVal sLocalFileName As String)
261 DownloadFile(sFileName, sLocalFileName, False)
262 End Sub
263 ' Download a remote file to a local file name. You must include a path. Set the
264 ' resume flag. The local file name will be created or will be overwritten, but the path must exist.
265 Public Sub DownloadFile(ByVal sFileName As String, _
266 ByVal sLocalFileName As String, _
267 ByVal bResume As Boolean)
268 Dim st As Stream
269 Dim output As FileStream
270 Dim cSocket As Socket
271 Dim offset, npos As Long
272 If (Not (m_bLoggedIn)) Then
273 Login()
274 End If
275 SetBinaryMode(True)
276 If (sLocalFileName.Equals("")) Then
277 sLocalFileName = sFileName
278 End If
279 If (Not (File.Exists(sLocalFileName))) Then
280 st = File.Create(sLocalFileName)
281 st.Close()
282 End If
283 output = New FileStream(sLocalFileName, FileMode.Open)
284 cSocket = CreateDataSocket()
285 offset = 0
286 If (bResume) Then
287 offset = output.Length
288 If (offset > 0) Then
289 'Send an FTP command to restart.
290 SendCommand("REST " & offset)
291 If (m_iRetValue <> 350) Then
292 offset = 0
293 End If
294 End If
295 If (offset > 0) Then
296 npos = output.Seek(offset, SeekOrigin.Begin)
297 End If
298 End If
299 'Send an FTP command to retrieve a file.
300 SendCommand("RETR " & sFileName)
301 If (Not (m_iRetValue = 150 Or m_iRetValue = 125)) Then
302 MessageString = m_sReply
303 Throw New IOException(m_sReply.Substring(4))
304 End If
305 Do While (True)
306 m_aBuffer.Clear(m_aBuffer, 0, m_aBuffer.Length)
307 m_iBytes = cSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
308 output.Write(m_aBuffer, 0, m_iBytes)
309 If (m_iBytes <= 0) Then
310 Exit Do
311 End If
312 Loop
313 output.Close()
314 If (cSocket.Connected) Then
315 cSocket.Close()
316 End If
317 ReadReply()
318 If (Not (m_iRetValue = 226 Or m_iRetValue = 250)) Then
319 MessageString = m_sReply
320 Throw New IOException(m_sReply.Substring(4))
321 End If
322 End Sub
323 'This is a function that is used to upload a file from your local hard disk to your FTP site.
324 Public Sub UploadFile(ByVal sFileName As String, ByVal OutPutFileName As String)
325 UploadFile(sFileName, OutPutFileName, False)
326 End Sub
327 ' This is a function that is used to upload a file from your local hard disk to your FTP site
328 ' and then set the resume flag.
329 Public Sub UploadFile(ByVal sFileName As String, _
330 ByVal OutPutFileName As String, _
331 ByVal bResume As Boolean)
332
333 Dim cSocket As Socket
334 Dim offset As Long
335 Dim input As FileStream
336 Dim bFileNotFound As Boolean
337 If (Not (m_bLoggedIn)) Then
338 Login()
339 End If
340 cSocket = CreateDataSocket()
341 offset = 0
342 If (bResume) Then
343 Try
344 SetBinaryMode(True)
345 offset = GetFileSize(sFileName)
346 Catch ex As Exception
347 offset = 0
348 End Try
349 End If
350
351 If (offset > 0) Then
352 SendCommand("REST " & offset)
353 If (m_iRetValue <> 350) Then
354 'The remote server may not support resuming.
355 offset = 0
356 End If
357 End If
358
359 'Send an FTP command to store a file.
360 'SendCommand("STOR " & Path.GetFileName(sFileName))
361 SendCommand("STOR " & OutPutFileName)
362
363 If (Not (m_iRetValue = 125 Or m_iRetValue = 150)) Then
364 MessageString = m_sReply
365 Throw New IOException(m_sReply.Substring(4))
366 End If
367
368 'Check to see if the file exists before the upload.
369 bFileNotFound = False
370 If (File.Exists(sFileName)) Then
371 ' Open the input stream to read the source file.
372 input = New FileStream(sFileName, FileMode.Open)
373 If (offset <> 0) Then
374 input.Seek(offset, SeekOrigin.Begin)
375 End If
376 'Upload the file.
377 m_iBytes = input.Read(m_aBuffer, 0, m_aBuffer.Length)
378
379 Do While (m_iBytes > 0)
380 cSocket.Send(m_aBuffer, m_iBytes, 0)
381 m_iBytes = input.Read(m_aBuffer, 0, m_aBuffer.Length)
382 Loop
383 input.Close()
384 Else
385 bFileNotFound = True
386 End If
387
388 If (cSocket.Connected) Then
389 cSocket.Close()
390 End If
391
392
393 'Check the return value if the file was not found.
394 If (bFileNotFound) Then
395 MessageString = m_sReply
396 Throw New IOException("The file: " & sFileName & " was not found. " & _
397 "Cannot upload the file to the FTP site")
398 End If
399
400 '##########################################################################
401 '2005.11.28 M.N del おそらく、FTPサーバーに対しエラーチェックを要請しているが、
402 'ftpdからのレスがないと止まってしまうので、コメントアウトした
403 'OCNからだと問題ないが、KCNからso-netにアクセスすると止まってしまう
404 '##########################################################################
405 'ReadReply()
406 'If (Not (m_iRetValue = 226 Or m_iRetValue = 250)) Then
407 ' MessageString = m_sReply
408 ' Throw New IOException(m_sReply.Substring(4))
409 'End If
410
411
412 End Sub
413 ' Delete a file from the remote FTP server.
414 Public Function DeleteFile(ByVal sFileName As String) As Boolean
415 Dim bResult As Boolean
416 bResult = True
417 If (Not (m_bLoggedIn)) Then
418 Login()
419 End If
420 'Send an FTP command to delete a file.
421 SendCommand("DELE " & sFileName)
422 If (m_iRetValue <> 250) Then
423 bResult = False
424 MessageString = m_sReply
425 End If
426 ' Return the final result.
427 Return bResult
428 End Function
429 ' Rename a file on the remote FTP server.
430 Public Function RenameFile(ByVal sOldFileName As String, _
431 ByVal sNewFileName As String) As Boolean
432 Dim bResult As Boolean
433 bResult = True
434 If (Not (m_bLoggedIn)) Then
435 Login()
436 End If
437 'Send an FTP command to rename from a file.
438 SendCommand("RNFR " & sOldFileName)
439 If (m_iRetValue <> 350) Then
440 MessageString = m_sReply
441 Throw New IOException(m_sReply.Substring(4))
442 End If
443 'Send an FTP command to rename a file to a new file name.
444 'It will overwrite if newFileName exists.
445 SendCommand("RNTO " & sNewFileName)
446 If (m_iRetValue <> 250) Then
447 MessageString = m_sReply
448 Throw New IOException(m_sReply.Substring(4))
449 End If
450 ' Return the final result.
451 Return bResult
452 End Function
453 'This is a function that is used to create a directory on the remote FTP server.
454 Public Function CreateDirectory(ByVal sDirName As String) As Boolean
455 Dim bResult As Boolean
456 bResult = True
457 If (Not (m_bLoggedIn)) Then
458 Login()
459 End If
460 'Send an FTP command to make directory on the FTP server.
461 SendCommand("MKD " & sDirName)
462 If (m_iRetValue <> 257) Then
463 bResult = False
464 MessageString = m_sReply
465 End If
466 ' Return the final result.
467 Return bResult
468 End Function
469 ' This is a function that is used to delete a directory on the remote FTP server.
470 Public Function RemoveDirectory(ByVal sDirName As String) As Boolean
471 Dim bResult As Boolean
472 bResult = True
473 'Check if logged on to the FTP server
474 If (Not (m_bLoggedIn)) Then
475 Login()
476 End If
477 'Send an FTP command to remove directory on the FTP server.
478 SendCommand("RMD " & sDirName)
479 If (m_iRetValue <> 250) Then
480 bResult = False
481 MessageString = m_sReply
482 End If
483 ' Return the final result.
484 Return bResult
485 End Function
486 'This is a function that is used to change the current working directory on the remote FTP server.
487 Public Function ChangeDirectory(ByVal sDirName As String) As Boolean
488 Dim bResult As Boolean
489 bResult = True
490 'Check if you are in the root directory.
491 If (sDirName.Equals(".")) Then
492 Exit Function
493 End If
494 'Check if logged on to the FTP server
495 If (Not (m_bLoggedIn)) Then
496 Login()
497 End If
498 'Send an FTP command to change directory on the FTP server.
499 SendCommand("CWD " & sDirName)
500 If (m_iRetValue <> 250) Then
501 bResult = False
502 MessageString = m_sReply
503 End If
504 Me.m_sRemotePath = sDirName
505 ' Return the final result.
506 Return bResult
507 End Function
508 ' Close the FTP connection of the remote server.
509 Public Sub CloseConnection()
510
511 If (Not (m_objClientSocket Is Nothing)) Then
512 'Send an FTP command to end an FTP server system.
513 SendCommand("QUIT")
514 End If
515 Cleanup()
516 End Sub
517
518 Public Sub PrintLog(ByVal msg As String)
519
520 'ログ出力用のテキストボックスがセットされてないときは無視
521 If log_text_box Is Nothing Then
522 Exit Sub
523 End If
524
525 log_text_box.Text = log_text_box.Text & msg & vbCrLf
526 log_text_box.SelectionStart = log_text_box.Text.Length
527 log_text_box.ScrollToCaret()
528 log_text_box.Refresh()
529
530
531 'ファイルに出力する
532 Dim sw As New StreamWriter("c:\ftp_text.txt", True, System.Text.Encoding.UTF8)
533 sw.Write(msg & vbCrLf)
534 sw.Close()
535
536
537
538 End Sub
539
540
541
542 #End Region
543 #Region "Private Subs and Functions"
544 ' Read the reply from the FTP server.
545 Private Sub ReadReply()
546 m_sMes = ""
547 m_sReply = ReadLine() '2005.11.28 M.N ここで止まってしまう・・・
548 m_iRetValue = Int32.Parse(m_sReply.Substring(0, 3))
549 End Sub
550 ' Clean up some variables.
551 Private Sub Cleanup()
552 If Not (m_objClientSocket Is Nothing) Then
553 m_objClientSocket.Close()
554 m_objClientSocket = Nothing
555 End If
556 m_bLoggedIn = False
557 End Sub
558 ' Read a line from the FTP server.
559 Private Function ReadLine(Optional ByVal bClearMes As Boolean = False) As String
560 Dim seperator As Char = ControlChars.Lf
561 Dim mess() As String
562 If (bClearMes) Then
563 m_sMes = ""
564 End If
565
566 Do While (True)
567 m_aBuffer.Clear(m_aBuffer, 0, BLOCK_SIZE)
568 'KCNの場合ここで止まるらしい。なぜだろう・・・・
569 m_iBytes = m_objClientSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
570 m_sMes += ASCII.GetString(m_aBuffer, 0, m_iBytes)
571 If (m_iBytes < m_aBuffer.Length) Then
572 Exit Do
573 End If
574 Loop
575 mess = m_sMes.Split(seperator)
576 If (m_sMes.Length > 2) Then
577 m_sMes = mess(mess.Length - 2)
578 Else
579 m_sMes = mess(0)
580 End If
581
582 If (Not (m_sMes.Substring(3, 1).Equals(" "))) Then
583 Return ReadLine(True)
584 End If
585
586 Return m_sMes
587 End Function
588 ' This is a function that is used to send a command to the FTP server that you are connected to.
589 Private Sub SendCommand(ByVal sCommand As String)
590 PrintLog(sCommand)
591 sCommand = sCommand & ControlChars.CrLf
592 Dim cmdbytes As Byte() = ASCII.GetBytes(sCommand)
593 m_objClientSocket.Send(cmdbytes, cmdbytes.Length, 0)
594 ReadReply()
595 End Sub
596 ' Create a data socket.
597 Private Function CreateDataSocket() As Socket
598 Dim index1, index2, len As Int32
599 Dim partCount, i, port As Int32
600 Dim ipData, buf, ipAddress As String
601 Dim parts(6) As Int32
602 Dim ch As Char
603 Dim s As Socket
604 Dim ep As IPEndPoint
605 'Send an FTP command to use passive data connection.
606 SendCommand("PASV")
607 If (m_iRetValue <> 227) Then
608 MessageString = m_sReply
609 Throw New IOException(m_sReply.Substring(4))
610 End If
611 index1 = m_sReply.IndexOf("(")
612 index2 = m_sReply.IndexOf(")")
613 ipData = m_sReply.Substring(index1 + 1, index2 - index1 - 1)
614 len = ipData.Length
615 partCount = 0
616 buf = ""
617 For i = 0 To ((len - 1) And partCount <= 6)
618 ch = Char.Parse(ipData.Substring(i, 1))
619 If (Char.IsDigit(ch)) Then
620 buf += ch
621 ElseIf (ch <> ",") Then
622 MessageString = m_sReply
623 Throw New IOException("Malformed PASV reply: " & m_sReply)
624 End If
625 If ((ch = ",") Or (i + 1 = len)) Then
626 Try
627 parts(partCount) = Int32.Parse(buf)
628 partCount += 1
629 buf = ""
630 Catch ex As Exception
631 MessageString = m_sReply
632 Throw New IOException("Malformed PASV reply: " & m_sReply)
633 End Try
634 End If
635 Next
636 ipAddress = parts(0) & "." & parts(1) & "." & parts(2) & "." & parts(3)
637 ' Make this call in Visual Basic .NET 2002. You want to
638 ' bitshift the number by 8 bits. In Visual Basic .NET 2002 you must
639 ' multiply the number by 2 to the power of 8.
640 'port = parts(4) * (2 ^ 8)
641 ' Make this call and then comment out the previous line for Visual Basic .NET 2003.
642 port = parts(4) << 8
643 ' Determine the data port number.
644 port = port + parts(5)
645 s = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
646 ep = New IPEndPoint(Dns.Resolve(ipAddress).AddressList(0), port)
647 Try
648 s.Connect(ep)
649 Catch ex As Exception
650 MessageString = m_sReply
651 Throw New IOException("Cannot connect to remote server.")
652 'If you cannot connect to the FTP server that is
653 'specified, make the boolean variable false.
654 flag_bool = False
655 End Try
656 'If you can connect to the FTP server that is specified, make the boolean variable true.
657 flag_bool = True
658 Return s
659 End Function
660 #End Region
661 End Class
|