home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / acodec1g / ftpbrws.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-06-15  |  6.6 KB  |  203 lines
  1. VERSION 5.00
  2. Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form frmFTPBrowse 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "FTP Browser"
  7.    ClientHeight    =   4155
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   5040
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   4155
  14.    ScaleWidth      =   5040
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.TextBox txtContents 
  17.       Height          =   3735
  18.       Left            =   120
  19.       MultiLine       =   -1  'True
  20.       ScrollBars      =   2  'Vertical
  21.       TabIndex        =   2
  22.       Top             =   360
  23.       Width           =   4815
  24.    End
  25.    Begin VB.Timer tmrSaveFile 
  26.       Enabled         =   0   'False
  27.       Interval        =   10
  28.       Left            =   3480
  29.       Top             =   4560
  30.    End
  31.    Begin MSComDlg.CommonDialog dlgSave 
  32.       Left            =   2160
  33.       Top             =   4440
  34.       _ExtentX        =   847
  35.       _ExtentY        =   847
  36.       _Version        =   393216
  37.       FontSize        =   1.17491e-38
  38.    End
  39.    Begin InetCtlsObjects.Inet inetBrowse 
  40.       Left            =   2760
  41.       Top             =   4440
  42.       _ExtentX        =   1005
  43.       _ExtentY        =   1005
  44.       _Version        =   393216
  45.       Protocol        =   2
  46.       RemotePort      =   21
  47.       URL             =   "ftp://"
  48.    End
  49.    Begin VB.TextBox txtAddress 
  50.       Height          =   285
  51.       Left            =   840
  52.       TabIndex        =   1
  53.       Top             =   0
  54.       Width           =   4095
  55.    End
  56.    Begin VB.Label Label1 
  57.       Caption         =   "&Address:"
  58.       Height          =   255
  59.       Left            =   120
  60.       TabIndex        =   0
  61.       Top             =   0
  62.       Width           =   735
  63.    End
  64. Attribute VB_Name = "frmFTPBrowse"
  65. Attribute VB_GlobalNameSpace = False
  66. Attribute VB_Creatable = False
  67. Attribute VB_PredeclaredId = True
  68. Attribute VB_Exposed = False
  69. Option Explicit
  70. Dim mstrTempDir As String
  71. Dim mstrDir As String
  72. 'API function
  73. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
  74.     (ByVal nBufferLength As Long, _
  75.     ByVal lpBuffer As String) As Long
  76. 'Get Windows temporary file path
  77. Private Sub Form_Load()
  78.     Dim lngLen As Long
  79.     lngLen = 144
  80.     mstrTempDir = Space(lngLen)
  81.     lngLen = GetTempPath(lngLen, mstrTempDir)
  82.     mstrTempDir = Left(mstrTempDir, lngLen)
  83. End Sub
  84. Private Sub txtAddress_KeyPress(KeyAscii As Integer)
  85.     If KeyAscii = Asc(vbCr) Then
  86.         'Eat keystroke
  87.         KeyAscii = 0
  88.         'Select text
  89.         txtAddress.SelStart = 0
  90.         txtAddress.SelLength = Len(txtAddress)
  91.         On Error GoTo errOpenURL
  92.         'Set FTP address to view
  93.         inetBrowse.URL = txtAddress
  94.         'Get directory
  95.         inetBrowse.Execute , "Dir "
  96.         txtAddress = inetBrowse.URL
  97.     End If
  98.     Exit Sub
  99. errOpenURL:
  100.     Select Case Err.Number
  101.         Case icBadUrl
  102.             MsgBox "Bad address. Please reenter."
  103.         Case icConnectFailed, icConnectionAborted, _
  104.             icCannotConnect
  105.             MsgBox "Unable to connect to network."
  106.         Case icInetTimeout
  107.             MsgBox "Connection timed out."
  108.         Case icExecuting
  109.             'Cancel previous request
  110.             inetBrowse.Cancel
  111.             'Check whether cancel worked
  112.             If inetBrowse.StillExecuting Then
  113.                 Caption = "Couldn't cancel request."
  114.             'Resubmit current request
  115.             Else
  116.                 Resume
  117.             End If
  118.         Case Else
  119.             Debug.Print Err.Number, Err.Description
  120.         End Select
  121. End Sub
  122. Private Sub txtContents_DblClick()
  123.     'Browse selected directory
  124.     If txtContents.SelLength Then
  125.         'If selection is a directory
  126.         If Right(txtContents.SelText, 1) = "/" Then
  127.             'Add selected item to address
  128.             txtAddress = txtAddress & "/" & _
  129.               Left(txtContents.SelText, _
  130.               txtContents.SelLength - 1)
  131.             'Trap errors (important!)
  132.             On Error GoTo errBrowse
  133.             'Show directory
  134.             mstrDir = Right(txtAddress, Len(txtAddress) _
  135.               - Len(inetBrowse.URL))
  136.             inetBrowse.Execute , "Dir " & mstrDir & "/*"
  137.         'Otherwise, it's a file, so retrieve it
  138.         Else
  139.             Dim strFilename
  140.             'Build pathname of file
  141.             mstrDir = Right(txtAddress, Len(txtAddress) _
  142.               - Len(inetBrowse.URL)) & "/" & _
  143.               txtContents.SelText
  144.             mstrDir = Right(mstrDir, Len(mstrDir) - 1)
  145.             strFilename = mstrDir
  146.             Do
  147.                 strFilename = Right(strFilename, _
  148.                     Len(strFilename) - InStr(strFilename, "/"))
  149.             Loop Until InStr(strFilename, "/") = 0
  150.             'Retrieve file
  151.             inetBrowse.Execute , "Get " & mstrDir & _
  152.                 " " & mstrTempDir & strFilename
  153.         End If
  154.     End If
  155.     Exit Sub
  156. errBrowse:
  157.     If Err = icExecuting Then
  158.         'Cancel previous request
  159.         inetBrowse.Cancel
  160.         'Check whether cancel worked
  161.         If inetBrowse.StillExecuting Then
  162.             Caption = "Couldn't cancel request."
  163.         'Resubmit current request
  164.         Else
  165.             Resume
  166.         End If
  167.     Else
  168.         'Display error
  169.         Debug.Print Err & " " & Err.Description
  170.     End If
  171. End Sub
  172. Private Sub inetBrowse_StateChanged(ByVal State As Integer)
  173.     Select Case State
  174.         Case icError
  175.             Debug.Print inetBrowse.ResponseCode & " " & _
  176.               inetBrowse.ResponseInfo
  177.         Case icResolvingHost, icRequesting, icRequestSent
  178.             Caption = "Searching..."
  179.         Case icHostResolved
  180.             Caption = "Found."
  181.         Case icReceivingResponse, icResponseReceived
  182.             Caption = "Receiving data."
  183.         Case icResponseCompleted
  184.             Dim strBuffer As String
  185.             'Get data
  186.             strBuffer = inetBrowse.GetChunk(1024)
  187.             'If data is a directory, display it
  188.             If strBuffer <> "" Then
  189.                 Caption = "Completed."
  190.                 txtContents = strBuffer
  191.             Else
  192.                 Caption = "File saved in " & _
  193.                   mstrTempDir & "."
  194.             End If
  195.         Case icConnecting, icConnected
  196.             Caption = "Connecting."
  197.         Case icDisconnecting
  198.         Case icDisconnected
  199.         Case Else
  200.             Debug.Print State
  201.     End Select
  202. End Sub
  203.