home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / realftp / testftp.bas < prev    next >
Encoding:
BASIC Source File  |  1997-04-20  |  17.4 KB  |  515 lines
  1. Attribute VB_Name = "Module1"
  2. Option Base 1
  3. Dim hi, lo, returncode, returncode2, savedata, strdata, strdata2 As String
  4. Dim asciilist, receiving, isdone, isready, lastpacket As Boolean
  5. Dim CurrentByte, totalreceived, receivesize, TotalByte As Long
  6. Dim transferstate As Integer
  7. Dim b(1024) As Byte
  8. Dim ba() As Byte
  9. Dim Elapsed, f, x, c, o As Long
  10. Dim temp, myip, os, saveport As String
  11. Dim ob As Byte
  12. Dim Rate As Double
  13. Public ftpcompleted As Integer
  14.  
  15. Private Sub Timer1_Timer()
  16. Elapsed = Elapsed + 1
  17. If CurrentByte > 0 And TotalByte > 0 Then
  18. ftpcompleted = CurrentByte / TotalByte * 100
  19. Rate = CurrentByte / Elapsed / 1000
  20. End If
  21. End Sub
  22.  
  23. Private Sub Winsock1_SendComplete(): isready = True: End Sub
  24.  
  25. Private Sub Winsock2_SendComplete(): isdone = True: End Sub
  26.  
  27. Private Sub Winsock1_DataArrival(ByVal bytestotal As Long)
  28.     winsock1.GetData strdata
  29.     If isready Then returncode = Left(strdata, 3)
  30.     If returncode = "221" Then savedata = strdata
  31.     If returncode = "227" Then savedata = strdata
  32.     If returncode = "150" Then savedata = strdata
  33. End Sub
  34.  
  35. Private Sub Winsock2_DataArrival(ByVal bytestotal As Long)
  36. transferstate = 0
  37. If receiving Then transferstate = 1
  38. If asciilist Then transferstate = 2
  39. Select Case transferstate
  40. Case 0: winsock2.GetData strdata2
  41. Case 1: winsock2.GetData ba(): Put #1, , ba()
  42.     totalreceived = totalreceived + bytestotal
  43.     CurrentByte = CurrentByte + bytestotal
  44. Case 2: winsock2.GetData strdata2: Write #1, strdata2
  45. End Select
  46.  
  47.     If isdone Then returncode = Left(strdata2, 3)
  48. End Sub
  49. Private Sub winsock2_ConnectionRequest(ByVal requestID As Long)
  50.     If winsock2.State <> sckClosed Then winsock2.Close
  51.     winsock2.Accept requestID
  52. End Sub
  53.  
  54. Public Sub LogonSendFile(FtpAddress As String, UserName As String, Password As String, LocalFileName As String, RemoteFileName As String)
  55.     Elapsed = 0
  56.     lastpacket = False
  57.     receiving = False
  58.     winsock1.RemoteHost = FtpAddress
  59.     winsock1.RemotePort = 21
  60.     winsock1.Protocol = sckTCPProtocol
  61.     winsock1.Connect
  62.     
  63. resetwinsock:
  64.  
  65.     While winsock1.State = 9
  66.     If winsock1.State <> sckClosed Then
  67.     winsock1.Close
  68.     While winsock1.State <> sckClosed: DoEvents: Wend
  69.     End If
  70.     winsock1.Connect
  71.     DoEvents
  72.     Wend
  73.     
  74.     While winsock1.State <> sckConnected
  75.     If winsock1.State = 9 Then GoTo resetwinsock
  76.     DoEvents
  77.     Wend
  78.     
  79.     While returncode <> "220": DoEvents: Wend
  80.     
  81.     temp = winsock1.LocalIP: myip = ""
  82.     For x = 1 To Len(temp)
  83.     If Mid(temp, x, 1) = "." Then myip = myip + "," Else myip = myip + Mid(temp, x, 1)
  84.     Next x
  85.     
  86.     winsock1.SendData "user " + UserName + Chr(13) + Chr(10)
  87.     While returncode <> "331": DoEvents: Wend
  88.     
  89.     winsock1.SendData "pass " + Password + Chr(13) + Chr(10)
  90.     While returncode <> "230": DoEvents: Wend
  91.     
  92.     'request port assignment from remote
  93.     
  94.     winsock1.SendData "pasv" + Chr(13) + Chr(10)
  95.     While returncode <> "227": DoEvents: Wend
  96.     For x = 1 To 4: savedata = Right(savedata, Len(savedata) - InStr(1, savedata, ",")): Next x
  97.     savedata = Left(savedata, Len(savedata) - 3)
  98.     hi = Left(savedata, InStr(1, savedata, ",") - 1)
  99.     lo = Right(savedata, Len(savedata) - (Len(hi) + 1))
  100.             
  101.             isready = False
  102.             
  103.             'open data port
  104.             
  105.             winsock2.LocalPort = Val(hi) * 256 + Val(lo)
  106.             winsock2.Listen
  107.             
  108.             winsock1.SendData "port " + myip + "," + savedata + Chr(13) + Chr(10)
  109.             While returncode <> "200": DoEvents: Wend
  110.             
  111.             winsock1.SendData "type i" + Chr(13) + Chr(10)
  112.             While returncode <> "200": DoEvents: Wend
  113.             
  114.             winsock1.SendData "stor " + RemoteFileName + Chr(13) + Chr(10)
  115.             While returncode <> "150": DoEvents: Wend
  116.             While winsock2.State <> sckConnected: DoEvents: Wend
  117.  
  118.             'send data to remote
  119.             
  120.             'read file in 1k chunks
  121.             
  122.             f = FileLen(LocalFileName)
  123.             If f > 1024 Then c = Int(f / 1024): o = f - (c * 1024) Else o = f
  124.             TotalByte = f
  125.             Open LocalFileName For Binary Access Read As #1
  126.             lastpacket = False
  127.             
  128.             If f > 1024 Then
  129.             For x = 1 To c
  130.             isdone = False
  131.             Get 1, , b()
  132.             winsock2.SendData b()
  133.             CurrentByte = CurrentByte + 1024
  134.             While Not isdone: DoEvents: Wend
  135.             Next x
  136.             End If
  137.                         
  138.             os = ""
  139.             If o = 0 Then lastpacket = True: isdone = True
  140.             
  141.             If o > 0 Then
  142.             isdone = False
  143.             For x = 1 To o
  144.             Get 1, , ob: os = os + Chr(ob)
  145.             CurrentByte = CurrentByte + 1
  146.             Next x
  147.             winsock2.SendData os
  148.             While Not isdone: DoEvents: Wend
  149.             lastpacket = True
  150.             isdone = True
  151.             End If
  152.             
  153.             'close data port
  154.             
  155.             If lastpacket Then
  156.             Close #1
  157.             winsock2.Close
  158.             winsock1.SendData "quit" + Chr(13) + Chr(10)
  159.             While returncode <> "221": DoEvents: Wend
  160.             winsock1.Close
  161.             While winsock1.State <> sckClosed: DoEvents: Wend
  162.             While winsock2.State <> sckClosed: DoEvents: Wend
  163.             CurrentByte = 0
  164.             TotalByte = 0
  165.             Elapsed = 0
  166.             End If
  167.             
  168. End Sub
  169. Public Sub LogonGetFile(FtpAddress As String, UserName As String, Password As String, LocalFileName As String, RemoteFileName As String)
  170.     receiving = True
  171.     Elapsed = 0
  172.     winsock1.RemoteHost = FtpAddress
  173.     winsock1.RemotePort = 21
  174.     winsock1.Protocol = sckTCPProtocol
  175.     winsock1.Connect
  176.     
  177. resetwinsock:
  178.  
  179.     While winsock1.State = 9
  180.     If winsock1.State <> sckClosed Then
  181.     winsock1.Close
  182.     While winsock1.State <> sckClosed: DoEvents: Wend
  183.     End If
  184.     winsock1.Connect
  185.     DoEvents
  186.     Wend
  187.     
  188.     While winsock1.State <> sckConnected
  189.     If winsock1.State = 9 Then GoTo resetwinsock
  190.     DoEvents
  191.     Wend
  192.     
  193.     While returncode <> "220": DoEvents: Wend
  194.     
  195.     temp = winsock1.LocalIP: myip = ""
  196.     For x = 1 To Len(temp)
  197.     If Mid(temp, x, 1) = "." Then myip = myip + "," Else myip = myip + Mid(temp, x, 1)
  198.     Next x
  199.     
  200.     winsock1.SendData "user " + UserName + Chr(13) + Chr(10)
  201.     While returncode <> "331": DoEvents: Wend
  202.     
  203.     winsock1.SendData "pass " + Password + Chr(13) + Chr(10)
  204.     While returncode <> "230": DoEvents: Wend
  205.     
  206.     winsock1.SendData "pasv" + Chr(13) + Chr(10)
  207.     While returncode <> "227": DoEvents: Wend
  208.     For x = 1 To 4: savedata = Right(savedata, Len(savedata) - InStr(1, savedata, ",")): Next x
  209.     savedata = Left(savedata, Len(savedata) - 3)
  210.     hi = Left(savedata, InStr(1, savedata, ",") - 1)
  211.     lo = Right(savedata, Len(savedata) - (Len(hi) + 1))
  212.             
  213.             isready = False
  214.             
  215.             winsock2.LocalPort = Val(hi) * 256 + Val(lo)
  216.             winsock2.Listen
  217.             
  218.             winsock1.SendData "port " + myip + "," + savedata + Chr(13) + Chr(10)
  219.             While returncode <> "200": DoEvents: Wend
  220.             
  221.             winsock1.SendData "type i" + Chr(13) + Chr(10)
  222.             While returncode <> "200": DoEvents: Wend
  223.                         
  224.             buffer = ""
  225.             totalreceived = 0
  226.  
  227.             Open LocalFileName For Binary Access Write As #1
  228.  
  229.             c = 0
  230.             winsock1.SendData "retr " + RemoteFileName + Chr(13) + Chr(10)
  231.             While returncode <> "150": DoEvents: Wend
  232.             savedata = Mid(savedata, InStr(1, savedata, "(") + 1, InStr(1, savedata, ")") - InStr(1, savedata, "(") - 7)
  233.             receivesize = Val(savedata)
  234.             bytestotal = receivesize
  235.             While winsock2.State = sckConnected: DoEvents: Wend
  236.             If winsock2.State <> sckConnected Then
  237.             Close #1
  238.             winsock2.Close
  239.             winsock1.SendData "quit" + Chr(13) + Chr(10)
  240.             While returncode <> "221": DoEvents: Wend
  241.             winsock1.Close
  242.             While winsock1.State <> sckClosed: DoEvents: Wend
  243.             While winsock2.State <> sckClosed: DoEvents: Wend
  244.             CurrentByte = 0
  245.             TotalByte = 0
  246.             Elapsed = 0
  247.             End If
  248.             
  249. End Sub
  250. Public Sub Logon(ByVal FtpAddress As String, ByVal UserName As String, ByVal Password As String)
  251.     
  252.     winsock1.RemoteHost = FtpAddress
  253.     winsock1.RemotePort = 21
  254.     winsock1.Protocol = sckTCPProtocol
  255.     winsock1.Connect
  256.     
  257. resetwinsock:
  258.  
  259.     While winsock1.State = 9
  260.     If winsock1.State <> sckClosed Then
  261.     winsock1.Close
  262.     While winsock1.State <> sckClosed: DoEvents: Wend
  263.     End If
  264.     winsock1.Connect
  265.     DoEvents
  266.     Wend
  267.     
  268.     While winsock1.State <> sckConnected
  269.     If winsock1.State = 9 Then GoTo resetwinsock
  270.     DoEvents
  271.     Wend
  272.     
  273.     While returncode <> "220": DoEvents: Wend
  274.     
  275.     winsock1.SendData "user " + UserName + Chr(13) + Chr(10)
  276.     While returncode <> "331": DoEvents: Wend
  277.     
  278.     winsock1.SendData "pass " + Password + Chr(13) + Chr(10)
  279.     While returncode <> "230": DoEvents: Wend
  280.  
  281. End Sub
  282. Public Sub SendFile(LocalFileName As String, RemoteFileName As String)
  283.     While winsock1.State <> sckConnected: DoEvents: Wend
  284.  
  285.     lastpacket = False
  286.     receiving = False
  287.     Elapsed = 0
  288.     
  289.     temp = winsock1.LocalIP: myip = ""
  290.     For x = 1 To Len(temp)
  291.     If Mid(temp, x, 1) = "." Then myip = myip + "," Else myip = myip + Mid(temp, x, 1)
  292.     Next x
  293.     
  294.     'request port assignment from remote
  295.     
  296.     winsock1.SendData "pasv" + Chr(13) + Chr(10)
  297.     While returncode <> "227": DoEvents: Wend
  298.     For x = 1 To 4: savedata = Right(savedata, Len(savedata) - InStr(1, savedata, ",")): Next x
  299.     savedata = Left(savedata, Len(savedata) - 3)
  300.     hi = Left(savedata, InStr(1, savedata, ",") - 1)
  301.     lo = Right(savedata, Len(savedata) - (Len(hi) + 1))
  302.             
  303.             isready = False
  304.             
  305.             'open data port
  306.             
  307.             winsock2.LocalPort = Val(hi) * 256 + Val(lo)
  308.             winsock2.Listen
  309.             
  310.             winsock1.SendData "port " + myip + "," + savedata + Chr(13) + Chr(10)
  311.             While returncode <> "200": DoEvents: Wend
  312.             
  313.             winsock1.SendData "type i" + Chr(13) + Chr(10)
  314.             While returncode <> "200": DoEvents: Wend
  315.             
  316.             winsock1.SendData "stor " + RemoteFileName + Chr(13) + Chr(10)
  317.             While returncode <> "150": DoEvents: Wend
  318.             While winsock2.State <> sckConnected: DoEvents: Wend
  319.  
  320.             'send data to remote
  321.             
  322.             'read file in 1k chunks
  323.             
  324.             f = FileLen(LocalFileName)
  325.             If f > 1024 Then c = Int(f / 1024): o = f - (c * 1024) Else o = f
  326.             Open LocalFileName For Binary Access Read As #1
  327.             lastpacket = False
  328.             TotalByte = f
  329.             If f > 1024 Then
  330.             For x = 1 To c
  331.             isdone = False
  332.             Get 1, , b()
  333.             winsock2.SendData b()
  334.             CurrentByte = CurrentByte + 1024
  335.             While Not isdone: DoEvents: Wend
  336.             Next x
  337.             End If
  338.                         
  339.             os = ""
  340.             If o = 0 Then lastpacket = True: isdone = True
  341.             
  342.             If o > 0 Then
  343.             isdone = False
  344.             For x = 1 To o
  345.             Get 1, , ob: os = os + Chr(ob)
  346.             CurrentByte = CurrentByte + 1
  347.             Next x
  348.             winsock2.SendData os
  349.             While Not isdone: DoEvents: Wend
  350.             lastpacket = True
  351.             isdone = True
  352.             End If
  353.             
  354.             'close data port
  355.             
  356.             If lastpacket Then
  357.             Close #1
  358.             winsock2.Close
  359.             While winsock2.State <> sckClosed: DoEvents: Wend
  360.             CurrentByte = 0
  361.             TotalByte = 0
  362.             Elapsed = 0
  363.             End If
  364.             
  365. End Sub
  366. Public Sub CloseFtp()
  367.             winsock1.SendData "quit" + Chr(13) + Chr(10)
  368.             While returncode <> "221": DoEvents: Wend
  369.             winsock1.Close
  370.             While winsock1.State <> sckClosed: DoEvents: Wend
  371. End Sub
  372. Public Sub GetFile(LocalFileName As String, RemoteFileName As String)
  373.     receiving = True
  374.     Elapsed = 0
  375.     While winsock1.State <> sckConnected: DoEvents: Wend
  376.     
  377.     temp = winsock1.LocalIP: myip = ""
  378.     For x = 1 To Len(temp)
  379.     If Mid(temp, x, 1) = "." Then myip = myip + "," Else myip = myip + Mid(temp, x, 1)
  380.     Next x
  381.     
  382.     winsock1.SendData "pasv" + Chr(13) + Chr(10)
  383.     While returncode <> "227": DoEvents: Wend
  384.     For x = 1 To 4: savedata = Right(savedata, Len(savedata) - InStr(1, savedata, ",")): Next x
  385.     savedata = Left(savedata, Len(savedata) - 3)
  386.     hi = Left(savedata, InStr(1, savedata, ",") - 1)
  387.     lo = Right(savedata, Len(savedata) - (Len(hi) + 1))
  388.             
  389.             isready = False
  390.             
  391.             winsock2.LocalPort = Val(hi) * 256 + Val(lo)
  392.             winsock2.Listen
  393.             
  394.             winsock1.SendData "port " + myip + "," + savedata + Chr(13) + Chr(10)
  395.             While returncode <> "200": DoEvents: Wend
  396.             
  397.             winsock1.SendData "type i" + Chr(13) + Chr(10)
  398.             While returncode <> "200": DoEvents: Wend
  399.                         
  400.             buffer = ""
  401.             totalreceived = 0
  402.  
  403.             Open LocalFileName For Binary Access Write As #1
  404.  
  405.             c = 0
  406.             winsock1.SendData "retr " + RemoteFileName + Chr(13) + Chr(10)
  407.             While returncode <> "150": DoEvents: Wend
  408.             savedata = Mid(savedata, InStr(1, savedata, "(") + 1, InStr(1, savedata, ")") - InStr(1, savedata, "(") - 7)
  409.             receivesize = Val(savedata)
  410.             TotalByte = receivesize
  411.             While winsock2.State = sckConnected: DoEvents: Wend
  412.  
  413.             If winsock2.State <> sckConnected Then
  414.             Close #1
  415.             winsock2.Close
  416.             While winsock2.State <> sckClosed: DoEvents: Wend
  417.             CurrentByte = 0
  418.             TotalByte = 0
  419.             Elapsed = 0
  420.             End If
  421.             
  422.  
  423. End Sub
  424. Public Sub GetDir(ByVal LocalFileName As String, ByVal Params As String)
  425. asciilist = True
  426.  
  427.     If Params <> "" Then Params = "-" + Params
  428.     receiving = True
  429.     Elapsed = 0
  430.     While winsock1.State <> sckConnected: DoEvents: Wend
  431.     
  432.     temp = winsock1.LocalIP: myip = ""
  433.     For x = 1 To Len(temp)
  434.     If Mid(temp, x, 1) = "." Then myip = myip + "," Else myip = myip + Mid(temp, x, 1)
  435.     Next x
  436.     
  437.     winsock1.SendData "pasv" + Chr(13) + Chr(10)
  438.     While returncode <> "227": DoEvents: Wend
  439.     For x = 1 To 4: savedata = Right(savedata, Len(savedata) - InStr(1, savedata, ",")): Next x
  440.     savedata = Left(savedata, Len(savedata) - 3)
  441.     hi = Left(savedata, InStr(1, savedata, ",") - 1)
  442.     lo = Right(savedata, Len(savedata) - (Len(hi) + 1))
  443.             
  444.             isready = False
  445.             
  446.             winsock2.LocalPort = Val(hi) * 256 + Val(lo)
  447.             winsock2.Listen
  448.             
  449.             winsock1.SendData "port " + myip + "," + savedata + Chr(13) + Chr(10)
  450.             While returncode <> "200": DoEvents: Wend
  451.             
  452.             winsock1.SendData "type a" + Chr(13) + Chr(10)
  453.             While returncode <> "200": DoEvents: Wend
  454.                         
  455.             buffer = ""
  456.             totalreceived = 0
  457.  
  458.             Open LocalFileName For Output As #1
  459.  
  460.             c = 0
  461.             winsock1.SendData "quote nlst " + Params + Chr(13) + Chr(10)
  462.             While returncode <> "150": DoEvents: Wend
  463.             While returncode <> "226": DoEvents: Wend
  464.             While winsock2.State = sckConnected: DoEvents: Wend
  465.                         
  466.             If winsock2.State <> sckConnected Then
  467.             Close #1
  468.             winsock2.Close
  469.             While winsock2.State <> sckClosed: DoEvents: Wend
  470.             End If
  471. asciilist = False
  472.  
  473. End Sub
  474. Public Sub ChangeDir(ByVal Directory As String)
  475.     winsock1.SendData "cwd " + Directory + Chr(13) + Chr(10)
  476.     While returncode <> "250": DoEvents: Wend
  477. End Sub
  478. Public Sub CreateDir(ByVal Directory As String)
  479.     winsock1.SendData "mkd " + Directory + Chr(13) + Chr(10)
  480.     While returncode <> "257": DoEvents: Wend
  481. End Sub
  482. Public Sub DeleteDir(ByVal Directory As String)
  483.     winsock1.SendData "dele " + Directory + Chr(13) + Chr(10)
  484.     While returncode <> "250": DoEvents: Wend
  485. End Sub
  486. Public Sub DeleteFile(FileName As String)
  487.     winsock1.SendData "dele " + FileName + Chr(13) + Chr(10)
  488.     While returncode <> "250": DoEvents: Wend
  489. End Sub
  490. Public Sub Site(SiteText As String)
  491.     winsock1.SendData "site " + SiteText + Chr(13) + Chr(10)
  492.     While returncode <> "250": DoEvents: Wend
  493. End Sub
  494. 'Public Sub Quote(QuoteText As String)
  495. '    Winsock1.SendData "quote " + SiteText + Chr(13) + Chr(10)
  496. '    While returncode <> "250": DoEvents: Wend
  497. 'End Sub
  498. Public Function TotalBytes() As Long
  499. TotalBytes = TotalByte
  500. End Function
  501. Public Function CurrentBytes() As Long
  502. CurrentBytes = CurrentByte
  503. End Function
  504. Public Function TransferRate() As String
  505. TransferRate = Format(Rate, "#00.00")
  506. End Function
  507. Public Function ElapsedTime() As Long
  508. ElapsedTime = Elapsed
  509. End Function
  510. Public Function CompletedPercent() As Integer
  511. CompletedPercent = ftpcompleted
  512. End Function
  513.  
  514.  
  515.