adsocket.pas

测试用例

procedure TApdSocket.DefaultHandler(var Message);
begin
end;

{ -WndProc to be used by the window handle }
procedure TApdSocket.WndProc(var Message: TMessage);
begin
  try
    Dispatch(Message);
    if Message.Msg = WM_QUERYENDSESSION then
      Message.Result := 1;
  except
    Application.HandleException(Self);
  end;
end;

{ -Shows error message in a non-exception manner }
procedure TApdSocket.ShowErrorMessage(Err : Integer);
begin
  { This is an opportunity to detect and handle Winsock load problems }
  { before the point where an exception might be raised }
end;

procedure TApdSocket.DoAccept(Socket : TSocket);
begin
  if Assigned(FOnWsAccept) then FOnWsAccept(Self, Socket);
end;

procedure TApdSocket.DoConnect(Socket : TSocket);
begin
  if Assigned(FOnWsConnect) then FOnWsConnect(Self, Socket);
end;

procedure TApdSocket.DoDisconnect(Socket : TSocket);
begin
  if Assigned(FOnWsDisconnect) then FOnWsDisconnect(Self, Socket);
end;

procedure TApdSocket.DoRead(Socket : TSocket);
begin
  if Assigned(FOnWsRead) then FOnWsRead(Self, Socket);
end;

procedure TApdSocket.DoError(Socket : TSocket; ErrCode : Integer);
begin
  if Assigned(FOnWsError) then
    FOnWsError(Self, Socket, ErrCode)
  else
    raise EApdSocketException.CreateTranslate(ErrCode, 0, 0);
end;

procedure TApdSocket.DoWrite(Socket : TSocket);
begin
  if Assigned(FOnWsWrite) then FOnWsWrite(Self, Socket);
end;

{ -Checks the status of the DLL and Winsock }
procedure TApdSocket.CheckLoaded;
begin
  if asStartErrorCode <> 0 then
    raise EApdSocketException.CreateNoInit(asStartErrorCode, nil);
end;

{ Conversion routines }

{ -Converts LongInt from Intel to Internet byte order }
function TApdSocket.htonl(HostLong : LongInt) : LongInt;
begin
  CheckLoaded;
  Result := SockFuncs.htonl(HostLong);
end;

{ -Converts Word from Intel to Internet byte order }
function TApdSocket.htons(HostShort : Word) : Word;
begin
  CheckLoaded;
  Result := SockFuncs.htons(HostShort);
end;

{ -Converts LongInt from Internet to Intel byte order }
function TApdSocket.ntohl(NetLong : LongInt) : LongInt;
begin
  CheckLoaded;
  Result := SockFuncs.ntohl(NetLong);
end;

{ -Converts Word from Internet to Intel byte order }
function TApdSocket.ntohs(NetShort : Word) : Word;
begin
  CheckLoaded;
  Result := SockFuncs.ntohs(NetShort);
end;

{ -Converts TInAddr to a XXX.XXX.XXX.XXX string }
function TApdSocket.NetAddr2String(InAddr : TInAddr) : string;
var
  TempStr : array[0..IPStrSize] of AnsiChar;
begin
  Result := '';
  CheckLoaded;
  StrCopy(TempStr, @SockFuncs.INet_NtoA(InAddr)^);
  Result := StrPas(TempStr);
end;

{ -Converts XXX.XXX.XXX.XXX string to a TInAddr }
function TApdSocket.String2NetAddr(const S : string) : TInAddr;
var
  TempStr : array[0..IPStrSize] of AnsiChar;
begin
  FillChar(Result, SizeOf(Result), #0);
  CheckLoaded;
  StrPLCopy(TempStr, S, IPStrSize);
  Result.S_addr := SockFuncs.INet_Addr(@TempStr);
end;

{ Lookup functions }

{ -Returns a name for an IP address }
function TApdSocket.LookupAddress(InAddr : TInAddr) : string;
var
  HostEnt : PHostEnt;
  TempStr : array[0..255] of AnsiChar;
begin
  Result := '';
  CheckLoaded;
  HostEnt := SockFuncs.GetHostByAddr(InAddr, SizeOf(InAddr), PF_INET);
  if Assigned(HostEnt) then
    Result := StrPas(StrCopy(TempStr, @HostEnt^.h_name^));
end;

{ -Returns an IP address for a name }
function TApdSocket.LookupName(const Name : string) : TInAddr;
var
  HostEnt : PHostEnt;
  TempStr : array[0..255] of AnsiChar;
begin
  FillChar(Result, SizeOf(Result), #0);
  CheckLoaded;
  HostEnt := SockFuncs.GetHostByName(@StrPCopy(TempStr, Name)^);
  if Assigned(HostEnt) then
    Result.S_addr := HostEnt.h_addr_list[0].S_addr;
end;

{ -Returns a service name for a port }
function TApdSocket.LookupPort(Port : Word) : string;
var
  ServEnt : PServEnt;
begin
  Result := '';
  CheckLoaded;
  ServEnt := SockFuncs.GetServByPort(htons(Port), nil);
  if Assigned(ServEnt) then
    Result := StrPas(@ServEnt^.s_name^);
end;

{ -Returns a port for a service name }
function TApdSocket.LookupService(const Service : string) : Integer;
var
  ServEnt : PServEnt;
  Temp1, Temp2 : array[0..255] of AnsiChar;
begin
  Result := 0;
  CheckLoaded;
  ServEnt := SockFuncs.GetServByName(@StrPCopy(Temp1, Service)^,
    @StrPCopy(Temp2, 'tcp')^);
  if Assigned(ServEnt) then
    Result := ntohs(ServEnt^.s_port)
end;

{ -Accepts a socket connection }
function TApdSocket.AcceptSocket(Socket : TSocket; var Address : TSockAddrIn) : TSocket;
var
  Len  : Integer;
begin
  CheckLoaded;
  Len := Sizeof(TSockAddrIn);
  Result := SockFuncs.Accept(Socket, Address, Len);
  if Result = SOCKET_ERROR then DoError(Socket, SockFuncs.WSAGetLastError);
end;

{ -Binds a socket }
function TApdSocket.BindSocket(Socket : TSocket; Address : TSockAddrIn) : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Bind(Socket, Address, Sizeof(TSockAddrIn));
  if Result = SOCKET_ERROR then DoError(Socket, SockFuncs.WSAGetLastError);
end;

{ -Closes a socket }
function TApdSocket.CloseSocket(Socket : TSocket) : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.CloseSocket(Socket);
  if Result = SOCKET_ERROR then DoError(Socket, SockFuncs.WSAGetLastError);
end;

{ -Connects to a socket }
function TApdSocket.ConnectSocket(Socket : TSocket; Address : TSockAddrIn) : Integer;
var
  ErrCode : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Connect(Socket, Address, Sizeof(TSockAddrIn));
  if Result = SOCKET_ERROR then begin
    ErrCode := SockFuncs.WSAGetLastError;
    if ErrCode <> WSAEWOULDBLOCK then DoError(Socket, ErrCode);
  end;
end;

{ -Creates a socket }
function TApdSocket.CreateSocket : TSocket;
begin
  CheckLoaded;
  Result := SockFuncs.Socket(AF_INET, SOCK_STREAM, 0);
  if Result = SOCKET_ERROR then
    raise EApdSocketException.CreateTranslate(SockFuncs.WSAGetLastError, 0, 0);
end;

{ -Listens to a socket }
function TApdSocket.ListenSocket(Socket : TSocket; Backlog : Integer) : Integer;
var
  ErrCode : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Listen(Socket, Backlog);
  if Result = SOCKET_ERROR then begin
    ErrCode := SockFuncs.WSAGetLastError;
    if ErrCode <> WSAEWOULDBLOCK then DoError(Socket, ErrCode);
  end;
end;

{ -Reads from a socket }
function TApdSocket.ReadSocket(Socket : TSocket; var Buf; BufSize, Flags : Integer) : Integer;
var
  ErrCode : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Recv(Socket, Buf, BufSize, Flags);
  if Result = SOCKET_ERROR then begin
    ErrCode := SockFuncs.WSAGetLastError;
    if ErrCode <> WSAEWOULDBLOCK then DoError(Socket, ErrCode);
  end;
end;

{ -Wait until socket has data to read or timeout (milliseconds)}
function TApdSocket.CanReadSocket(Socket : TSocket;
                                  WaitTime : Longint) : Boolean;
var
  RFDS    : TFDSet;
  Timeout : TTimeVal;
begin
  CheckLoaded;
  RFDS.fd_count := 1;
  RFDS.fd_array[0] := Socket;
  Timeout.tv_sec := WaitTime div 1000;
  Timeout.tv_usec := (WaitTime mod 1000) * 1000;
  Result := SockFuncs.Select(0, @RFDS, nil, nil, @Timeout) > 0;
end;

{ -Wait until socket can be written to or timeout (milliseconds)}
function TApdSocket.CanWriteSocket(Socket : TSocket;
                                   WaitTime : Longint) : Boolean;
var
  WFDS    : TFDSet;
  Timeout : TTimeVal;
begin
  CheckLoaded;
  WFDS.fd_count := 1;
  WFDS.fd_array[0] := Socket;
  Timeout.tv_sec := WaitTime div 1000;
  Timeout.tv_usec := (WaitTime mod 1000) * 1000;
  Result := SockFuncs.Select(0, nil, @WFDS, nil, @Timeout) > 0;
end;

{ -Shuts the socket down -- does not close the socket }
function TApdSocket.ShutdownSocket(Socket : TSocket; How : Integer) : Integer;
var
  ErrCode : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Shutdown(Socket, How);
  if Result = SOCKET_ERROR then begin
    ErrCode := SockFuncs.WSAGetLastError;
    if ErrCode <> WSAEWOULDBLOCK then DoError(Socket, ErrCode);
  end;
end;

{ -Sets the Async Styles of a Socket }
function TApdSocket.SetAsyncStyles(Socket : TSocket; lEvent : LongInt) : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.WSAAsyncSelect(Socket, Handle, CM_APDSOCKETMESSAGE, lEvent);
  if Result = SOCKET_ERROR then DoError(Socket, SockFuncs.WSAGetLastError);
end;

{ -Sets socket options } 
function TApdSocket.SetSocketOptions(Socket : TSocket; Level : Cardinal; OptName : Integer;
  var OptVal; OptLen : Integer): Integer;
begin
  CheckLoaded;
  Result := SockFuncs.SetSockOpt(Socket, Level, OptName, OptVal, OptLen);
  if Result = SOCKET_ERROR then DoError(Socket, SockFuncs.WSAGetLastError);
end;

{ -Writes to a socket }
function TApdSocket.WriteSocket(Socket : TSocket; var Buf; BufSize, Flags : Integer) : Integer;
var
  ErrCode : Integer;
begin
  CheckLoaded;
  Result := SockFuncs.Send(Socket, Buf, BufSize, Flags);
  if Result = SOCKET_ERROR then begin
    ErrCode := SockFuncs.WSAGetLastError;
    if ErrCode <> WSAEWOULDBLOCK then DoError(Socket, ErrCode);
  end;
end;


end.