Links i nyt vindue

Prøv det her:

ShellExecute(Handle, 'open', 'iexplore', 'http://www.burn-it.dk', '', SW_NORMAL);

Svar accepteret, mange tak :)

Du kan også bruge nedenstående funktion. Den finder første default browser og åbner så siden i den. hejhej's eksempel kræver at man har Internet Explorer installeret ;)

uses
  ShellAPI, Registry;

procedure OpenURL(Url: string);
var
  ts: string;
begin
  with TRegistry.Create do
    try
      rootkey := HKEY_CLASSES_ROOT;
      OpenKey('\htmlfile\shell\open\command', False);
      try
        ts := ReadString('');
      except
        ts := '';
      end;
      CloseKey;
    finally
      Free;
    end;
  if ts = '' then Exit;
  // remove quotes and commandline parameters
  ts := Copy(ts, Pos('"', ts) + 1, Length(ts));
  ts := Copy(ts, 1, Pos('"', ts) - 1);
  ShellExecute(0, 'open', PChar(ts), PChar(url), nil, SW_SHOW);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenURL('http://www.eksperten.dk');
end;


Snowball

Jeg ville fandme (undskyld udtrykket) blive sur, hvis et program åbnede et website i IE, og ikke Mozilla Firebird, på min computer! Det ville jeg kalde dårlig programmering...
Derfor: Brug Snowball's løsning :-)

Som det er nu står der:
begin
ShellExecute(Handle, 'open', 'iexplore', 'http://www.burn-it.dk', '', SW_NORMAL);
end;

Hvordan får jeg det lavet om til det snowball skriver? Jeg kan jo ikke bare sætte din procedre ind i min!?

uses
  ShellAPI, Registry;

procedure OpenURL(Url: string);
var
  ts: string;
begin
  with TRegistry.Create do
    try
      rootkey := HKEY_CLASSES_ROOT;
      OpenKey('\htmlfile\shell\open\command', False);
      try
        ts := ReadString('');
      except
        ts := '';
      end;
      CloseKey;
    finally
      Free;
    end;
  if ts = '' then Exit;
  // remove quotes and commandline parameters
  ts := Copy(ts, Pos('"', ts) + 1, Length(ts));
  ts := Copy(ts, 1, Pos('"', ts) - 1);
  ShellExecute(0, 'open', PChar(ts), PChar(url), nil, SW_SHOW);
end;


begin
  OpenURL('http://www.burn-it.dk');
end;

Tak til snowball og athlon-pascal, det virker glimragende :)

Snowball og athlon -> Vil i ikke have pointene :)

hejhej: For min skyld må du gerne beholde dem - det er jo så få point det drejer sig om, så jeg overlever nok ;)

Snowball

Jeg kopierede bare Snowballs løsning, så jeg skal vist ikke have points :-)

>>snowball Jeg fatter hentydningen, skal nok give flere point næste gang jeg poster noget du svarer på :)

oc_gork: Det var nu slet ikke det der var meningen med min kommentar. Synes det er helt fint at du giver 10 point for dette spørgsmål. Et let spørgsmål er jo sat til 15 point og det her er jo relativt let for "garvede" Delphi programmører ;)

Snowball

Oki, jeg tænkte nok at det ville være nemt for jer :)

Hmmm... Jeg har Mozilla Firebird som standard-browser og hvis jeg slår den angivne sti (HKEY_CLASSES_ROOT\htmlfile\shell\open\command\) op, så får jeg en streng-værdi der viser:

"C:\Programmer\Internet Explorer\iexplore.exe" -nohome

Er i sikre på at den funktion er rigtig, eller er det bare min computer der er skør!?

//hermandsen

hermandsen: Nej, der er ikke noget galt med din PC ;) Har selv prøvet at hente Mozilla Firebird 0.7 og fandt ud af det samme. Problemet skyldes at Mozilla ikke er så "flink" at skrive den slags informationer i registreringsdatabasen så derfor vil IE altid stå som default browser.

Man kan i stedet for gøre som nedenstående. Her kigger man i stedet på hvilket program der er sat til at åbne .htm filer, da man så må gå ud fra at det program er default browser. Er testet med IE 5.5SP2 og Mozilla Firebird 0.7.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TBrowserInformation = record
    Name    : String;
    Path    : String;
    Version  : String;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    BrowserInfo: TBrowserInformation;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type
EGetDefaultBrowser = class(Exception);

implementation

Uses ShellApi, ShlObj, ActiveX;

{$R *.DFM}

function LongPathName(ShortPathName: string): string;
var
  PIDL: PItemIDList;
  Desktop: IShellFolder;
  WidePathName: WideString;
  AnsiPathName: AnsiString;

begin
  Result := ShortPathName;
  if Succeeded(SHGetDesktopFolder(Desktop)) then begin
    WidePathName := ShortPathName;
    if Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(WidePathName), ULONG(nil^), PIDL, ULONG(nil^))) then
    try
      SetLength(AnsiPathName, MAX_PATH);
      SHGetPathFromIDList(PIDL, PChar(AnsiPathName));
      Result := PChar(AnsiPathName);
    finally
      CoTaskMemFree(PIDL);
    end;
  end;
end;

function GetDefaultBrowser : TBrowserInformation;
var
  tmp : PChar;
  res : PChar;
  Version : Pointer;
  VersionInformation : Pointer;
  VersionInformationSize : IntegeR;
  Dummy : Cardinal; //Integer;
  Handle : Integer;
begin
  tmp := StrAlloc(255);
  res := StrAlloc(255);
  Version := Nil;
  try
    GetTempPath(255,tmp);
    Handle := FileCreate(tmp+'htmpl.htm');
    If Handle <> -1 then begin
      if FindExecutable('htmpl.htm',tmp,res) > 32 then begin
        Result.Name := ExtractFileName(res);
        Result.Path := LongPathName(ExtractFilePath(res));
        // Try to determine the Browser Version
        VersionInformationSize := GetFileVersionInfoSize(Res,Dummy);
        if VersionInformationSize > 0 then begin
          GetMem(VersionInformation,VersionInformationSize);
          GetFileVersionInfo(Res,0,VersionInformationSize,VersionInformation);
          VerQueryValue(VersionInformation,('\\StringFileInfo\\040904E4\\ProductVersion'),
          Pointer(Version),Dummy);
          if Version <> Nil then
            Result.Version := PChar(Version);

          FreeMem(VersionInformation);
        end;
    end
      else
        raise EGetDefaultBrowser.Create('Can''t determine the executable.');

      FileClose(Handle);
      SysUtils.DeleteFile(tmp+'htmpl.htm');
    end
    else
      raise EGetDefaultBrowser.Create('Can''t create temporary file.');
  finally
    StrDispose(tmp);
    StrDispose(res);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BrowserInfo := GetDefaultBrowser;
  ListBox1.Items.Add('Name: ' + BrowserInfo.Name);
  ListBox1.Items.Add('Path: ' + BrowserInfo.Path);
  ListBox1.Items.Add('Version: ' + BrowserInfo.Version);

  ShellExecute(0, 'open', PChar(BrowserInfo.Path + '\' + BrowserInfo.Name), PChar(Edit1.Text), nil, SW_SHOW);
end;

end.


Snowball