shellw.bas

加入一个用VB编写CGI的VB源程序。（你需要在Win98上首先安装20Personal WebServer

Attribute VB_Name = "SHELLW"
'=============================================================
'SHELLW.BAS
'Author: Kevin O'Brien <[e-mail]>
'                      <[e-mail]>
'Version: 1.0
'Launch a shelled program, and wait for it to complete.
'
'VB's built-in Shell() function can be used as well, however
'it does not wait for the shelled program to complete.
'If your script depends upon the output of a called program then
'use ShellAndWait() instead.
'
'To use:
'   Dim rc        as Long    'return code
'   Dim shellPgm  as String  'program (and optional parameters)
'   Dim wTime     as Long    'Maximum amount of time to wait before
'                            'continuing (in milliseconds).
'                            'Set wTime to -1 to wait indefinitely.
'   rc = ShellAndWait(shellPgm, wTime)
'
'Possible values for rc:
'   0  success
'  -1  program not found
' 258  program did not finish executing before wTime millisecs
'=============================================================

Private Declare Function WaitForSingleObject Lib "kernel32" _
   (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" _
   (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject 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

Public Function ShellAndWait(cmdLine As String, waitTime As Long) As Long
Const NORMAL_PRIORITY_CLASS = &H20&
Dim proc  As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim rc    As Long

start.cb = Len(start)
rc = CreateProcessA(0&, cmdLine, 0&, 0&, 1&, _
                    NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
ShellAndWait = WaitForSingleObject(proc.hProcess, waitTime)
rc = CloseHandle(proc.hProcess)
End Function