检测是否有人在RDP连接登录

Question

我有运行的应用程序一个VPS。该应用程序运行，如果是有通过RDP或用户没有登录，但对于某些功能是必需的用户通过RDP记录。

有没有办法对我Delphi应用程序检测是否有任何人通过RDP登录？也许一个Windows API，它可以做到这一点。我需要的是一种方式，如果有人登录的RDP或不以编程方式检测;应用程序可以与别人运行记录或没有，但我需要有人时实际登录检测。

谢谢 ！

Answer 1

下面的代码列出了通过RDP登录的用户帐户。它需要从JEDI API Library & Security Code Library单位JwaWtsApi32.pas。

uses Windows, SysUtils, Classes,
     JwaWtsApi32;  // https://sourceforge.net/projects/jedi-apilib/

procedure FillRdpUserList (const UserList: TStrings;
                           const bIncludeDomain: Boolean = false;
                           const sServer: String = '');

type
    PWtsSessionInfoArray = ^TWtsSessionInfoArray;
    TWtsSessionInfoArray = array [0..MAXCHAR] of WTS_SESSION_INFO;

var
    iIndex : Integer;
    pWSI : PWtsSessionInfoArray;
    pValue : PChar;
    pCount, dwBytesReturned : DWord;
    hServer : THandle;
    sValue, sDomain : String;
    bConnected : Boolean;
    WtsInfoClass : TWtsInfoClass;
    bUserInfo : Boolean;

begin
    Assert (UserList <> NIL);

    UserList.Clear;

    if (sServer <> '') then
    begin
        hServer := WTSOpenServer (PChar (sServer));

        if (hServer = 0) then
            exit;
    end { if }
    else hServer := WTS_CURRENT_SERVER_HANDLE;

    try
        Win32Check (WtsEnumerateSessions (hServer, 0, 1,
                                          PWTS_SESSION_INFO (pWSI),
                                          pCount));
        for iIndex := 0 to pCount - 1 do
            if (pWSI^[iIndex].State in [WTSActive, WTSDisconnected]) then
            begin
                if (bIncludeDomain) then
                    WtsInfoClass := WTSDomainName
                else WtsInfoClass := WTSUserName;

                bUserInfo := WtsInfoClass = WTSUserName;

                repeat
                    if (WTSQuerySessionInformation (hServer,
                                                    pWSI^[iIndex].SessionId,
                                                    WtsInfoClass,
                                                    Pointer (pValue),
                                                    dwBytesReturned)) then
                    begin
                        sValue := LowerCase (pValue);
                        WtsFreeMemory (pValue);

                        if (sValue <> '') then
                            if (WtsInfoClass = WTSDomainName) then
                                sDomain := sValue + '\'
                            else
                            begin
                                with pWSI^[iIndex] do
                                    if (pWinStationName <> 'Console') then
                                    begin
                                        bConnected := State = WTSActive;
                                        UserList.AddObject (sDomain + sValue,
                                                            TObject (bConnected))
                                    end; { if }

                                sDomain := '';
                            end; { else }

                        if (WtsInfoClass = WTSDomainName) then
                            WtsInfoClass := WTSUserName
                        else bUserInfo := true;
                    end { if }
                    else Break;
                until (bUserInfo);
            end; { if }

    finally
        if (pWSI <> NIL) then
            WtsFreeMemory (pWSI);

        if (sServer <> '') then
            WTSCloseServer (hServer);
    end; { try / finally }
end; { FillRdpUserList }