frmftp.frm

包括www浏览器、ftp、email服务器、查看网页代码四部分。

      Caption         =   "FTP"
      Begin VB.Menu down 
         Caption         =   "下载文件"
         Shortcut        =   ^D
      End
      Begin VB.Menu list 
         Caption         =   "下载列表"
         Shortcut        =   ^L
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
         WindowList      =   -1  'True
      End
   End
   Begin VB.Menu manage 
      Caption         =   "站点管理"
      Begin VB.Menu add 
         Caption         =   "添加站点"
      End
      Begin VB.Menu delete 
         Caption         =   "删除站点"
      End
   End
End
Attribute VB_Name = "frmftp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bDowning As Boolean
Dim lisNum As Integer
Dim strTemp As String


Private Sub cmdCd_Click()
Dim strUrl As String
Dim strfile As String
strUrl = Combo1.Text

strfile = txtRemote.Text

If bDowning Then
MsgBox "downing!"
Exit Sub
Else
End If

bDowning = True

Inet1.Execute strUrl, "cd" + " " + strfile
'Inet1.Execute strUrl, "PWD"

'Inet1.Execute strUrl, "dir"

'Inet1.Execute strUrl, "dir" + " " + strFile

lblPath.Caption = strUrl + strfile

End Sub

Private Sub cmdAdd_Click()
Combo1.AddItem txtNewFTP.Text
End Sub

Private Sub cmdDel_Click()
Combo1.RemoveItem lisNum
End Sub

Private Sub CmdDown_Click()
On Error GoTo errhandle:
Dim strUrl As String
Dim sRFile As String
Dim sLFile As String

If bDowning Then
MsgBox "downing!"
Exit Sub
Else
End If

bDowning = True
strUrl = Combo1.Text
sRFile = txtRemote.Text
sLFile = txtLocal.Text
Inet1.Execute strUrl, "get " + txtRemote.Text + " " + sLFile
Exit Sub
errhandle:
    MsgBox Err.Description
End Sub

Private Sub cmdExit_Click()
Unload frmftp
End Sub

Private Sub cmdShow_Click()
On Error GoTo errhandle:
Dim strUrl As String
Dim strfile As String
strUrl = Combo1.Text
strfile = txtRemote.Text

If bDowning Then
MsgBox "downing!"
Exit Sub
Else
End If

bDowning = True

Inet1.Execute strUrl, "dir " + strfile
'Inet1.Execute strUrl, "dir"+

lblPath.Caption = strUrl + strfile
Exit Sub
errhandle:
    MsgBox Err.Description
End Sub

Private Sub cmdChoose_Click()
'txtRemote.Text = txtRemote.Text + rtbShow.SelText
Me.txtRemote.Text = Me.txtRemote.Text & strTemp
strTemp = ""
End Sub

Private Sub Command2_Click()
Dim strUrl As String
strUrl = Combo1.Text
 Inet1.Execute strUrl, "quit"

End Sub

Private Sub Command3_Click()
Dim strUrl As String
Dim strfile As String
strfile = txtRemote.Text

stuUrl = Combo1.Text
Inet1.Execute , " CDUP "


End Sub

Private Sub Command1_Click()
Inet1.Execute , "pwd"
End Sub

Private Sub Form_Load()
rtbShow.Text = ""
Combo1.Text = "ftp://166.111.162.3/"
lisNum = 0
Combo1.AddItem "ftp://166.111.162.3/"
Combo1.AddItem "ftp://166.111.4.80/"
Combo1.AddItem "ftp://166.111.163.3/"
Combo1.AddItem "ftp://ftp.lib.pku.edu.cn/"
Combo1.AddItem "ftp://159.226.23.16/"
bDowning = False

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 FrmWebBroswer.Show
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim vPartData As Variant

Select Case State
Case 1
    Me.StatusBar1.Panels(2).Text = "is looking"
Case 2
    Me.StatusBar1.Panels(2).Text = "success finding "
      Me.StatusBar1.Panels(2).Text = "success finding "
Case 3
  Me.StatusBar1.Panels(2).Text = "is connecting"
Case 4
  Me.StatusBar1.Panels(2).Text = "success connected"
Case 5
  Me.StatusBar1.Panels(2).Text = "is sending request"
Case 6
  Me.StatusBar1.Panels(2).Text = "sucess sending"
Case 7
  Me.StatusBar1.Panels(2).Text = "is receiving"
Case 8
  Me.StatusBar1.Panels(2).Text = "success receive"

Case 9
  Me.StatusBar1.Panels(2).Text = "is disconnecting"
Case 10
  Me.StatusBar1.Panels(2).Text = "success disconnect"
Case 11
  Me.StatusBar1.Panels(2).Text = "is error"

Case icResponseCompleted
    rtbShow.Text = ""
      Me.StatusBar1.Panels(2).Text = "success receive data"
    rtbShow.Text = rtbShow.Text + vPartData
    vPartData = Inet1.GetChunk(1024, icString)
    Do While LenB(vPartData) > 0
        rtbShow.Text = rtbShow.Text + vPartData
      vPartData = Inet1.GetChunk(1024, icString)
      Loop
      rtbShow.Text = rtbShow.Text + vPartData
rtbShow.SelStart = Len(rtbShow.Text)
If bDowning Then
MsgBox "down load file complete!"
bDowning = False
End If
'Inet1.Execute , "quit"
End Select


End Sub

Private Sub Mnu_Click()

End Sub

Private Sub MnuAdd_Click()
cmdAdd_Click
End Sub

Private Sub mnuDel_Click()
cmdDel_Click
End Sub

Private Sub mnuExit_Click()
cmdExit_Click
End Sub

Private Sub mnuList_Click()
cmdShow_Click
End Sub

Private Sub mnuLoad_Click()
CmdDown_Click
End Sub

Private Sub rtbShow_Click()
Me.rtbShow.Span Chr(10), False, True
Me.rtbShow.SelLength = Me.rtbShow.SelLength + 1
'strTemp = Me.rtbShow.SelText
Me.rtbShow.Span Chr(10), True, True
Me.rtbShow.SelLength = Me.rtbShow.SelLength + 1
strTemp = strTemp + Me.rtbShow.SelText

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

   Select Case Button.Key
   Case Is = "Connect"
     cmdShow_Click
   Case Is = "Add"
     cmdAdd_Click
     Case Is = "Delete"
     cmdDel_Click
     Case Is = "Save"
     CommonDialog1.ShowSave
     If Me.CommonDialog1.FileName = "" Then Exit Sub
     rtbShow.SaveFile (CommonDialog1.FileName)
     'cmdDown_Click
    Case Is = "Quit"
     ' cmdexit_click
   End Select

End Sub

Private Sub txtRemote_Change()
txtLocal.Text = "e:\net\"

End Sub

Private Sub combo1_Change()
txtRemote.Text = ""
lisNum = Combo1.ListIndex

Me.StatusBar1.Panels(1).Text = Combo1.Text
End Sub