关于NetBox2.8端口问题

这几天公司在搞单机练习版(asp程序),为了封装程序,使用的是netbox2.8.以往年的经验,在端口问题上给技术支持带的压力挺大.我们自己定一个端口,到了用户那里,可能该端口已被占用.上周BOSS找我谈话,让我本周把该问题解决掉,争取今年的单机练习版中不再出现此问题.由于Netbox已经停止开发了,没有任何的技术支持.所以只有自己去研究了.发现netbox的语言,和VB极为类似,可以说就是VB的语法,加入了Netbox自己的对象而已.昨天解决了以后今天又优化了一下,我想应该是没有任何问题了.发在这里,方便那里曾经或者还正在被此问题困扰的同行们.
如果你认为或者发现了其它问题,可以在后面留言,我们一起来解决它.

Dim httpd
dim Path 
Dim ServerPort
Dim b_createport

path =NetBox.ApplicationPath
NetBox.ConfigFile = path & "main.ini"
ServerPort = netBox.Config("Server","Port")

Set httpd = NetBox.CreateObject("NetBox.HttpServer")
IF ServerPort="" THen
    ServerPort = 80
    netBox.Config("Server","Port") = ServerPort
End If

Shell.Service.Icon = path & netBox.Config("config","ICON")
Shell.Service.RunService "NBWeb", "NetBox Web Server", "NetBox Http Server Sample"

Sub CreatePort()Sub CreatePort()
    ServerPort = 0
    Do While (ServerPort<1025 Or ServerPort>65535)
        If httpd.Create("", 0) = 0  Then
            If httpd.LocalPort > 1024 and  httpd.LocalPort < 65535 Then
                ServerPort=httpd.LocalPort
            End If
        End If
    Loop
End Sub

Sub OnServiceStart()Sub OnServiceStart()
    Set service = Shell.Service
    If httpd.Create("", ServerPort) = 0 Then
    If b_createport = true Then
        Dim b_SaveConfig
        b_SaveConfig = Shell.MsgBox ("练习系统检测到目前分配到的端口[" & ServerPort & "]可以使用,是否保存?","保存端口",33)
        If b_SaveConfig = 1 Then
            netBox.Config("Server","Port") = ServerPort
        End If
    End If
        Set host = httpd.AddHost("", "\")
    Set host1 = host.AddFolder("WebExam","\WebExam")
        host1.EnableScript = true
        host1.AddDefault "default.asp"
        host1.AddDefault "default.htm"
        httpd.Start
    Shell.Execute """" & NetBox.SysInfo("Folder_ProgramFiles") & "\Internet Explorer\IEXPLORE.EXE"" http://localhost:"&ServerPort&"/Your App"
    else
    Shell.MsgBox "练习系统检测到要使用的端口[" & ServerPort & "]已被别的程序占用，系统将重新分配端口!点击确定继续", "提示信息",64
    b_createport = true
    CreatePort
    OnServiceStart
    end if
End Sub

Sub OnServiceStop()Sub OnServiceStop()
    httpd.Close
    Shell.Halt 0
    Shell.Quit 0
End Sub

Sub OnServicePause()Sub OnServicePause()
    httpd.Stop
End Sub

Sub OnServiceResume()Sub OnServiceResume()
    httpd.Start
End Sub