Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.09.2011, 13:48   #1
Persej
Новичок
Джуниор
 
Регистрация: 19.09.2011
Сообщений: 1
По умолчанию Запуск программы при нажатии на ссылку html-документе в TWebBrowser

Создаю презентацию компании на CD.
В ней будет раздел: каталог оборудования, который выводится в TWebBrowser, в нем загружается страница HTML со списком оборудования. Нужно сделать запуск внешней программы (MHTView.exe) с нужным файлом описания при нажатии на строку списка.
Искал на всех форумах, из всего получился такой код:

Код:
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ShellAPI, ActiveX, MSHTML;
 
type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
//    procedure WebBrowser1StatusTextChange(Sender: TObject;
//      const Text: WideString);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
   Headers: OleVariant; var Cancel: WordBool);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  NewURL:String;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('C:\Documents and Settings\Tem\Desktop\Proej\Nazhatie\DATA\Sh_mht_2.html'); //Любой адрес для проверки   C:\Documents and Settings\Tem\Desktop\Proej\Nazhatie\DATA\Sh_mht_2.html
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
    ShellExecute(Application.Handle, nil,'mhtview.exe',
'DATA\6.mht', nil,SW_SHOW);
end;
 
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
   Headers: OleVariant; var Cancel: WordBool);
   var
   s: string;
   new: string;
 begin
     Cancel := True;
     if Pos( '#', URL ) > 0 then
      s := Copy( URL, Pos( '#', URL )+1, 10 )
      ;
   if ( s ) = 'new' then
      begin
   ShellExecute(Application.Handle, nil,'mhtview.exe',
PCHAR(new), nil,SW_SHOW);//пробую открыть в программе
    end;
   end;
end.
Ссылка в html-документе такого вида - <a href="#6.mht">открыть
локально файл</a>.
Подскажите, что не так? Возможно все надо делать по другому?
Persej вне форума Ответить с цитированием
Старый 24.09.2011, 08:20   #2
Sologen
Новичок
Джуниор
 
Регистрация: 18.09.2011
Сообщений: 1
По умолчанию

Вот решение, может кому пригодится, взято здесь:http://www.cyberforum.ru/delphi-begi...ml#post2009635.
Код:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ShellApi, Math, ExtCtrls;

type
  TForm5 = class(TForm)
    Panel1: TPanel;
    WebBrowser1: TWebBrowser;
    Panel2: TPanel;
    Button1: TButton;
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
var
   vpath: WideString;
   ExeName: WideString;
begin
   vpath := ExtractFilePath(Application.ExeName);
   WebBrowser1.Navigate(vpath + 'index.html');
end;

function Hex2Bin(const DataStr: AnsiString): AnsiString;

  function LocChar2Hex(const AChar: AnsiChar): Byte;
  begin
    case AChar of
      '0'..'9': Result := Ord(AChar) - Ord('0');
      'A'..'F': Result := Ord(AChar) - Ord('A') + 10;
     else begin
       Result := 255; {fake}
       Exception.Create('Неверный символ в 16-ричном числе');
     end;
    end;
  end;

var
  StrLen, DataLen: Integer;
  i: Integer;
  P, P1: PByte;
  CharCode: Byte;
begin
  StrLen := Length(DataStr);
  Assert(StrLen mod 2 = 0, 'Неверный размер строки с данными');

  Result := '';
  P1 := PByte(DataStr);
  DataLen := StrLen div 2;
  for i := 1 to DataLen do begin
    CharCode := (LocChar2Hex(AnsiChar(P1^)) shl 4);
    Inc(P1);
    Result := Result + IntToStr(CharCode + LocChar2Hex(AnsiChar(P1^)));
    asm
      inc P1
    end;
  end;
end; { Hex2Bin }

procedure TForm5.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  vPath, vDoc, vChar: string;
  vBuff: AnsiString;
  i: Integer;
begin
  if Pos('#MYLINK#', URL) <> 0 then
  begin
    vPath := URL;
    if Pos('///', vPath) <> 0 then
    begin
      Delete(vPath, 1, Pos('///', vPath) + 2);
    end;
    vDoc := Copy(vPath, Pos('#MYLINK#', vPath) + 8, Length(vPath) - Pos('#MYLINK#', vPath) - 7);
    Delete(vPath,  Pos('#MYLINK#', vPath), Length(vPath) - Pos('#MYLINK#', vPath) + 1);
    //Заменим все '/' на '\'
    i := Pos('/', vPath);
    while i <> 0 do
    begin
      vPath[i] := '\';
      i := Pos('/', vPath);
    end;
    //Удалим все %xx
    i := Pos('%', vPath);
    while i <> 0 do
    begin
      vChar := Copy(vPath, i + 1, 2);
      Delete(vPath, i, 2);
      //SetLength(vBuff, Length(vChar));
      vBuff := Hex2Bin(AnsiString(vChar));
      vPath[i] := Chr(StrToint(String(vBuff)));
      i := Pos('%', vPath);
    end;
    vPath := ExtractFilePath(vPath);
    if vPath[Length(vPath)] <> '\' then
      vPath := vPath + '\';
    URL := vPath + vDoc;
    ShellExecute(Handle, nil,'mhtview.exe',
    pchar(vDoc), nil,SW_SHOW);
  // Cancel := True;
    end;
  end;
end.
Sologen вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
При нажатии на ссылку появляеться меню Vitaliy> JavaScript, Ajax 2 01.07.2011 00:48
Открытие текста при нажатии на ссылку moondor HTML и CSS 2 27.03.2011 19:29
Как вывести информацию при нажатии на ссылку в нужный div ??? 333_org_ua HTML и CSS 1 13.11.2010 13:51
Запуск формы при нажатии кнопки SkrudjMakdak Microsoft Office Excel 4 30.07.2010 22:29
Как открыть папку,нажимая на ссылку в HTML-документе? Zap PHP 3 20.05.2009 00:19