VB No multiplica, es una verguenza

Pues para poder procesar en VB una cantidad numerica algo grande se tiene que recurrir a otro tipo de procedimientos (algo complejo) afortunadamente hace tiempo realizae un programa que permitia multiplicar una cantidad muy grade de cifras numericas

Option Explicit On
Option Strict On

Imports System

Namespace punisher.Math
Public Class Real
Friend Shared ad() As String
Public Shared NumDecimales As Integer = 4
Public Shared MostrarResto As Boolean = False
'
'
Private Shared Function miDiv2(ByVal num1 As String, ByVal num2 As String, ByVal decAct As Integer) As String
Dim res As String = num1
Dim n As Integer = 0
If num2.Length < num1.Length Then
num2 = (New String("0"c, num1.Length) & num2).Substring(num2.Length, num1.Length)
End If
Do
res = miResta2(res, num2)
n += 1
If res = "0" OrElse res < num2 Then Exit Do
Loop
res = quitarCeros(res)
If res <> "0" Then
If decAct < NumDecimales Then
decAct += 1
res = miDiv2(res & "0", num2, decAct)
' quitar los puntos que haya
res = res.Replace(".", "")
Return n.ToString & "." & res
Else
' si queda un resto mostrarlo con :
' (o bien no mostrarlo)
If MostrarResto Then
Return n.ToString & ":" & res
Else
Return n.ToString '& ":" & res
End If
End If
Else
Return n.ToString
End If
End Function
Public Shared Function Div2(ByVal num1 As String, ByVal num2 As String) As String
' Para dividir dos números:
' Se leva restando al dividendo el divisor hasta que
' el resto sea cero o menor que el divisor
Dim decAct As Integer = 0
'
Dim nDec1 As Integer
Dim nDec2 As Integer
Dim dec1 As Integer = num1.IndexOf(".")
Dim dec2 As Integer = num2.IndexOf(".")
If dec1 > -1 Then
num1 = quitarCerosFinales(num1)
nDec1 = num1.Substring(dec1 + 1).Length
num1 = num1.Replace(".", "")
End If
If dec2 > -1 Then
num2 = quitarCerosFinales(num2)
nDec2 = num2.Substring(dec2 + 1).Length
num2 = num2.Replace(".", "")
End If
If nDec1 > 0 Then
num2 = num2 & New String("0"c, nDec1)
End If
If nDec2 > 0 Then
num1 = num1 & New String("0"c, nDec2)
End If
'
Return miDiv2(num1, num2, decAct)
End Function
'
Public Shared Function PotN(ByVal num1 As String, ByVal elevado As String) As String
Dim i As Integer
'
' si el exponente tiene decimales, quitárselo
i = elevado.IndexOf(".")
If i > -1 Then
elevado = elevado.Substring(0, i)
End If
'
If elevado = "0" Then
Return "1"
ElseIf elevado = "1" Then
Return num1
End If
If num1 = "1" Then
Return "1"
ElseIf num1 = "0" Then
Return "0"
End If
'
i = CInt(elevado) - 1
Dim p(i) As String
For k As Integer = 0 To i
p(k) = num1
Next
Return Mult2(p)
End Function
'
Public Shared Function Mult2(ByVal ParamArray nums() As String) As String
Dim total As String = nums(0)
For i As Integer = 1 To nums.Length - 1
Dim n1 As String = nums(i)
total = Mult2(total, n1)
Next
'
Return total
End Function
Public Shared Function Mult2(ByVal num1 As String, ByVal num2 As String) As String
'
' Comprobar si alguno de los números tiene decimales (11/Ago/04)
Dim nDec As Integer
'
Dim dec1 As Integer = num1.IndexOf(".")
Dim dec2 As Integer = num2.IndexOf(".")
If dec1 > -1 Then
nDec = num1.Substring(dec1 + 1).Length
num1 = num1.Replace(".", "")
End If
If dec2 > -1 Then
nDec += num2.Substring(dec2 + 1).Length
num2 = num2.Replace(".", "")
End If
'
' Poner el más largo como primer número
If num2.Length > num1.Length Then
Swap(num1, num2)
End If
'
' El número de operaciones necesarias
' será la cantidad de cifras del más pequeño
ReDim ad(num2.Length - 1)
Dim n As Integer = -1
Dim resto As String = "0"
Dim res As String = ""
'
' Multiplicar formando filas con los resultados (al estilo manual)
For i As Integer = num2.Length - 1 To 0 Step -1
n += 1
ad(n) = ""
' Añadir espacios a la derecha según la cifra (fila) que se procese
For k As Integer = 1 To n
ad(n) &= " "
Next
Dim c1 As String = num2.Substring(i, 1)
' Para simplificar las cosas
' se comprueba si se multiplicará por ceo o por uno
' de forma que no sea necesario hacer estas operaciones
If c1 = "0" Then
ad(n) = New String("0"c, num1.Length) & ad(n)
ElseIf c1 = "1" Then
ad(n) = num1 & ad(n)
Else
For j As Integer = num1.Length - 1 To 0 Step -1
Dim c2 As String = num1.Substring(j, 1)
res = (CInt("0" & c1) * CInt("0" & c2) + CInt(resto)).ToString
'ad(n) = vb.Right(res, 1) & ad(n)
ad(n) = res.Substring(res.Length - 1, 1) & ad(n)
If res.Length - 1 < 1 Then
resto = "0"
Else
resto = res.Substring(0, res.Length - 1)
End If
Next
If resto <> "0" Then
ad(n) = resto & ad(n)
resto = "0"
End If
End If
Next
'
res = sumarFilas()
If nDec > 0 Then
If NumDecimales = 0 Then
res = res.Substring(0, res.Length - nDec)
Else
resto = res.Substring(res.Length - nDec)
If resto.Length > NumDecimales Then
resto = resto.Substring(0, NumDecimales)
End If
res = res.Substring(0, res.Length - nDec) & "." & quitarCerosFinales(resto)
End If
End If
Return res
End Function
'
Public Shared Function Suma2(ByVal ParamArray nums() As String) As String
'
ReDim ad(nums.Length - 1)
For i As Integer = 0 To nums.Length - 1
ad(i) = nums(i)
Next
'
Return sumarFilas()
End Function
Public Shared Function Suma2(ByVal num1 As String, ByVal num2 As String) As String
ReDim ad(1)
'
Dim nDec As Integer
Dim nDec1 As Integer
Dim nDec2 As Integer
Dim dec1 As Integer = num1.IndexOf(".")
Dim dec2 As Integer = num2.IndexOf(".")
If dec1 > -1 Then
num1 = quitarCerosFinales(num1)
nDec1 = num1.Substring(dec1 + 1).Length
num1 = num1.Replace(".", "")
End If
If dec2 > -1 Then
num2 = quitarCerosFinales(num2)
nDec2 = num2.Substring(dec2 + 1).Length
num2 = num2.Replace(".", "")
End If
If nDec1 > 0 Then
num2 = num2 & New String("0"c, nDec1)
End If
If nDec2 > 0 Then
num1 = num1 & New String("0"c, nDec2)
End If
nDec = nDec1 + nDec2
'
ad(0) = num1
ad(1) = num2
'
'Return sumarFilas()
'
Dim res As String = sumarFilas()
Dim resto As String = ""
If nDec > 0 Then
If NumDecimales = 0 Then
res = res.Substring(0, res.Length - nDec)
Else
resto = res.Substring(res.Length - nDec)
If resto.Length > NumDecimales Then
resto = resto.Substring(0, NumDecimales)
End If
res = res.Substring(0, res.Length - nDec) & "." & quitarCerosFinales(resto)
End If
End If
Return res
End Function
'
Public Shared Function Resta2(ByVal ParamArray nums() As String) As String
Dim total As String = nums(0)
For i As Integer = 1 To nums.Length - 1
Dim n1 As String = nums(i)
total = miResta2(total, n1)
Next
'
Return total
End Function
Private Shared Function miResta2(ByVal num1 As String, ByVal num2 As String) As String
' usar esta función para cálculos internos en los que no se deben quitar
' los ceros del principio del número
ReDim ad(1)
'
Dim nDec As Integer
Dim nDec1 As Integer
Dim nDec2 As Integer
Dim dec1 As Integer = num1.IndexOf(".")
Dim dec2 As Integer = num2.IndexOf(".")
If dec1 > -1 Then
num1 = quitarCerosFinales(num1)
nDec1 = num1.Substring(dec1 + 1).Length
num1 = num1.Replace(".", "")
End If
If dec2 > -1 Then
num2 = quitarCerosFinales(num2)
nDec2 = num2.Substring(dec2 + 1).Length
num2 = num2.Replace(".", "")
End If
If nDec1 > 0 Then
num2 = num2 & New String("0"c, nDec1)
End If
If nDec2 > 0 Then
num1 = num1 & New String("0"c, nDec2)
End If
nDec = nDec1 + nDec2
'
ad(0) = num1
ad(1) = num2
'
'Return restar2Filas()
'
Dim res As String = restar2Filas()
Dim resto As String = ""
If nDec > 0 Then
If NumDecimales = 0 Then
res = res.Substring(0, res.Length - nDec)
Else
resto = res.Substring(res.Length - nDec)
If resto.Length > NumDecimales Then
resto = resto.Substring(0, NumDecimales)
End If
res = res.Substring(0, res.Length - nDec) & "." & quitarCerosFinales(resto)
End If
End If
Return res
End Function
Public Shared Function Resta2(ByVal num1 As String, ByVal num2 As String) As String
Return quitarCeros(miResta2(num1, num2))
End Function
'
Private Shared Function sumarFilas() As String
Dim m As Integer = 0
Dim n As Integer = ad.Length - 1
'
' m será el número de mayor longitud
For k As Integer = 0 To n
If ad(k).Length > m Then m = ad(k).Length
Next
'
' sumar las filas obtenidas
Dim resto As String = "0"
Dim total As String = ""
Dim res As String = ""
'
For k As Integer = 0 To n
'ad(k) = vb.Right(New String(" "c, m) & ad(k), m)
ad(k) = (New String(" "c, m) & ad(k)).Substring(ad(k).Length, m)
Next
For k As Integer = m - 1 To 0 Step -1
res = resto
For i As Integer = 0 To n
res = (CInt(res) + CInt("0" & ad(i).Substring(k, 1))).ToString
Next
'total = vb.Right(res, 1) & total
total = res.Substring(res.Length - 1, 1) & total
If res.Length - 1 < 1 Then
resto = "0"
Else
resto = res.Substring(0, res.Length - 1)
End If
Next
If resto <> "0" Then
total = resto & total
End If
'
Return total
End Function
'
Private Shared Function restar2Filas() As String
Dim m As Integer = 0
Dim n As Integer = ad.Length - 1
'
For k As Integer = 0 To n
If ad(k).Length > m Then m = ad(k).Length
Next
'
' restar las filas obtenidas
Dim resto As String = "0"
Dim total As String = ""
Dim res As String = ""
'
For k As Integer = 0 To n
'ad(k) = vb.Right(New String(" "c, m) & ad(k), m)
ad(k) = (New String("0"c, m) & ad(k)).Substring(ad(k).Length, m)
Next
For k As Integer = m - 1 To 0 Step -1
res = (CInt("0" & ad(0).Substring(k, 1)) - (CInt("0" & ad(1).Substring(k, 1)) + CInt(resto))).ToString
If CInt(res) < 0 Then
res = (CInt(res) + 10).ToString
res = "1" & res
End If
'total = vb.Right(res, 1) & total
total = res.Substring(res.Length - 1, 1) & total
If res.Length - 1 < 1 Then
resto = "0"
Else
resto = res.Substring(0, res.Length - 1)
End If
Next
If resto <> "0" Then
total = resto & total
End If
'
Return total
End Function
'
Public Shared Sub Swap(ByRef n1 As String, ByRef n2 As String)
Dim t As String = n1
n1 = n2
n2 = t
End Sub
'
Private Shared Function quitarCeros(ByVal num As String) As String
'
' Si tiene varios ceros, dejar sólo uno
While num.StartsWith("0")
If num = "0" Then Exit While
num = num.Substring(1)
End While
Return num
End Function
Private Shared Function quitarCerosFinales(ByVal num As String) As String
'
' Si tiene varios ceros, dejar sólo uno
While num.EndsWith("0")
If num = "0" Then Exit While
num = num.Substring(0, num.Length - 1)
End While
Return num
End Function
End Class
End Namespace

*Aclaro esto me lo paso un amigo no son mios los codes