frmmain.frm

用VB写的一个代理服务器程序.rar复件 用VB写的一个代理服务器程序.rar

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmMain 
   Caption         =   "代理服务器"
   ClientHeight    =   5415
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6675
   Icon            =   "frmMain.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   5415
   ScaleWidth      =   6675
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkLog 
      Caption         =   "生成日志文件"
      Height          =   255
      Left            =   3240
      TabIndex        =   12
      Top             =   90
      Value           =   1  'Checked
      Width           =   2355
   End
   Begin TabDlg.SSTab tabProxy 
      Height          =   4995
      Left            =   0
      TabIndex        =   3
      Top             =   420
      Width           =   6675
      _ExtentX        =   11774
      _ExtentY        =   8811
      _Version        =   393216
      Tab             =   1
      TabHeight       =   520
      TabCaption(0)   =   "日志"
      TabPicture(0)   =   "frmMain.frx":030A
      Tab(0).ControlEnabled=   0   'False
      Tab(0).Control(0)=   "fraLog"
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "Header"
      TabPicture(1)   =   "frmMain.frx":0326
      Tab(1).ControlEnabled=   -1  'True
      Tab(1).Control(0)=   "fraRequest"
      Tab(1).Control(0).Enabled=   0   'False
      Tab(1).Control(1)=   "fraResponse"
      Tab(1).Control(1).Enabled=   0   'False
      Tab(1).ControlCount=   2
      TabCaption(2)   =   "状态"
      TabPicture(2)   =   "frmMain.frx":0342
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "fraStat"
      Tab(2).ControlCount=   1
      Begin VB.Frame fraStat 
         Caption         =   "连接请求参数"
         Height          =   4485
         Left            =   -74910
         TabIndex        =   10
         Top             =   390
         Width           =   6435
         Begin MSFlexGridLib.MSFlexGrid flxStatistic 
            Height          =   4095
            Left            =   120
            TabIndex        =   11
            Top             =   240
            Width           =   6165
            _ExtentX        =   10874
            _ExtentY        =   7223
            _Version        =   393216
            AllowBigSelection=   0   'False
            SelectionMode   =   1
            AllowUserResizing=   1
         End
      End
      Begin VB.Frame fraResponse 
         Caption         =   "响应Header"
         Height          =   1905
         Left            =   90
         TabIndex        =   7
         Top             =   2340
         Width           =   6465
         Begin VB.TextBox txtResponse 
            Height          =   1515
            Left            =   150
            Locked          =   -1  'True
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   9
            Top             =   270
            Width           =   6195
         End
      End
      Begin VB.Frame fraRequest 
         Caption         =   "请求Header"
         Height          =   1905
         Left            =   90
         TabIndex        =   6
         Top             =   390
         Width           =   6465
         Begin VB.TextBox txtRequest 
            Height          =   1515
            Left            =   150
            Locked          =   -1  'True
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   8
            Top             =   240
            Width           =   6195
         End
      End
      Begin VB.Frame fraLog 
         Caption         =   "代理拉日志"
         Height          =   4485
         Left            =   -74910
         TabIndex        =   4
         Top             =   390
         Width           =   6435
         Begin VB.ListBox lstLog 
            BackColor       =   &H00000000&
            ForeColor       =   &H00FFFFFF&
            Height          =   4020
            ItemData        =   "frmMain.frx":035E
            Left            =   120
            List            =   "frmMain.frx":0360
            TabIndex        =   5
            Top             =   210
            Width           =   6195
         End
      End
   End
   Begin VB.CommandButton cmdClearLog 
      Caption         =   "清除"
      Height          =   405
      Left            =   2100
      TabIndex        =   2
      Top             =   0
      Width           =   1035
   End
   Begin VB.CommandButton cmdConfiguration 
      Caption         =   "设置"
      Height          =   405
      Left            =   1050
      TabIndex        =   1
      Top             =   0
      Width           =   1035
   End
   Begin VB.Timer tmrClient 
      Index           =   0
      Interval        =   10
      Left            =   4470
      Top             =   0
   End
   Begin VB.Timer tmrServer 
      Index           =   0
      Interval        =   10
      Left            =   4020
      Top             =   0
   End
   Begin MSWinsockLib.Winsock sckClient 
      Index           =   0
      Left            =   3150
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckServer 
      Index           =   0
      Left            =   3570
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton cmdSwitch 
      Caption         =   "开始"
      Height          =   405
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1035
   End
   Begin VB.Menu mnuHeader 
      Caption         =   "Header"
      Visible         =   0   'False
      Begin VB.Menu mnuClearHeader 
         Caption         =   "Clear"
      End
   End
   Begin VB.Menu mnuLog 
      Caption         =   "Log"
      Visible         =   0   'False
      Begin VB.Menu mnuClearLog 
         Caption         =   "Clear"
      End
   End
   Begin VB.Menu mnuStat 
      Caption         =   "Stat"
      Visible         =   0   'False
      Begin VB.Menu mnuSave 
         Caption         =   "Save"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Private Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32" (addr As Long, addrLen As Long, addrType As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private objSystray As clsSysTray

Private Const DEBUG_MODE = False

Dim BlockingClient() As Boolean
Dim BlockingServer() As Boolean

Dim ServerConnection As Collection
Dim ClientConnection As Collection

Private Sub cmdClearLog_Click()
    lstLog.Clear
    txtRequest.Text = ""
    txtResponse.Text = ""
End Sub

Private Sub cmdConfiguration_Click()
    '获取设置
    LoadConfigurationScreen Me, netProxy
End Sub

Private Sub cmdSwitch_Click()
    If cmdSwitch.Caption = "开始" Then
        objSystray.ToolTip = "Personal Proxy Server On"
        StartProxy ListeningPort
        cmdSwitch.Caption = "停止"
    Else
        objSystray.ToolTip = "Personal Proxy Server Off"
        StopProxy
        cmdSwitch.Caption = "开始"
    End If
End Sub

Private Sub StartProxy(LocalPort As Long)
    '启动代理服务器
    SendMessage "Initializing Personal Proxy Server"
    InitializeSocket sckServer(0)
    sckServer(0).LocalPort = LocalPort
    sckServer(0).Listen
    SendMessage "Listening on port " & LocalPort
End Sub

Private Sub StopProxy()
    '停止代理服务器
    Dim Socket As Winsock
    SendMessage "Shutting down Personal Proxy Server"
    '逐个停止winsock控件
    For Each Socket In sckServer
        tmrServer(Socket.Index).Enabled = False
        tmrClient(Socket.Index).Enabled = False
        DoEvents
        CloseSocket Socket.Index
    Next
    SendMessage "Personal Proxy Server stopped"
End Sub

Private Sub InitializeSocket(Socket As Winsock)
    '初始化Winsock
    On Error Resume Next
    SendMessage "Initialize Socket " & Socket.LocalPort
    Socket.Close
    Socket.LocalPort = 0
End Sub

Private Sub SendMessage(Message As String)
    '在日志中记录
    lstLog.AddItem "[" & Now & "] " & Message
    If lstLog.ListCount > 10000 Then lstLog.Clear
End Sub

Private Sub flxStatistic_Click()
    '连接请求参数框鼠标单击事件
    Dim i As Long

    With flxStatistic
        For i = 1 To ConnectionRequest.Count
            DoEvents
            If i = .Rows Then
                .Rows = .Rows + 1
                .TextMatrix(i, 0) = i
                'IP地址
                .TextMatrix(i, 1) = ConnectionRequest(i).IPAddress
                If ConnectionRequest(i).HostName = "" Then
                    '获取主机名
                    ConnectionRequest(i).HostName = _
                            NameByAddr(ConnectionRequest(i).IPAddress)
                End If
                .TextMatrix(i, 2) = ConnectionRequest(i).HostName
            End If
            .TextMatrix(i, 3) = ConnectionRequest(i).Stat_Connect_Count
            '接受字节数
            .TextMatrix(i, 4) = FormatByte( _
                    ConnectionRequest(i).Stat_Bytes_Received)
            '发送字节数
            .TextMatrix(i, 5) = FormatByte( _
                    ConnectionRequest(i).Stat_Bytes_Sent)