Option Explicit
''''VBS 实现求 1000! 位数
''''作者: xiaoyuehen(萧月痕)
''''日期: 2006-1-6
''''MSN: xiaoyuehen(at)msn.com

''''大数加法
''''参数 x: 加数, y: 被加数
''''以数组存储
function GetAddResult(x, y)
 Dim arrR(), strX, strY, lx, ly
 strX = StrReverse(x)
 strY = StrReverse(y)
 lx = Len(strX)
 ly = Len(strY)
 ''''Msgbox lx

 Dim i, iMax, iJinWei
 If lx > ly Then
  iMax = lx
 Else
  iMax = ly
 End If

 ReDim arrR(iMax)
 iJinWei = 0

 For i = 1 to iMax
  arrR(i) = int("0" & Mid(strX, i, 1)) + int("0" & Mid(strY, i, 1)) + iJinWei

  iJinWei = arrR(i) \ 10
  arrR(i) = Right(arrR(i), 1)
 Next

 Dim strResult
 strResult = StrReverse(Join(arrR, ""))

 If Left(strResult, 1)  = "0" Or iJinWei = 1 Then
  strResult = "1" & strResult
 End If
 GetAddResult = strResult
End function

''''加法
''''参数 x: 加数, y: 被加数
''''以字符串构造
''''该方法经过试验不可行..速度太慢!
function GetAddNResult(x, y)
 Dim strX, strY, lx, ly
 strX = StrReverse(x)
 strY = StrReverse(y)
 lx = Len(strX)
 ly = Len(strY)

 Dim i, iMax, iJinWei
 If lx > ly Then
  iMax = lx
 Else
  iMax = ly
 End If

 Dim iTemp, strResult
 iJinWei = 0
 iTemp = 0

 For i = 1 to iMax
  iTemp = int("0" & Mid(strX, i, 1)) + int("0" & Mid(strY, i, 1)) + iJinWei

  iJinWei = iTemp \ 10
  strResult = (iTemp Mod 10) & strResult
 Next

 If Left(strResult, 1)  = "0" Or iJinWei = 1 Then
  strResult = "1" & strResult
 End If
 GetAddNResult = strResult
End function

''''乘法
''''参数 x: 大数, y: 小数(一位)
function GetMulResult(x, y)
 GetMulResult = 0
 Dim i
 For i = 1 to y
  GetMulResult = GetAddResult(GetMulResult, x)
 Next
End function

''''乘法
''''参数 x: 大数, y: 小数
function GetMultResult(x, y)
 GetMultResult = 0

 Dim str, lx, ly, i
 ly = Len(y)
 For i = 1 to ly
  GetMultResult = GetAddResult(GetMultResult, GetMulResult(x, CInt(Mid(y, i, 1))) & String(ly - i, "0"))
 Next
End function

''''乘法
''''参数 x: 大数, y: 大数
function GetMulcResult(x, y)
 If Len(x) > Len(y) Then
  GetMulcResult = GetMultResult(x, y)
 Else
  GetMulcResult = GetMultResult(y, x)
 End If
End function

''''阶乘
''''参数 x: 自然数
function GetFactorialResult(x)
 GetFactorialResult = x
 Dim i
 For i = (x - 1) to 2 step - 1
  GetFactorialResult = GetMulcResult(GetFactorialResult, i)
 Next
End function

''''直接求阶乘位数
''''参数 x: 自然数
''''原作: aiur2000(闭关失败，走火入魔，开关拉！)
''''vbs代码实现: xiaoyuehen
function GetFactorialLength(x)
 Dim iLen, iSum, iVal, i

 ''''思路:因为不计算具体值,所以没必要全部算出,只用计算能影响到结果的位数即可,同时要加入下次影响结果的值.
 ''''做法:每次的积取下次乘数的位数的2倍即可.

 ''''下一个乘数的位数
 iLen = 0

 ''''位数
 iSum = 0

 ''''积
 iVal = 1
 
 For i = 1 to x
  iLen = Len(i)

  ''''如果积超过乘数位数2倍,后面的记入汇总位数
  If Len(iVal) > iLen * 2 Then
   iSum = iSum + (Len(iVal) - iLen * 2)
   iVal = Left(iVal, iLen * 2)
  End If

  iVal = iVal * i
 Next
 
 GetFactorialLength = Len(iVal) + iSum
End function

''''下面开始各项测试

Dim t, x, y
t = Timer
x = String(1000, "9")
y = String(1000, "9")
''''y = String(200, "9")
''''Msgbox " String 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetAddResult(x, y)
''''Msgbox " GetAddResult: " & "GetAddResult(x, y)" & " 总用时: " & FormatNumber(Timer - t) & " 秒"

t = Timer
''''Call GetFactorialLength(1000)
Msgbox " GetFactorialLength(1000): " & GetFactorialLength(1000) & " 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetMulResult(x, y)
''''Msgbox " GetMulResult: " & GetMulResult(x, y) & " 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetMulResult(x, y)
''''Msgbox " GetMultResult: " & GetMultResult(x, y) & " 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetMulResult(x, y)
''''Msgbox " GetMulcResult: " & GetMulcResult(x, y) & " 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetAddResult(x, y)
''''Msgbox " GetAddResult 总用时: " & FormatNumber(Timer - t) & " 秒"

''''t = Timer
''''Call GetAddNResult(x, y)
''''Msgbox " GetAddNResult 总用时: " & FormatNumber(Timer - t) & " 秒"

''''x = 300
''''t = Timer
''''Call GetFactorialResult(x)
''''Msgbox " GetFactorialResult(" & x & ") = " & GetFactorialResult(x) & " 总用时: " & FormatNumber(Timer - t) & " 秒"
''''Msgbox " 共 " & Len(GetFactorialResult(x)) & " 位, 用时: " & FormatNumber(Timer - t) & " 秒"