Delphi控件源码

开发平台：
Delphi

TestFW.frm：源码内容
							VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form Form1 
   Caption         =   "TestPSMFirewall"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtNo 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   720
      TabIndex        =   3
      Text            =   "10"
      Top             =   2640
      Width           =   975
   End
   Begin VB.CommandButton cmdCloseAll 
      Caption         =   "&Close All"
      Height          =   495
      Left            =   3240
      TabIndex        =   2
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton cmdFlood 
      Caption         =   "&Flood"
      Height          =   495
      Left            =   1800
      TabIndex        =   1
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Timer TimerRefresh 
      Interval        =   2000
      Left            =   120
      Top             =   2640
   End
   Begin SHDocVwCtl.WebBrowser Web 
      Height          =   2295
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   4455
      ExtentX         =   7858
      ExtentY         =   4048
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Const WM_CLOSE = &H10
Private Sub cmdCloseAll_Click()
  Dim h As Long
  cmdCloseAll.Enabled = False
  Me.Caption = "sdjfhdsjkfhkja"
  h = FindWindow("ThunderRT6FormDC", "TestPSMFirewall")
  While h > 0
    DoEvents
    SendMessage h, WM_CLOSE, 0, 0
    h = FindWindow("ThunderRT6FormDC", "TestPSMFirewall")
  Wend
  cmdCloseAll.Enabled = True
  Wait 10
  End
End Sub
Private Sub cmdFlood_Click()
  cmdFlood.Enabled = False
  Dim i As Integer
  For i = 1 To Int(txtNo.Text) Step 1
    On Error Resume Next
    Shell App.Path + "TestPSMFW.exe", vbNormalFocus
    Wait 200
    On Error GoTo 0
  Next i
  cmdFlood.Enabled = True
End Sub
Private Sub Form_Load()
  Randomize
  Web.Navigate "http://www.msn.co.kr/my.asp"
  'Web.Navigate "http://kr.news.yahoo.com/service/magazine/ShellSection.htm?LinkID=66"
  Me.Move Screen.Width * Rnd, Screen.Height * Rnd
End Sub
Private Sub Form_Resize()
  If Me.WindowState <> vbMinimized Then Web.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 500
End Sub
Private Sub TimerRefresh_Timer()
  Web.Refresh
End Sub
Public Sub Wait(x10ms)
  Dim t As Long
  t = Timer * 100 + x10ms
  Do
    DoEvents
  Loop While Timer * 100 < t
End Sub

						