bufferudp.pas

DELPHI实现的快速屏幕截图并发送源代码

    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.