联通增值业务“定位之星”L1协议服务端的模拟器-.NET教程,Asp.Net开发

去年接触了联通的“定位之星”增值业务，客户端都是php的（说到php，真的发现以前太小看php了，功能还是很强大的，呵呵），因为联通不开通开发测试，所以自己写了这个模拟器，功能非常简陋，纯粹是为了测试通信存在。

废话少说，源码贴上（赘姆烂壳的老规矩，没多少注释）

frmmain.frm

version 5.00
object = "{248dd890-bb45-11cf-9abc-0080c7e7b78d}#1.0#0"; "mswinsck.ocx"
begin vb.form frmmain
   borderstyle     =   1  fixed single
   caption         =   "l1 protocol gateway"
   clientheight    =   5430
   clientleft      =   45
   clienttop       =   330
   clientwidth     =   7995
   icon            =   "frmmain.frx":0000
   linktopic       =   "form1"
   maxbutton       =   0   false
   scaleheight     =   5430
   scalewidth      =   7995
   startupposition =   2  centerscreen
   begin vb.timer tmrtimeout
      interval        =   1000
      left            =   7560
      top             =   4980
   end
   begin vb.commandbutton cmdexit
      caption         =   "e&xit"
      height          =   495
      left            =   6660
      tabindex        =   5
      top             =   4800
      width           =   1215
   end
   begin vb.commandbutton cmdstop
      caption         =   "s&top"
      height          =   495
      left            =   6660
      tabindex        =   4
      top             =   4200
      width           =   1215
   end
   begin vb.commandbutton cmdltrtask
      caption         =   "&ltr task"
      height          =   495
      left            =   5340
      tabindex        =   3
      top             =   4800
      width           =   1215
   end
   begin vb.commandbutton cmdstart
      caption         =   "&start"
      height          =   495
      left            =   5340
      tabindex        =   2
      top             =   4200
      width           =   1215
   end
   begin vb.textbox txtltr
      height          =   1095
      left            =   120
      multiline       =   -1  true
      scrollbars      =   2  vertical
      tabindex        =   1
      top             =   4200
      width           =   5115
   end
   begin vb.textbox txtlog
      height          =   3975
      left            =   120
      multiline       =   -1  true
      scrollbars      =   2  vertical
      tabindex        =   0
      top             =   120
      width           =   7755
   end
   begin mswinsocklib.winsock sckserver
      index           =   0
      left            =   0
      top             =   0
      _extentx        =   741
      _extenty        =   741
      _version        =   393216
   end
end
attribute vb_name = "frmmain"
attribute vb_globalnamespace = false
attribute vb_creatable = false
attribute vb_predeclaredid = true
attribute vb_exposed = false
option explicit

dim intcuridx as integer

private sub cmdexit_click()
    unload me
end sub

private sub cmdstart_click()
    sckserver(0).localport = svrport
    sckserver(0).listen
    call writelog("start…" & vbcrlf)
end sub

private sub cmdstop_click()
    sckserver(0).close
    call writelog("stop…" & vbcrlf)
end sub

private sub form_load()
    redim lcsclient(1)
    with lcsclient(0)
        .ip = "61.181.74.13"
        .password = "12345"
        .username = "tta"
        .port = 2001
    end with

    redim client(0)
   
    redim closelist(0)

    intcuridx = 0

    svrport = 2000
end sub

private sub form_queryunload(cancel as integer, unloadmode as integer)
    end
end sub

private sub sckserver_connectionrequest(index as integer, byval requestid as long)
    dim i as integer
   
    if index <> 0 then exit sub
   
    for i = 1 to intcuridx
        if not isobject(sckserver(i)) then
            load sckserver(i)
            sckserver(i).accept requestid
            client(i).ip = sckserver(i).remotehostip
            call writelog(sckserver(i).remotehostip & " is connected…" & vbcrlf)
            exit sub
        else
            if sckserver(i).state = sckclosed then
                sckserver(i).accept requestid
                client(i).ip = sckserver(i).remotehostip
                call writelog(sckserver(i).remotehostip & " is connected…" & vbcrlf)
                exit sub
            end if
        end if
    next
    intcuridx = intcuridx + 1
    load sckserver(intcuridx)
    sckserver(intcuridx).accept requestid
    redim preserve client(intcuridx)
    with client(intcuridx)
        .ip = sckserver(intcuridx).remotehostip
    end with
    call writelog(sckserver(intcuridx).remotehostip & " is connected…" & vbcrlf)
end sub

private sub sckserver_dataarrival(index as integer, byval bytestotal as long)
    dim str as string
   
    if index = 0 then exit sub
    sckserver(index).getdata str
   
    txtlog.text = txtlog.text & str & vbcrlf
    txtlog.selstart = len(txtlog.text)
   
    if left(str, 4) <> "post" then
        call sendmsg(index, "couldnt support the operation")
        call removeclient(index)
        exit sub
    end if
    do
        str = mid(str, instr(str, vbcrlf) + 2)
    loop while instr(str, vbcrlf) <> 1
    str = mid(str, instr(str, vbcrlf) + 2)
   
    call parsexml(index, str)
    txtlog.text = txtlog.text & "send complete" & vbcrlf
end sub

private sub sckserver_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)
    if index = 0 then
        sckserver(0).localport = svrport
        sckserver(0).listen
        exit sub
    end if
    if sckserver(index).state <> sckclosed then sckserver(index).close
end sub

private sub sckserver_sendcomplete(index as integer)
    dim i as integer
   
    for i = 0 to ubound(closelist) – 1
        if closelist(i) = index then
            sckserver(index).close
            exit sub
        end if
    next
end sub

modmain.bas

attribute vb_name = "modmain"
option explicit

private type typeclient
    ip as string
    socketidx as integer
end type
public client() as typeclient

private type typelcsclient
    username as string
    password as string
    ip as string
    port as string
end type
public lcsclient() as typelcsclient

public closelist() as integer

public const maxcon as byte = 5
public svrport as string

public sub parsexml(byval idx as integer, byval str as string)
    dim xml as msxml.domdocument
    dim nodereq as ixmldomnode
    dim nodeclient as ixmldomnode
    dim nodeoriginator as ixmldomnode
    dim nodelir as ixmldomnode
    dim nodeltr as ixmldomnode
    dim nodelctr as ixmldomnode
   
    set xml = new msxml.domdocument
    if not xml.loadxml(str) then
        call sendmsg(idx, "not valid xml")
        exit sub
    end if
   
    取req节点
    set nodereq = xml.selectsinglenode("req")
    if nodereq is nothing then
        没有req节点，返回错误
        call sendmsg(idx, "couldnt support the operation")
        exit sub
    end if
   
    取client节点
    set nodeclient = nodereq.selectsinglenode("client")
    if nodeclient is nothing then
        没有client节点，返回错误
        call sendmsg(idx, "couldnt support the operation")
        exit sub
    end if
   
    鉴权
    dim nodelcsclientid as ixmldomnode
    dim nodepassword as ixmldomnode
    set nodelcsclientid = nodeclient.selectsinglenode("lcsclientid")
    set nodepassword = nodeclient.selectsinglenode("password")
    if nodeclient is nothing or nodepassword is nothing then
        call sendmsg(idx, "couldnt support the operation")
        exit sub
    end if
    if not isvalidsp(nodelcsclientid.text, nodepassword.text, frmmain.sckserver(idx).remotehostip) then
        call sendmsg(idx, "access defined")
        exit sub
    end if
   
    取数据
    set nodeoriginator = nodereq.selectsinglenode("originator")
    set nodelir = nodereq.selectsinglenode("lir")
    set nodeltr = nodereq.selectsinglenode("ltr")
    set nodelctr = nodereq.selectsinglenode("lctr")
    if nodeoriginator is nothing then
        lctr
        if nodelctr is nothing then
            call sendmsg(idx, "couldnt support the operation")
            exit sub
        end if
        dim nodereq_id as ixmldomnode
        set nodereq_id = nodelctr.selectsinglenode("req_id")
        if nodereq_id is nothing then
            call sendmsg(idx, "has no req_id")
            exit sub
        end if
       
    else
        lir or ltr
        if ((nodelir is nothing) and (nodeltr is nothing)) or ((not nodelir is nothing) and (not nodeltr is nothing)) then
            call sendmsg(idx, "couldnt support the operation")
            exit sub
        end if
        if nodeltr is nothing then
            lir
            dim nodeorid as ixmldomnode
            set nodeorid = nodeoriginator.selectsinglenode("orid")
            if nodeorid is nothing then
                call sendmsg(idx, "has no orid")
                exit sub
            end if
           
            dim nodepqos as ixmldomnode
            set nodepqos = nodelir.selectsinglenode("pqos")
            if nodepqos is nothing then
                call sendmsg(idx, "pqos field missing")
                exit sub
            end if
           
            dim noderesptimer as ixmldomnode
            set noderesptimer = nodepqos.selectsinglenode("resp_timer")
           
            dim wt as long
            wt = clng(noderesptimer.text)
            frmmain.txtlog.text = frmmain.txtlog.text & "wait " & wt & " sec…" & vbcrlf
            dim o as long
            o = timer
            do until timer – o > wt
                doevents
            loop
            frmmain.txtlog.text = frmmain.txtlog.text & "send xml" & vbcrlf
           
            dim strlia as string
            strlia = createlia(nodelcsclientid.text, nodeorid.text)
           
            frmmain.txtlog.text = frmmain.txtlog.text & vbcrlf & strlia & vbcrlf & vbcrlf
           
            call sendmsg(idx, strlia)
        else
            ltr没有写，实际几乎没有此需求，毕竟太耗费系统资源，好像当时联通也不支持，不知现在如何了
           
        end if
    end if
end sub

public sub sendmsg(byval idx as integer, byval str as string)
    if isobject(frmmain.sckserver(idx)) then
        if frmmain.sckserver(idx).state <> sckclosed then
            frmmain.sckserver(idx).senddata str
            redim preserve closelist(ubound(closelist) + 1)
            closelist(ubound(closelist) – 1) = idx
        end if
    end if
end sub

public sub removeclient(byval socket as integer)
    if isobject(frmmain.sckserver(socket)) then
        if frmmain.sckserver(socket).state <> sckclosed then frmmain.sckserver(socket).close
    end if
end sub

public sub writelog(byval str as string)
    frmmain.txtlog.text = frmmain.txtlog.text & str
end sub

private function isvalidsp(byval uid as string, byval pwd as string, byval cip as string) as boolean
    dim i as integer
   
    for i = 0 to ubound(lcsclient) – 1
        if lcsclient(i).username = uid and lcsclient(i).password = pwd and lcsclient(i).ip = cip then
            isvalidsp = true
            exit function
        end if
    next
    isvalidsp = false
end function

public function createlia(byval lcscid as string, byval orid as string) as string
    dim xml as msxml.domdocument
   
    dim strheader as string
    dim strlia as string
    dim snglatitude as single, snglongitude as single
   
    randomize timer
   
    strheader = "<?xml version = ""1.0"" ?><!doctype ans system ""locans.dtd"">"
    strlia = "<ans ver=""0.01"">" & _
               "<lcsclientid>theclient</lcsclientid>" & _
               "<orid>13300000000</orid>" & _
               "<lia>" & _
                 "<posinfos>" & _
                   "<posinfo>" & _
                     "<positionresult>1</positionresult>" & _
                     "<msid>13300000001</msid>" & _
                     "<msid_type>0</msid_type>" & _
                     "<areacode>25</areacode>" & _
                     "<localtime>20020420142020</localtime>" & _
                     "<latitudetype>0</latitudetype>" & _
                     "<latitude>301628.312</latitude>" & _
                     "<longitudetype>0</longitudetype>" & _
                     "<longitude>451533.431</longitude>" & _
                     "<radius>200</radius>" & _
                     "<posour>6</posour>" & _
                   "</posinfo>" & _
                 "</posinfos>" & _
               "</lia>" & _
              "</ans>"

   
    set xml = new msxml.domdocument
    xml.loadxml strlia
   
    xml.selectsinglenode("/ans/lcsclientid").text = lcscid
    xml.selectsinglenode("/ans/orid").text = orid
    xml.selectsinglenode("/ans/lia/posinfos/posinfo/msid").text = orid
    xml.selectsinglenode("/ans/lia/posinfos/posinfo/localtime").text = format(now, "yyyymmddhhmmss")
   
    snglatitude = rnd * 100000000 / 1000
    xml.selectsinglenode("/ans/lia/posinfos/posinfo/latitude").text = snglatitude
    snglongitude = rnd * 100000000 / 1000
    xml.selectsinglenode("/ans/lia/posinfos/posinfo/longitude").text = snglongitude
   
    createlia = strheader & xml.xml
end function

附l1协议的简介

1           概述1.1         l1接口根据pn4747，l1接口是cdma移动定位中心（mpc）与位置服务客户机（lcs client）之间的接口。 l1接口协议（cdma移动定位协议）是应用级协议，用于使用cdma无线定位技术定位时mpc和sp位置应用的通讯接口。本文将介绍移动定位中心（mpc）应该能够执行的操作的核心集合。1.2         承载方式l1移动定位承载协议采用http/xml，通过ssl 保证数据传输的安全。xml(extensible markup language)，是一种可延伸或扩展的标记语言，它的优点是可根据设计的需要自行定义标签，sp和mpc间的接口往往会根据功能或业务的需要自行定义参数，使用该语言可以自行定义标签，建立数据非常灵活。    mpc对sp设置两个http 端口，一个通过ssl来保证数据安全，一个不需要采用ssl。前者主要提供给非信任域、非安全域的用户，如通过internet 来访问的用户确保数据安全；后者提供给信任域、安全域的用户，如通过局域网来访问的用户，同时由于不采用ssl可提高数据传输速度。可以选择两个端口号码作为建议的标准端口。端口应该由iana（internet指定的号码机构）登记。对cdma中用到两个端口号码的建议如下：·         700 用于ssl传输·         701用于非安全传输mpc和位置服务器可以选择基于其它端口的技术或http透明技术实现安全传输。但是，无论使用哪种技术，都不能使用上述两个端口。http 版本为1.1，关于http，请参见：http://www.w3.org。 1.3         l1语法1.3.1          约定特殊符号的标识：回车（ascii码为13）               cr换行（ascii码为10）               lf空格（ascii码为32）               sp[a-z]                                  表示可以为所有小写字母[a-z]                                 表示可以为所有大写字母[0-9]                                  表示可以为从0到9的任何数字{min,max}                            表示长度在min和max之间[a-z,a-z,0-9]                         表示可以为所有小写字母、所有大写字母、0到9的所有数字 举例：[0-9] {7,8}表示长度为7位或8位的数字串，如8787767即符合要求，而119不符合要求[b-d]{3,4}表示长度为3位或4位的b-d的字符串，如bbc符合要求，bbccd和abc不符合要求[a,c,7-9]{1}表示可以为a或c或7或8或91.3.2          dtd语法+                                          大于或等于1个*                                          大于或等于0个?                                           0或者1个()                                          一组标签|                                           或,                                           与，但有前后顺序<space>                                   与，但没有前后顺序