Mensajes

[@Miseryk :]

HOLA!!!

Hice una pequeña prueba  con el maximo numero que soporta tu funcion y solo una llamada:


For the record:
Mi funcion recien empieza a tener un tiempo registrable luego de las 1000 llamadas (4ms) con 10000 llamadas llega a 47ms!

Y por supuesto...
Con el numero: 2305843008139952128

@Miseryk :
En vez de buscar el ultimo digito de esa manera buscalo asi, ya que tu funcion no acepta numeros mayor que long te va a servir:

Código (vb) [Seleccionar] Expandir

Lastnum = Numero mod 10

GRACIAS POR LEER!!!

Wow, interesante, no se me había ocurrido.

Código Completo:

Código (vb) [Seleccionar] Expandir


Option Explicit

'6
'28
'496
'8128
'33550336
'8589869056
'137438691328
'2305843008139952128

Public Function Misery_MOD(ByVal dividendo As Double, ByVal divisor As Double) As Double
'x / y = z
'y * z + R = x

'10 / 3 = 3,333
'10 / 3 = 3
Misery_MOD = dividendo - (divisor * Fix(dividendo / divisor))
End Function

Public Function IsPerfect(ByRef numero As Double) As Boolean
Dim loopc As Double
Dim calc As Double

Dim LastNum As Byte

Dim Max As Variant

Max = Fix(CDbl(numero) / CDbl(2))

'By 79137913
LastNum = numero Mod 10

If LastNum = 6 Or LastNum = 8 Then
    For loopc = Max To 1 Step -1
        'If numero Mod loopc = 0 Then
        If Misery_MOD(numero, loopc) = 0 Then
            calc = calc + loopc

            If calc > numero Then
                IsPerfect = False
                Exit Function
            End If
        End If
    Next loopc
End If

IsPerfect = (calc = numero)
End Function

Private Sub Form_Load()
'MsgBox 33550336 Mod 10
MsgBox IsPerfect(33550336)
End
End Sub


Modificación_2

HOLA!!!

Me parece o alguien tomo de base mi ejemplo funcion...

GRACIAS POR LEER!!!

jajaja sí, yo a las funciones las llamo asd o sdav jajaja

Mi código, con un par de deducciones que hice

Código (vb) [Seleccionar] Expandir


Public Function IsPerfect(ByRef numero As Double) As Boolean
Dim loopc As Double
Dim calc As Double

Dim NumStr As String
Dim LastNum As Byte

NumStr = CStr(numero)
LastNum = CByte(Mid(NumStr, Len(NumStr), 1))

Dim Max As Variant

Max = Fix(CDbl(numero) / CDbl(2))

If LastNum = 6 Or LastNum = 8 Then
   For loopc = Max To 1 Step -1
       'If numero Mod loopc = 0 Then
       If numero Mod loopc = 0 Then
           calc = calc + loopc

           If calc > numero Then
               IsPerfect = False
               Exit Function
           End If
       End If
   Next loopc
End If

IsPerfect = (calc = numero)
End Function


Modificación.

A lo que me refiero es que el usuario ingrese un número en un textbox y al hacer click en un button le informe si el número ingresado es perfecto o no.

Hola a todos, los invito a que programen a gusto si un número es perfecto o no.

Cómo funciona un número perfecto?

Un número es perfecto, cuando la SUMA de TODOS sus divisores, evadiendo a si mismo, es igual a ese número.

Ej:

6: 1+2+3 = 6
28: 1+2+4+7+14 = 28
etc

Lista:
6
28
496
8128
33550336
8589869056
137438691328
2305843008139952128

Valoro pensamientos/deducciones propias

Donde coloco el proceso y el valor? ._.
Cual VS usaste? el 2008? me han salido más de 40 errores he intento repararlos y a que te refieres con ¿DoEvents?

El handle del proceso lo meto acá:

Código (vb) [Seleccionar] Expandir


ProcessHandle = myHandle

Donde myHandle es una variable global que guardé el handle del proceso.

Lo hice en VB6, fijate de pasarlo a VB.NET, debe ser casi lo mismo.

http://msdn.microsoft.com/es-es/library/system.windows.forms.application.doevents.aspx

Con respecto al DoEvents:

http://support.microsoft.com/kb/118468/es

La función DoEvents entrega la ejecución de la macro, para que el sistema operativo pueda procesar otros eventos. La función DoEvents pasa el control de la aplicación para el sistema operativo. Algunos casos en los que puede resultar útil DoEvents incluyen los siguientes:
Hardware de E/S
Bucles de retardo
Llamadas al sistema operativo
DDE de interbloqueos
Este artículo también analiza los problemas potenciales asociados a la función DoEvents.

PD:

También prodrías hacer ésto:

Código (vb) [Seleccionar] Expandir


Public Function MiseryCalc2(ByVal PROCESSHANDLEparam As Long, ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant

...

ProcessHandle = PROCESSHANDLEparam

...


[módulo completo]

Es muy raro que yo comparta código de hacks/cheats, pero aquí tienes el módulo completo, son del 2010 o antes, así que no están optimizados:

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Type tOffset
   HexValue As Variant
   DecimValue As Long
   HexAddress As Variant
   DecimAddress As Long
End Type

Private NumOffsets As Long
Private Offsets() As tOffset
Private ActualOffsetVal As Variant


Private FAddressHex As Variant
Private FAddressDecim As Long
Private FValueHex As Variant
Private FValueDecim As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal Hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Public Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function WriteProcessMem Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function Hotkey Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer


Public L(1 To 8) As Long, lR(1 To 8) As Long, lS(1 To 8) As Long
Public v(1 To 8) As Variant
Public OffSet(1 To 8) As Variant

Public Pass As String

Public Function MiseryCalc(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:

Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String

'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub

ReDim Offsets(NumOffsets)

For i = 1 To NumOffsets
   ActualOffsetVal = TheOffsets(i - 1)
   'MsgBox ActualOffsetVal
   
   Offsets(i).HexValue = "&H" & ActualOffsetVal
   Offsets(i).DecimValue = "&H" & ActualOffsetVal
Next i

'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle

For i = 1 To NumOffsets
   If i = 1 Then
       ReadProcessMem ProcessHandle, CLng(Address), PointerValue, 4&, 0
   Else
       ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
   End If
   AddressDec = PointerValue + Offsets(i).DecimValue
   Offsets(i).DecimAddress = AddressDec
   Offsets(i).HexAddress = Hex(AddressDec)
Next i

FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0

FValueDecim = FValueDecim + 0

FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)

MiseryCalc = FAddressDecim

'CloseHandle ProcessHandle

'Exit Function
'Err:
'    Exit Function
End Function

Public Function MiseryCalc2(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:

Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String

'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub

ReDim Offsets(NumOffsets)

For i = 1 To NumOffsets
   ActualOffsetVal = TheOffsets(i - 1)
   'MsgBox ActualOffsetVal
   
   Offsets(i).HexValue = ActualOffsetVal
   Offsets(i).DecimValue = ActualOffsetVal
Next i

'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle

For i = 1 To NumOffsets
   If i = 1 Then
       ReadProcessMem ProcessHandle, Address, PointerValue, 4&, 0
   Else
       ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
   End If
   AddressDec = PointerValue + Offsets(i).DecimValue
   Offsets(i).DecimAddress = AddressDec
   Offsets(i).HexAddress = Hex(AddressDec)
Next i

FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0

FValueDecim = FValueDecim + 0

FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)

MiseryCalc2 = FAddressDecim

'CloseHandle ProcessHandle

'Exit Function
'Err:
'    Exit Function
End Function

Public Function CalcularBytes(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant

AddressHex = Hex(Address)

AddressHex = "0000000" & (AddressHex)

NAH = Right(AddressHex, 8)

'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7

For i = 1 To 8
   v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i

OffSet(1) = &H3
'OffSet(2) = &H6

'OffSet(3) = &HA
'OffSet(4) = &H2

OffSet(5) = &H7
OffSet(6) = &HB

OffSet(7) = &HF
OffSet(8) = &HF

For i = 1 To 8
   L(i) = L(i) + v(i) + OffSet(i)
   
   If L(i) > &HF Then
       lR(i) = (L(i) - &H10)
       
       
       If i <> 8 Then
           lS(i) = (L(i) - lR(i))
           L(i + 1) = L(i + 1) + (lS(i) / &H10)
       End If
       
       '//FIX
       L(i) = lR(i)
   End If
Next i

'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
               "85 - " & _
               Hex(L(2)) & Hex(L(1)) & " - " & _
               Hex(L(4)) & Hex(L(3)) & " - " & _
               Hex(L(6)) & Hex(L(5)) & " - " & _
               Hex(L(8)) & Hex(L(7))

'0F 85 FC 04 00 00
'0x0 4  F C  85 0F
'  4,3  2,1  85 0F
CalcularBytes = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function

Public Function CalcularBytes2(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant

AddressHex = Hex(Address)

AddressHex = "0000000" & (AddressHex)

NAH = Right(AddressHex, 8)

'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7

For i = 1 To 8
   v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i

OffSet(1) = &H3
'OffSet(2) = &H6

'OffSet(3) = &HA
'OffSet(4) = &H2

OffSet(5) = &H7
OffSet(6) = &HB

OffSet(7) = &HF
OffSet(8) = &HF

For i = 1 To 8
   L(i) = L(i) + v(i) + OffSet(i)
   
   If L(i) > &HF Then
       lR(i) = (L(i) - &H10)
       
       
       If i <> 8 Then
           lS(i) = (L(i) - lR(i))
           L(i + 1) = L(i + 1) + (lS(i) / &H10)
       End If
       
       '//FIX
       L(i) = lR(i)
   End If
Next i

'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
               "85 - " & _
               Hex(L(2)) & Hex(L(1)) & " - " & _
               Hex(L(4)) & Hex(L(3)) & " - " & _
               Hex(L(6)) & Hex(L(5)) & " - " & _
               Hex(L(8)) & Hex(L(7))

'0F 85 FC 04 00 00
'0x0 4  F C  85 0F
'  4,3  2,1  85 0F
CalcularBytes2 = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function

Public Function Encrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte

Dim TheAsc As Long
Dim TheAscX As Long

Dim PassEnc As Long
Dim TheXor As Long

FVal = vVal
PassEnc = PassEncrypt(Pass)

If EncKa = 1 Then
'    Form1.List1.AddItem "------------"
'    Form1.List1.AddItem "Val Encrypt:"
'    Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
'    Form1.List1.AddItem "------------"
'    Form1.List1.AddItem "Pass Encrypt:"
'    Form1.List1.AddItem "------------"
End If

For i = 1 To mlvl
   DoEvents
   vValCpy = FVal
   FVal = ""
   For X = 1 To Len(vValCpy)
       DoEvents
       TheAsc = Asc(Mid(vValCpy, X, 1)) + X 'Convierto a ASCII y le sumo la posicion
       TheAscX = TheAsc - 2 'Le resto 2
       TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
       FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
   Next X
   'Form1.List1.AddItem FVal
Next i
Encrypt = FVal
End Function

Public Function Decrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte

Dim TheAsc As Long
Dim TheAscX As Long

Dim PassEnc As Long
Dim TheXor As Long

FVal = vVal
PassEnc = PassEncrypt(Pass)

If EncKa = 1 Then
'    Form1.List1.AddItem "------------"
'    Form1.List1.AddItem "Val Encrypt:"
'    Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
'    Form1.List1.AddItem "------------"
'    Form1.List1.AddItem "Pass Encrypt:"
'    Form1.List1.AddItem "------------"
End If

For i = 1 To mlvl
   DoEvents
   vValCpy = FVal
   FVal = ""
   For X = 1 To Len(vValCpy)
       DoEvents
       'TheAsc = Asc(Mid(vValCpy, x, 1)) + x 'Convierto a ASCII y le sumo la posicion
       'TheAscX = TheAsc - 2 'Le resto 2
       'TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
       'FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
       
       TheAsc = Asc(Mid(vValCpy, X, 1))
       TheXor = TheAsc Xor PassEnc
       TheAscX = TheXor + 2
       TheAscX = TheAscX - X
       FVal = FVal & Chr(TheAscX)
   Next X
   'Form1.List1.AddItem FVal
Next i
Decrypt = FVal
End Function

Public Function PassEncrypt(ByVal Pass As Variant)
Dim vVal As Integer
Dim i As Byte

For i = 1 To Len(Pass)
   DoEvents
   vVal = vVal + (Asc(Mid(Pass, i, 1)) \ 2)
Next i
vVal = vVal \ 3
PassEncrypt = vVal
End Function

Function FileExist(ByVal File As String, ByVal FileType As VbFileAttribute) As Boolean
   FileExist = (Dir$(File, FileType) <> "")
End Function

USO:

Código (vb) [Seleccionar] Expandir


MiseryCalc2(ADDRESS, OFFSET1, OFFSET2, OFFSET3, ...)

Ej:
MiseryCalc2(BaseAddress + &HF3034, &H44, &H28)


Lo que hace el offset es que desde un address (usualmente static, con respecto a lo que buscas) genera otros address para llegar al address final, lo cual sería así:

Tienes el static address

luego tienes que leer el valor del [static addres + offset1]
A ese resultado -> ResultadoAddOff1

le tienes que sumar offset2 y leerlo

[ResultadoAddOff1 + offset2] -> ResultadoAddOff2

etc etc, así al final obtendrás el address final con su valor, lo cual podrías hacer un bucle de ReadProcessMemory, pasándole por array la cantidad de offset y obteniendo la longitud del mismo array para el bucle, yo hice uno hace mucho para un juego, pero no recuerdo donde lo tengo :S también había hecho un FindPattern xDDDD, todo es posible , espero que ésto te sea de ayuda.

Una pregunta, los resultados no deben tener números iguales entre sí? o cada secuencia por separada?