Dim Paths(50) As String
Dim Extensions(5) As String
Dim Pindex As Integer

Const MaxAlias = 100
Dim Aliases(MaxAlias, 2) As String
Dim aindex As Integer

Const MaxHist = 20
Dim HistIndex
Dim HistBuff(MaxHist) As String
Dim HistRoll
Dim PBIndex
Dim MaxHistUsed

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 AliasSubst ()

    ' Do relevant alias substitutions on buffer text
    x = Len(buffer.Text)
    y$ = Left$(buffer.Text, 1)
    If ((y$ = "!") Or (y$ = "@")) Then
        z = 2
    Else
        y$ = ""
        z = 1
    End If

    While ((z <= x) And (Mid$(buffer.Text, z, 1) <> " "))
        z = z + 1
    Wend
    
    If (y$ = "") Then
        q$ = Left$(buffer.Text, z - 1)
    Else
        q$ = Mid$(buffer.Text, 2, z - 2)
    End If

    m$ = Mid$(buffer.Text, z)
    r = 0
    x = 1
    While ((x <= aindex) And (r = 0))
        If (q$ = Aliases(x, 1)) Then
            q$ = Aliases(x, 2)
            r = 1
        End If
        x = x + 1
    Wend
    buffer.Text = y$ + q$ + m$

End Sub

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 = MaxHist
            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 1                  ' Ctrl-A
        SendKeys "{Home}"
        Key = 0             ' Stop the beep madness

    Case 2                  ' Ctrl-B
        SendKeys "{Left}"
        Key = 0

    Case 4                  ' Ctrl-D
        SendKeys "{Del}"
        Key = 0

    Case 5                  ' Ctrl-E
        SendKeys "{End}"
        Key = 0

    Case 6                  ' Ctrl-F
        SendKeys "{Right}"
        Key = 0
    
    Case 11                 ' Ctrl-K
        buffer.Text = Left$(buffer.Text, buffer.SelStart)
        SendKeys "{End}"
        Key = 0
    
    Case 13                 ' Ctrl-M
        If (buffer.Text <> "") Then
            RunCommand
        End If
        Key = 0

    Case 14                 ' Ctrl-N
        If PBIndex < MaxHistUsed Then
            PBIndex = PBIndex + 1
        Else
            PBIndex = 1
        End If
        buffer.Text = HistBuff(PBIndex)
        SendKeys "{End}"
        Key = 0

    Case 16                 ' Ctrl-P
        If PBIndex > 1 Then
            PBIndex = PBIndex - 1
        Else
            PBIndex = MaxHistUsed
        End If
        buffer.Text = HistBuff(PBIndex)
        SendKeys "{End}"
        Key = 0
        
    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 ()
    InitExt
    InitBuf
    InitPaths
    InitAliases
    HistIndex = 1
    HistRoll = 0
    MaxHistUsed = 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 InitAliases ()

    aindex = 0      ' Means no aliases have been found
    IniFile$ = App.Path + "\" + App.EXEName + ".INI"

    On Error GoTo INI_file_done
    Open IniFile$ For Input As 1
    Input #1, x$
    While (Not EOF(1))
        If (InStr(1, x$, "[aliases]", 1)) Then
            Input #1, x$
            While (Not EOF(1) And (Not InStr(x$, "[")) And (aindex < MaxAlias))
                aindex = aindex + 1
                Aliases(aindex, 1) = x$
                Input #1, x$
            Wend
            GoTo INI_file_done
        End If
        Input #1, x$
    Wend

INI_file_done:
    Close 1

    If (aindex > 0) Then
        y = 1
        While (y <= aindex)
        eindex = InStr(Aliases(y, 1), "=")
        If (eindex > 0) Then
            Aliases(y, 2) = Scrub(Mid$(Aliases(y, 1), eindex + 1))
            Aliases(y, 1) = Scrub(Left$(Aliases(y, 1), eindex - 1))
        End If
        y = y + 1
        Wend
    End If
End Sub

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

Sub InitExt ()

    Extensions(1) = ""
    Extensions(2) = ".COM"
    Extensions(3) = ".EXE"
    Extensions(4) = ".BAT"
    Extensions(5) = ".PIF"

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 > MaxHist) Then
        HistRoll = 1
        HistIndex = 1
    End If
    MaxHistUsed = MaxHistUsed + 1
    If (MaxHistUsed > MaxHist) Then
        MaxHistUsed = MaxHist
    End If
    PBIndex = HistIndex

    AliasSubst

    ' 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$, 1)
    End If
    InitBuf

End Sub

Function Scrub (xxx As String) As String

    ' Scrub leading and trailing spaces from the string

    z = Len(xxx)
    j = 0
    k = 0
    l = 0

    While ((j < z) And (k = 0)) ' Find start of string
        j = j + 1
        tmp$ = Mid$(xxx, j, 1)
        If (tmp$ <> " ") Then k = j
    Wend

    j = z
    While ((j > 0) And (l = 0)) ' Find end of string
        tmp$ = Mid$(xxx, j, 1)
        If (tmp$ <> " ") Then l = j
        j = j - 1
    Wend

    Scrub = Mid$(xxx, k, l - k + 1)

End Function