去年接触了联通的“定位之星”增值业务,客户端都是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协议的简介
根据PN4747,L1接口是CDMA移动定位中心(MPC)与位置服务客户机(LCS Client)之间的接口。
L1接口协议(CDMA移动定位协议)是应用级协议,用于使用CDMA无线定位技术定位时MPC和SP位置应用的通讯接口。本文将介绍移动定位中心(MPC)应该能够执行的操作的核心集合。
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透明技术实现安全传输。但是,无论使用哪种技术,都不能使用上述两个端口。 特殊符号的标识: 回车(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个 * 大于或等于0个 ? 0或者1个 () 一组标签 | 或 , 与,但有前后顺序 <space> 与,但没有前后顺序 
|