?? myproxy.frm
字號:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form myproxy
BorderStyle = 1 'Fixed Single
Caption = "簡單得HTTP代理服務器"
ClientHeight = 5100
ClientLeft = 45
ClientTop = 330
ClientWidth = 6660
BeginProperty Font
Name = "宋體"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 340
ScaleMode = 3 'Pixel
ScaleWidth = 444
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtLog
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 3735
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 480
Width = 6375
End
Begin VB.CommandButton Command2
Caption = "停止服務"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3000
TabIndex = 1
Top = 4440
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "啟動服務"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1800
TabIndex = 0
Top = 4440
Width = 1215
End
Begin MSWinsockLib.Winsock insocket
Index = 0
Left = 480
Top = 4320
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock outsocket
Index = 0
Left = 1080
Top = 4320
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
Caption = "簡單代理服務器"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2040
TabIndex = 3
Top = 120
Width = 1455
End
End
Attribute VB_Name = "myproxy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blnManagingData As Boolean
Public blnNewConnection As Boolean
Public socketNum As Integer
Public Sub addLog(strEvent, intEventType)
'象文本框加入信息
With myproxy.txtLog
.Text = .Text & Date$ & " " & Time$ & " " & strEvent & vbCrLf
.SelStart = Len(.Text)
End With
End Sub
Private Sub Command1_Click()
On Error Resume Next
insocket(0).LocalPort = 6666
insocket(0).Listen
addLog "開始啟動服務，端口是6666。", 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
insocket(0).Close
outsocket(0).Close
addLog "停止服務。", 0
End Sub
Private Sub Form_Load()
addLog "程序啟動，歡迎使用本代理", 0
End Sub
Private Sub insocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'如果收到連接請求，接受
'insocket(0).Close
blnNewConnection = True
socketNum = socketNum + 1
Load insocket(socketNum)
Load outsocket(socketNum)
' Debug.Print Index '& "connect insock"
' Debug.Print Index '& "socketNum insock"
insocket(socketNum).Accept requestID
addLog "接收連接來自于 " & insocket(0).RemoteHostIP, 0
End Sub
Private Sub insocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'改子程序等待瀏覽器發(fā)送HTTP請求頭
'當所有必須的信息獲得以后，連接到真正的目的服務器，然后傳送
'請求頭信息
'錯誤處理
On Error Resume Next
'變量聲名
Static strInBuffer As String '接受緩沖區(qū)
Static blnHeaderRead As Boolean '是否讀HTTP頭
Dim strDataReceived As String '已經(jīng)獲得的數(shù)據(jù)
Dim strDestinationHost As String '目標主機
Dim strDestinationPort As String '目標端口
Dim intPos As Integer, intPos2 As Integer '字符串位置
'通知其他程序，數(shù)據(jù)已經(jīng)被處理
blnManagingData = True
'如果是新連接，重新設(shè)置緩沖區(qū)和
If blnNewConnection Then
strInBuffer = ""
strDestinationHost = ""
strDestinationPort = ""
blnHeaderRead = False
blnNewConnection = False
End If
'獲取數(shù)據(jù)
insocket(Index).GetData strDataReceived
Debug.Print strDataReceived
'如果HTTP頭完成，然后進行外部連接
'然后退出
If blnHeaderRead Then
outsocket(Index).SendData strDataReceived
Exit Sub
End If
'把數(shù)據(jù)放入緩沖區(qū)
strInBuffer = strInBuffer & strDataReceived
'從請求頭信息中獲取遠處計算機的主機地址
intPos = InStr(strInBuffer, "Host: ")
If intPos > 0 Then
intPos = intPos + Len("Host: ")
intPos2 = InStr(intPos + 1, strInBuffer, vbCrLf)
If intPos2 > 0 Then
'如果查到主機地址，然后獲得端口號
'默認的端口是80
strDestinationHost = Mid$(strInBuffer, intPos, intPos2 - intPos)
intPos = InStr(strDestinationHost, ":")
If intPos > 0 Then
strDestinationPort = Int(Right$(strDestinationHost, Len(strDestinationHost) - intPos + 1))
strDestinationHost = Left$(strDestinationHost, intPos - 1)
Else
strDestinationPort = 80
End If
addLog "連接到" & strDestinationHost & ":" & strDestinationPort, 0
'打開外部連接
' MsgBox "連接到:" & strDestinationHost & " 站點"
' MsgBox "連接到:" & strDestinationHost & " 站點"
outsocket(Index).Connect strDestinationHost, strDestinationPort
'等待連接成功
While outsocket(Index).State <> sckConnected
DoEvents
Wend
'發(fā)送目前緩沖區(qū)的信息
outsocket(Index).SendData strInBuffer
'表示頭信息已經(jīng)被閱讀
blnHeaderRead = True
End If
End If
'通知其他程序表示已經(jīng)完成
blnManagingData = False
End Sub
Private Sub outsocket_Close(Index As Integer)
On Error Resume Next
addLog "外部連接關(guān)閉", 0
While blnManagingData
DoEvents
Wend
DoEvents
'insocket(Index).Close
Debug.Print Index & "關(guān)閉"
End Sub
Private Sub outsocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'接受外部數(shù)據(jù)
'然后把數(shù)據(jù)傳送給請求的客戶
On Error Resume Next
Dim strDataReceived As String
outsocket(Index).GetData strDataReceived
insocket(Index).SendData strDataReceived
End Sub
'出現(xiàn)錯誤，關(guān)閉連接
Private Sub outsocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
addLog "外部連接關(guān)閉", 0
DoEvents
' insocket(Index).Close
'insocket(Index).Listen
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -