，歡迎訪問網(wǎng)頁設(shè)計愛好者web開發(fā)。
去年接觸了聯(lián)通的“定位之星”增值業(yè)務(wù)，客戶端都是php的（說到php，真的發(fā)現(xiàn)以前太小看php了，功能還是很強大的，呵呵），因為聯(lián)通不開通開發(fā)測試，所以自己寫了這個模擬器，功能非常簡陋，純粹是為了測試通信存在。
廢話少說，源碼貼上（贅姆爛殼的老規(guī)矩，沒多少注釋）
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 = "<r 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, "couldn't 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節(jié)點
set nodereq = xml.selectsinglenode("req")
if nodereq is nothing then
'沒有req節(jié)點，返回錯誤
call sendmsg(idx, "couldn't support the operation")
exit sub
end if
'取client節(jié)點
set nodeclient = nodereq.selectsinglenode("client")
if nodeclient is nothing then
'沒有client節(jié)點，返回錯誤
call sendmsg(idx, "couldn't support the operation")
exit sub
end if
'鑒權(quán)
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, "couldn't 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
'取數(shù)據(jù)
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, "couldn't 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, "couldn't 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沒有寫，實際幾乎沒有此需求，畢竟太耗費系統(tǒng)資源，好像當(dāng)時聯(lián)通也不支持，不知現(xiàn)在如何了
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協(xié)議的簡介
1 概述1.1 l1接口根據(jù)pn4747，l1接口是cdma移動定位中心（mpc）與位置服務(wù)客戶機（lcs client）之間的接口。 l1接口協(xié)議（cdma移動定位協(xié)議）是應(yīng)用級協(xié)議，用于使用cdma無線定位技術(shù)定位時mpc和sp位置應(yīng)用的通訊接口。本文將介紹移動定位中心（mpc）應(yīng)該能夠執(zhí)行的操作的核心集合。1.2 承載方式l1移動定位承載協(xié)議采用http/xml，通過ssl 保證數(shù)據(jù)傳輸?shù)陌踩ml(extensible markup language)，是一種可延伸或擴展的標記語言，它的優(yōu)點是可根據(jù)設(shè)計的需要自行定義標簽，sp和mpc間的接口往往會根據(jù)功能或業(yè)務(wù)的需要自行定義參數(shù)，使用該語言可以自行定義標簽，建立數(shù)據(jù)非常靈活。 mpc對sp設(shè)置兩個http 端口，一個通過ssl來保證數(shù)據(jù)安全，一個不需要采用ssl。前者主要提供給非信任域、非安全域的用戶，如通過internet 來訪問的用戶確保數(shù)據(jù)安全；后者提供給信任域、安全域的用戶，如通過局域網(wǎng)來訪問的用戶，同時由于不采用ssl可提高數(shù)據(jù)傳輸速度。可以選擇兩個端口號碼作為建議的標準端口。端口應(yīng)該由iana（internet指定的號碼機構(gòu)）登記。對cdma中用到兩個端口號碼的建議如下：· 700 用于ssl傳輸· 701用于非安全傳輸mpc和位置服務(wù)器可以選擇基于其它端口的技術(shù)或http透明技術(shù)實現(xiàn)安全傳輸。但是，無論使用哪種技術(shù)，都不能使用上述兩個端口。http 版本為1.1，關(guān)于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的任何數(shù)字{min,max} 表示長度在min和max之間[a-z,a-z,0-9] 表示可以為所有小寫字母、所有大寫字母、0到9的所有數(shù)字 舉例：[0-9] {7,8}表示長度為7位或8位的數(shù)字串，如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> 與，但沒有前后順序
