VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5976
   ClientLeft      =   48
   ClientTop       =   276
   ClientWidth     =   11292
   LinkTopic       =   "Form1"
   ScaleHeight     =   5976
   ScaleWidth      =   11292
   StartUpPosition =   3  'Windows-Standard
   Begin VB.ListBox List1 
      Height          =   5040
      Left            =   180
      MultiSelect     =   1  '1 -Einfach
      TabIndex        =   1
      Top             =   144
      Width           =   10956
   End
   Begin VB.CommandButton Command1 
      Caption         =   "BeanShell"
      Height          =   408
      Left            =   4680
      TabIndex        =   0
      Top             =   5364
      Width           =   2100
   End
End
Option Explicit
 
Private Const SW_NORMAL = 1
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const WAIT_TIMEOUT As Long = 258&
 
Private Type STARTUPINFO
 ...
End Type
 
Private Type PROCESS_INFORMATION
  ...
End Type
 
Private Type SECURITY_ATTRIBUTES
  ...
End Type
 
Private Declare Function CreatePipe Lib "kernel32" ( _ ....As Long
Private Declare Function ReadFile Lib "kernel32" ( _ ...As Long
Private Declare Function WriteFile Lib "kernel32" ( _ ...As Long
Private Declare Function CreateProcessA Lib "kernel32" ( _ ...As Long
Private Declare Function CloseHandle Lib "kernel32" ( _ ...As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _ ...As Long
 
Public mStdRdIN As Long
Public mStdWrIN As Long
Public mStdRdOUT As Long
Public mStdWrOUT As Long
Public mProcess As Long
Public mThread As Long
Private Sub ExecCmd(cmdline As String)
  Dim I As Integer
  Dim ret As Long
  Dim bSuccess As Long
  Dim hReadPipe1 As Long
  Dim hWritePipe1 As Long
  Dim hWritePipe3 As Long
  Dim hReadPipe3 As Long
  Dim Bytesread As Long
  Dim Byteswritten As Long
  Dim mybuff As String
  Dim start As STARTUPINFO
  Dim sa As SECURITY_ATTRIBUTES
  Dim proc As PROCESS_INFORMATION
 
  mybuff = String(256, Chr$(65))
 
  sa.nLength = Len(sa)
  sa.lpSecurityDescriptor = 0&
  sa.bInheritHandle = True
 
  ' A pipe for redirection of STDOUT
  If mStdRdOUT = 0 Then
    ret = CreatePipe(hReadPipe1, hWritePipe1, sa, 0)
    If ret = 0 Then
      MsgBox "CreatePipe for STDOUT failed. Error: " & Err.LastDllError
      Exit Sub
    End If
  Else
    hReadPipe1 = mStdRdOUT
    hWritePipe1 = mStdWrOUT
  End If
 
    ' A pipe for redirection of STDOUT
  If mStdRdIN = 0 Then
    ret = CreatePipe(hReadPipe3, hWritePipe3, sa, 0)
    If ret = 0 Then
      MsgBox "CreatePipe for STDIN failed. Error: " & Err.LastDllError
      Exit Sub
    End If
  Else
    hReadPipe3 = mStdWrIN
    hWritePipe3 = mStdRdIN
  End If
 
  start.cb = Len(start)
  start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
  start.hStdOutput = hWritePipe1
  start.hStdError = hWritePipe1
  start.hStdInput = hReadPipe3
  start.wShowWindow = SW_NORMAL
 
  ' Start the shelled application:
  ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, _
    0&, start, proc)
  If ret <> 1 Then
     MsgBox "CreateProcess failed. Error: " & Err.LastDllError
  End If
 
  bSuccess = ReadFile(hReadPipe1, ByVal mybuff, Len(mybuff), Bytesread, 0&)
  If bSuccess = 1 Then
    List1.AddItem Left(mybuff, Bytesread)
  Else
    MsgBox "ReadFile failed. Error: " & Err.LastDllError
  End If
 
  ret& = WaitForSingleObject(proc.hProcess, 100)
 
  mybuff = " start notepad" & vbNewLine
  bSuccess = WriteFile(hWritePipe3, ByVal mybuff, Len(mybuff), Byteswritten, 0)
 
  ret& = WaitForSingleObject(proc.hProcess, 100)
 
  mStdRdIN = hWritePipe3
  mStdWrIN = hReadPipe3
  mStdRdOUT = hReadPipe1
  mStdWrOUT = hWritePipe1
  mProcess = proc.hProcess
  mThread = proc.hThread
 
End Sub
Private Sub Command1_Click()
  'ExecCmd ("java -cp c:\programme\jet\bin\bsh-1.3.0.jar bsh.Interpreter")
  ExecCmd ("cmd.exe")
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Dim ret As Long
 
  ret& = CloseHandle(mProcess)
  ret& = CloseHandle(mThread)
 
  ' Handle's vom Lesen schließen
  ret& = CloseHandle(mStdRdOUT)
  ret& = CloseHandle(mStdWrOUT)
End Sub