modoperation.bas

用visua basic语言开发的进行大数运算的代码。

Attribute VB_Name = "ModOperation"
'大数运算模块(仅支持正整数运算)
'作者：陨落雕(刘留)
'作者E-mail：[e-mail]
'作者主页：http://www.fantasiasoft.net/
'本模块您可以任意使用或传播，但是请不要删除上面的说明文字，
'如用于商业用途，请在Credit里面注明使用本模块，谢谢合作！

Function StrADC(Num1 As String, Num2 As String) As String '加法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To IIf(LengthOfNum1 > LengthOfNum2, LengthOfNum1 + 1, LengthOfNum2 + 1)) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
  NumByte1(i) = Mid(Num1, j, 1)
  j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
  NumByte2(i) = Mid(Num2, j, 1)
  j = j - 1
Next i
For i = 1 To UBound(ResultByte) - 1 '进行运算
  If (i <= LengthOfNum2) And (i <= LengthOfNum1) Then
    TempByte = NumByte1(i) + NumByte2(i) + ResultByte(i) '各个数位进行加法运算
  ElseIf (i <= LengthOfNum2) Then
      TempByte = NumByte2(i) + ResultByte(i) '同上
    ElseIf (i <= LengthOfNum1) Then
        TempByte = NumByte1(i) + ResultByte(i) '同上
  End If
  If TempByte < &HA Then '如果TempByte小于10
    ResultByte(i) = TempByte '直接输出TempByte到保存最终结果的数组
  Else '否则
    ResultByte(i) = TempByte - 10 '将TempByte减去10再保存到最终结果
    ResultByte(i + 1) = 1 '进位1
  End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
  If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
  Result = CStr(ResultByte(i)) + Result
Next i
StrADC = Result
End Function

Function StrLt(Num1 As String, Num2 As String) As Boolean
'如果Num1小于Num2，输出结果True，否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
For i = 1 To Len(Num1)
 If Mid(Num1, i, 1) = "0" Then Num1 = Right(Num1, Len(Num1) - 1) Else Exit For
Next i
For i = 1 To Len(Num2)
 If Mid(Num2, i, 1) = "0" Then Num2 = Right(Num2, Len(Num2) - 1) Else Exit For
Next i
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 > LengthOfNum2 Then '进行长度比较
  StrLt = False
ElseIf LengthOfNum1 < LengthOfNum2 Then '同上
    StrLt = True
  Else '如果长度相等
    For i = 1 To LengthOfNum1 '逐位进行比较
      NumByte1 = Mid(Num1, i, 1)
      NumByte2 = Mid(Num2, i, 1)
      If NumByte1 <> NumByte2 Then '如果不相等
        If NumByte1 < NumByte2 Then StrLt = True '且Num1的那位小于Num2的那位，输出True
        Exit For '不管是否为True，都退出循环
      End If
    Next i
End If
End Function

Function StrMt(Num1 As String, Num2 As String) As Boolean
'如果Num1大于Num2，输出结果True，否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
For i = 1 To Len(Num1)
 If Mid(Num1, i, 1) = "0" Then Num1 = Right(Num1, Len(Num1) - 1) Else Exit For
Next i
For i = 1 To Len(Num2)
 If Mid(Num2, i, 1) = "0" Then Num2 = Right(Num2, Len(Num2) - 1) Else Exit For
Next i
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 < LengthOfNum2 Then '进行长度比较
  StrMt = False
ElseIf LengthOfNum1 > LengthOfNum2 Then '同上
    StrMt = True
  Else
    For i = 1 To LengthOfNum1 '逐位进行比较
      NumByte1 = Mid(Num1, i, 1)
      NumByte2 = Mid(Num2, i, 1)
      If NumByte1 <> NumByte2 Then '如果不相等
        If NumByte1 > NumByte2 Then StrMt = True '且Num1的那位大于Num2的那位，输出Ture
        Exit For '不管是否为True，都退出循环
      End If
    Next i
End If
End Function

Function StrSwap(Num1 As String, Num2 As String) As Boolean
'进行数据的交换
Dim ChangeNum As String
ChangeNum = Num1
Num1 = Num2
Num2 = ChangeNum
StrSwap = True
End Function

Function StrSBB(Num1 As String, Num2 As String) As String '减法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
If StrLt(Num1, Num2) = True Then StrSwap Num1, Num2 '如果Num1小于Num2，交换位置
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
  NumByte1(i) = Mid(Num1, j, 1)
  j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
  NumByte2(i) = Mid(Num2, j, 1)
  j = j - 1
Next i
For i = 1 To UBound(ResultByte) '进行运算
  If i <= LengthOfNum2 Then
    TempByte = NumByte1(i) - NumByte2(i) '各个数位进行加法运算
    If TempByte < &H0 Then '如果小于0了
      TempByte = TempByte + 10 '加上10
      NumByte1(i + 1) = NumByte1(i + 1) - 1 '向上借一位
    End If
  Else
    TempByte = NumByte1(i)
  End If
  ResultByte(i) = TempByte '输出TempByte到保存最终结果的数组
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
  If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
  Result = CStr(ResultByte(i)) + Result
Next i
StrSBB = Result
End Function

Function StrMUL(Num1 As String, Num2 As String) As String '乘法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1 + LengthOfNum2) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
  NumByte1(i) = Mid(Num1, j, 1)
  j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
  NumByte2(i) = Mid(Num2, j, 1)
  j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
  For j = 1 To LengthOfNum2
    TempByte = NumByte1(i) * NumByte2(j) '各位进行乘法运算
    fi = i + j - 1 '计算偏移位
    If TempByte < &HA Then '如果小于10
      ResultByte(fi) = ResultByte(fi) + TempByte '直接输出到ResultByte(fi)中
    Else '否则
      TempHighByte = TempByte \ 10 '计算进位的多少
      ResultByte(fi) = ResultByte(fi) + TempByte - TempHighByte * 10 '计算个位
      ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
    End If
    If ResultByte(fi) > &H9 Then '如果ResultByte(fi)大于10
      TempHighByte = ResultByte(fi) \ 10 '输出进位的多少
      ResultByte(fi) = ResultByte(fi) - TempHighByte * 10 '计算个位
      ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
    End If
  Next j
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
  If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
  Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(Result) <> "" Then StrMUL = Result Else StrMUL = "0"
End Function

Function StrDIV(Num1 As String, Num2 As String, ModNum As String) As String '除法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempNum As String, TempModNum As String
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
If Num1 = "0" Or Num2 = "0" Then
  ModNum = "0"
  Exit Function
End If
If StrLt(Num1, Num2) = True Then
  ModNum = Num1
  Exit Function
'StrSwap Num1, Num2 '如果Num1小于Num2，交换位置
End If
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim ResultByte(1 To LengthOfNum1 - LengthOfNum2 + 1) As Long
fi = LengthOfNum1 - LengthOfNum2 + 1
TempNum = Left(Num1, LengthOfNum2) '取得前LengthOfNum2位
For i = LengthOfNum2 To LengthOfNum1 '进行运算
  If i > LengthOfNum2 Then TempNum = TempNum & Mid(Num1, i, 1) '增加一位
  If StrLt(TempNum, Num2) = False Then '如果TempNum不小于Num2
    For j = 2 To 10 '进行测试
      If StrMt(StrXLng(Num2, j), TempNum) = True Then '直到Num2 * j大于TempNum为止
        ResultByte(fi) = j - 1 '输出最终结果到ResultByte(fi)
        TempNum = StrSBB(TempNum, StrXLng(Num2, ResultByte(fi))) '取得余数
        Exit For
      End If
    Next j
  End If
  fi = fi - 1
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
  If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
  Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(TempNum) <> "" Then ModNum = TempNum Else ModNum = "0"
If Trim$(Result) <> "" Then StrDIV = Result Else StrDIV = "0"
End Function

Public Function StrXLng(Num1 As String, Num2 As Long) As String '进行Long变量和String变量的混合乘法运算(速度有提升)
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long
Dim LengthOfNum1 As Long
LengthOfNum1 = Len(Num1) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim ResultByte(1 To LengthOfNum1 + 1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
  NumByte1(i) = Mid(Num1, j, 1)
  j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
  TempByte = NumByte1(i) * Num2 '各位进行乘法运算
  If TempByte < &HA Then '如果小于10
    ResultByte(i) = ResultByte(i) + TempByte '直接输出到ResultByte(fi)中
  Else '否则
    TempHighByte = TempByte \ 10 '计算进位的多少
    ResultByte(i) = ResultByte(i) + TempByte - TempHighByte * 10 '计算个位
    ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
  End If
  If ResultByte(i) > &H9 Then '如果ResultByte(fi)大于10
    TempHighByte = ResultByte(i) \ 10 '输出进位的多少
    ResultByte(i) = ResultByte(i) - TempHighByte * 10 '计算个位
    ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
  End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
  If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
  Result = CStr(ResultByte(i)) + Result
Next i
StrXLng = Result
End Function

Function StrHex2Dec(HexStr As String) As String
Dim Result As String, TempStr As String
Dim LengthOfHex As Long, i As Long, j As Long, HexBytes() As String
LengthOfHex = Len(HexStr)
ReDim HexBytes(1 To LengthOfHex)
ReDim DecBytes(1 To LengthOfHex + 1)
For j = LengthOfHex To 1 Step -1
  i = i + 1
  Select Case Mid(HexStr, j, 1)
  Case "F"
    HexBytes(i) = "15"
  Case "E"
    HexBytes(i) = "14"
  Case "D"
    HexBytes(i) = "13"
  Case "C"
    HexBytes(i) = "12"
  Case "B"
    HexBytes(i) = "11"
  Case "A"
    HexBytes(i) = "10"
  Case "9"
    HexBytes(i) = "9"
  Case "8"
    HexBytes(i) = "8"
  Case "7"
    HexBytes(i) = "7"
  Case "6"
    HexBytes(i) = "6"
  Case "5"
    HexBytes(i) = "5"
  Case "4"
    HexBytes(i) = "4"
  Case "3"
    HexBytes(i) = "3"
  Case "2"
    HexBytes(i) = "2"
  Case "1"
    HexBytes(i) = "1"
  Case "0"
    HexBytes(i) = "0"
  End Select
Next j
Result = "0"
For i = 1 To LengthOfHex
TempStr = HexBytes(i)
For j = 2 To i
    TempStr = StrMUL(TempStr, "16")
  Next j
  Result = StrADC(TempStr, Result)
Next i
If Trim$(Result) <> "" Then StrHex2Dec = Result Else StrHex2Dec = "0"
End Function