去年接触了联通的“定位之星”增值业务，客户端都是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 = "<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节点
Set nodeREQ = xml.selectSingleNode("REQ")
If nodeREQ Is Nothing Then
'没有REQ节点，返回错误
Call SendMsg(idx, "couldn't support the operation")
Exit Sub
End If
'取CLIENT节点
Set nodeCLIENT = nodeREQ.selectSingleNode("CLIENT")
If nodeCLIENT Is Nothing Then
'没有CLIENT节点，返回错误
Call SendMsg(idx, "couldn't 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, "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
'取数据
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没有写，实际几乎没有此需求，毕竟太耗费系统资源，好像当时联通也不支持，不知现在如何了
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或9
1.3.2 DTD语法+ 大于或等于1个
* 大于或等于0个
? 0或者1个
() 一组标签
| 或
, 与，但有前后顺序
<space> 与，但没有前后顺序
