Delphi-PRAXiS - Delphi Detect Remote Desktop User

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 :coder: