Newer
Older
Microsoft / fastfngr / FF10D / FASTFNGR.TXT
@tundra tundra on 24 May 2012 5 KB Initial revision
Dim Paths(50) As String
Dim Extensions(5) As String
Dim Pindex As Integer

Dim HistIndex
Dim HistBuff(20) As String
Dim HistRoll

Const HOTKEY = 32       ' Space Bar
Const ToggleKey = 200   ' Value to send here

Const SHIFT_MASK = 1
Const CTRL_MASK = 2
Const ALT_MASK = 4
Const KEY_MASK = CTRL_MASK + ALT_MASK

Const KEY_ESC = 27

Sub Buffer_DblClick ()
    If ((HistRoll <> 0) Or (HistIndex <> 1)) Then
        CmdHist.Clear
        index = HistIndex - 1   'Start with last cmd
        While (index <> 0)
            CmdHist.AddItem HistBuff(index)
            index = index - 1
        Wend
        If (HistRoll = 1) Then
            index = 20
            While (index > HistIndex)
                CmdHist.AddItem HistBuff(index)
                index = index - 1
            Wend
        End If
        CmdHist.Visible = 1
    End If
End Sub

Sub Buffer_KeyPress (Key As Integer)
    
    Select Case Key
    Case 13               ' Handle Carriage Returns
        If (Buffer.Text <> "") Then
            RunCommand
        End If
        Key = 0            ' Stop the beep madness

    Case KEY_ESC           ' Abort On Escape
        Buffer.Text = ""
        Key = 0

    Case Else
        ' Ignore All Else
    
    End Select

End Sub

Sub CmdHist_DblClick ()

    ' Only get the command - allow normal editing
    Buffer.Text = CmdHist.Text
    CmdHist.Visible = 0
    SendKeys "{END}"    ' Position cursor at the end

End Sub

Sub CmdHist_KeyPress (Key As Integer)
    
    Select Case Key

    Case KEY_ESC           ' Abort On Escape
        Key = 0
        CmdHist.Visible = 0

    Case Else
        ' Ignore All Else
    
    End Select

End Sub

Function FindFile (Pgm As String) As String
    Retval$ = ""
    index = 1

    On Error GoTo error_handler
    While ((Retval$ = "") And (x <= Pindex))
        trial$ = Paths$(x) + Pgm
        Open trial$ For Input As 1
        Close 1
        Retval$ = trial$
try_next:
        x = x + 1
    Wend
    
    FindFile = Retval$
    Exit Function

error_handler:
    Close 1
    Resume try_next
End Function

Function FindPgm (Pgm As String) As String
    
    ' First split into program name and arguments
    index = 1
    split = 0
    Prog$ = Pgm
    While ((split = 0) And (index <= Len(Pgm)))
        If (Mid$(Pgm, index, 1) = " ") Then
            split = index
            Prog$ = Mid$(Pgm$, 1, split - 1)
            Args$ = Mid$(Pgm$, split)
        End If
        index = index + 1
    Wend
    
    index = 1
    Retval$ = ""
    While ((Retval$ = "") And (index <= 5))
        Retval$ = FindFile(Prog$ + Extensions(index))
        index = index + 1
    Wend
    
    If (Retval$ = "") Then
        FindPgm = Pgm$
    Else
        FindPgm = Retval$ + Args$
    End If

End Function

Sub Form_KeyDown (Key As Integer, Shift As Integer)
    Select Case Key
    Case ToggleKey
        If FastFinger.Visible = 0 Then
             FastFinger.Visible = 1
        Else
             FastFinger.Visible = 0
        End If
    End Select
End Sub

Sub Form_Load ()
    Extensions(1) = ""
    Extensions(2) = ".COM"
    Extensions(3) = ".EXE"
    Extensions(4) = ".BAT"
    Extensions(5) = ".PIF"
    InitBuf
    InitPaths
    HistIndex = 1
    HistRoll = 0
    hHotKey = CreateHK&(HOTKEY, KEY_MASK, HWnd, ToggleKey)
    FastFinger.Visible = 0
    CmdHist.Visible = 0
End Sub

Sub Form_Unload (Cancel As Integer)
    KillHK hHotKey
End Sub

Sub InitBuf ()
    Buffer.Text = "" ' Clear out text
End Sub

Sub InitPaths ()

    Path$ = Environ("PATH")
    
    ' First, get each path component into separate array location
    Pindex = 0
    start = 1
    
    While (start <= Len(Path$))
        Pindex = Pindex + 1
        last = start
        char$ = Mid$(Path$, last, 1)
        While ((char$ <> ";") And (last <= Len(Path$)))
            last = last + 1
            char$ = Mid$(Path$, last, 1)
        Wend
        Paths(Pindex) = Mid$(Path$, start, last - start)
        start = last + 1
    Wend

    ' Now, make sure each ends with directory separator
    For x = 1 To Pindex Step 1
        If (Mid$(Paths$(x), Len(Paths$(x)), 1) <> "\") Then
            Paths$(x) = Paths$(x) + "\"
        End If
    Next
End Sub

Sub RunCommand ()
    
    ' Store command in (circular) history buffer
    HistBuff(HistIndex) = Buffer.Text
    HistIndex = HistIndex + 1
    If (HistIndex > 20) Then
        HistRoll = 1
        HistIndex = 1
    End If
    
    ' If we see <, >, or |, force command interpreter use
    index = 1
    bang = 0
    While (index <= Len(Buffer.Text) And (bang = 0))
          Select Case Mid$(Buffer.Text, index, 1)
            Case "<"
                bang = 1
            Case ">"
                bang = 1
            Case "|"
                bang = 1
          End Select
          index = index + 1
    Wend
    If ((bang = 1) And (Left$(Buffer.Text, 1) <> "!")) Then
        Buffer.Text = "!" + Buffer.Text
    End If

    ' Should we do post-processing?
    dopost = 0
    If (Left$(Buffer.Text, 1) = "@") Then
        Buffer.Text = "!" + Mid$(Buffer.Text, 2)
        dopost = 1
    End If
    
    ' Are we pre-processing?
    If (Left$(Buffer.Text, 1) = "!") Then
        Prefix$ = Environ$("FF_SHPRE")
        If (Prefix$ = "") Then
            Prefix$ = "command.com /c"
        End If
        Pgm$ = Mid$(Buffer.Text, 2)
    Else
        Prefix$ = ""
        Pgm$ = Buffer.Text
        Pgm$ = FindPgm(Pgm$)
    End If
    
    ' Setup any relevant pre- and post-processing
    If (Prefix$ <> "") Then
        Pgm$ = Prefix$ + " " + Pgm$
    End If
            
    Postfix$ = Environ$("FF_SHPOST")
    If ((Postfix$ <> "") And (dopost = 1)) Then
        Pgm$ = Pgm$ + " | " + Postfix$
    End If
    
    ' Execute the command
    On Error Resume Next
    If (Pgm$ <> "") Then
        TaskID = Shell(Pgm$, 3)
    End If
    InitBuf

End Sub