HanDs
管理员

[Delphi文章] HTTP 代理源代码 





学习中请遵循国家相关法律法规,黑客不作恶。没有网络安全就没有国家安全

本站需要登陆后才能查看

以下代码在 DELPHI7+INDY9 下正常编译,只供自己分析研究HTTP用,有兴趣的可以自行修改。

---------------------------------------------------------------------------------
-httpproxy.dpr
---------------------------------------------------------------------------------

program HttpProxy;

uses
  Forms,
  main in 'main.pas' {Main_form};

{$R *.res}

begin
  Application.Initialize;
  Application.Title := 'HTTP代理 Ver2.50 ';
  Application.CreateForm(TMain_form, Main_form);
  Application.Run;
end.


----------------------------------------------------------------------------------
-main.pas
----------------------------------------------------------------------------------

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,SyncObjs,ExtCtrls,StdCtrls, ComCtrls, ActnList, ToolWin, ImgList, Menus,
  IdException,IdBaseComponent, IdComponent, IdTCPServer,IdTCPClient,
  IdURI, IdIOHandlerSocket,IdStack,IdGlobal, IdIntercept,
  IdThreadMgr, IdThreadMgrPool, IdAntiFreezeBase,
  IdAntiFreeze, IdLogBase, IdUserAccounts,IdCoderMIME,
  IdAuthentication,IdIOHandler,IdIOHandlerThrottle, IdSocks,
  IdTCPConnection,IdCustomHTTPServer, IdSocketHandle,IdResourceStrings,
  CheckLst, Buttons, Grids, ValEdit;

type
  TMyServerInterceptLogBase = class;
  TIdOnLogString=procedure (ASender: TMyServerInterceptLogBase;Remote:string;ConnectTime:string;Options:String;AData: string) of object;

  TMyServerInterceptLogBase = class(TIdServerIntercept)
  protected
    FOnLogString:TIdOnLogString;
    FLock: TCriticalSection;
    FLogTime: Boolean;
    FReplaceCRLF: Boolean;
    FActive:boolean;
  public
    procedure Init; override;
    function Accept(AConnection: TComponent): TIdConnectionIntercept; override;
    destructor Destroy;override;
    procedure DoLogWriteString(Remote:string;ConnectTime:string;Options:String;AData: string);virtual;
    procedure LogWriteString(Remote:string;ConnectTime:string;Options:String;AData: string);virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Active: Boolean read FActive write FActive default False;
    property LogTime: Boolean read FLogTime write FLogTime default True;
    property ReplaceCRLF: Boolean read FReplaceCRLF write FReplaceCRLF default true;
  end;

  TMyServerInterceptLogConnection = class(TIdLogBase) //BGO: i just love long class names <g>
  protected
    FServerInterceptLog:TMyServerInterceptLogBase;
    procedure LogReceivedData(const AText: string; const AData: string);override;
    procedure LogSentData(const AText: string; const AData: string);  override;
    procedure LogStatus(const AText: string); override;
    function GetConnectionID:string;virtual;

  end;



  TMain_form = class(TForm)
    ProxyServer: TIdTCPServer;
    AntiFreeze: TIdAntiFreeze;
    ThreadPool: TIdThreadMgrPool;
    ImageList: TImageList;
    ActionList: TActionList;
    ToolBar: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    Action_Start: TAction;
    Action_Stop: TAction;
    Action_Quit: TAction;
    StatusBar: TStatusBar;
    UserManager: TIdUserManager;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    Action_LoadServerInfo: TAction;
    Action_LoadAccount: TAction;
    PopupMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    ToolButton7: TToolButton;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    ToolButton8: TToolButton;
    Action_Intercept: TAction;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton3: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    Action_About: TAction;
    ToolButton14: TToolButton;
    Action_Change: TAction;
    PageControl: TPageControl;
    TabSheet1: TTabSheet;
    ClientQuery: TMemo;
    TabSheet4: TTabSheet;
    ChangeList: TValueListEditor;
    ConnectList: TCheckListBox;
    Splitter1: TSplitter;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    ToolButton15: TToolButton;
    procedure ProxyServerGETCommand(ASender: TIdCommand);
    procedure ProxyServerCONNECTCommand(ASender: TIdCommand);
    procedure Action_StartExecute(Sender: TObject);
    procedure Action_StopExecute(Sender: TObject);
    procedure Action_QuitExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Action_LoadServerInfoExecute(Sender: TObject);
    procedure Action_LoadAccountExecute(Sender: TObject);
    procedure Action_StartUpdate(Sender: TObject);
    procedure Action_StopUpdate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ProxyServerNoCommandHandler(ASender: TIdTCPServer;
      const AData: String; AThread: TIdPeerThread);
    procedure Action_InterceptUpdate(Sender: TObject);
    procedure Action_InterceptExecute(Sender: TObject);
    procedure ProxyServerException(AThread: TIdPeerThread;
      AException: Exception);
    procedure Action_AboutExecute(Sender: TObject);
    procedure Action_ChangeExecute(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function  LoadServerInfo(filename:string):boolean;
    procedure SaveServerInfo(filename:string);
    function  LoadUserInfo(filename:string):boolean;
    procedure SaveUserInfo(filename:string);
    function  LoadChangeList(filename:string):boolean;
    procedure SaveChangeList(filename:string);
    procedure LogString(ASender: TMyServerInterceptLogBase;Remote:string;ConnectTime:string;Options:String;AData: string);
  end;


  procedure SendResponse(AThread:TIdPeerThread;RespNo:integer;Rawstr:string;Content:string;disconnect:boolean);
  procedure ReadHeaders(LConnection:TIdTCPConnection;Headers:TStringList);
  function  Auther(Command:TIdCommand;Headers:TStringList;UserManager:TIdUserManager;var LoginUser:TIdUserAccount):boolean;
  procedure ConnectionSet(LPeer:TIdTCPConnection;var Account:TIdUserAccount);
  procedure CreateConnect(Command:TIdCommand;Headers:TStringList;var LClient:TIdTCPConnection);
  procedure SendHeaders(LConnection:TIdTCPConnection;Headers:TStringList;Change:boolean);
  procedure SendData(AThread:TIdPeerThread;LFrom:TIdTCPConnection;LTo:TIdTCPConnection;LSize:integer;Change:boolean);
  procedure TransData(AThread:TIdPeerThread;LFrom:TIdTCPConnection;LTo:TIdTCPConnection;Change:boolean);
  function ChangeData(S:string):string;

var
  Main_form: TMain_form;
  ServerInfo,ChangeInfo:TStringList;
implementation

{$R *.dfm}

function TMyServerInterceptLogBase.Accept( AConnection: TComponent): TIdConnectionIntercept;
begin
  Result:=TMyServerInterceptLogConnection.Create(AConnection);
  TMyServerInterceptLogConnection(Result).FServerInterceptLog:=self;
  TMyServerInterceptLogConnection(Result).LogTime:=FLogTime;
  TMyServerInterceptLogConnection(Result).ReplaceCRLF:=FReplaceCRLF;
  TMyServerInterceptLogConnection(Result).Active:=true;
  TMyServerInterceptLogConnection(Result).FConnection:=AConnection;
  TMyServerInterceptLogConnection(Result).Connect(AConnection);
end;

constructor TMyServerInterceptLogBase.Create(Aowner:TComponent);
begin
  Inherited;
  FReplaceCRLF:=true;
  FLogTime:=true;
  FLock := TCriticalSection.Create;
end;

destructor TMyServerInterceptLogBase.Destroy;
begin
  FreeAndNil(FLock);
  inherited;
end;

procedure TMyServerInterceptLogBase.Init;
begin
end;

procedure TMyServerInterceptLogBase.LogWriteString(Remote:string;ConnectTime:string;Options:String;AData: string);
begin
//  if (Length(AData) > 0) then begin
    FLock.Enter;
    try
      DoLogWriteString(Remote,ConnectTime,Options,AData);
    finally
      FLock.Leave;
    end;
//  end;
end;

procedure TMyServerInterceptLogBase.DoLogWriteString(Remote:string;ConnectTime:string;Options:String;AData: string);
begin
  if Assigned(FOnLogString) and FActive then begin
    FOnLogString(Self,Remote,ConnectTime,Options,AData);
  end;
end;

{ TMyServerInterceptLogConnection }

procedure TMyServerInterceptLogConnection.LogReceivedData(const AText:string;const AData: string);
begin
  FServerInterceptLog.LogWriteString(GetConnectionID,AText,'R',AData);  {Do not translate}
end;

procedure TMyServerInterceptLogConnection.LogSentData(const AText: string; const AData: string);
begin
  FServerInterceptLog.LogWriteString(GetConnectionID,AText,'S',AData);  {Do not translate}
end;

procedure TMyServerInterceptLogConnection.LogStatus(const AText: string);
var
  Options:String;
begin
  if AnsiSameText(Atext,RSLogConnected) then begin
     Options:='C';
  end else if AnsiSameText(AText,RSLogDisconnected) then begin
              Options:='D';
           end else begin
                    Options:=AText;
               end;
  FServerInterceptLog.LogWriteString(GetConnectionID,DateTimeToStr(Now),Options,'');  {Do not translate}
end;

function TMyServerInterceptLogConnection.GetConnectionID:string;
var
  LSocket: TIdIOHandlerSocket;
begin
  if (FConnection is TIdTCPConnection) then begin
    LSocket := TIdTCPConnection(FConnection).Socket;
    if (LSocket <> nil) then begin
      if (LSocket.Binding <> nil) then begin
        with LSocket.Binding do begin
          Result := PeerIP + ':' + IntToStr(PeerPort);
        end;
        Exit;
      end;
    end;
  end;
  Result := '0.0.0.0:0';
end;


function Auther(Command:TIdCommand; Headers:TStringList;
         UserManager:TIdUserManager;var LoginUser:TIdUserAccount):boolean;
var
  AuthString,AuthUser,AuthPassword:string;
  LConnection:TIdTCPServerConnection;
  LPeerThread:TIdPeerThread;
begin
  Result:=strtointdef(ServerInfo.Values['UserManager'],0)<=0;
  LPeerThread:=Command.Thread;
  LConnection:=Command.Thread.Connection;

  if  Assigned(LPeerThread) and Assigned(LConnection) then begin
      //如果需要代理身份认证
      if  LConnection.Connected and  (not Result) then begin
          AuthString:=Headers.Values['Proxy-Authorization'];
          Fetch(AuthString,'Basic',true);
          AuthString := TIdDecoderMIME.DecodeString(trim(AuthString));
          //解码用户名和密码
          if length(trim(AuthString))>0 then begin
             Headers.Delete(Headers.IndexOfName('Proxy-Authorization'));
          end;

          AuthUser:=Fetch(AuthString, ':');
          AuthPassword:=AuthString;
          if UserManager.AuthenticateUser(AuthUser,AuthPassword) then begin
             LoginUser:=UserManager.Accounts[AuthUser];
             result:=Assigned(LoginUser);
          end; //if  Authentcateuser
      end;
  end;//if usermanager.tag>0

end;
function ChangeData(S:string):string;
var
  temp:integer;
begin
   result:=s;
   try
      for temp:=0 to ChangeInfo.Count-1 do begin
          result:=StringReplace(result,ChangeInfo.Names[temp],ChangeInfo.ValueFromIndex[temp],[rfReplaceAll]);
      end;
   except
   end;
end;


procedure ConnectionSet(LPeer:TIdTCPConnection;var Account:TIdUserAccount);
var
  LIOHandler:TIdIOHandlerThrottle;
  N:integer;
begin
  if Assigned(Account) and Assigned(LPeer) then begin
     if LPeer.Connected and (LPeer.IOHandler is TIdIOHandlerThrottle) then begin
        N:=strtointdef(Account.Attributes.Values['Speed'],0);
         //设置该用户每连接的流量
        if N<=0 then begin
            N:=strtointdef(ServerInfo.Values['SpeedWithPeer'],0);
             //设置该用户每连接的流量
        end;

        if N>0 then  begin
           LIOHandler:=TIdIOHandlerThrottle(LPeer.IOHandler);
           //建立用于控制每连接流量的对象
           LIOHandler.BytesPerSec:=N;
        end;

     end;
  end;

end;

procedure  CreateConnect(Command:TIdCommand;Headers:TStringList;
                         var LClient:TIdTCPConnection);
var
  LURI: TIdURI;
  LDocument: string;
  ProxyString,ProxyAuth:String;
  LAuth:TIdBasicAuthentication;
  LPeer:TIdTCPConnection;
  LThread:TIdPeerThread;
  LHost:string;
  LVersion:string;
  LSocksInfo:TIdSocksInfo;
  LIOHandler:TIdIOHandlerThrottle;
begin
  LThread:=Command.Thread;
  LPeer:=Command.Thread.Connection;
  if (not Assigned(Command)) or (not Assigned(LThread))
     or (not Assigned(LPeer)) or (not Assigned(Headers)) then begin
     exit;
  end else begin
      if not (Command.Params.Count=2) then begin
         exit;
      end;
  end;

  if LPeer.Connected and (not LThread.Stopped) then begin
     LClient:=TIdTCPClient.Create(nil);
     LIOHandler:=TIdIOHandlerThrottle.Create(LClient);
     LClient.IOHandler:=TIdIOHandlerSocket.Create(LIOHandler);
     LIOHandler.ChainedHandler:=LClient.IOHandler;
     LClient.IOHandler:=LIOHandler;

     LClient.ReadTimeout:=strtointdef(ServerInfo.Values['ReadTimeOut'],0);
     LClient.ReadTimeout:=iif(LClient.ReadTimeout=-1,0,LClient.ReadTimeout);

     LURI := TIdURI.Create(Command.Params.Strings[0]);
     //建立一个分析URL的对象
     LVersion:=Command.Params.Strings[1];

     if AnsiSameText(Command.CommandHandler.Command,'CONNECT')
        and (LURI.Protocol='') then begin
        //如果是connect命令,并且url中没有http协议字符,则添加后进行分析
        LURI.URI:='HTTP://'+Command.Params.Strings[0];
     end;

     if not AnsiSameText(Command.CommandHandler.Command,'OPTIONS') then begin
        if LURI.Host='' then begin
           exit;
            //如果不是options命令,不能从url中分析出目标主机则认为此请求
            //是无效的http代理请求
        end;
     end else begin
         //如果是options命令,则通过host字段来分析目标主机
         LHost:=Headers.Values['Host'];
         LURI.Host:=Fetch(LHost,':',true);
         LURI.Port:=LHost;
     end;


     try
        TIdTCPClient(LClient).Port := StrToIntDef(LURI.Port, 80);
        //获取请求url中的端口信息
        TIdTCPClient(LClient).Host := LURI.Host;

        LDocument := LURI.Path + LURI.Document + LURI.Params;
         //重建资源路径(使用相对路径的表示方式)
        if LURI.Bookmark<>'' then begin
           LDocument:=LDocument+'#'+LURI.Bookmark;
        end;

        LURI.URI:='';

        ProxyString:=Serverinfo.Values[TIdTCPClient(LClient).Host+':'+
                                 IntToStr(TIdTCPClient(LClient).Port)];
        //根据系统配置,设置二级代理
        if Length(Trim(ProxyString))>0 then begin
           LURI.URI:=ProxyString;

           if AnsiSameText(LURI.Protocol,'HTTP') then begin
              //如果使用http二级代理
              if not LClient.Connected then begin
                 TIdTCPClient(LClient).Port:=StrToIntDef(LURI.Port, 8080);
                 TIdTCPClient(LClient).Host := LURI.Host;
              end;
              if LURI.Username<>'' then begin
                 //如果二级需要验证身份,则重新修改代理认证字段
                 LAuth := TIdBasicAuthentication.Create;
                 try
                    with LAuth do  begin
                         Params.Values['Username'] := LURI.Username;
                         Params.Values['Password'] := LURI.Password;
                         ProxyAuth:= Authentication;
                    end;
                    if Length(ProxyAuth)>0 then begin
                       Headers.Values['Proxy-Authorization']:= ProxyAuth;
                    end;
                 finally
                    LAuth.Free;
                 end;
              end;

           end else  begin   //如果使用socks代理
               LSocksInfo:=LClient.Socket.SocksInfo;
               with LSocksInfo do begin
                    IoHandler:=LClient.IOHandler;
                    Username:=LURI.Username;
                    Password:=LURI.Password;
                    if not LClient.Connected then begin
                       Host:=LURI.Host;
                       Port:=strtointdef(LURI.Port,1080);
                    end;
                    //设置二级代理的类型  0=无socks代理 1=SOCKS4
                    // 2=SOCKS4A 3=SOCKS5
                    Version:=TSocksVersion(
                             iif(AnsiSameText(LURI.Protocol,'SOCKS4'),1,
                             iif(AnsiSameText(LURI.Protocol,'SOCKS4A'),2,
                             iif(AnsiSameText(LURI.Protocol,'SOCKS5'),3,0))));
                    //根据二级socks代理是否需要身份验证,
                    //只有socks5支持身份认证
                    Authentication:=TSocksAuthentication(
                                    iif(trim(UserName)<>'',1,0));
               end;
           end;
        end else begin
            //如果没有定义该目标主机的二级代理,则修改请求命令行
            Headers.Strings[0]:=Command.CommandHandler.Command+' '+
                                LDocument+' '+LVersion;
        end; //length(ProxyString)>0

        if Headers.Values['Proxy-Connection']<>'' then begin
           Headers.Delete(Headers.IndexOfName('Proxy-Connection'));
            //删除请求包中的代理标志
        end;

     finally
        FreeAndNil(LURI);
     end;

     try
        TIdTCPClient(LClient).Connect(strtointdef(ServerInfo.Values['ConnectTimeOut'],10000));
     except
        on E:EIdConnectTimeout do begin
           SendResponse(LThread,504,'','连接目标主机超时',true);
        end;
     end;
  end;

end;

procedure ReadHeaders(LConnection:TIdTCPConnection;Headers:TStringList);
begin
  if Assigned(LConnection) and Assigned(Headers) then begin
     if LConnection.Connected  then begin
        LConnection.Capture(Headers,'');
     end;
  end;
end;

procedure SendData(Athread:TIdPeerThread;LFrom:TIdTCPConnection;
                   LTo:TIdTCPConnection;LSize:integer;Change:boolean);
var
  LContentSize:integer;
  Temp:integer;
  TempStr:string;
begin
  if not Assigned(AThread) or not  Assigned(LFrom) or
     not Assigned(LTo)  then  begin
     exit;
  end;

  LContentSize:=LSize;

  case Lsize of
       -1:begin
            exit;
          end;
        0:begin
             while (LFrom.Connected) and (LTO.Connected) do begin
                 try
                    LFrom.ReadFromStack(false,LFrom.ReadTimeout,false);
                 except

                 end;
                 if LFrom.InputBuffer.Size>0 then begin
                    LFrom.InputBuffer.Seek(0,soFromBeginning);
                    try
                       LTo.WriteBuffer(LFrom.InputBuffer.memory^,LFrom.InputBuffer.Size);
                    finally
                       LFrom.InputBuffer.Remove(LFrom.InputBuffer.Size);
                    end;
                 end;
                 LFrom.CheckForGracefulDisconnect(false);
                 LTo.CheckForGracefulDisconnect(false);
             end;
          end;
  else begin
          while (LContentSize>0) and (LFrom.Connected)  and
                (LTo.Connected) do begin
                 try
                    LFrom.ReadFromStack(false,LFrom.ReadTimeout,false);
                 except
                 end;

                 Temp:=LFrom.InputBuffer.Size;
                 if Temp>0 then begin
                    try
                       if Change then begin
                          TempStr:=ChangeData(LFrom.InputBuffer.Extract(Temp));
                          LTo.Write(TempStr);
                       end else begin
                           LTo.WriteBuffer(LFrom.InputBuffer.memory^,Temp);
                           LFrom.InputBuffer.Remove(Temp);
                       end;
                    finally
                       Dec(LContentSize,Temp);
                    end;
                 end;
                 LFrom.CheckForGracefulDisconnect(false);
                 LTo.CheckForGracefulDisconnect(false);
          end;
       end;
  end;


end;

procedure SendHeaders(LConnection:TIdTCPConnection;Headers:TStringList;Change:boolean);
begin
  if Assigned(LConnection) then begin
     LConnection.OpenWriteBuffer();
     try
        if Change then begin
           Headers.Text:=ChangeData(Headers.Text);
        end;

        LConnection.WriteStrings(Headers);
     finally
        LConnection.CloseWriteBuffer;
     end;

  end;
end;

procedure SendResponse(AThread:TIdPeerThread;RespNo:integer;Rawstr:string;
                       Content:string;disconnect:boolean);
var
  LHTTPResponseInfo:TIdHttpResponseInfo;
  Temp:integer;
begin
  if Assigned(AThread.Connection) and AThread.Connection.Connected and
     not AThread.Stopped then begin
     LHttpResponseInfo:=TIdHttpResponseInfo.Create(AThread.Connection);
     try
        with LHttpResponseInfo do begin
             Server:='HTTP PROXY SERVER Ver 1.0';
             ResponseNo:=RespNo;
             ContentType:='';
             if Length(Content)>0 then begin
                ContentText:=Content;
             end;

             with RawHeaders do  begin
                  if Server <> '' then begin
                     Values['Server'] := Server;
                  end;
                  if ContentType <> '' then begin
                     Values['Content-Type'] := ContentType;
                  end;
                  if ContentText<>'' then begin
                     ContentLength:=Length(ContentText);
                  end;
                  if ContentLength > 0 then  begin
                    Values['Content-Length'] := IntToStr(ContentLength);
                  end;
                  if Length(RawStr)>0 then begin
                     Append(Rawstr);
                  end;
             end;


             with AThread.Connection do  begin
                 OpenWriteBuffer;
                 try
                    WriteLn('HTTP/1.1 ' + IntToStr(ResponseNo) + ' ' +
                             ResponseText);    {Do not Localize}
                    for Temp := 0 to RawHeaders.Count -1 do begin
                        WriteLn(RawHeaders[Temp]);
                    end;
                    WriteLn;
                    if  ContentLength>0 then begin
                        Write(ContentText);
                    end;

                 finally
                    CloseWriteBuffer;
                 end;
             end;
        end;
     finally
        LHttpResponseInfo.Free;
        if DisConnect then
           AThread.Connection.Disconnect;
     end;
  end;
end;

procedure TransData(AThread:TIdPeerThread;LFrom:TIdTCPConnection;
                    LTo:TIdTCPConnection;Change:boolean);
var
  LClientHandle: TObject;
  LServerHandle: TObject;
  LReadList:TList;
  //LNetData:string;
begin
  if Assigned(AThread) and Assigned(LFrom) and Assigned(LTo) then begin
     LClientHandle:=TObject(LFrom.Socket.Binding.Handle);
     LServerHandle:=TObject(LTo.Socket.Binding.Handle);
     LReadList:=TList.Create;

     try
        LFrom.CheckForDisconnect(true,true);
        LTo.CheckForDisconnect(true,true);

        while (not AThread.Stopped) and (LFrom.Connected)
               and (LTo.Connected) do begin

               with LReadList do begin
                    Clear;
                    Add(LClientHandle);
                    Add(LServerHandle);

                    if GStack.WSSelect(LReadList, nil, nil, IdTimeoutInfinite)
                       > 0 then begin

                       if IndexOf(LClientHandle) > -1 then begin
                          if Change then begin
                             LTo.Write(ChangeData(LFrom.CurrentReadBuffer));
                          end else begin
                              LTo.Write(LFrom.CurrentReadBuffer);
                          end;
                       end;
                       if IndexOf(LServerHandle) > -1 then begin

                          LFrom.Write(LTo.CurrentReadBuffer);
                       end;
                    end else begin
                        LFrom.CheckForDisconnect(true,true);
                        LTo.CheckForDisconnect(true,true);
                    end;
               end; //with
        end;//while do
     finally
        FreeAndNil(LReadList);
     end;
  end //if assigned(athread)...
end;



function TMain_form.LoadServerInfo(filename:string):boolean;
begin
  result:=false;

  if not Assigned(ServerInfo) then begin
     ServerInfo:=TStringList.Create;
  end;

  try
     if Assigned(ServerInfo) and  fileexists(filename) then begin
        ServerInfo.Clear;
        ServerInfo.LoadFromFile(filename);

        result:=ServerInfo.Count>1;
     end;
  except
  end;

end;

procedure TMain_form.SaveServerInfo(filename:string);
begin
//
  if Assigned(ServerInfo) then begin
     if ServerInfo.Count>0 then begin
        try
           ServerInfo.SaveToFile(filename);
        except
        end;
     end;
  end;
end;

function TMain_form.LoadUserInfo(filename:string):boolean;
var
  temp:integer;
  OneUser:TIdUserAccount;
  UsersInfo,OneUserInfo:TStringList;
begin
  result:=false;
  UsersInfo:=TStringList.Create;
  try
     if Assigned(UsersInfo) and fileexists(filename) then  begin
        UsersInfo.LoadFromFile(filename);

        with UserManager do begin
             if UsersInfo.Count>0 then begin
                Accounts.Clear;

                OneUserInfo:=TStringList.Create;

                try
                   for temp:=0 to  UsersInfo.Count-1 do begin
                       OneUserInfo.Clear;
                       OneUserInfo.DelimitedText:=UsersInfo.Strings[temp];

                       OneUser:=Accounts.Add;
                       OneUser.UserName:=OneUserInfo.Values['UserName'];
                       OneUser.Password:=OneUserInfo.Values['Password'];
                       OneUser.RealName:=OneUserInfo.Values['RealName'];

                       OneUserInfo.Delete(OneUserInfo.IndexOfName('UserName'));
                       OneUserInfo.Delete(OneUserInfo.IndexOfName('Password'));
                       OneUserInfo.Delete(OneUserInfo.IndexOfName('RealName'));
                       OneUser.Attributes.Text:=OneUserInfo.Text;
                   end;

                   result:=true;
                finally
                   FreeAndNil(OneUserInfo);
                end;
             end;
        end;
     end;
  finally
     FreeAndNil(UsersInfo);
  end;


end;

procedure TMain_form.SaveUserInfo(filename:string);
var
  OneUser:TIdUserAccount;
  UsersInfo,OneUserInfo:TStringList;
  temp:integer;
begin
//
  UsersInfo:=TStringList.Create;
  OneUserInfo:=TStringList.Create;
  try
     try
        UsersInfo.Clear;

        for temp:=0 to UserManager.Accounts.Count-1 do begin
            OneUser:=UserManager.Accounts.Items[temp];

            OneUserInfo.Text:=OneUser.Attributes.Text;
            OneUserInfo.Insert(0,'RealName='+OneUser.RealName);
            OneUserInfo.Insert(0,'Password='+OneUser.Password);
            OneUserInfo.Insert(0,'UserName='+OneUser.UserName);

            UsersInfo.Add(OneUserInfo.DelimitedText);
        end;
     finally
        FreeAndNil(OneUserInfo);
     end;


     UsersInfo.SaveToFile(filename);
  finally
     FreeAndNil(OneUserInfo);
     FreeAndnil(UsersInfo);
  end;

end;

procedure TMain_form.SaveChangeList(filename:string);
begin
   try
      if Assigned(ChangeInfo) then begin
         ChangeInfo.SaveToFile(filename);
      end;
   except
      on e:exception do begin
      end;
   end;
end;

function TMain_form.LoadChangeList(filename:string):boolean;
begin
  result:=false;
  try
     if not Assigned(ChangeInfo) then begin
        ChangeInfo:=TStringList.Create;
     end;

     if Assigned(ChangeInfo) then begin
        ChangeInfo.LoadFromFile(filename);
        ChangeList.Strings.Assign(ChangeInfo);
        result:=true;
     end;
  except
  end;
end;

procedure TMain_form.LogString(ASender: TMyServerInterceptLogBase;Remote:string;
                               ConnectTime:string;Options:String;AData: String);
var
  index:integer;
begin
  try
      if ClientQuery.Lines.Count>strtointdef(ServerInfo.Values['MaxLog'],300) then begin
         ClientQuery.Lines.Clear;
      end;

      Index:=ConnectList.Items.IndexOf(Remote);
      if AnsiSameText(Options,'R') or AnsiSameText(Options,'S')  then begin
         ClientQuery.Lines.Add(Remote+#32+Options+#32+inttostr(length(AData))+#32+AData);
         if Index=-1 then begin
            ConnectList.Items.Add(Remote);
         end;
      end else if AnsiSameText(Options,'D') and (Index>-1) then begin
                  ConnectList.Items.Delete(Index);
               end;
  except
  end;
end;



procedure TMain_form.ProxyServerGETCommand(ASender: TIdCommand);
var
  LClientHeaders,LServerHeaders:TStringList;
  LContentSize: Integer;
  LClient: TIdTCPClient;
  LPeer:TIdTcpServerConnection;
  LoginUser:TIdUserAccount;
begin
  ASender.PerformReply:=false;
   //禁止COMMAND执行完毕后自动发送RFC信息
  LPeer:=ASender.Thread.Connection;
  LClient:=Nil;
  //获取保存的到目的主机的连接,用于支持http/1.1协议的在长连接中接收多次请求
  LoginUser:=nil;

  if LPeer.Connected and not ASender.Thread.Stopped then begin
     //检查连接是否中断,线程是否中止
     LClientHeaders:=TStringList.Create;
     //建立接收客户端请求包头变量
     LClientHeaders.NameValueSeparator:=':';

     try
        LClientHeaders.Insert(0,ASender.RawLine);
        //插入客户端请求行
        ReadHeaders(LPeer,LClientHeaders);
        //读取客户端请求头
        //验证客户端身份
        if Auther(ASender,LClientHeaders,Usermanager,LoginUser)then  begin
           CreateConnect(ASender,LClientHeaders,TIdTCPConnection(LClient));
           if Assigned(LClient) then begin
              ConnectionSet(LClient,LoginUser);
              if (not ASender.Thread.Stopped) and LClient.Connected then begin
                 try
                    LClientHeaders.Add('');


                    SendHeaders(LClient,LClientHeaders,Action_Change.Checked);
                    LContentSize := StrToIntDef(LClientHeaders.Values
                                                ['Content-Length'], -1) ;
                    //判断是否有数据提交给远端
                    if LContentSize>0 then begin
                       SendData(ASender.Thread,LPeer,LClient,LContentSize,Action_Change.Checked);
                   //    TransData(ASender.Thread,LPeer,LClient);
                    end;
                    //发送指定数据到远端

                    LServerHeaders:=TStringList.Create;
                    //建立接收服务端返回包头变量
                    LServerHeaders.NameValueSeparator:=':';
                    try
                       ReadHeaders(LClient,LServerHeaders);
                       LServerHeaders.Add('');
                       SendHeaders(LPeer,LServerHeaders,false);

                       LContentSize:= StrToIntDef(LServerHeaders.Values
                                                  ['Content-Length'], -1) ;
                        //判断是否有返回的数据
                       if LContentSize<0 then begin
                          LContentSize:=iif(length(LServerHeaders.Values
                                                   ['Content-Type'])>0,0,LContentSize);
                       end;

                       SendData(ASender.Thread,LClient,LPeer,LContentSize,false);
                        //发送返回的数据到客户端
                    finally
                       LClient.Disconnect;
                       FreeAndNil(LServerHeaders);
                    end;
                 finally
                     LClient.Disconnect;
                 end;
              end else begin
                  LClient.Disconnect;
              end;
           end;
        end else begin
            SendResponse(ASender.Thread,407,
                   'Proxy-Authenticate:Basic realm="Http-Proxy Authorization"',
                   '', true);
        end;
     finally
        FreeAndNIl(LClient);
        FreeAndNil(LClientHeaders);
     end;
  end;

end;


procedure TMain_form.ProxyServerCONNECTCommand(ASender: TIdCommand);
var
  LClientHeaders:TStringList;
  LClient: TIdTCPClient;
  LPeer:TIdTcpServerConnection;
  LoginUser:TIdUserAccount;
begin
  ASender.PerformReply:=false;
  //禁止COMMAND执行完毕后自动发送RFC信息
  LPeer:=ASender.Thread.Connection;
  LClient:=nil;
  LoginUser:=nil;

  if LPeer.Connected and not ASender.Thread.Stopped then begin
  //检查连接是否中断,线程是否中止
     LClientHeaders:=TStringList.Create;
     //建立接收客户端请求包头变量
     LClientHeaders.NameValueSeparator:=':';
     try
        LClientHeaders.Insert(0,ASender.RawLine);
        ReadHeaders(LPeer,LClientHeaders);                        //读取请求包头
        //验证客户端身份
        if Auther(ASender,LClientHeaders,Usermanager,LoginUser) then  begin
           CreateConnect(ASender,LClientHeaders,TIdTCPConnection(LClient));
           //建立一个到服务端的客户端对象

           if Assigned(LClient) then begin
              ConnectionSet(LClient,LoginUser);     //设置客户端的速率等

              if LClient.Connected then begin
                 try
                    SendResponse(ASender.thread,200,'','',false);
                    TransData(ASender.Thread,LPeer,LClient,Action_Change.Checked);
                    //开始在两个连接之间交换数据
                 finally
                    LClient.Disconnect;
                 end;
              end;
           end;
        end;
     finally
        FreeAndNil(LClientHeaders);
        FreeAndNIl(LClient);
     end;

  end;



end;

procedure TMain_form.Action_StartExecute(Sender: TObject);
begin
  if Action_LoadServerInfo.Execute then begin
     try
        ProxyServer.Active:=true;
     except
     end;

  end;
end;

procedure TMain_form.Action_StopExecute(Sender: TObject);
begin
  if (not Action_Stop.Checked ) and ProxyServer.Active then begin
     try
        ProxyServer.Active:=false;
     finally

     end;
  end;
end;

procedure TMain_form.Action_QuitExecute(Sender: TObject);
begin
  try
     if ProxyServer.Active then begin
        if Application.MessageBox('退出前需要停止服务','注意',
                                   MB_OKCANCEL)=ID_OK then begin
           Action_Stop.Execute;
        end else begin
            exit;
        end;
     end;
  finally;
     close;
  end;
end;

procedure TMain_form.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if ProxyServer.Active then
   Action_Stop.Execute;

  CanClose:=Application.MessageBox('你确定推出该程序么?','关闭',
                                 MB_OKCANCEL)=ID_OK;
end;

procedure TMain_form.Action_LoadServerInfoExecute(Sender: TObject);
var
  ServerInfoName:string;
  temp:integer;
  BindingList:TStringList;
  LSockHandler:TIdSocketHandle;
begin
  if not ProxyServer.Active then begin
     try
        ServerInfoName:=ExtractFilePath(Application.ExeName)+'ServerInfo.txt';
        if LoadServerInfo(ServerInfoName) then begin
           with ProxyServer do begin
                DefaultPort:=strtointdef(ServerInfo.Values['DefaultPort'],8080);
                MaxConnections:=strtointdef(ServerInfo.Values['MaxConnections'],0);
                UserManager.Tag:=strtointdef(ServerInfo.Values['UserManager'],0);

                for temp:=0 to ProxyServer.CommandHandlers.Count-1 do begin
                    CommandHandlers.Items[temp].Enabled:=strtointdef(ServerInfo.
                                                         Values[CommandHandlers.
                                                         Items[temp].Name],1)>0;
                end;

                DefaultPort:=strtointdef(ServerInfo.Values['DefaultPort'],8080);
                BindingList:=TStringList.Create;
                BindingList.NameValueSeparator:=':';
                BindingList.DelimitedText:=ServerInfo.Values['HttpProxyBindings'];
                try
                   Bindings.Clear;
                   for temp:=0 to BindingList.Count-1 do begin
                       LSockHandler:=Bindings.Add;
                       LSockHandler.IP:=BindingList.Names[temp];
                       LSockHandler.Port:=strtointdef(BindingList.
                                          ValueFromIndex[temp],DefaultPort);
                   end;

                finally
                   FreeAndNil(BindingList);
                end;

           end;
        end;
     except
     end;
  end;
end;

procedure TMain_form.Action_LoadAccountExecute(Sender: TObject);
var
  UserInfoName:string;
begin
  if UserManager.Tag=1 then begin
     UserInfoName:=ExtractFilePath(Application.ExeName)+'UserInfo.txt';

     try
        UserManager.Tag:=iif(LoadUserInfo(UserInfoName),1,0);
     except
     end;
  end;

end;

procedure TMain_form.Action_StartUpdate(Sender: TObject);
begin
  if Sender is TAction then begin
     TAction(Sender).Enabled:=not ProxyServer.Active;
  end;
end;

procedure TMain_form.Action_StopUpdate(Sender: TObject);
begin
Action_Stop.Enabled:=ProxyServer.Active;
end;


procedure TMain_form.FormCreate(Sender: TObject);
var
  ServerIntercept:TMyServerInterceptLogBase;
begin
  if Action_LoadServerInfo.Execute then begin
     Action_LoadAccount.Execute;
  end;

  try
     ServerIntercept:=TMyServerInterceptLogBase.Create(ProxyServer);
     ServerIntercept.ReplaceCRLF:=false;
     ServerIntercept.FOnLogString:=LogString;
     ProxyServer.Intercept:=ServerIntercept;
  except
  end;

  try
     LoadChangeList(ExtractFilePath(Application.ExeName)+'ChangeList.txt');
  except
  end;
end;

procedure TMain_form.ProxyServerNoCommandHandler(ASender: TIdTCPServer;
  const AData: String; AThread: TIdPeerThread);
begin
  SendResponse(AThread,501,'','',true);
  //501 未实现(Not Implemented)
  //服务器无法提供对请求中所要求功能的支持。
  //如果服务器无法识别请求方法就会回
  //应此状态代码,这意味着不能回应请求所要求的任何资源。

end;

procedure TMain_form.Action_InterceptUpdate(Sender: TObject);
begin
  Action_Intercept.Enabled:= Assigned(ProxyServer.Intercept) and
                           (ProxyServer.Intercept is TMyServerInterceptLogBase);

end;

procedure TMain_form.Action_InterceptExecute(Sender: TObject);
var
  view:boolean;
begin
  try
     View:=TMyServerInterceptLogBase(ProxyServer.Intercept).Active;
     TMyServerInterceptLogBase(ProxyServer.Intercept).Active:=not View;
     if not TMyServerInterceptLogBase(ProxyServer.Intercept).Active then begin
        ConnectList.Clear;
     end;
     toolbutton8.Down:=not View;
                        ;
  except
     Action_Intercept.Enabled:=false;
     toolbutton8.Down:=false;
  end;

end;

procedure TMain_form.ProxyServerException(AThread: TIdPeerThread;
  AException: Exception);
begin
{  if Assigned(AException) then begin
      SendResponse(AThread,500,'','',true);
      // 500 服务器内部错误(Internal Server Error)
      //服务器碰到了意外情况,使其无法继续回应请求
  end;
}
end;

procedure TMain_form.Action_AboutExecute(Sender: TObject);
var
   AboutStr:string;
begin
  AboutStr:='      迷你HTTP 代理服务器      '+EOL+EOL+
            '          Ver 2.50         '+EOL+EOL+
            '    Copyright 2005-2008    '+EOL+EOL+
            '   Email:[email protected]   ';
  Application.MessageBox(Pchar(ABoutStr),'关于',Mb_Ok);
end;

procedure TMain_form.Action_ChangeExecute(Sender: TObject);
begin
  try
     Action_Change.Checked:=not Action_Change.Checked;
     toolbutton14.Down:=Action_Change.Checked;
  except
     toolbutton14.Down:=false;
  end;
end;

procedure TMain_form.SpeedButton1Click(Sender: TObject);
begin
  try
     if Assigned(ChangeInfo) then begin
        ChangeInfo.Assign(ChangeList.Strings);
     end;

     SaveChangeList(ExtractFilePath(Application.ExeName)+'ChangeList.txt');
  except
  end;
end;

end.




----------------------------------------------------------------------------------
-  Main.dfm                
----------------------------------------------------------------------------------

object Main_form: TMain_form
  Left = 213
  Top = 131
  Width = 564
  Height = 449
  Caption = #36855#20320'HTTP'#20195#29702' Ver 2.50'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = #23435#20307
  Font.Style = []
  Icon.Data = {
    0000010001002020100000000000E80200001600000028000000200000004000
    0000010004000000000080020000000000000000000000000000000000000000
    000000008000008000000080800080000000800080008080000080808000C0C0
    C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF009999
    99999999999999999999999999999FFFFFFFFFFFFF88888888888FFFFFF997FF
    FFFFFFFF888888888888888FFFF9977FFFFFFFF8444C444888888888FFF99777
    FFFFFF4444444444488888888FF997777FFF44444C4C4C4C4C48888888F99777
    77F44444443444444444888888F99777774C444C433C4C4C4C4C488888899777
    74444444C334C444C444C48888899777744C4C4C433C4C4C4C4C4C8888899777
    444444C43334CCC4C4C4C44888899777444C4C43333C4C4C4C4C4C3888899774
    4444C4433333CCCCC4CCC433888997744C4C4C4333333C4C4C4C4C3388899774
    4444C43333333CCCCCCCC43388899774444C4C333333CC4CCC4C4C3388899774
    4444C433333CCCCCCCC33333888997744C4C4C334C4C4CCCCCC3333388899774
    44444433CCCC3CCCCCC3333388F99777444C4C433C433C4CCC4C333888F99777
    4444343333333CCCCCCCC4C88FF99777744C333333333C4C4C433C88FFF99777
    7444333333333CCCCCC3348FFFF99777774C333333333C4C3C433FFFFFF99777
    7774333333C333CC3433FFFFFFF9977777774333334C333C4C377FFFFFF99777
    77777744433444C4477777FFFFF99777777777774C4C4C477777777FFFF99777
    777777777777777777777777FFF997777777777777777777777777777FF99777
    77777777777777777777777777F9999999999999999999999999999999990000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    0000000000000000000000000000000000000000000000000000000000000000
    000000000000000000000000000000000000000000000000000000000000}
  OldCreateOrder = False
  Position = poScreenCenter
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 12
  object ToolBar: TToolBar
    Left = 0
    Top = 0
    Width = 556
    Height = 53
    AutoSize = True
    ButtonHeight = 51
    ButtonWidth = 61
    Ctl3D = False
    Flat = True
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -12
    Font.Name = #23435#20307
    Font.Style = []
    Images = ImageList
    Indent = 3
    ParentFont = False
    ShowCaptions = True
    TabOrder = 0
    Transparent = True
    object ToolButton1: TToolButton
      Left = 3
      Top = 0
      Action = Action_Start
      AutoSize = True
    end
    object ToolButton5: TToolButton
      Left = 56
      Top = 0
      Width = 8
      ImageIndex = 6
      Style = tbsSeparator
    end
    object ToolButton2: TToolButton
      Left = 64
      Top = 0
      Action = Action_Stop
      AllowAllUp = True
      AutoSize = True
    end
    object ToolButton6: TToolButton
      Left = 123
      Top = 0
      Width = 8
      ImageIndex = 6
      Style = tbsSeparator
    end
    object ToolButton3: TToolButton
      Left = 131
      Top = 0
      Action = Action_LoadServerInfo
    end
    object ToolButton7: TToolButton
      Left = 192
      Top = 0
      Width = 8
      Caption = 'ToolButton7'
      ImageIndex = 7
      Style = tbsSeparator
    end
    object ToolButton10: TToolButton
      Left = 200
      Top = 0
      Action = Action_LoadAccount
    end
    object ToolButton11: TToolButton
      Left = 261
      Top = 0
      Width = 8
      Caption = 'ToolButton11'
      ImageIndex = 5
      Style = tbsSeparator
    end
    object ToolButton8: TToolButton
      Left = 269
      Top = 0
      Action = Action_Intercept
    end
    object ToolButton15: TToolButton
      Left = 330
      Top = 0
      Width = 8
      Caption = 'ToolButton15'
      ImageIndex = 7
      Style = tbsSeparator
    end
    object ToolButton14: TToolButton
      Left = 338
      Top = 0
      Action = Action_Change
    end
    object ToolButton9: TToolButton
      Left = 399
      Top = 0
      Width = 8
      Caption = 'ToolButton9'
      ImageIndex = 6
      Style = tbsSeparator
    end
    object ToolButton13: TToolButton
      Left = 407
      Top = 0
      Action = Action_About
    end
    object ToolButton12: TToolButton
      Left = 468
      Top = 0
      Width = 8
      Caption = 'ToolButton12'
      ImageIndex = 6
      Style = tbsSeparator
    end
    object ToolButton4: TToolButton
      Left = 476
      Top = 0
      Action = Action_Quit
      AutoSize = True
    end
  end
  object StatusBar: TStatusBar
    Left = 0
    Top = 403
    Width = 556
    Height = 19
    AutoHint = True
    Panels = <>
  end
  object PageControl: TPageControl
    Left = 0
    Top = 53
    Width = 556
    Height = 350
    ActivePage = TabSheet1
    Align = alClient
    Images = ImageList
    Style = tsFlatButtons
    TabOrder = 2
    object TabSheet1: TTabSheet
      Caption = #30417#35270
      ImageIndex = 3
      object Splitter1: TSplitter
        Left = 121
        Top = 0
        Height = 302
      end
      object ClientQuery: TMemo
        Left = 124
        Top = 0
        Width = 424
        Height = 302
        Hint = #36827#20986#30340#25968#25454#21253'  R= '#23458#25143#31471'to'#26381#21153#31471'  S= '#26381#21153#31471'TO'#23458#25143#31471
        Align = alClient
        Ctl3D = False
        ParentCtl3D = False
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
      object ConnectList: TCheckListBox
        Left = 0
        Top = 0
        Width = 121
        Height = 302
        Hint = #25152#26377#24403#21069#36830#25509
        Align = alLeft
        Ctl3D = False
        ItemHeight = 12
        ParentCtl3D = False
        TabOrder = 1
      end
    end
    object TabSheet4: TTabSheet
      Caption = #31713#25913
      ImageIndex = 7
      object ChangeList: TValueListEditor
        Left = 0
        Top = 0
        Width = 530
        Height = 272
        Hint = #24314#35758#22343#20026#23383#31526#20018#65292#20540#20013#19981#33021#26377'='#21495
        Align = alClient
        Ctl3D = False
        KeyOptions = [keyEdit, keyAdd, keyDelete, keyUnique]
        ParentCtl3D = False
        TabOrder = 0
        TitleCaptions.Strings = (
          #21407#20540
          #20462#25913#20540)
        ColWidths = (
          261
          265)
      end
      object Panel1: TPanel
        Left = 0
        Top = 272
        Width = 530
        Height = 30
        Align = alBottom
        BevelOuter = bvNone
        TabOrder = 1
        object SpeedButton1: TSpeedButton
          Left = 232
          Top = 0
          Width = 73
          Height = 30
          Caption = #24212#29992#20445#23384
          Flat = True
          OnClick = SpeedButton1Click
        end
      end
    end
  end
  object ProxyServer: TIdTCPServer
    Bindings = <>
    CommandHandlers = <
      item
        CmdDelimiter = ' '
        Command = 'OPTIONS'
        Disconnect = True
        Name = 'HTTP_OPTIONS'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'GET'
        Disconnect = True
        Name = 'HTTP_GET'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'HEAD'
        Disconnect = True
        Name = 'HTTP_HEAD'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'POST'
        Disconnect = True
        Name = 'HTTP_POST'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'PUT'
        Disconnect = True
        Name = 'HTTP_PUT'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'DELETE'
        Disconnect = True
        Name = 'HTTP_DELETE'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'TRACE'
        Disconnect = True
        Name = 'HTTP_TRACE'
        OnCommand = ProxyServerGETCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end
      item
        CmdDelimiter = ' '
        Command = 'CONNECT'
        Disconnect = True
        Name = 'HTTP_CONNECT'
        OnCommand = ProxyServerCONNECTCommand
        ParamDelimiter = ' '
        ReplyExceptionCode = 0
        ReplyNormal.NumericCode = 0
        Tag = 0
      end>
    DefaultPort = 8080
    Greeting.NumericCode = 0
    MaxConnectionReply.NumericCode = 0
    MaxConnectionReply.Text.Strings = (
      'HTTP/1.0 503 Service Unavailable'
      'Connection: close'
      'Content-Type: text/html'
      ''
      '<html>'
      ' <head>'
      '   503 '#36798#21040#26368#22823#36830#25509#25968#65281
      ' </head>'
      '</html>')
    OnException = ProxyServerException
    OnNoCommandHandler = ProxyServerNoCommandHandler
    ReplyExceptionCode = 0
    ReplyTexts = <>
    ReplyUnknownCommand.NumericCode = 0
    Left = 16
    Top = 279
  end
  object AntiFreeze: TIdAntiFreeze
    Left = 80
    Top = 279
  end
  object ThreadPool: TIdThreadMgrPool
    PoolSize = 10
    Left = 48
    Top = 279
  end
  object ImageList: TImageList
    Height = 32
    Width = 32
    Left = 49
    Top = 246
    Bitmap = {000000000000}
  end
  object ActionList: TActionList
    Images = ImageList
    Left = 17
    Top = 246
    object Action_Start: TAction
      Caption = #21551'[&R]'#21160
      Hint = #21551#21160#20195#29702#26381#21153
      ImageIndex = 0
      OnExecute = Action_StartExecute
      OnUpdate = Action_StartUpdate
    end
    object Action_Stop: TAction
      Caption = #20572'[&S]'#27490' '
      Hint = #20851#38381#20195#29702#26381#21153
      ImageIndex = 1
      OnExecute = Action_StopExecute
      OnUpdate = Action_StopUpdate
    end
    object Action_Quit: TAction
      Caption = #36864'[&Q]'#20986' '
      Hint = #36864#20986#20195#29702#31243#24207
      ImageIndex = 5
      OnExecute = Action_QuitExecute
    end
    object Action_LoadServerInfo: TAction
      Caption = #31995'[&O]'#32479
      Hint = #35835#21462#24212#29992#31995#32479#37197#32622
      ImageIndex = 2
      OnExecute = Action_LoadServerInfoExecute
      OnUpdate = Action_StartUpdate
    end
    object Action_LoadAccount: TAction
      Caption = #24080'[&U]'#25143
      Hint = #35835#21462#24212#29992#29992#25143#37197#32622
      ImageIndex = 4
      OnExecute = Action_LoadAccountExecute
      OnUpdate = Action_StartUpdate
    end
    object Action_Intercept: TAction
      Caption = #30417'[&V]'#35270' '
      Hint = #30417#35270#25968#25454#36827#20986
      ImageIndex = 3
      OnExecute = Action_InterceptExecute
      OnUpdate = Action_InterceptUpdate
    end
    object Action_About: TAction
      Caption = #20851'[&A]'#20110
      Hint = #36855#20320#20195#29702#31243#24207
      ImageIndex = 6
      OnExecute = Action_AboutExecute
    end
    object Action_Change: TAction
      Caption = #31713'[&C]'#25913
      Hint = #31713#25913#36755#20986#30340#25968#25454#21253
      ImageIndex = 7
      OnExecute = Action_ChangeExecute
    end
  end
  object UserManager: TIdUserManager
    Accounts = <>
    CaseSensitiveUsernames = False
    CaseSensitivePasswords = False
    Left = 106
    Top = 280
  end
  object PopupMenu: TPopupMenu
    Images = ImageList
    Left = 82
    Top = 246
    object N5: TMenuItem
      Action = Action_Start
      SubMenuImages = ImageList
    end
    object N1: TMenuItem
      Action = Action_Stop
      SubMenuImages = ImageList
    end
    object N2: TMenuItem
      Caption = '-'
      ImageIndex = 2
    end
    object N3: TMenuItem
      Action = Action_LoadServerInfo
      SubMenuImages = ImageList
    end
    object N4: TMenuItem
      Action = Action_LoadAccount
      SubMenuImages = ImageList
    end
    object N6: TMenuItem
      Caption = '-'
    end
    object N7: TMenuItem
      Action = Action_Quit
      SubMenuImages = ImageList
    end
  end
end


---------------------------------------------------------------------------------
- Userinfo.txt
---------------------------------------------------------------------------------
UserName=test,Password=test,Speed=102400


---------------------------------------------------------------------------------
- ServerInfo.txt
---------------------------------------------------------------------------------
#默认开放的代理端口,如果没有在bindings中指定需要提供代理的网段及端口,则默认在所有网段的defaultport上提供服务
DefaultPort=8888
#指定提供HTTP代理服务的接口ip及端口,用","分隔多个接口如:127.0.0.1:8080,127.0.0.1:8888,192.168.1.2:8080
HttpProxyBindings=0.0.0.0:8080
#端口映射服务所需要开放的接口及端口
MapBindings=127.0.0.1:9000
#代理服务所允许的最大连接数量,不是客户数,一个ie打开时有时侯可能同时开启4个连接,主要用于控制代理服务器的最大处理能力
MaxConnections=0
#控制是否使用代理认证,如果=1,则使用userinfo中的信息来人正客户端
UserManager=0
#设置代理服务器连接到目标服务器所允许的最大时间,避免一直连接,而无法中断该线程
ConnectTimeOut=10000
#设置读取数据的最大等待时间
ReadTimeOut=10000
#设置默认情况下每个连接的最大流量,1048576=1024*1024=1Mb,如果需要对某客户端控制,则需要在userinfo中对该用户配置
SpeedWithPeer=1048576
#最大日志行数
MaxLog=10000
#设置所允许的命令方法,常用的有get,post,head,options,允许http隧道功能的话需要开放connect
HTTP_OPTIONS=1
HTTP_GET=1
HTTP_HEAD=1
HTTP_POST=1
HTTP_PUT=1
HTTP_DELETE=1
HTTP_TRACE=1
HTTP_CONNECT=1

---------------------------------------------------------------------------------
- ChangeList.txt
---------------------------------------------------------------------------------
6C8A4B3A018BE81FEA0D686B5BADE6B2=4D1DEEF37B4F0FDCBBBA76090A363611
E7BA34301BA410175BCAA875802310D6=4D1DEEF37B4F0FDCBBBA76090A363611


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
HTTP 代理源代码
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复