• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

Fatal1ty

[Dúvida] Randomizar o tempo

3 mensagens neste tópico

Boas,

É assim tenho uma dúvida estou a fazer um programa no qual dentro de 10m ele randomize o tempo.

Por exemplo executar a função até ao máximo de 10m, mas com um tempo ao calhas, por exemplo aos 3m. Ou seja tem até 10m no máximo para fazer a função.

Será que deu para entender?

Aguardo ajuda!

Cumps

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Já resolvi esta parte.

Mas tenho outra duvida! Como é que consigo terminar um processo em vb6? Por exemplo terminar o "Firefox.exe"?

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá boa noite.

espero te ajudar com este exemplo.

1º -  no formulário adicionas os controles:

- Text1.text (textbox)

- Botão  (Command1)

2º - Adicionar um módulo.

Código do formulário :

==============

Private Sub Command1_Click()
    Dim uLngProcess As Long
    uLngProcess = GetProcessIDByEXEName(Me.Text1.Text)
    If uLngProcess <> 0 Then ProcessTerminate uLngProcess
End Sub

Código do Módulo :

============

Global Const MAX_PATH = 260
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private 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
Private Type LUID: UsedPart As Long: IgnoredForNowHigh32BitPart As Long: End Type
Private Type TOKEN_PRIVILEGES: PrivilegeCount As Long: TheLuid As LUID: Attributes As Long: End Type


Function GetProcessIDByEXEName(ByVal EXEName As String) As Long
    
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim R As Long, lStrtemp As String

hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)

    If hSnapShot = -1 Then Exit Function

uProcess.dwSize = Len(uProcess)
R = ProcessFirst(hSnapShot, uProcess)

    Do While R
    
        If InStr(UCase(uProcess.szExeFile), UCase(EXEName)) <> 0 Then
        GetProcessIDByEXEName = uProcess.th32ProcessID
        Call CloseHandle(hSnapShot)
        Exit Function
        End If
    
    R = ProcessNext(hSnapShot, uProcess)
    
    Loop

Call CloseHandle(hSnapShot)

End Function

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_TERMINATE = &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_TERMINATE, 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

Por Fim :

Dentro da text1.text adicionas dentro da propriedade Text : Firefox.exe

Cump.

Programadorvb6

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora