Source Evolution Offset Tester

strup

por strup Usa camisa de fuerza

Bueno aqui os dejo el source de la tool que cree por si alguien quiere modificarla para añadirle algo mas siempre y cuando se mantengan los creditos del autor xD
codifo fuente del modulo, .bas:

Mostrar/Ocultar

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Nombre: Evolution Offset Tester                      '
'Autor: Strup                                         '
'Objetivo: Testear grandes cantidades de offsets      '
'Fecha: 02/02/2014 03:17                              '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const HWND_TOPMOST As Integer = -1
Private Const SWP_NOSIZE As Integer = 1
Private Const SWP_NOMOVE As Integer = 2
Private Const WM_CLOSE As Integer = &H10
Private Const SW_HIDE As Integer = 0

Private Cuenta As Long, Contador As Long, Sustraccion As Long, Adicion As Long, i As Long, x As Long, Medida As Long, Ancho As Long, Tops As Long, Lefts As Long, Pid As Long
Private Exe() As String, Titulo As String, Directorio As String, RutaOffsets As String, Offsets() As String, Skin As String
Private Recurso() As Byte, Canal As Byte
Private Clear As Variant
Public Flag As Boolean

Public Sub Testear()
If Form1.Testeo.Caption = CStr(Cuenta) Then
Call Ejecutar
Else
Form1.LV.Checkboxes = False: Flag = True: Form1.Testeo.Caption = "Pausar": Form1.Suma.Enabled = False: Form1.Resta.Enabled = False: Form1.Limpieza.Enabled = False
On Error GoTo RE
Medida = UBound(Offsets)
Form1.PB.Max = Medida
For x = Form1.PB.Value + 1 To Medida
Form1.PB.Value = x
Call Progreso(CStr(Fix(x * 100 / Form1.PB.Max)) & "%")
Form1.Text1.Text = "Testeados: " + CStr(Form1.PB.Value) + " De " + CStr(Medida)
On Error Resume Next
Pid = Shell(Directorio + "\" + Offsets(x), vbNormalFocus)
Resume Next
Call ShellExecute(0, "open", "tskill.exe", "dwwin", vbNullString, SW_HIDE)
Sleep (CLng(CStr(Form1.Text2.Text) & "000"))
Call SendMessage(FindWindow(vbNullString, Directorio + "\" + Offsets(x)), WM_CLOSE, 0&, 0&)
Call SendMessage(FindWindow("#32770", vbNullString), WM_CLOSE, 0&, 0&)
Call TerminateProcess(OpenProcess(&H1, False, Pid), 0)
DoEvents
Next x
End If
If Form1.PB.Value >= Medida And x > 1 Then
Flag = False: Form1.Testeo.Caption = "Terminado": Form1.Suma.Enabled = True: Form1.Resta.Enabled = True: Form1.Limpieza.Enabled = True
ElseIf x > 1 Then
Flag = False: Form1.Testeo.Caption = "Continuar": Form1.Suma.Enabled = True: Form1.Resta.Enabled = True: Form1.Limpieza.Enabled = True
End If
RE:
If Err.Number = 9 Then
Form1.LV.ListItems.Clear
Form1.LV.ColumnHeaders.Clear
OLEDragAndDrop (Directorio)
Call Testear
End If
End Sub

Public Sub FormLoad()
Call Aplicar_Skin
Call SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
Titulo = Form1.Caption
Form1.Caption = "Arrastra Un Directorio"
Lefts = Form1.Left: Tops = Form1.Top: Ancho = Form1.Width
End Sub

Public Sub OLEDragAndDrop(ByVal Ruta As String)
Directorio = Ruta
If (Ruta <> vbNullString) Then
On Error Resume Next
RutaOffsets = Dir(Ruta & "\*.exe", vbNormal)
Resume Next
If (RutaOffsets <> vbNullString) Then
Call Modificar
i = 1
End If
While (RutaOffsets <> vbNullString)
ReDim Preserve Offsets(i) As String
Offsets(i) = Form1.LV.ListItems.Add(, , RutaOffsets)
RutaOffsets = Dir
i = i + 1
DoEvents
Wend
If i > 1 Then
Form1.Suma.Enabled = True: Form1.Resta.Enabled = True
Form1.Testeo.Caption = "Testear"
Form1.Limpieza.Enabled = True
Form1.Testeo.Enabled = True
Call Form1.LV.ColumnHeaders.Add(, , "Listado", 4520)
Form1.LV.Checkboxes = True
End If
End If
End Sub

Public Sub Ejecutar()
Dim h As Long
Erase Offsets()
Form1.LV.ListItems.Clear
Contador = 1
For h = LBound(Exe) + 1 To UBound(Exe)
If Exe(h) <> vbNullString Then
ReDim Preserve Offsets(Contador) As String
Offsets(Contador) = Exe(h)
Call Form1.LV.ListItems.Add(, , Offsets(Contador))
Contador = Contador + 1
End If
DoEvents
Next h
Form1.Testeo.Caption = vbNullString
Call Testear
End Sub

Public Sub Abrir(item)
On Error GoTo IR
Pid = Shell(Directorio + "\" + item, vbNormalFocus)
IR:
If Err.Number = 5 Then
Call MsgBox("El Offset " + item + " No Es Funcional", vbInformation, "Aviso")
End If
Call ShellExecute(0, "open", "tskill.exe", "dwwin", vbNullString, SW_HIDE)
Sleep (CLng(CStr(Form1.Text2.Text) & "000"))
Call SendMessage(FindWindow(vbNullString, Directorio + "\" + item), WM_CLOSE, 0&, 0&)
Call SendMessage(FindWindow("#32770", vbNullString), WM_CLOSE, 0&, 0&)
Call TerminateProcess(OpenProcess(&H1, False, Pid), 0)
End Sub

Public Sub Añadir(item)
Adicion = Adicion + 1
ReDim Preserve Exe(Adicion) As String
Exe(Adicion) = item
Cuenta = Cuenta + 1
Form1.Testeo.Caption = Cuenta
End Sub

Public Sub Quitar(item)
For Sustraccion = 1 To UBound(Exe)
If Exe(Sustraccion) = item Then
Exe(Sustraccion) = vbNullString
End If
Next Sustraccion
Cuenta = Cuenta - 1
Form1.Testeo.Caption = Cuenta
End Sub

Public Sub Sumar()
Form1.Text2.Text = Form1.Text2.Text + 1
End Sub

Public Sub Restar()
If Form1.Text2.Text < 1 Then
Form1.Text2.Text = 0
Else
Form1.Text2.Text = Form1.Text2.Text - 1
End If
End Sub

Public Sub Limpiar()
Form1.Testeo.Caption = vbNullString
Form1.Porcentaje = Clear: Form1.Text1.Text = Clear: Form1.LV.ListItems.Clear: Form1.PB = Clear
Form1.Testeo.Enabled = False: Form1.Text1.Visible = False: Form1.Limpieza.Enabled = False: Form1.Suma.Enabled = False: Form1.Resta.Enabled = False
RutaOffsets = vbNullString: Directorio = vbNullString
Form1.OLEDropMode = 1
Form1.LV.ColumnHeaders.Clear
Form1.LV.Checkboxes = True
Erase Offsets()
Erase Exe()
x = 0: i = 0: Adicion = 0: Sustraccion = 0: Contador = 0: Cuenta = 0
End Sub

Public Sub Pausar()
x = Medida
End Sub

Private Sub Modificar()
With Form1
.Caption = Titulo
.Height = 6720
.Width = Ancho
.Left = Lefts
.Top = Tops
.OLEDropMode = 0
End With
With Form1.LV
.Height = 4215
.Top = 480
End With
With Form1.Text1
.Visible = True
.Text = Directorio & "\"
End With
Call Form1.Creditos.Move(4080, 5280, 615, 375)
End Sub

Private Sub Progreso(ByVal Porciento As String)
Form1.Porcentaje.Caption = Porciento
If (Len(Porciento) = 4) Then
Form1.Porcentaje.Left = 2265
ElseIf (Len(Porciento) = 3) Then
Form1.Porcentaje.Left = 2305
End If
End Sub

Private Sub Aplicar_Skin()
Canal = FreeFile
Recurso = LoadResData(101, "CUSTOM")
Skin = App.Path + "\" + "M3.msstyles"
Open Skin For Binary As #Canal
On Error Resume Next
Put #Canal, , Recurso
Resume Next
Close #Canal
Call Form1.SF.LoadSkin(Skin, vbNullString)
Form1.SF.ApplyWindow (Form1.hwnd)
End Sub

Codigo Fuente en el form:

Mostrar/Ocultar

Private Sub LV_ItemCheck(ByVal item As MSComctlLib.ListItem)
If item.Checked = False Then
Quitar (item)
Else
Añadir (item)
End If
End Sub

Private Sub LV_ItemClick(ByVal item As MSComctlLib.ListItem)
Abrir (item)
End Sub

Private Sub Testeo_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With Testeo
Select Case .Caption
Case "Testear"
.ToolTipText = "Empezar A Testear Offsets"
Case "Pausar"
.ToolTipText = "Pausar Proceso De Ejecuciones"
Case "Continuar"
.ToolTipText = "Continuar Proceso De Ejecuciones"
Case "Terminado"
.ToolTipText = "Proceso De Ejecuciones Terminado"
Case Else
.ToolTipText = "Ejecutar Seleccionados"
End Select
End With
End Sub

Private Sub Suma_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Suma.ToolTipText = "Sumar Segundos"
End Sub

Private Sub Resta_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Resta.ToolTipText = "Restar Segundos"
End Sub

Private Sub Creditos_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Creditos.ToolTipText = "Creditos"
End Sub

Private Sub Limpieza_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Limpieza.ToolTipText = "Limpiar Campos y Variables"
End Sub

Private Sub Testeo_Click()
If Flag = True Then
Call Pausar
Else
Call Testear
End If
End Sub

Private Sub Suma_Click()
Call Sumar
End Sub

Private Sub Resta_Click()
Call Restar
End Sub

Private Sub Limpieza_Click()
Call Limpiar
End Sub

Private Sub Creditos_Click()
Dialog.Show
End Sub

Private Sub Form_Load()
Call FormLoad
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Call OLEDragAndDrop(Data.Files(1))
End Sub

Tiene un form dialog que es el de los creditos por eso dice Dialog.show, para que muestre los creditos, Bueno caballeros eso es todo, espero os gusten y un saludo

Abolición para el torneo del toro de la vega. Death to the murderers of bulls.

strup

por strup Usa camisa de fuerza

Actualice el codigo lo optimice y lo comente para que sea mas entendible
codigo Fuente del modulo bas

Mostrar/Ocultar

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Nombre: Evolution Offset Tester                      '
'Autor: Strup                                         '
'Objetivo: Testear grandes cantidades de offsets      '
'Fecha: 06/02/2014 01:34                              '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'declaramos la apis suficientes para que el programa funcione
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Y las constantes suficientes para usarlas con las apis que requieran una constante como parametro la cual determinaria  de una manera resumida que es lo que queremos hacer
Public Const HWND_TOPMOST As Integer = -1
Public Const SWP_NOSIZE As Integer = 1
Public Const SWP_NOMOVE As Integer = 2
Private Const WM_CLOSE As Integer = &H10
Private Const SW_HIDE As Integer = 0
'Declaramos las variables suficientes si es verdad que podria haber usado las integer que gastan menos memoria pero nunca se sabe cuantos offsets se van a testear a si que uso long que aunque ocupe mas que integer tiene mas capacidad xDD
Private Cuenta As Long, Contador As Long, Sustraccion As Long, Adicion As Long, i As Long, x As Long, Medida As Long, Ancho As Long, Tops As Long, Lefts As Long, Pid As Long
Private Exe() As String, Titulo As String, Directorio As String, RutaOffsets As String, Offsets() As String, Skin As String
Private Recurso() As Byte, Canal As Byte
Private Clear As Variant
Public Flag As Boolean

Public Sub Testear()
If Form1.Testeo.Caption = CStr(Cuenta) Then'Si hemos tildado algun ejecutable en la variable cuenta habra un valor y en el caption del button testeo estara el mismo numero que cuenta y entonces llama a ejecutar
Call Ejecutar
Else'Si no ejecutara este bloque de codigo
Form1.LV.Checkboxes = False: Flag = True: Form1.Testeo.Caption = "Pausar": Form1.Frame.Enabled = False: Form1.Limpieza.Enabled = False 'si destildamos todos daria error fuera de rango erro Nº9 a si que saltamos al label RE: para que no se cuelgue el programa y ejecute todos los offsets de la lista(por logica)
On Error GoTo RE
Medida = UBound(Offsets)
Form1.PB.Max = Medida
For x = Form1.PB.Value + 1 To Medida'esto asignara el valor del prgressbar y sumara uno para ir a por el siguiente(por si pausamos xDD)
Form1.PB.Value = x
Call Progreso(CStr(Fix(x * 100 / Form1.PB.Max)) & "%")'Llamamos al procedimiento progreso y le pasamos el porcentaje solapado a string como argumento
Form1.Text1.Text = "Testeados: " + CStr(Form1.PB.Value) + " De " + CStr(Medida)'Indicamos la cantidad de testeados
On Error Resume Next'si un ejecutable esta roto daria error y se pararia elprograma, con este manejo de excepcion el programa seguiria e iriamos a por el proximo ejecutable
Pid = Shell(Directorio + "\" + Offsets(x), vbNormalFocus)'Ejecutamos la offset concatenando su ruta y directorio àra que shell lo encuentre y alamecene el pid del offset ejecutado
Resume Next
Call ShellExecute(0, "open", "tskill.exe", "dwwin", vbNullString, SW_HIDE)
Sleep (Form1.Text2.Text)'pausa de tantos milisegundos o segundos que indiquemos
Call SendMessage(FindWindow(vbNullString, Directorio + "\" + Offsets(x)), WM_CLOSE, 0&, 0&)'si salta error en una aplicacion con la ruta como caption lo cerramos
Call SendMessage(FindWindow("#32770", vbNullString), WM_CLOSE, 0&, 0&)'Lo mismo que la de arriba pero para los que salgan con el caption error de aplicacion a si que solo indicamos el nombre de la clase para ser independiente de los idiomas
Call TerminateProcess(OpenProcess(&H1, False, Pid), 0)'openprocess retorna el handle de un proceso a partir del pid retornado por shell y la constante &H1 le da permisos para que sea cerrado por la api terminateprocess
DoEvents' doevents hara que el programa no se cuelgue por el bucle generado y que podamos visualizar bien la carga del progressbar
Next x
End If
If Form1.PB.Value >= Medida And x > 1 Then'Solo si el progressbar a terminado se mostrara en el caption la cadena "terminado" como que realmente la aplicacion ya a terminado su tarea de manera literal
Flag = False: Form1.Testeo.Caption = "Terminado": Form1.Frame.Enabled = True: Form1.Limpieza.Enabled = True
ElseIf x > 1 Then'en caso contrario y si x es mayor de 1 pausaremos por lo tanto esto se cumplira cuando pausemos
Flag = False: Form1.Testeo.Caption = "Continuar": Form1.Frame.Enabled = True: Form1.Limpieza.Enabled = True
End If
RE:'Hacemos salto, bien como dije arriba si hay un error Nº 9 para refrescar la lista y llamarse el procedimiento a si mismo
If Err.Number = 9 Then
Form1.LV.ListItems.Clear
Form1.LV.ColumnHeaders.Clear
OLEDragAndDrop (Directorio)
Call Testear
End If
End Sub

Public Sub FormLoad()
Call Aplicar_Skin'Aplicamos la Skin llamando al procedimiento que se encarga de ello
Call SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)'Con esta Api indicamos que el form quede siempre visible,(Para un mejor draganddrop xDD)
Titulo = Form1.Caption
Form1.Caption = "Arrastra Un Directorio"
Lefts = Form1.Left: Tops = Form1.Top: Ancho = Form1.Width'Almacenamos en variables las coordenadas del Form1
End Sub

Public Sub OLEDragAndDrop(ByVal Ruta As String)
Directorio = Ruta'Directorio ahora almacena la ruta completa donde estan los offsets, a si la usaremos durante el programa
If (Ruta <> vbNullString) Then
On Error Resume Next'hacemos manejo de excepcion por si no encuentran exe's, a si no se colgara el programa
RutaOffsets = Dir(Ruta & "\*.exe", vbNormal)
Resume Next
If (RutaOffsets <> vbNullString) Then
Call Modificar'Si Encuentra una cadena minimo, el form se preparara para el testing
i = 1
End If
While (RutaOffsets <> vbNullString)
ReDim Preserve Offsets(i) As String'Redimensionamos con preserve para que no se pierdan los valores del array
Offsets(i) = Form1.LV.ListItems.Add(, , RutaOffsets)
RutaOffsets = Dir'Avanzamos al proximo ejecutable
i = i + 1
DoEvents
Wend
If i > 1 Then'si es mayor de 1 significa que encontro al menos un .exe entonces habilitamos lo necesario para empezar el testing
Form1.Frame.Enabled = True
Form1.Testeo.Caption = "Testear"
Form1.Limpieza.Enabled = True
Form1.Testeo.Enabled = True
Call Form1.LV.ColumnHeaders.Add(, , "Listado", 4520)
Form1.LV.Checkboxes = True
End If
End If
End Sub

Public Sub Ejecutar()
Dim h As Long
Erase Offsets()'Borramos el contenido del array
Form1.Testeo.Enabled = False: Form1.Frame.Enabled = False: Form1.Limpieza.Enabled = False'Deshabilitamos los controles para que no se pueda modificar nada mientras carga la lista de offsets seleccionados
Form1.LV.ListItems.Clear'Limpiamos Lista para Refrescarla con los seleccionados
Contador = 1
For h = LBound(Exe) + 1 To UBound(Exe)
If Exe(h) <> vbNullString Then'si un elemento del array Exe no es nulo podremos asignar el elemento al array offsets
ReDim Preserve Offsets(Contador) As String'redimensionamos sin perderlos valores
Offsets(Contador) = Exe(h)'Y asignamos una string(nombre del offsets y su extension) al array Offsets indicando como subindice un iterador que solo se incrementara en caso de que la condicion sea verdadera, si no el testeo podria durar mucho  con solo 2 ejecutables si hemos destildado muchos ejecutables
Call Form1.LV.ListItems.Add(, , Offsets(Contador))
Contador = Contador + 1
End If
DoEvents
Next h
Form1.Testeo.Enabled = True
Form1.Testeo.Caption = vbNullString
Call Testear
End Sub

Public Sub Abrir(ByVal item As String)
On Error GoTo IR'si un Offset no Funciona, con este manejo de excepcion nos dira que no funciona
Pid = Shell(Directorio + "\" + item, vbNormalFocus)
IR:
If Err.Number = 5 Then
Call MsgBox("El Offset " + item + " No Es Funcional", vbInformation, "Aviso")
End If
Call ShellExecute(0, "open", "tskill.exe", "dwwin", vbNullString, SW_HIDE)'Lamamos a la Api shellexecute el programa tskill.exe que viene con windows en la carpeta system32
Sleep (Form1.Text2.Text)
Call SendMessage(FindWindow(vbNullString, Directorio + "\" + item), WM_CLOSE, 0&, 0&)
Call SendMessage(FindWindow("#32770", vbNullString), WM_CLOSE, 0&, 0&)
Call TerminateProcess(OpenProcess(&H1, False, Pid), 0)
End Sub

Public Sub Añadir(ByVal item As String)
Adicion = Adicion + 1'damos subindice al array y lo redimensionamos sin que pierda los valores
ReDim Preserve Exe(Adicion) As String
Exe(Adicion) = item
Cuenta = Cuenta + 1'Sumamos uno al caption del button que va indicando cuantos tenemos seleccionados
Form1.Testeo.Caption = Cuenta
End Sub

Public Sub Quitar(ByVal item As String)
For Sustraccion = 1 To UBound(Exe)'Recorremos el array Exe() asta encontrar el elemento que quitemos para asi quitarlo del array Exe
If Exe(Sustraccion) = item Then
Exe(Sustraccion) = vbNullString
End If
Next Sustraccion
Cuenta = Cuenta - 1'Restamos uno al caption del button que va indicando cuantos tenemos seleccionados
Form1.Testeo.Caption = Cuenta
End Sub

Public Sub Limpiar()
'Esta claro, ponemos a cero todas las variable enteras limpiamos campos y arrays para que el programa quede como ejecutado desde 0
Form1.Testeo.Caption = vbNullString
Form1.Porcentaje = Clear: Form1.Text1.Text = Clear: Form1.LV.ListItems.Clear: Form1.PB = Clear
Form1.Testeo.Enabled = False: Form1.Text1.Visible = False: Form1.Limpieza.Enabled = False: Form1.Frame.Enabled = False
RutaOffsets = vbNullString: Directorio = vbNullString
Form1.OLEDropMode = 1
Form1.LV.ColumnHeaders.Clear
Form1.LV.Checkboxes = True
Erase Offsets()
Erase Exe()
x = 0: i = 0: Adicion = 0: Sustraccion = 0: Contador = 0: Cuenta = 0
End Sub

Public Sub Pausar()
x = Medida'Pausar sifnifica dar el tope  al bucle(como aqui). Por eso luego para continuar usariamos el valor de la progressbar para continuar por que es el elemento que contiene el valor real en donde nos quedemos
End Sub

Private Sub Modificar()
With Form1
.Caption = Titulo
.Height = 6720
.Width = Ancho
.Left = Lefts
.Top = Tops
.OLEDropMode = 0
End With
With Form1.LV
.Height = 4215
.Top = 480
End With
With Form1.Text1
.Visible = True
.Text = Directorio & "\"
End With
Call Form1.Creditos.Move(3720, 5280, 975, 375)
End Sub

Private Sub Progreso(ByVal Porciento As String)
Form1.Porcentaje.Caption = Porciento'Esto se hace a si para que el porcentaje del progreso no quede descentrado y quede centrado y bonito
If (Len(Porciento) = 4) Then
Form1.Porcentaje.Left = 2265
ElseIf (Len(Porciento) = 3) Then
Form1.Porcentaje.Left = 2305
End If
End Sub

Private Sub Aplicar_Skin()
Canal = FreeFile'asignamos un canal para identificar el archivo y despues cargamos desde los recursos para escribirlo en disco y cargarlo
Recurso = LoadResData(101, "CUSTOM")
Skin = App.Path + "\" + "M3.msstyles"
Open Skin For Binary As #Canal
On Error Resume Next
Put #Canal, , Recurso
Resume Next
Close #Canal
Call Form1.SF.LoadSkin(Skin, vbNullString)
Form1.SF.ApplyWindow (Form1.hwnd)
End Sub

codigo fuente del formulario 1

Mostrar/Ocultar

Private Sub Command1_Click()
Form2.Show
End Sub

Private Sub Testeo_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With Testeo
Select Case .Caption
Case "Testear"
.ToolTipText = "Empezar A Testear Offsets"
Case "Pausar"
.ToolTipText = "Pausar Proceso De Ejecuciones"
Case "Continuar"
.ToolTipText = "Continuar Proceso De Ejecuciones"
Case "Terminado"
.ToolTipText = "Proceso De Ejecuciones Terminado"
Case Else
.ToolTipText = "Ejecutar Seleccionados"
End Select
End With
End Sub

Private Sub LV_ItemCheck(ByVal item As MSComctlLib.ListItem)
If item.Checked = False Then
Quitar (item)
Else
Añadir (item)
End If
End Sub

Private Sub LV_ItemClick(ByVal item As MSComctlLib.ListItem)
Abrir (item)
End Sub

Private Sub Limpieza_Click()
Call Limpiar
End Sub

Private Sub Testeo_Click()
If Flag = True Then
Call Pausar
Else
Call Testear
End If
End Sub

Private Sub Creditos_Click()
Dialog.Show
End Sub

Private Sub Form_Load()
Call FormLoad
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Call OLEDragAndDrop(Data.Files(1))
End Sub

Private Sub UpDown1_Change()
Text2.Text = UpDown1.Value
End Sub

codigo fuente del formulario 2(el de modificar los incrementos del sleep xD)

Mostrar/Ocultar

Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub

Private Sub Option1_Click()
Form1.UpDown1.Value = Form1.Text2.Text
Form1.UpDown1.Increment = 100
End Sub

Private Sub Option2_Click()
Form1.UpDown1.Value = Form1.Text2.Text
Form1.UpDown1.Increment = 500
End Sub

Private Sub Option3_Click()
Form1.UpDown1.Value = Form1.Text2.Text
Form1.UpDown1.Increment = 1000
End Sub

Private Sub Option4_Click()
Form1.UpDown1.Value = Form1.Text2.Text
Form1.UpDown1.Increment = 10
End Sub

Private Sub Option5_Click()
Form1.UpDown1.Value = Form1.Text2.Text
Form1.UpDown1.Increment = 1
End Sub

El formulario 2 creo que no hace falta comentar y el del form1 tampoco el del bas si xD
por cierto si algun moderador me actualiza el hilo se lo agradeceria, un saludo a todos

Abolición para el torneo del toro de la vega. Death to the murderers of bulls.

Source Evolution Offset Tester

Temas similares

Variantes de tema

Source Evolution Offset Tester

Mostrar mensajes previos

Ordenar por

Temas similares

Variantes de tema