vbAccelerator - Contents of code file: fTest.frm

VERSION 5.00
Begin VB.Form fTest 
   Caption         =   "Test Shell Wait"
   ClientHeight    =   2160
   ClientLeft      =   4575
   ClientTop       =   3105
   ClientWidth     =   5715
   LinkTopic       =   "Form1"
   ScaleHeight     =   2160
   ScaleWidth      =   5715
   Begin VB.CommandButton cmdShell 
      Caption         =   "Shell..."
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   1320
      TabIndex        =   5
      Top             =   960
      Width           =   1335
   End
   Begin Project1.cUpDown cUpDown1 
      Height          =   315
      Left            =   1320
      TabIndex        =   3
      Top             =   120
      Width           =   2295
      _ExtentX        =   5212
      _ExtentY        =   556
      Upper           =   30000
      Position        =   10000
      AutoChangeBuddyText=   -1  'True
      Begin VB.TextBox txtTimeOut 
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   0
         TabIndex        =   4
         Text            =   "5000"
         Top             =   0
         Width           =   2115
      End
   End
   Begin VB.TextBox txtCommand 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1320
      TabIndex        =   2
      Top             =   480
      Width           =   4335
   End
   Begin VB.Label lblCommand 
      Caption         =   "Command:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   60
      TabIndex        =   1
      Top             =   540
      Width           =   1215
   End
   Begin VB.Label lblTimeOut 
      Caption         =   "Time Out (ms):"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
End
Attribute VB_Name = "fTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal
 hWndNewParent As Long) As Long

Private Sub cmdShell_Click()
Dim sError As String
    If (ShellAndWaitForTermination( _
        txtCommand.Text, _
        vbNormalFocus, _
        sError, _
        CLng(txtTimeOut))) Then
        MsgBox "Success", vbInformation
    Else
        MsgBox "An error occurred: " & sError, vbExclamation
    End If
End Sub

Private Sub cUpDown1_BeforeChange(ByVal iPos As Long, iDelta As Long)
    ' Can validate here.  Set iDelta = 0
    ' if you don't want to do the change.
End Sub

Private Sub cUpDown1_Change()
    'Debug.Print "Change"
End Sub

Private Sub Form_Load()
    ' Initialise timeout:
    txtTimeOut.Text = Format$(cUpDown1.Position, "##,##0")
    cUpDown1.AutoChangeBuddyText = True
    cUpDown1.BuddyhWnd = txtTimeOut.hwnd
    cUpDown1.AutoPositionToBuddyText = True
    
    ' Create a batch file to test with:
    txtCommand.Text = "C:\TEST.BAT"
    
    On Error Resume Next
    Kill txtCommand.Text
            
    On Error GoTo 0
    Dim iFIle As Integer
    iFIle = FreeFile
    Open txtCommand.Text For Binary As #iFIle
    Put #iFIle, , "echo off" & vbCrLf & "Pause" & vbCrLf
    Close #iFIle
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    Kill "C:\TEST.BAT"
End Sub