Mensajes

buenas se que con visual b es imposible pero quizas aya alguna forma con apis, para obtener el retorno, yo conozco una forma pero esta me muestra los resultados finales pero no todo el proceso, osea si yo pongo en el CMD netstat -a -b me muestra todo el proceso a medidas que se va ejecutando, pues el modulo que tengo llo solo me muestra cuando todo el proceso finalizo.

Bien alguien tiene algun modulo o clase para mostrar toda la operacion en proceso.


Saludos

che muy bueno, yo avia provado varias formas y no avia podido dar de como descargar el .flv, ahora lo estuve testiando y bueno pude hacer algunas modificaciones para no depender del webbrowser, estoy utilizando winsock mas un ocx para vajar el archivo , no es que sean menos pasos pero me parece un poco mas profesional que el webbrowser, de todas formas me gusto mucho todo.
aproposito supiste como convertir el video de flv a otro formato. yo lo que busco es pasarlo a .3gp o en su defecto a .mpeg algun formato que reproduscan los celulares, mi idea es poder hacer estos paso y luego por ejemplo ingresar mi direccion de ip en el browser del celular + el nombre del video de youtube y me lo descargue en mi celular en formato .3gp

ya casi esta todo solo faltaria ver como poder hacer la convercion del formato flv a 3gp

Hola no puedes acceder a esa propiedad hasta que el documento no se descargue por completo, de hay tal error. tenes que asegurarte de que el documento se haya descargado por eso te digo que lo pongas en el evento del WebBrowser1_DocumentComplete

hola yo la verdad no pude captar como obtener la direccion del .flv para descargarlo lo que intente es convertir un .flv a .avi o .3gp y utilize unas aplicaciones de consola pueden provar con estas

engine.exe
ffmpeg.exe
MMConverterCon.exe

ejemplo

C:\MMConverterCon.exe -i C:\VideoFlv.flv

bueno en la web hay mucha info para poder usar algunas de estas aplicaciones yo tambien queria hacer un convertidor de videos de youtuve a 3gp pero bueno me fueron todos los intentos mal asi que lo deje, pero si alguno tiene alguna data importante seria bueno compartirla

hola si ahora se entiende mejor, siempre es mejor especificar lo mejor posible todo, cuando se formula una pregunta.

bien me fije y la forma de saber si se cargo es mirando el tamaño de la imagen (FileSize)

lo que decia freeze, no funcionaria porque el codigo de fuente siempre va a ser igual por mas que la imagen no se cargue.

te paso un ejemplo con una pagina que por lo que veo no carga dos imagenes la 3 y la 7 en tal caso remplaza las imagenes por otra, y tambien te puse un ejemplo de como obtener otros datos

Código [Seleccionar] Expandir


Private Sub Form_Load()
WebBrowser1.Navigate "http://www.wikilearning.com/mi_primera_aplicacion_cliente-wkccp-7936-5.htm"

End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

With WebBrowser1.Document.images
    For i = 0 To .length - 1
        Debug.Print "-------- Imagen " & i & "-----------"
        Debug.Print "Ancho: " & .Item(i).Width 'Ancho
        Debug.Print "Alto: " & .Item(i).Height 'Alto
        Debug.Print "Tamaño: " & .Item(i).FileSize 'Tamaño
        Debug.Print "Texto alternativo: " & .Item(i).alt 'Texto alternativo
        Debug.Print "Direccion: " & .Item(i).src 'Direccion de la imagen
        Debug.Print "-------------------------------------" & vbCrLf
   
        If .Item(i).FileSize = -1 Then
            MsgBox "La Imagen " & i & " no se cargo y sera remplzada por otra"
            .Item(i).src = "C:\WINDOWS\A pescar.bmp"
        End If
    Next
End With

End Sub


Saludos

buenas aca les dejo el source

http://www.recursosvisualbasic.com.ar/htm/utilidades-codigo-fuente/spyuseragent.htm

Saludos

hola tenes que utilizar javascript para determinarlo. para ello tenes que ingresar a las propiedades del Document del webrowser

Código [Seleccionar] Expandir


Dim LaImagen As String
Private Sub Form_Load()
Me.Show
LaImagen = "D:\Mdis documentos\Image2.png"
'WebBrowser1.Navigate "about:<img src='" & LaImagen & "'  onerror=" & Chr(34) & "alert('La imagen no se cargo')" & Chr(34) & " /> "
WebBrowser1.Navigate "about:<img src='" & LaImagen & "' id=1 onerror=" & chr34 & "this.id='Error'" & chr34 & " /> "
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If WebBrowser1.Document.getelementbyid(1) Is Nothing Then
MsgBox "La Imange no se cargo"
End If
End Sub


Espero que sea eso a lo que te referias, sino explicate mejor

[any]

en el api guide figura como any, pero en fin no tiene mucha importancia si no le vas a pasar ningun parmetro, osea lo podes declarar como integer currency etc, ahora si bien si le vas a pasar el parametro tienes que declararlo como OVERLAPPED o  en el ultimo de los caso como any,

El tipo OVERLAPPED esta compuesto de la siguiente manera

Private Type OVERLAPPED
   ternal As Long
   ternalHigh As Long
   offset As Long
   OffsetHigh As Long
   hEvent As Long
End Type


y por si no lo tienes te pongo tres ejemplos del api guide

Ejemplo 1

Código [Seleccionar] Expandir


Const MOVEFILE_REPLACE_EXISTING = &H1
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim sSave As String, hOrgFile As Long, hNewFile As Long, bBytes() As Byte
    Dim sTemp As String, nSize As Long, Ret As Long
    'Ask for a new volume label
    sSave = InputBox("Please enter a new volume label for drive C:\" + vbCrLf + " (if you don't want to change it, leave the textbox blank)")
    If sSave <> "" Then
        SetVolumeLabel "C:\", sSave
    End If

    'Create a buffer
    sTemp = String(260, 0)
    'Get a temporary filename
    GetTempFileName "C:\", "KPD", 0, sTemp
    'Remove all the unnecessary chr$(0)'s
    sTemp = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
    'Set the file attributes
    SetFileAttributes sTemp, FILE_ATTRIBUTE_TEMPORARY
    'Open the files
    hNewFile = CreateFile(sTemp, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    hOrgFile = CreateFile("c:\config.sys", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)

    'Get the file size
    nSize = GetFileSize(hOrgFile, 0)
    'Set the file pointer
    SetFilePointer hOrgFile, Int(nSize / 2), 0, FILE_BEGIN
    'Create an array of bytes
    ReDim bBytes(1 To nSize - Int(nSize / 2)) As Byte
    'Read from the file
    ReadFile hOrgFile, bBytes(1), UBound(bBytes), Ret, ByVal 0&
    'Check for errors
    If Ret <> UBound(bBytes) Then MsgBox "Error reading file ..."

    'Write to the file
    WriteFile hNewFile, bBytes(1), UBound(bBytes), Ret, ByVal 0&
    'Check for errors
    If Ret <> UBound(bBytes) Then MsgBox "Error writing file ..."

    'Close the files
    CloseHandle hOrgFile
    CloseHandle hNewFile

    'Move the file
    MoveFileEx sTemp, "C:\KPDTEST.TST", MOVEFILE_REPLACE_EXISTING
    'Delete the file
    DeleteFile "C:\KPDTEST.TST"
    Unload Me
End Sub


Ejemplo 2

Código [Seleccionar] Expandir


'in a module
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function SetTapeParameters Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, lpTapeInformation As Any) As Long
Public Declare Function PrepareTape Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, ByVal bimmediate As Long) As Long
Public Declare Function SetTapePosition Lib "kernel32" (ByVal hDevice As Long, ByVal dwPositionMethod As Long, ByVal dwPartition As Long, ByVal dwOffsetLow As Long, ByVal dwOffsetHigh As Long, ByVal bimmediate As Long) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function GetTapeParameters Lib "kernel32" (ByVal hDevice As Long, ByVal dwOperation As Long, lpdwSize As Long, lpTapeInformation As Any) As Long
Public Declare Function GetTapePosition Lib "kernel32" (ByVal hDevice As Long, ByVal dwPositionType As Long, lpdwPartition As Long, lpdwOffsetLow As Long, lpdwOffsetHigh As Long) As Long
Public Declare Function GetTapeStatus Lib "kernel32" (ByVal hDevice As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Const GET_TAPE_DRIVE_INFORMATION = 1
Public Const GET_TAPE_MEDIA_INFORMATION = 0
Public Const SET_TAPE_DRIVE_INFORMATION = 1
Public Const SET_TAPE_MEDIA_INFORMATION = 0
Public Type TAPE_GET_MEDIA_PARAMETERS
    Capacity As Long
    Remaining As Long
    BlockSize As Long
    PartitionCount As Long
    WriteProtected As Boolean
End Type
Public Type TAPE_GET_DRIVE_PARAMETERS
    ECC As Boolean
    Compression As Boolean
    DataPadding As Boolean
    ReportSetmarks As Boolean
    DefaultBlockSize As Long
    MaximumBlockSize As Long
    MinimumBlockSize As Long
    MaximumPartitionCount As Long
    FeaturesLow As Long
    FeaturesHigh As Long
    EOTWarningZoneSize As Long
End Type
Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
' following taken from Winnt.h
'
' IOCTL_TAPE_ERASE definitions
'
Public Const TAPE_ERASE_SHORT = 0
Public Const TAPE_ERASE_LONG = 1
Public Type TAPE_ERASE
    Type As Long
    Immediate As Boolean
' TAPE_ERASE, *PTAPE_ERASE;
End Type
'
' IOCTL_TAPE_PREPARE definitions
'
Public Const TAPE_LOAD = 0
Public Const TAPE_UNLOAD = 1
Public Const TAPE_TENSION = 2
Public Const TAPE_LOCK = 3
Public Const TAPE_UNLOCK = 4
Public Const TAPE_FORMAT = 5
Public Type TAPE_PREPARE
    Operation As Long
    Immediate As Boolean
' TAPE_PREPARE, *PTAPE_PREPARE;
End Type
'
' IOCTL_TAPE_WRITE_MARKS definitions
'
Public Const TAPE_SETMARKS = 0
Public Const TAPE_FILEMARKS = 1
Public Const TAPE_SHORT_FILEMARKS = 2
Public Const TAPE_LONG_FILEMARKS = 3
Public Type TAPE_WRITE_MARKS
    Type As Long
    Count As Long
    Immediate As Boolean
' TAPE_WRITE_MARKS, *PTAPE_WRITE_MARKS;
End Type
'
' IOCTL_TAPE_GET_POSITION definitions
'

Public Const TAPE_ABSOLUTE_POSITION = 0
Public Const TAPE_LOGICAL_POSITION = 1
Public Const TAPE_PSEUDO_LOGICAL_POSITION = 2
Public Type TAPE_GET_POSITION
    Type As Long
    Partition As Long
    offset As Long
' TAPE_GET_POSITION, *PTAPE_GET_POSITION;
End Type
'
' IOCTL_TAPE_SET_POSITION definitions
'
Public Const TAPE_REWIND = 0&
Public Const TAPE_ABSOLUTE_BLOCK = 1&
Public Const TAPE_LOGICAL_BLOCK = 2&
Public Const TAPE_PSEUDO_LOGICAL_BLOCK = 3&
Public Const TAPE_SPACE_END_OF_DATA = 4&
Public Const TAPE_SPACE_RELATIVE_BLOCKS = 5&
Public Const TAPE_SPACE_FILEMARKS = 6&
Public Const TAPE_SPACE_SEQUENTIAL_FMKS = 7&
Public Const TAPE_SPACE_SETMARKS = 8&
Public Const TAPE_SPACE_SEQUENTIAL_SMKS = 9&
Public Type TAPE_SET_POSITION
    Method As Long
    Partition As Long
    offset As Long
    Immediate As Boolean
' TAPE_SET_POSITION, *PTAPE_SET_POSITION;
End Type
'
' IOCTL_TAPE_GET_DRIVE_PARAMS definitions
'
'
' Definitions for FeaturesLow parameter
'
Public Const TAPE_DRIVE_FIXED = &H1
Public Const TAPE_DRIVE_SELECT = &H2
Public Const TAPE_DRIVE_INITIATOR = &H4
Public Const TAPE_DRIVE_ERASE_SHORT = &H10
Public Const TAPE_DRIVE_ERASE_LONG = &H20
Public Const TAPE_DRIVE_ERASE_BOP_ONLY = &H40
Public Const TAPE_DRIVE_ERASE_IMMEDIATE = &H80
Public Const TAPE_DRIVE_TAPE_CAPACITY = &H100
Public Const TAPE_DRIVE_TAPE_REMAINING = &H200
Public Const TAPE_DRIVE_FIXED_BLOCK = &H400
Public Const TAPE_DRIVE_VARIABLE_BLOCK = &H800
Public Const TAPE_DRIVE_WRITE_PROTECT = &H1000
Public Const TAPE_DRIVE_EOT_WZ_SIZE = &H2000
Public Const TAPE_DRIVE_ECC = &H10000
Public Const TAPE_DRIVE_COMPRESSION = &H20000
Public Const TAPE_DRIVE_PADDING = &H40000
Public Const TAPE_DRIVE_REPORT_SMKS = &H80000
Public Const TAPE_DRIVE_GET_ABSOLUTE_BLK = &H100000
Public Const TAPE_DRIVE_GET_LOGICAL_BLK = &H200000
Public Const TAPE_DRIVE_SET_EOT_WZ_SIZE = &H400000
Public Const TAPE_DRIVE_EJECT_MEDIA = &H1000000
Public Const TAPE_DRIVE_CLEAN_REQUESTS = &H2000000
Public Const TAPE_DRIVE_SET_CMP_BOP_ONLY = &H4000000
Public Const TAPE_DRIVE_RESERVED_BIT = &H80000000     'don't use this bit!
'                                              'can't be a low features bit!
'                                              'reserved; high features only
'
' Definitions for FeaturesHigh parameter
'
Public Const TAPE_DRIVE_LOAD_UNLOAD = &H80000001
Public Const TAPE_DRIVE_TENSION = &H80000002
Public Const TAPE_DRIVE_LOCK_UNLOCK = &H80000004
Public Const TAPE_DRIVE_REWIND_IMMEDIATE = &H80000008
Public Const TAPE_DRIVE_SET_BLOCK_SIZE = &H80000010
Public Const TAPE_DRIVE_LOAD_UNLD_IMMED = &H80000020
Public Const TAPE_DRIVE_TENSION_IMMED = &H80000040
Public Const TAPE_DRIVE_LOCK_UNLK_IMMED = &H80000080
Public Const TAPE_DRIVE_SET_ECC = &H80000100
Public Const TAPE_DRIVE_SET_COMPRESSION = &H80000200
Public Const TAPE_DRIVE_SET_PADDING = &H80000400
Public Const TAPE_DRIVE_SET_REPORT_SMKS = &H80000800
Public Const TAPE_DRIVE_ABSOLUTE_BLK = &H80001000
Public Const TAPE_DRIVE_ABS_BLK_IMMED = &H80002000
Public Const TAPE_DRIVE_LOGICAL_BLK = &H80004000
Public Const TAPE_DRIVE_LOG_BLK_IMMED = &H80008000
Public Const TAPE_DRIVE_END_OF_DATA = &H80010000
Public Const TAPE_DRIVE_RELATIVE_BLKS = &H80020000
Public Const TAPE_DRIVE_FILEMARKS = &H80040000
Public Const TAPE_DRIVE_SEQUENTIAL_FMKS = &H80080000
Public Const TAPE_DRIVE_SETMARKS = &H80100000
Public Const TAPE_DRIVE_SEQUENTIAL_SMKS = &H80200000
Public Const TAPE_DRIVE_REVERSE_POSITION = &H80400000
Public Const TAPE_DRIVE_SPACE_IMMEDIATE = &H80800000
Public Const TAPE_DRIVE_WRITE_SETMARKS = &H81000000
Public Const TAPE_DRIVE_WRITE_FILEMARKS = &H82000000
Public Const TAPE_DRIVE_WRITE_SHORT_FMKS = &H84000000
Public Const TAPE_DRIVE_WRITE_LONG_FMKS = &H88000000
Public Const TAPE_DRIVE_WRITE_MARK_IMMED = &H90000000
Public Const TAPE_DRIVE_FORMAT = &HA0000000
Public Const TAPE_DRIVE_FORMAT_IMMEDIATE = &HC0000000
Public Const TAPE_DRIVE_HIGH_FEATURES = &H80000000    'mask for high features flag
'
' IOCTL_TAPE_SET_DRIVE_PARAMETERS definitions
'
Public Type TAPE_SET_DRIVE_PARAMETERS
    ECC As Boolean
    Compression As Boolean
    DataPadding As Boolean
    ReportSetmarks As Boolean
    EOTWarningZoneSize As Boolean
' TAPE_SET_DRIVE_PARAMETERS, *PTAPE_SET_DRIVE_PARAMETERS;
End Type
'
' IOCTL_TAPE_SET_MEDIA_PARAMETERS definitions
'
Public Type TAPE_SET_MEDIA_PARAMETERS
    BlockSize As Long
' TAPE_SET_MEDIA_PARAMETERS, *PTAPE_SET_MEDIA_PARAMETERS;
End Type
'
' IOCTL_TAPE_CREATE_PARTITION definitions
'
Public Const TAPE_FIXED_PARTITIONS = 0&
Public Const TAPE_SELECT_PARTITIONS = 1&
Public Const TAPE_INITIATOR_PARTITIONS = 2&
Public Type TAPE_CREATE_PARTITION
    Method As Boolean
    Count As Boolean
    Size As Boolean
' TAPE_CREATE_PARTITION, *PTAPE_CREATE_PARTITION;
End Type
Public Function ReadNextTapeFile(destfile As String) As String
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'-> This sample was created by Ethan Larson
Dim indata(65536) As Byte
Dim num As Long
Dim tapehandle, diskhandle As Long
Dim secatt As SECURITY_ATTRIBUTES
Dim temp As Long
Dim nbr As Long
Dim nbw As Long
Dim param1 As Long, param2 As Long, param3 As Long
Dim tgdp As TAPE_GET_DRIVE_PARAMETERS
Dim tgmp As TAPE_GET_MEDIA_PARAMETERS
Dim lpdwSize As Long
Dim lpFSH As Long
Dim donereading As Boolean
Dim fileobject, filething, filestream
Dim wrotetofile As Boolean

ReadNextTapeFile = ""

secatt.bInheritHandle = 0&
secatt.lpSecurityDescriptor = 0&
secatt.nLength = 0&

tapehandle = CreateFile("\\.\Tape0", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, secatt, OPEN_EXISTING, 0, 0&)
num = SetTapeParameters(tapehandle, SET_TAPE_MEDIA_INFORMATION, 0) ' variable block length!
num = GetTapeStatus(ByVal tapehandle)

diskhandle = CreateFile(destfile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, secatt, CREATE_ALWAYS, 0, 0&)

donereading = False
wrotetofile = False
While Not donereading
    Erase indata
    num = ReadFile(tapehandle, indata(1), 65536, nbr, ByVal 0&)
    num = GetLastError
    If num <> 0 Then ' place for breakpoint
        j = j
    End If
    If num = 1104 Then ' no data found error
        StatusQuip ("End of data found.")
        ReadNextTapeFile = "End of data"
        donereading = True
    End If
    If Not donereading Then
        If nbr = 0 Then
            donereading = True
            If wrotetofile Then
                wrotetofile = False
                CloseHandle (diskhandle)
                ReadNextTapeFile = "No Error"
            Else
                StatusQuip ("No data written to file.")
                ReadNextTapeFile = "Error"
            End If
        Else
            wrotetofile = True
            num = WriteFile(diskhandle, indata(1), nbr, nbw, ByVal 0&)
            If num = 0 Then
                num = GetLastError
            End If
        End If
    End If
    DoEvents
Wend

CloseHandle (tapehandle)
CloseHandle (diskhandle)

If Not ReadNextTapeFile = "No Error" Then
    Set fileobject = CreateObject("Scripting.FileSystemObject")
    If fileobject.FileExists(destfile) Then
       Set filething = fileobject.GetFile(destfile)
        filething.Delete
    End If
End If

End Function


Ejemplo 3

Código [Seleccionar] Expandir


'Redirects output from console program to textbox.
'Requires two textboxes and one command button.
'Set MultiLine property of Text2 to true.
'
'Original bcx version of this program was made by
' dl <dl@tks.cjb.net>
'VB port was made by Jernej Simoncic <jernej@isg.si>
'Visit Jernejs site at http://www2.arnes.si/~sopjsimo/
'
'Note: don't run plain DOS programs with this example
'under Windows 95,98 and ME, as the program freezes when
'execution of program is finnished.

Option Explicit
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessId As Long
  dwThreadId As Long
End Type

Private Type STARTUPINFO
  cb As Long
  lpReserved As Long
  lpDesktop As Long
  lpTitle As Long
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Byte
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type

Private Type OVERLAPPED
    ternal As Long
    ternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type

Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2

Private Sub Command1_Click()
  Command1.Enabled = False
  Redirect Text1.Text, Text2
  Command1.Enabled = True
End Sub
Private Sub Form_Load()
    Text1.Text = "ping"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If Command1.Enabled = False Then Cancel = True
End Sub

Sub Redirect(cmdLine As String, objTarget As Object)
  Dim i%, t$
  Dim pa As SECURITY_ATTRIBUTES
  Dim pra As SECURITY_ATTRIBUTES
  Dim tra As SECURITY_ATTRIBUTES
  Dim pi As PROCESS_INFORMATION
  Dim sui As STARTUPINFO
  Dim hRead As Long
  Dim hWrite As Long
  Dim bRead As Long
  Dim lpBuffer(1024) As Byte
  pa.nLength = Len(pa)
  pa.lpSecurityDescriptor = 0
  pa.bInheritHandle = True
 
  pra.nLength = Len(pra)
  tra.nLength = Len(tra)

  If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then
    sui.cb = Len(sui)
    GetStartupInfo sui
    sui.hStdOutput = hWrite
    sui.hStdError = hWrite
    sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
    sui.wShowWindow = SW_HIDE
    If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then
      SetWindowText objTarget.hwnd, ""
      Do
        Erase lpBuffer()
        If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then
          SendMessage objTarget.hwnd, EM_SETSEL, -1, 0
          SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0)
          DoEvents
        Else
          CloseHandle pi.hThread
          CloseHandle pi.hProcess
          Exit Do
        End If
        CloseHandle hWrite
      Loop
      CloseHandle hRead
    End If
  End If
End Sub


hola lo que te manda es  la Cabesera de la peticion, la cabesera es divida del cuertpo por dos saltos de carro (vbcrlf), entonces tu tienes que verificar este salto de carro para  saber que termino la cabesera

mira

en el general declaras
Dim Data as string

Código [Seleccionar] Expandir

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim Dato as string


WS.GetData Dato

Data = Data & Dato


If InStr(Data, vbCrLf & vbCrLf) Then 'significa que termino la cabesera

Ret = InStr(Data, "GET /")
If Ret Then
FileRequest = Mid(Data, 6, InStr(Data, "HTTP/1.1" & vbCrLf) - 7)

    If FileRequest = "" Then
        FileRequest = App.Path & "\Index.html"
    Else
        'tu sabras que mandas
    End If
End If

end if

como ves almaceno la variable Dato en Data porque puede que la cabesera no llegue 
entera de una sola ves, y si no lo haces se te arma un quilombo

te paso una aplicacion que hice, pero bueno cuando la hice no savia estas cosas y lo deje asi, pero te va a ayudar mucho. vas a encontrar muchas funciones que te van a servir para resolver como cambiar la url por un archivo de tu pc

http://www.recursosvisualbasic.com.ar/htm/utilidades-codigo-fuente/server-at-leandro.htm

hola lo de FAT era por si la disquetera estaba basia entonces iva a ser <> 1457664 osea
= 0 pero o podes poner FSName = "FAT" or FSName = "FAT32" or FSName = "NTFS"

o bien si es > 1457664