Option Explicit
Dim lIndice As Long, lIndice2 As Long, cod As Long
Dim sNome As String, sNome2 As String
Dim sValore As String, sValore2 As String
Dim lTipo As Long, lTipo2 As Long
Dim percorso As String, nuovachiave As String
Dim kIndice As Long
Private Sub avv_Click()
Call avvio
End Sub
Private Sub deletems_Click()
Call ApriChiave(percorso, cod, &HF003F)
Call CancellaValore(cod, "MSConfig")
Call ChiudiChiave(cod)
Timer1.Enabled = True
End Sub
Private Sub esci_Click()
Unload frmAbout
Unload Form2
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = App.Title & " vers. " & App.Major & "." & App.Minor & "." & App.Revision & " - By Natamas"
kIndice = 1
nuovachiave = "HKEY_LOCAL_MACHINE\SOFTWARE\XControl"
percorso = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Call CreaChiave(nuovachiave)
Call leggi
Call leggi2
End Sub
Sub leggi()
On Error GoTo errori
lIndice = 0
Do While EnumeraValori(percorso, lIndice, sNome, lTipo)
Call LeggiChiaveStringa(percorso, sNome, sValore)
If sNome = "MSConfig" Then
deletems.Enabled = True
End If
Dim itmX As ListItem
Set itmX = listaw.ListItems.Add
itmX.Text = sNome
itmX.SubItems(1) = sValore
itmX.SubItems(2) = percorso
itmX.Checked = True
itmX.Tag = lIndice
itmX.ToolTipText = " Abilitato "
lIndice = lIndice + 1
Loop
errori:
If Err.Number > 0 Then
Call errore(Err.Description, Err.Number)
Exit Sub
End If
End Sub
Sub leggi2()
On Error GoTo errori
lIndice2 = 0
Do While EnumeraValori(nuovachiave, lIndice2, sNome2, lTipo2)
Call LeggiChiaveStringa(nuovachiave, sNome2, sValore2)
Dim itmX2 As ListItem
Set itmX2 = listaw.ListItems.Add
itmX2.Text = sNome2
itmX2.SubItems(1) = sValore2
itmX2.SubItems(2) = percorso
itmX2.Checked = False
itmX2.Tag = lIndice2
itmX2.ToolTipText = " Bloccato "
lIndice2 = lIndice2 + 1
Loop
errori:
If Err.Number > 0 Then
Call errore(Err.Description, Err.Number)
Exit Sub
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub inf_Click()
frmAbout.Show 1
End Sub
Sub ok(Optional ByVal mess As String)
If mess <> "" Then
Form2.Label1.Caption = mess
Form2.Frame1.Caption = ""
Form2.ok.Visible = False
Form2.Timer1.Enabled = True
End If
Form2.Visible = True
Form1.Visible = False
Unload Me
End Sub
Private Sub listaw_ItemClick(ByVal Item As MSComctlLib.ListItem)
If Not Item.Checked Then
Item.Checked = True
Else
Item.Checked = False
End If
End Sub
Private Sub rel_Click()
Call ok("Aggiornamento in corso, attendere .....")
End Sub
Sub avvio()
On Error GoTo errori
Dim filesel As String, filesel2 As String, file As Long
file = listaw.ListItems.Count
If kIndice <= file Then
filesel = listaw.ListItems.Item(kIndice)
filesel2 = listaw.ListItems.Item(kIndice).SubItems(1)
If (listaw.ListItems.Item(kIndice).Checked) Then
Call ScriviChiaveStringa(percorso, filesel, filesel2)
Call controllo(nuovachiave, filesel)
Else
Call ScriviChiaveStringa(nuovachiave, filesel, filesel2)
Call controllo(percorso, filesel)
End If
Timer1.Enabled = True
kIndice = kIndice + 1
Call avvio
End If
errori:
If Err.Number > 0 Then
Call errore(Err.Description, Err.Number)
Exit Sub
End If
End Sub
Sub controllo(ByVal dir As String, ByVal name As String)
On Error GoTo errori
Dim zIndice As Long, zTipo As Long, zNome As String, zValore As String
zIndice = 0
Do While EnumeraValori(dir, zIndice, zNome, zTipo)
Call LeggiChiaveStringa(dir, zNome, zValore)
If zNome = name Then
Call ApriChiave(dir, cod, &HF003F)
Call CancellaValore(cod, name)
Call ChiudiChiave(cod)
End If
zIndice = zIndice + 1
Loop
errori:
If Err.Number > 0 Then
Call errore(Err.Description, Err.Number)
Exit Sub
End If
End Sub
Private Sub Timer1_Timer()
Call ok
Timer1.Enabled = False
End Sub
Sub errore(ByVal descrizione As String, ByVal numero As Long)
MsgBox ("Si e vericato questo errore: " & descrizione), vbCritical, App.Title & " - Errore n° " & numero
Exit Sub
End Sub
