以下是代码片段：
Dim httpd
Dim retVal
Dim ServiceName
Dim DisplayName
ServiceName = "NewLifeWebServer"
DisplayName = "新生命页面应用开发专用Web服务器"
'Shell.Service.RunService "NLWeb", "新生命专用Web服务器,80端口,支持ASP", "新生命页面应用开发专用"
Shell.Service.Name = ServiceName
Shell.Service.DisplayName = DisplayName & " 作者 大石头 http://www.nnhy.org"
Shell.Service.Description = DisplayName
If Shell.Service.Running then
retVal = Shell.MsgBox("本程序的另一个副本已启动，是否强制终止？", DisplayName, vbOKCancel)
If retVal = 2 then
Shell.Quit 0
End If
Shell.Service.SendCommand 200 '发送终止指令
NewLife.Sleep 1000 '等待终止
End If
Shell.Service.RunService ServiceName
'---------------------- Service Event ---------------------
Sub OnServiceStart()
Shell.Service.AppendCommand 101, "开始服务"
Shell.Service.AppendCommand 102, "暂停服务"
Shell.Service.AppendCommand 103, "重启服务"
Shell.Service.AppendCommand -1
Shell.Service.AppendCommand 0, "打开主页"
Shell.Service.AppendCommand 104, "作者介绍"
Set httpd = NetBox.CreateObject("NetBox.HttpServer")
If httpd.Create("", 80) <> 0 Then
Shell.Beep
Dim retVal
retVal = Shell.MsgBox("端口可能已经被IIS占用，是否停止IIS？", DisplayName, vbOKCancel)
If retVal = 2 then
Shell.Quit 0
End If
Shell.Execute "Net Stop W3SVC", 16
If httpd.Create("", 80) <> 0 Then
Shell.Beep
Shell.MsgBox "很抱歉，Web服务无法启动！", DisplayName
Shell.Quit 0
End If
End If
Set host = httpd.AddHost("", "")
host.EnableScript = true
host.EnableBrowse = true
host.EnableDebug = true
host.AddDefault "index.asp"
host.AddDefault "index.htm"
host.AddDefault "index.html"
host.AddDefault "default.asp"
host.AddDefault "default.htm"
host.AddDefault "default.html"
httpd.Start
Dim RndForOpenNnhyOrg '百分之一的概率打开http://www.nnhy.org
Randomize
RndForOpenNnhyOrg = Int((100 * Rnd) + 1) ' 产生 1 到 100 之间的随机数。
If RndForOpenNnhyOrg = 1 Then OpenUrl "http://www.nnhy.org"
End Sub
Sub OnServiceStop()
httpd.Close
End Sub
Sub OnServicePause()
httpd.Stop
End Sub
Sub OnServiceResume()
httpd.Start
End Sub
Sub OnServiceCommand(uCtrl)
'Shell.MsgBox "被迫退出" & uCtrl, "nnhy"
Select Case uCtrl
'Case 3 '开始服务
' Shell.MsgBox "开始服务", "nnhy"
' httpd.Start
'Case 2 '暂停服务
' Shell.MsgBox "暂停服务", "nnhy"
' httpd.Stop
'Case 16 '重启服务
' Shell.MsgBox "重启服务", "nnhy"
' httpd.Close
Case 101 '开始服务
httpd.Start
Case 102 '暂停服务
httpd.Stop '停止服务器运行将暂停接受新的连接请求，对于已经建立的连接没有影响。
Case 103 '重启服务
httpd.Close '关闭服务器对象将关闭所有已经建立的连接，等待正在处理的连接线程全部结束，并清除服务器所占用的资源。
Shell.Execute NewLife.ApplicationName
Shell.Halt 0
Case 104 '打开http://www.nnhy.org
OpenUrl "http://www.nnhy.org"
Case 200
httpd.Close
'Shell.MsgBox "被迫退出", "nnhy"
'Shell.Quit 0
Shell.Halt 0
Case else '打开主页
OpenUrl "http://127.0.0.1"
End Select
End Sub
Sub OpenUrl(url)
Set htWin= CreateObject("NetBox.HtmlWindow")
htWin.Title = Shell.Service.DisplayName
htWin.ResizAble = false
htWin.Center
htWin.ScrollBar = false
htWin.Open url
htWin.ShowDialog
End Sub | 