home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD2001.psc / My Projects / HTTPServer / V2.0 / TestFrame / frmTestFrame.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-11-07  |  4.6 KB  |  154 lines
  1. VERSION 5.00
  2. Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
  3. Begin VB.Form frmTestFrame 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Test Frame"
  6.    ClientHeight    =   5490
  7.    ClientLeft      =   2535
  8.    ClientTop       =   2190
  9.    ClientWidth     =   6930
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   5490
  15.    ScaleWidth      =   6930
  16.    ShowInTaskbar   =   0   'False
  17.    Begin InetCtlsObjects.Inet inetTest 
  18.       Left            =   1470
  19.       Top             =   90
  20.       _ExtentX        =   1005
  21.       _ExtentY        =   1005
  22.       _Version        =   393216
  23.       RequestTimeout  =   15
  24.    End
  25.    Begin VB.TextBox txtLog 
  26.       Appearance      =   0  'Flat
  27.       BorderStyle     =   0  'None
  28.       Height          =   4875
  29.       Left            =   0
  30.       MultiLine       =   -1  'True
  31.       ScrollBars      =   3  'Both
  32.       TabIndex        =   1
  33.       Top             =   600
  34.       Width           =   6915
  35.    End
  36.    Begin VB.CommandButton cmdTest 
  37.       Caption         =   "Start Tests"
  38.       Height          =   495
  39.       Left            =   60
  40.       TabIndex        =   0
  41.       Top             =   60
  42.       Width           =   1275
  43.    End
  44.    Begin VB.Label lblStatus 
  45.       AutoSize        =   -1  'True
  46.       BackStyle       =   0  'Transparent
  47.       Height          =   195
  48.       Left            =   1410
  49.       TabIndex        =   2
  50.       Top             =   150
  51.       UseMnemonic     =   0   'False
  52.       Width           =   5385
  53.       WordWrap        =   -1  'True
  54.    End
  55. Attribute VB_Name = "frmTestFrame"
  56. Attribute VB_GlobalNameSpace = False
  57. Attribute VB_Creatable = False
  58. Attribute VB_PredeclaredId = True
  59. Attribute VB_Exposed = False
  60. Option Explicit
  61. Private WithEvents mobjSrv As HTTPServer
  62. Attribute mobjSrv.VB_VarHelpID = -1
  63. Private Sub ClearLog()
  64.   txtLog.Text = ""
  65. End Sub
  66. Public Sub LogItem(LogData As String)
  67.   txtLog.Text = txtLog.Text & LogData & vbNewLine
  68.   txtLog.SelStart = Len(txtLog.Text)
  69. End Sub
  70. Private Sub RunTests()
  71.   If Test1() = False Then
  72.     Status = "Failed Test #1"
  73.     Exit Sub
  74.   End If
  75.   LogItem ""
  76.   If Test2() = False Then
  77.     Status = "Failed Test #2"
  78.     Exit Sub
  79.   End If
  80.   LogItem ""
  81.   Set mobjSrv = Nothing
  82.   Status = "All tests completed."
  83.   LogItem ""
  84.   LogItem "All tests completed."
  85. End Sub
  86. Public Property Let Status(newStatus As String)
  87.   lblStatus.Caption = newStatus
  88.   lblStatus.Refresh
  89. End Property
  90. Private Function Test1() As Boolean
  91.   Status = "Running Test #1(Init)"
  92.   LogItem "Starting Test #1 at " & Now
  93.   Dim objSrv As HTTPServer
  94.   LogItem "Creating HTTPServer"
  95.   Set objSrv = New HTTPServer
  96.   LogItem "Initializing HTTPServer to port 7777"
  97.   If objSrv.Initialize(7777) = False Then
  98.     LogItem "Initialize failed with port 7777"
  99.     Exit Function
  100.   End If
  101.   Set objSrv = Nothing
  102.   LogItem "Test 1 Succeeded."
  103.   Test1 = True
  104. End Function
  105. Private Function Test2() As Boolean
  106.   Status = "Running Test #2 HTTP Request"
  107.   LogItem "Starting Test #2 at " & Now
  108.   Dim sURL As String
  109.   Dim sRet As String
  110.   LogItem "Creating HTTPServer"
  111.   Set mobjSrv = New HTTPServer
  112.   LogItem "Initializing HTTPServer to port 1234"
  113.   On Error Resume Next
  114.   If mobjSrv.Initialize(1234) = False Then
  115.     LogItem "Initialize failed with port 1234"
  116.     Exit Function
  117.   End If
  118.   sURL = "http://localhost:1234/test/testpage.htm"
  119.   LogItem "Opening test page from server at: " & sURL
  120.   sRet = inetTest.OpenURL(sURL, icString)
  121.   If sRet <> "" Then
  122.     LogItem "Return Data = " & vbNewLine & sRet
  123.     LogItem "Test 2 Succeeded."
  124.     Test2 = True
  125.   Else
  126.     LogItem "Request to " & sURL & " returned no data."
  127.     LogItem "Test 2 Failed."
  128.     Test2 = False
  129.   End If
  130. End Function
  131. Private Sub cmdTest_Click()
  132.   Set mobjSrv = Nothing
  133.   ClearLog
  134.   RunTests
  135. End Sub
  136. Private Sub Form_Unload(Cancel As Integer)
  137.   Set mobjSrv = Nothing
  138. End Sub
  139. Private Sub mobjSrv_OnRequest(Request As HTTPServerLib.HTTPServiceRequest)
  140.   Dim HeaderData As New DelimitedString
  141.   Dim ResponseData As New DelimitedString
  142.   LogItem "Received a request for " & Request.URI
  143.   LogItem "Method = " & Request.Method
  144.   LogItem "Raw data = " & Request.RawRequest
  145.   HeaderData.Add "Connection: Close"
  146.   With ResponseData
  147.     .Add "<html>"
  148.     .Add "<body>"
  149.     .Add "<h1>You requested " & Request.URI & "</h1>"
  150.     .Add "</body></html>"
  151.   End With
  152.   Request.WriteResponse "200 OK", HeaderData, ResponseData.Value
  153. End Sub
  154.