Detect Remote Desktop User

[kuba]

Hallo,

kann ich mit Hilfe von Delphi irgendwie herausfinden ob ein RemoteUser auf meinem Desktop per VNC, RDP oder PC-Anywhere eingeloggt ist ?

KUBA

[SirThornberry]

generell nicht. du kannst bei den einzelnen programmen nur jeweils prüfen ob der Server aktiv ist.

[SvB]

Hi, es gibt von microOlap die Komponente Packet Sniffer SDK. Damit kannst Du höchstens prüfen, vorausgesetzt alle Verbindungen gehen über Netzwerk, ob die Programme irgendwelchen Netzwerkverkehr haben.

Grüße Sven

[kuba]

Zitat von SirThornberry:

generell nicht. du kannst bei den einzelnen programmen nur jeweils prüfen ob der Server aktiv ist.

wie das ??

kuba

[SvB]

In dem man in der Liste der aktiven Prozesse nachschaut, ob da die Programm am laufen sind.

Grüße Sven

[mkinzler]

Dann weiss man aber nicht, ob ein Benutzer momentan aktiv ist.

[kuba]

Zitat von mkinzler:

Dann weiss man aber nicht, ob ein Benutzer momentan aktiv ist.

und genau das möchte ich wissen ...

KUBA

PS: dabei ist mir der Benutzeraccount völlig egal, will nur wissen wann jemand "schaut"

[kuba]

Hallo,

das Thema beschäftigt mich ...

Beim Surfen bin ich auf folgenden Code gestossen:

Delphi-Quellcode:

function     TcpOpenEnum(var TcpTable: PTcpTable): DWORD;
procedure  TcpCloseEnum(TcpTable: PTcpTable);
function     TcpPortFromLong(Port: LongWord): Word;
function     TcpAddrFromLong(Address: LongWord): String;
function     TcpStateDescription(State: LongWord): String;
function     TcpDeleteRow(TcpRow: PTcpRow): DWORD;

An example of using all functions:

var  lpTable:       PTcpTable;
     dwCount:       Integer;
begin

  // Retrieve the table of tcp entries
  if (TCPOpenEnum(lpTable) = ERROR_SUCCESS) then
  begin
     // Resource protection
     try
        // Walk the table entries
        for dwCount:=0 to Pred(lpTable^.dwNumEntries) do
        begin
           // Write out
           // -  the local port (in common format, vs network order)
           // -  the local address (in string format)
           // -  the descriptive state of the tcp entry
           WriteLn(TcpPortFromLong(lpTable^.Table[dwCount].dwLocalPort),
                   ' , ',
                   TcpAddrFromLong(lpTable^.Table[dwCount].dwLocalAddr),
                   ' , ',
                   TcpStateDescription(lpTable^.Table[dwCount].dwState));

           // Example of closing a tcp port/connection
           // - check for a connection to a remote port 80 (http) and close it
           if (TcpPortFromLong(lpTable^.Table[dwCount].dwRemotePort) = 80) then
              TcpDeleteRow(@lpTable^.Table[dwCount]);
        end;
     finally
        // Free the memory allocated by the open enum function
        TCPCloseEnum(lpTable);
     end;
  end;

end;

And finally, the source for it all.

Delphi-Quellcode:

--------

unit TcpApi;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit           :  TCPAPI
//   Date           :  Original -  05.25.2004
//                     Updated  -  11.12.2004
//   Author         :  rllibby
//
//   Description    :  Set of TCP enumeration and helper routines.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils;

////////////////////////////////////////////////////////////////////////////////
//   General constants
////////////////////////////////////////////////////////////////////////////////
const
  ALLOC_SIZE        =  4096;

////////////////////////////////////////////////////////////////////////////////
//   Data structures
////////////////////////////////////////////////////////////////////////////////
type
  PMIB_TCPROW       =  ^MIB_TCPROW;
  MIB_TCPROW        =  packed record
     dwState:       LongWord;
     dwLocalAddr:   LongWord;
     dwLocalPort:   LongWord;
     dwRemoteAddr:  LongWord;
     dwRemotePort:  LongWord;
  end;
  TTcpRow           =  MIB_TCPROW;
  PTcpRow           =  ^TTcpRow;

  PMIB_TCPTABLE     =  ^MIB_TCPTABLE;
  MIB_TCPTABLE      =  packed record
     dwNumEntries:  LongWord;
     Table:         Array [0..MaxWord] of MIB_TCPROW;
  end;
  TTcpTable         =  MIB_TCPTABLE;
  PTcpTable         =  ^TTcpTable;

  PIP_BYTES         =  ^IP_BYTES;
  IP_BYTES          =  Array [0..3] of Byte;
  TIpBytes          =  IP_BYTES;
  PIpBytes          =  ^TIpBytes;

////////////////////////////////////////////////////////////////////////////////
//   Function definitions
////////////////////////////////////////////////////////////////////////////////
type
  TGetTcpTable      =  function(lpTcpTable: PTcpTable; lpdwSize: PDWORD; bOrder: BOOL): DWORD; stdcall;
  TSetTcpEntry      =  function(lpTcpRow: PTcpRow): DWORD; stdcall;

////////////////////////////////////////////////////////////////////////////////
//   TCP table entry state constants
////////////////////////////////////////////////////////////////////////////////
const
  MIB_TCP_STATE_CLOSED       =  1;
  MIB_TCP_STATE_LISTEN       =  2;
  MIB_TCP_STATE_SYN_SENT     =  3;
  MIB_TCP_STATE_SYN_RCVD     =  4;
  MIB_TCP_STATE_ESTAB        =  5;
  MIB_TCP_STATE_FIN_WAIT1    =  6;
  MIB_TCP_STATE_FIN_WAIT2    =  7;
  MIB_TCP_STATE_CLOSE_WAIT   =  8;
  MIB_TCP_STATE_CLOSING      =  9;
  MIB_TCP_STATE_LAST_ACK     =  10;
  MIB_TCP_STATE_TIME_WAIT    =  11;
  MIB_TCP_STATE_DELETE_TCB   =  12;

const
  MIB_TCP_STATES:            Array [0..12] of PChar =
                            ('Unknown',
                             'Closed',
                             'Listening',
                             'Syn Sent',
                             'Syn Received',
                             'Established',
                             'Fin Wait1',
                             'Fin Wait2',
                             'Close Wait',
                             'Closing',
                             'Last Ack',
                             'Time Wait',
                             'Deleted');

////////////////////////////////////////////////////////////////////////////////
//   Late bound function wrappers
////////////////////////////////////////////////////////////////////////////////
function   GetTcpTable(lpTcpTable: PTcpTable; lpdwSize: PDWORD; bOrder: BOOL): DWORD; stdcall;
function   SetTcpEntry(lpTcpRow: PTcpRow): DWORD; stdcall;

////////////////////////////////////////////////////////////////////////////////
//   TCP functions designed to be used by developers
////////////////////////////////////////////////////////////////////////////////
function   TcpOpenEnum(var TcpTable: PTcpTable): DWORD;
procedure  TcpCloseEnum(TcpTable: PTcpTable);
function   TcpPortFromLong(Port: LongWord): Word;
function   TcpAddrFromLong(Address: LongWord): String;
function   TcpStateDescription(State: LongWord): String;
function   TcpDeleteRow(TcpRow: PTcpRow): DWORD;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Library and function name constants
////////////////////////////////////////////////////////////////////////////////
const
  LIB_IPHLPAPI            =  'iphlpapi.dll';
  FUNC_GETTCPTABLE        =  'GetTcpTable';
  FUNC_SETTCPENTRY_NAME   =  'SetTcpEntry';

////////////////////////////////////////////////////////////////////////////////
//   Protected variables
////////////////////////////////////////////////////////////////////////////////
var
  hIphlp:           HMODULE        =  0;
  _GetTcpTable:     TGetTcpTable   =  nil;
  _SetTcpEntry:     TSetTcpEntry   =  nil;

function TcpDeleteRow(TcpRow: PTcpRow): DWORD;
begin

  // Check assignment
  if Assigned(TcpRow) then
  begin
     // Set entry state
     TcpRow^.dwState:=MIB_TCP_STATE_DELETE_TCB;
     // Call SetTcpEntry
     result:=SetTcpEntry(TcpRow);
  end
  else
     // Invalid param
     result:=ERROR_INVALID_PARAMETER;

end;

function TcpStateDescription(State: LongWord): String;
begin

  // Handle state
  if State in [MIB_TCP_STATE_CLOSED..MIB_TCP_STATE_DELETE_TCB] then
     // Return state description
     result:=MIB_TCP_STATES[State]
  else
     // Unknown state
     result:=MIB_TCP_STATES[0];

end;

function TcpAddrFromLong(Address: LongWord): String;
var  lpBytes:    TIpBytes;
     dwIndex:    Integer;
begin

  // Move dword to byte array
  Move(Address, lpBytes, SizeOf(LongWord));

  // Set start of string
  result:=IntToStr(lpBytes[0]);

  // Walk remaining bytes
  for dwIndex:=Succ(Low(lpBytes)) to High(lpBytes) do result:=result+'.'+IntToStr(lpBytes[dwIndex]);

end;

function TcpPortFromLong(Port: LongWord): Word;
begin

  // Convert from network order to common port format
  result:=(Port div 256) + (Port mod 256) * 256;

end;

function TcpOpenEnum(var TcpTable: PTcpTable): DWORD;
var  dwSize:        DWORD;
begin

  // Set the default size, this is enough to hold appx 204 entries
  dwSize:=ALLOC_SIZE;

  // Allocate memory
  TcpTable:=AllocMem(dwSize);

  // Attempt to get the full tcp table
  result:=GetTcpTable(TcpTable, @dwSize, True);

  // Check for insuffecient buffer
  if (result = ERROR_INSUFFICIENT_BUFFER) then
  begin
     // Re-alloc the table
     ReAllocMem(TcpTable, dwSize);
     // Call the function again
     result:=GetTcpTable(TcpTable, @dwSize, True);
  end;

  // Check result
  if (result <> ERROR_SUCCESS) then
  begin
     // Failed to get table, cleanup allocated memory
     FreeMem(TcpTable);
     // Clear the table
     TcpTable:=nil;
  end;

end;

procedure TcpCloseEnum(TcpTable: PTcpTable);
begin

  // Need to free the memory allocated by a call to open enum
  if Assigned(TcpTable) then FreeMem(TcpTable);

end;

function GetTcpTable(lpTcpTable: PTcpTable; lpdwSize: PDWORD; bOrder: BOOL): DWORD;
begin

  // Make sure the api function was bound
  if Assigned(@_GetTcpTable) then
     // Call the function
     result:=_GetTcpTable(lpTcpTable, lpdwSize, bOrder)
  else
     // Function was not bound
     result:=ERROR_PROC_NOT_FOUND;

end;

function SetTcpEntry(lpTcpRow: PTcpRow): DWORD;
begin

  // Make sure the api function was bound
  if Assigned(@_SetTcpEntry) then
     // Call the function
     result:=_SetTcpEntry(lpTcpRow)
  else
     // Function was not bound
     result:=ERROR_PROC_NOT_FOUND;

end;

initialization

  // Load the ip helper api library
  hIphlp:=LoadLibrary(LIB_IPHLPAPI);

  // Attempt to get the function addresses
  if (hIphlp > 0) then
  begin
     // Bind both the get table and set entry functions
     @_GetTcpTable:=GetProcAddress(hIpHlp, FUNC_GETTCPTABLE);
     @_SetTcpEntry:=GetProcAddress(hIpHlp, FUNC_SETTCPENTRY_NAME);
  end;

finalization

  // Clear bound functions
  @_GetTcpTable:=nil;
  @_SetTcpEntry:=nil;

  // Free the ip helper api library
  if (hIphlp > 0) then FreeLibrary(hIphlp);

end.

Ich habe selbstverständlich erstmal ausprobiert, bei "Writeout" habe ich ein "Überstzungsproblem"
Die Zeilen habe ich einfach mal ausdokumentiert (verstehe auch nicht ganz), das Programm funktioniert sogar. Jedoch nur "Clientseitig", wenn ich Port 5900 einsetze und das Programm starte wird die Verbindung unterbrochen, starte ich das Programm auf dem "Server" (HOST) dann passiert nichts.

Ausserdem fand ich noch diesen Code (habe aber noch nicht getestet...):

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, clipbrd, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    procedure ClipboardChanged(var message: TMessage); message WM_DRAWCLIPBOARD;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure JPEG(FileName:String;Quality:Integer);
var
  bmp:TBitmap;
  Jpg:TJpegImage;
begin
  bmp:=TBitmap.Create;
  jpg:=TJpegImage.Create;
  try
    bmp.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
    Jpg.CompressionQuality:=Quality;
    Jpg.Assign(bmp);
    Jpg.SaveToFile(FileName);
  finally
    jpg.Free;
    bmp.Free;
  end;
end;

procedure TForm1.ClipboardChanged(var message: TMessage);
begin
  if Clipboard.HasFormat(CF_BITMAP) then begin
    Image1.Picture.Assign(Clipboard);
    JPEG('C:\1.jpg',strtoint('100'));
    beep;
    //u could put anything u want in here for an action.
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetClipboardViewer(Form1.Handle);
end;

end.

KUBA

[kuba]

funktioniert !!

KUBA