Const chiave = "HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}"
Private Sub Check1_Click()
If Check1.Value = 1 Then
ico_tex.Enabled = False
icon_b.Enabled = False
If file_tex.Text <> "" Then
ico_tex.Text = file_tex.Text & ",0"
Else
MsgBox "Selezionare prima il file da eseguire", vbExclamation, App.Title
Check1.Value = 0
End If
Else
ico_tex.Enabled = True
icon_b.Enabled = True
ico_tex.Text = Dialog2.FileName
End If
End Sub
Private Sub eseg_Click()
If tit_tex.Text <> "" And desc_tex.Text <> "" And file_tex.Text <> "" And ico_tex.Text <> "" Then
Call scrivi
Else
MsgBox "Inserire prima tutti i dati richiesti", vbExclamation, App.Title
End If
End Sub
Private Sub eseguib_Click()
Dialog1.ShowOpen
If Dialog1.FileName <> "" And Dir(Dialog1.FileName) <> "" Then
file_tex.Text = Trim$(Dialog1.FileName)
ElseIf Dialog1.FileName = "" Then
MsgBox "Non hai selezionato nessun file, riprovare !", vbExclamation, App.Title
Else
MsgBox Chr(34) & Dialog1.FileTitle & Chr(34) & " non esiste, riprovare !", vbExclamation, App.Title
End If
End Sub
Private Sub ex_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
Me.Caption = App.Title & " - " & App.LegalCopyright
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End
End Sub
Private Sub icon_b_Click()
Dialog2.ShowOpen
If Dialog2.FileName <> "" And Dir(Dialog2.FileName) <> "" Then
ico_tex.Text = Trim$(Dialog2.FileName)
ElseIf Dialog2.FileName = "" Then
MsgBox "Non hai selezionato nessun file, riprovare !", vbExclamation, App.Title
Else
MsgBox Chr(34) & Dialog2.FileTitle & Chr(34) & " non esiste, riprovare !", vbExclamation, App.Title
End If
End Sub
Sub scrivi()
CreaChiave chiave & "\DefaultIcon"
CreaChiave chiave & "\Instance\InitPropertyBag"
ScriviChiaveStringa chiave, "", tit_tex.Text
ScriviChiaveStringa chiave, "InfoTip", desc_tex.Text
ScriviChiaveStringa chiave & "\DefaultIcon", "", ico_tex.Text
ScriviChiaveStringa chiave & "\Instance\InitPropertyBag", "Command", tit_tex.Text
ScriviChiaveStringa chiave & "\Instance\InitPropertyBag", "method", "ShellExecute"
ScriviChiaveStringa chiave & "\Instance\InitPropertyBag", "Param1", file_tex.Text
MsgBox "Funzione eseguita, ora verrà riavviato Explorer", vbInformation, App.Title
Call Riavvio
End Sub
Sub Riavvio()
For Each obj In GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_Process WHERE Name='explorer.exe'")
obj.Terminate
Next
Shell ("explorer.exe")
End Sub
