📄 dll.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "DLL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Sub svrerr(server As Object, errstr As String)
server.WriteLine "Error: " & errstr
server.statcode = 400
server.retval = 4
End Sub
Private Sub Win(server As Object)
server.WriteLine "<HTML><HEAD><TITLE>I Win</TITLE></HEAD><BODY>"
server.WriteLine "I got it right!</BODY></HTML>"
End Sub
Private Sub GuessAgain(server As Object, Hi As Long, Lo As Long)
Dim servername As Variant
Dim script As Variant
server.WriteLine "<HTML><HEAD><TITLE>HiLo!</TITLE></HEAD><BODY>"
server.WriteLine "My guess is " & CInt((Hi + Lo) / 2) & "<P>"
server.ServerVariable "SERVER_NAME", servername
server.ServerVariable "SCRIPT_NAME", script
server.WriteLine "Is my guess:<P>"
server.Write "<FORM ACTION=http://" & servername
server.Write "/" & script
server.WriteLine "?HILO.DLL:Guess+HI=" & Hi & "+LO=" & Lo & " METHOD=POST>"
server.WriteLine "High <INPUT TYPE=RADIO NAME=ANSWER VALUE=HI><P>"
server.WriteLine "Correct <INPUT TYPE=RADIO NAME=ANSWER VALUE=OK><P>"
server.WriteLine "Low <INPUT TYPE=RADIO NAME=ANSWER VALUE=LO><P>"
server.WriteLine "<INPUT TYPE=SUBMIT>"
server.WriteLine "</FORM>"
server.WriteLine "</BODY></HTML>"
End Sub
Public Sub Guess(server As Object)
Dim Guess As Long
Dim Hi As Long
Dim Lo As Long
Dim pos As Long
Dim ans As String
pos = InStr(1, server.QueryString, "HI=", vbTextCompare)
If pos = 0 Then
svrerr server, "Can't find HI"
Exit Sub
End If
Hi = Val(Mid(server.QueryString, pos + 3))
pos = InStr(1, server.QueryString, "LO=", vbTextCompare)
If pos = 0 Then
svrerr server, "Can't find LO"
Exit Sub
End If
Lo = Val(Mid(server.QueryString, pos + 3))
If server.ContentLength = 0 Then
GuessAgain server, Hi, Lo
Else
Guess = (Hi + Lo) / 2
pos = InStr(1, server.Content, "ANSWER=", vbTextCompare)
If pos = 0 Then
svrerr server, "Form error"
Exit Sub
End If
ans = Mid(server.Content, pos + 7, 2)
If ans = "OK" Then Win server
If ans = "LO" Then GuessAgain server, Hi, Guess
If ans = "HI" Then GuessAgain server, Guess, Lo
If ans <> "OK" And ans <> "LO" And ans <> "HI" Then svrerr server, "Unknown Response: " & server.Content
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -