检测是否有人登录 RDP 连接

Detect if anyone is logged in a RDP connection

我有一个 VPS 运行 应用程序。应用程序 运行s 是否有用户通过 RDP 登录,但某些功能需要用户通过 RDP 登录。

有没有办法让我的 Delphi 应用程序检测是否有人通过 RDP 登录?也许 Windows API 可以做到这一点。我需要的是一种以编程方式检测是否有人登录 RDP 的方法;该应用程序可以 运行 有人登录或不登录,但我需要检测某人实际登录的时间。

谢谢!

以下代码列出了通过 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 }