{*******************************************************}
{                                                       }
{       ExploitHandler.pas                              }
{                                                       }
{                                                       }
{       Copyright (c) 2007-2008 Shenturk                }
{       Create: 15.05.2008                              }
{                                                       }
{                                                       }
{*******************************************************}

unit ExploitHandler;

{$WARNINGS OFF}

interface

uses
  Windows, SysUtils, Classes, Axctrls, ComObj, UrlMon, ActiveX, ActiveObjects,
  HTTPApp;

const
  IID_ExploitVirtualServer: TGUID = '{38DB76AD-BF52-4D43-A979-D63145102BEC}';

var
  VirtualHost: string = 'www.selfsozluk.com';
  DefaultDocument: string = 'default.asp'; //'index.asp';
  ScriptExtension: string = '.asp';
  DocumentRoot: string = '';

type
  { TURLComponents }
  TURLComponents = record
    Scheme,
    HostName,
    URLPath,
    ExtraInfo: string;
  end;

type
  { Forward Declarations }
  TExploitRequest = class;
  TExploitResponse = class;
  TExploitThread = class;

  // IInternetProtocol, //http://windowssdk.msdn.microsoft.com/en-us/library/ms528534.aspx
  // IInternetProtocolRoot // http://msdn.microsoft.com/workshop/networking/pluggable/reference/ifaces/iinternetprotocolroot/iinternetprotocolroot.asp

  { TExploitServer }
  TExploitServer = class(TComObject, IInternetProtocol, IInternetProtocolRoot)
  private
    FIProtSink: IInternetProtocolSink;
    FIBindInfo: IInternetBindInfo;
    FURL,
    FMethod,
    FQueryString,
    FPathInfo,
    FPathTranslated,
    FStatusString,
    FHeaders,
    FPostData: string; { Request Content }
    FStatusCode,
    FAvailable: Integer; { Request ContentLength }
    FContentType: WideString;
    FContentStream: TMemoryStream;
    FThread: TExploitThread;
    FTargetType: Integer;
    FTraceID: Integer;
    FCacheFile: WideString;
  protected
    { IInternetProtocolRoot }
    function Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
      OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
    function Continue(const ProtocolData: TProtocolData): HResult; stdcall;
    function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
    function Terminate(dwOptions: DWORD): HResult; stdcall;
    function Suspend: HResult; stdcall;
    function Resume: HResult; stdcall;
    { IInternetProtocol }
    function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
    function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
      out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
    function LockRequest(dwOptions: DWORD): HResult; stdcall;
    function UnlockRequest: HResult; stdcall;
  public
    procedure Initialize; override;
    procedure DebugTrace(const S: string);
    { Helper functions }
    function GetFieldByName(const Name: string): string;
    function WriteClient(var Buffer; Count: Integer): Integer;
    function WriteString(const AString: string): Boolean;
    function WriteHeaders(StatusCode: Integer; const StatusString, Headers: string): Boolean;
    { Properties }
    property IProtSink: IInternetProtocolSink read FIProtSink;
    property IBindInfo: IInternetBindInfo read FIBindInfo;
    { Request Section }
    property URL: string read FURL;
    property Method: string read FMethod;
    property QueryString: string read FQueryString;
    property PathInfo: string read FPathInfo;
    property PathTranslated: string read FPathTranslated;
    property PostData: string read FPostData;
    property Available: Integer read FAvailable;
    { Response Section }
    property StatusCode: Integer read FStatusCode write FStatusCode;
    property StatusString: string read FStatusString write FStatusString;
    property Headers: string read FHeaders write FHeaders;
    property ContentStream: TMemoryStream read FContentStream;
    property ContentType: WideString read FContentType;
    property CacheFile: WideString read FCacheFile write FCacheFile;
  end;

  { TExploitRequest }
  TExploitRequest = class(TWebRequest)
  private
    FExploit: TExploitServer;
  protected
    function GetStringVariable(Index: Integer): string; override;
    function GetDateVariable(Index: Integer): TDateTime; override;
    function GetIntegerVariable(Index: Integer): Integer; override;
  public
    constructor Create(ExploitServer: TExploitServer);
    function GetFieldByName(const Name: string): string; override;
    function ReadClient(var Buffer; Count: Integer): Integer; override;
    function ReadString(Count: Integer): string; override;
    function TranslateURI(const URI: string): string; override;
    function WriteClient(var Buffer; Count: Integer): Integer; override;
    function WriteString(const AString: string): Boolean; override;
    function WriteHeaders(StatusCode: Integer; const StatusString, Headers: string): Boolean; override;
  end;

  { TExploitResponse }
  TExploitResponse = class(TWebResponse)
  private
    FStatusCode: Integer;
    FStringVariables: array[0..MAX_STRINGS - 1] of string;
    FIntegerVariables: array[0..MAX_INTEGERS - 1] of Integer;
    FDateVariables: array[0..MAX_DATETIMES - 1] of TDateTime;
    FContent: string;
    FSent: Boolean;
  protected
    function GetContent: string; override;
    function GetDateVariable(Index: Integer): TDateTime; override;
    function GetIntegerVariable(Index: Integer): Integer; override;
    function GetLogMessage: string; override;
    function GetStatusCode: Integer; override;
    function GetStringVariable(Index: Integer): string; override;
    procedure SetContent(const Value: string); override;
    procedure SetDateVariable(Index: Integer; const Value: TDateTime); override;
    procedure SetIntegerVariable(Index: Integer; Value: Integer); override;
    procedure SetLogMessage(const Value: string); override;
    procedure SetStatusCode(Value: Integer); override;
    procedure SetStringVariable(Index: Integer; const Value: string); override;
    procedure InitResponse; virtual;
  public
    constructor Create(HTTPRequest: TWebRequest);
    procedure SendResponse; override;
    procedure SendRedirect(const URI: string); override;
    procedure SendStream(AStream: TStream); override;
    function Sent: Boolean; override;
  end;

  { TExploitThread }
  TExploitThread = class(TThread)
  private
    FDone: Boolean;
    FExploit: TExploitServer;
  public
    constructor Create(CreateSuspended: Boolean; ExploitServer: TExploitServer);
    procedure Execute; override;
    property Done: Boolean read FDone;
  end;

{ CrackURL }
function CrackURL(const URL: string; var URLComponents: TURLComponents): BOOL;

implementation

uses
  Main, WinInet, BrkrConst, ComServ2007;

const
  TARGET_ANYFILE    = 0;
  TARGET_SCRIPT     = 1;

{ CrackURL }
function CrackURL(const URL: string; var URLComponents: TURLComponents): BOOL;
var
  InetComponents: URL_COMPONENTS;
begin

  FillChar(InetComponents, SizeOf(URL_COMPONENTS), 0);
  with InetComponents do
  begin
    dwStructSize := SizeOf(URL_COMPONENTS);
    dwSchemeLength := 1;
    dwHostNameLength := 1;
    dwUserNameLength := 1;
    dwPasswordLength := 1;
    dwUrlPathLength := 1;
    dwExtraInfoLength := 1;
  end;

  Result := InternetCrackUrl(PChar(URL), 0, 0, InetComponents);
  if Result then
    with InetComponents, URLComponents do
    begin
      SetString(Scheme, lpszScheme, dwSchemeLength);
      SetString(HostName, lpszHostName, dwHostNameLength);
      SetString(URLPath, lpszUrlPath, dwUrlPathLength);
      SetString(ExtraInfo, lpszExtraInfo, dwExtraInfoLength);
    end;

end;

{ GetContentType }
function GetContentType(const FileName: string): string;
var
  Key: HKEY;
  Size: DWORD;
  Extension: string;
begin
  Result := '';
  Extension := ExtractFileExt(FileName);
  if RegOpenKeyEx(HKEY_CLASSES_ROOT, PChar(Extension), 0, KEY_READ, Key) = ERROR_SUCCESS then
  begin
    Size := 0;
    if RegQueryValueEx(Key, 'Content Type', nil, nil, nil, @Size) = ERROR_SUCCESS then
    begin
      SetLength(Result, Size);
      if RegQueryValueEx(Key, 'Content Type', nil, nil, PByte(Result), @Size) <> ERROR_SUCCESS then
        Result := '';
    end;
    if Size > 0 then SetLength(Result, Size - 1);
    RegCloseKey(Key);
  end;
end;

{ ServerVariableToIndex }
function ServerVariableToIndex(VariableName: PChar): Integer;
var
  Index: Integer;
begin
  Result := -1;
  for Index := Low(ServerVariables) to High(ServerVariables) do
    if StrIComp(PChar(ServerVariables[Index]), VariableName) = 0 then
    begin
      Result := Index;
      Break;
    end;
end;

{ HGlobalToString }
function HGlobalToString(Handle: HGLOBAL; Size: Integer): string;
var
  OleStream: TOleStream;
  Stream: IStream;
  S: TStringStream;
begin
  CreateStreamOnHGlobal(Handle, False, Stream);
  OleStream := TOleStream.Create(Stream);
  try
    S := TStringStream.Create('');
    try
      S.CopyFrom(OleStream, Size);
      Result := S.DataString;
    finally
      S.Free;
    end;
  finally
    OleStream.Free;
  end;
end;

{ TExploitServer }

function TExploitServer.Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
begin
  DebugTrace('ABORT');
  Result := E_NOTIMPL;
end;

function TExploitServer.Continue(const ProtocolData: TProtocolData): HResult;
begin
  DebugTrace('CONTINUE');
  Result := S_OK;
end;

procedure TExploitServer.DebugTrace(const S: string);
begin
  if Main.ExploitBrowserForm.Memo1.Visible then
  begin
    Main.ExploitBrowserForm.Memo1.Lines.Add(Format('ID: %d, %s', [FTraceID, S]));
    Inc(FTraceID);
  end;
end;

function TExploitServer.GetFieldByName(const Name: string): string;
var
  Index: Integer;
begin
  Index := ServerVariableToIndex(PChar(Name));
  case Index of
     0: Result := Self.FMethod;
     1: Result := 'HTTP/1.1';
     2: Result := Self.FURL;
     3: Result := Self.FQueryString;
     4: Result := Self.FPathInfo;
     5: Result := Self.FPathTranslated;
    10: Result := VirtualHost;
    16: Result := IntToStr(Self.FAvailable);
    23: Result := Self.FPathInfo;
    25: Result := Self.FPostData;
    { Others not supported }
  else
    Result := '';
  end;
  //Main.ExploitBrowserForm.Memo1.Lines.Add(Format('Fields: %s', [Name]));
end;

procedure TExploitServer.Initialize;
begin
  inherited Initialize;
  FTraceID := 0;
end;

function TExploitServer.LockRequest(dwOptions: DWORD): HResult; stdcall;
begin
  DebugTrace('LOCK');
  Result := S_OK;
end;

function TExploitServer.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
const
  BINDSTATUS_CACHECONTROL = BINDSTATUS_SESSION_COOKIES_ALLOWED + 1 ;
begin
  if not Assigned(FContentStream) then
  begin
    Result := INET_E_DOWNLOAD_FAILURE;
    Exit;
  end;
  if (FTargetType = TARGET_ANYFILE) then
  begin
    if ExtractFileExt(FPathTranslated) = '.swf' then
    begin
      FillChar(pv^, cb, 0);
      if FContentStream.Position < FContentStream.Size then
      begin
      cbRead := FContentStream.Read(pv^, cb);
      if cbRead > 0 then Result := S_OK
      else begin
        Result := S_FALSE;
      end;
      end
      else begin
        Result := S_FALSE;
      end;
    end
    else begin
      FillChar(pv^, cb, 0);
      cbRead := FContentStream.Read(pv^, cb);
      if cbRead > 0 then Result := S_OK
      else begin
        Result := S_FALSE;
      end;
    end;
  end
  else begin
    if FThread.Done then
    begin

      cbRead := FContentStream.Read(pv^, cb);
      if FContentStream.Position < FContentStream.Size then
        Result := S_OK
      else begin
        Result := S_FALSE;
      end;
    end
    else Result := HRESULT(E_PENDING);
  end;
  DebugTrace(Format('READ -> Path: %s, Length: %d', [FPathTranslated, cbRead]));
end;

function TExploitServer.Resume: HResult; stdcall;
begin
  DebugTrace('RESUME');
  Result := E_NOTIMPL;
end;

function TExploitServer.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
  out libNewPosition: ULARGE_INTEGER): HResult;
begin
  DebugTrace('SEEK');
  Result := E_NOTIMPL;
end;

function TExploitServer.Start(szUrl: PWideChar;
  OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo;
  grfPI, dwReserved: DWORD): HResult; stdcall;
const
  BINDSTATUS_CACHECONTROL = BINDSTATUS_SESSION_COOKIES_ALLOWED + 1 ;
var
  URLComponents: TURLComponents;
  bi: BINDINFO;
  bif: DWORD;
  Extension: string;
  DataSize: Integer;
  WidePathInfo: WideString;
begin

  FIProtSink := OIProtSink;
  FIBindInfo := OIBindInfo;

  Result := INET_E_OBJECT_NOT_FOUND;

  FURL := WideCharToString(szUrl);
  CrackURL(FURL, URLComponents);

  if Main.ExploitBrowserForm.Memo1.Visible then
    DebugTrace(Format('%s -> %4d URL: %s', ['START', Main.ExploitBrowserForm.Tag, FURL]));

  if not SameText(VirtualHost, URLComponents.HostName) then
  begin
    Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
    Exit;
  end;

  FillChar(bi, SizeOf(BINDINFO), 0);
  bif := 0;
  bi.cbSize := SizeOf(BINDINFO);
  FIBindInfo.GetBindInfo(bif, bi);

  if bi.dwBindVerb = BINDVERB_GET then
    FMethod := 'GET'
  else if bi.dwBindVerb = BINDVERB_POST then
    FMethod := 'POST'
  else if bi.dwBindVerb = BINDVERB_PUT then
    FMethod := 'PUT'
  else if bi.dwBindVerb = BINDVERB_CUSTOM then
    FMethod := 'CUSTOM';

  FQueryString := URLComponents.ExtraInfo;
  if Length(FQueryString) > 0 then Delete(FQueryString, 1, 1); { Char '?' }

  if (bi.dwBindVerb = BINDVERB_POST) and (bi.stgmedData.tymed = TYMED_HGLOBAL) then
  begin
    FAvailable := bi.cbstgmedData;
    FPostData := HGlobalToString(bi.stgmedData.hGlobal, FAvailable);
  end;

  FTargetType := TARGET_ANYFILE;

  FPathInfo := HTTPDecode(URLComponents.URLPath);
  WidePathInfo := HTTPDecode(URLComponents.URLPath);

  FPathTranslated := FPathInfo;

  if AnsiSameText(FPathInfo, '/') then
    FPathTranslated := FPathTranslated + DefaultDocument;

  Extension := ExtractFileExt(FPathTranslated);

  if AnsiSameText(Extension, ScriptExtension) then
    FTargetType := TARGET_SCRIPT;

  FContentStream := TMemoryStream.Create;
  try
    if FTargetType = TARGET_SCRIPT then { ASP Script file }
    begin
      if VirtualDrive.FileExists(FPathTranslated) then
      begin
        Result := HRESULT(E_PENDING);
        FThread := TExploitThread.Create(True, Self); { Create thread }
        FThread.Resume;
      end;
    end
    else begin { Any file }
      if VirtualDrive.FileExists(FPathTranslated) then
      begin
        FContentType := GetContentType(FPathTranslated);
        VirtualDrive.SaveToStream(FPathTranslated, FContentStream);
        DataSize := FContentStream.Size;
        Result := S_OK;
      end;
    end;
    { Read icin hazir }
    FContentStream.Position := 0;
  except

  end;

  with FIProtSink do
    if Result = S_OK then
    begin

      if Length(FContentType) = 0 then FContentType := CFSTR_MIME_HTML;

      ReportProgress(BINDSTATUS_DIRECTBIND, nil);
      ReportProgress(BINDSTATUS_USINGCACHEDCOPY, nil);
      ReportProgress(BINDSTATUS_FINDINGRESOURCE, PWideChar(WidePathInfo));
		  ReportProgress(BINDSTATUS_CONNECTING, PWideChar(WidePathInfo));
		  ReportProgress(BINDSTATUS_SENDINGREQUEST, PWideChar(WidePathInfo));

      if SameText(Extension, '.swf') then { flash/IE bug }
      begin
        FCacheFile := UnixPathToDosPath(VirtualDrive.Root + FPathTranslated);
        ReportProgress(BINDSTATUS_CACHEFILENAMEAVAILABLE, PWideChar(FCacheFile));
      end;
      ReportProgress(BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE, PWideChar(FContentType));
      ReportData(BSCF_FIRSTDATANOTIFICATION, 0, DataSize);
      ReportData(BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, DataSize, DataSize);
      ReportResult(Result, 200, nil);

    end
    else if Result = INET_E_OBJECT_NOT_FOUND then
      ReportResult(Result, 404, 'Not Found');

end;

function TExploitServer.Suspend: HResult; stdcall;
begin
  DebugTrace('SUSPEND');
  Result := E_NOTIMPL;
end;

function TExploitServer.Terminate(dwOptions: DWORD): HResult; stdcall;
begin
  DebugTrace('TERMINATE');

  if Assigned(FThread) then
  begin
    FThread.WaitFor;
    FreeAndNil(FThread);
  end;

  if Assigned(FContentStream) then
    FContentStream.Free;

  FIProtsink._Release; { IProtsink := nil; }
  FIBindInfo._Release; { IBindInfo := nil; }

  Result := S_OK;
  
end;

function TExploitServer.UnlockRequest: HResult;
begin
  DebugTrace('UNLOCK');
  Result := S_OK;
end;

function TExploitServer.WriteClient(var Buffer;
  Count: Integer): Integer;
begin
  Result := ContentStream.Write(Buffer, Count);
end;

function TExploitServer.WriteHeaders(StatusCode: Integer;
  const StatusString, Headers: string): Boolean;
begin
  FStatusCode := StatusCode;
  FStatusString := StatusString;
  FHeaders := Headers;
  Result := True;
end;

function TExploitServer.WriteString(const AString: string): Boolean;
begin
  Result := WriteClient(Pointer(AString)^, Length(AString)) = Length(AString);
end;

{ TExploitRequest }

constructor TExploitRequest.Create(ExploitServer: TExploitServer);
begin
  FExploit := ExploitServer;
  inherited Create;
end;

function TExploitRequest.GetDateVariable(Index: Integer): TDateTime;
var
  Value: string;
begin
  Value := GetStringVariable(Index);
  if Value <> '' then
    Result := ParseDate(Value)
  else Result := -1;
end;

function TExploitRequest.GetFieldByName(const Name: string): string;

  function AdjustHTTP(const Name: string): string;
  const
    SHttp = 'HTTP_';     { do not localize }
  begin
    if Pos(SHttp, Name) = 1 then
      Result := Copy(Name, 6, MaxInt)
    else
      Result := SHttp + Name;
  end;

begin
  Result := FExploit.GetFieldByName(Name);
  if Result = '' then
    Result := FExploit.GetFieldByName(AdjustHTTP(Name));
end;

function TExploitRequest.GetIntegerVariable(Index: Integer): Integer;
var
  Value: string;
begin
  Value := GetStringVariable(Index);
  if Value <> '' then
    Result := StrToInt(Value)
  else Result := -1;
end;

function TExploitRequest.GetStringVariable(Index: Integer): string;
begin
  case Index of
    0: Result := FExploit.Method;
    3: Result := FExploit.QueryString;
    4: Result := FExploit.PathInfo;
    5: Result := FExploit.PathTranslated;
    1..2, 6..24, 26..28: Result := GetFieldByName(ServerVariables[Index]);
    25: if FExploit.Available > 0 then { Request Content }
      SetString(Result, PChar(FExploit.PostData), FExploit.Available);
   else
      Result := '';
  end;
  if Main.ExploitBrowserForm.Memo1.Visible then
  begin
    Main.ExploitBrowserForm.Memo1.Lines.Add(Format('Index: %d, Result: %s', [Index, Result]));
  end;
end;

function TExploitRequest.ReadClient(var Buffer; Count: Integer): Integer;
begin
  Result := -1;
end;

function TExploitRequest.ReadString(Count: Integer): string;
var
  Len: Integer;
begin
  SetLength(Result, Count);
  Len := ReadClient(Pointer(Result)^, Count);
  if Len > 0 then
    SetLength(Result, Len)
  else Result := '';
end;

function TExploitRequest.TranslateURI(const URI: string): string;
var
  PathInfo: string;
  PathInfoPos: Integer;
  PathTranslated: string;
begin
  Result := URI;
  PathTranslated := FExploit.PathTranslated;
  if Length(PathTranslated) > 0 then
  begin
    PathInfo := UnixPathToDosPath(FExploit.PathInfo);
    PathInfoPos := Length(PathTranslated) - Length(PathInfo);
    if Copy(PathTranslated, PathInfoPos + 1, Length(PathInfo)) = PathInfo then
      Result := Copy(PathTranslated, 1, PathInfoPos) + UnixPathToDosPath(URI);
  end;
end;

function TExploitRequest.WriteClient(var Buffer; Count: Integer): Integer;
begin
  Result := FExploit.WriteClient(Buffer, Count);
end;

function TExploitRequest.WriteHeaders(StatusCode: Integer;
  const StatusString, Headers: string): Boolean;
begin
  Result := FExploit.WriteHeaders(StatusCode, StatusString, Headers);
end;

function TExploitRequest.WriteString(const AString: string): Boolean;
begin
  Result := WriteClient(Pointer(AString)^, Length(AString)) = Length(AString);
end;

{ TExploitResponse }

constructor TExploitResponse.Create(HTTPRequest: TWebRequest);
begin
  inherited Create(HTTPRequest);
  InitResponse;
end;

function TExploitResponse.GetContent: string;
begin
  Result := FContent;
end;

function TExploitResponse.GetDateVariable(Index: Integer): TDateTime;
begin
  if (Index >= 0) and (Index < 3) then
    Result := FDateVariables[Index]
  else Result := -1;
end;

function TExploitResponse.GetIntegerVariable(Index: Integer): Integer;
begin
  if (Index >= 0) and (Index < 2) then
    Result := FIntegerVariables[Index]
  else Result := -1;
end;

function TExploitResponse.GetLogMessage: string;
begin
  // Service not available
  Result := '';
end;

function TExploitResponse.GetStatusCode: Integer;
begin
  Result := FStatusCode;
end;

function TExploitResponse.GetStringVariable(Index: Integer): string;
begin
  if (Index >= 0) and (Index < 12) then
    Result := FStringVariables[Index];
end;

procedure TExploitResponse.InitResponse;
begin
  if FHTTPRequest.ProtocolVersion = '' then
    Version := '1.0';  { do not localize }
  StatusCode := 200;
  LastModified := -1;
  Expires := -1;
  Date := -1;
  ContentType := 'text/html';  { do not localize }
end;

procedure TExploitResponse.SendRedirect(const URI: string);
begin
  Location := URI;
  StatusCode := 302;
  ContentType := 'text/html';  { do not localize }
  Content := Format(sDocumentMoved, [URI]);
  SendResponse;
end;

procedure TExploitResponse.SendResponse;
var
  StatusString: string;
  Headers: string;
  I: Integer;

  procedure AddHeaderItem(const Item, FormatStr: string);
  begin
    if Item <> '' then
      Headers := Headers + Format(FormatStr, [Item]);
  end;

begin
  if HTTPRequest.ProtocolVersion <> '' then
  begin
    if (ReasonString <> '') and (StatusCode > 0) then
      StatusString := Format('%d %s', [StatusCode, ReasonString])
    else StatusString := '200 OK';                                              {do not localize }
    AddHeaderItem(Location, 'Location: %s'#13#10);                              {do not localize }
    AddHeaderItem(Allow, 'Allow: %s'#13#10);                                    {do not localize }
    for I := 0 to Cookies.Count - 1 do
      AddHeaderItem(Cookies[I].HeaderValue, 'Set-Cookie: %s'#13#10);            {do not localize }
    AddHeaderItem(DerivedFrom, 'Derived-From: %s'#13#10);                       {do not localize }
    if Expires > 0 then
      AddHeaderItem(Format(FormatDateTime(sDateFormat + ' "GMT"',               {do not localize}
        Expires), [DayOfWeekStr(Expires), MonthStr(Expires)]), 'Expires: %s'#13#10);  {do not localize}

    if LastModified > 0 then
      AddHeaderItem(Format(FormatDateTime(sDateFormat +
        ' "GMT"', LastModified), [DayOfWeekStr(LastModified),                   {do not localize}
        MonthStr(LastModified)]), 'Last-Modified: %s'#13#10);                         {do not localize}
    AddHeaderItem(Title, 'Title: %s'#13#10);                                    {do not localize }
    AddHeaderItem(FormatAuthenticate, 'WWW-Authenticate: %s'#13#10);               {do not localize }
    AddCustomHeaders(Headers);
    AddHeaderItem(ContentVersion, 'Content-Version: %s'#13#10);                 {do not localize }
    AddHeaderItem(ContentEncoding, 'Content-Encoding: %s'#13#10);               {do not localize }
    AddHeaderItem(ContentType, 'Content-Type: %s'#13#10);                       {do not localize }
    if (Content <> '') or (ContentStream <> nil) then
      AddHeaderItem(IntToStr(ContentLength), 'Content-Length: %s'#13#10);       {do not localize }
    Headers := Headers + 'Content:'#13#10#13#10;                                {do not localize }
    HTTPRequest.WriteHeaders(StatusCode, StatusString, Headers);
  end;
  if ContentStream = nil then
    HTTPRequest.WriteString(Content)
  else if ContentStream <> nil then
  begin
    SendStream(ContentStream);
    ContentStream := nil; // Drop the stream
  end;
  FSent := True;
end;

procedure TExploitResponse.SendStream(AStream: TStream);
var
  Buffer: array[0..8191] of Byte;
  BytesToSend: Integer;
begin
  while AStream.Position < AStream.Size do
  begin
    BytesToSend := AStream.Read(Buffer, SizeOf(Buffer));
    FHTTPRequest.WriteClient(Buffer, BytesToSend);
  end;
end;

function TExploitResponse.Sent: Boolean;
begin
  Result := FSent;
end;

procedure TExploitResponse.SetContent(const Value: string);
begin
  FContent := Value;
  if ContentStream = nil then
    ContentLength := Length(FContent);
end;

procedure TExploitResponse.SetDateVariable(Index: Integer;
  const Value: TDateTime);
begin
  if (Index >= Low(FDateVariables)) and (Index <= High(FDateVariables)) then
    FDateVariables[Index] := Value;
end;

procedure TExploitResponse.SetIntegerVariable(Index, Value: Integer);
begin
  if (Index >= Low(FIntegerVariables)) and (Index <= High(FIntegerVariables)) then
    FIntegerVariables[Index] := Value;
end;

procedure TExploitResponse.SetLogMessage(const Value: string);
begin
  // Service not available
end;

procedure TExploitResponse.SetStatusCode(Value: Integer);
begin
  if FStatusCode <> Value then
  begin
    FStatusCode := Value;
    ReasonString := StatusString(Value);
  end;
end;

procedure TExploitResponse.SetStringVariable(Index: Integer;
  const Value: string);
begin
  if (Index >= Low(FStringVariables)) and (Index <= High(FStringVariables)) then
    FStringVariables[Index] := Value;
end;

{ TExploitThread }

constructor TExploitThread.Create(CreateSuspended: Boolean;
  ExploitServer: TExploitServer);
begin
  inherited Create(CreateSuspended);
  FExploit := ExploitServer;
end;

procedure TExploitThread.Execute;
const
  sInternalServerError = '<html><title>Internal Server Error 500</title>'#13#10 +
    '<h1>Internal Server Error 500</h1><hr>'#13#10 +
    'Message: <b>%s</b><br></html>'#13#10;
var
  ExploitRequest: TExploitRequest;
  ExploitResponse: TExploitResponse;
  FScriptSite: TExploitScriptSite;
  Location, ContentType, CacheFileTemp: WideString;
begin

  // Call Coinitialize on this thread
  if (CoInitFlags = -1) and (IsMultiThread) then
    CoInitFlags := COINIT_MULTITHREADED; // Required for multithreaded
  if Assigned(ComObj.CoInitializeEx) and (CoInitFlags <> -1) then
    ComObj.CoInitializeEx(nil, CoInitFlags)
  else CoInitialize(nil);

  try
    ExploitRequest := TExploitRequest.Create(FExploit);
    try
      ExploitResponse := TExploitResponse.Create(ExploitRequest);
      try
        FScriptSite := TExploitScriptSite.Create(nil);
        try
          with FScriptSite do
          begin
            Request := ExploitRequest;
            Response := ExploitResponse;
            try
              Initialize;
              ExecuteFile(FExploit.PathTranslated);
              if not Response.Sent then Response.SendResponse;
              FDone := True;
              if Response.StatusCode = 302 then
              begin
                FExploit.ContentStream.Position := 0;
                Location := Response.Location;
                FExploit.IProtSink.ReportProgress(BINDSTATUS_REDIRECTING, PWideChar(Location));
                FExploit.IProtSink.ReportResult(INET_E_REDIRECTING, Response.StatusCode, 'Redirect');
              end
              else begin
                FExploit.ContentStream.Position := 0;
                ContentType := Response.ContentType;
                if Length(ContentType) = 0 then ContentType := CFSTR_MIME_HTML;
                SetLength(CacheFileTemp, MAX_PATH);
                CreateUrlCacheEntryW(PChar(FExploit.PathInfo), 0, 'txt', PWideChar(CacheFileTemp), 0);
                FExploit.CacheFile := PWideChar(CacheFileTemp);
                FExploit.ContentStream.SaveToFile(FExploit.CacheFile);
                FExploit.ContentStream.Position := 0;
                FExploit.IProtSink.ReportProgress(BINDSTATUS_CACHEFILENAMEAVAILABLE, PWideChar(FExploit.CacheFile));
                FExploit.IProtSink.ReportProgress(BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE, PWideChar(ContentType));
                FExploit.IProtSink.ReportData(BSCF_FIRSTDATANOTIFICATION or
                  BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE,
                  FExploit.ContentStream.Size, FExploit.ContentStream.Size);
                FExploit.IProtSink.ReportResult(S_OK, 200 {Response.StatusCode}, 'OK');
              end;
            except
              on E: Exception do
              begin
                FDone := True;
                FExploit.ContentStream.Clear;
                FExploit.WriteString(Format(sInternalServerError, [E.Message]));
                FExploit.ContentStream.Position := 0;
                FExploit.IProtSink.ReportData(BSCF_FIRSTDATANOTIFICATION or
                  BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE,
                  FExploit.ContentStream.Size, FExploit.ContentStream.Size);
                FExploit.IProtSink.ReportResult(S_OK, 500, nil);
              end;
            end;
          end;
        finally
          FScriptSite.Free;
        end;
      finally
        ExploitResponse.Free;
      end;
    finally
      ExploitRequest.Free;
    end;

  finally
    CoUninitialize;
  end;

end;

initialization
  TComObjectFactory.Create(ComServer, TExploitServer, IID_ExploitVirtualServer,
    'ExploitVirtualServer', 'ExploitVirtualServer', ciMultiInstance, tmApartment);
    
end.