Private Const sBaseStr As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx"
Private Const base = 100
Private Type LargeArray
mang(1 To 100) As Byte
End Type
Private Type so_rat_lon
length As Integer
data As LargeArray
End Type
Sub InitNum(ByVal text As String, v As so_rat_lon)
Dim length As Long, k As Long, result As so_rat_lon
If Len(text) Mod 2 = 1 Then text = "0" & text
length = Len(text) \ 2
result.length = length
For k = 1 To length
result.data.mang(k) = Mid(text, 2 * (length - k) + 1, 2)
Next k
v = result
End Sub
Function NumToStr(v As so_rat_lon) As String
Dim k As Long, s As String
If v.length = 0 Then Exit Function
s = Format(v.data.mang(v.length), "0")
For k = v.length - 1 To 1 Step -1
s = s & Format(v.data.mang(k), "00")
Next k
NumToStr = s
End Function
Sub vmul(a As so_rat_lon, ByVal n As Byte, v As so_rat_lon) ' v = a*n. Tra ve v
Dim length As Long, k As Long, p As Integer, nho As Byte
length = a.length
v.length = length
For k = 1 To length
p = a.data.mang(k) * CLng(n) + nho
v.data.mang(k) = p Mod base
nho = p \ base
Next k
If nho Then
v.length = length + 1
v.data.mang(length + 1) = nho
End If
End Sub
Sub vadd(a As so_rat_lon, b As so_rat_lon, v As so_rat_lon) ' v = a + b. Tra ve v
Dim length As Integer, k As Integer, nho As Byte
v = a
length = a.length
If length < b.length Then length = b.length
For k = 1 To length
nho = nho + v.data.mang(k) + b.data.mang(k)
v.data.mang(k) = nho Mod base
nho = nho \ base
Next k
If nho > 0 Then
v.data.mang(length + 1) = nho
v.length = length + 1
Else
v.length = length
End If
End Sub
Sub vdiv(a As so_rat_lon, ByVal b As Byte, nguyen As so_rat_lon, du As Byte) ' a = b*nguyen + du. Tra ve nguyen, du
Dim k As Integer, so As Long, rest As Byte, v As so_rat_lon, u As so_rat_lon
nguyen.length = a.length
For k = a.length To 1 Step -1
so = rest * 100 + a.data.mang(k)
nguyen.data.mang(k) = so \ b
rest = so Mod b
Next k
du = rest
k = nguyen.length
Do While nguyen.data.mang(k) = 0
k = k - 1
If k = 0 Then Exit Do
Loop
nguyen.length = k
End Sub
Sub vsub(a As so_rat_lon, b As so_rat_lon, v As so_rat_lon) ' v = a - b. Tra ve v
Dim length As Integer, k As Integer, vay As Byte
If (b.length = 0) Or a.length < b.length Then Err.Raise number:=9999, Description:="Tham so khong hop le"
For k = 1 To a.length
If a.data.mang(k) - vay < b.data.mang(k) Then
If k = a.length Then Err.Raise number:=9999, Description:="Tham so khong hop le"
v.data.mang(k) = a.data.mang(k) - vay + 100 - b.data.mang(k)
vay = 1
Else
v.data.mang(k) = a.data.mang(k) - vay - b.data.mang(k)
vay = 0
End If
Next k
k = a.length
Do While v.data.mang(k) = 0
k = k - 1
If k = 0 Then Exit Do
Loop
v.length = k
End Sub
Function encoding_number(ByVal number As String) As String
Dim a As so_rat_lon, nguyen As so_rat_lon, du As Byte, result As String, text As String
InitNum number, a
Do While a.length > 0
vdiv a, 60, nguyen, du
result = Mid(sBaseStr, du + 1, 1) & result
a = nguyen
text = NumToStr(nguyen)
Loop
encoding_number = result
End Function
Function decoding_code(ByVal code As String) As String
Dim k As Long, text As String, a As so_rat_lon, b As so_rat_lon, result As so_rat_lon
If Len(code) = 0 Then Exit Function
For k = 1 To Len(code) - 1
text = InStr(1, sBaseStr, Mid(code, k, 1), vbBinaryCompare) - 1
InitNum text, b
a = result
vadd a, b, result
a = result
vmul a, 60, result
Next k
text = InStr(1, sBaseStr, Mid(code, Len(code), 1), vbBinaryCompare) - 1
InitNum text, b
a = result
vadd a, b, result
decoding_code = NumToStr(result)
End Function
