simplesocks.pas

由delphi实现的bt下载器示例程序

      FOwner.Lock;
      try
        FOwner.FClients.InsertItem(pointer(ahandle), pointer(self), true);
      finally
        FOwner.Unlock;
      end;
    except
    end;
  end;
end;

destructor TSimpleSock.Destroy;
begin
  inherited;
  DeleteCriticalSection(FLock);
end;

procedure TSimpleSock.Close;
begin
  try
    if Handle >= 0 then
     sockslist.DeleteItem(pointer(Handle));
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TSimpleSock.Close error: '+e.message);
  {$ENDIF}
  end;
end;

procedure TSimpleSock.DoEvent(WParam, LParam: Integer);
var
  tmp: string;
  l, err, h: Integer;
  a: TSockAddrIn;
  s: TSimpleSock;
  f: Boolean;
begin
  try
    case WParam of
      FD_ERROR:
      begin
        if assigned(feventhandle) then
          feventhandle(self, WParam, Handle, LParam);
        if LParam <> WSAEINPROGRESS then
          close;
      end;
      FD_READ:
      begin
        setlength(tmp, 8192);
        f := false;
        repeat
          l := recv(Handle, tmp[1], 8192, 0);
          if l < 0 then
          begin
            err := wsagetlasterror;
            if err <> WSAEWOULDBLOCK then
            begin
              if (err <> WSAEINPROGRESS) then
              begin
                if assigned(feventHandle) then
                  feventhandle(self, FD_ERROR, Handle, err);
                close;
              end;
              exit;
            end;
          end
          else begin
              Lock;
              try
                FRecvBuffer := fRecvBuffer + copy(tmp, 1, l);
              finally
                Unlock;
              end;
            lastread := gettickcount;
            recvbytes := l;
            f := true;
          end;
        until l <= 0;
        if f and assigned(feventhandle) then
        begin
          Lock;
          try
            tmp := frecvbuffer;
            frecvbuffer := '';
          finally
            unlock;
          end;
          l := length(tmp);
          if l > 0 then
          begin
            feventhandle(self, FD_READ, tmp[1], l);
            delete(tmp, 1, length(tmp) - l);
            if length(tmp) > 0 then
            begin
              lock;
              try
                frecvbuffer := tmp + frecvbuffer;
              finally
                unlock;
              end;
            end;
          end;
        end;
        wsaasyncselect(handle, sockwnd.Wnd, XM_SOCK, FD_READ or FD_WRITE or FD_CLOSE);
      end;
      FD_WRITE:
      begin
        Lock;
        try
          tmp := fsendbuffer;
          fsendbuffer := '';
        finally
          Unlock;
        end;
        while length(tmp) > 0 do
        begin
          l := winsock.send(Handle, tmp[1], length(tmp), 0);
          if l < 0 then
          begin
            err := wsagetlasterror;
            if (err <> WSAEWOULDBLOCK) and (err <> WSAEINPROGRESS) then
            begin
              if assigned(feventhandle) then
                feventhandle(self, FD_ERROR, Handle, err);
              close;
            end
            else begin
              Lock;
              try
                fsendbuffer := tmp + fsendbuffer;
              finally
                Unlock;
              end;
            end;
            exit;
          end
          else begin
            delete(tmp, 1, l);
            sendbytes := l;
            lastsend := gettickcount;
            Lock;
            try
              tmp := tmp + fsendbuffer;
              fsendbuffer := '';
            finally
              Unlock;
            end;
            if assigned(feventhandle) and (tmp = '') then
            begin
              l := 0;
              feventhandle(self, FD_WRITE, handle, l);
            end;
          end;
        end;
      end;
      FD_ACCEPT:
      begin
        l := sizeof(a);
        h := accept(Handle, @a, @l);
        if h < 0 then
        begin
          err := wsagetlasterror;
          if assigned(feventhandle) then
            feventhandle(self, FD_ERROR, Handle, err);
        end
        else begin
          if assigned(feventhandle) then
            feventhandle(self, FD_ACCEPT, a, l);
          if l > 0 then
          begin
            s := TSimpleSock.Create(self, h);
            move(a, s.Addr, l);
            s.FEventHandle := FEventHandle;
            s.WorkInThread := WorkInThread;
            wsaasyncselect(h, sockwnd.Wnd, XM_SOCK, FD_READ or FD_WRITE or FD_CLOSE);
            if assigned(feventhandle) then
              feventhandle(s, FD_CONNECT, h, l);
          end
          else closesocket(h);
        end;
      end;
      FD_CONNECT:
      begin
        if assigned(feventhandle) then
          feventhandle(self, FD_CONNECT, Handle, l);
      end;
      FD_CLOSE:
        close;
    end;
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TSimpleSock.DoEvent('+Inttohex(wparam, 4)+','+inttostr(lparam)+') error: '+e.message);
  {$ENDIF}
  end;
end;

function TSimpleSock.GetCurrentRecv: Integer;
begin
  result := fcurrrecv;
  fcurrrecv := 0;
end;

function TSimpleSock.GetCurrentSend: Integer;
begin
  result := fcurrsend;
  fcurrsend := 0;
end;

procedure TSimpleSock.Lock;
begin
  entercriticalsection(flock);
end;

function TSimpleSock.TryLock(TimeOut: Cardinal): Boolean;
var
  tick: Cardinal;
begin
  tick := GetTickCount;
  result := tryentercriticalsection(flock);
  while not result and (gettickcount - tick < timeout) do
  begin
    sleep(1);
    result := tryentercriticalsection(flock);
  end;
end;

procedure TSimpleSock.Unlock;
begin
  leavecriticalsection(flock);
end;

procedure TSimpleSock.DeleteSelf;
var
  buf: PPointerList;
  i, l: Integer;
begin
  try
    if handle < 0 then exit;
    closesocket(handle);
    if fclients <> nil then
    begin
      Lock;
      try
        with TListRef(fclients) do
        begin
          l := FCount;
          buf := FList;
          FList := nil;
          FCount := 0;
          FCapacity := 0;
        end;
      finally
        Unlock;
      end;
      if l > 0 then
      begin
        for i := 0 to l - 1 do
          with TSimpleSock(buf[i]) do
          begin
            FOwner := nil;
            Close;
          end;
        dispose(buf);
      end;
    end;
    if fowner <> nil then
    begin
      if fowner.FClients <> nil then
        fowner.FClients.DeleteItem(pointer(handle));
    end;
    if assigned(feventhandle) then
      feventhandle(self, FD_CLOSE, Handle, Handle);
    handle := -1;
    delayrelease(self);
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TSimpleSock.DeleteSelf error: '+e.message);
  {$ENDIF}
  end;
end;

procedure TSimpleSock.Send(s: string);
var
  buf: PPointerList;
  i, l: Integer;
begin
  try
    if fclients = nil then
    begin
      Lock;
      try
        if handle > 0 then
          fsendbuffer := fsendbuffer+s;
      finally
        Unlock;
      end;
      doevent(FD_WRITE, 0);
    end
    else begin
      buf := nil;
      Lock;
      try
        l := fclients.Count;
        if l > 0 then
        begin
          getmem(buf, l * 4);
          move(fclients.list^, buf^, l * 4);
        end;
      finally
        Unlock;
      end;
      if l > 0 then
      begin
        for i := 0 to l - 1 do
          TSimpleSock(buf[i]).Send(s);
        dispose(buf);
      end;
    end;
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TSimpleSock.Send('+s+') error: '+e.message);
  {$ENDIF}
  end
end;

procedure TSimpleSock.Send(const Buf; Len: Integer);
begin
  if Len > 0 then
    send(makebuffer([@buf, Len]));
end;

procedure TSimpleSock.SetRecvBytes(const Value: Integer);
begin
  inc(frecvbytes, value);
  inc(fcurrrecv, value);
  if FOwner <> nil then
    fowner.RecvBytes := value;
end;

procedure TSimpleSock.SetSendBytes(const Value: Integer);
begin
  inc(fsendbytes, value);
  inc(fcurrsend, value);
  if fowner <> nil then
    fowner.SendBytes := value;
end;

procedure TSimpleSock.Put(s: string);
var
  buf: PPointerList;
  i, l: Integer;
begin
  try
    if fclients = nil then
    begin
      Lock;
      try
        if handle > 0 then
          fsendbuffer := fsendbuffer+s;
      finally
        Unlock;
      end;
    end
    else begin
      buf := nil;
      Lock;
      try
        l := fclients.Count;
        if l > 0 then
        begin
          getmem(buf, l * 4);
          move(fclients.list^, buf^, l * 4);
        end;
      finally
        Unlock;
      end;
      if l > 0 then
      begin
        for i := 0 to l - 1 do
          TSimpleSock(buf[i]).Put(s);
        dispose(buf);
      end;
    end;
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TSimpleSock.Put('+s+') error: '+e.message);
  {$ENDIF}
  end
end;

procedure TSimpleSock.Put(const Buf; Len: Integer);
begin
  if Len > 0 then
    Put(makebuffer([@buf, Len]));
end;

function TSimpleSock.GetBufferUsed: Integer;
begin
  Lock;
  Result := Length(FSendBuffer);
  Unlock;
end;

initialization
  initsocks;

finalization
  finalsocks;

end.