by K.V.N.Jitendra (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 21st October 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This code converts the text message to PDU(BCH fromat).
VBcoders
Dim strbin As String, strdata As String
Dim iVal As String
Dim i As Integer, j As Integer, k As Integer
Dim str1 As String, str2 As String, strfinal As String
Private Sub Command1_Click()
'stri = "hellohello"
stri = Text1.Text
For i = 1 To Len(stri)
iVal = AscW(Mid(stri, i, 1))
strbin = strbin + dectobin(iVal)
Next
k = 1
For j = 1 To Len(strbin) Step 7
str1 = Mid(strbin, j, 7)
str2 = Right(Mid(strbin, j + 7, 7), k)
If str2 = "" Then
j = j + 7
k = k + 1
strdat = strdat + Right(Mid(strbin, j + 7, 7), k) + Left(str1, Len(str1) - k + 1)
Else
strdat = strdat + str2 + Left(str1, Len(str1) - k + 1)
k = k + 1
If k > 7 Then k = 0
str2 = ""
End If
Next
strlnt = Len(strdat) Mod 4
For n = 1 To (Len(strdat) - strlnt)
strfinal = strfinal + bintohex(Mid(strdat, n, 4))
n = n + 3
Next
If strlnt > 0 Then
strfinal = strfinal + bintohex(Mid(strdat, Len(strdat) - strlnt + 1))
End If
Text2.Text = strfinal
End Sub
Function dectobin(iVal As String)
Dim strnumber As String, number As String
Do Until iVal = 0 Or iVal = 1
number = iVal Mod 2
strnumber = number + strnumber
iVal = iVal \ 2
Loop
strnumber = CStr(iVal) + strnumber
dectobin = strnumber
End Function
Function bintohex(data As String)
Dim temp As String, strsum As Integer, strtemp As String, spl As Integer
temp = data
k = Len(temp)
j = 0
strsum = 0
Do Until k < 1
spl = CInt(Mid(temp, k, 1))
strsum = strsum + spl * 2 ^ j
k = k - 1
j = j + 1
Loop
strtemp = strtemp + CStr(Getval(strsum))
bintohex = strtemp
End Function
Public Function Getval(strsum As Integer) As String
Select Case strsum
Case 10
alpha = "A"
Case 11
alpha = "B"
Case 12
alpha = "C"
Case 13
alpha = "D"
Case 14
alpha = "E"
Case 15
alpha = "F"
Case Else
alpha = strsum
End Select
Getval = CStr(alpha)
End Function