'Prøv at lave den her på en Form1 (din server)
'Tilføj Microsoft Winsock Controls og endre Winsock1 til WSHttp
'og set index til 0 (WSHttp.Index = 0)
'Start din internet browser og skriv
http://din ip adresse/ ("
http://127.0.0.1/" hvis du ikke er tilsluttet.)
'nu skulle der komme et par links frem på din browser.
Option Explicit
Private strCommand() As String
Private strHTML As String
Private Sub Form_Load()
ReDim Preserve strCommand(0) As String
WSHttp(0).LocalPort = 80
WSHttp(0).Listen
'her din html kode
strHTML = "<br><a href=start>Command Start</a><br>" _
& "<a href=stop>Command Stop</a><br>" _
& "<a href=show>Command Show caption</a><br>"
End Sub
Private Sub WSHttp_Close(Index As Integer)
WSHttp(Index).Close
Do Until WSHttp(Index).State = sckClosed
DoEvents: DoEvents
Loop
Unload WSHttp(Index)
End Sub
Private Sub WSHttp_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
If IsError(WSHttp(requestID)) = False Then
Load WSHttp(requestID)
DoEvents
WSHttp(requestID).Accept requestID
If requestID > UBound(strCommand()) Then
ReDim Preserve strCommand(requestID) As String
End If
End If
End If
End Sub
Private Sub WSHttp_DataArrival(Index As Integer, ByVal bytesTotal As Long)
WSHttp(Index).GetData strCommand(Index), vbString, bytesTotal
If Mid(strCommand(Index), 1, 3) = "GET" Then
Select Case LCase$(Mid$(strCommand(Index), 6, Val(InStr(1, strCommand(Index), vbNewLine) - 15)))
Case "start"
Me.Caption = "Start" 'caption start
strCommand(Index) = "<html>" & strHTML & "</html>"
Case "stop"
Me.Caption = "Stop" 'caption stop
strCommand(Index) = "<html>" & strHTML & "</html>"
Case "show"
strCommand(Index) = "<html>Caption: " & Me.Caption & strHTML & "</html>"
End Select
Else
WSHttp(Index).SendData "<html>" & strHTML & "</html>"
End If
WSHttp(Index).SendData strCommand(Index)
End Sub
Private Sub WSHttp_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)
Call WSHttp_Close(Index)
End Sub
Private Sub WSHttp_SendComplete(Index As Integer)
Call WSHttp_Close(Index)
End Sub
