te comento
no tiene modulos, solo usa funciones privadas
no es un malware, es un gestor del arranque, como un msconfig
tiene trozos que he tenido que sacar de internet si, como todo jeje, luego lo he puesto a mi manera
mira, os dejo el codiugo fuente, haber si veis algo
Option Explicit
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Public carpeta As String
Private Sub Form_Initialize()
If App.PrevInstance = True Then
MsgBox "La aplicacion ya esta siendo ejecutada", vbInformation
End
End If
App.TaskVisible = True
End Sub
Private Sub Form_Load()
carpeta = Environ("PROGRAMFILES") & "\InfoBugs"
Call Ficheros_programa
Call lblinicio_Click
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'FUNCIONES
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Function listado_servicios() 'FUNCION DE LISTADO DE SERVICIOS
On Error GoTo error
Dim objwmiservice As Object
Dim colListOfServices, objservice
Dim lisitems As ListItem
Dim estado As String
LV3.ListItems.Clear
Set objwmiservice = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colListOfServices = objwmiservice.ExecQuery("Select * from Win32_Service")
For Each objservice In colListOfServices
If objservice.state = "Running" Then Set lisitems = LV3.ListItems.Add(, , , , "service-on") Else Set lisitems = LV3.ListItems.Add(, , , , "service-off")
If objservice.state = "Running" Then estado = "Iniciado" Else estado = "Parado"
lisitems.SubItems(1) = objservice.DisplayName
lisitems.SubItems(2) = objservice.Description
lisitems.SubItems(3) = estado
lisitems.SubItems(4) = objservice.Name
Next
error:
End Function
Private Function Listado(ByVal path As String) 'FUNCION DE LISTADO DE CARPETAS
On Error GoTo error
Dim raiz As Folder
Dim carpetas As Folder
Dim archivo As File
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Set raiz = FSO.GetFolder(path)
Screen.MousePointer = vbHourglass
For Each carpetas In raiz.SubFolders
LV.ListItems.Add(, , carpetas.Name, , "carpeta").SubItems(1) = raiz.path
Next
For Each archivo In raiz.Files
LV.ListItems.Add(, , archivo.Name, , "archivo").SubItems(1) = archivo.path
Next
Screen.MousePointer = vbDefault
Set FSO = Nothing
Set raiz = Nothing
error:
End Function
Private Sub Image4_Click()
On Error GoTo error
Shell "netsh firewall set opmode mode = ENABLE", vbHide
imgfirewallno.Visible = False
imgfirewallsi.Visible = True
Exit Sub
error:
imgfirewallno.Visible = True
imgfirewallsi.Visible = False
End Sub
Private Sub Image7_Click()
On Error GoTo error
Shell "reg add HKLM\System\CurrentControlSet\Services\Tcpip\Parameters /f /v SynAttackProtect /d 2 /t reg_dword", vbHide
imgsynfloodsi.Visible = True
imgsynfloodno.Visible = False
Exit Sub
error:
imgsynfloodsi.Visible = False
imgsynfloodno.Visible = True
End Sub
Private Sub imgbackupreg_Click() 'FUNCION PARA BACKUP DEL REGISTRO
Dim fecha As String
fecha = Date$ & " " & Time$
fecha = Replace(fecha, ":", " ")
If MsgBox("¿Esta seguro de querer realizar un backup del registro?", vbQuestion + vbYesNo, "Advertencia") = vbYes Then
Me.MousePointer = vbHourglass
Call Ficheros_programa
Shell "regedit /e " & Chr(34) & carpeta & "\Registro\" & fecha & ".reg" & Chr(34)
If Len(Dir(carpeta & "\Registro\" & fecha & ".reg")) Then MsgBox "Backup del Registro Completado Satisfactoriamente", vbInformation Else MsgBox "Backup del Registro Fallido, Comprueba Permisos", vbCritical
Me.MousePointer = vbNormal
End If
End Sub
Private Sub imgbackdoor_Click() 'COMPROBANDO SI HAY UNA BACKDOOR TRASERA
On Error GoTo error
Dim sethc As Long, cmd As Long, taskmgr As Long
cmd = FileLen("c:\windows\system32\cmd.exe")
sethc = FileLen("c:\windows\system32\sethc.exe")
taskmgr = FileLen("c:\windows\system32\taskmgr.exe")
Select Case cmd
Case sethc
backno.Visible = True
backyes.Visible = False
Case taskmgr
backno.Visible = True
backyes.Visible = False
Case Else
backyes.Visible = True
backno.Visible = False
End Select
Exit Sub
error:
backyes.Visible = False
backno.Visible = True
End Sub
Private Function Registro_dir(ByVal raiz As String, ByVal ruta As String, ByVal origen As String) 'EXAMINANDO LOS VALORES DEL REGISTRO
On Error GoTo error
Dim oreg As Object
Dim Nombre_pc, respuesta, valor As String
Dim lisitems As ListItem
Dim arrvaluenames(), arrvaluetypes() As String
Dim i As Integer
Screen.MousePointer = vbHourglass
Nombre_pc = "."
Set oreg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Nombre_pc & "\root\default:StdRegProv")
Select Case raiz
Case "hklm"
respuesta = oreg.EnumValues(HKEY_LOCAL_MACHINE, ruta, arrvaluenames, arrvaluetypes)
Case "hkcu"
respuesta = oreg.EnumValues(HKEY_CURRENT_USER, ruta, arrvaluenames, arrvaluetypes)
Case "hku"
respuesta = oreg.EnumValues(HKEY_USERS, ruta, arrvaluenames, arrvaluetypes)
Case "hkcr"
respuesta = oreg.EnumValues(HKEY_CLASSES_ROOT, ruta, arrvaluenames, arrvaluetypes)
Case "hkcc"
respuesta = oreg.EnumValues(HKEY_CURRENT_CONFIG, ruta, arrvaluenames, arrvaluetypes)
End Select
For i = 0 To UBound(arrvaluenames)
Select Case raiz
Case "hklm"
oreg.GetStringValue HKEY_LOCAL_MACHINE, ruta & "\", arrvaluenames(i), valor
raiz = "HKEY_LOCAL_MACHINE"
Case "hkcu"
oreg.GetStringValue HKEY_CURRENT_USER, ruta & "\", arrvaluenames(i), valor
raiz = "HKEY_CURRENT_USER"
Case "hku"
oreg.GetStringValue HKEY_USERS, ruta & "\", arrvaluenames(i), valor
raiz = "HKEY_USERS"
Case "hkcr"
oreg.GetStringValue HKEY_CLASSES_ROOT, ruta & "\", arrvaluenames(i), valor
raiz = "HKEY_CLASSES_ROOT"
Case "hkcc"
oreg.GetStringValue HKEY_CURRENT_CONFIG, ruta & "\", arrvaluenames(i), valor
raiz = "HKEY_CURRENT_CONFIG"
End Select
Set lisitems = LV2.ListItems.Add(, , origen)
lisitems.SubItems(1) = arrvaluenames(i)
lisitems.SubItems(2) = valor
lisitems.SubItems(3) = raiz & "\" & ruta
Next
error:
Screen.MousePointer = vbNormal
End Function
Private Function Ficheros_programa() 'VERIFICANDO INSTALACION DEL PROGRAMA
If Len(Dir(carpeta, vbDirectory)) = 0 Then
MkDir carpeta
Open carpeta & "\carpetas.ibgs" For Output As #1
Close #1
Open carpeta & "\registros.ibgs" For Output As #1
Close #1
MkDir carpeta & "\Registro"
Else
If Len(Dir(carpeta & "\Registro", vbDirectory)) = 0 Then MkDir carpeta & "\Registro"
If Len(Dir(carpeta & "\carpetas.ibgs", vbArchive)) = 0 Then
Open carpeta & "\carpetas.ibgs" For Output As #1
Close #1
End If
If Len(Dir(carpeta & "\registros.ibgs", vbArchive)) = 0 Then
Open carpeta & "\registros.ibgs" For Output As #1
Close #1
End If
End If
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'DESCRIPCIONES
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub LV_Click() 'CAMPOS DE DESCRIPCION DEL VALOR
lblnombreini.Caption = "Nombre: " & LV.SelectedItem.Text
lblvalorini.Caption = "Ruta: " & LV.SelectedItem.SubItems(1)
If Len(lblvalorini) >= 129 Then lblvalorini.Caption = Mid(lblvalorini, 1, 126) & "..."
If Len(lblnombreini) >= 129 Then lblnombreini.Caption = Mid(lblnombreini, 1, 126) & "..."
End Sub
Private Sub LV2_Click() 'CAMPOS DE DESCRIPCION DEL VALOR
Dim raiz() As String
raiz = Split(LV2.SelectedItem.SubItems(3), "\")
lblraizreg.Caption = "Raiz: " & raiz(0)
lblorigenreg.Caption = "Descripcion: " & Left(LV2.SelectedItem.Text, 15)
lblnombrereg.Caption = "Nombre: " & LV2.SelectedItem.SubItems(1)
lblvalorreg.Caption = "Valor: " & LV2.SelectedItem.SubItems(2)
If Len(lblvalorreg) >= 129 Then lblvalorreg.Caption = Mid(lblvalorreg, 1, 129) & "..."
If Len(lblnombrereg) >= 129 Then lblnombrereg.Caption = Mid(lblnombrereg, 1, 129) & "..."
End Sub
Private Sub LV3_Click()
lblestadoservice.Caption = "Estado: " & LV3.SelectedItem.SubItems(3)
lblnombreservice.Caption = "Nombre: " & LV3.SelectedItem.SubItems(1)
lbldescripcionservice.Caption = "Descripcion: " & LV3.SelectedItem.SubItems(2)
If Len(lbldescripcionservice) >= 110 Then lbldescripcionservice.Caption = Mid(lbldescripcionservice, 1, 107) & "..."
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MENUS
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub lblregistro_Click() 'COMPROBANDO LOS REGISTROS
On Error GoTo error
Dim lugar As String
Dim partes() As String
frameregistro.Visible = True
frameinicio.Visible = False
frameotros.Visible = False
frameservicios.Visible = False
lblinicio.BackColor = &H6E6E6E
lblregistro.BackColor = &H7E7E7E
lblotros.BackColor = &H6E6E6E
lblservicios.BackColor = &H6E6E6E
LV2.ListItems.Clear
Screen.MousePointer = vbHourglass
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows\Currentversion\run", "Run HKLM"
Registro_dir "hkcu", "SOFTWARE\Microsoft\Windows\Currentversion\run", "Run HKCU"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows\Currentversion\runonce", "RunOnce HKLM"
Registro_dir "hkcu", "SOFTWARE\Microsoft\Windows\Currentversion\runonce", "RunOnce HKCU"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows\Currentversion\runonceex", "RunOnceEx HKLM"
Registro_dir "hkcu", "SOFTWARE\Microsoft\Windows\Currentversion\runonceex", "RunOnceEx HKCU"
Registro_dir "hkcu", "Software\Microsoft\Windows NT\CurrentVersion\Windows\run", "Run HKCU WinNT"
Registro_dir "hkcu", "Software\Microsoft\Windows NT\CurrentVersion\Windows\load", "Load HKCU WinNT"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell HKLM"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\UserInit", "UserInit HKLM"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\Run", "Policies HKLM"
Registro_dir "hkcu", "SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\Run", "Policies HKCU"
Registro_dir "hklm", "SOFTWARE\Policies\Microsoft\Windows\System\Scripts", "Scripts HKLM"
Registro_dir "hklm", "SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\State\Machine\Scripts", "Scripts HKLM"
Call Ficheros_programa
Open carpeta & "\registros.ibgs" For Input As #2
Do While Not EOF(2)
Line Input #2, lugar
partes = Split(lugar, "<>")
Registro_dir partes(1), partes(2), partes(0)
Loop
Close #2
Screen.MousePointer = vbDefault
error:
End Sub
Private Sub lblinicio_Click()
On Error GoTo error
Dim wscript As Object
Dim pathinicio As String, carpeta_especificada As String
frameinicio.Visible = True
frameregistro.Visible = False
frameotros.Visible = False
frameservicios.Visible = False
lblregistro.BackColor = &H6E6E6E
lblinicio.BackColor = &H7E7E7E
lblotros.BackColor = &H6E6E6E
lblservicios.BackColor = &H6E6E6E
Set wscript = CreateObject("Wscript.Shell")
pathinicio = wscript.specialfolders("Startup")
LV.ListItems.Clear
Call Listado(pathinicio)
Call Ficheros_programa
Open carpeta & "\carpetas.ibgs" For Input As #1
Do While Not EOF(1)
Line Input #1, carpeta_especificada
Call Listado(carpeta_especificada)
Loop
Close #1
Set wscript = Nothing
error:
End Sub
Private Sub lblotros_Click()
frameinicio.Visible = False
frameregistro.Visible = False
frameotros.Visible = True
frameservicios.Visible = False
lblregistro.BackColor = &H6E6E6E
lblinicio.BackColor = &H6E6E6E
lblotros.BackColor = &H7E7E7E
lblservicios.BackColor = &H6E6E6E
End Sub
Private Sub lblservicios_Click()
frameinicio.Visible = False
frameregistro.Visible = False
frameotros.Visible = False
frameservicios.Visible = True
lblregistro.BackColor = &H6E6E6E
lblinicio.BackColor = &H6E6E6E
lblotros.BackColor = &H6E6E6E
lblservicios.BackColor = &H7E7E7E
listado_servicios
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'LLAMADAS A MENUS CONTEXTUALES
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub LV_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
Me.PopupMenu mnucontextual, , , , mnueliminar
End If
End Sub
Private Sub LV2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
Me.PopupMenu mnuregistro, , , , mnueliminarreg
End If
End Sub
Private Sub LV3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
If LV3.SelectedItem.SubItems(3) = "Iniciado" Then
mnudetenerservice.Enabled = True
mnuiniciarservice.Enabled = False
Me.PopupMenu mnuservicios, , , , mnudetenerservice
Else
mnuiniciarservice.Enabled = True
mnudetenerservice.Enabled = False
Me.PopupMenu mnuservicios, , , , mnuiniciarservice
End If
End If
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MENUS CONTEXTUALES
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub mnueliminar_Click()
On Error GoTo error
If LV.SelectedItem <> "" Then
If MsgBox("Estas seguro de querer eliminar" & LV.SelectedItem & " ?", vbQuestion + vbYesNo, "Advertencia") = vbYes Then
Kill LV.SelectedItem.SubItems(1)
If Len(Dir(LV.SelectedItem.SubItems(1))) = 0 Then MsgBox "Archivo Eliminado Correctamente", vbInformation Else MsgBox "No se pudo Eliminar el archivo, puede estar en proceso o que no tengas permisos", vbCritical
Call lblinicio_Click
End If
End If
error:
End Sub
Private Sub mnueliminarreg_Click()
On Error GoTo error
If LV2.SelectedItem <> "" Then
If MsgBox("Estas seguro de querer eliminar el valor: " & LV2.SelectedItem.SubItems(1) & " ?", vbQuestion + vbYesNo, "Advertencia") = vbYes Then
Dim regedit As Object
Set regedit = CreateObject("Wscript.Shell")
regedit.regdelete (LV2.SelectedItem.SubItems(3) & "\" & LV2.SelectedItem.SubItems(1))
Call lblregistro_Click
Set regedit = Nothing
End If
End If
error:
End Sub
Private Sub mnuinformacion_Click()
On Error GoTo error
If LV.SelectedItem <> "" Then
Dim atributo As Long, atributos As String
atributo = GetAttr(LV.SelectedItem.SubItems(1))
If atributo And vbReadOnly Then atributos = atributos & " R -"
If atributo And vbHidden Then atributos = atributos & " H -"
If atributo And vbSystem Then atributos = atributos & " S -"
If atributo And vbDirectory Then atributos = atributos & " D"
atributos = Trim(atributos)
If InStr(Len(atributos) - 1, atributos, "-") Then atributos = Left(atributos, Len(atributos) - 1)
If atributo And vbDirectory Then
MsgBox "Nombre: " & LV.SelectedItem & vbCrLf & vbCrLf & "Ruta: " & LV.SelectedItem.SubItems(1) & vbCrLf & vbCrLf & "Atributos: " & atributos, , "Informacion"
Else
MsgBox "Nombre: " & LV.SelectedItem & vbCrLf & vbCrLf & "Ruta: " & LV.SelectedItem.SubItems(1) & vbCrLf & vbCrLf & "Atributos: " & atributos & vbCrLf & vbCrLf & "Tamaño: " & FileLen(LV.SelectedItem.SubItems(1)) / 1024 & " MBytes", , "Informacion"
End If
End If
error:
End Sub
Private Sub mnuinformacionreg_Click()
On Error GoTo error
If LV2.SelectedItem <> "" Then
MsgBox "Descripcion: " & LV2.SelectedItem & vbCrLf & vbCrLf & "Ruta: " & LV2.SelectedItem.SubItems(3) & vbCrLf & vbCrLf & "Nombre: " & LV2.SelectedItem.SubItems(1) & vbCrLf & vbCrLf & "Valor: " & LV2.SelectedItem.SubItems(2)
End If
error:
End Sub
Private Sub mnuinfoservice_Click()
On Error GoTo error
If LV3.SelectedItem.SubItems(1) <> "" Then
MsgBox "Nombre: " & LV3.SelectedItem.SubItems(1) & vbCrLf & vbCrLf & _
"Nombre del Servicio: " & LV3.SelectedItem.SubItems(4) & vbCrLf & vbCrLf & _
"Estado: " & LV3.SelectedItem.SubItems(3) & vbCrLf & vbCrLf & _
"____________________________________________________" & vbCrLf & _
"Descripcion: " & LV3.SelectedItem.SubItems(2)
End If
error:
End Sub
Private Sub mnudetenerservice_Click()
On Error GoTo error
Dim wmi As Object
Dim sentencia As Object
Dim servicio As Object
If LV3.SelectedItem.SubItems(1) <> "" Then
Screen.MousePointer = vbHourglass
Set wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set sentencia = wmi.ExecQuery("Select * from Win32_Service Where Name ='" & LV3.SelectedItem.SubItems(1) & "'")
For Each servicio In sentencia
servicio.stopservice
MsgBox "Se Detuvo el Servicio " & LV3.SelectedItem.SubItems(1), vbInformation
Next
Call lblservicios_Click
Screen.MousePointer = vbNormal
End If
error:
End Sub
Private Sub mnuiniciarservice_Click()
On Error GoTo error
Dim wmi As Object
Dim sentencia As Object
Dim servicio As Object
If LV3.SelectedItem.SubItems(1) <> "" Then
Screen.MousePointer = vbHourglass
Set wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set sentencia = wmi.ExecQuery("Select * from Win32_Service Where Name ='" & LV3.SelectedItem.SubItems(1) & "'")
For Each servicio In sentencia
servicio.startservice
MsgBox "Se Inicio el Servicio " & LV3.SelectedItem.SubItems(1), vbInformation
Next
Call lblservicios_Click
Screen.MousePointer = vbNormal
End If
error:
End Sub
Autor
En línea
pero eso no quita que cualquier malware por ejemplo haga una lista de claves del registro o que liste los procesos del sistema, y por eso puede ser que tu codigo se asemeje mucho a un codigo de un malware.
