psock.pas

DELPHI里面一些常用的控件

    FifoQ.Remove(Pointer(@Result[1]), Value);
  end;
  if Canceled then
  begin
    Canceled := False;
    raise EAbortError.Create(sPSk_Cons_msg_send_a);
    if Assigned(OnAbortrestart) then
      OnAbortrestart(self);
  end;
end;

{*******************************************************************************************
Read Line from Socket
********************************************************************************************}

function TPowersock.Readln: string;
var
  I: Integer;
  LF: string;
begin
  LF := #10;

  StatusMessage(Status_Debug, sPSk_Cons_msg_readln); {Inform status}
  Result := '';
  I := 0;
  TimerOn;
  try
    while not (TimedOut or Canceled) do
    begin
      if DataAvailable then
      begin
        I := FifoQ.Search(Pointer(LF));
        if I > 0 then
          Break;
      end;
      Wait;
    end;

    if I > 0 then
    begin
      SetLength(Result, I);
      FifoQ.Remove(PChar(@Result[1]), I);
    end;

    if Canceled then
    begin
      Canceled := False;
      raise EAbortError.Create(sPSk_Cons_msg_readln_a);
      if Assigned(OnAbortrestart) then
        OnAbortrestart(self);
    end;
  finally
    TimerOff
  end;
end;

{*******************************************************************************************
Send command To Socket and get Reply
********************************************************************************************}

function TPowersock.Transaction;
var
  I: Integer;
  temp: string;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_transa); {Inform status}
  FReplyNumber := 0; {Initialise Numerical reply}
  Writeln(CommandString); {Write Command string to Socket}
  FTransactionReply := Readln; {Get Reply}
  if Length(FTransactionReply) > 0 then
  begin
    StatusMessage(Status_Informational, FTransactionReply); {Report status}
    temp := '';
    for I := 1 to 10 do
      if (FTransactionReply[I] >= '0') and (FTransactionReply[I] <= '9') then
        temp := temp + FTransactionReply[I]
      else
        Break;
    if temp <> '' then
      FReplyNumber := StrToIntDef(temp, 0); {Extract Numerical Result if any}
  end;
  Result := FTransactionReply; {Return Reply}
end;

{*******************************************************************************************
Send File To Socket
********************************************************************************************}

procedure TPowersock.SendFile(Filename: string);
var
  strm: TFileStream;
  rc, LeftB, rc2: Integer;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_sendf); {Status Message}
  strm := TFileStream.Create(Filename, fmOpenRead);
  try
    repeat
      if not Canceled then
      begin
        rc := strm.Read(Buf, MAX_RECV_BUF);
          {If explicit buffer length given use it else get it from string length}
        LeftB := rc;
        repeat
          rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
          if rc2 = 0 then
            Break;
          if rc2 > -1 then
          begin
            LeftB := LeftB - rc2;
            FBytesSent := FBytesSent + rc2;
            if Assigned(FPacketSent) then
              FPacketSent(self);
            TimerOn;
          end
          else
            ErrorManager(WSAEWOULDBLOCK);
          Application.ProcessMessages;
        until (LeftB = 0) or Canceled;
      end;
    until (strm.position = strm.Size) or Canceled;
  finally
    strm.Free;
  end;
  if Canceled then
  begin
    Canceled := False;
    raise EAbortError.Create(sPSk_Cons_msg_send_a);
    if Assigned(OnAbortrestart) then
      OnAbortrestart(self);
  end;
end;

{*******************************************************************************************
Send File To Socket
********************************************************************************************}

procedure TPowersock.SendRestStream(MainStream: TStream);
var
  rc, LeftB, rc2, r3: Longint;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_sendstrm); {Status Message}
  if not Canceled then
  begin
      {If explicit buffer length given use it else get it from string length}
    FBytesSent := 0;
    FBytesTotal := MainStream.Size;

    repeat
      r3 := MainStream.Size - MainStream.position;
      if r3 > MAX_RECV_BUF then
        r3 := MAX_RECV_BUF;
      rc := MainStream.Read(Buf, r3);
      LeftB := rc;
      repeat
        rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
        if rc2 = 0 then
          Exit;
        if rc2 > 0 then
        begin
          LeftB := LeftB - rc2;
          FBytesSent := FBytesSent + rc2;
          TimerOn;
          if Assigned(FPacketSent) then
            FPacketSent(self);
        end
        else
          ErrorManager(WSAEWOULDBLOCK);
        Application.ProcessMessages;
      until (LeftB = 0) or Canceled;
    until (MainStream.Size = MainStream.position) or Canceled;
  end;

  if Canceled then
  begin
    Canceled := False;
    raise EAbortError.Create(sPSk_Cons_msg_send_a);
    if Assigned(OnAbortrestart) then
      OnAbortrestart(self);
  end;
end;

{*******************************************************************************************
Send File To Socket
********************************************************************************************}

procedure TPowersock.SendStream(MainStream: TStream);
var
  rc, LeftB, rc2, r3: Longint;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_sendstrm); {Status Message}
  MainStream.position := 0;

  if not Canceled then
  begin
      {If explicit buffer length given use it else get it from string length}
    FBytesSent := 0;
    FBytesTotal := MainStream.Size;
    repeat
      r3 := MainStream.Size - MainStream.position;
      if r3 > MAX_RECV_BUF then
        r3 := MAX_RECV_BUF;
      rc := MainStream.Read(Buf, r3);
      LeftB := rc;
      repeat
        rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
        if rc2 = 0 then
          Exit;
        if rc2 > 0 then
        begin
          LeftB := LeftB - rc2;
          FBytesSent := FBytesSent + rc2;
          if Assigned(FPacketSent) then
            FPacketSent(self);
        end
        else
          ErrorManager(WSAEWOULDBLOCK);
        Application.ProcessMessages;
      until (LeftB = 0) or Canceled;
    until (MainStream.Size = MainStream.position) or Canceled;
  end;

  if Canceled then
  begin
    Canceled := False;
    raise EAbortError.Create(sPSk_Cons_msg_send_a);
    if Assigned(OnAbortrestart) then
      OnAbortrestart(self);
  end;
end;

{*******************************************************************************************
Append File from Socket
********************************************************************************************}

procedure TPowersock.AppendFile(Filename: string);
var
  strm: TFileStream;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil_app); {Send status}
  strm := TFileStream.Create(Filename, fmOpenWrite); {Create file stream to read from}
  try
    strm.position := strm.Size;
    CaptureStream(strm, -2);
  finally
    strm.Free;
  end;
end;

{*******************************************************************************************
Capture File from Socket
********************************************************************************************}

procedure TPowersock.CaptureFile(Filename: string);
var
  strm: TFileStream;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil); {Send status}
  strm := TFileStream.Create(Filename, fmCreate); {Create file stream to read from}
  try
    CaptureStream(strm, -2);
  finally
    strm.Free;
  end;
end;

{*******************************************************************************************
Capture File from Socket
********************************************************************************************}

procedure TPowersock.CaptureStream(MainStream: TStream; Size: Longint);
var
  j: Longint;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_cap_strm); {Send status}
  FBytesRecvd := 0;
  TimerOn;
  try
    while (not Canceled) do
    begin
      while ((not (DataAvailable)) and (not Canceled) and (Connected) and (Size <> -1)) do
        Wait;
      j := FifoQ.BufferSize;

      if j > MAX_RECV_BUF then
        j := MAX_RECV_BUF;
      FifoQ.Remove(@Buf, j);
      MainStream.WriteBuffer(Buf, j); {Write it to stream}
      FBytesRecvd := FBytesRecvd + j;
      if Assigned(FPacketRecvd) then
        FPacketRecvd(self);
      TimerOn;
      if ((not Connected) or (MainStream.Size = Size)) or (Size = -1) then
        Break;
    end;
    if Canceled then
    begin
      Canceled := False;
      raise EAbortError.Create(sPSk_Cons_msg_cap_a);
      if Assigned(OnAbortrestart) then
        OnAbortrestart(self);
    end;
  finally
    TimerOff;
  end;
end;

{*******************************************************************************************
Capture File from Socket
********************************************************************************************}

procedure TPowersock.CaptureString(var AString: string; Size: Longint);
var
  I, j: Longint;

begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_string); {Send status}
  StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil);
  FBytesRecvd := 0;
  SetLength(AString, 0);
  TimerOn;
  try
    while (not Canceled) do
    begin
      while ((FifoQ.BufferSize = 0) and (not Canceled) and (Connected) and (Size <> -1)) do
        Wait;
      I := Length(AString);
      j := FifoQ.BufferSize;

      if Size <> -1 then
        if I + j < Size then
          j := Size - I;

      if j <> 0 then
      begin
        SetLength(AString, I + j);
        FifoQ.Remove(@AString[I + 1], j);
        FBytesRecvd := FBytesRecvd + j;
        TimerOn;
      end;

      if Assigned(FPacketRecvd) then
        FPacketRecvd(self);

      if not Connected then
        Break;
    end;

    if Canceled then
    begin
      Canceled := False;
      raise EAbortError.Create(sPSk_Cons_msg_cap_a);
      if Assigned(OnAbortrestart) then
        OnAbortrestart(self);
    end;
  finally
    TimerOff;
  end;
end;

{*******************************************************************************************
Filter out a MIME header
********************************************************************************************}

procedure TPowersock.FilterHeader(HeaderStream: TFileStream);
var
  StrIn: string;

begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_filthead); {Inform status}
  repeat
    StrIn := Readln; {Read a line}
    HeaderStream.WriteBuffer(StrIn[1], Length(StrIn)) {Write it to buffer}
  until (StrIn = LF) or (StrIn = CRLF) or (StrIn = ''); {Until blank line}
end;

{*******************************************************************************************
Initialize Socket and Listen to It
********************************************************************************************}

procedure TPowersock.Listen(sync: Boolean);

begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_Listen); {Report status}

  {Set Address to blank}
  RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, '0.0.0.0'));
  RemoteAddress.sin_family := AF_INET; {Family = Internet address}
  RemoteAddress.sin_port := htons(PORT); {Set port to given port}

  {Bind Socket to given address}
  Winsock.bind(ThisSocket, RemoteAddress, SizeOf(RemoteAddress));

  {Direct reply message to WM_WAITFORRESPONSE handler}
  if sync then
    WSAAsyncselect(ThisSocket, FSocketWindow, WM_WAITFORRESPONSE, FD_ALL)
  else
    WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL);

  {Listen to socket}
  Winsock.Listen(ThisSocket, 5);
end;

{*******************************************************************************************
Accept Input from Listening Socket
********************************************************************************************}

function TPowersock.Accept;
var
  SockHandle: TSocket;
  ASocKAddr: TSockAddr;
  Asize: Integer;