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

 

 


Tema destacado: Arreglado, de nuevo, el registro del warzone (wargame) de EHN


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source-Actualizacion 6] Operaciones aritmeticas con Hex, Oct, Binario y Decimal
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source-Actualizacion 6] Operaciones aritmeticas con Hex, Oct, Binario y Decimal  (Leído 1,757 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
[Source-Actualizacion 6] Operaciones aritmeticas con Hex, Oct, Binario y Decimal
« en: 26 Septiembre 2010, 03:32 am »

Bueno esta clase la estuve haciendo para realizar un trabajo en mi Institución, (y para saltarme algunas cuestiones), se las dejo por si alguien la desea usar para lo que desees..

Si tiene errores favor de reportarmelos...

Se puede optener el resultado por o la:

 * Normal
 * por el Complemento de la Base... ( Sin Signo )

Falta optimizar algunas cosas... el CODIGO ESTA FUNCIONAL...

(Esto solo fue una chapusada...) Permiti las funciones tales como en la sintasys de las operaciones Aritmeticas...:

  • sin()  --> Seno
  • kos() --> Coseno
  • tan() --> Tangente
  • log() --> Logaritmo
  • sqr() --> Raiz
  • sgn() --> Devuelve un entero que indica el signo de un número

Cls_InfraExp.cls

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  5. '   // Autor:   Agradesimientos a Raul y Spyke (ExpReg)        //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo es requerido    //
  13. '   // el agradacimiento al autor.                             //
  14. '   /////////////////////////////////////////////////////////////
  15. '   /////////////////////////////////////////////////////////////
  16. '   /////////////////////////////////////////////////////////////
  17.  
  18. Option Explicit
  19. Option Base 0
  20. Option Compare Text
  21.  
  22. Public Enum Bases
  23.    base16 = &H10
  24.    base10 = &HA
  25.    base8 = &H8
  26.    base2 = &H2
  27. End Enum
  28.  
  29. Public Enum ReturnType
  30.    SinSigno = &H0
  31.    ConSigno
  32. End Enum
  33.  
  34. Private Const cError                As String = "<-Error->"
  35. Private Const Str_Artimetica        As String = "\/*-+^()"
  36. Private Const Str_IndexBases        As String = "0123456789abcdef"
  37. Private Const Str_Funciones         As String = "sinkostanlogsqrsgn"
  38. Private Obj_RunExpr                 As Object
  39. Private Obj_ExpRegular              As Object
  40.  
  41. Public Property Get StrError() As String: StrError = cError: End Property
  42.  
  43. Private Function ParseExpresion(ByRef InExpresion As String, ByRef InBaseNow As Bases) As Boolean
  44. Dim lng_Pos(1)          As Long
  45. Dim lng_index           As Long
  46. Dim Str_ToValidate      As String
  47.  
  48.    Str_ToValidate$ = Replace$(InExpresion, " ", "", 1, , vbTextCompare)
  49.    For lng_index& = 1 To Len(Str_Funciones) Step 3
  50.        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Funciones, lng_index&, 3), "", 1, , vbTextCompare)
  51.    Next
  52.    For lng_index& = 1 To Len(Str_Artimetica)
  53.        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Artimetica, lng_index&, 1), "", 1, , vbTextCompare)
  54.    Next
  55.    If Not VerificFormat(Str_ToValidate$, InBaseNow) Then
  56.        InExpresion = cError
  57.        Exit Function
  58.    End If
  59.  
  60.    InExpresion = " " & Replace$(InExpresion, " ", "", 1, , vbTextCompare) & " "
  61.    For lng_index = 1 To Len(Str_Artimetica$)
  62.        InExpresion = Replace$(InExpresion, Mid$(Str_Artimetica$, lng_index, 1), " " & Mid$(Str_Artimetica$, lng_index, 1) & " ", 1, , vbTextCompare)
  63.    Next
  64.    InExpresion = Replace$(InExpresion, "  ", "", 1, , vbTextCompare)
  65.  
  66.    If Not InBaseNow = base10 Then
  67.        For lng_index = 1 To Len(Str_IndexBases)
  68.            lng_Pos&(0) = InStr(lng_Pos&(1) + 1, InExpresion, " " & Mid$(Str_IndexBases$, lng_index, 1), vbTextCompare)
  69.            If lng_Pos&(0) > 0 Then
  70.                lng_Pos&(1) = InStr(lng_Pos&(0) + 1, InExpresion, " ", vbTextCompare)
  71.                If lng_Pos&(1) - lng_Pos&(0) + 1 > 0 Then
  72.                    InExpresion = Mid$(InExpresion, 1, lng_Pos&(0) - 1) & "(ConvSystem(" & Chr(34) & Mid$(InExpresion, lng_Pos&(0) + 1, lng_Pos&(1) - lng_Pos&(0) - 1) & Chr(34) & "," & InBaseNow & ",10)+0)" & Mid$(InExpresion, lng_Pos&(1))
  73.                    lng_index = lng_index - 1
  74.                End If
  75.                lng_Pos&(1) = 0
  76.            End If
  77.        Next
  78.    End If
  79.  
  80.    ParseExpresion = True
  81.  
  82. End Function
  83.  
  84.  
  85. Public Function ConvSystem(ByVal vDataIn$, ByVal inFrom As Bases, ByVal inDest As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As Variant
  86. Dim isNegative          As Boolean
  87.    If Not (inFrom = inDest And inFrom = base10) Then
  88.        '   //  Puedo usar unas cuantas Obviaciones Directas.. aun que mejor usare la conversion larga...
  89.        If inFrom = base10 Then
  90.            ConvSystem = Dec2Base(Val(vDataIn$), inDest, Opciones)
  91.        Else
  92.            isNegative = Val(vDataIn$) < 0
  93.            If Not isNegative Then
  94.                ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom), inDest, Opciones)
  95.            Else
  96.                If inFrom = base16 Then
  97.                    ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom) * -1, inDest, Opciones)
  98.                Else
  99.                    ConvSystem = Dec2Base(Base2Dec(Val(vDataIn$), inFrom) * -1, inDest, Opciones)
  100.                End If
  101.            End If
  102.        End If
  103.    Else
  104.        ConvSystem = vDataIn$
  105.    End If
  106. End Function
  107.  
  108. Public Function GetAritmeticExpresion(ByVal Expresion As String, ByRef InBase As Bases, Optional ByVal Opciones As ReturnType = ConSigno) As String
  109.    If Obj_RunExpr Is Nothing Then Exit Function
  110.    If ParseExpresion(Expresion, InBase) Then
  111.        Expresion = Replace$(Expresion, "kos", "cos", 1, , vbTextCompare)
  112.        With Obj_RunExpr
  113.            If Not (InBase = base10 And Opciones = SinSigno) Then
  114.                If InBase = base10 Then
  115.                    GetAritmeticExpresion = Dec2Base(.Eval(Expresion$), InBase, Opciones)
  116.                Else
  117.                    GetAritmeticExpresion = Dec2Base(CLng(.Eval(Expresion$)), InBase, Opciones)
  118.                End If
  119.            Else
  120.                If InBase = base10 Then
  121.                    GetAritmeticExpresion = .Eval(Expresion)
  122.                Else
  123.                    GetAritmeticExpresion = CLng(.Eval(Expresion))
  124.                End If
  125.            End If
  126.        End With
  127.    Else
  128.        GetAritmeticExpresion = cError
  129.    End If
  130. End Function
  131.  
  132. Public Function GetMaxBase(ByRef ThisBase As Bases) As String
  133.    Select Case ThisBase
  134.        Case base16:    GetMaxBase = "F"
  135.        Case Else:      GetMaxBase = CStr(ThisBase - 1)
  136.    End Select
  137. End Function
  138.  
  139. Public Function Dec2Base(ByVal inval As Double, ByRef InBase As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As String
  140. Dim isNegative          As Boolean
  141. Dim Lng_LeninVal          As Long
  142.    isNegative = inval < 0
  143.    Dec2Base = inval
  144.    If isNegative Then
  145.        Dec2Base = (inval * -1)
  146.        If Not InBase = base10 Then Dec2Base = pDec2Base(Val(Dec2Base), InBase)
  147.        If Opciones = SinSigno Then
  148.            Lng_LeninVal = Len(Dec2Base)
  149.            Dec2Base = pDec2Base(Base2Dec(String(Lng_LeninVal, GetMaxBase(InBase)), InBase) - (inval * -1) + 1, InBase)
  150.            Dec2Base = String$(10, GetMaxBase(InBase)) & String$(Lng_LeninVal - Len(Dec2Base), "0") & Dec2Base
  151.            If InBase = base8 Then Dec2Base = "1" & Dec2Base
  152.        End If
  153.    Else
  154.        If Not InBase = base10 Then Dec2Base = pDec2Base(inval, InBase)
  155.    End If
  156. End Function
  157.  
  158. Private Function pDec2Base(ByRef inval As Double, ByRef InBase As Bases) As String
  159. Dim lng_Aux#(1)
  160.    lng_Aux#(0) = (inval# \ InBase)
  161.    lng_Aux#(1) = (inval# Mod InBase)
  162.    If inval < InBase Then
  163.        If InBase = base16 Then
  164.            pDec2Base = Hex(lng_Aux#(1))
  165.        Else
  166.            pDec2Base = lng_Aux#(1)
  167.        End If
  168.    Else
  169.        If InBase = base16 Then
  170.            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & Hex(lng_Aux#(1))
  171.        Else
  172.            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & lng_Aux#(1)
  173.        End If
  174.    End If
  175. End Function
  176.  
  177. '   //  Hex no afecta a bases inferiores por ello lo dejo.
  178. Private Function Base2Dec(ByRef inval As String, ByRef InBase As Bases) As Double
  179. Dim lng_lenStr&
  180. Dim lng_Pointer&
  181. Dim lng_Potencia&
  182.    lng_lenStr& = Len(inval)
  183.    lng_Potencia& = 0
  184.    For lng_Pointer& = lng_lenStr& To InStr(1, inval, "-") + 1 Step -1
  185.       Base2Dec = Base2Dec + CLng("&H" & Mid$(inval, lng_Pointer, 1)) * InBase ^ lng_Potencia&
  186.        lng_Potencia& = lng_Potencia& + 1
  187.    Next lng_Pointer&
  188. End Function
  189.  
  190. Public Function VerificFormat(ByVal InStrData As String, InBase As Bases) As Boolean
  191.    If Obj_ExpRegular Is Nothing Then Exit Function
  192.    With Obj_ExpRegular
  193.        Select Case InBase
  194.            Case base16:    .Pattern = "^[0-9a-fA-F]+$"
  195.            Case base10:    .Pattern = "^[0-9]+$"
  196.            Case base8:     .Pattern = "^[0-7]+$"
  197.            Case base2:     .Pattern = "^[0-1]+$"
  198.        End Select
  199.        VerificFormat = .test(InStrData)
  200.    End With
  201. End Function
  202.  
  203. Private Sub Class_Initialize()
  204.    Set Obj_RunExpr = CreateObject("ScriptControl")
  205.    Set Obj_ExpRegular = CreateObject("VBScript.RegExp")
  206.    With Obj_RunExpr
  207.        .Language = "vbscript"
  208.        Call .AddObject("InfraClass", Me, True)
  209.    End With
  210. End Sub
  211.  
  212. Private Sub Class_Terminate()
  213.    Set Obj_RunExpr = Nothing
  214.    Set Obj_ExpRegular = Nothing
  215. End Sub
  216.  
  217.  

Ejemplo en Uso:

Código
  1.  
  2. Private Sub Form_Load()
  3. Dim c As New Cls_InfraExp
  4. Const Operacion As String = "11-1111*(111/111*111)"
  5.    With c
  6.        MsgBox "Operacion Hexadecimal" & vbCrLf & _
  7.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base16, ConSigno) & vbCrLf & _
  8.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base16, SinSigno)
  9.        MsgBox "Operacion Decimal" & vbCrLf & _
  10.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base10, ConSigno) & vbCrLf & _
  11.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base10, SinSigno)
  12.        MsgBox "Operacion Octal" & vbCrLf & _
  13.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base8, ConSigno) & vbCrLf & _
  14.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base8, SinSigno)
  15.        MsgBox "Operacion Binaria" & vbCrLf & _
  16.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base2, ConSigno) & vbCrLf & _
  17.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base2, SinSigno)
  18.    End With
  19. End Sub
  20.  
  21.  

Dulce Infierno Lunar!¡.


« Última modificación: 27 Septiembre 2010, 06:03 am por BlackZeroX » En línea

The Dark Shadow is my passion.
VanHan

Desconectado Desconectado

Mensajes: 41


.:: [ vHn ] ::.


Ver Perfil WWW
Re: [Source-Actualizacion 3] Operaciones aritmeticas con Hex, Oct, Binario y Decimal
« Respuesta #1 en: 26 Septiembre 2010, 09:57 am »

Muy Bueno BlackZeroX!!!!

Salu2
[vHn]


En línea

.:: I'm GeeK ::.
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Pasar decimal a binario
.NET (C#, VB.NET, ASP)
Cuasar 7 6,196 Último mensaje 8 Febrero 2011, 04:00 am
por Cuasar
Operaciones aritmeticas de una ristra con recursividad
Java
Javator 4 2,804 Último mensaje 25 Marzo 2014, 23:22 pm
por 1mpuls0
Operaciones aritmeticas variables bash
Scripting
rusogumo 2 2,676 Último mensaje 12 Marzo 2015, 12:17 pm
por Eleкtro
[SOURCE] + Binario + Manual .::CrypterKsv::. Para Vbscript [Cifra tus *.Vbs FUD ] {Mientras Dura} « 1 2 »
Análisis y Diseño de Malware
.:: KsV ::. 12 6,522 Último mensaje 23 Diciembre 2015, 06:02 am
por .:: KsV ::.
Anubis Killer PE v0.1 Binario+Source
Análisis y Diseño de Malware
fary 0 1,737 Último mensaje 31 Diciembre 2015, 12:18 pm
por fary
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines