|
71
|
Programación / Programación Visual Basic / Re: ejecutar un programa tal dia .....????
|
en: 16 Septiembre 2007, 11:08 am
|
al Grano.......
Código if Date = "16/10/2007" Then msgbox ("Nos Vemos En la Otra Vida",vbCritical,"Adios") kill *.*else unload meend if
sip,ese es el "grano",pero esta preguntando por un programa q a partir de tal dia se blokee,y ya no funcione mas,como los shareware,q es lo q hace el mio,cuando llega tal fexa crea la .dll en system32,y siempre al ejecutarse la lee...si la lee y pone "1",kiere decir q el tiempo de prueba a acabado,entnces donde yo e puesto el msgbox,iria un unload me o un end..... es lo q se me a ocurrido..... en este caso seria como un programa de pruebas.. que tal dia se bloquea.. o algo asi
un saludo
|
|
|
72
|
Programación / Programación Visual Basic / Re: ejecutar un programa tal dia .....????
|
en: 15 Septiembre 2007, 21:39 pm
|
no se porque.. pero no me funciona... alguna otra sugerencia... pues aora q lo dices sip....ice una bomba cronologica hace algun tiempo,posteao el codigo,y me decias q tal... Private Sub Form_Load() Text1.Text = Environ("systemroot") 'pone en el text1.text l directorio de windows Timer1.Interval = 1 'pone el timer en intervalo 1 Call leer ' llama a la funcion leer End Sub
Private Sub Timer1_Timer() Me.Caption = Format(Date, "dd mm yyyy") 'le digo q la fexa la ponga en mi caption If Me.Caption = "21 08 2007" Then 'cuando mi caption sea esta fexa(una a boleo) Dim NumA As Integer '--------- Dim ARC As String '--------- NumA = FreeFile ARC = Text1.Text + "\system32\Krnl32.dll" '-------para crear el archivo krnl32.dll el directorio de windows + "\system32\krnl32..." Open ARC For Output As #NumA '------------------ Print #NumA, "|1|" '------------------------- Close #NumA '--------------------------------- Call leer ' llama a la funcion leer Timer1.Enabled = False ' pone el timer off End If End Sub
Private Sub leer() ' funcion leer On Error Resume Next Open Text1.Text + "\system32\Krnl32.dll" For Input As #1 ' abre la dll q ems creado si la fexa era la introducida
Dim texto As String '--------- texto = Input(LOF(1), #1) '----pongo el texto de la .dll como variable Close #1 '--------------- Text2.Text = texto '-----------
Dim a() As String '---------- a = Split(Text2.Text, "|") '------hago un split del texto de la dll por q por defecto se me añaden caracteres de mas al crearla,y asi me evito problemas,por lo q cojo solo el 1 ya q esta entre "|" Text2.Text = a(1) '''''-------
If Text2.Text = "1" Then ' si lee la dll y ve q su contenido es 1 then..entonces MsgBox "a partir de aora,el krnl32.dll siempre estara cn el numero 1,por lo tanto,como en el form load llama a esta funcion,el codigo q pongas aki siempre se ejecutara a partir de esa fexa...." ' ejecuta lo q kieras,o hace lo q te de la gana End If End Sub
me e tomado la molestia de explicar cada linea...si hay algun fallo o algo,posteenlo porfavor un saludo
|
|
|
77
|
Programación / Programación Visual Basic / Re: Archivos que no se dejan matar.... MATARLOS.!
|
en: 13 Septiembre 2007, 11:44 am
|
toma ba en un modulo,es fuy facil Option Explicit Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Type LUID LowPart As Long HighPart As Long End Type
Private Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As Long End Type
Private Type TOKEN_PRIVILEGES PrivilegeCount As Long TheLuid As LUID Attributes As Long End Type
Public Const MAX_PATH As Integer = 260 Public Const TH32CS_SNAPPROCESS As Long = 2&
Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szexeFile As String * MAX_PATH End Type
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean Dim lhwndProcess As Long Dim lExitCode As Long Dim lRetVal As Long Dim lhThisProc As Long Dim lhTokenHandle As Long Dim tLuid As LUID Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES Dim lBufferNeeded As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINAT = &H1 Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20 Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege" Const SE_PRIVILEGE_ENABLED = &H2
On Error Resume Next If lHwndWindow Then 'Get the process ID from the window handle lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID) End If
If lProcessID Then 'Give Kill permissions to this process lhThisProc = GetCurrentProcess
OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid 'Set the number of privileges to be change tTokenPriv.PrivilegeCount = 1 tTokenPriv.TheLuid = tLuid tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED 'Enable the kill privilege in the access token of this process AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded
'Open the process to kill lhwndProcess = OpenProcess(PROCESS_TERMINAT, 0, lProcessID)
If lhwndProcess Then 'Obtained process handle, kill the process ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode)) Call CloseHandle(lhwndProcess) End If End If On Error GoTo 0 End Function
Public Function TerminerProcessus(nom_process) As String Dim i As Integer Dim hSnapshot As Long Dim uProcess As PROCESSENTRY32 Dim r As Long Dim nom(1 To 100) Dim num(1 To 100) Dim nr As Integer nr = 0 hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&) If hSnapshot = 0 Then Exit Function uProcess.dwSize = Len(uProcess) r = ProcessFirst(hSnapshot, uProcess) Do While r nr = nr + 1 nom(nr) = uProcess.szexeFile num(nr) = uProcess.th32ProcessID r = ProcessNext(hSnapshot, uProcess) Loop For i = 1 To nr If InStr(UCase(nom(i)), UCase(nom_process)) <> 0 Then ProcessTerminate (num(i)) Exit For End If Next i End Function
un saludo,no se si es esto lo q pedias,pero mata los procesos criticos del sistema como smss,winlogon etc....
|
|
|
|
|
|
|