{*******************************************************}
{                                                       }
{       ActiveObjects.pas                               }
{                                                       }
{                                                       }
{       Copyright (c) 2006-2009 Shenturk                }
{       Update: 10.08.2009                              }
{                                                       }
{                                                       }
{*******************************************************}

unit ActiveObjects;

{$WARNINGS OFF}

interface

uses
  Windows, SysUtils, Classes, ActiveX, ComObj, ObjComAuto2007, Variants, HTTPApp,
  DateUtils, ActiveScript, Parsers, AutoDomCore, AutoHtmlParser, EncdDecd,
  WinZLib, SelfSozluk_TLB, AutoIEParser, Urlmon, Scripting_TLB;

const
  CA_HIDETRAY = 0;
  CA_EXITAPP  = 1;
  
const
  ExploitVersion = '1.30';

resourcestring
  strNewVersionAvailable = 'Self Sözlük %s sürümü ile yeniden karşınızda! İndirmek ister misiniz?';

const
  MAX_VARIABLE = 29;
  ServerVariables: array[0..MAX_VARIABLE - 1] of string = (
    'REQUEST_METHOD',
    'SERVER_PROTOCOL',
    'URL',
    'QUERY_STRING',
    'PATH_INFO',
    'PATH_TRANSLATED',
    'HTTP_CACHE_CONTROL',
    'HTTP_DATE',
    'HTTP_ACCEPT',
    'HTTP_FROM',
    'HTTP_HOST',
    'HTTP_IF_MODIFIED_SINCE',
    'HTTP_REFERER',
    'HTTP_USER_AGENT',
    'HTTP_CONTENT_ENCODING',
    'HTTP_CONTENT_TYPE',
    'HTTP_CONTENT_LENGTH',
    'HTTP_CONTENT_VERSION',
    'HTTP_DERIVED_FROM',
    'HTTP_EXPIRES',
    'HTTP_TITLE',
    'REMOTE_ADDR',
    'REMOTE_HOST',
    'SCRIPT_NAME',
    'SERVER_PORT',
    'CONTENT',
    'HTTP_CONNECTION',
    'HTTP_COOKIE',
    'HTTP_AUTHORIZATION');

type

{$METHODINFO ON} { Undocumented Delphi Directive. Don't remove this line }

  { Forward Declarations }
  TExploitScriptSite = class;

  { TExploitDispatch }
  TExploitDispatch = class(TObjectDispatch)
  private
    FScriptSite: TExploitScriptSite;
  public
    constructor Create(ScriptSite: TExploitScriptSite);
    destructor Destroy; override;
    { Helper Functions }
    function CreateHTMLParser: IDispatch;
    function createIEParser: IDispatch;
    function CreateVBArray(): OleVariant; // Test only
    procedure Eval(const Code: WideString);
    function UTF8Encode(const Str: OleVariant): WideString;
    function UTF8Decode(const Str: OleVariant): WideString;
    function URLEncode(const Url: OleVariant): WideString;
    function URLDecode(const Url: OleVariant): WideString;
    function HTMLEncode(const Html: OleVariant): WideString;
    function HTMLDecode(const Html: OleVariant): WideString;
    function LowerCase(const Str: OleVariant): WideString;
    function LowerCaseUTF8(const Str: OleVariant): WideString;
    function StrConv(const V: OleVariant): WideString;
    function LoadFromFile(const FileName: WideString): WideString;
    function LoadFromArchive(const FileName: WideString): WideString;
    procedure SaveToFile(const FileName, Text: WideString);
    function DayOfTheWeek(Year, Month, Day: Integer): Integer;
    function GetShortDayName(DayOfWeek: Integer): WideString;
    function GetLongMonthName(Month: Integer): WideString;
    function GetLongDayName(Day: Integer): WideString;
    function Time: Double;
    function Date: Double;
    function Today: Double;
    function Now: Double;
    function DaysBetween(const ANow, AThen: Double): Double;
    function HoursBetween(const ANow, AThen: TDateTime): Double;
    function MinutesBetween(const ANow, AThen: Double): Double;
    function SecondsBetween(const ANow, AThen: TDateTime): Double;
    function MilliSecondsBetween(const ANow, AThen: TDateTime): Double;
    function DateToString(const Value: Double): WideString;
    function TimeToString(const Value: Double): WideString;
    function DateTimeToString(const Value: Double): WideString;
    function FormatDateTime(const Format: WideString; const Value: Double): WideString;
    function Base64Encode(const Text: OleVariant): WideString;
    function Base64Decode(const Text: OleVariant): WideString;
    function Extract(const Data: WideString): WideString; { unzip }
    function Package(const Data: WideString): WideString; { zip }
    function Package64(const Data: WideString): WideString; { zip base64 }
    function Extract64(const Data: WideString): WideString; { unzip base64 }
    function TrimLeft(const Text: OleVariant): WideString;
    function TrimRight(const Text: OleVariant): WideString;
    function Trim(const Text: OleVariant): WideString;
    function SmartFormat(const Value: Double): WideString;
    function HTMLColor(const Value: Cardinal): WideString;
    function Random(const Value: Integer): Integer;
    function FormatUnit(const Value: Double; UnitFormat: Integer = 0): WideString;
    function Unassigned: OleVariant;
    function Null: OleVariant;
    function Replace(const Text, OldPattern, NewPattern: WideString): WideString;
    procedure Sleep(const Wait: Integer);
    function WorkDir: WideString;
    function GetWorkDir: WideString;
    function GetSpecialFolderPath(const CLSID: Integer): WideString;
    function GetTempPath: WideString;
    function GetVersion: WideString;
    function GetAdsenseEnabled(const Element: WideString): Boolean;
    function GetAdsense(const Element: WideString): WideString;
    function GetGoogleEnabled: Boolean;
    function GetNewVersionEnabled: Boolean;
    function GetVersionText: WideString;
    function FileExists(const FileName: WideString): Boolean;
    function GetFormMethod: WideString;
    function ClearCRLF(const Data: WideString): WideString;
    function GetShowTrayIcon: Boolean;
    procedure SetShowTrayIcon(const Value: Integer);
    function GetCloseAction: Integer;
    procedure SetCloseAction(const Value: Integer);
    function GetIgnoreSave: Boolean;
    procedure SetIgnoreSave(const Value: Integer);
    function GetNotifyVersion: Boolean;
    procedure SetNotifyVersion(const Value: Integer);
    function GetTheme: WideString;
    procedure SetTheme(const Value: WideString);
  end;

  { TResponseDispatch }
  TResponseDispatch = class(TObjectDispatch)
  private
    FResponse: TWebResponse;
    function GetContentType: WideString;
    procedure SetContentType(const Value: WideString);
    function GetCacheControl: WideString;
    procedure SetCacheControl(const Value: WideString);
  public
    constructor Create(Response: TWebResponse);
    destructor Destroy; override;
    procedure WriteText(const Text: WideString);
    procedure Write(const Variable: OleVariant);
    procedure WriteLn(const Variable: OleVariant);
    procedure WriteBlock(iBlockNumber: Integer);
    procedure Redirect(const URL: WideString);
    procedure AddHeader(const Name, Value: WideString);
    procedure Clear;
  published
    property ContentType: WideString read GetContentType write SetContentType;
    property CacheControl: WideString read GetCacheControl write SetCacheControl;
  end;

  { TServerDispatch }
  TServerDispatch = class(TObjectDispatch)
  private
    FRequest: TWebRequest;
    FResponse: TWebResponse;
    FScriptSite: TExploitScriptSite;
  public
    constructor Create(ScriptSite: TExploitScriptSite;
      Request: TWebRequest; Response: TWebResponse);
    destructor Destroy; override;
    function CreateObject(const ProgID: WideString): IDispatch;
    function MapPath(const URI: WideString): WideString;
    procedure Execute(const URI: WideString);
    procedure Transfer(const URI: WideString);
    function HTMLEncode(const HTML: WideString): WideString;
    function URLEncode(const URL: WideString): WideString;
    function GetVarType(const Value: OleVariant): WideString;
  end;

  { TWriteDispatch }
  TWriteDispatch = class(TObjectDispatch)
  private
    FResponse: TWebResponse;
  public
    constructor Create(Response: TWebResponse);
    destructor Destroy; override;
    procedure WriteText(const Text: WideString);
    procedure Write(const Variable: OleVariant);
    procedure WriteLn(const Variable: OleVariant);
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
  end;

  { TWriteLnDispatch }
  TWriteLnDispatch = class(TWriteDispatch)
  public
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
  end;

  { TFormatDispatch }
  TFormatDispatch = class(TObjectDispatch)
  public
    constructor Create;
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
  end;

  { TRequireDispatch }
  TRequireDispatch = class(TObjectDispatch)
  private
    FScriptSite: TExploitScriptSite;
  public
    constructor Create(ScriptSite: TExploitScriptSite);
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
  end;

  { TUseDispatch }
  TUseDispatch = class(TObjectDispatch)
  private
    FScriptSite: TExploitScriptSite;
  public
    constructor Create(ScriptSite: TExploitScriptSite);
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
      ArgErr: Pointer): HRESULT; override; stdcall;
  end;

{$METHODINFO OFF}

  { TSessionDispatch }
  TSessionDispatch = class(TAutoIntfObject, ISession)
  private
    FContents: IDictionary;
  protected
    function Get_Value(const bstrKey: WideString): OleVariant; safecall;
    procedure Set_Value(const bstrKey: WideString; Value: OleVariant); safecall;
    function Get_SessionID: WideString; safecall;
    function Get_Contents: OleVariant; safecall;
  public
    constructor Create;
  end;

  { TRequestDictionary }
  TRequestDictionary = class(TAutoIntfObject, IDispatch, IRequestDictionary)
  private
    FValues: IDictionary;
    function ValuesToString: OleVariant;
  protected
    function Get_Item(Param: OleVariant): OleVariant; safecall;
    function Get_Count: Integer; safecall;
    function Get_Key(VarKey: OleVariant): OleVariant; safecall;
    function Exists(varKey: OleVariant): WordBool; safecall;
    procedure Add(varKey: OleVariant; varItem: OleVariant); safecall;
    { IDispatch }
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create;
  end;

  { TRequestDispatch }
  TRequestDispatch = class(TAutoIntfObject, IRequest)
  private
    FWebRequest: TWebRequest;
    FForm: IRequestDictionary;
    FQueryString: IRequestDictionary;
    FCookies: IRequestDictionary;
    FServerVariables: IRequestDictionary;
    procedure InitializeQueryString;
    procedure InitializeForm;
    procedure InitializeCookies;
    procedure InitializeServerVariables;
  protected
    function Get_Item(const bstrVar: WideString): OleVariant; safecall;
    function Get_Form: IRequestDictionary; safecall;
    function Get_QueryString: IRequestDictionary; safecall;
    function Get_Cookies: IRequestDictionary; safecall;
    function Get_ServerVariables: IRequestDictionary; safecall;
  public
    constructor Create(Request: TWebRequest);
  end;

  { TExploitScript }
  TExploitScriptSite = class(TActiveScriptSite)
  private
    FRequest: TWebRequest;
    FResponse: TWebResponse;
    FRequireFiles: TStrings;
    FCodeSource: WideString;
    { Exploit Objects }
    FIExploit,
    FIResponse,
    FIServer,
    FIRequest,
    { Exploit Procedures }
    FIWrite,
    FIWriteLn,
    FFormat,
    FRequire,
    FUse: IDispatch;
  protected
    procedure ScriptHandleError(Sender: TObject; Line, Pos: Integer;
      Source, Description: string);
    function ParseExploitFile(const FileName: string): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Initialize; virtual;
    procedure RegisterScriptObjects; virtual;
    function ExecuteFile(const FileName: WideString): WideString;
    function TransferFile(const FileName: WideString): WideString;
    function RequireFile(const FileName: WideString): WideString;
    function UseFile(const FileName: WideString): WideString;
    procedure Eval(const Code: WideString);
  published
    property Request: TWebRequest read FRequest write FRequest;
    property Response: TWebResponse read FResponse write FResponse;
  end;

type

  { TVirtualDrive }
  TVirtualDrive = class(TObject)
  private
    FRoot: string;
  public
    constructor Create(const ARoot: string);
    function FileExists(const FileName: string): Boolean; virtual; abstract;
    procedure SaveToStream(const FileName: string; Stream: TStream); virtual; abstract;
    property Root: string read FRoot;
  end;

  { TArchiveDrive }
  TArchiveDrive = class(TVirtualDrive)
  private
    FArchive: TArchive;
  public
    constructor Create(const ArchiveFile, ARoot: string);
    destructor Destroy; override;
    function FileExists(const FileName: string): Boolean; override;
    procedure SaveToStream(const FileName: string; Stream: TStream); override;
  end;

  { TResourceArchiveDrive }
  TResourceArchiveDrive = class(TVirtualDrive)
  private
    FArchive: TArchive;
  public
    constructor Create(AInstance: THandle; const AResourceName: string;
      AResourceType: PChar; const ARoot: string);
    destructor Destroy; override;
    function FileExists(const FileName: string): Boolean; override;
    procedure SaveToStream(const FileName: string; Stream: TStream); override;
  end;

  { TPhysicalDrive }
  TPhysicalDrive = class(TVirtualDrive)
  public
    constructor Create(const ARoot: string);
    destructor Destroy; override;
    function FileExists(const FileName: string): Boolean; override;
    procedure SaveToStream(const FileName: string; Stream: TStream); override;
  end;

var
  { Global Variants }
  VirtualDrive: TVirtualDrive;
  GoogleEnabled: Boolean = False;
  NewVersionEnabled: Boolean = False;
  VersionText: WideString = '';

{ InitGlobalScriptObjects }
procedure InitGlobalScriptObjects;

{ DoneGlobalScriptObjects }
procedure DoneGlobalScriptObjects;

implementation

uses
  ComServ2007, ShlObj, SHFolder, Forms, Main, ExUtils;

var
  SessionGlobal: ISession;

const
  sExploitCompilerError = 'Exploit Compiler Error (%d, %d): <i>%s</i> [%s]';

{ InitGlobalScriptObjects }
procedure InitGlobalScriptObjects;
begin
  SessionGlobal := TSessionDispatch.Create as ISession;
end;

{ DoneGlobalScriptObjects }
procedure DoneGlobalScriptObjects;
begin
  SessionGlobal := nil;
end;

const
  UF_AUTOBYTE = 0;
  UF_BYTE     = 1;
  UF_KILOBYTE = 2;
  UF_MEGABYTE = 3;
  UF_GIGABYTE = 4;
  UF_TERABYTE = 5;

const
  KiloByte = 1024.00;
  MegaByte = KiloByte * 1024.00;
  GigaByte = MegaByte * 1024.00;
  TeraByte = GigaByte * 1024.00;

{ BytesToSmartString }
function BytesToSmartString(Value: Double): string;
begin
  if Value < KiloByte then
    Result := FormatFloat('#,0 B', Value)
  else
  if Value < MegaByte then
    Result := FormatFloat('#,0 KB', Value / KiloByte)
  else
  if Value < GigaByte then
    Result := FormatFloat('#,0 MB', Value / MegaByte)
  else Result := FormatFloat('#,##0.00 GB', Value / GigaByte);
end;

{ SmartFormatString }
function SmartFormatString(Value: Double; UnitFormat: Integer = 0): string;
begin
  Result := '';
  case UnitFormat of
    UF_AUTOBYTE : Result := BytesToSmartString(Value);
    UF_BYTE     : Result := FormatFloat('#,0 B', Value);
    UF_KILOBYTE : Result := FormatFloat('#,0 KB', Value / KiloByte);
    UF_MEGABYTE : Result := FormatFloat('#,0 MB', Value / MegaByte);
    UF_GIGABYTE : Result := FormatFloat('#,##0.00 GB', Value / GigaByte);
  end;
end;

{ Ogretici bir fonksiyondur. Incelemenizi siddetle tavsiye ederim. }
{ GetDefaultValue }
function GetDefaultValue(const Variable: OleVariant): WideString;
var
  CallDesc: TCallDesc;
  DispIDs: Integer;
  ParamArray: array [0..0] of Variant;
  Dispatch: IDispatch;
  DispResult: OleVariant;
begin
  Result := '';
  Dispatch := IDispatch(Variable);
  DispIDs := 0; { Default Value icin DispIDs 0 olmali}
  FillChar(CallDesc, SizeOf(CallDesc), 0);
  CallDesc.CallType := DISPATCH_PROPERTYGET; { Property }
  CallDesc.ArgCount := 0; { Parametre yok. }
  { ParamArray gereksiz ama DispatchInvoke fonksiyonunda nil yazan yere koyabiliriz. }
  FillChar(ParamArray, SizeOf(ParamArray), 0);
  DispatchInvoke(Dispatch, @CallDesc, @DispIDs, nil, @DispResult);
  if VarType(DispResult) <> varDispatch then
    Result := DispResult; { Property Value' yi string' e cevir }
end;

{ VariantArrayToString }
function VariantArrayToString(const V: OleVariant): string;
var
  P: Pointer;
  Size: Integer;
begin
  Result := '';
  if VarIsArray(V) and (VarType(V) and varTypeMask = varByte) then
  begin
    Size := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;
    if Size > 0 then
    begin
      SetLength(Result, Size);
      P := VarArrayLock(V);
      try
        Move(P^, Result[1], Size);
      finally
        VarArrayUnlock(V);
      end;
    end;
  end;
end;

{ StringToVariantArray }
function StringToVariantArray(const S: string): OleVariant;
var
  P: Pointer;
begin
  Result := NULL;
  if Length(S) > 0 then
  begin
    Result := VarArrayCreate([0, Length(S) - 1], varByte);
    P := VarArrayLock(Result);
    try
      Move(S[1], P^, Length(S));
    finally
      VarArrayUnlock(Result);
    end;
  end;
end;

{ GetPureText }
function GetPureText(Parser: TScriptParser): string;
var
  StartPtr, EndPtr: PChar;
  Token: Word;
begin
  Result := '';
  StartPtr := Parser.LastPtr;
  EndPtr := StartPtr;
  while True do begin
    Token := Parser.NextToken;
    case Token of
      idEOF: Break;
      idScriptEnd:
        begin
          EndPtr := Parser.LastPtr;
          EndPtr := EndPtr - 2; // for %> tag
          Break;
        end;
    end;
  end;
  if EndPtr > StartPtr then
    Result := Parser.GetPureText(StartPtr, EndPtr);
end;

{ GetIncludeText }
function GetIncludeText(Parser: TScriptParser): string;
var
  StartPtr, EndPtr: PChar;
  Token: Word;
begin
  Result := '';
  StartPtr := Parser.LastPtr;
  EndPtr := StartPtr;
  while True do
  begin
    Token := Parser.NextToken;
    case Token of
      idEOF: Break;
      idCommentEnd:
        begin
          EndPtr := Parser.LastPtr;
          EndPtr := EndPtr - 3; // for --> tag
          Break;
        end;
    end;
  end;
  if EndPtr > StartPtr then
    Result := Parser.GetPureText(StartPtr, EndPtr);
end;

{ GetCommentText }
function GetCommentText(Parser: TScriptParser): string;
var
  StartPtr, EndPtr: PChar;
  Token: Word;
begin
  Result := '';
  StartPtr := Parser.LastPtr;
  EndPtr := StartPtr;
  while True do
  begin
    Token := Parser.NextToken;
    case Token of
      idEOF: Break;
      idCommentEnd:
        begin
          EndPtr := Parser.LastPtr;
          EndPtr := EndPtr - 3; // for --> tag
          Break;
        end;
    end;
  end;
  if EndPtr > StartPtr then
    Result := Parser.GetPureText(StartPtr, EndPtr);
end;

{ TExploitDispatch }

function TExploitDispatch.Base64Decode(const Text: OleVariant): WideString;
begin
  if VarType(Text) = varDispatch then
    Result := DecodeString(GetDefaultValue(Text))
  else
    Result := DecodeString(Text);
end;

function TExploitDispatch.Base64Encode(const Text: OleVariant): WideString;
begin
  if VarType(Text) = varDispatch then
    Result := EncodeString(GetDefaultValue(Text))
  else
    Result := EncodeString(Text);
end;

function TExploitDispatch.ClearCRLF(const Data: WideString): WideString;
begin
  Result := SysUtils.StringReplace(Data, #13, '', [rfReplaceAll]);
  Result := SysUtils.StringReplace(Result, #10, '', [rfReplaceAll]);
end;

constructor TExploitDispatch.Create(ScriptSite: TExploitScriptSite);
begin
  inherited Create(Self, False);
  FScriptSite := ScriptSite;
end;

function TExploitDispatch.CreateHTMLParser: IDispatch;
begin
  Result := TAutoHTMLParser.Create as IDispatch;
end;

function TExploitDispatch.createIEParser: IDispatch;
begin
  Result := TAutoIEParser.Create as IDispatch;
end;

function TExploitDispatch.CreateVBArray: OleVariant;
begin
  Result := VarArrayCreate([0, 9], varVariant);
end;

function TExploitDispatch.Date: Double;
begin
  Result := SysUtils.Date;
end;

function TExploitDispatch.DateTimeToString(
  const Value: Double): WideString;
begin
  Result := DateTimeToStr(Value);
end;

function TExploitDispatch.DateToString(const Value: Double): WideString;
begin
  Result := SysUtils.DateToStr(Value);
end;

function TExploitDispatch.DayOfTheWeek(Year, Month, Day: Integer): Integer;
var
  st: _SYSTEMTIME;
begin
  FillChar(st, SizeOf(_SYSTEMTIME), 0);
  DateTimeToSystemTime(EncodeDate(Year, Month, Day), st);
  Result := st.wDayOfWeek;
  //Result := DateUtils.DayOfTheWeek(EncodeDate(Year, Month, Day));
end;

function TExploitDispatch.DaysBetween(const ANow, AThen: Double): Double;
begin
  Result := DateUtils.DaysBetween(ANow, AThen);
end;

destructor TExploitDispatch.Destroy;
begin
  inherited Destroy;
end;

procedure TExploitDispatch.Eval(const Code: WideString);
begin
  FScriptSite.Eval(Code);
end;

function TExploitDispatch.Extract(const Data: WideString): WideString;
begin
  Result := ExUtils.Extract(Data);
end;

function TExploitDispatch.Extract64(const Data: WideString): WideString;
begin
  Result := ExUtils.Extract64(Data);
end;

function TExploitDispatch.FileExists(const FileName: WideString): Boolean;
begin
  Result := SysUtils.FileExists(FileName);
end;

function TExploitDispatch.FormatDateTime(const Format: WideString;
  const Value: Double): WideString;
begin
  Result := SysUtils.FormatDateTime(Format, Value);
end;

function TExploitDispatch.FormatUnit(const Value: Double;
  UnitFormat: Integer): WideString;
begin
  Result := SmartFormatString(Value, UnitFormat);
end;

function TExploitDispatch.GetAdsense(const Element: WideString): WideString;
begin
  Result := '';
end;

function TExploitDispatch.GetAdsenseEnabled(
  const Element: WideString): Boolean;
begin
  Result := GoogleEnabled;
end;

function TExploitDispatch.GetCloseAction: Integer;
begin
  Result := Main.ExploitBrowserForm.GetCloseAction;
end;

function TExploitDispatch.GetFormMethod: WideString;
begin
  Result := 'get';
end;

function TExploitDispatch.GetGoogleEnabled: Boolean;
begin
  Result := GoogleEnabled;
end;

function TExploitDispatch.GetIgnoreSave: Boolean;
begin
  Result := Main.ExploitBrowserForm.GetIgnoreSave;
end;

function TExploitDispatch.GetLongDayName(Day: Integer): WideString;
begin
  Result := SysUtils.LongdayNames[Day];
end;

function TExploitDispatch.GetLongMonthName(Month: Integer): WideString;
begin
  Result := SysUtils.LongMonthNames[Month];
end;

function TExploitDispatch.GetNewVersionEnabled: Boolean;
begin
  Result := NewVersionEnabled;
end;

function TExploitDispatch.GetNotifyVersion: Boolean;
begin
  Result := Main.ExploitBrowserForm.GetNotifyVersion;
end;

function TExploitDispatch.GetShortDayName(DayOfWeek: Integer): WideString;
begin
  Result := SysUtils.ShortDayNames[DayOfWeek];
end;

function TExploitDispatch.GetShowTrayIcon: Boolean;
begin
  Result := Main.ExploitBrowserForm.GetShowTrayIcon;
end;

function TExploitDispatch.GetSpecialFolderPath(
  const CLSID: Integer): WideString;
begin
  SetLength(Result, MAX_PATH);
  if SHGetSpecialFolderPathW(HWND_DESKTOP, PWideChar(Result), CLSID, False) then
    Result := PWideChar(Result)
  else Result := '';
end;

function TExploitDispatch.GetTempPath: WideString;
var
  AnsiPath: string;
begin
  SetLength(AnsiPath, MAX_PATH);
  Windows.GetTempPath(MAX_PATH, PChar(AnsiPath));
  AnsiPath := PChar(AnsiPath);
  Result := AnsiPath;
end;

function TExploitDispatch.GetTheme: WideString;
begin
  Result := Main.ExploitBrowserForm.GetTheme;
end;

function TExploitDispatch.GetVersion: WideString;
begin
  Result := ExploitVersion;
end;

function TExploitDispatch.GetVersionText: WideString;
begin
  Result := VersionText;
end;

function TExploitDispatch.GetWorkDir: WideString;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

function TExploitDispatch.HoursBetween(const ANow,
  AThen: TDateTime): Double;
begin
  Result := DateUtils.HoursBetween(ANow, AThen);
end;

function TExploitDispatch.HTMLColor(const Value: Cardinal): WideString;
begin
  Result := WideFormat('#%.06x', [Value and $00FFFFFF]);
end;

function TExploitDispatch.HTMLDecode(const Html: OleVariant): WideString;
begin
  if VarType(Html) = varDispatch then
    Result := HTTPApp.HTMLDecode(GetDefaultValue(Html))
  else
    Result := HTTPApp.HTMLDecode(Html);
end;

function TExploitDispatch.HTMLEncode(const Html: OleVariant): WideString;
begin
  if VarType(Html) = varDispatch then
    Result := HTTPApp.HTMLEncode(GetDefaultValue(Html))
  else
    Result := HTTPApp.HTMLEncode(Html);
end;

function TExploitDispatch.LoadFromArchive(
  const FileName: WideString): WideString;
var
  S: TStringStream;
begin
  Result := '';
  if Assigned(VirtualDrive) and VirtualDrive.FileExists(FileName) then
  begin
    S := TStringStream.Create('');
    try
      VirtualDrive.SaveToStream(FileName, S);
      Result := S.DataString;
    finally
      S.Free;
    end;
  end;
end;

function TExploitDispatch.LoadFromFile(
  const FileName: WideString): WideString;
var
  F: TFileStream;
  S: TStringStream;
begin
  F := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  try
    S := TStringStream.Create('');
    try
      S.CopyFrom(F, F.Size);
      Result := S.DataString;
    finally
      S.Free;
    end;
  finally
    F.Free;
  end;
end;

function TExploitDispatch.LowerCase(const Str: OleVariant): WideString;
begin
  // Result := Self.UTF8Encode(SysUtils.AnsiLowerCase(Self.UTF8Decode(Str)));
  if VarType(Str) = varDispatch then
    Result := SysUtils.AnsiLowerCase(GetDefaultValue(Str))
  else
    Result := SysUtils.AnsiLowerCase(Str)
end;

function TExploitDispatch.LowerCaseUTF8(const Str: OleVariant): WideString;
begin
  if VarType(Str) = varDispatch then
    Result := System.UTF8Encode(SysUtils.AnsiLowerCase(System.UTF8Decode(GetDefaultValue(Str))))
  else
    Result := System.UTF8Encode(SysUtils.AnsiLowerCase(System.UTF8Decode(Str)));
end;

function TExploitDispatch.MilliSecondsBetween(const ANow,
  AThen: TDateTime): Double;
begin
  Result := DateUtils.MilliSecondsBetween(ANow, AThen);
end;

function TExploitDispatch.MinutesBetween(const ANow,
  AThen: Double): Double;
begin
  Result := DateUtils.MinutesBetween(ANow, AThen);
end;

function TExploitDispatch.Now: Double;
begin
  Result := SysUtils.Now;
end;

function TExploitDispatch.Null: OleVariant;
begin
  Result := Variants.Null;
end;

function TExploitDispatch.Package(const Data: WideString): WideString;
begin
  Result := ExUtils.Package(Data);
end;

function TExploitDispatch.Package64(const Data: WideString): WideString;
begin
  Result := ExUtils.Package64(Data);
end;

function TExploitDispatch.Random(const Value: Integer): Integer;
begin
  Result := System.Random(Value);
end;

function TExploitDispatch.Replace(const Text, OldPattern,
  NewPattern: WideString): WideString;
begin
  Result := StringReplace(Text, OldPattern, NewPattern, [rfReplaceAll]);
end;

procedure TExploitDispatch.SaveToFile(const FileName, Text: WideString);
var
  F: TStringStream;
  M: TMemoryStream;
begin
  F := TStringStream.Create(Text);
  try
    M := TMemoryStream.Create;
    try
      M.CopyFrom(F, F.Size);
      M.SaveToFile(FileName);
    finally
      M.Free;
    end;
  finally
    F.Free;
  end;
end;

function TExploitDispatch.SecondsBetween(const ANow,
  AThen: TDateTime): Double;
begin
  Result := DateUtils.SecondsBetween(ANow, AThen);
end;

procedure TExploitDispatch.SetCloseAction(const Value: Integer);
begin
  Main.ExploitBrowserForm.SetCloseAction(Value);
end;

procedure TExploitDispatch.SetIgnoreSave(const Value: Integer);
begin
  Main.ExploitBrowserForm.SetIgnoreSave(Value);
end;

procedure TExploitDispatch.SetNotifyVersion(const Value: Integer);
begin
  Main.ExploitBrowserForm.SetNotifyVersion(Value);
end;

procedure TExploitDispatch.SetShowTrayIcon(const Value: Integer);
begin
  Main.ExploitBrowserForm.SetShowTrayIcon(Value);
end;

procedure TExploitDispatch.SetTheme(const Value: WideString);
begin
  Main.ExploitBrowserForm.SetTheme(Value);
end;

procedure TExploitDispatch.Sleep(const Wait: Integer);
begin
  Windows.Sleep(Wait);
end;

function TExploitDispatch.SmartFormat(const Value: Double): WideString;
const
  KiloByte = 1024.00;
  MegaByte = KiloByte * 1024.00;
  GigaByte = MegaByte * 1024.00;
  TeraByte = GigaByte * 1024.00;
  
  { BytesToSmartString }
  function BytesToSmartString(Value: Double): string;
  begin
    if Value < KiloByte then
      Result := FormatFloat('#,0 B', Value)
    else
    if Value < MegaByte then
      Result := FormatFloat('#,0 KB', Value / KiloByte)
    else
    if Value < GigaByte then
      Result := FormatFloat('#,0 MB', Value / MegaByte)
    else Result := FormatFloat('#,##0.00 GB', Value / GigaByte);
  end;
  
begin
  Result := BytesToSmartString(Value);
end;


function TExploitDispatch.StrConv(const V: OleVariant): WideString;
begin
  Result := VariantArrayToString(V);
end;

function TExploitDispatch.Time: Double;
begin
  Result := SysUtils.Time;
end;

function TExploitDispatch.TimeToString(const Value: Double): WideString;
begin
  Result := SysUtils.TimeToStr(Value);
end;

function TExploitDispatch.Today: Double;
begin
  Result := SysUtils.Now;
end;

function TExploitDispatch.Trim(const Text: OleVariant): WideString;
begin
  if VarType(Text) = varDispatch then
    Result := SysUtils.Trim(GetDefaultValue(Text))
  else
    Result := SysUtils.Trim(Text)
end;

function TExploitDispatch.TrimLeft(const Text: OleVariant): WideString;
begin
  if VarType(Text) = varDispatch then
    Result := SysUtils.TrimLeft(GetDefaultValue(Text))
  else
    Result := SysUtils.TrimLeft(Text);
end;

function TExploitDispatch.TrimRight(const Text: OleVariant): WideString;
begin
  if VarType(Text) = varDispatch then
    Result := SysUtils.TrimRight(GetDefaultValue(Text))
  else
    Result := SysUtils.TrimRight(Text);
end;

function TExploitDispatch.Unassigned: OleVariant;
begin
  Result := Variants.Unassigned;
end;

function TExploitDispatch.URLDecode(const Url: OleVariant): WideString;
begin
  if VarType(Url) = varDispatch then
    Result := HTTPApp.HTTPDecode(GetDefaultValue(Url))
  else
    Result := HTTPApp.HTTPDecode(Url);
end;

function TExploitDispatch.URLEncode(const Url: OleVariant): WideString;
begin
  if VarType(Url) = varDispatch then
    Result := HTTPApp.HTTPEncode(GetDefaultValue(Url))
  else
    Result := HTTPApp.HTTPEncode(Url);
end;

function TExploitDispatch.UTF8Decode(const Str: OleVariant): WideString;
begin
  {
  if VarType(Str) = varDispatch then
    Result := System.UTF8Decode(GetDefaultValue(Str))
  else
    Result := System.UTF8Decode(Str);
  }
  if VarType(Str) = varDispatch then
    Result := UTF8ToWideString(GetDefaultValue(Str))
  else
    Result := UTF8ToWideString(Str);

end;

function TExploitDispatch.UTF8Encode(const Str: OleVariant): WideString;
begin
  {
  if VarType(Str) = varDispatch then
    Result := System.UTF8Encode(GetDefaultValue(Str))
  else
    Result := System.UTF8Encode(Str);
  }

  if VarType(Str) = varDispatch then
    Result := WideStringToUTF8(GetDefaultValue(Str))
  else
    Result := WideStringToUTF8(Str);

end;

function TExploitDispatch.WorkDir: WideString;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

{ TResponseDispatch }

procedure TResponseDispatch.AddHeader(const Name, Value: WideString);
begin
  FResponse.CustomHeaders.Add(Name + '=' + Value);
end;

procedure TResponseDispatch.Clear;
begin
  FResponse.Content := '';
end;

constructor TResponseDispatch.Create(Response: TWebResponse);
begin
  inherited Create(Self, False);
  FResponse := Response;
end;

destructor TResponseDispatch.Destroy;
begin
  inherited Destroy;
end;

function TResponseDispatch.GetCacheControl: WideString;
begin
  Result := '';
end;

function TResponseDispatch.GetContentType: WideString;
begin
  Result := FResponse.ContentType;
end;

procedure TResponseDispatch.Redirect(const URL: WideString);
begin
  FResponse.SendRedirect(URL);
end;

procedure TResponseDispatch.SetCacheControl(const Value: WideString);
begin
  FResponse.CustomHeaders.Add('Cache-Control=' + Value);
end;

procedure TResponseDispatch.SetContentType(const Value: WideString);
begin
  FResponse.ContentType := Value;
end;

procedure TResponseDispatch.Write(const Variable: OleVariant);
var
  VarText: WideString;
begin
  VarText := '';
  case VarType(Variable) of
    varSmallInt,
    varInteger,
    varShortInt,
    varByte,
    varWord,
    varLongWord,
    varInt64,
    varOleStr,
    varString: VarText := Variable;
    varDispatch: VarText := GetDefaultValue(Variable);
    else VarText := Variable; //'Unknown Type';
  end;
  Self.WriteText(VarText);
end;

procedure TResponseDispatch.WriteBlock(iBlockNumber: Integer);
begin
  // ASP den alinti
end;

procedure TResponseDispatch.WriteLn(const Variable: OleVariant);
begin
  Self.Write(Variable);
  Self.WriteText(sLineBreak);
end;

procedure TResponseDispatch.WriteText(const Text: WideString);
begin
  FResponse.Content := FResponse.Content + Text;
end;

{ TServerDispatch }

constructor TServerDispatch.Create(ScriptSite: TExploitScriptSite;
  Request: TWebRequest; Response: TWebResponse);
begin
  inherited Create(Self, False);
  FScriptSite := ScriptSite;
  FRequest := Request;
  FResponse := Response;
end;

function TServerDispatch.CreateObject(const ProgID: WideString): IDispatch;
var
  ClassID: TCLSID;
begin
  ClassID := ProgIDToClassID(ProgID);
  OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IDispatch, Result));
end;

destructor TServerDispatch.Destroy;
begin
  inherited Destroy;
end;

procedure TServerDispatch.Execute(const URI: WideString);
var
  Script: TExploitScriptSite;
  FileName: string;
begin
  Script := TExploitScriptSite.Create(nil);
  try
    Script.Request := FRequest;
    Script.Response := FResponse;
    Script.Initialize;
    FileName := MapPath(URI);
    if FileExists(FileName) then
      Script.ExecuteFile(FileName)
    else raise Exception.CreateFmt('File not found "%s"', [URI]);
  finally
    Script.Free;
  end;
end;

function TServerDispatch.GetVarType(const Value: OleVariant): WideString;
begin
  Result := VarTypeAsText(VarType(Value));
end;

function TServerDispatch.HTMLEncode(const HTML: WideString): WideString;
begin
  Result := HTTPApp.HTMLEncode(HTML);
end;

function TServerDispatch.MapPath(const URI: WideString): WideString;
begin
  Result := FRequest.TranslateURI(URI);
end;

procedure TServerDispatch.Transfer(const URI: WideString);
var
  FileName: string;
begin
  FileName := MapPath(URI);
  if FileExists(FileName) then
    FScriptSite.TransferFile(FileName)
  else raise Exception.CreateFmt('File not found "%s"', [URI]);
end;

function TServerDispatch.URLEncode(const URL: WideString): WideString;
begin
  Result := HTTPApp.HTTPEncode(URL);
end;

{ TWriteDispatch }

constructor TWriteDispatch.Create(Response: TWebResponse);
begin
  inherited Create(Self, False);
  FResponse := Response;
end;

destructor TWriteDispatch.Destroy;
begin
  inherited Destroy;
end;

function TWriteDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HRESULT;
type
  PVariantArray = ^TVariantArray;
  TVariantArray = array[0..65535] of Variant;
var
  Parms: PDispParams;
  I: Integer;
  TempResult: Variant;
begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if (Result = DISP_E_MEMBERNOTFOUND) and (DispID = 0) then
  begin
    Parms := @Params;
    try
      if Parms.cArgs > 0 then
        for I := Parms.cArgs - 1 downto 0 do { Parametreler tersten gelir. }
          Self.Write(PVariantArray(Parms.rgvarg)^[I]);

      if VarResult = nil then
        VarResult := @TempResult;
      POleVariant(VarResult)^ := '';

      Result := S_OK;

    except
      if ExcepInfo <> nil then
      begin
        FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);
        with TExcepInfo(ExcepInfo^) do
        begin
          bstrSource := StringToOleStr(ClassName);
          if ExceptObject is Exception then
            bstrDescription := StringToOleStr(Exception(ExceptObject).Message);
          scode := E_FAIL;
        end;
      end;
      Result := DISP_E_EXCEPTION;
    end;
  end;

end;

procedure TWriteDispatch.Write(const Variable: OleVariant);
var
  VarText: WideString;
begin
  VarText := '';
  case VarType(Variable) of
    varEmpty: VarText := 'Empty';
    varNull: VarText := 'Null';
    varDispatch: VarText := GetDefaultValue(Variable);
    varBoolean: VarText := SysUtils.LowerCase(Variable); // JScript true or false
    else VarText := Variable; // Any Type
  end;
  if Length(VarText) > 0 then
    Self.WriteText(VarText);
end;

procedure TWriteDispatch.WriteLn(const Variable: OleVariant);
begin
  Self.Write(Variable);
  Self.WriteText(sLineBreak);
end;

procedure TWriteDispatch.WriteText(const Text: WideString);
begin
  FResponse.Content := FResponse.Content + Text;
end;

{ TWriteLnDispatch }

function TWriteLnDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HRESULT;
begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if Result = S_OK then
    Self.WriteText(sLineBreak);

end;

{ TExploitDispatchScriptSite }

constructor TExploitScriptSite.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRequireFiles := TStringList.Create;
  Self.OnError := ScriptHandleError;
end;

destructor TExploitScriptSite.Destroy;
begin
  FRequireFiles.Free;
  inherited Destroy;
end;

procedure TExploitScriptSite.Eval(const Code: WideString);
begin
  Require(Code);
end;

function TExploitScriptSite.ExecuteFile(const FileName: WideString): WideString;
begin
  Result := ParseExploitFile(FileName);
  FCodeSource := Result;
  Execute(Result);
end;

procedure TExploitScriptSite.Initialize;
begin
  { Objects }
  FIExploit := TExploitDispatch.Create(Self) as IDispatch;
  FIServer := TServerDispatch.Create(Self, Request, Response) as IDispatch;
  FIResponse := TResponseDispatch.Create(Response) as IDispatch;
  FIRequest := TRequestDispatch.Create(Request) as IDispatch;
  { Procedures }
  FIWrite := TWriteDispatch.Create(Response) as IDispatch;
  FIWriteLn := TWriteLnDispatch.Create(Response) as IDispatch;
  FFormat := TFormatDispatch.Create as IDispatch;
  FRequire := TRequireDispatch.Create(Self) as IDispatch;
  FUse := TUseDispatch.Create(Self) as IDispatch;
  RegisterScriptObjects;
end;

function TExploitScriptSite.ParseExploitFile(
  const FileName: string): string;
var
  Parser: TScriptParser;
  M: TMemoryStream;
  Token: Word;

  procedure AddHtml(const Text: string);
  var
    Html: string;
  begin
    Html := StringReplace(Text, '\', '\\', [rfReplaceAll]);
    Html := StringReplace(Html, '"', '\"', [rfReplaceAll]);
    Html := StringReplace(Html, '''', '\''', [rfReplaceAll]);
    Html := StringReplace(Html, #13, '\r', [rfReplaceAll]);
    Html := StringReplace(Html, #10, '\n', [rfReplaceAll]);
    Result := Result + Format('Write("%s");'#13#10, [Html]);
  end;

  procedure ParseTokenHTML;
  var
    Html: string;
  begin
    Html := Parser.TokenString;
    AddHtml(Html);
  end;

  procedure ParseTokenScriptBegin;
  begin
    Result := Result + GetPureText(Parser);
  end;

  procedure ParseTokenEvaluate;
  begin
    Result := Result + Format('Write(%s);', [Trim(GetPureText(Parser))]);
  end;

  procedure ParseTokenDirective;
  begin
    GetPureText(Parser);
  end;

begin

  Result := '';

  M := TMemoryStream.Create;
  try
    VirtualDrive.SaveToStream(FileName, M);
    Parser := TScriptParser.Create(M);
    try
      while True do
      begin
        Token := Parser.NextToken;
        case Token of
          idEOF         : Break;
          idEvaluate    : ParseTokenEvaluate;
          idHtml        : ParseTokenHTML;
          idScriptBegin : ParseTokenScriptBegin;
          idDirective   : ParseTokenDirective;
        end;
      end;
    finally
      Parser.Free;
    end;
  finally
    M.Free;
  end;

end;

procedure TExploitScriptSite.RegisterScriptObjects;
begin
  { Objects }
  AddNamedItem('Exploit', FIExploit);
  AddNamedItem('Server', FIServer);
  AddNamedItem('Request', FIRequest);
  AddNamedItem('Response', FIResponse);
  AddNamedItem('Session', SessionGlobal);
  { Procedures }
  AddNamedItem('Write', FIWrite);
  AddNamedItem('WriteLn', FIWriteLn);
  AddNamedItem('Format', FFormat);
  { Directives }
  AddNamedItem('require', FRequire);
  AddNamedItem('use', FUse);
end;

function TExploitScriptSite.RequireFile(
  const FileName: WideString): WideString;
begin
  Result := '';
  if FRequireFiles.IndexOf(FileName) < 0 then
  begin
    FRequireFiles.Add(FileName);
    Result := ParseExploitFile(FileName);
    FCodeSource := FCodeSource + Result;
    Require(Result);
  end;
end;

procedure TExploitScriptSite.ScriptHandleError(Sender: TObject; Line,
  Pos: Integer; Source, Description: string);
var
  Text: string;
begin
  Text := System.Copy(FCodeSource, Line, 128); 
  raise Exception.CreateFmt(sExploitCompilerError, [Line, Pos, Description, Text]);
end;

{ TFormatDispatch }

constructor TFormatDispatch.Create;
begin
  inherited Create(Self, False);
end;

function TFormatDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HRESULT;
type
  PVariantArray = ^TVariantArray;
  TVariantArray = array[0..65535] of Variant;
var
  Parms: PDispParams;
  I, K, Count: Integer;
  A, TempResult: Variant;
  T: array of TVarRec;
  FormatText, TextResult: WideString;
  E: Extended;
  Settings: TFormatSettings;

  { MakeLangID }
  function MakeLangID(usPrimaryLanguage, usSubLanguage: ShortInt): Word;
  begin
    Result := (usSubLanguage shl 10) or usPrimaryLanguage;
  end;

  { MakeLCID }
  function MakeLCID(vLanguageID, vSortID: Word): DWORD;
  begin
    Result := (vSortID shl 16) or vLanguageID;
  end;

begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if (Result = DISP_E_MEMBERNOTFOUND) and (DispID = 0) then
  begin
    Parms := @Params;
    try

      TextResult := '';

      if Parms.cArgs > 1 then
      begin
        { Ilk parametre format bicimi. Ama dikkat, parametreler tersten gelir. }
        FormatText := PVariantArray(Parms.rgvarg)^[Parms.cArgs - 1];
        SetLength(T, Parms.cArgs - 1);
        Count := Parms.cArgs - 2;
        for I := 0 to Count do
        begin
          A := PVariantArray(Parms.rgvarg)^[I];
          K := Count - I;
          case TVarData(A).VType of
            varSmallInt:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VSmallInt;
              end;
            varInteger:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VInteger;
              end;
            varSingle:
              begin
                T[K].VType := vtExtended;
                E := TVarData(A).VSingle; { Extended tipine zorla }
                T[K].VExtended := @E;
              end;
            varDouble:
              begin
                T[K].VType := vtExtended;
                E := TVarData(A).VDouble; { Extended tipine zorla }
                T[K].VExtended := @E;
              end;
            varCurrency:
              begin
                T[K].VType := vtCurrency;
                T[K].VCurrency := @TVarData(A).VCurrency;
              end;
            varDate:
              begin
                T[K].VType := vtExtended;
                E := TVarData(A).VDate; { Extended tipine zorla }
                T[K].VExtended := @E;
              end;
            varOleStr:
              begin
                T[K].VType := vtWideString;
                T[K].VWideString := TVarData(A).VOleStr;
              end;
            varDispatch:
              begin
                T[K].VType := vtInterface;
                T[K].VInterface := TVarData(A).VDispatch;
              end;
            varBoolean:
              begin
                T[K].VType := vtBoolean;
                T[K].VBoolean := TVarData(A).VBoolean;
              end;
            varUnknown:
              begin
                T[K].VType := vtInterface;
                T[K].VInterface := TVarData(A).VUnknown;
              end;
            varShortInt:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VShortInt;
              end;
            varByte:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VByte;
              end;
            varWord:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VWord;
              end;
            varLongWord:
              begin
                T[K].VType := vtInteger;
                T[K].VInteger := TVarData(A).VLongWord;
              end;
            varInt64:
              begin
                T[K].VType := vtInt64;
                T[K].VInt64 := @TVarData(A).VInt64;
              end;
            { OLE tarafindan desteklenmiyor }
            { Unsupported by OLE }
            { Nicht unterstützte von OLE }
            {
            varString:
              begin
                T[K].VType := vtAnsiString;
                T[K].VAnsiString := TVarData(A[I]).VString;
              end;
            varError:    (VError: HRESULT);
            varAny:      (VAny: Pointer);
            varArray:    (VArray: PVarArray);
            varByRef:    (VPointer: Pointer);
            }
          end;
        end;
        try
          GetLocaleFormatSettings(
            MakeLCID(MakeLangID(LANG_ENGLISH, SUBLANG_DEFAULT), SORT_DEFAULT),
            Settings);
          TextResult := WideFormat(FormatText, T, Settings);
        finally
        end;
      end;

      if VarResult = nil then
        VarResult := @TempResult;
      POleVariant(VarResult)^ := TextResult;

      Result := S_OK;

    except
      if ExcepInfo <> nil then
      begin
        FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);
        with TExcepInfo(ExcepInfo^) do
        begin
          bstrSource := StringToOleStr(ClassName);
          if ExceptObject is Exception then
            bstrDescription := StringToOleStr(Exception(ExceptObject).Message);
          scode := E_FAIL;
        end;
      end;
      Result := DISP_E_EXCEPTION;
    end;
  end;

end;

function TExploitScriptSite.TransferFile(
  const FileName: WideString): WideString;
begin
  Result := ParseExploitFile(FileName);
  Transfer(Result);
end;

{ TRequireDispatch }

constructor TRequireDispatch.Create(ScriptSite: TExploitScriptSite);
begin
  inherited Create(Self, False);
  FScriptSite := ScriptSite;
end;

function TRequireDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HRESULT;
type
  PVariantArray = ^TVariantArray;
  TVariantArray = array[0..65535] of Variant;
var
  Parms: PDispParams;
  TempResult: Variant;
  I: Integer;
  FileName: WideString;
begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if (Result = DISP_E_MEMBERNOTFOUND) and (DispID = 0) then
  begin
    Parms := @Params;
    try

      if Parms.cArgs > 0 then
        for I := Parms.cArgs - 1 downto 0 do
        begin
          FileName := PVariantArray(Parms.rgvarg)^[I];
          if not FileExists(FileName) then
            FileName := FScriptSite.Request.TranslateURI(FileName);
          FScriptSite.RequireFile(FileName);
        end;

      if VarResult = nil then
        VarResult := @TempResult;
      POleVariant(VarResult)^ := '';

      Result := S_OK;

    except
      if ExcepInfo <> nil then
      begin
        FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);
        with TExcepInfo(ExcepInfo^) do
        begin
          bstrSource := StringToOleStr(ClassName);
          if ExceptObject is Exception then
            bstrDescription := StringToOleStr(Exception(ExceptObject).Message);
          scode := E_FAIL;
        end;
      end;
      Result := DISP_E_EXCEPTION;
    end;
  end;
end;

function TExploitScriptSite.UseFile(
  const FileName: WideString): WideString;
begin
  Result := ParseExploitFile(FileName);
  FCodeSource := FCodeSource + Result;
  Use(Result);
end;

{ TUseDispatch }

constructor TUseDispatch.Create(ScriptSite: TExploitScriptSite);
begin
  inherited Create(Self, False);
  FScriptSite := ScriptSite;
end;

function TUseDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HRESULT;
type
  PVariantArray = ^TVariantArray;
  TVariantArray = array[0..65535] of Variant;
var
  Parms: PDispParams;
  TempResult: Variant;
  I: Integer;
  FileName: WideString;
begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if (Result = DISP_E_MEMBERNOTFOUND) and (DispID = 0) then
  begin
    Parms := @Params;
    try

      if Parms.cArgs > 0 then
        for I := Parms.cArgs - 1 downto 0 do
        begin
          FileName := PVariantArray(Parms.rgvarg)^[I];
          if not FileExists(FileName) then
            FileName := FScriptSite.Request.TranslateURI(FileName);
          FScriptSite.UseFile(FileName);
        end;

      if VarResult = nil then
        VarResult := @TempResult;
      POleVariant(VarResult)^ := '';

      Result := S_OK;

    except
      if ExcepInfo <> nil then
      begin
        FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);
        with TExcepInfo(ExcepInfo^) do
        begin
          bstrSource := StringToOleStr(ClassName);
          if ExceptObject is Exception then
            bstrDescription := StringToOleStr(Exception(ExceptObject).Message);
          scode := E_FAIL;
        end;
      end;
      Result := DISP_E_EXCEPTION;
    end;
  end;
end;

{ TSessionDispatch }

constructor TSessionDispatch.Create;
begin
  inherited Create(ComServer.TypeLib, ISession);
  { Aslina bir Variant List yazmak gerekirdi ama,
    IDictionary kullanmak daha kolayima geldi. }
  FContents := CreateOleObject('Scripting.Dictionary') as IDictionary;
end;

function TSessionDispatch.Get_Contents: OleVariant;
begin
  Result := FContents;
end;

function TSessionDispatch.Get_SessionID: WideString;
begin
  Result := 'EXPLOITID1234'; { One Session only }
end;

function TSessionDispatch.Get_Value(const bstrKey: WideString): OleVariant;
var
  VarKey: OleVariant;
begin
  VarKey := bstrKey;
  if FContents.Exists(VarKey) then
    Result := FContents.Get_Item(VarKey)
  else Result := Unassigned; { or Null ? }
end;

procedure TSessionDispatch.Set_Value(const bstrKey: WideString;
  Value: OleVariant);
var
  VarKey: OleVariant;
  VarValue: OleVariant;
begin
  VarKey := bstrKey;
  VarValue := Value;
  if FContents.Exists(VarKey) then FContents.Remove(VarKey);
    { FValues.Set_Item(VarKey, VarValue); } { Member not found exception }
  FContents.Add(VarKey, VarValue);
end;

{ TRequestDictionary }

procedure TRequestDictionary.Add(varKey, varItem: OleVariant);
begin
  FValues.Add(varKey, varItem);
end;

constructor TRequestDictionary.Create;
begin
  inherited Create(ComServer.TypeLib, IRequestDictionary);
  FValues := CreateOleObject('Scripting.Dictionary') as IDictionary;
end;

function TRequestDictionary.Exists(varKey: OleVariant): WordBool;
begin
  Result := FValues.Exists(varKey);
end;

function TRequestDictionary.Get_Count: Integer;
begin
  Result := FValues.Count;
end;

function TRequestDictionary.Get_Item(Param: OleVariant): OleVariant;
begin
  if FValues.Exists(Param) then
    Result := FValues.Get_Item(Param)
  else
    Result := TRequestDictionary.Create as IRequestDictionary; { Empty Dictionary }
end;

function TRequestDictionary.Get_Key(VarKey: OleVariant): OleVariant;
begin
  Result := FValues.Get_Item(VarKey); { Duzletilmesi gerekiyor. }
end;

function TRequestDictionary.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var
  TempResult: Variant;
begin

  Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params,
    VarResult, ExcepInfo, ArgErr);

  if (Result = DISP_E_BADPARAMCOUNT) and (DispID = 0) then
  begin
    try
      if VarResult = nil then
        VarResult := @TempResult;
      POleVariant(VarResult)^ := Self.ValuesToString; { ToString }
      Result := S_OK;
    except
      if ExcepInfo <> nil then
      begin
        FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);
        with TExcepInfo(ExcepInfo^) do
        begin
          bstrSource := StringToOleStr(ClassName);
          if ExceptObject is Exception then
            bstrDescription := StringToOleStr(Exception(ExceptObject).Message);
          scode := E_FAIL;
        end;
      end;
      Result := DISP_E_EXCEPTION;
    end;
  end;

end;

function TRequestDictionary.ValuesToString: OleVariant;
var
  I, J: Integer;
  A, Items: OleVariant;
  Keys: OleVariant;
begin
  Result := '';
  Items := FValues.Items;
  Keys := FValues.Keys;
  for I := 0 to FValues.Count - 1 do
  begin
    A := Items[I];
    if VarType(A) = varDispatch then { IRequestDictionary }
    begin
      for J := 0 to A.Count - 1 do
      begin
        Result := Result + Keys[I] + '=' + A.Item[J + 1];
        if J < A.Count - 1 then Result := Result + '&';
      end;
    end
    else if VarType(A) = varOleStr then Result := Result + A; { WideString }
    if I < FValues.Count - 1 then Result := Result + '&';
  end;
end;

{ TRequestDispatch }

constructor TRequestDispatch.Create(Request: TWebRequest);
begin
  inherited Create(ComServer.TypeLib, IRequest);
  FWebRequest := Request;
  FForm := TRequestDictionary.Create;
  InitializeForm;
  FQueryString := TRequestDictionary.Create;
  InitializeQueryString;
  FCookies := TRequestDictionary.Create;
  InitializeCookies;
  FServerVariables := TRequestDictionary.Create;
  InitializeServerVariables;
end;

function TRequestDispatch.Get_Cookies: IRequestDictionary;
begin
  Result := FCookies;
end;

function TRequestDispatch.Get_Form: IRequestDictionary;
begin
  Result := FForm;
end;

function TRequestDispatch.Get_Item(const bstrVar: WideString): OleVariant;
begin
  if FQueryString.Exists(bstrvar) then
    Result := FQueryString.Item[bstrVar]
  else if FForm.Exists(bstrvar) then
    Result := FForm.Item[bstrVar]
  else if FCookies.Exists(bstrvar) then
    Result := FCookies.Item[bstrVar]
  else if FServerVariables.Exists(bstrvar) then
    Result := FServerVariables.Item[bstrVar]
  else
    Result := TRequestDictionary.Create as IRequestDictionary; { Empty Dictionary }
end;

function TRequestDispatch.Get_QueryString: IRequestDictionary;
begin
  Result := FQueryString;
end;

function TRequestDispatch.Get_ServerVariables: IRequestDictionary;
begin
  Result := FServerVariables;
end;

procedure TRequestDispatch.InitializeCookies;
var
  Key, Value, Text, Index: OleVariant;
  I: Integer;
begin
  with FWebRequest do
    for I := 0 to CookieFields.Count - 1 do
    begin
      Key := CookieFields.Names[I];
      Text := CookieFields.ValueFromIndex[I];
      if FForm.Exists(Key) then
      begin
        Value := FForm.Item[Key];
        Index := Value.Count;
        Index := Index + 1;
        Value.Add(Index, Text);
      end
      else begin
        Value := TRequestDictionary.Create as IRequestDictionary;
        Index := 1;
        Value.Add(Index, Text);
        FForm.Add(Key, Value);
      end;
    end;
end;

procedure TRequestDispatch.InitializeForm;
var
  Key, Value, Text, Index: OleVariant;
  I: Integer;
begin
  with FWebRequest do
    for I := 0 to ContentFields.Count - 1 do
    begin
      Key := ContentFields.Names[I];
      Text := ContentFields.ValueFromIndex[I];
      if FForm.Exists(Key) then
      begin
        Value := FForm.Item[Key];
        Index := Value.Count;
        Index := Index + 1;
        Value.Add(Index, Text);
      end
      else begin
        Value := TRequestDictionary.Create as IRequestDictionary;
        Index := 1;
        Value.Add(Index, Text);
        FForm.Add(Key, Value);
      end;
    end;
end;

procedure TRequestDispatch.InitializeQueryString;
var
  Key, Value, Text, Index: OleVariant;
  I: Integer;
begin
  with FWebRequest do
    for I := 0 to QueryFields.Count - 1 do
    begin
      Key := QueryFields.Names[I];
      Text := QueryFields.ValueFromIndex[I];
      if FQueryString.Exists(Key) then
      begin
        Value := FQueryString.Item[Key];
        Index := Value.Count;
        Index := Index + 1;
        Value.Add(Index, Text);
      end
      else begin
        Value := TRequestDictionary.Create as IRequestDictionary;
        Index := 1;
        Value.Add(Index, Text);
        FQueryString.Add(Key, Value);
      end;
    end;
end;

procedure TRequestDispatch.InitializeServerVariables;
var
  Key, Text: OleVariant;
  KeyStr, ValueStr: string;
  I: Integer;
begin
  with FWebRequest do
    for I := 0 to MAX_VARIABLE - 1 do
    begin
      Key := ServerVariables[I];
      KeyStr := Key;
      ValueStr := GetFieldByName(KeyStr);
      Text := ValueStr;
      FServerVariables.Add(Key, Text);
    end;
end;

{ TPhysicalDrive }

constructor TPhysicalDrive.Create(const ARoot: string);
begin
  inherited Create(ARoot);
end;

destructor TPhysicalDrive.Destroy;
begin
  inherited Destroy;
end;

function TPhysicalDrive.FileExists(const FileName: string): Boolean;
begin
  Result := SysUtils.FileExists(UnixPathToDosPath(Root + FileName));
end;

procedure TPhysicalDrive.SaveToStream(const FileName: string; Stream: TStream);
var
  M: TMemoryStream;
begin
  if Self.FileExists(FileName) then
  begin
    M := TMemoryStream.Create;
    try
      M.LoadFromFile(UnixPathToDosPath(Root + FileName));
      M.SaveToStream(Stream);
    finally
      M.Free;
    end;
  end;
end;

{ TArchiveDrive }

constructor TArchiveDrive.Create(const ArchiveFile, ARoot: string);
begin
  inherited Create(ARoot);
  FArchive := TArchive.Create;
  FArchive.LoadFromFile(ArchiveFile);
end;

destructor TArchiveDrive.Destroy;
begin
  FArchive.Free;
  inherited Destroy;
end;

function TArchiveDrive.FileExists(const FileName: string): Boolean;
begin
  Result := FArchive.FileExists(Root + FileName);
end;

procedure TArchiveDrive.SaveToStream(const FileName: string;
  Stream: TStream);
var
  Item: TArchiveItem;
begin
  if Self.FileExists(FileName) then
  begin
    Item := FArchive.Names[Root + FileName];
    Stream.CopyFrom(Item.Memory, 0);
  end;
end;

{ TVirtualDrive }

constructor TVirtualDrive.Create(const ARoot: string);
begin
  inherited Create;
  FRoot := ARoot;
end;

{ TResourceArchiveDrive }

constructor TResourceArchiveDrive.Create(AInstance: THandle;
  const AResourceName: string; AResourceType: PChar; const ARoot: string);
begin
  inherited Create(ARoot);
  FArchive := TArchive.Create;
  FArchive.LoadFromResource(AResourceName, AResourceType);
end;

destructor TResourceArchiveDrive.Destroy;
begin
  FArchive.Free;
  inherited Destroy;
end;

function TResourceArchiveDrive.FileExists(const FileName: string): Boolean;
begin
  Result := FArchive.FileExists(Root + FileName);
end;

procedure TResourceArchiveDrive.SaveToStream(const FileName: string;
  Stream: TStream);
var
  Item: TArchiveItem;
begin
  if Self.FileExists(FileName) then
  begin
    Item := FArchive.Names[Root + FileName];
    Stream.CopyFrom(Item.Memory, 0);
  end;
end;

end.