full/w2hfax/shellutils.bas

Attribute VB_Name = "shellutils"
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Function Shell(Program As String, Optional ShowCmd As Long = _
vbNormalNoFocus, Optional ByVal WorkDir As Variant) As Long

    Dim FirstSpace As Integer, Slash As Integer

    If Left(Program, 1) = """" Then
        FirstSpace = InStr(2, Program, """")


        If FirstSpace <> 0 Then
            Program = Mid(Program, 2, FirstSpace - 2) & _
              Mid(Program, FirstSpace + 1)
            FirstSpace = FirstSpace - 1
        End If

    Else
        FirstSpace = InStr(Program, " ")
    End If

    If FirstSpace = 0 Then FirstSpace = Len(Program) + 1

    If IsMissing(WorkDir) Then

        For Slash = FirstSpace - 1 To 1 Step -1
            If Mid(Program, Slash, 1) = "\" Then Exit For
        Next

        If Slash = 0 Then
            WorkDir = CurDir
        ElseIf Slash = 1 Or Mid(Program, Slash - 1, 1) = ":" Then
            WorkDir = Left(Program, Slash)
        Else
            WorkDir = Left(Program, Slash - 1)
        End If

    End If

    Shell = ShellExecute(0, vbNullString, _
    Left(Program, FirstSpace - 1), LTrim(Mid(Program, _
    FirstSpace)), WorkDir, ShowCmd)
    If Shell < 32 Then VBA.Shell Program, ShowCmd 'To raise Error

End Function

1	Attribute VB_Name = "shellutils"
2	Option Explicit
3
4	Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
5
6	Function Shell(Program As String, Optional ShowCmd As Long = _
7	vbNormalNoFocus, Optional ByVal WorkDir As Variant) As Long
8
9	Dim FirstSpace As Integer, Slash As Integer
10
11	If Left(Program, 1) = """" Then
12	FirstSpace = InStr(2, Program, """")
13
14
15	If FirstSpace <> 0 Then
16	Program = Mid(Program, 2, FirstSpace - 2) & _
17	Mid(Program, FirstSpace + 1)
18	FirstSpace = FirstSpace - 1
19	End If
20
21	Else
22	FirstSpace = InStr(Program, " ")
23	End If
24
25	If FirstSpace = 0 Then FirstSpace = Len(Program) + 1
26
27	If IsMissing(WorkDir) Then
28
29	For Slash = FirstSpace - 1 To 1 Step -1
30	If Mid(Program, Slash, 1) = "\" Then Exit For
31	Next
32
33	If Slash = 0 Then
34	WorkDir = CurDir
35	ElseIf Slash = 1 Or Mid(Program, Slash - 1, 1) = ":" Then
36	WorkDir = Left(Program, Slash)
37	Else
38	WorkDir = Left(Program, Slash - 1)
39	End If
40
41	End If
42
43	Shell = ShellExecute(0, vbNullString, _
44	Left(Program, FirstSpace - 1), LTrim(Mid(Program, _
45	FirstSpace)), WorkDir, ShowCmd)
46	If Shell < 32 Then VBA.Shell Program, ShowCmd 'To raise Error
47
48	End Function
49
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26