Mensajes

hola tienes que poner un winsock escuchando en el puerto 25 y ve mirando como van llegando los datos, es cuestion de ir estudiando el protocolo, yo hasta ahora lo hice con http (puerto 80) con Ftp(puerto 21) y pude crear ambos servidores

Saludos

si pusiste todos los datos bien,puede que el firewall no te deje abrir la conexion, prova desavilitarlo.

te dejo otro ejemplo con una cuenta

Código [Seleccionar] Expandir


Dim hOpen As Long, hConnection As Long, bRet As Long, Refrescar As Boolean
Option Explicit
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
      ByVal lpszRemoteFile As String, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
     
     
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
      ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
     

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

' User agent constant.
Private Const scUserAgent = "vb wininet"

' Use registry access settings.
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_FLAG_PASSIVE = &H8000000

' Opens a HTTP session for a given site.
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
               
' Number of the TCP/IP port on the server to connect to.
Private Const INTERNET_OPTION_USERNAME = 28
Private Const INTERNET_OPTION_PASSWORD = 29
Private Const INTERNET_OPTION_PROXY_USERNAME = 43
Private Const INTERNET_FLAG_RELOAD = &H80000000
' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1

' Closes a single Internet handle or a subtree of Internet handles.
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer


Sub Command1_Click()
'Guardamos en App.Path & "\" & "Prueva.txt"
Close #1
Open App.Path & "\" & "Prueva.txt" For Output As #1
Print #1, Text1.Text
Close #1
Info "Guardando en el servidor..."
'App.Path & "\" & "Prueva.txt" es el archivo selecionado y Prueva.txt es el nombre con que lo guardamos
bRet = FtpPutFile(hConnection, App.Path & "\" & "Prueva.txt", "Prueva.txt", FTP_TRANSFER_TYPE_ASCII, 0)
If bRet <> 0 Then Info "Proceso terminado corectamente" Else Info "Error": Exit Sub
End Sub
Sub Info(Mensage As String)
Label1.Caption = Mensage
Label1.Refresh
End Sub
Sub Command2_Click()
Dim file_data As String
Info "Descargando..."
bRet = FtpGetFile(hConnection, "Prueva.txt", App.Path & "\" & "Prueva.txt", False, _
        INTERNET_FLAG_RELOAD, FTP_TRANSFER_TYPE_ASCII, 0)
If bRet <> 0 Then Info "Archivo descargado correctamente" Else Info "Error": Exit Sub
Text1.Text = ""
Close #1
Open App.Path & "\" & "Prueva.txt" For Input As #1
While Not EOF(1)
Line Input #1, file_data
Text1.Text = Text1.Text & file_data & vbCrLf
Wend
Close #1
End Sub

Private Sub Command3_Click()
If Command3.Caption = "Conectar" Then
Conectar
Else
If hConnection <> 0 Then InternetCloseHandle (hConnection)
Command3.Caption = "Conectar"
Command1.Enabled = False
Command2.Enabled = False
Info "Coneción cerrada"
End If
End Sub

Sub Form_Load()
Text1.Text = ""
Command1.Caption = "Subir al Servidor"
Command2.Caption = "Descargar del Servidor"
Command3.Caption = "Conectar"
Command1.Enabled = False
Command2.Enabled = False
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen <> 0 Then Info "Iniciado correctamente" Else Info "Error"
Me.Caption = "http://celularchat.unlugar.com/includes/Prueva.txt"
End Sub

Sub Form_Unload(Cancel As Integer)
If hConnection <> 0 Then InternetCloseHandle (hConnection)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
End Sub

Sub Conectar()
Dim Servevidor As String, Usuario As String, Contraseña As String, Carpeta As String
'----------------------------------------
Servevidor = "celularchat.unlugar.com"
Usuario = "ftp-celularchat.unlugar.com"
Contraseña = "ramonramon"
Carpeta = "/includes"
'----------------------------------------
Info "Conectando..."
'hacemos la conexion
hConnection = InternetConnect(hOpen, Servevidor, INTERNET_INVALID_PORT_NUMBER, _
Usuario, Contraseña, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
If hConnection <> 0 Then Info "Buscando Directorio" Else Info "Error": Exit Sub
'selecionamos "/includes" que es la carpeta en el servidor donde guardo el archivo
bRet = FtpSetCurrentDirectory(hConnection, Carpeta)
If bRet <> 0 Then Info "conexión exitosa!!!" Else Info "Error": Exit Sub
Command1.Enabled = True
Command2.Enabled = True
Command3.Caption = "Desconectar"
End Sub
[code]

tres botones, un textbox multiline, y un label

Saludos
[/code]

entonoses en que quedo lo de la dll se puede o no en visual, de  que estamos ablando de una dll no activeX?? (esto es lo feo de solo saber programar en visual b desconoces todas estas cosas)

Saludos

Hola Hendrix esta muy interesante el code, pero no entiendo mucho su finalidad, que se supone aria la dll dentro del notepad?, puedes poner un ejemplo de como se ejecuta una funcion de la dll de esta forma?

Saludos

bueno yo por mi parte aporto un ejemplo de como enviar archivos del tamaño que se les de la gana, enviandolo en trosos y con progressbar, es un ejemplo Basico pero con todas las validaciones para evitar error (poreso algo extenso), ojo yo pongo una forma en la que se envian paquetes y se espera una respuesta , pero hay varias formas de hacer esto, y quizas mas puntuales, pero en fin a mi me gusta de esta 

http://ar.geocities.com/leandroascierto/Winsock_Envio_de_Archivos.zip

Saludos

hola si queres mover una ventana dos opciones

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Sub Form_Load()
MoveWindow Me.hwnd, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, True
'o desde visual
'Me.Move 0, 0, Screen.Width, Screen.Height
End Sub

pero bien para tapar la barra es como te dice EON

hola si los modulos no te funcionan cuando envias archivos grandes es porque lo tenenes que enviar por paquetes, aproximadamente de 4 kb , no todo de un sopeton porque eso satura el buffer y fijate que si funciona bien

Saludos

yo boy mas con lo que dice EON yo hice el mio asi con las caracteristicas de un joiner y asi siempre queda con su icono y no se ve tan mamon el archivo infectado.


----------   Huesped..
----------    Virus..
-----------   "XD"         **marca virica**


al ejecutar el archivo infectado este se desconpone y crea solamente el huesped mientras que el archivo original sigue infectado.
XD

y como se supone que se ejecuta el virus si esta escrito despues del huesped, me parece que estas equivocado.

hola si les gusta algo un poquito mas rebuscado

en un modulo

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2&
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Posicion As Integer
Public m_Form As Form
Public m_FrmHeight As Long
Public m_Direccion As Boolean
Public m_Velosidad As Integer

Public Sub SlideForm(FRM As Form, Mostrar As Boolean, LEVEL As Byte, Optional velocidad As Integer = 50)
Dim Tamaño As Integer, hwnd As Long, res As Long, Rec As RECT

Set m_Form = FRM
m_Direccion = Mostrar
m_FrmHeight = FRM.Height
m_Velosidad = velocidad
hwnd = FindWindow("Shell_TrayWnd", "")
If hwnd > 0 Then
res = GetWindowRect(hwnd, Rec)
If res > 0 Then
Tamaño = CStr(Rec.Bottom - Rec.Top) * Screen.TwipsPerPixelY
If Rec.Left <= 0 And Rec.Top > 0 Then Posicion = 1
If Rec.Left > 0 And Rec.Top <= 0 Then Posicion = 2: Tamaño = (Rec.Right - Rec.Left) * 15
If Rec.Left <= 0 And Rec.Top <= 0 And Rec.Right < 600 Then Posicion = 3: Tamaño = Rec.Right * 15
If Rec.Left <= 0 And Rec.Top <= 0 And Rec.Right > 600 Then Posicion = 4
End If
Else
Posicion = 1
End If


If m_Direccion = True Then
FRM.Height = 0
Select Case Posicion
Case 1
FRM.Move Screen.Width - FRM.Width, Screen.Height - FRM.Height - Tamaño
Case 2
FRM.Move Screen.Width - FRM.Width - Tamaño, Screen.Height - FRM.Height
Case 3
FRM.Move Tamaño, Screen.Height - FRM.Height
Case 4
FRM.Move Screen.Width - FRM.Width, Tamaño
End Select
End If

res = SetWindowPos(FRM.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
Call SetWindowLong(FRM.hwnd, GWL_EXSTYLE, GetWindowLong(FRM.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(FRM.hwnd, 0, LEVEL, LWA_ALPHA)
SetTimer FRM.hwnd, 0, 1, AddressOf TimerProc

End Sub
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
If m_Direccion = True Then
    m_Form.Height = m_Form.Height + m_Velosidad
    If Not Posicion = 4 Then m_Form.Top = m_Form.Top - m_Velosidad
    If m_Form.Height >= m_FrmHeight Then KillTimer m_Form.hwnd, 0
Else
    If m_Form.Height <= 520 Then
        KillTimer m_Form.hwnd, 0
        Unload m_Form
    Else
        m_Form.Height = m_Form.Height - m_Velosidad
        If Not Posicion = 4 Then m_Form.Top = m_Form.Top + m_Velosidad
    End If
End If
End Sub



y en el proyecto con dos formularios y en el form1 con dos botones

Código [Seleccionar] Expandir


Private Sub Command1_Click()
'200 es valor de transparencia si no se quiere poner 255
'100 es la velocidad en estiarse, mientras mas alto el valor mas rapido
SlideForm Form2, True, 200, 100
End Sub

'para ocultarla
Private Sub Command2_Click()
SlideForm Form2, False, 200, 100
End Sub


pd: tengo otro pero para usar multi hilo si les hace falta avisan
Saludos

[(el cual creo que es incorrecto, osea para obtenerlo de otra aplicacion, este solo me devuelve el mio no?)]

si quieres interceptar mensajes de otras aplicaciones tendras que usar un hook, como es logico a tu formulario solo son enviados mensajes de lo que pasa dentro de el.

Hola bien e provado con hook, pero no consigo interceptar nada, lo unico que logro es colgar el otro programa, nose quizas lo estoy haciendo mal, si bien hay que usar el hInstance y el ThreadID, el
hInstance lo consegui de esta manera

hInstance =GetWindowLong(ElHwnd, GWL_HINSTANCE)
y
Thread = GetCurrentThreadId() (el cual creo que es incorrecto, osea para obtenerlo de otra aplicacion, este solo me devuelve el mio no?)

ahora suponiendo que creo una aplicacion y copio su App.hInstance Y App.ThreadID y los paso como parametros, como te decia se cuelga el programa , no el mio sino el que intento interceptar

asi es como lo estoy haciendo (El ejemplo esta con la propia aplicacion la cual si funciona pero aver si nos echas una mano para usarlo con otra), en este caso es para capturar los mensajes del teclado

En un modulo

Código [Seleccionar] Expandir


Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Const GWL_HINSTANCE = (-6)

Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public hHook As Long
Public Function HookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Debug.Print idHook, wParam, lParam
       
    HookProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)

End Function


en un formulario

Código [Seleccionar] Expandir


Private Const WH_MSGFILTER As Long = -1
Private Const WH_MIN As Long = -1
Private Const WH_MINHOOK As Long = WH_MIN
Private Const WH_JOURNALRECORD As Long = 0
Private Const WH_JOURNALPLAYBACK As Long = 1
Private Const WH_KEYBOARD As Long = 2
Private Const WH_GETMESSAGE As Long = 3
Private Const WH_CALLWNDPROC As Long = 4
Private Const WH_CBT As Long = 5
Private Const WH_SYSMSGFILTER As Long = 6
Private Const WH_MOUSE As Long = 7
Private Const WH_HARDWARE As Long = 8
Private Const WH_DEBUG As Long = 9
Private Const WH_SHELL As Long = 10
Private Const WH_FOREGROUNDIDLE As Long = 11
Private Const WH_MAX As Long = 11
Private Const WH_MAXHOOK As Long = WH_MAX
Private Const WH_CALLWNDPROCRET As Long = 12
Private Const WH_KEYBOARD_LL As Long = 13
Private Const WH_MOUSE_LL As Long = 14

Private Sub Form_Load()

    'hInst = App.hInstance
    hInst = GetWindowLong(Me.hwnd, GWL_HINSTANCE)
    'Thread = App.ThreadID
    Thread = GetCurrentThreadId()

hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf HookProc, hInst, Thread)

End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End Sub


Espero tu respuesta, Saludos