'######################################### 'SMS/EMS Encoder 'Write by Hesicong 'Last Edited:2005/2/20 'Until now no bug found here. 'Contact: ' Email: ' hesicong@mail.sc.cninfo.net ' or ' 38288890@qq.com ' HomePage: ' http://dream-world.nease.net 'Thanks for using my code '######################################### Namespace SMSNamespace SMS Namespace EncoderNamespace Encoder PublicClass SMSClass SMS Enums#Region "Enums" PublicEnum ENUM_TP_VPFEnum ENUM_TP_VPF Relative_Format =16'b4=1 b3=0 End Enum PublicEnum ENUM_TP_SRIEnum ENUM_TP_SRI Request_SMS_Report =32 No_SMS_Report =0 End Enum PublicEnum ENUM_TP_DCSEnum ENUM_TP_DCS DefaultAlphabet =0 UCS2 =8 End Enum PublicEnum ENUM_TP_VALID_PERIODEnum ENUM_TP_VALID_PERIOD OneHour =11'0 to 143:(TP-VP+1)*5Min ThreeHours =29 SixHours =71 TwelveHours =143 OneDay =167 OneWeek =196 Maximum =255 End Enum #End Region Private Data#Region "Private Data" Protected SC_Number AsString'Note the plus! Protected TP_MTI AsByte=1 Protected TP_RD AsByte=0 Protected TP_VPF AsByte=16 Protected TP_UDHI AsByte Protected TP_SRR AsByte Protected TP_MR AsInteger Protected TP_DA AsString Protected TP_PID AsByte Protected TP_DCS AsByte Protected TP_VP AsByte Protected TP_UDL AsInteger Protected TP_UD AsString #End Region Properties#Region "Properties" PublicProperty ServiceCenterNumber()Property ServiceCenterNumber() AsString Get Return SC_Number EndGet Set(ByVal Value AsString) 'Convert an ServiceCenterNumber to PDU Code IfInStr(Value, "+") Then SC_Number ="91" Else SC_Number ="81" EndIf Value =Mid(Value, 2) Dim i AsInteger If (Value.Length Mod2) =1Then Value +="F" EndIf For i =1To Value.Length Step2 SC_Number += Swap(Mid(Value, i, 2)) Next SC_Number = ByteToHex((SC_Number.Length -2) /2+1) + SC_Number EndSet End Property PublicProperty TP_Status_Report_Request()Property TP_Status_Report_Request() As ENUM_TP_SRI Get Return TP_SRR EndGet Set(ByVal Value As ENUM_TP_SRI) TP_SRR = Value EndSet End Property PublicProperty TP_Message_Reference()Property TP_Message_Reference() AsInteger Get Return TP_MR EndGet Set(ByVal Value AsInteger) TP_MR = Value EndSet End Property PublicProperty TP_Destination_Address()Property TP_Destination_Address() AsString Get Return TP_DA EndGet Set(ByVal Value AsString) TP_DA ="" IfInStr(Value, "+") Then TP_DA +="91" Else TP_DA +="81" EndIf Value = Value.Replace("+", "") TP_DA =Format(Value.Length, "X2") + TP_DA Dim i AsInteger If (Value.Length Mod2) =1Then Value +="F" EndIf For i =1To Value.Length Step2 TP_DA += Swap(Mid(Value, i, 2)) Next EndSet End Property PublicProperty TP_Data_Coding_Scheme()Property TP_Data_Coding_Scheme() As ENUM_TP_DCS Get Return TP_DCS EndGet Set(ByVal Value As ENUM_TP_DCS) TP_DCS = Value EndSet End Property PublicProperty TP_Validity_Period()Property TP_Validity_Period() As ENUM_TP_VALID_PERIOD Get Return TP_VP EndGet Set(ByVal Value As ENUM_TP_VALID_PERIOD) TP_VP = Value EndSet End Property PublicOverridableProperty TP_User_Data()Property TP_User_Data() AsString Get Return TP_UD EndGet Set(ByVal Value AsString) SelectCase TP_DCS CaseIs= ENUM_TP_DCS.DefaultAlphabet TP_UDL = Value.Length TP_UD = Encode7Bit(Value) CaseIs= ENUM_TP_DCS.UCS2 TP_UDL = Value.Length *2 TP_UD = EncodeUCS2(Value) CaseElse TP_UD = Value EndSelect EndSet End Property #End Region Functions#Region "Functions" PublicSharedFunction CheckForEncoding()Function CheckForEncoding(ByVal Content AsString) As SMS.ENUM_TP_DCS Dim i AsInteger For i =1To Content.Length IfAsc(Mid(Content, i, 1)) <0Then Return SMS.ENUM_TP_DCS.UCS2 EndIf Next Return SMS.ENUM_TP_DCS.DefaultAlphabet End Function PublicOverridableFunction GetSMSPDUCode()Function GetSMSPDUCode() AsString Dim PDUCode AsString 'Check User Data Length If TP_DCS = ENUM_TP_DCS.DefaultAlphabet Then If TP_UD.Length >280ThenThrowNew Exception("User Data is TOO LONG for SMS") EndIf If TP_DCS = ENUM_TP_DCS.UCS2 Then If TP_UD.Length >280ThenThrowNew Exception("User Data is TOO LONG for SMS") EndIf 'Make PDUCode PDUCode = SC_Number PDUCode += FirstOctet() PDUCode +=Format(TP_MR, "X2") PDUCode += TP_DA PDUCode +=Format(TP_PID, "X2") PDUCode +=Format(TP_DCS, "X2") PDUCode +=Format(TP_VP, "X2") PDUCode +=Format(TP_UDL, "X2") PDUCode += TP_UD Return PDUCode End Function PublicOverridableFunction FirstOctet()Function FirstOctet() AsString Return ByteToHex(TP_MTI + TP_VPF + TP_SRR + TP_UDHI) End Function SharedFunction ByteToHex()Function ByteToHex(ByVal aByte AsByte) AsString Dim result AsString result =Format(aByte, "X2") Return result End Function Enocode7Bit#Region "Enocode7Bit" SharedFunction Encode7Bit()Function Encode7Bit(ByVal Content AsString) AsString 'Prepare Dim CharArray AsChar() = Content.ToCharArray Dim c AsChar Dim t AsString ForEach c In CharArray t = CharTo7Bits(c) + t Next 'Add "0" Dim i AsInteger If (t.Length Mod8) <>0Then For i =1To8- (t.Length Mod8) t ="0"+ t Next EndIf 'Split into 8bits Dim result AsString For i = t.Length -8To0Step-8 result = result + BitsToHex(Mid(t, i +1, 8)) Next Return result End Function SharedFunction BitsToHex()Function BitsToHex(ByVal Bits AsString) AsString 'Convert 8Bits to Hex String Dim i, v AsInteger For i =0To Bits.Length -1 v = v +Val(Mid(Bits, i +1, 1)) *2^ (7- i) Next Dim result AsString result =Format(v, "X2") Return result End Function SharedFunction CharTo7Bits()Function CharTo7Bits(ByVal c AsChar) AsString If c ="@"ThenReturn"0000000" Dim Result AsString Dim i AsInteger For i =0To6 If (Asc(c) And2^ i) >0Then Result ="1"+ Result Else Result ="0"+ Result EndIf Next Return Result End Function #End Region SharedFunction EncodeUCS2()Function EncodeUCS2(ByVal Content AsString) AsString Dim i, j, v AsInteger Dim Result, t AsString For i =1To Content.Length v = AscW(Mid(Content, i, 4)) t =Format(v, "X4") Result += t Next Return Result End Function SharedFunction Swap()Function Swap(ByRef TwoBitStr AsString) AsString 'Swap two bit like "EF" TO "FE" Dim c() AsChar= TwoBitStr.ToCharArray Dim t AsChar t = c(0) c(0) = c(1) c(1) = t Return (c(0) + c(1)).ToString End Function #End Region End Class PublicClass ConcatenatedShortMessageClass ConcatenatedShortMessage Inherits SMS Private TotalMessages AsInteger PublicFunction GetEMSPDUCode()Function GetEMSPDUCode() AsString() SelectCase tp_dcs Case ENUM_TP_DCS.UCS2 TotalMessages = (TP_UD.Length /4) \66+ ((TP_UD.Length /4Mod66) =0) Case ENUM_TP_DCS.DefaultAlphabet TotalMessages = (tp_ud.Length \266) - ((tp_ud.Length Mod266) =0) EndSelect Dim Result(TotalMessages) AsString Dim tmpTP_UD AsString Dim i AsInteger TP_UDHI =2^6 Dim Reference AsInteger=Rnd(1) *65536'16bit Reference Number 'See 3GPP Document For i =0To TotalMessages SelectCase tp_dcs Case ENUM_TP_DCS.UCS2 tmpTP_UD =Mid(TP_UD, i *66*4+1, 66*4) 'When TP_UDL is odd, the max length of an Unicode string in PDU code is 66 Charactor.See [3GPP TS 23.040 V6.5.0 (2004-09] 9.2.3.24.1 Case ENUM_TP_DCS.DefaultAlphabet tmpTP_UD =Mid(tp_ud, i *133*2+1, 133*2) EndSelect Result(i) = SC_Number Result(i) += FirstOctet() Result(i) +=Format(TP_MR, "X2") 'Next segement TP_MR must be increased 'TP_MR += 1 Result(i) += TP_DA Result(i) +=Format(TP_PID, "X2") Result(i) +=Format(TP_DCS, "X2") Result(i) +=Format(TP_VP, "X2") If tp_dcs = ENUM_TP_DCS.UCS2 Then TP_UDL = tmpTP_UD.Length /2+6+1'6:IE EndIf If tp_dcs = ENUM_TP_DCS.DefaultAlphabet Then TP_UDL =Fix((tmpTP_UD.Length +7*2) *4/7) '6:length of IE ''################################# ''still problem here: ''when the charcter is several times of 7 of the last message, tp_udl will not correct! ''to correct this problem i write some code below. that's may not perfect solution. ''################################# 'If i = TotalMessages And ((tmpTP_UD.Length Mod 14) = 0) Then ' tp_udl -= 1 'End If EndIf Result(i) +=Format(TP_UDL, "X2") Result(i) +="060804"'TP_UDHL and some of Concatenated message Result(i) +=Format(Reference, "X4") Result(i) +=Format(TotalMessages +1, "X2") Result(i) +=Format(i +1, "X2") Result(i) += tmpTP_UD Next Return Result End Function PublicOverridesFunction FirstOctet()Function FirstOctet() AsString Return ByteToHex(TP_MTI + TP_VPF + TP_SRR + TP_UDHI) End Function End Class End Namespace End Namespace