elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: (TUTORIAL) Aprende a emular Sentinel Dongle By Yapis


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  [Aporte] Super Calculadora
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Aporte] Super Calculadora  (Leído 1,159 veces)
Flamer


Desconectado Desconectado

Mensajes: 1.036


crack, crack y mas crack...


Ver Perfil WWW
[Aporte] Super Calculadora
« en: 31 Diciembre 2016, 20:36 pm »

ahora vengo con otro código una calculadora en Vbscript de numeros grandes
la idea me surgio al ver esta pagina: http://www.elguille.info/NET/dotnet/operarConNumerosGrandes1.htm

pero en algunas operaciones observe que no daba el resultado correcto así que hice la mía mejor

Nota: si ponen muy grandes tardara en hacer la operación

Aquí el code

Código
  1. Option Explicit
  2.  
  3. Dim num1, num2, n, m, x, op, r,v
  4.  
  5. num2 = inputbox("Introduce El Primer Numero")'"123654789"
  6. num1 = inputbox("Introduce Segundo Numero")'"147852369"
  7.  
  8. ReDim n(Len(num1)), m(Len(num2))
  9.  
  10. For x = 1 To Len(num1)
  11.   n(x) = CInt(Mid(num1, x, 1))
  12. Next
  13.  
  14. For x = 1 To Len(num2)
  15.   m(x) = CInt(Mid(num2, x, 1))
  16. Next
  17.  
  18. op = InputBox("1- Sumar" & vbCrLf & "2- Restar" & vbCrLf & "3- Multiplicar" & vbCrLf & "4- Dividir")
  19.  
  20. Select Case op
  21.   Case "1"
  22.      r = sumar(n, m)
  23.   Case "2"
  24.      r = RestaroDividir(n, m, op)
  25.   Case "3"
  26.      v = mmi(num1,num2)
  27.      if v = "+" then
  28.     r = multiplicar(n,m)
  29.  elseif v = "-" then
  30.         r = multiplicar(m, n)
  31.      else
  32.     r = multiplicar(n, m)
  33.  end if      
  34.   Case "4"
  35.      r = RestaroDividir(n, m, op)
  36. End Select
  37. MsgBox r
  38. r = Replace(r, " ", "")
  39.  
  40. Function Dividir(n, m)
  41. On Error Resume Next
  42.   Dim num1, num2, pf, d, x, s, j, r, mk
  43.  
  44.   num1 = Replace(Join(n), " ", "")
  45.   num2 = Replace(Join(m), " ", "")
  46.  
  47.   pf = UBound(m)
  48.  
  49.   d = Mid(num1, 1, pf)
  50.  
  51.   While pf <= UBound(n)  'pf
  52.  
  53.      Select Case mmi(d, num2)
  54.         Case "+"
  55.            x = "0"
  56.            s = "0"
  57.            ReDim md(Len(d))
  58.            For j = 1 To Len(d)
  59.               md(j) = Mid(d, j, 1)
  60.            Next
  61.            While mmi(s, d) = "-"
  62.               x = CStr(CDbl(x) + 1)
  63.  
  64.               ReDim mx(Len(x))
  65.               ReDim ms(Len(num2))
  66.  
  67.               For j = 1 To Len(num2)
  68.                  ms(j) = Mid(num2, j, 1)
  69.               Next
  70.  
  71.               For j = 1 To Len(x)
  72.                  mx(j) = Mid(x, j, 1)
  73.               Next
  74.               s = Replace(multiplicar(ms, mx), " ", "")
  75.            Wend
  76.            If mmi(s, d) <> "1" Then
  77.                x = CStr(CDbl(x) - 1)
  78.            End If
  79.  
  80.               ReDim mx(Len(x))
  81.  
  82.               For j = 1 To Len(x)
  83.                  mx(j) = Mid(x, j, 1)
  84.               Next
  85.  
  86.               mk = Split(multiplicar(mx, m), " ")
  87.  
  88.               d = Replace(RestaroDividir(mk, md, "2"), " ", "")
  89.               While Mid(d, 1, 1) = "0"
  90.                  d = Mid(d, 2, Len(d))
  91.               Wend
  92.  
  93.               r = r & x
  94.  
  95.              pf = pf + 1
  96.              d = d & n(pf)
  97.  
  98.         Case "-"
  99.            r = r & "0"
  100.            pf = pf + 1
  101.            d = d & n(pf)
  102.         Case "1"
  103.            r = r & "1"
  104.            pf = pf + 1
  105.            d = n(pf)
  106.      End Select
  107.   Wend
  108.   While Mid(r, 1, 1) = "0"
  109.      r = Mid(r, 2, Len(r))
  110.   Wend
  111.   Dividir = "Caben:-" & r & "----Sobran:-" & d
  112. End Function
  113.  
  114. Function mmi(num1, num2)
  115.   Dim x, r
  116.  
  117.   While Mid(num1, 1, 1) = "0"
  118.      num1 = Mid(num1, 2, Len(num1))
  119.   Wend
  120.   While Mid(num2, 1, 1) = "0"
  121.      num2 = Mid(num2, 2, Len(num2))
  122.   Wend
  123.  
  124.   If Len(num1) > Len(num2) Then
  125.      r = "+"
  126.   ElseIf Len(num1) = Len(num2) Then
  127.      For x = 1 To Len(num1)
  128.         If CInt(Mid(num1, x, 1)) > CInt(Mid(num2, x, 1)) Then
  129.            r = "+"
  130.            Exit For
  131.         ElseIf CInt(Mid(num1, x, 1)) < CInt(Mid(num2, x, 1)) Then
  132.            r = "-"
  133.            Exit For
  134.         End If
  135.      Next
  136.   Else
  137.      r = "-"
  138.   End If
  139.  
  140.   If (x - 1) = Len(num1) Then
  141.      mmi = "1"
  142.   Else
  143.      mmi = r
  144.   End If
  145. End Function
  146. '-------------------------------------------------------------------------------------------------------------'
  147. Function RestaroDividir(n, m, op)
  148.   Dim lm, ln, r, x
  149.  
  150.   ln = UBound(n)
  151.   lm = UBound(m)
  152.  
  153.   If ln > lm Then
  154.      r = rd(n, m, op)
  155.   ElseIf ln < lm Then
  156.      r = rd(m, n, op)
  157.   Else
  158.      For x = 1 To UBound(n)
  159.         If n(x) > m(x) Then
  160.             r = rd(n, m, op)
  161.             Exit For
  162.         ElseIf n(x) < m(x) Then
  163.             r = rd(m, n, op)
  164.             Exit For
  165.         End If
  166.      Next
  167.   End If
  168.  
  169.   If r = "" Then
  170.      If op = "2" Then
  171.         RestaroDividir = "0"
  172.      Else
  173.         RestaroDividir = "1"
  174.      End If
  175.   Else
  176.      RestaroDividir = r
  177.   End If
  178. End Function
  179.  
  180. Function rd(n, m, op)
  181.   Dim ln, lm, r
  182.  
  183.   If op = "2" Then
  184.      ln = UBound(n)
  185.      lm = UBound(m)
  186.      r = Restar(ln, lm, n, m)
  187.   Else
  188.      r = Dividir(n, m)
  189.   End If
  190.   rd = r
  191. End Function
  192. '-------------------------------------------Funcion Multiplica---------------------------------------------------'
  193. Function multiplicar(n, m)
  194.   Dim x, y, r, c, s
  195.  
  196.   ReDim a(UBound(m))
  197.  
  198.   For x = UBound(a) To 1 Step -1
  199.      r = Join(n)
  200.      s = Split(r, " ")
  201.      For y = 2 To CInt(m(x))
  202.         r = sumar(n, s)
  203.         s = Split(r, " ")
  204.      Next
  205.      a(x) = r & c
  206.      c = c & " 0"
  207.   Next
  208.  
  209.   s = Split(a(1), " ")
  210.  
  211.   For x = 2 To UBound(a)
  212.      c = Split(a(x), " ")
  213.      r = sumar(s, c)
  214.      s = Split(r, " ")
  215.   Next
  216.   multiplicar = r
  217. End Function
  218. '---------------------------------------------Funcion Restar-------------------------------------------------------'
  219. Function Restar(ln, lm, n, m)
  220.   Dim x, r, a
  221.  
  222.   For x = ln To 1 Step -1
  223.      If lm > 0 Then
  224.         If CInt(n(x)) >= CInt(m(lm)) Then
  225.            r = CStr(n(x) - m(lm)) & " " & r
  226.         Else
  227.            r = CStr(n(x) - m(lm) + 10) & " " & r
  228.            For a = x - 1 To 1 Step -1
  229.               If n(a) = 0 Then
  230.                  n(a) = 9
  231.               Else
  232.                  n(a) = n(a) - 1
  233.                  Exit For
  234.               End If
  235.            Next
  236.         End If
  237.      Else
  238.         r = CStr(n(x)) & " " & r
  239.      End If
  240.      lm = lm - 1
  241.   Next
  242.   While Mid(r, 1, 1) = "0"
  243.         r = Mid(r, 2, Len(r))
  244.   Wend
  245.   Restar = Trim(r)
  246. End Function
  247. '-----------------------------------------Funcion Sumar--------------------------------------------------------------------'
  248. Function sumar(n, m)
  249.   Dim lm, ln, r
  250.  
  251.   ln = UBound(n)
  252.   lm = UBound(m)
  253.  
  254.   If ln >= lm Then
  255.      r = s(ln, lm, n, m)
  256.   Else
  257.      r = s(lm, ln, m, n)
  258.   End If
  259.   sumar = r
  260. End Function
  261.  
  262. Function s(ln, lm, n, m)
  263.   Dim a, b, x, r
  264.   a = 0
  265.   For x = ln To 1 Step -1
  266.      If lm > 0 Then
  267.         a = CInt(n(x)) + CInt(m(lm)) + a
  268.         If a > 9 Then
  269.            b = CStr(a)
  270.            r = Mid(b, 2, 1) & " " & r
  271.            a = CInt(Mid(b, 1, 1))
  272.         Else
  273.            r = CStr(a) & " " & r
  274.            a = 0
  275.         End If
  276.      Else
  277.         a = CInt(n(x)) + a
  278.         If a > 9 Then
  279.            b = CStr(a)
  280.            r = Mid(b, 2, 1) & " " & r
  281.            a = CInt(Mid(b, 1, 1))
  282.         Else
  283.            r = CStr(a) & " " & r
  284.            a = 0
  285.         End If
  286.      End If
  287.      lm = lm - 1
  288.   Next
  289.   If a > 0 Then
  290.      r = CStr(a) & " " & r
  291.   End If
  292.   s = " " & Trim(r)
  293. End Function
  294.  
  295.  


Saludos Flamer y me dicen si tiene errores para corregirlos


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Calculadora
Electrónica
Neobius 2 3,384 Último mensaje 11 Noviembre 2005, 17:24 pm
por Neobius
pequeño aporte(proxy),pero aporte al fin.:D
Programación Visual Basic
Tengu 0 1,569 Último mensaje 22 Julio 2007, 17:33 pm
por Tengu
[Aporte] Calculadora estilo windows en VB6 (Muy basica y noob)
Programación Visual Basic
Dracomega 4 2,003 Último mensaje 2 Junio 2010, 22:34 pm
por Dracomega
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines