unit U_HintW;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Registry, ShellAPI, FastStrings, Dialogs, StdCtrls, OleCtrls, SHDocVw, ucCustomizedWebBrowser, ActiveX,
  IdCoderMIME, Menus, ExtCtrls;

type

  TVariantArray = array of Variant;

  TCustomizedWebBrowser = class(ucCustomizedWebBrowser.TCustomizedWebBrowser)
  protected
    procedure InvokeEvent(DispID: TDispID; var Params: TDispParams); override;
  end;

  TF_HintW = class(TForm)
    WebBrowser: TCustomizedWebBrowser;
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    Panel1: TPanel;
    CustomizedWebBrowser1: TCustomizedWebBrowser;
    procedure WebBrowserBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowserEnter(Sender: TObject);
    function WebBrowserPressAccelerator(Sender: TObject;
      const lpMsg: tagMSG): Boolean;
    procedure WebBrowserDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowserNavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowserMenuPopup(Sender: TObject; X, Y: Integer;
      ID: Cardinal);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  protected
    FBNext: String;
    FBBack: String;
    FBFirst: String;
    FTplPath: String;
    FMainForm: TForm;
    procedure AssignEmptyDocument;
    procedure Go(Url: string);
    procedure GoStat(Url: string);
    procedure HideHints;
    function LoadFromStream(const AStream: TStream): HRESULT;
    function LoadFromStrings(const AStrings: TStrings): HRESULT;
    function LoadFromString(const S: string): HRESULT;
    function LoadFromFile(const FileName: string): HRESULT;
    procedure LoadNavButton(var aBtCode: String; const aTplDir, aTpl, aDefText: String);
    procedure StepWizard(aDirection: Integer);
  public
    FCurrStep: Integer;
    FStepCount: Integer;
    function GetPathTpl(aRelative: Boolean=false): String;
    procedure FirstWizard;
    procedure NextWizard;
    procedure BackWizard;
    procedure StartWizard;
  end;

  procedure CheckAndShowHint(aUrl: string; aProgIdent: string; aMainForm: TForm = nil; DaysCheck: integer = 7; CheckNeedOpen: boolean = True);

  procedure SendStat(aUrlStat, aProgIdent, prog_full_ver_str, prog_ver, build_or_date, req_code, answ_code: string; is_trial, is_flash: boolean);

const
  RegRootKey = HKEY_CURRENT_USER;

var
  F_HintW: TF_HintW;
  WasNavError: boolean;
  Reg: TRegistry = nil;
  NumTime: integer;

implementation

uses IdCoder;

{$R *.dfm}


{ TF_HintW }

procedure SendStat(aUrlStat, aProgIdent, prog_full_ver_str, prog_ver, build_or_date, req_code, answ_code: string; is_trial, is_flash: boolean);
var
  aFullURL: string;
  IdEncoderMIME: TIdEncoderMIME;
begin
  if assigned(F_HintW) then
    FreeAndNil(F_HintW);
  if Not assigned(F_HintW) then
    Application.CreateForm(TF_HintW, F_HintW);

  try
    IdEncoderMIME := TIdEncoderMIME.Create(nil);
    aFullURL := aUrlStat + '?ProgIdent=' + IdEncoderMIME.EncodeString(aProgIdent);
    aFullURL := aFullURL + '&prog_full_ver_str=' + IdEncoderMIME.EncodeString(prog_full_ver_str);
    aFullURL := aFullURL + '&prog_ver=' + IdEncoderMIME.EncodeString(prog_ver);
    aFullURL := aFullURL + '&build_or_date=' + IdEncoderMIME.EncodeString(build_or_date);
    aFullURL := aFullURL + '&req_code=' + IdEncoderMIME.EncodeString(req_code);
    aFullURL := aFullURL + '&answ_code=' + IdEncoderMIME.EncodeString(answ_code);
    aFullURL := aFullURL + '&is_trial=' + IdEncoderMIME.EncodeString(inttostr(byte(is_trial)));
    aFullURL := aFullURL + '&is_flash=' + IdEncoderMIME.EncodeString(inttostr(byte(is_flash)));
  finally
    IdEncoderMIME.Free;
  end;
  F_HintW.GoStat(aFullURL);
end;

procedure CheckAndShowHint(aUrl: string; aProgIdent: string; aMainForm: TForm = nil; DaysCheck: integer = 7; CheckNeedOpen: boolean = True);
var
  LastDate: integer;
  NeedOpen: boolean;
  vRefresh : OleVariant;
begin
  NumTime := 0;
  if Not Assigned(Reg) then
    Reg := TRegistry.Create;
  Reg.RootKey := RegRootKey;
  if (DaysCheck > 0) and CheckNeedOpen then
  begin
    try
      if Reg.OpenKey('\Software\Expertsoft\Hints\' + aProgIdent, True) then
      begin
        if Reg.ValueExists('DontShow') then
        begin
          if Reg.ReadBool('DontShow') then
          begin
            Reg.CloseKey;
            exit;
          end;
        end;
      end;
    except
    end;
  end;

  NeedOpen := True;
  if CheckNeedOpen then
  begin
    NeedOpen := False;
    LastDate := 0;
    if Reg.OpenKey('\Software\Expertsoft\Hints\' + aProgIdent, True) then
    begin
      try
        if Reg.ValueExists('Date') then
        begin
          LastDate := Reg.ReadInteger('Date');
        end;
      except
        LastDate := 0;
      end;
    end;
    if Now - LastDate >= DaysCheck then
      NeedOpen := True
  end;
  if NeedOpen then
  begin
    if assigned(F_HintW) then
    begin
      if F_HintW.Caption = aUrl then
        FreeAndNil(F_HintW);
    end;

    if Not assigned(F_HintW) then
      Application.CreateForm(TF_HintW, F_HintW);

    F_HintW.FMainForm := aMainForm;
    //if F_HintW.Caption = '' then
    begin
      F_HintW.Caption := aUrl;
      F_HintW.CustomizedWebBrowser1.Visible := False;
      F_HintW.CustomizedWebBrowser1.Height := 1;
      F_HintW.CustomizedWebBrowser1.Width := 1;
      F_HintW.CustomizedWebBrowser1.left := -1;
      F_HintW.CustomizedWebBrowser1.top := -1;
      if F_HintW.FMainForm <> nil then
      begin
        F_HintW.Left := aMainForm.Left + aMainForm.Width - F_HintW.Width - (GetSystemMetrics(SM_CXBORDER) + 2);
        F_HintW.Top := aMainForm.Top + aMainForm.Height - F_HintW.Height - (GetSystemMetrics(SM_CXBORDER) + 2);
       end;
      //F_HintW.WebBrowser.Navigate(aUrl);
      //F_HintW.WebBrowser.Stop;  тормозит
      F_HintW.Go(aUrl);
      //F_HintW.Show;
    end;  
  end;
end;

procedure TCustomizedWebBrowser.InvokeEvent(DispID: TDispID;
  var Params: TDispParams);
const
  DISPID_NAVIGATEERROR = 271;
  INET_E_RESOURCE_NOT_FOUND = -2146697211;
var
  Code: Integer;
  ParamCount, I: Integer;
  VarArray: TVariantArray;
begin
  inherited;
  if DispID = DISPID_NAVIGATEERROR then
  begin
    ParamCount := Params.cArgs;
    SetLength(VarArray, ParamCount);
    for I := Low(VarArray) to High(VarArray) do
      VarArray[High(VarArray) - I] := OleVariant(Params.rgvarg^[I]);
    { StatusCode }
    Code := VarArray[3];
    if (Code = INET_E_RESOURCE_NOT_FOUND) or  (Code = 404) then
    begin
      //ShowMessage('Not found!');
      WasNavError := True;
    end;
  end;
end;


procedure TF_HintW.AssignEmptyDocument;
begin
  Go('about:blank');
end;

procedure TF_HintW.BackWizard;
begin
  StepWizard(-1);
end;

procedure TF_HintW.Go(Url: string);
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  WasNavError := False;
  Flags := 0;
  TargetFrameName := 0;
  Postdata := 0;
  Headers := 0;
  if (Trim(Url) <> '') then
    WebBrowser.Navigate(Url, Flags, TargetFrameName, PostData, Headers);
end;

procedure TF_HintW.GoStat(Url: string);
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  WasNavError := False;
  Flags := 0;
  TargetFrameName := 0;
  Postdata := 0;
  Headers := 0;
  if (Trim(Url) <> '') then
    CustomizedWebBrowser1.Navigate(Url, Flags, TargetFrameName, PostData, Headers);
end;

procedure TF_HintW.HideHints;
begin
//
end;

function TF_HintW.LoadFromFile(const FileName: string): HRESULT;
var
   Stream: TStream;
begin
   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
   try
      Result := LoadFromStream(Stream);
   finally
      Stream.Free;
   end;
end;


function TF_HintW.LoadFromStream(const AStream: TStream): HRESULT;
begin
  if not Assigned(WebBrowser.Document) then
      AssignEmptyDocument;
   AStream.seek(0, 0);
   Result := (WebBrowser.Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
end;

function TF_HintW.LoadFromStrings(const AStrings: TStrings): HRESULT;
var
   M: TMemoryStream;
begin
   if not Assigned(WebBrowser.document) then
      AssignEmptyDocument;
   M := TMemoryStream.Create;
   try
      AStrings.SaveToStream(M);
      Result := LoadFromStream(M);
   except
      Result := S_False;
   end;
   M.free;
end;

function TF_HintW.LoadFromString(const S: string): HRESULT;
var
   Strings: TStringList;
begin
   Strings := TStringList.Create;
   try
      Strings.Text := S;
      Result := LoadFromStrings(Strings);
   finally
      FreeAndNil(Strings);
   end;
end;

function TF_HintW.GetPathTpl(aRelative: Boolean=false): String;
begin
  Result := '\HintBox\';
end;

procedure TF_HintW.FirstWizard;
begin
  StepWizard(1-FCurrStep);
end;

procedure TF_HintW.NextWizard;
begin
  StepWizard(1);
end;

procedure TF_HintW.StartWizard;
begin
end;

procedure TF_HintW.StepWizard(aDirection: Integer);
begin
//  LoadFromString(tplBegin + Tpl +TplNav + tplEnd);
end;

function SplitString(const AStr, ASeparator: string; AIncludeEmptySections: Boolean): TStringList;
var
  i: Integer;
  LenStr: Integer;
  BuffStr: String;
  SepLookIdx: Integer;
  SepBuff: String;
  IsFullSep: Boolean;
begin
  Result := TStringList.Create;
  BuffStr := '';
  LenStr := Length(AStr);
  SepLookIdx := 1;
  SepBuff := '';

  for i := 1 to LenStr do
  begin
    IsFullSep := false;
    if AStr[i] = ASeparator[SepLookIdx] then
    begin
      if SepLookIdx = Length(ASeparator) then
      begin
        IsFullSep := true;
        SepLookIdx := 1;
        SepBuff := '';
      end
      else
      begin
        SepBuff := SepBuff + AStr[i];
        Inc(SepLookIdx);
        Continue; //// CONTINUE ////
      end;
    end
    else
    begin
      // Сброс буФера сплитера
      if SepLookIdx > 1 then
      begin
        BuffStr := BuffStr + SepBuff;
        SepLookIdx := 1;
        SepBuff := '';
      end;
    end;

    if Not IsFullSep then
      BuffStr := BuffStr + AStr[i];
    if IsFullSep or (i=LenStr) then
      if (BuffStr <> '') or AIncludeEmptySections then
      begin
        Result.Add(BuffStr);
        BuffStr := '';

        // если последний символ - разделитель, то добавляем пустую строку
        if AIncludeEmptySections then
          if IsFullSep and (i=LenStr) then
            Result.Add('');
      end;
  end;
end;


procedure TF_HintW.WebBrowserBeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  PosAbout: Integer;
  UrlParts: TStringList;
  UrlCmd: String;
  ovElem: OleVariant;
  Str: String;

  //SprComponentType: TNBComponentType;
  FileName: String;

  function DefineWorkList: Boolean;
  begin
    Result := true;
  end;

begin
  if (URL <> 'about:blank') then
  begin
    URL := FastReplace(URL, 'about:blank', 'about:', false);
    PosAbout := Pos('about:shell:', URL);
    if PosAbout = 1 then
    begin
      URL := FastReplace(URL, 'about:shell:', 'about:', false);
      UrlParts := SplitString(Copy(URL, Length('about:')+1, Length(URL)-(Length('about:'))), #255, false);
      if UrlParts.Count > 0 then
      begin
        UrlCmd := UrlParts[0];
        ShellExecute(Handle, 'open', PChar(UrlCmd), nil, nil, SW_MAXIMIZE);
      end;
      Cancel := true;
    end
    else
    begin
      PosAbout := Pos('about:', URL);
      if PosAbout = 1 then
      begin
        UrlParts := SplitString(Copy(URL, Length('about:')+1, Length(URL)-(Length('about:'))), '_', false);
        if UrlParts.Count > 0 then
        begin
          UrlCmd := UrlParts[0];
          if UrlCmd = 'actClose' then
          begin
            Close;
          end
          else if UrlCmd = 'actToolTip' then
          begin
            if UrlParts.Count > 1 then
            begin
              ovElem := WebBrowser.OleObject.document.getElementbyId('ttContent'+UrlParts[1]); 
              if ovElem.tagName = 'SPAN' then
              begin
                Str := ovElem.InnerHTML;
                Str := FastReplace(Str, 'about:blank', 'about:', false);
              end
              else
              if ovElem.tagName = 'IMG' then
              begin
                FileName := ovElem.href;
                FileName := FastReplace(FileName, 'about:blank', 'about:', false);
                FileName := Copy(FileName, Length('about:')+1, Length(URL)-(Length('about:')));
                try
                except
                end;
              end;
            end;
          end
          else
          if UrlCmd = 'actNewProj' then
          begin
            //FSCS_Main.aNew.Execute
          end;
        end;
        Cancel := true;
      end;
    end;  
  end;
end;

procedure TF_HintW.WebBrowserEnter(Sender: TObject);
begin
//  HideHints;
end;

function TF_HintW.WebBrowserPressAccelerator(Sender: TObject;
  const lpMsg: tagMSG): Boolean;
begin
  //
end;

procedure TF_HintW.LoadNavButton(var aBtCode: String; const aTplDir, aTpl, aDefText: String);
var
  btPath: String;
begin
  if aBtCode = '' then
  begin
    btPath := aTplDir + aTpl;
    //if FileExists(btPath) then
    //  aBtCode := GetFileContents(btPath)
    //else
    //  aBTCode := aDefText;
  end;
end;

procedure TF_HintW.WebBrowserDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  str1: string;
begin
  if WasNavError then
  begin
    Close;
    exit;
  end;
  str1 := WebBrowser.OleObject.Document.All.Tags('title').Item(0).InnerHtml;
  if pos('HTTP 404', str1) <= 0 then
    Show
  else
    exit;

  Timer1.Enabled := True;

  try
    if Reg.CurrentPath <> '' then
    begin
      try
        Reg.WriteInteger('Date', Trunc(Now));
      except
      end;
    end;
  except
  end;
end;

procedure Explode(var a: array of string; Border, S: string; MaxLen: integer);
var
  S2: string;
  i: Integer;
begin
  i  := 0;
  S2 := S + Border;
  repeat
    a[i] := Copy(S2, 0,Pos(Border, S2) - 1);
    Delete(S2, 1,Length(a[i] + Border));
    Inc(i);
    if i > MaxLen then
      break;
  until S2 = '';
end;

procedure TF_HintW.WebBrowserNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  str1: string;
  i: integer;
  A: array of String;
begin
  F_HintW.WebBrowser.Ctl3D := False;
  F_HintW.webbrowser.Left := - (GetSystemMetrics(SM_CXBORDER) + 1);
  F_HintW.webbrowser.Top := - (GetSystemMetrics(SM_CYBORDER) + 1);
  F_HintW.webbrowser.Height := F_HintW.Height + (GetSystemMetrics(SM_CYBORDER) + 1) * 2;
  F_HintW.webbrowser.Width := F_HintW.Width + (GetSystemMetrics(SM_CXBORDER) + 1) * 2;

  if not WasNavError then
  begin
    try
      str1 := WebBrowser.OleObject.Document.Title;
      SetLength(A, 3);
      Explode(A, '_', str1, 3);
      F_HintW.Width := strtoint(A[1]);
      F_HintW.Height := strtoint(A[2]);
      if F_HintW.FMainForm <> nil then
      begin
        F_HintW.Left := FMainForm.Left + FMainForm.Width - F_HintW.Width - (GetSystemMetrics(SM_CXBORDER) + 2);
        F_HintW.Top := FMainForm.Top + FMainForm.Height - F_HintW.Height - (GetSystemMetrics(SM_CXBORDER) + 2);
      end;
      F_HintW.webbrowser.Left := - (GetSystemMetrics(SM_CXBORDER) + 1);
      F_HintW.webbrowser.Top := - (GetSystemMetrics(SM_CYBORDER) + 1);
      F_HintW.webbrowser.Height := F_HintW.Height + (GetSystemMetrics(SM_CYBORDER) + 1) * 2;
      F_HintW.webbrowser.Width := F_HintW.Width + (GetSystemMetrics(SM_CXBORDER) + 1) * 2;
    except
    end;
    Show;

  end;  
end;

procedure TF_HintW.WebBrowserMenuPopup(Sender: TObject; X, Y: Integer;
  ID: Cardinal);
begin
  //
end;

procedure TF_HintW.Timer1Timer(Sender: TObject);
begin
  NumTime := NumTime + 1;
  F_HintW.Show;
  if NumTime > 5 then
    Timer1.Enabled := False;
end;

procedure TF_HintW.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Timer1.Enabled then
    CanClose := False;
end;

end.