elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: AIO elhacker.NET 2021 Compilación herramientas análisis y desinfección malware


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Problema al leer un .txt que se modifica constantemente
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 [2] Ir Abajo Respuesta Imprimir
Autor Tema: Problema al leer un .txt que se modifica constantemente  (Leído 5,847 veces)
farlaine23

Desconectado Desconectado

Mensajes: 10


Ver Perfil
Re: Problema al leer un .txt que se modifica constantemente
« Respuesta #10 en: 21 Noviembre 2011, 00:16 am »

Hola:
He creado ya el servidor,el cual lee los datos de un .txt,asi que ya tengo la mitad del trabajo hecho.
Ahora quiero saber si me podeis ayudar a enviar esos datos directamente al servidor,sin tener que tener ese paso del .txt intermedio


En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: Problema al leer un .txt que se modifica constantemente
« Respuesta #11 en: 21 Noviembre 2011, 01:50 am »

.
Mira mas o menos seria algo asi... Solo arme 3 microclientes de PRUEBA que realizar acciones de escritura en un archivo llamada "c:\BDD.txt" las demas acciones serán ya cosa tuya.

Nesesitas
5 Controles Winsock

1 llamado wsSrv sin index
1 llamado wsCon con index = 0
3 winsock llamados Winsock1, Winsock2 y Winsock3

Código:

Option Explicit

Private Type t
    lSizeData   As Long 'Currency
    lCountPages As Long
    lStep       As Long
    bRead       As Long
End Type

Private Enum SockState
    sckClosed = 0
    sckOpen
    sckListening
    sckConnectionPending
    sckResolvingHost
    sckHostResolved
    sckConnecting
    sckConnected
    sckClosing
    sckError
End Enum

Private collectionSockets() As t

Public Function max(ByVal l1 As Long, ByVal l2 As Long) As Long
    If l1 > l2 Then
        max = l1
        Exit Function
    End If
    max = l2
End Function

Public Function getIndexSocket(ByRef osck As Object) As Integer
Dim Index                   As Integer
Dim SockSt                  As SockState
    getIndexSocket = -1
    For Index = osck.lbound To osck.UBound
        With osck(Index)
            SockSt = .State
            If SockSt = sckClosed Or SockSt = sckListening Or SockSt = sckClosing Then
                'If SockSt = sckClosed Or SockSt = sckListening Or SockSt = sckClosing Or SockSt = sckError Then    '   //  Optativo
                getIndexSocket = Index
                Exit For
            End If
        End With
    Next
End Function
 
Public Function acceptConection(ByRef osck As Object, ByVal requestID As Long) As Long
Dim i             As Integer
    i = getIndexSocket(osck)
    If i = -1 Then
        i = osck.UBound + 1
        Load osck(i)
    End If
    osck(i).Close  ' // Poner Close en lugar de CloseSck   si se usa el OCX WindSock de M$.
    osck(i).Accept requestID
    acceptConection = i
End Function

Private Sub Form_Load()
    With wsSrv
        .Close
        .LocalPort = 456
        .Listen
    End With
    Open "c:\BDD.txt" For Binary As 1
   
    Winsock1.Connect "127.0.0.1", 456
    Winsock2.Connect "127.0.0.1", 456
    Winsock3.Connect "127.0.0.1", 456
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Close 1
End Sub

'   //  Pequeño Cliente 1...
Private Sub Winsock1_Connect()
Dim lAux As Long
Const NAME As String = "Miguel agel ortega avila"
    lAux = 2
    Winsock1.SendData lAux
    lAux = Len(NAME)
    Winsock1.SendData lAux
    Winsock1.SendData NAME
   
'   //  El protocolo seria:
'   *   4 bytes para decirle que hacer al Servidor.
'   *   4 bytes para decirle la longitud de los datos a enviar (segun el caso anterior).
'   *   Paquete de Bytes a enviar.
'   *   Termina.
End Sub

'   //  Pequeño Cliente 2...
Private Sub Winsock2_Connect()
Dim lAux As Long
Const NAME As String = vbCrLf & "No programe las acciones de lectura para el archivo debido a que no tengo mucho tiempo."
    lAux = 2
    Winsock2.SendData lAux
    lAux = Len(NAME)
    Winsock2.SendData lAux
    Winsock2.SendData NAME
   
'   //  El protocolo seria:
'   *   4 bytes para decirle que hacer al Servidor.
'   *   4 bytes para decirle la longitud de los datos a enviar (segun el caso anterior).
'   *   Paquete de Bytes a enviar.
'   *   Termina.
End Sub

'   //  Pequeño Cliente 3...
Private Sub Winsock3_Connect()
Dim lAux As Long
Const NAME As String = vbCrLf & "Solo falta aplicar Adecuadamente la teoria FIFO, con pocos clientes esto ira adecuadamente."
    lAux = 2
    Winsock3.SendData lAux
    lAux = Len(NAME)
    Winsock3.SendData lAux
    Winsock3.SendData NAME
   
'   //  El protocolo seria:
'   *   4 bytes para decirle que hacer al Servidor.
'   *   4 bytes para decirle la longitud de los datos a enviar (segun el caso anterior).
'   *   Paquete de Bytes a enviar.
'   *   Termina.
End Sub

'   //  Fin del pequeño Cliente...
Private Sub wsCon_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim bData()     As Byte
Dim lSize       As Long

    Do
        Select Case collectionSockets(Index).lStep
            Case 0
                lSize = 4       '   //  Flags.
                collectionSockets(Index).lCountPages = 0
               
            Case 1
                lSize = 4       '   //  Size of Data
                collectionSockets(Index).lCountPages = 0
               
            Case 2
                lSize = min(1024, bytesTotal)    '   //  Size of Data leemos de a 1kB...
                collectionSockets(Index).lCountPages = 0
               
            Case Else
        End Select
       
        ReDim bData(0 To (lSize - 1))
       
        wsCon(Index).GetData bData, vbByte, lSize
        bytesTotal = (bytesTotal - lSize)
       
        Select Case collectionSockets(Index).lStep
            Case 0  '   //  Tipo de accion
                Select Case byteToLong(bData)
                    Case 1
                        collectionSockets(Index).bRead = True
                    Case 2
                        collectionSockets(Index).bRead = False
                    Case Else
                        collectionSockets(Index).lStep = 0
                        Exit Do
                End Select
                collectionSockets(Index).lStep = 1
            Case 1  '   //  Longitud de los datos.
                If collectionSockets(Index).bRead Then
                    '   //  No lo programare...
                Else
                   collectionSockets(Index).lSizeData = byteToLong(bData)
                End If
                collectionSockets(Index).lStep = 2
               
            Case 2  '   //  Reseccion/Envio de los datos.
                collectionSockets(Index).lSizeData = (collectionSockets(Index).lSizeData - lSize)
                Put 1, , bData
        End Select
       
    Loop While (bytesTotal > &H0) Or (collectionSockets(Index).lSizeData > &H0)
End Sub


Private Sub wsSrv_ConnectionRequest(ByVal requestID As Long)
Dim i   As Long
Dim a As Winsock

    i = acceptConection(wsCon, requestID)
    ReDim Preserve collectionSockets(max(i, wsCon.UBound))
   
End Sub



Public Function min(ByVal l1 As Long, ByVal l2 As Long) As Long
    If l1 < l2 Then
        min = l1
        Exit Function
    End If
    min = l2
End Function

Public Function byteToLong(ByRef bData() As Byte) As Long
    If (bData(3) And &H80000000) Then byteToLong = byteToLong Or &H80000000
    byteToLong = (bData(3) And &H7F) * &H1000000
    byteToLong = byteToLong Or (bData(2) * &H10000)
    byteToLong = byteToLong Or (bData(1) * &H100)
    byteToLong = byteToLong Or bData(0)
End Function


Dulces Lunas!¡.


En línea

The Dark Shadow is my passion.
Páginas: 1 [2] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
El Mouse Constantemente Clikc
Programación Visual Basic
nahueld 7 2,469 Último mensaje 17 Abril 2008, 22:41 pm
por nahueld
Problema con virtual box, se reinicia constantemente
Software
neutraleye 3 4,090 Último mensaje 15 Abril 2017, 17:53 pm
por neutraleye
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines