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	joko	1.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