psock.pas

DELPHI里面一些常用的控件

      {If Remote host handler exists execute it}
    if Assigned(FOnHostResolved) then
      FOnHostResolved(self);
  end;
end;

{*******************************************************************************************
Abort a Socket
********************************************************************************************}

procedure TPowersock.Abort;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_Abort); {Inform status}
  Cancel;
end;

{*******************************************************************************************
Close a Socket
********************************************************************************************}

procedure TPowersock.Close(Socket: THandle);
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_CloseSock); {Inform status}
  CloseSocket(Socket); {Close socket}
end;

{*******************************************************************************************
Get IP Address of remote machine in dotted decimal notation
********************************************************************************************}

function TPowersock.GetRemoteIP: string;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_GetRemoteIP); {Inform status}
  Result := inet_ntoa(RemoteAddress.sin_addr);
end;

{*******************************************************************************************
Get IP Address of local machine in dotted decimal notation
********************************************************************************************}

function TPowersock.GetLocalIP: string;
var
  pH: PHostEnt;
  T: PChar;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_GetLocalIP); {Inform status}
  T := AllocMem(200);
  try
    gethostname(T, 200);
    pH := gethostbyname(T);
    Result := Format('%d.%d.%d.%d', [Ord(pH.h_addr_list^[0]), Ord(pH.h_addr_list^[1]), Ord(pH.h_addr_list^[2]), Ord(pH.h_addr_list^[3])]);
  finally
    FreeMem(T, 200);
  end;
end;

{*******************************************************************************************
Get Address String of Local Machine
********************************************************************************************}

function TPowersock.GetLocalAddress;
var
  sockaddr: TSockAddrIn;
  iSize, Commas: Integer;
  P: PChar;
begin
  iSize := SizeOf(TSockAddr); {Size of Address structure}
  {Get Local Socket info}
  getsockname(ThisSocket, sockaddr, iSize);
  P := inet_ntoa(sockaddr.sin_addr);
  iSize := 0;
  Commas := 0;

  while Commas < 3 do
  begin
    if P[iSize] = '.' then
    begin
      P[iSize] := ',';
      inc(Commas);
    end;
    inc(iSize);
  end;

  Result := StrPas(P);
end;

{*******************************************************************************************
Get Port String of a listening Port
********************************************************************************************}

function TPowersock.GetPortString;
var
  sockaddr: TSockAddrIn;
  iSize: Integer;
begin
  iSize := SizeOf(TSockAddr); {Size of Address structure}
  getsockname(ThisSocket, sockaddr, iSize);

  with sockaddr do {Format IP address to required string type}
    Result := Format(',%d,%d', [Lo(sin_port), Hi(sin_port)]);
end;

procedure TPowersock.SetFifoCapacity(NewCapacity: Longint);
begin
  FifoQ.MemoryBufferCapacity := NewCapacity;
end;

function TPowersock.GetFifoCapacity: Longint;
begin
  Result := FifoQ.MemoryBufferCapacity;
end;

{*******************************************************************************************
********************************************************************************************
********************************************************************************************}

{ TTimer }

constructor TThreadTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 1000;
  FWindowHandle := TmrAllocateHWnd(self);
end;

destructor TThreadTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  DestroyWindow(FWindowHandle);
  inherited Destroy;
end;

procedure TThreadTimer.Wndproc(var Msg: TMessage);
begin
  with Msg do
    if Msg = WM_TIMER then
    try
      Timer;
    except
      Application.HandleException(self);
    end
    else
      Result := DefWindowProc(0, Msg, WPARAM, LPARAM);
end;

procedure TThreadTimer.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
    if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
      raise Exception.Create(sPSk_Cons_msg_NoTimer);
end;

procedure TThreadTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    UpdateTimer;
  end;
end;

procedure TThreadTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;

procedure TThreadTimer.SetOnTimer(Value: TNotifyEvent);
begin
  FOnTimer := Value;
  UpdateTimer;
end;

procedure TThreadTimer.Timer;
begin
  if Assigned(FOnTimer) then
    FOnTimer(self);
end;

{*******************************************************************************************
********************************************************************************************
********************************************************************************************}

{*******************************************************************************************
Create Server - If Demo version handles demo Registering
********************************************************************************************}

constructor TNMGeneralServer.Create;
var
  Tp: TClass;
begin
  inherited Create(AOwner);
  Tp := AOwner.ClassType;
  ATlist := nil;
  repeat
    if Tp = TNMGeneralServer then
      Break
    else
      Tp := Tp.ClassParent;
  until Tp = nil;
  if Tp = nil then
    ATlist := TThreadList.Create;
end;

destructor TNMGeneralServer.Destroy;
begin
  try
    try
      Abort;
    finally
      if ATlist <> nil then
        ATlist.Free;
      ATlist := nil;
    end;
  finally
    inherited Destroy;
  end;
end;

{*******************************************************************************************
Override connect so no inherited connection
********************************************************************************************}

procedure TNMGeneralServer.Connect;
begin
  {Does not call inherited connect}
end;

{*******************************************************************************************
On Loading the General Sever. Set the ServerAccept method to handle accepts from
a client and start listening for connections.
********************************************************************************************}

procedure TNMGeneralServer.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
  begin
    OnAccept := ServerAccept;
    Listen(False);
  end;
end;

procedure TNMGeneralServer.Abort;
var
  x: Integer;
begin
  if ATlist <> nil then
  begin
    with ATlist.LockList do
    try
      for x := 0 to Count - 1 do
        TNMGeneralServer(Items[x]).Cancel;
    finally
      ATlist.UnlockList;
    end;
  end;
end;

{*******************************************************************************************
The method to accept a connection from a client.  It kicks off a thread to handle a client
and resumes listning on the original socket.
********************************************************************************************}

procedure TNMGeneralServer.ServerAccept;
begin
  ExecuteInThread(DisPatchResponse, nil);
end;

procedure TNMGeneralServer.DisPatchResponse(data: Pointer);
var
  ServSock: TNMGeneralServer;
begin
  ServSock := TNMGeneralServer(TComponentClass((self.ClassType())).Create(Owner));
  ServSock.FConnected := True;
  ServSock.RemoteAddress := RemoteAddress;
  ServSock.OnConnect := OnConnect;
  ServSock.OnDisconnect := OnDisconnect;
  Winsock.CloseSocket(ServSock.ThisSocket);
  Wait_Flag := True;
  ServSock.ThisSocket := Accept;
  WSAAsyncselect(ServSock.ThisSocket, ServSock.FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL); {To direct messages to clientsocket}
  ATlist.Add(ServSock);
  ServSock.Chief := self;
  ServSock.Serve;
  ATlist.Remove(ServSock);
  ServSock.Destroy;
end;

{*******************************************************************************************
The base server metod for GeneralServer. This has to be overridden by a derived
server to provide the servers functionality.
********************************************************************************************}

procedure TNMGeneralServer.Serve;
begin
end;

{*******************************************************************************************
********************************************************************************************
********************************************************************************************}

{$IFNDEF NMF3}

{ TStringStream }

constructor TStringStream.Create(const AString: string);
begin
  inherited Create;
  FDataString := AString;
end;

function TStringStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := Length(FDataString) - FPosition;
  if Result > Count then
    Result := Count;
  Move(PChar(@FDataString[FPosition + 1])^, Buffer, Result);
  inc(FPosition, Result);
end;

function TStringStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := Count;
  SetLength(FDataString, (FPosition + Result));
  Move(Buffer, PChar(@FDataString[FPosition + 1])^, Result);
  inc(FPosition, Result);
end;

function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent: FPosition := FPosition + Offset;
    soFromEnd: FPosition := Length(FDataString) - Offset;
  end;
  if FPosition > Length(FDataString) then
    FPosition := Length(FDataString)
  else if FPosition < 0 then
    FPosition := 0;
  Result := FPosition;
end;

function TStringStream.ReadString(Count: Longint): string;
var
  Len: Integer;
begin
  Len := Length(FDataString) - FPosition;
  if Len > Count then
    Len := Count;
  SetString(Result, PChar(@FDataString[FPosition + 1]), Len);
  inc(FPosition, Len);
end;

procedure TStringStream.WriteString(const AString: string);
begin
  Write(PChar(AString)^, Length(AString));
end;

procedure TStringStream.SetSize(NewSize: Longint);
begin
  SetLength(FDataString, NewSize);
  if FPosition > NewSize then
    FPosition := NewSize;
end;

{*******************************************************************************************
********************************************************************************************
********************************************************************************************}

{ TThreadList }

constructor TThreadList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TThreadList.Destroy;
begin
  LockList; // Make sure nobody else is inside the list.
  try
    FList.Free;
    inherited Destroy;
  finally
    UnlockList;
  end;
end;

procedure TThreadList.Add(Item: Pointer);
begin
  LockList;
  try
    if FList.IndexOf(Item) = -1 then
      FList.Add(Item);
  finally
    UnlockList;
  end;
end;

procedure