PDU Encoder, PDU To TEXT

PDU Encoder

Thursday, 10. May 2007, 16:02:57

PDU To TEXT, SMS, Converter, PDU ...
Akhirnya ketemu juga. Coding buat converter PDU ke ASCII dan sebaliknya. Setelah muter-muter di google, sampe nge-trace coding pascal, pokoknya seru dech. Walaupun masih kacau codingnya, solanya baru aja selesai, belum sempat di-tuning. ni juga mempoles dari coding di internet. heheh

Public Class PDU

Implements IDisposable

Private Const iLenAwal As Integer = 4
Private Const iLenTengah As Integer = 4

Private Function GetLenSMSC(ByVal aMsg As String) As Integer
Return GetDecimal(Left(aMsg.Trim, 1)) + GetDecimal(Mid(aMsg.Trim, 2, 1))
End Function

Private Function GetLenSender(ByVal aMsg As String) As Integer

Dim iLenSMSC As Integer = GetLenSMSC(aMsg) * 2
Dim i As Integer = GetDecimal(Mid(aMsg.Trim, iLenAwal + iLenSMSC + 1, 1)) + GetDecimal(Mid(aMsg.Trim, iLenAwal + iLenSMSC + 2, 1))

Return IIf(i Mod 2 = 0, i, i + 1)

End Function

Public Function GetServiceNumber(ByVal aMsg As String) As String

Dim iLenSMSC As Integer = GetLenSMSC(aMsg) * 2
Dim SMSC As String = Mid(aMsg.Trim, iLenAwal + 1, iLenSMSC - 2)

Dim iLoop As Integer = 0
Dim sPreReturn As String = ""

For iLoop = 1 To iLenSMSC Step 2
sPreReturn &= StrReverse(Mid(SMSC, iLoop, 2))
Next

Return "+" & Replace(sPreReturn, "F", "")

End Function

Public Function GetSenderNumber(ByVal MSG As String) As String

Dim iLenSMSC As Integer = GetLenSMSC(MSG) * 2
Dim iLenSender As Integer = GetLenSender(MSG)
Dim SENDER As String = Mid(MSG.Trim, iLenSMSC + iLenAwal + 5, iLenSender)

Dim iLoop As Integer = 0
Dim sPreReturn As String = ""

For iLoop = 1 To iLenSender Step 2
sPreReturn &= StrReverse(Mid(SENDER, iLoop, 2))
Next

Return "+" & Replace(sPreReturn, "F", "")

End Function

Public Function GetSendDate(ByVal aMSG As String) As String

Dim iLenSMSC As Integer = GetLenSMSC(aMSG) * 2
Dim iLenSender As Integer = GetLenSender(aMSG)
Dim iLenX As Integer = iLenAwal + iLenSMSC + iLenSender + iLenTengah
Dim sHex As String = Mid(aMSG.Trim, iLenX + 5, 6)
Dim iLoop As Integer = 0
Dim sPreReturn As String = ""

For iLoop = 1 To 6 Step 2
sPreReturn &= StrReverse(Mid(sHex, iLoop, 2))
Next

Return Format(DateSerial(Val(Left(sPreReturn, 2)), Val(Mid(sPreReturn, 3, 2)), Val(Right(sPreReturn, 2))), "dd/MM/yyyy")

End Function

Public Function GetSendTime(ByVal aMSG As String) As String

Dim iLenSMSC As Integer = GetLenSMSC(aMSG) * 2
Dim iLenSender As Integer = GetLenSender(aMSG)
Dim iLenX As Integer = iLenAwal + iLenSMSC + iLenSender + iLenTengah
Dim sHex As String = Mid(aMSG.Trim, iLenX + 11, 6)
Dim iLoop As Integer = 0
Dim sPreReturn As String = ""

For iLoop = 1 To 6 Step 2
sPreReturn &= IIf(iLoop <> 1, ":", "") & StrReverse(Mid(sHex, iLoop, 2))
Next

Return sPreReturn

End Function

Public Function GetMessage(ByVal MSG As String) As String

Dim iLenSMSC As Integer = GetLenSMSC(MSG) * 2
Dim iLenSender As Integer = GetLenSender(MSG)
Dim iLenX As Integer = iLenAwal + iLenSMSC + iLenSender + iLenTengah + 21

Return PDU_To_Text(Mid(MSG.Trim, iLenX, Len(MSG)).Trim)

End Function

Public Function PDU_To_Text(ByVal MSG As String) As String

Dim xStr As String = MSG
Dim xStr1 As String = MSG
Dim Length As Integer = Len(MSG)
Dim Length1 As Integer = Len(MSG) \ 2
Dim StrArr(160) As String
Dim j As Integer = 1
Dim c As Integer = 0
Dim StrNum As Integer
Dim Alpha As String = ""
Dim StrHexBin As String = ""
Dim StrHexToBin As String = ""
Dim StrLast As String = ""
Dim i As Integer = 0

For i = 0 To Length1
StrArr(i) = Mid(xStr, j, 2)
j += 2
Next i

For i = 0 To Length1 - 1
xStr = StrArr(i)
StrNum = 0
For j = 1 To 2
Alpha = Mid(xStr, j, 1)
c = GetDecimal(Alpha)
If j = 1 Then
c *= 16
Else
c *= 1
End If
StrNum += c
Next j
StrHexToBin = HexToBin(StrNum)
StrHexBin += StrHexToBin
Next i

If Length Mod 2 <> 0 Then
StrLast = Mid(xStr1, Length, 1)
StrLast = HexToBin(CInt(StrLast))
StrHexBin += StrLast
End If

Return BinToDec(StrHexBin)

End Function

Private Function GetDecimal(ByVal Alpha As String) As Integer

Select Case UCase(Alpha)
Case "A"
Alpha = 10
Case "B"
Alpha = 11
Case "C"
Alpha = 12
Case "D"
Alpha = 13
Case "E"
Alpha = 14
Case "F"
Alpha = 15
Case Else
Alpha = Alpha
End Select

Try
Return Alpha
Catch ex As Exception
Return 0
End Try

End Function

Private Function HexToBin(ByVal strnum As Integer) As String

Dim number As String = ""
Dim strnumber As String = ""
Dim k As Integer = 0
Dim j As Integer = 0

Do Until strnum = 0 Or strnum = 1
number = CStr(strnum Mod 2)
strnumber += number
strnum \= 2
Loop
strnumber &= CStr(strnum)
If Len(strnumber) < 8 Then
k = 8 - Len(strnumber)
For j = 1 To k
strnumber &= "0"
Next j
End If
HexToBin = strnumber

End Function

Private Function BinToDec(ByVal StrHexBin As String) As String

Dim lnt As Integer = Len(StrHexBin)
Dim strd As String = ""
Dim strsum As String = ""
Dim i As Integer = 0
Dim istr As String = ""

For i = 1 To lnt - (lnt Mod 7)
strd = Mid(StrHexBin, i, 7)
istr = AscStr(StrReverse(strd))
i += 6
strsum &= CStr(Chr(istr))
Next i

Return strsum

End Function

Private Function AscStr(ByVal StrD As String) As Integer

Dim iDec As Integer = 0
Dim iSpl As Integer = 0
Dim StrSum As Integer = 0
Dim i As Integer = 7
Dim j As Integer = 0

Do Until i < 1
iSpl = CInt(Mid(StrD, i, 1))
StrSum += iSpl * (2 ^ j)
i -= 1
j += 1
Loop

Return StrSum

End Function

Public Function Text_To_PDU(ByVal MSG As String) As String

Dim Bin_Msg_Chars(160) As String
Dim Return_String As String = ""
Dim Borrow_Value As Byte = 0
Dim i As Byte
Dim n As Byte = 0
Dim iLenMsg As Integer = Len(MSG.Trim)

If Len(MSG.Trim) = 0 Then
Return ""
End If

For i = 1 To iLenMsg
Bin_Msg_Chars(i) = Dec_To_Bin(Asc(Mid(MSG.Trim, i, 1)))
Next i

For i = 1 To iLenMsg

If i <> iLenMsg Then

If Bin_Msg_Chars(i) <> "!" Then

Borrow_Value += 1

If Borrow_Value = 8 Then
Borrow_Value = 1
End If

n += 1

Return_String &= Right$("0" & CStr(Hex(Bin_To_Dec(Right$(Bin_Msg_Chars(i + 1), Borrow_Value) & Bin_Msg_Chars(i)))), 2)

If Borrow_Value = 7 Then
Bin_Msg_Chars(i + 1) = "!"
Else
Bin_Msg_Chars(i + 1) = Mid$(Bin_Msg_Chars(i + 1), 1, Len(Bin_Msg_Chars(i + 1)) - Borrow_Value)
End If

End If

Else

n = n + 1
Return_String &= Right$("0" & CStr(Hex(Bin_To_Dec(Bin_Msg_Chars(i)))), 2)

End If

Next i

Return Return_String

End Function

Private Function Dec_To_Bin(ByVal Dec_Val As Integer) As String

Dim leading_zero_flag As Boolean = True
Dim i As Byte
Dim place_val As Byte
Dim pad_zeroes As String = ""
Dim StrTemp As String = ""

For i = 1 To 8
If i = 1 Then place_val = 128 Else place_val = place_val / 2
If Dec_Val / place_val >= 1 Then
StrTemp = StrTemp & "1"
Dec_Val -= Dec_Val
leading_zero_flag = False
Else
If leading_zero_flag = False Then
StrTemp &= "0"
End If
End If
Next i

For i = 1 To 7 - Len(StrTemp)
pad_zeroes &= "0"
Next i

Return pad_zeroes & StrTemp

End Function

Private Function Bin_To_Dec(ByVal bin_val As String) As Integer

Dim i As Integer
Dim place_val As Byte
Dim IntTemp As Integer = 0

bin_val = Right$("00000000" & bin_val, 8)

For i = 8 To 1 Step -1
If i = 8 Then place_val = 1 Else place_val = place_val * 2
If Mid$(bin_val, i, 1) = "1" Then
IntTemp += place_val
End If
Next i

Return IntTemp

End Function

Private disposedValue As Boolean = False ' To detect redundant calls

' IDisposable
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
' TODO: free unmanaged resources when explicitly called
End If

' TODO: free shared unmanaged resources
End If
Me.disposedValue = True
End Sub

#Region " IDisposable Support "
' This code added by Visual Basic to correctly implement the disposable pattern.
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region

End Class