-
Notifications
You must be signed in to change notification settings - Fork 2
Expand file tree
/
Copy pathCFtpClient.cls
More file actions
3369 lines (3278 loc) · 121 KB
/
CFtpClient.cls
File metadata and controls
3369 lines (3278 loc) · 121 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CFtpClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'------------------------------------------------------------------------------------------
' Module : CFtpClient Class Module (CFtpClient.cls)
' Type : Internet application protocol wrapper
' Updated : 17-OCT-2002
' Version : 1.0.4
' Author : Oleg Gdalevich
' Purpose : Implements the FTP protocol client
' Notes :
' Dependencies: CScoket.cls class module
' MSocketSupport.bas code module
' CFtpFile.cls class module
' CFtpFiles.cls class module
' CTimeOut.cls class module
' CTimeOutSupport.bas code module
' CFtpError.cls class module
' URL : http://www.vbip.com/protocols/ftp/vb-ftp-client-library/default.asp
'------------------------------------------------------------------------------------------
' Copyright © 2002 by Oleg Gdalevich
' Visual Basic Internet Programming website (http://www.vbip.com)
'------------------------------------------------------------------------------------------
Option Explicit
Private Enum InternalStateConstants
istFreeState 'default
istConnect
istGetCurrentDirectory
istSetCurrentDirectory
istCreateDirectory
istRemoveDirectory
istRenameFile
istDeleteFile
istDownloadFile
istUploadFile
istEnumFiles
istQuitSession
End Enum
Public Enum FtpSessionStates
ftpFreeState
ftpClosed
ftpConnecting
ftpConnected
ftpAuthentication
ftpUserLoggedIn
ftpChangingCurrentDirectory
ftpDeletingFile
ftpRemovingDirectory
ftpCreatingDirectory
ftpRenamingFile
ftpEstablishingDataConnection
ftpDataConnectionEstablished
ftpRetrievingDirectoryInfo
ftpDirectoryInfoRetrieved
ftpDownloadInProgress
ftpDownloadCompleted
ftpUploadInProgress
ftpUploadCompleted
ftpQuitingSession
End Enum
Public Enum AsyncResultStatusConstants
arStatusOk
arStatusError
arStatusTimeOut
arStatusCancel
End Enum
Public Enum FtpTransferModes
FTP_ASCII_MODE
FTP_IMAGE_MODE
End Enum
Public Enum SessionProtocolMessageTypes
FTP_USER_COMMAND
FTP_SERVER_RESPONSE
FTP_SERVER_BAD_RESPONSE
FTP_APPLICATION_MESSAGE
End Enum
Private Const RESPONSE_CODE_LENGHT = 3
Private Const FTP_CLIENT_BASE_ERROR = 16000
Private m_varInternalState As InternalStateConstants
Private m_strControlBuffer As String
Private m_strNewFileName As String
Private m_strRemoteFileName As String
Private m_strLocalFileName As String
Private m_blnOverWriteFile As Boolean
Private m_intLocalFile As Integer
Private m_strUserName As String
Private m_strPassword As String
Private m_varFtpServer As Variant
Private m_lngRemotePort As Long
Private m_strCurrentDirectory As String
Private m_bPassiveMode As Boolean
Private m_intTimeOut As Integer
Private m_strFtpServerMessage As String
Private m_strLastSentCommand As String
Private m_TransferMode As FtpTransferModes
Private m_lngDownloadedBytes As Long
Private m_lngUploadedBytes As Long
Private m_strDataSocketBuffer As String
Private m_objFtpFiles As CFtpFiles
Private m_strFtpFilesText As String
Private m_lngStartPositioon As Long
Private m_lngBytesToUpload As Long
Private m_varFtpSessionState As FtpSessionStates
Private m_lngLocalPort As Long
Private m_strLastServerResponse As String
Private m_intSendBufferLenght As Integer
Private m_blnTransferComplete As Boolean
Private arrDataToSend() As Byte
Private WithEvents m_objTimeOut As CTimeout
Attribute m_objTimeOut.VB_VarHelpID = -1
Private WithEvents m_objControlSocket As CSocket
Attribute m_objControlSocket.VB_VarHelpID = -1
Private WithEvents m_objDataSocket As CSocket
Attribute m_objDataSocket.VB_VarHelpID = -1
Private m_objFtpError As CFtpError
'
Public Event OnConnect(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnCreateDirectory(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnDeleteFile(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnGetCurrentDirectory(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnSetCurrentDirectory(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnRemoveDirectory(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnRenameFile(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnDownloadFile(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnUploadFile(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnEnumFiles(ByVal AsyncResultStatus As AsyncResultStatusConstants)
Public Event OnDataTransferProgress(ByVal lngBytesTransferred As Long)
Public Event SessionProtocolMessage(ByVal strMessage As String, ByVal MessageType As SessionProtocolMessageTypes)
Public Event OnStateChange(ByVal SessionState As FtpSessionStates)
Public Event OnQuitSession(ByVal AsyncResultStatus As AsyncResultStatusConstants)
'
Public Sub ClearFileList()
Set m_objFtpFiles = Nothing
End Sub
Public Sub Connect()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'Purpose :Starts the connection establishment process.
'Description :This is an asynchronous method. The completion event is the OnConnect.
'
' The Connect method performs also the user authentication and
' retrieving the initial current (working) directory on the FTP server.
' All the FTP commands for these operations will be sent from the
' m_objControlSocket_OnDataArrival event handler procedure as soon as
' the corresponding server responses will be received.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
If Len(m_varFtpServer) = 0 Then
'
Err.Raise 380, "CFtpClient.Connect", "Invalid property value."
'
Else
'
'If no UserName provided by the user,
'login the user as an anonymous one
'
If Len(m_strUserName) = 0 Then
m_strUserName = "anonymous"
m_strPassword = "someone@somehost.com"
End If
'
'Change value of the FtpSessionState property
m_varFtpSessionState = ftpConnecting
RaiseEvent OnStateChange(ftpConnecting)
'
'Reset values of the following vars as they may store
'something for the previous FTP session.
m_strLastSentCommand = ""
m_strControlBuffer = ""
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istConnect)
'
'Call the Connect method of the CSocket class just to
'establish a TCP connection with the server.
m_objControlSocket.Connect m_varFtpServer, m_lngRemotePort
'
'If the connection is established successfully, the server sends
'the welcome message with the response code 220, and then, from the
'm_objControlSocket_OnDataArrival event procedure the USER FTP command
'will be sent in order to start the user authentication process.
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
'The most possible error here - sckAlreadyConnected = 10056
'So be sure that you have closed the previous FTP session
'before to call the Connect method.
'
If m_varInternalState = istConnect Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.Connect failed: " & .Description
End With
'
End Sub
Public Sub SetCurrentDirectory(ByVal strDirectoryPath As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of changing the current (working) directory.
' In terms of FTP it sends the CWD FTP command to the server.
' CWD = Change Working Directory.
'
'Description :This is an asynchronous method. The completion event is the
' OnSetCurrentDirectory.
'
'Argument :The strDirectoryPath contains the name of the directory to change
' to on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
If Len(strDirectoryPath) > 0 Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istSetCurrentDirectory)
'Send the CWD FTP command to the server
Call SendFtpCommand("CWD", strDirectoryPath)
'
Else
'
Err.Raise 5, "CFtpClient.SetCurrentDirectory", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.SetCurrentDirectory", _
"Cannot execute the SetCurrentDirectory method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istSetCurrentDirectory Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.SetCurrentDirectory failed: " & .Description
End With
'
End Sub
Public Sub GetCurrentDirectory()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of retrieving the current (working) directory path.
' In terms of FTP it sends the PWD FTP command to the server.
' PWD = Print Working Directory.
'
'Description :This is an asynchronous method. The completion event is the
' OnGetCurrentDirectory.
'
' Since this is an asynchronous method, it doesn't return any
' value. The retrieved directory path will be placed in the
' CurrentDirectory property that you should read after the
' OnGetCurrentDirectory event.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istGetCurrentDirectory)
'Send the PWD FTP command to the server
Call SendFtpCommand("PWD", "")
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.GetCurrentDirectory", _
"Cannot execute the GetCurrentDirectory method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istGetCurrentDirectory Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.GetCurrentDirectory failed: " & .Description
End With
'
End Sub
Public Sub CreateDirectory(ByVal strDirectoryPath As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the creating of a new directory.
' In terms of FTP it sends to the server the MKD FTP command with the
' new directory path as an argument.
' MKD = Make Directory.
'
'Description :This is an asynchronous method. The completion event is the
' OnCreateDirectory.
'
'Argument :The strDirectoryPath contains the name of the directory to create
' on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
If Len(strDirectoryPath) > 0 Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istCreateDirectory)
'Send the MKD FTP command to the server
Call SendFtpCommand("MKD", strDirectoryPath)
'
Else
'
Err.Raise 5, "CFtpClient.CreateDirectory", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.CreateDirectory", _
"Cannot execute the CreateDirectory method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istCreateDirectory Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.CreateDirectory failed: " & .Description
End With
'
End Sub
Public Sub RemoveDirectory(ByVal strDirectoryPath As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the removing a directory.
' In terms of FTP it sends to the server the RMD FTP command with the
' path of the directory to remove.
' RMD = Remove Directory.
'
'Description :This is an asynchronous method. The completion event is the
' OnRemoveDirectory.
'
'Argument :The strDirectoryPath contains the name of the directory to remove
' on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
If Len(strDirectoryPath) > 0 Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istRemoveDirectory)
'Send the RMD FTP command to the server
Call SendFtpCommand("RMD", strDirectoryPath)
'
Else
'
Err.Raise 5, "CFtpClient.RemoveDirectory", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.RemoveDirectory", _
"Cannot execute the RemoveDirectory method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istRemoveDirectory Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.RemoveDirectory failed: " & .Description
End With
'
End Sub
Public Sub DeleteFile(ByVal strFilePath As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the deleting a file on the remote system.
' In terms of FTP it sends to the server the DELE FTP command with the
' path of the file to delete as an argument.
' DELE = Delete.
'
'Description :This is an asynchronous method. The completion event is the
' OnDeleteFile.
'
'Argument :The strFilePath contains the path to the file to delete
' on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
If Len(strFilePath) > 0 Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istDeleteFile)
'Send the DELE FTP command to the server
Call SendFtpCommand("DELE", strFilePath)
'
Else
'
Err.Raise 5, "CFtpClient.DeleteFile", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.DeleteFile", _
"Cannot execute the DeleteFile method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istDeleteFile Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.DeleteFile failed: " & .Description
End With
'
End Sub
Public Sub RenameFile(ByVal strOldFileName As String, ByVal strNewFileName As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the renaming a file on the remote system.
' In order to rename a file on the FTP server, we need to send
' two commands - the RNFR to specify the file to rename, and then,
' after receiving successful response from the server, the RNTO one
' to specify the new file name.
' RNFR = Rename From.
' RNTO = Rename To.
'
'Description :This is an asynchronous method. The completion event is the
' OnRenameFile.
'
'Argument :strOldFileName - path to the file to rename
' strNewFileName - new name for the file
'
' Both arguments can be either fully qualified paths
' or names relative to the current directory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
If Len(strOldFileName) > 0 And Len(strNewFileName) > 0 Then
'
m_strNewFileName = strNewFileName
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istRenameFile)
'Send the RNFR FTP command to the server
Call SendFtpCommand("RNFR", strOldFileName)
'
'If the successful response will be received on this command,
'the RNTO command will be sent from the m_objControlSocket_OnDataArrival
'event handler procedure.
'
Else
'
Err.Raise 5, "CFtpClient.RenameFile", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.RenameFile", _
"Cannot execute the RenameFile method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istRenameFile Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.RenameFile failed: " & .Description
End With
'
End Sub
Public Sub DownloadFile(ByVal strRemoteFilePath As String, ByVal strLocalFilePath As String, ByVal OverWrite As Boolean)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the downloading of a file from the server to
' the local system. In terms of FTP it sends to the server the RETR
' FTP command with the path of the file to download as an argument.
'
' But before sending the RETR command the data connection must be
' established and other options of the data transfer should be
' defined. The client specifies the data type with the TYPE FTP
' command and sends the REST command in the case when it needs
' to resume the previously broken data transfer.
'
' TYPE = Type
' RETR = Retrieve
' REST = Restart
'
'Description :This is an asynchronous method. The completion event is the
' OnDeleteFile.
'
'Arguments :The strRemoteFilePath contains the path to the file to retrieve
' on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
' The strLocalFilePath argument specifies the path on the local
' file system where the downloaded file will be stored.
'
' The OverWrite argument specifies the behavior of the CFtpClient class
' in the case when the local file with the same name is already exists.
'
'********************************************************************************
'
Dim strMode As String
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
'Both arguments must be initialized, otherwise the error
'"Invalid procedure call or argument" occurs.
'
If Len(strRemoteFilePath) > 0 And Len(strLocalFilePath) > 0 Then
'
'Store the arguments values in the module level variables.
m_strRemoteFileName = strRemoteFilePath
m_strLocalFileName = strLocalFilePath
m_blnOverWriteFile = OverWrite
'Reset the downloaded bytes counter.
m_lngDownloadedBytes = 0
'
'Read the TransferMode property of the class in order to
'get the argument for the TYPE FTP command.
strMode = CStr(IIf(m_TransferMode = FTP_ASCII_MODE, "A", "I"))
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istDownloadFile)
'Send the TYPE FTP command to the server
Call SendFtpCommand("TYPE", strMode)
'
'If the successful response will be received on the TYPE command,
'the PORT or PASV command will be sent from the m_objControlSocket_OnDataArrival
'event handler procedure in order to establish the data connection.
'
'If restarting of data transfer is needed the REST command will be sent
'later, from the OpenLocalFile subroutine which is called before sending
'the RETR FTP command.
'
Else
'
Err.Raise 5, "CFtpClient.DownloadFile", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.DownloadFile", _
"Cannot execute the DownloadFile method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istDownloadFile Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.DownloadFile failed: " & .Description
End With
'
End Sub
Public Sub EnumFiles()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the retrieving the current directory listing
' on the remote system. To perform this operation the LIST FTP command
' is used. The LIST command retrieves name, size, last write time and
' other properties of every file and subdirectory located in the current
' directory.
'
' But before sending the LIST command the data type should be specified
' with the TYPE FTP command and the data connection must be established
' as directory listings are transferred only via the data connection.
'
'Description :This is an asynchronous method. The completion event is the
' OnEnumFiles. As soon as this event has been occurred you can
' read the current directory listing with the CurrentDirectoryFiles
' property of the CFtpClient class. This property is an instance of
' the CFtpFiles collection. Each item of that collection is an instance
' of the CFtpFiles class which represents a single file or subdirectory.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istEnumFiles)
'Send the TYPE FTP command to the server
Call SendFtpCommand("TYPE", "A")
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.EnumFiles", _
"Cannot execute the EnumFiles method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istEnumFiles Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.EnumFiles failed: " & .Description
End With
'
End Sub
Public Sub UploadFile(ByVal strLocalFile As String, ByVal strRemoteFile As String, ByVal lngStartPosition As Long)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of the uploading a file from the local system
' to the FTP server. In terms of FTP it sends to the server the STOR
' FTP command with the path to the file to store on the remote system
' as an argument.
'
' But before sending the STOR command the data connection must be
' established and other options of the data transfer should be
' defined. The client specifies the data type with the TYPE FTP
' command and sends the REST command in the case when it needs
' to resume the previously broken data transfer.
'
' TYPE = Type
' STOR = Store
' REST = Restart
'
'Description :This is an asynchronous method. The completion event is the
' OnUploadFile.
'
'Arguments :The strLocalFilePath argument specifies the path to the file
' on the local system that is going to be uploaded.
'
' The strRemoteFilePath contains the path to the file to store
' on the remote system. This can be either a fully qualified path
' or a name relative to the current directory.
'
' If the file with the specified name already exists on the remote
' system and the lngStartPosition argument is not 0, the CFtpClient
' class skips the part of the local file and starts the reading
' and transfer of the file data at the specified position.
'
'********************************************************************************
'
Dim strMode As String
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
'Both arguments must be initialized, otherwise the error
'"Invalid procedure call or argument" occurs.
'
If Len(strRemoteFile) > 0 And Len(strLocalFile) > 0 Then
'
'Store the arguments values in the module level variables.
m_strRemoteFileName = strRemoteFile
m_strLocalFileName = strLocalFile
m_lngStartPositioon = lngStartPosition
'
ReDim arrDataToSend(m_intSendBufferLenght - 1)
'
'Read the TransferMode property of the class in order to
'get the argument for the TYPE FTP command.
strMode = CStr(IIf(m_TransferMode = FTP_ASCII_MODE, "A", "I"))
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istUploadFile)
'Send the TYPE FTP command to the server
Call SendFtpCommand("TYPE", strMode)
'
Else
'
Err.Raise 5, "CFtpClient.UploadFile", "Invalid procedure call or argument"
'
End If
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.UploadFile", _
"Cannot execute the UploadFile method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istUploadFile Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.UploadFile failed: " & .Description
End With
'
End Sub
Public Sub QuitSession()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Starts the process of quiting from the current FTP session.
' In terms of FTP it sends the QUIT FTP command to the server.
'
'Description :This is an asynchronous method. The completion event is the
' OnQuitSession.
'
' As the QUIT command is received from the client, the FTP server
' must send the reply code 221 and close the control connection.
'
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
'If the class is not busy executing another asynchronous method, we can go on.
If m_varInternalState = istFreeState Then
'
'Turn the class into the "waiting for server response" state
Call BeginAsyncMethod(istQuitSession)
'Send the QUIT FTP command to the server
Call SendFtpCommand("QUIT", "")
'
Else
'
Err.Raise FTP_CLIENT_BASE_ERROR + 7, "CFtpClient.QuitSession", _
"Cannot execute the QuitSession method. " & _
"Waiting fot the server response on the previous command."
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
If m_varInternalState = istQuitSession Then
Call EndAsyncMethod
End If
'
With Err
.Raise .Number, .Source, "CFtpClient.QuitSession failed: " & .Description
End With
'
End Sub
Private Sub CloseDataConnection()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'Purpose :Closes the socket responsible for the data connection.
'********************************************************************************
'
On Error GoTo ERROR_HANDLER
'
Dim lngRetValue As Long
'
If Not m_objDataSocket.State = sckClosed Then
'
'Some FTP servers ignore the TCP FIN segment sent by a client
'to the data connection. This is exactly what the CSocket does
'when the CloseSocket method is called:
'
'shutdown(m_lngSocketHandle, SD_SEND)
'
'the CSocket class calls the closesocket Winsock API function
'only if the reciprocal FIN TCP segment is received from the server.
'But some servers do not send it, and continue sending data. Imagine
'you are going to cancel 700 MB file transfer due to the slow speed
'of the data transfer - you could wait forever.
'
'So, here is a litle interference in the CSocket class implementation:
'
lngRetValue = shutdown(m_objDataSocket.SocketHandle, SD_BOTH)
'
'With such a call of the shutdown Winsock API function the server
'will have got the RST TCP segment in return on any chunk of data
'sent once we have called this method.
'
m_objDataSocket.CloseSocket
'
End If
'
Exit Sub
'
ERROR_HANDLER:
'
With Err
.Raise .Number, .Source, "CFtpClient.CloseDataConnection failed: " & .Description
End With
'
End Sub
Public Sub CancelAsyncMethod()
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'
'Purpose :Cancels any asynchronous method performed by the class.
'
' In other words, takes the class off the waiting state - stops the
' timer and changes a value of the m_varInternalState variable
' with the call of the EndAsyncMethod subroutine, and then raises
' the appropriate event.
'
' If any data transfer is in progress, this method closes the data
' connection calling the CloseDataConnection subroutine. If that
' data transfer is either the downloading or uploading operation,
' the method closes the local file using the CloseLocalFile.
'
'********************************************************************************
'
Dim varIntState As InternalStateConstants
'
On Error GoTo ERROR_HANDLER
'
varIntState = m_varInternalState
'
Call EndAsyncMethod
'
Select Case varIntState
'
Case istConnect
RaiseEvent OnConnect(arStatusCancel)
Case istCreateDirectory
RaiseEvent OnCreateDirectory(arStatusCancel)
Case istDeleteFile
RaiseEvent OnDeleteFile(arStatusCancel)
Case istGetCurrentDirectory
RaiseEvent OnGetCurrentDirectory(arStatusCancel)
Case istRemoveDirectory
RaiseEvent OnRemoveDirectory(arStatusCancel)
Case istRenameFile
RaiseEvent OnRenameFile(arStatusCancel)
Case istSetCurrentDirectory
RaiseEvent OnSetCurrentDirectory(arStatusCancel)
Case istEnumFiles
m_strDataSocketBuffer = ""
Call CloseDataConnection
RaiseEvent OnEnumFiles(arStatusCancel)
Case istDownloadFile
Call CloseDataConnection
Call CloseLocalFile
RaiseEvent OnDownloadFile(arStatusCancel)
Case istUploadFile
Call CloseDataConnection
Call CloseLocalFile
RaiseEvent OnUploadFile(arStatusCancel)
'
End Select
'
Exit Sub
'
ERROR_HANDLER:
'
With Err
.Raise .Number, .Source, "CFtpClient.CancelAsyncMethod failed: " & .Description
End With
'
End Sub
Private Sub SendFtpCommand(strCommand As String, strArguments As String)
'********************************************************************************
'Author :Oleg Gdalevich
'Date/Time :08-13-2002
'Purpose :Sends an FTP command to the FTP server.
'Arguments :strCommand - the FTP command to send
' strArguments - any arguments to send with the command