conapp.pas

BaiduMp3 search baidu mp3

            Execute;
        WM_KEYDOWN:
            WMKeyDown(Msg);
        WM_KEYUP:
            WMKeyUp(Msg);
        else
            TranslateMessage(Msg);
            DispatchMessage(Msg);
        end;
    end
    else begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.ConsoleWrite(const S: String);
begin
    Write(S);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.ConsoleWriteLn(const S: String);
begin
    WriteLn(S);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Console mode applications do not receive keyboard messages as GUI apps.
// We use a thread to wait for keyboard activity and generate keyboard
// messages as in a GUI application.
constructor TKeyboardThread.Create(Suspended: Boolean);
begin
    inherited Create(TRUE);
    FEvent := CreateEvent(nil, TRUE, FALSE, nil);
    if not Suspended then
        Resume;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TKeyboardThread.Destroy;
begin
    if FEvent <> 0 then begin
        SetEvent(FEvent);
        Sleep(0);
        CloseHandle(FEvent);
        FEvent := 0;
    end;
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TKeyboardThread.Execute;
var
    hConsole    : THandle;
    Status      : DWORD;
    InputBuffer : TInputRecord;
    KeyEvent    : TKeyEventRecord;
    Count       : DWORD;
    Ascii       : Char;
    I           : Integer;
    Handles     : array [0..1] of THandle;
begin
    hConsole   := GetStdHandle(STD_INPUT_HANDLE);
    Handles[0] := hConsole;
    Handles[1] := FEvent;
    while not Terminated do begin
        Status := MsgWaitForMultipleObjects(2, Handles, FALSE, INFINITE, 0);
        if Status = WAIT_FAILED then begin
            //WriteLn('WAIT_FAILED');
            break;                             // Wait failed
        end
        else if Status = WAIT_OBJECT_0 + 1 then begin
            //WriteLn('FEvent is signaled');
            break;                            // FEvent is signaled
        end
        else if Status = WAIT_OBJECT_0 then begin  // Console is signaled
            if ReadConsoleInput(hConsole, InputBuffer, 1, Count) then begin
                if InputBuffer.EventType = KEY_EVENT then begin
{$IFDEF COMPILER4_UP}
{ Starting from Delphi 4 and Bcb4, they changed definition }
                    KeyEvent := InputBuffer.Event.KeyEvent;
{$ELSE}
                    KeyEvent := InputBuffer.KeyEvent;
{$ENDIF}
                    Ascii := Char(KeyEvent.AsciiChar);
                    for I := 1 to KeyEvent.wRepeatCount do begin
                        if KeyEvent.bKeyDown then begin
                            PostThreadMessage(
                                ConAppThreadID,
                                WM_KEYDOWN,
                                Ord(Ascii) + (KeyEvent.wVirtualKeyCode shl 16),
                                KeyEvent.dwControlKeyState);
                        end
                        else begin
                            PostThreadMessage(
                                ConAppThreadID,
                                WM_KEYUP,
                                Ord(Ascii) + (KeyEvent.wVirtualKeyCode shl 16),
                                KeyEvent.dwControlKeyState);
                        end;
                    end;
                end;
            end;
        end
        else begin
            WriteLn('Unknown status ', Status);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.WMKeyDown(var MsgRec: TMsg);
var
    Ascii : Char;
begin
    Ascii := Char(MsgRec.wParam and 255);

//    WriteLn('WMKeyDown ' +
//            IntToHex(MsgRec.WParam, 8) + ' ' +
//            IntToHex(MsgRec.lParam, 8));
    if not FLineMode then begin
        DoCharReceived(Ascii);
    end
    else begin
        case Ascii of
        #0: begin                      // Not an ASCII char
            end;
        #9: begin                      // TabChar
                repeat
                    if FLineEcho then
                        ConsoleWrite(' ');
                    FLineBuffer := FLineBuffer + ' ';
                until (Length(FLineBuffer) and 7) = 0;
            end;
        #8: begin                     // BackSpace
                if Length(FLineBuffer) > 0 then begin
                     if FLineEcho then
                         ConsoleWrite(#8#32#8);
                     SetLength(FLineBuffer, Length(FLineBuffer) - 1);
                end;
            end;
        #13: begin                     // Return
                if FLineEcho then
                    ConsoleWrite(#13#10);
                DoLineReceived(FLineBuffer);
                FLineBuffer := '';    // Clear line
            end;
        else
            if FLineEcho then
                ConsoleWrite(Char(MsgRec.WParam));
            FLineBuffer := FLineBuffer + Char(MsgRec.WParam);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.WMKeyUp(var MsgRec: TMsg);
begin

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.DoLineReceived(const Line : String);
begin
    // By default: nothing to do
    // Todo: Override this method in your derived class
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TConApplication.DoCharReceived(Ch: Char);
begin
    // By default: nothing to do
    // Todo: Override this method in your derived class
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This is a callback routine called by windows when some events occurs.     }
{ We trap those events to close our application.                            }
function CtrlHandlerRoutine(CtrlType : DWORD) : DWORD; stdcall;
begin
    case CtrlType of
    CTRL_C_EVENT,            // User hit CTRL-C
    CTRL_BREAK_EVENT,        // User hit CTRL-BREAK
    CTRL_LOGOFF_EVENT,       // User log off his session
    CTRL_CLOSE_EVENT,        // Close signal
    CTRL_SHUTDOWN_EVENT :    // Window shutdown signal
        begin
            Result := 1;
            PostThreadMessage(ConApplication.FThreadID, WM_QUIT, 0, 0);
        end;
    else
        Result := 0;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TKeyboardThread.Terminate;
begin
    inherited Terminate;
    if FEvent <> 0 then
        SetEvent(FEvent);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TConApplication.GetExeName: String;
begin
    SetLength(Result, 256);
    SetLength(Result, GetModuleFileName(0, @Result[1], Length(Result)));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.