Newsgroup: it.comp.lang.visual-basic
Titolo: Un consiglio per un programma

Ciao a tutti,
vorrei la vostra opinione e/o qualche idea sulla realizzabilità di questo
programma:
onde evitare che venga utilizzato software indesiderato (ovvero giochi e
porcatine varie) in una Azienda, vorrei fare un programmino che controlla i
processi di sitema e killa o non lascia partire quelli che non rientrano in
una determinata lista.
Ho fatto anche delle belle cosine con VB5, ma non mi ritengo così esperto da
realizzare un programma di questo tipo senza una spintarella iniziale.
Grazie a tutti per la collaborazione :)))
<LuigI> 
omc...@msoft.it

una determinata lista.
L'esempio che segue crea un process viewer, con la possibilita' di killare i
processi.
Penso che faccia al caso tuo.
Forse funziona solo su win95/98, non so se funziona su WinNT.
Buon Lavoro
Come procedere:
- Clippare qui sotto e salvare in un file chiamato frmMain.frm
- creare un nuovo progetto ed aggiungere questo form ( frmMain.frm )
Buon Lavoro a tutti
######################################################################
####   INIZIO CLIP ######################################################
######################################################################
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4095
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8295
   LinkTopic       =   "frmMain"
   ScaleHeight     =   4095
   ScaleWidth      =   8295
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2
      Caption         =   "Aggiorna"
      Height          =   435
      Left            =   60
      TabIndex        =   3
      Top             =   3600
      Width           =   1875
   End
   Begin VB.CommandButton Command1
      Caption         =   "Chiudi Processo"
      Default         =   -1  'True
      Height          =   495
      Left            =   5880
      TabIndex        =   1
      Top             =   3540
      Width           =   2295
   End
   Begin VB.ListBox List1
      BeginProperty Font
         Name            =   "Fixedsys"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2985
      Left            =   60
      TabIndex        =   0
      Top             =   480
      Width           =   8115
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "LISTA DEI PROCESSI"
      Height          =   315
      Left            =   60
      TabIndex        =   2
      Top             =   180
      Width           =   8115
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ***********************************************************
' *
' * Elenco dei processi e chiusura a comando
' *
' * Fatto da:
' * Ettore Maronese  By -MES-
' * 
il...@usa.net
' * 27/10/1998
' *
' ***********************************************************
Private Type THREADENTRY32
    dwSize              As Long
    cntUsage            As Long
    th32ThreadID        As Long
    th32OwnerProcessID  As Long
    tpBasePri           As Long
    tpDeltaPri          As Long
    dwFlags             As Long
End Type
Private Type MODULEENTRY32
    dwSize          As Long
    th32ModuleID    As Long
    th32ProcessID   As Long
    GlblcntUsage    As Long
    ProccntUsage    As Long
    modBaseAddr     As Long ' puntatore char
    modBaseSize     As Long
    hModule         As Long
    szModule        As String * 256
    szExePath       As String * 260
End Type
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 * 260
End Type
Const TH32CS_SNAPHEAPLIST = &H1&
Const TH32CS_SNAPPROCESS = &H2&
Const TH32CS_SNAPTHREAD = &H4&
Const TH32CS_SNAPMODULE = &H8&
Const TH32CS_INHERIT = &H80000000
'const TH32CS_SNAPALL      = (TH32CS_SNAPHEAPLIST | TH32CS_SNAPPROCESS |
TH32CS_SNAPTHREAD | TH32CS_SNAPMODULE)
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal
dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryProc As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryProc As PROCESSENTRY32) As Long
Private Declare Function Module32First Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryModule As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryModule As MODULEENTRY32) As Long
Private Declare Function Thread32First Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryModule As THREADENTRY32) As Long
Private Declare Function Thread32Next Lib "kernel32.dll" (ByVal HSnapShot
As Long, ByRef EntryModule As THREADENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
As Long
Private Declare Function PostThreadMessage Lib "user32" Alias
"PostThreadMessageA" (ByVal idThread As Long, ByVal msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Private Const WM_QUIT = &H12
Private Sub Command1_Click()
    Dim pID As Long
    If List1.ListIndex < 0 Then Exit Sub
    If vbYes = MsgBox("Si desidera chiudere il processo?", vbYesNo +
vbQuestion) Then
        pID = Val("&H" & Left$(List1.List(List1.ListIndex),
InStr(List1.List(List1.ListIndex), " ") - 1) & "&")
        Call CloseProcess(pID)
        Call GetProcessList(List1)
    End If
End Sub
Private Sub Command2_Click()
    Call GetProcessList(List1)
End Sub
Private Sub Form_Load()
    Call GetProcessList(List1)
End Sub
Private Function GetProcessModule(pID As Long, ModuleID As Long,
EntryModule As MODULEENTRY32) As Boolean
    Dim HSnapShot       As Long
    GetProcessModule = False
    HSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
    If HSnapShot <> -1 Then
        EntryModule.dwSize = Len(EntryModule)
        Esito = Module32First(HSnapShot, EntryModule)
        Do While Esito
            If EntryModule.th32ModuleID = ModuleID Then
                GetProcessModule = True
                Exit Do
            End If
            Esito = Module32Next(HSnapShot, EntryModule)
        Loop
        Call CloseHandle(HSnapShot)
    End If
End Function
Sub GetProcessList(Lista As Control)
    Dim HSnapShot       As Long
    Dim EntryProcess    As PROCESSENTRY32
    Dim EntryModule     As MODULEENTRY32
    Dim Esito           As Long
    Dim StrAppo$
    List1.Clear
    HSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If HSnapShot = -1 Then
        MsgBox "Errore creazione SnapShot Processi"
        Exit Sub
    End If
    EntryProcess.dwSize = Len(EntryProcess)
    Esito = Process32First(HSnapShot, EntryProcess)
    Do While Esito
        If GetProcessModule(EntryProcess.th32ProcessID,
EntryProcess.th32ModuleID, EntryModule) Then
            StrAppo$ = Left$(EntryModule.szModule,
InStr(EntryModule.szModule, Chr$(0)) - 1)
            StrAppo$ = Format$(StrAppo$, "@@@@@@@@@@@@@@@ ") &
Left$(EntryModule.szExePath, InStr(EntryModule.szExePath, Chr$(0)) - 1)
            Lista.AddItem Right$("00000000" &
Hex(EntryProcess.th32ProcessID), 8) & " " & StrAppo$
            Esito = Process32Next(HSnapShot, EntryProcess)
        End If
    Loop
    Call CloseHandle(HSnapShot)
End Sub
Function CloseProcess(pID As Long) As Boolean
    Dim EntryThread     As THREADENTRY32
    Dim HSnapShot       As Long
    CloseProcess = False
    HSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, pID)
    If HSnapShot <> -1 Then
        EntryThread.dwSize = Len(EntryThread)
        Esito = Thread32First(HSnapShot, EntryThread)
        Do While Esito
            If EntryThread.th32OwnerProcessID = pID Then
                CloseProcess = True
                ' invio il messaggio di chiusura
                Call PostThreadMessage(EntryThread.th32ThreadID, WM_QUIT,
0, 0)
            End If
            Esito = Thread32Next(HSnapShot, EntryThread)
        Loop
        Call CloseHandle(HSnapShot)
    End If
End Function
Private Sub List1_DblClick()
    Command1.Value = True
End Sub
######################################################################
####   FINE CLIP #######################################################
######################################################################