unit swfForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw;

type
  TfrmSwf = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Navigate(const fileName:WideString);
  end;

var
  frmSwf: TfrmSwf;

implementation

uses Registry;

{$R *.dfm}

function HtmlEncodeW(const ASrc:WideString):AnsiString;
var
  i: Integer;
begin
  Result := '';    {Do not Localize}
  for i := 1 to Length(ASrc) do
  begin
    if (ASrc[i]>='A') and (ASrc[i]<='Z') or (ASrc[i]>='a') and (ASrc[i]<='z') or (ASrc[i]>='0') and (ASrc[i]<='9') then
      Result := Result + AnsiChar(ASrc[i])
    else
      Result := Result + AnsiString('&#'+IntToStr(Ord(ASrc[i]))+';');
  end;
end;

// https://msdn.microsoft.com/en-us/library/ee330730(v=vs.85).aspx#browser_emulation

procedure SetBROWSER_EMULATION(ver:integer);
var
  r:TRegistry;
begin
  r := TRegistry.Create;
  try
    if r.OpenKey('Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION',true) then
    begin
      if ver <> 0 then
         r.WriteInteger(ExtractFileName(ParamStr(0)),ver)
      else
         r.DeleteValue(ExtractFileName(ParamStr(0)));
    end;
  finally
    r.Free;
  end;
end;

function ReadStringDef(r: TRegistry; const sName, sDef: string): string;
begin
  try
    if r.ValueExists(sName) then
       Result := r.ReadString(sName)
    else
       Result := sDef;
  except
      Result := sDef;
  end;
end;

function ParseVer(const s:string):integer;
var
  i:integer;
begin
  Result := 0;
  i := pos('.',s);
  if i > 0 then
     TryStrToInt(copy(s,1,i),Result)
end;

function GetInternetExplorerMajorVersion:integer;
var
  r : TRegistry;
begin
  Result := 0;
  r := TRegistry.Create;
  try
    r.RootKey := HKEY_LOCAL_MACHINE;
    if r.OpenKeyReadOnly('Software\Microsoft\Internet Explorer') then
    begin
      Result := ParseVer(ReadStringDef(r,'svcVersion',''));
      if Result = 0 then
         Result := ParseVer(ReadStringDef(r,'Version',''));
    end;
  finally
    r.Free;
  end;
end;

//  Version7 = 7000,
//  Version8 = 8000,
//  Version8Standards = 8888,
//  Version9 = 9000,
//  Version9Standards = 9999,
//  Version10 = 10000,
//  Version10Standards = 10001,
//  Version11 = 11000,
//  Version11Edge = 11001

procedure SetBrowserEmulationMode;
var
  iIEVer, ver :integer;
begin
  iIEVer := GetInternetExplorerMajorVersion;
  case iIEVer of
    7: ver := 7000;
    8: ver := 8888;
    9: ver := 9999;
    10: ver := 10001;
    11: ver := 11001;
    else
      ver := 0;
  end;
  SetBROWSER_EMULATION(ver);
end;

// wide string routines

function RawStringReplace(const S, OldPattern, NewPattern: AnsiString): AnsiString;
var
  SearchStr, NewStr: AnsiString;
  Offset: Integer;
begin
  SearchStr := S;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := Pos(OldPattern, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    SearchStr := Copy(SearchStr, Offset + Length(OldPattern), MaxInt);
  end;
end;

{ TfrmSwf }

procedure TfrmSwf.FormCreate(Sender: TObject);
begin
  SetBrowserEmulationMode;
end;

procedure TfrmSwf.Navigate(const fileName: WideString);
var
  fh:THandle;
  fs:TFileStream;
  sScript:AnsiString;
  sHtmlFileName:WideString;
  dwWritten:DWORD;
begin
  Caption := fileName;
  fs := TFileStream.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+'script.html',fmOpenRead);
  try
    SetLength(sScript,fs.Size);
    fs.Read(PAnsiChar(sScript)^,fs.Size);
  finally
    fs.Free;
  end;
  sScript := RawStringReplace(sScript,'%%SWF_URL%%',HtmlEncodeW(fileName+'.swf'));
  sScript := RawStringReplace(sScript,'%%HTML_URL%%',HtmlEncodeW(fileName+'.xml'));
  sScript := RawStringReplace(sScript,'%%HTML5VIEWER_URL%%',HtmlEncodeW('docviewer.html'));

  sHtmlFileName := fileName+WideString('.html');
  fh := CreateFileW(PWideChar(sHtmlFileName), GENERIC_WRITE, 0,
                      nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if fh = INVALID_HANDLE_VALUE then
     RaiseLastOSError;
  try
    WriteFile(fh,PAnsiChar(sScript)^,Length(sScript),dwWritten, nil );
  finally
    CloseHandle(fh)
  end;

  WebBrowser1.Navigate('file://'+sHtmlFileName);
end;

end.
