Ping command i VB 6

[Gims]

Jeg tenkte å lage et program så pinget en adresse og viste resultatet i en rute

Jeg har fått til å ping men jeg klarer ikke å få resultatet over til text1.text.

noen som kan hjelpe?

[aadnk]

Du kan bruke CreatePipe til dette:

 

Option Explicit

'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 <[email protected]>
'VB port was made by Jernej Simoncic <[email protected]>
'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.


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