unit MainUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, winsock;

type
 THTTPProxyForm = class(TForm)
   bnStart: TButton;
   Label1: TLabel;
   edPort: TEdit;
   Label2: TLabel;
   edExtProxyAddr: TEdit;
   Label3: TLabel;
   edExtProxyPort: TEdit;
   procedure bnStartClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 HTTPProxyForm: THTTPProxyForm;

implementation

uses ServerThreadUnit;

{$R *.dfm}

procedure THTTPProxyForm.bnStartClick(Sender: TObject);
var
st:TServerThread;
begin
st:=TServerThread.Create(true);
st.iLocalPort:=StrToIntDef(edPort.Text, 8088);
st.iExtProxyPort:=StrToIntDef(edExtProxyPort.Text, 8080);
st.sExtProxyAddr:=edExtProxyAddr.Text;
st.Resume;
end;

procedure THTTPProxyForm.FormCreate(Sender: TObject);
var
wData : WSADATA;
begin
// Загрузка WinSock
if WSAStartup(MAKEWORD(1,1), wData) <> 0 then
begin
  MessageBox(0, 'Не могу загрузить WinSock', 'Ошибка', 0);
  exit;
end;
end;

end.

unit ServerThreadUnit;

interface

uses
 Classes, winsock, windows;

type
 TServerThread = class(TThread)
 private
   { Private declarations }
 protected
   procedure Execute; override;
 public
  iLocalPort, iExtProxyPort:Integer;
  sExtProxyAddr:String;
 end;

implementation

uses ClientThreadUnit;

procedure TestWinSockError(S:String);
var
iErr:Integer;
sFullErr:String;
begin
sFullErr:='Неизвестная ошибка';
iErr:=WSAGetLastError();

case iErr of
 WSANOTINITIALISED: sFullErr:='Нужно сначала вызвать функцию WSASturtup, а потом создавать сокет';
WSAENETDOWN: sFullErr:='Cвязь нарушена, возможные причины - отошёл кабель или отключились от Интернета';
WSAEADDRINUSE: sFullErr:='Указанный адрес уже используется';
WSAEFAULT: sFullErr:='Параметры name и namelen не соответствуют выбранной адресации. Параметр namelen может быть меньше необходимого значения, а name содержать некорректные данные';
WSAEINPROGRESS: sFullErr:='Выполняется операция в блокирующем режиме. Вы уже запустили на выполнение какую-то функцию и нужно дождаться завершения её работы';
WSAEINVAL: sFullErr:='Сокет уже связан с адресом';
WSAENOBUFS: sFullErr:='Недостаточно буферов, слишком много соединений';
WSAENOTSOCK: sFullErr:='Неверный дескриптор сокета';
 WSAEISCONN: sFullErr:='Сокет уже подключён';
 WSAEMFILE: sFullErr:='Нет больше доступных дескрипторов';
end;

MessageBox(0, PChar('Ошибка в функции '+S+' - '+sFullErr), 'Ошибка', 0);
end;

function TestFuncError(iErr:Integer; FuncName:String):Boolean;
begin
Result:=false;
if iErr = SOCKET_ERROR then
 begin
  TestWinSockError(FuncName);
  Result:=true;
 end;
end;

procedure TServerThread.Execute;
var
sServerListen, stClientSocket : TSOCKET;
localaddr : sockaddr_in;
ct : TClientThread;
begin
// Создание сокета
sServerListen := socket(AF_INET, SOCK_STREAM, 0);
if sServerListen = INVALID_SOCKET then
 begin
  MessageBox(0, 'Ошибка создания сокета', 'Ошибка', 0);
  exit;
 end;

// Запонение структуры адреса
localaddr.sin_addr.s_addr := htonl(INADDR_ANY);
localaddr.sin_family := AF_INET;
localaddr.sin_port := htons(iLocalPort);

// Связывание сокета с локальным адресом
if TestFuncError(bind(sServerListen, localaddr, sizeof(localaddr)), 'bind') then
 exit;

if TestFuncError(listen(sServerListen, 4), 'Listen') then
 exit;

while true do
 begin
  stClientSocket := accept(sServerListen, nil, nil);
  if stClientSocket=INVALID_SOCKET then
   continue;

  ct:=TClientThread.Create(true);
  ct.stClient := stClientSocket;
  ct.iExtProxyPort := iExtProxyPort;
  ct.sExtProxyAddr := sExtProxyAddr;
  ct.Resume;
 end;
end;

end.

unit ClientThreadUnit;

interface

uses
 Classes, winsock, sysutils, windows;

type
 TClientThread = class(TThread)
 private
   { Private declarations }
 protected
   procedure Execute; override;
 public
   iExtProxyPort:Integer;
   sExtProxyAddr:String;
   stClient:TSocket;
 end;

implementation

{ TClientThread }

function LookupName(name:String): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
if name[4]='.' then
 InAddr.s_addr := inet_addr(PChar(name))
else
 begin
 HostEnt := gethostbyname(PChar(name));
 FillChar(InAddr, SizeOf(InAddr), 0);
 if HostEnt <> nil then
  begin
   with InAddr, HostEnt^ do
    begin
     S_un_b.s_b1 := h_addr^[0];
     S_un_b.s_b2 := h_addr^[1];
     S_un_b.s_b3 := h_addr^[2];
     S_un_b.s_b4 := h_addr^[3];
    end;
  end
 end;
 Result := InAddr;
end;

procedure SendStr(s:TSocket; str:String);
var
sRecvBuff : array [0..255] of char;
TempStr : AnsiString;
begin
TempStr:=str+#13+#10;
CopyMemory(@sRecvBuff, PChar(TempStr), Length(TempStr));
send(s, sRecvBuff, Length(TempStr), 0);
end;

procedure TClientThread.Execute;
var
Buff: array [0..1024] of char;
iPort: Integer;
sRequest, sHost:String;
server_addr : sockaddr_in;
sock_server : TSocket;
iMode, iSize : Integer;
rfds : TFDSET;
begin
////////////////////////////
//Считывание заголовка
Recv(stClient, Buff, 1024, 0);

sRequest:=String(Buff);

// Нет заголовка
if sRequest='' then
 begin
  CloseSocket(stClient);
  exit;
 end;

////////////////////////////
// Выдераем адрес сервера и порт
sHost:=Copy(sRequest, Pos('Host: ', sRequest), 255);
Delete(sHost, Pos(#13, sHost), 255);
Delete(sHost, 1, 6);
iPort:=StrToIntDef(Copy(sHost, Pos(':', sHost)+1, 255), 80);
Delete(sHost, Pos(':', sHost), 255);

// Если не найден host то ошибка
if sHost='' then
 begin
  SendStr(stClient, 'HTTP/1.0 400 Invalid header received from browser');
  CloseSocket(stClient);
  exit;
 end;

// Если есть внешний проксик, то перенаправляем на него
if sExtProxyAddr<>'' then
 begin
   iPort := iExtProxyPort;
   sHost := sExtProxyAddr;
 end;

sock_server := socket(AF_INET, SOCK_STREAM, 0);

// Ищем сервер/проксик
server_addr.sin_addr.s_addr := htonl(INADDR_ANY);
server_addr.sin_family := AF_INET;
server_addr.sin_port := htons(iPort);
server_addr.sin_addr := LookupName(sHost);

//Соединение с сервером
if connect(sock_server, server_addr, sizeof(server_addr))=SOCKET_ERROR then
 begin
  SendStr(stClient, '404 Host Not Found');
  exit;
 end;

iMode:=1;
setsockopt(sock_server, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof (integer));

// Перенаправляем запрос серверу или другому проксику
send(sock_server, buff, strlen(buff),0);

// Теперь работаем посредником между клиентом и сервером
// передавая запрошенные данные
while true do
 begin
  // Добавляем сокеты в набор для ожидания
  FD_ZERO(rfds);
  FD_SET(stClient, rfds);
  FD_SET(sock_server, rfds);

  if (select(0, @rfds, nil, nil, nil) < 0) then
   exit;

  // Если пришел запрос от клиента
  // то перенаправляем серверу
  if(FD_ISSET(stClient, rfds)) then
 begin
  iSize := recv(stClient, buff, sizeof(buff), 0);

     if iSize=-1 then break;

  Send(sock_server, buff, iSize, 0);
  continue;
 end;

  // Если пришли данные от сервера
  // то перенаправляем клиенту
  if(FD_ISSET(sock_server, rfds)) then
 begin
  iSize := recv(sock_server, buff, sizeof(buff), 0);

     // Сервер уже всё выслал
     if iSize=0 then
      exit;

  Send(stClient, buff, iSize, 0);
  continue;
 end;
 end;
CloseSocket(stClient);
CloseSocket(sock_server);
end;

end.

object HTTPProxyForm: THTTPProxyForm
 Left = 260
 Top = 107
 BorderStyle = bsSingle
 Caption = 'Proxy'
 ClientHeight = 145
 ClientWidth = 314
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 PixelsPerInch = 96
 TextHeight = 13
 object Label1: TLabel
   Left = 8
   Top = 16
   Width = 25
   Height = 13
   Caption = #1055#1086#1088#1090
 end
 object Label2: TLabel
   Left = 8
   Top = 80
   Width = 105
   Height = 13
   Caption = #1040#1076#1088'. '#1074#1085#1077#1096'. '#1087#1088#1086#1082#1089#1080#1082#1072
 end
 object Label3: TLabel
   Left = 8
   Top = 48
   Width = 108
   Height = 13
   Caption = #1055#1086#1088#1090' '#1074#1085#1077#1096'. '#1087#1088#1086#1082#1089#1080#1082#1072
 end
 object bnStart: TButton
   Left = 120
   Top = 112
   Width = 75
   Height = 25
   Caption = #1047#1072#1087#1091#1089#1082
   TabOrder = 0
   OnClick = bnStartClick
 end
 object edPort: TEdit
   Left = 128
   Top = 16
   Width = 177
   Height = 21
   TabOrder = 1
   Text = '8080'
 end
 object edExtProxyAddr: TEdit
   Left = 128
   Top = 80
   Width = 177
   Height = 21
   TabOrder = 3
   Text = '192.168.8.88'
 end
 object edExtProxyPort: TEdit
   Left = 128
   Top = 48
   Width = 177
   Height = 21
   TabOrder = 2
   Text = '8080'
 end
end