dos.frm

可以在VB里打印ipconfig /all之类的信息

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6915
   ClientLeft      =   3255
   ClientTop       =   1785
   ClientWidth     =   9690
   LinkTopic       =   "Form1"
   ScaleHeight     =   6915
   ScaleWidth      =   9690
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   8400
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   6615
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   8175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 0
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
  (ByVal lpApplicationName As String, _
  ByVal lpCommandLine As String, _
  lpProcessAttributes As SECURITY_ATTRIBUTES, _
  lpThreadAttributes As SECURITY_ATTRIBUTES, _
  ByVal bInheritHandles As Long, _
  ByVal dwCreationFlags As Long, _
  lpEnvironment As Any, _
  ByVal lpCurrentDirectory As String, _
  lpStartupInfo As STARTUPINFO, _
  lpProcessInformation As PROCESS_INFORMATION) As Long
    
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
  lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
  lpOverlapped As Long) As Long
    
Private Declare Function WaitForSingleObject Lib "kernel32" _
  (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
  phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _
  ByVal nSize As Long) As Long
    
Private Type STARTUPINFO
  cb   As Long
  lpReserved   As String
  lpDesktop   As String
  lpTitle   As String
  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 Long
  hStdInput   As Long
  hStdOutput   As Long
  hStdError   As Long
End Type
    
Private Type PROCESS_INFORMATION
  hProcess   As Long
  hThread   As Long
  dwProcessId   As Long
  dwThreadId   As Long
End Type
    
Private Type SECURITY_ATTRIBUTES
  nLength   As Long
  lpSecurityDescriptor   As Long
  bInheritHandle   As Long
End Type
    
Private Const NORMAL_PRIORITY_CLASS       As Long = &H20&
    
Private Const STARTF_USESTDHANDLES       As Long = &H100&
Private Const STARTF_USESHOWWINDOW       As Long = &H1&
Private Const SW_HIDE       As Long = 0&
    
Private Const INFINITE       As Long = &HFFFF&
    
Public Function RunCommand(CommandLine As String) As String
  Dim si     As STARTUPINFO     'used   to   send   info   the   CreateProcess
  Dim pi     As PROCESS_INFORMATION     'used   to   receive   info   about   the   created   process
  Dim retval     As Long     'return   value
  Dim hRead     As Long     'the   handle   to   the   read   end   of   the   pipe
  Dim hWrite     As Long     'the   handle   to   the   write   end   of   the   pipe
  Dim sBuffer(0 To 63)         As Byte     'the   buffer   to   store   data   as   we   read   it   from   the   pipe
  Dim lgSize     As Long     'returned   number   of   bytes   read   by   readfile
  Dim sa     As SECURITY_ATTRIBUTES
  Dim strResult     As String     'returned   results   of   the   command   line
    
  'set   up   security   attributes   structure
  With sa
  .nLength = Len(sa)
  .bInheritHandle = 1&       'inherit,   needed   for   this   to   work
  .lpSecurityDescriptor = 0&
  End With
    
  'create   our   anonymous   pipe   an   check   for   success
  '   note   we   use   the   default   buffer   size
  '   this   could   cause   problems   if   the   process   tries   to   write   more   than   this   buffer   size
  retval = CreatePipe(hRead, hWrite, sa, 0&)
  If retval = 0 Then
  Debug.Print "CreatePipe   Failed"
  RunCommand = ""
  Exit Function
  End If
    
  'set   up   startup   info
  With si
  .cb = Len(si)
  .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW           'tell   it   to   use   (not   ignore)   the   values   below
  .wShowWindow = SW_HIDE
'   .hStdInput   =   GetStdHandle(STD_INPUT_HANDLE)
  .hStdOutput = hWrite       'pass   the   write   end   of   the   pipe   as   the   processes   standard   output
'   .hStdError   =   GetStdHandle(STD_ERROR_HANDLE)
  End With
    
  'run   the   command   line   and   check   for   success
  retval = CreateProcess(vbNullString, CommandLine & vbNullChar, sa, sa, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi)
  If retval Then
  'wait   until   the   command   line   finishes
  '   trouble   if   the   app   doesn't   end,   or   waits   for   user   input,   etc
  WaitForSingleObject pi.hProcess, INFINITE
    
  'read   from   the   pipe   until   there's   no   more   (bytes   actually   read   is   less   than   what   we   told   it   to)
  Do While ReadFile(hRead, sBuffer(0), 64, lgSize, ByVal 0&)
  'convert   byte   array   to   string   and   append   to   our   result
  strResult = strResult & StrConv(sBuffer(), vbUnicode)
  'TODO   =   what's   in   the   tail   end   of   the   byte   array   when   lgSize   is   less   than   64???
  Erase sBuffer()
  If lgSize <> 64 Then Exit Do
  Loop
    
  'close   the   handles   of   the   process
  CloseHandle pi.hProcess
  CloseHandle pi.hThread
  Else
  Debug.Print "CreateProcess   Failed" & vbCrLf
  End If
    
  'close   pipe   handles
  CloseHandle hRead
  CloseHandle hWrite
  RunCommand = Replace(strResult, vbNullChar, "")
End Function
Private Sub Command1_Click()
    Text1 = RunCommand(Text1)
End Sub