'
'Coded by Slasher-
'
Option Explicit
Option Base 1

Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long

Public Const CA1 = 1
Public Const CA2 = 2
Public Const SIGN_MAGN = 3

Public Const NUM_CMP_EQUAL = 1
Public Const NUM_CMP_MAJOR = 2
Public Const NUM_CMP_MINOR = 3

Function AddN(ByVal Number1 As String, ByVal Number2 As String) As String
          Dim btNum1() As Byte, btNum2() As Byte
          Dim btTotal() As Byte, lCnt&
          Dim iByte1%, iByte2%
          Dim iByteTotal%
          Dim lLen1&, lLen2&
          Dim iCarry%, i&, r&
          Dim bSigned As Boolean

  If NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then
    AddN = SubN(Number2, Mid$(Number1, 2))
    Exit Function
  ElseIf NumCmp(Number1, 0, NUM_CMP_MAJOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then
    AddN = SubN(Number1, Mid$(Number2, 2))
    Exit Function
  ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then
    bSigned = True
  End If
 
  If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2)
  If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2)
 
  lLen1 = EqualStr(Number1, Number2, "0")
  lLen2 = lLen1
  lCnt = lLen1 + lLen2
 
  ReDim btTotal(lLen1 + lLen2) As Byte
 
  btNum1 = StrToByteVal(Number1)
  btNum2 = StrToByteVal(Number2)

  For i = 1 To lLen1
    iByte1 = btNum1(lLen1 - i)
    iByte2 = btNum2(lLen2 - i)
   
    iByteTotal = iByte1 + iByte2 + iCarry
   
    If iByteTotal >= 10 Then
      btTotal(lCnt) = Val(Mid$(iByteTotal, 2, 1))
      iCarry = 1
    Else
      btTotal(lCnt) = iByteTotal
      iCarry = 0
    End If
   
    lCnt = lCnt - 1
  Next
 
  AddN = ByteToStrVal(btTotal())
 
End Function

Function SubN(ByVal Number1 As String, ByVal Number2 As String) As String
          Dim btNum1() As Byte, btNum2() As Byte
          Dim btTotal() As Byte, lCnt&
          Dim iByte1%, iByte2%
          Dim iByteTotal%, sTotal$
          Dim lLen1&, lLen2&
          Dim iNextByte%, i&
          Dim bSigned As Boolean
          Dim sTemp$, iTempByte$

  'Analiza los dos números antes de realizar la resta, para
  'reemplazar la operación en caso que sea necesario por los
  'signos, y así simplificar la función.
  '
  If NumCmp(Number1, Number2, NUM_CMP_EQUAL) And NumCmp(Number1, 0, NUM_CMP_MAJOR) Then
    'Num1>0 And Num2>0
    SubN = 0
    Exit Function
  ElseIf NumCmp(Number1, Number2, NUM_CMP_EQUAL) And NumCmp(Number1, 0, NUM_CMP_MINOR) Then
    'Num1=Num2 And Num2<0
    SubN = "-" & AddN(Mid$(Number1, 2), Mid$(Number2, 2))
   
    Exit Function
  ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MINOR) Then
    'Num1 < 0 And Num2 < 0
    '
    If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2)
    If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2)
   
    SubN = "-" & AddN(Number1, Number2)
    Exit Function

  ElseIf NumCmp(Number1, Number2, NUM_CMP_MINOR) Then
    If NumCmp(Number1, 0, NUM_CMP_MAJOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then
      'Num1 > 0 And Num2 > 0
      '
      sTemp = Number2
      Number2 = Number1
      Number1 = sTemp

      bSigned = True
    ElseIf NumCmp(Number1, 0, NUM_CMP_MINOR) And NumCmp(Number2, 0, NUM_CMP_MAJOR) Then
      'Num1 < 0 And Num2 > 0
      '
      bSigned = True
    End If
   
    If Left$(Number1, 1) Like "-" Then Number1 = Mid$(Number1, 2)
    If Left$(Number2, 1) Like "-" Then Number2 = Mid$(Number2, 2)
  End If
 
  lLen1 = EqualStr(Number1, Number2, "0") - 1
  lLen2 = lLen1
 
  btNum1 = StrToByteVal(Number1)
  btNum2 = StrToByteVal(Number2)
 
  ReDim btTotal(lLen1 + lLen2 + 1) As Byte
  lCnt = lLen1 + lLen2 + 1
 
  For i = 0 To lLen1
    iByte1 = btNum1(lLen1 - i)
    iByte2 = btNum2(lLen2 - i)
   
    If (iByte1 < iByte2) And i < lLen1 Then
      iByte1 = iByte1 + 10
     
      iNextByte = btNum1(lLen1 - i - 1)
      btNum1(lLen1 - i - 1) = iNextByte - 1
    End If
   
    iByteTotal = iByte1 - iByte2
   
    btTotal(lCnt) = iByteTotal
    lCnt = lCnt - 1
  Next
 
  If bSigned Then
    SubN = "-" & ByteToStrVal(btTotal)
  Else
    SubN = ByteToStrVal(btTotal)
  End If
End Function

Function ProN(ByVal Number1 As String, ByVal Number2 As String) As String
          Dim btNum1() As Byte, btNum2() As Byte
          Dim btTotal() As Byte, lCnt&
          Dim iByte1%, iByte2%
          Dim iByteTotal%, sTotal$
          Dim lLen1&, lLen2&
          Dim iCarry%, sSum$()
          Dim i&, ind&

  lLen1 = Len(Number1) - 1
  lLen2 = Len(Number2) - 1

  btNum1 = StrToByteVal(Number1)
  btNum2 = StrToByteVal(Number2)
 
  For i = 0 To lLen2
    iByte2 = btNum2(lLen2 - i)
   
    'If i > 9 Then Stop
   
    For ind = 0 To lLen1
      iByte1 = btNum1(lLen1 - ind)
     
      iByteTotal = (iByte1 * iByte2) + iCarry
     
      If iByteTotal >= 10 Then
        If ind < lLen1 Then
          sTotal = Right$(iByteTotal, 1) & sTotal
          iCarry = CInt(Left$(iByteTotal, Len(CStr(iByteTotal)) - 1))
        Else
          sTotal = iByteTotal & sTotal
        End If
      Else
        sTotal = iByteTotal & sTotal
        iCarry = 0
      End If
    Next

    sTotal = sTotal & String$(i, "0")
   
    ReDim Preserve sSum$(i + 1)
   
    sSum(i + 1) = sTotal
    sTotal = vbNullString
   
    iCarry = 0
  Next
 
  sTotal = sSum(1)
 
  For i = 2 To lLen2 + 1
    sTotal = AddN(sTotal, sSum(i))
  Next
 
  ProN = sTotal
End Function

Function DivN(ByVal Number1 As String, ByVal Number2 As String, Optional MaxDec = 30) As String
          Dim btNum1() As Byte, lLen1&
          Dim btTotal() As Byte, lCnt&
          Dim iByte1%
          Dim sCurDiv$, iCurFac%
          Dim iDecCnt%, i&, ind%

  If MaxDec < 0 Then MaxDec = 30
 
  Do While NumCmp(Number1, Number2, NUM_CMP_MINOR)
    'El dividendo debe ser mayor que el divisor.
    '
    Number1 = Number1 & "0"
   
    iDecCnt = iDecCnt + 1
  Loop
 
  lLen1 = Len(Number1) - 1

  btNum1 = StrToByteVal(Number1)
 
  lCnt = 1
  ReDim btTotal(lCnt) As Byte
 
  If iDecCnt > 0 Then
    ReDim Preserve btTotal(3) As Byte
   
    btTotal(1) = vbKey0 'Cero
    btTotal(2) = 44     'Coma
    lCnt = 3
   
    For i = 3 To iDecCnt
      btTotal(i) = vbKey0
     
      lCnt = lCnt + 1
     
      ReDim Preserve btTotal(lCnt) As Byte
    Next
  End If
 
  For i = 0 To lLen1
    iByte1 = btNum1(i)
   
    sCurDiv = sCurDiv & iByte1
   
    If NumCmp(sCurDiv, Number2, NUM_CMP_MAJOR) Or NumCmp(sCurDiv, Number2, NUM_CMP_EQUAL) Then
      Exit For
    End If
  Next
 
  Do
    iCurFac = 1
   
    Do While NumCmp(sCurDiv, ProN(Number2, iCurFac), NUM_CMP_MAJOR)
      iCurFac = iCurFac + 1
    Loop
   
    If CLng(sCurDiv) Mod CLng(Number2) = 0 Then
      btTotal(lCnt) = iCurFac + vbKey0
      sCurDiv = SubN(sCurDiv, ProN(Number2, iCurFac)) & Mid$(Number1, Len(sCurDiv) + 1)
    Else
      btTotal(lCnt) = (iCurFac - 1) + vbKey0
      sCurDiv = SubN(sCurDiv, ProN(Number2, (iCurFac - 1))) & Mid$(Number1, Len(sCurDiv) + 1)
    End If
   
    If NumCmp(sCurDiv, Number2, NUM_CMP_MINOR) Then
      If NumCmp(sCurDiv, "0", NUM_CMP_EQUAL) And Len(sCurDiv) > 1 Then
        lCnt = lCnt + 1
        ReDim Preserve btTotal(lCnt) As Byte
     
        btTotal(lCnt) = vbKey0
       
        Exit Do
      ElseIf NumCmp(sCurDiv, "0", NUM_CMP_EQUAL) Then
        Exit Do
      Else
        If iDecCnt = 0 Then
          lCnt = lCnt + 1
        ReDim Preserve btTotal(lCnt) As Byte
       
          btTotal(lCnt) = 44  'Coma
        End If
       
        iDecCnt = iDecCnt + 1

        sCurDiv = sCurDiv & "0"
       
        If iDecCnt > MaxDec Then Exit Do
      End If
     
    End If
   
    lCnt = lCnt + 1
    ReDim Preserve btTotal(lCnt) As Byte

  Loop
 
  DivN = ByteToStrVal(btTotal)

End Function

Function EqualStr(String1 As String, String2 As String, CharFill As String) As Long
          Dim lLen1&, lLen2&

  lLen1 = Len(String1)
  lLen2 = Len(String2)
 
  If CharFill Like vbNullString Then CharFill = vbNullChar
 
  If lLen1 < lLen2 Then
    String1 = String$(lLen2 - lLen1, CharFill) & String1
    lLen1 = lLen2
  ElseIf lLen2 < lLen1 Then
    String2 = String$(lLen1 - lLen2, CharFill) & String2
    lLen2 = lLen1
  End If

  EqualStr = lLen1
End Function

Function NumCmp(ByVal Number1 As String, ByVal Number2 As String, CmpType As Integer) As Integer
          Dim iByte1%, iByte2%
          Dim lLen1&, lLen2&
          Dim sTempNum$
          Dim i&

  'Realiza la comparación por signo.
  '
  iByte1 = Left$(Number1, 1) Like "-"
  iByte2 = Left$(Number2, 1) Like "-"
 
  Select Case CmpType
    Case NUM_CMP_EQUAL: If iByte1 <> iByte2 Then Exit Function
    Case NUM_CMP_MAJOR
      If (iByte1 <> 0) And (iByte2 = 0) Then
        NumCmp = 0
        Exit Function
      End If
    Case NUM_CMP_MINOR
      If (iByte1 <> 0) And (iByte2 = 0) Then
        NumCmp = 1
        Exit Function
      End If
  End Select
 
  If (iByte1 <> 0) And (iByte2 <> 0) Then
    Number1 = Mid$(Number1, 2)
    Number2 = Mid$(Number2, 2)
   
    sTempNum = Number2
    Number2 = Number1
    Number1 = sTempNum
  End If
 
  'Realiza la comprobación exaustiva-
  '
  lLen1 = EqualStr(Number1, Number2, "0")
  lLen2 = lLen1

  For i = 1 To lLen1
    iByte1 = Val(Mid$(Number1, i, 1))
    iByte2 = Val(Mid$(Number2, i, 1))
   
    Select Case CmpType
      Case NUM_CMP_EQUAL
        If iByte1 <> iByte2 Then
          NumCmp = 0
          Exit For
        Else
          NumCmp = 1
        End If
      Case NUM_CMP_MAJOR
        If iByte1 > iByte2 Then
          NumCmp = 1
          Exit For
        ElseIf iByte1 <> iByte2 Then Exit For
        End If
      Case NUM_CMP_MINOR
        If iByte1 < iByte2 Then
          NumCmp = 1
          Exit For
        ElseIf iByte1 <> iByte2 Then Exit For
        End If
    End Select
  Next
End Function

Function ByteToStrVal(NumSpec() As Byte) As String
  On Error Resume Next
 
        Dim i&, sData$

  sData = StrConv(NumSpec, vbUnicode)
 
  For i = LBound(NumSpec) To UBound(NumSpec)
    If NumSpec(i) <> 0 Then Exit For
  Next
 
  sData = Mid$(sData, i)
 
  For i = 0 To 9
    sData = Replace$(sData, Chr$(i), CStr(i))
  Next
 
  ByteToStrVal = sData
End Function

Function StrToByteVal(Number As String) As Byte()
  On Error Resume Next
 
          Dim i&, lLen&
          Dim btData() As Byte

  lLen = Len(Number)
 
  btData = StrConv(Number, vbFromUnicode)
 
  For i = 0 To lLen - 1
    btData(i) = btData(i) - vbKey0
  Next
 
  StrToByteVal = btData
End Function