截取屏幕怎样才能有VNC一样的效果？？？？？？？？(100分)

它是截取GDI写屏的区域，并且和该区域原位图比较，压缩后传输。
这种方法对绕过GDI写屏的软件不起作用，所以运行有些软件时远程并不刷新。

iie:

截取GDI写屏的区域的API函数是什么呢？
如何与原位图进行比较呢？
thanks ：）

用getdc确实很慢，要是有更快的高手们不要保守，公布出来，好多这样的问题了。

具体实现不是几句话能说清楚的,你还是直接去研究一下源码吧

nvc是一种协议,基于vnc有很多改进版,相信还可做得更快,如果一考虑兼容

我用了DirectX,还是不够快呀......

呵呵，可不可以告诉我,DirectX怎么用呀。。。[]

多人接受答案了。

unit BufferUDP;

interface

uses
Windows, SysUtils, Classes, WinSock, syncobjs;

type // Main class
TUDPDataEvent = procedure(Sender: TObject; const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer) of object;
TUDPSender = class(TComponent)
private
{ Private declarations }
FHandle: TSocket;
FActive: Boolean;
FRemoteIP: String;
FRemoteHost: String;
FRemotePort: Word;
CS: TCriticalSection;
Procedure SetActive(const Value: Boolean);
Procedure SetRemoteIP(const Value: String);
Procedure SetRemoteHost(const Value: String);
Procedure SetRemotePort(const Value: Word);
protected
{ Protected declarations }
public
{ Public declarations }
Class function ResolveHost(const psHost: string; var psIP: string): u_long; virtual;
Class function ResolveIP(const psIP: string): string; virtual;
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure Connect;
Procedure Disconnect;
Function SendBuf(var Buffer; BufSize: Integer): Integer;
property Handle: TSocket read FHandle;
published
{ Published declarations }
property Active: Boolean read FActive write SetActive default False;
property RemoteIP: String read FRemoteIP write SetRemoteIP;
property RemoteHost: String read FRemoteHost write SetRemoteHost;
property RemotePort: Word read FRemotePort write SetRemotePort;
end;

TUDPReceiver = class;

TUDPReceiverThread = class(TThread)
protected
FReceiver: TUDPReceiver;
FBuffer: Pointer;
FRecvSize: Integer;
FPeer: string;
FPort: Integer;
FBufSize: Integer;
procedure SetBufSize(const Value: Integer);
public
procedure Execute; override;
procedure UDPRead;
published
Property BufSize: Integer read FBufSize write SetBufSize;
Property Receiver: TUDPReceiver read FReceiver write FReceiver;
end;

TUDPReceiver = class(TComponent)
private
{ Private declarations }
FHandle: TSocket;
FActive: Boolean;
FPort: Word;
FBufferSize: Integer;
FMulticastIP : String;
// FUDPBuffer: Pointer;
FOnUDPData: TUDPDataEvent;
FUDPReceiverThread: TUDPReceiverThread;
Procedure SetActive(const Value: Boolean);
Procedure SetPort(const Value: Word);
Procedure SetBufferSize(const Value: Integer);
procedure SetMulticastIP(const Value: String);
protected
{ Protected declarations }
public
{ Public declarations }
Class Function BindMulticast(const Socket: TSocket; const IP:String): LongInt; virtual;
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure Connect;
Procedure Disconnect;
procedure DoUDPRead(const Buffer: Pointer; const RecvSize:Integer; const Peer: string; const Port: Integer); virtual;
property Handle: TSocket read FHandle;
published
{ Published declarations }
property Active: Boolean read FActive write SetActive default False;
property Port: Word read FPort write SetPort;
property BufferSize: Integer read FBufferSize write SetBufferSize default 65000;
property OnUDPData: TUDPDataEvent read FOnUDPData write FOnUDPData;
property MulticastIP: String read FMulticastIP write SetMulticastIP;
end;

type // exception
EBufferUDP = Exception;

procedure Register;

resourcestring
EUDPNOTACTIVE = 'UDP Socket not connected';
EUDPACTIVED = 'UDP Socket already connected';
EWSAError = 'Socket Error : %d';
EUNABLERESOLVEHOST = 'Unable to resolve host: %s';
EUNABLERESOLVEIP = 'Unable to resolve IP: %s';
EZEROBYTESEND = '0 bytes were sent.';
EPACKAGETOOBIG = 'Package Size Too Big: %d';
ENOREMOTESIDE = 'Remote Host/IP not identified!';
ESIZEOUTOFBOUNDARY = 'Size value is out of boundary!';
EWSAENOBUFS = 'An operation on a socket could not be performed because the system lacked sufficient buffer space or because a queue was full.';
EWSANOTINITIALISED = 'A successful WSAStartup must occur before using this function.';
EWSAENETDOWN = 'The network subsystem has failed.';
EWSAEFAULT = 'optval is not in a valid part of the process address space or optlen argument is too small.';
EWSAEINPROGRESS = 'A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function.';
EWSAEINVAL = 'level is not valid, or the information in optval is not valid.';
EWSAENETRESET = 'Connection has timed out when SO_KEEPALIVE is set.';
EWSAENOPROTOOPT = 'The option is unknown or unsupported for the specified provider.';
EWSAENOTCONN = 'Connection has been reset when SO_KEEPALIVE is set.';
EWSAENOTSOCK = 'The descriptor is not a socket.';
EWSAUNKNOW = 'Unknow socket error.';
implementation

procedure Register;
begin
RegisterComponents('Samples', [TUDPSender, TUDPReceiver]);
end;

Type
TIMR = Packed Record
imr_multiaddr: LongInt;
imr_interface: LongInt;
End;

{ TUDPSender }

procedure TUDPSender.Connect;
Var
Faddr: TSockAddrIn;
begin
CS.Enter;
try
If FActive then
Raise EBufferUDP.CreateRes(@EUDPACTIVED);

If ((FRemoteHost='') and (FRemoteIP='')) then
Raise EBufferUDP.CreateRes(@ENOREMOTESIDE);

If Not (csDesigning in ComponentState) then
Begin
FHandle:= WinSock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
If FHandle = INVALID_SOCKET then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

with faddr do begin
sin_family := PF_INET;
sin_port := WinSock.htons(FRemotePort);
// sin_addr.s_addr := WinSock.ResolveHost(fsHost, fsPeerAddress);
if length(FRemoteIP) > 0 then begin
sin_addr.s_addr := WinSock.inet_addr(PChar(FRemoteIP));
end;
end;
WinSock.connect(FHandle, faddr, Sizeof(faddr));
End;

FActive:= True;
finally
CS.Leave;
end;
end;

constructor TUDPSender.Create(AOwner: TComponent);
begin
inherited;
CS:= TCriticalSection.Create;
FActive:= False;
FHandle := INVALID_SOCKET;
// FReceiveTimeout := -1;
end;

destructor TUDPSender.Destroy;
begin
Active:= False;
CS.Free;
inherited;
end;

procedure TUDPSender.Disconnect;
Var
OldHandle: TSocket;
begin
CS.Enter;
try
If FActive then
Begin
OldHandle:= FHandle;
FHandle:= INVALID_SOCKET;
CloseSocket(OldHandle);
End;
finally
FActive:= False;
CS.Leave;
end;
end;

class function TUDPSender.ResolveHost(const psHost: string;
var psIP: string): u_long;
Var
pa: PChar;
sa: TInAddr;
aHost: PHostEnt;
begin
psIP := psHost;
// Sometimes 95 forgets who localhost is
if CompareText(psHost, 'LOCALHOST') = 0 then
begin
sa.S_un_b.s_b1 := #127;
sa.S_un_b.s_b2 := #0;
sa.S_un_b.s_b3 := #0;
sa.S_un_b.s_b4 := #1;
psIP := '127.0.0.1';
Result := sa.s_addr;
end else begin
// Done if is tranlated (ie There were numbers}
Result := inet_addr(PChar(psHost));
// If no translation, see if it resolves}
if Result = u_long(INADDR_NONE) then begin
aHost := Winsock.GetHostByName(PChar(psHost));
if aHost = nil then
begin
Result:= 0;
psIP:= '';
Exit;
//Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEHOST, [psHost]);
end else
begin
pa := aHost^.h_addr_list^;
sa.S_un_b.s_b1 := pa[0];
sa.S_un_b.s_b2 := pa[1];
sa.S_un_b.s_b3 := pa[2];
sa.S_un_b.s_b4 := pa[3];
psIP:= String(inet_ntoa(sa));
//psIP := TInAddrToString(sa);
end;
Result := sa.s_addr;
end;
end;
end;

class function TUDPSender.ResolveIP(const psIP: string): string;
var
i: Integer;
P: PHostEnt;
begin
result := '';
if CompareText(psIP, '127.0.0.1') = 0 then
begin
result := 'LOCALHOST';
end else
begin
i := Winsock.inet_addr(PChar(psIP));
P := Winsock.GetHostByAddr(@i, 4, PF_INET);
If P = nil then
Begin
Result:= '';
Exit;
// Raise EBufferUDP.CreateResFmt(@EUNABLERESOLVEIP, [psIP]);
//CheckForSocketError2(SOCKET_ERROR, [WSANO_DATA]);
End else
Begin
result := P.h_name;
End;
end;
end;

Function TUDPSender.SendBuf(var Buffer; BufSize: Integer): Integer;
begin
CS.Enter;
try
Result:= 0;
If BufSize<=0 then
Exit;
If Not FActive then
Raise EBufferUDP.CreateRes(@EUDPNOTACTIVE);

Result:= Winsock.send(FHandle, Buffer, BufSize, 0);
If Result<>BufSize then
Begin
Case Result of
0:
Raise EBufferUDP.CreateRes(@EZEROBYTESEND);
SOCKET_ERROR:
If WSAGetLastError = WSAEMSGSIZE then
Raise EBufferUDP.CreateResFmt(@EPACKAGETOOBIG, [BufSize])
End;{CASE}
End;
finally
CS.Leave;
end;
end;

procedure TUDPSender.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
If Value then
Connect
Else
Disconnect;
End;
end;

procedure TUDPSender.SetRemoteHost(const Value: String);
Var
IsConnected: Boolean;
begin
If FRemoteHost<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemoteHost:= Value;
If Not (csDesigning in ComponentState) then
ResolveHost(FRemoteHost, FRemoteIP);
// Resovle IP
Active:= IsConnected;
End;
end;

procedure TUDPSender.SetRemoteIP(const Value: String);
Var
IsConnected: Boolean;
begin
If FRemoteIP<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemoteIP:= Value;
// Resovle Host name
If Not (csDesigning in ComponentState) then
FRemoteHost:= ResolveIP(FRemoteIP);
Active:= IsConnected;
End;
end;

procedure TUDPSender.SetRemotePort(const Value: Word);
Var
IsConnected: Boolean;
begin
If FRemotePort<>Value then
Begin
IsConnected:= Active;
Active:= False;
FRemotePort:= Value;
Active:= IsConnected;
End;
end;

{ TUDPReceiver }

class function TUDPReceiver.BindMulticast(const Socket: TSocket;
const IP: String): LongInt;
Var
lpMulti: TIMR;
Begin
lpMulti.imr_multiaddr := inet_addr(PChar(IP));
lpMulti.imr_interface := 0;
Result:= SetSockOpt(Socket, IPPROTO_IP, IP_ADD_MEMBERSHIP, @lpMulti, Sizeof(lpMulti));
End;

procedure TUDPReceiver.Connect;
var
m_addr: TSockAddrIn;
begin
If FActive then
Raise EBufferUDP.CreateRes(@EUDPACTIVED);

If csDesigning in ComponentState then
Begin
FActive:= True;
Exit;
End;

// SOCKET
FHandle := Winsock.Socket(PF_INET, SOCK_DGRAM, IPPROTO_IP);
If FHandle = INVALID_SOCKET then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

// BIND
With m_addr do begin
sin_family := PF_INET;
sin_port := Winsock.htons(FPort);
sin_addr.s_addr := INADDR_ANY;
End;
If WinSock.bind(FHandle, m_addr, Sizeof(m_addr))=SOCKET_ERROR then
Raise EBufferUDP.CreateResFmt(@EWSAError, [WSAGetLastError]);

// Bind Multicast
If FMulticastIP<>'' then
If BindMulticast(FHandle, FMulticastIP)=SOCKET_ERROR then
Case WSAGetLastError of
WSAENOBUFS: Raise EBufferUDP.CreateRes(@EWSAENOBUFS );
WSANOTINITIALISED: Raise EBufferUDP.CreateRes(@EWSANOTINITIALISED);
WSAENETDOWN: Raise EBufferUDP.CreateRes(@EWSAENETDOWN );
WSAEFAULT: Raise EBufferUDP.CreateRes(@EWSAEFAULT );
WSAEINPROGRESS: Raise EBufferUDP.CreateRes(@EWSAEINPROGRESS );
WSAEINVAL: Raise EBufferUDP.CreateRes(@EWSAEINVAL );
WSAENETRESET: Raise EBufferUDP.CreateRes(@EWSAENETRESET );
WSAENOPROTOOPT: Raise EBufferUDP.CreateRes(@EWSAENOPROTOOPT );
WSAENOTCONN: Raise EBufferUDP.CreateRes(@EWSAENOTCONN );
WSAENOTSOCK: Raise EBufferUDP.CreateRes(@EWSAENOTSOCK );
Else
Raise EBufferUDP.CreateRes(@EWSAUNKNOW);
End; {CASE}

// Thread read
FUDPReceiverThread := TUDPReceiverThread.Create(True);
With FUDPReceiverThread do
Begin
Receiver:= Self;
BufSize:= FBufferSize;
FreeOnTerminate := True;
Resume;
End;

FActive:= True;
end;

constructor TUDPReceiver.Create(AOwner: TComponent);
begin
inherited;
FHandle := INVALID_SOCKET;
FActive:= False;
FBufferSize:= 65000;
FMulticastIP:= '';
end;

destructor TUDPReceiver.Destroy;
begin
Active:= False;
inherited;
end;

procedure TUDPReceiver.Disconnect;
Var
OldHandle: TSocket;
begin
If Not FActive then
Exit;

try
OldHandle:= FHandle;
FHandle:= INVALID_SOCKET;
CloseSocket(OldHandle);
finally
FActive:= False;
end;

If FUDPReceiverThread <> nil then
Begin
FUDPReceiverThread.Terminate;
FUDPReceiverThread.WaitFor;
End;
end;

procedure TUDPReceiver.DoUDPRead(const Buffer: Pointer; const RecvSize:Integer;
const Peer: string; const Port: Integer);
begin
If Assigned(FOnUDPData) then begin
FOnUDPData(Self, Buffer, RecvSize, Peer, Port);
End;
end;

procedure TUDPReceiver.SetActive(const Value: Boolean);
begin
If FActive<>Value then
Begin
If Value then
Connect
Else
Disconnect;
End;
end;

procedure TUDPReceiver.SetBufferSize(const Value: Integer);
begin
If FBufferSize<>Value then
Begin
If ((Value>=1024) and (Value<=65000)) then
FBufferSize:= Value
Else
Raise EBufferUDP.CreateRes(@ESIZEOUTOFBOUNDARY);
End;
end;

procedure TUDPReceiver.SetMulticastIP(const Value: String);
Var
IsConnected: Boolean;
begin
If Value<>FMulticastIP then
Begin
IsConnected:= Active;
Active:= False;
FMulticastIP:= Value;
Active:= IsConnected;
End;
end;

procedure TUDPReceiver.SetPort(const Value: Word);
Var
IsConnected: Boolean;
begin
If FPort<>Value then
Begin
IsConnected:= Active;
Active:= False;
FPort:= Value;
Active:= IsConnected;
End;
end;

{ TUDPReceiverThread }

procedure TUDPReceiverThread.Execute;
var
i: Integer;
addr_remote: TSockAddrin;
arSize: Integer;
begin
GetMem(FBuffer, FBufSize);
arSize:= SizeOf(addr_remote);
while FReceiver.Active and not Terminated do
Begin
i := arSize;
FRecvSize := Winsock.RecvFrom(FReceiver.Handle, FBuffer^, FBufSize, 0, addr_remote, i);
If FReceiver.Active and (FRecvSize>0) then
Begin
//fsData := Copy(fListener.fsUDPBuffer, 1, iByteCount);
FPeer := String(inet_ntoa(addr_remote.sin_addr));
//FPeer := String(TWinshoe.TInAddrToString(addr_remote.sin_addr));
FPort := Winsock.NToHS(addr_remote.sin_port);
Synchronize(UDPRead);
End;
End;
FreeMem(FBuffer);
end;

procedure TUDPReceiverThread.SetBufSize(const Value: Integer);
begin
If FBufSize<> Value then
FBufSize:= Value;
end;

procedure TUDPReceiverThread.UDPRead;
begin
FReceiver.DoUDPRead(FBuffer, FRecvSize, FPeer, FPort);
end;

Var
GWSADATA: TWSADATA;
initialization
WSAStartup(MakeWord(2, 0), GWSADATA);
finalization
WSACleanup;
end.