Autor
|
Tema: Declaración de la API ReadFile (Leído 2,120 veces)
|
NekroByte
|
Hoygan, me gustaría saber cómo es exactamente la declaración de la función API ReadFile(), ya que el visor de APIs me la traduce como: Public Declare Function ReadFile Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long Y en MSDN aparece como: BOOL ReadFile( HANDLE hFile, // handle of file to read LPVOID lpBuffer, // pointer to buffer that receives data DWORD nNumberOfBytesToRead, // number of bytes to read LPDWORD lpNumberOfBytesRead, // pointer to number of bytes read LPOVERLAPPED lpOverlapped // pointer to structure for data ); Todo bien hasta ahora... pero en todos los ***** sitios de internet en los que veo, hasta en las páginas de Microsoft (msdn.microsoft.com, support.microsoft.com, etc) me aparece como: Public Declare Function ReadFile Lib "kernel32" _ (ByVal hFile As Long, ByVal lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _ lpNumberOfBytesRead As Long, Optional ByVal lpOverlapped As Long) As Long Long, long, long o algo parecido si se trata de .NET. ¿Cuál es la religión verdadera entonces?, ¿y por qué sólo en mi software aparece con otro tipo distinto a Long? Hilsener y gracias de hantemano.
|
|
|
En línea
|
|
|
|
LeandroA
|
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 1Const 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'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'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
|
|
|
En línea
|
|
|
|
NekroByte
|
Gracias, LeandroA, pero esa no fue mi duda, lo que ocurre es que como dices no voy a usar ese parámetro; me imagino que debió ser implementado así por compatibilidad: en C puedes poner NULL y te lo salta pero en VB no puedes poner ni Null ni vbNull porque lanza error al tratar de compilarlo, debió ser por eso que se distribuye como Any, para agregar ese valor &0 que veo en varios lados.
Me imagino que debe ser eso, pero tenía la duda, ¿por qué en todos lados aparecía distinto al mío?
Pero bah, creo que simplemente le voy a poner As Any confiando en mi teoría.
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Error en declaracion
Java
|
BlackDawn
|
3
|
3,058
|
30 Noviembre 2010, 19:05 pm
por Casidiablo
|
|
|
declaraciòn duplicada en el alcance actual.. (CODIGO)
« 1 2 »
Programación Visual Basic
|
rdzlcs
|
15
|
9,865
|
23 Diciembre 2010, 21:21 pm
por BlackZeroX
|
|
|
Aclaración en declaración de variable
Programación C/C++
|
novalida
|
9
|
3,142
|
27 Julio 2011, 19:57 pm
por Saberuneko
|
|
|
Obama podrá ordenar cyberataques sin que el Congreso aprueba una declaración...
Noticias
|
wolfbcn
|
0
|
1,679
|
4 Febrero 2013, 21:31 pm
por wolfbcn
|
|
|
no funciona ReadFile y overlapped
Programación C/C++
|
Belial & Grimoire
|
8
|
3,043
|
6 Febrero 2014, 23:43 pm
por Belial & Grimoire
|
|