📄 frmhttpexp4.frm
字号:
VERSION 4.00
Begin VB.Form frmHTTPExp4
Caption = "HTTP Control Experiment"
ClientHeight = 4704
ClientLeft = 1800
ClientTop = 2412
ClientWidth = 7452
Height = 5100
Left = 1752
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 4704
ScaleWidth = 7452
Top = 2064
Width = 7548
Begin VB.PictureBox pbDivider
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 3672
Left = 2880
MousePointer = 9 'Size W E
ScaleHeight = 3672
ScaleWidth = 72
TabIndex = 6
Top = 600
Width = 72
End
Begin VB.TextBox txtURL
Height = 288
Left = 600
TabIndex = 2
Text = "http://www.microsoft.com"
Top = 120
Width = 3492
End
Begin VB.CommandButton cmdPerformRequest
Caption = "Perform Request"
Height = 372
Left = 4200
TabIndex = 0
Top = 120
Width = 1524
End
Begin ComctlLib.TreeView tvURLTreeView
Height = 3672
Left = 60
TabIndex = 5
Top = 600
Width = 2832
_ExtentX = 4995
_ExtentY = 6477
LabelEdit = 1
PathSeparator = "\"
Style = 6
BorderStyle = 1
MouseIcon = "frmHTTPExp4.frx":0000
End
Begin ComctlLib.StatusBar sbHTTPStatus
Align = 2 'Align Bottom
Height = 360
Left = 0
TabIndex = 4
Top = 4344
Width = 7452
_ExtentX = 13145
_ExtentY = 635
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 4
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Alignment = 1
AutoSize = 1
Object.Width = 3352
MinWidth = 2230
ToolTipText = "HTTP Control State"
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Alignment = 1
AutoSize = 1
Object.Width = 3224
MinWidth = 2102
ToolTipText = "Protocol Status"
EndProperty
BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 5
Alignment = 1
AutoSize = 1
Object.Width = 3098
MinWidth = 1976
TextSave = "10:07 AM"
ToolTipText = "Time"
EndProperty
BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 6
Alignment = 1
AutoSize = 1
Object.Width = 2886
MinWidth = 1764
TextSave = "8/23/96"
ToolTipText = "Date"
EndProperty
EndProperty
MouseIcon = "frmHTTPExp4.frx":001C
End
Begin VB.Label lblURL
BackStyle = 0 'Transparent
Caption = "URL:"
Height = 252
Left = 120
TabIndex = 3
Top = 120
Width = 372
End
Begin RichTextLib.RichTextBox txtOutput
Height = 3672
Left = 2940
TabIndex = 1
Top = 600
Width = 4452
_ExtentX = 7853
_ExtentY = 6477
ScrollBars = 3
TextRTF = $"frmHTTPExp4.frx":0038
End
Begin HTTPCTLib.HTTP HTTP1
Left = 6120
Top = 240
_ExtentX = 508
_ExtentY = 508
RemoteHost = "127.0.0.1"
RemotePort = 80
ConnectTimeout = 0
RecvTimeout = 0
NotificationMode= 1
Document = ""
Method = 1
End
End
Attribute VB_Name = "frmHTTPExp4"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Dummy As Variant
Private PageResources As HTMLPageResources
Private bPerformingRequest As Boolean
Private BinaryFile As Boolean
Private CurrentParentTreeNode As Node
Private ActiveTreeNode As Node
Private Sub cmdPerformRequest_Click()
Dim FileExtension As String
Dim TargetFilename As String
' Cannot get the following technique to function:
'HTTP1.Method = 1 'prcGet ' Use the Get method.
'HTTP1.Document = "home_netscape_com.html"
'HTTP1.RemoteHost = "home.netscape.com"
'HTTP1.PerformRequest
If Not bPerformingRequest Then
bPerformingRequest = True
'cmdPerformRequest.Caption = "Cancel Request"
FileExtension = Trim(LCase(ExtractFilenameExtensionFromPath(txtURL.Text)))
Select Case FileExtension
Case "gif", "jpg"
Me.MousePointer = vbHourglass
BinaryFile = True
TargetFilename = App.Path & "\" & ExtractFilenameFromPath(txtURL.Text)
HTTP1.GetDoc txtURL.Text, , TargetFilename
Case Else
Me.MousePointer = vbArrowHourglass
BinaryFile = False
Set PageResources = New HTMLPageResources
txtOutput.Text = ""
HTTP1.GetDoc txtURL.Text
End Select
Else
' Cancel the request.
' This section causes an error.
' Possible bug in HTTP control.
'bPerformingRequest = False
'cmdPerformRequest.Caption = "Perform Request"
'Set PageResources = Nothing
'HTTP1.Cancel
End If
End Sub
Private Sub Form_Resize()
If frmHTTPExp4.ScaleWidth < _
(lblURL.Width + _
cmdPerformRequest.Width + _
200 + 3 * 60) Then
frmHTTPExp4.Width = lblURL.Width + _
cmdPerformRequest.Width + _
500 + 4 * 60 + 4
End If
If frmHTTPExp4.ScaleHeight < _
(txtOutput.Top + 500 + 60) Then
frmHTTPExp4.Height = txtOutput.Top + 500 + 60
End If
lblURL.Left = 60
txtURL.Left = lblURL.Left + lblURL.Width + 60
txtURL.Width = frmHTTPExp4.ScaleWidth - _
(txtURL.Left + cmdPerformRequest.Width + 120)
cmdPerformRequest.Left = frmHTTPExp4.ScaleWidth - _
(cmdPerformRequest.Width + 60)
tvURLTreeView.Left = 60
tvURLTreeView.Height = frmHTTPExp4.ScaleHeight - _
(sbHTTPStatus.Height + tvURLTreeView.Top + 60)
txtOutput.Top = tvURLTreeView.Top
txtOutput.Left = tvURLTreeView.Left + tvURLTreeView.Width + 60
txtOutput.Width = frmHTTPExp4.ScaleWidth - (txtOutput.Left + 60)
txtOutput.Height = frmHTTPExp4.ScaleHeight - _
(sbHTTPStatus.Height + txtOutput.Top + 60)
pbDivider.Top = tvURLTreeView.Top
pbDivider.Height = tvURLTreeView.Height
pbDivider.Left = tvURLTreeView.Left + tvURLTreeView.Width
pbDivider.Width = 60
End Sub
Private Sub HTTP1_DocOutput(ByVal DocOutput As DocOutput)
Dim sContentType As String
Dim vData As Variant
If DocOutput.State = icDocData Then
sContentType = DocOutput.Headers. _
Item("content-type").Value
If InStr(1, sContentType, "text/", 1) Then
' Retrieve text data.
DocOutput.GetData vData, vbString
txtOutput.Text = txtOutput.Text & vData
Else
' Retrieve binary data.
'DocOutput.GetData vData, vbArray + vbByte
End If
End If
End Sub
Private Sub HTTP1_ProtocolStateChanged(ByVal ProtocolState As Integer)
sbHTTPStatus.Panels(2).Text = HTTP1.ProtocolStateString
Select Case ProtocolState
Case 0
If bPerformingRequest Then
If (Not BinaryFile) Then
Me.MousePointer = vbHourglass
cmdPerformRequest.Enabled = False
txtURL.Enabled = False
tvURLTreeView.Enabled = False
PageResources.AddLinksFromDocument txtOutput.Text, txtURL
AddLinksToTreeView PageResources, HTTP1.URL
cmdPerformRequest.Enabled = True
txtURL.Enabled = True
tvURLTreeView.Enabled = True
End If
bPerformingRequest = False
End If
Me.MousePointer = vbDefault
Case 1
txtURL = HTTP1.URL
End Select
End Sub
Private Sub HTTP1_StateChanged(ByVal State As Integer)
sbHTTPStatus.Panels(1).Text = HTTP1.StateString
End Sub
Private Sub pbDivider_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
pbDivider.Left = _
MaxLong(200, _
MinLong((pbDivider.Left + x), _
(frmHTTPExp4.ScaleWidth - 260)))
End If
End Sub
Private Sub pbDivider_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
tvURLTreeView.Width = pbDivider.Left - tvURLTreeView.Left
txtOutput.Left = pbDivider.Left + pbDivider.Width
txtOutput.Width = frmHTTPExp4.ScaleWidth - (txtOutput.Left + 60)
End Sub
Private Sub tvURLTreeView_NodeClick(ByVal Node As Node)
If Node <> ActiveTreeNode Then
Set ActiveTreeNode = Node
txtURL.Text = Node.Key
cmdPerformRequest_Click
End If
End Sub
Private Sub txtURL_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdPerformRequest_Click
End If
End Sub
Public Sub AddLinksToTreeView(PageResources As HTMLPageResources, ParentURL As String)
Dim CurrentNode As Node
Dim Link As HTMLLinks
On Error Resume Next
Set CurrentNode = tvURLTreeView.Nodes.Add(, , ParentURL, ParentURL)
If Not (CurrentNode Is Nothing) Then
Set ActiveTreeNode = CurrentNode
End If
For Each Link In PageResources.PageLinks
Set CurrentNode = tvURLTreeView.Nodes.Add(ParentURL, tvwChild, _
Link.URL, _
Link.Path)
Next Link
For Each Link In PageResources.PageElements
Set CurrentNode = tvURLTreeView.Nodes.Add(ParentURL, tvwChild, _
Link.URL, _
Link.Path)
Next Link
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -