// Getestet mit D4 unter WinME

// Die folgende Anweisung öffnet eine Internetseite im Standard-Browser. 
 
uses Shellapi; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if shellexecute(handle, 'open', 
    'http://www.dbrsoftware.de/delphi', nil, nil, sw_show) <= 32 
    then showmessage('FEHLER!'); 
end; 
 
// **************************************************************************** 
 
// Die folgende Anweisung öffnet eine Internetseite in einem speziellen Browser, 
// dessen Name und Pfad aber bekannt sein muss. 
 
uses Shellapi; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  if shellexecute(handle, 'open', 
    'C:\Programme\Netscape\Communicator\Program\netscape.exe', 
    'http://www.dbrsoftware.de/delphi', nil, 0) <= 32 
    then showmessage('FEHLER!'); 
end; 
 
// *************************************************************************** 
 
// Hiermit ermittelt man erst den Standard-Browser und kann anschließend 
// mehrere Seiten je in einem seperaten Fenster öffnen. Bei manchen Browsern 
// (z.B. Opera 6) lässt sich damit auf einmal leider nur eine Seite öffnen. 
 
// ------- Variante 1 -------------- 
 
uses shellapi; 
 
function ermitteln(var s: string): boolean; 
var 
  dummy: string; 
  buffer: Pchar; 
  th: THandle; 
begin 
  dummy := 'dummy.htm'; 
  getmem(buffer, max_path); 
  result := false; 
  th := createfile(pchar(dummy), 0, 0, nil, create_always, 0, 0); 
  if th = INVALID_HANDLE_VALUE then exit; 
  closehandle(th); 
  result := findexecutable(pchar(dummy), nil, buffer) > 32; 
  s := buffer; 
  freemem(buffer); 
  deletefile(dummy); 
end; 
 
// ------- Variante 2 --------------  
uses Registry, Shellapi; 
 
function ermitteln(var s: string): boolean; 
var 
  Reg: TRegistry; 
  p: integer; 
begin 
  result := false; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    if Reg.OpenKey('htmlfile\shell\open\command', false) then 
    begin 
      s := Reg.ReadString(''); 
      p := lastdelimiter('"', s); 
      if p > 0 then s := copy(s, 2, p - 2) else begin 
        p := pos(#32, s); 
        if p > 0 then s := copy(s, 1, p - 1); 
      end; 
      Reg.CloseKey; 
      result := true; 
    end; 
  finally 
    Reg.Free; 
  end; 
end;
// ----------------------------------------------------- 
 
procedure oeffne(browser, site: string); 
begin 
  shellexecute(application.handle, 'open', pchar(browser), 
    pchar(site), nil, sw_show); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var browser: string; 
begin 
  if ermitteln(browser) then begin 
    oeffne(browser, 'http://www/dbrsoftware/delphi');
    oeffne(browser, 'http://www.freenet.de'); 
    oeffne(browser, 'http://www.mzsaalfeld.de'); 
  end; 
end; 
 
// **************************************************************************** 
 
// Und so wird im Standard-Mailprogramm eine komplett ausgefüllte 
// Email aufgeblendet. 
 
uses Shellapi; 
 
procedure TForm1.Button3Click(Sender: TObject); 
var mail, txt, betr: string; 
begin 
  mail := 'dbr.software@freenet.de'; 
  betr := 'Test-Mehl'; 
  txt := 'Liebe Oma, ich schicke Dir eine Emil.'; 
  shellexecute(handle, 'open', 
   pchar('mailto:' + mail + '?Subject=' + betr + '&body=' + txt), nil, nil, 0); 
end; 
 
// *************************************************************************** 
 
// So versendet man mit Outlook (nicht Outlook-Express!) eine Mail samt Anhang. 
 
uses ComObj; 
 
procedure TForm1.Button4Click(Sender: TObject); 
var o, i: OleVariant; 
begin 
  o := CreateOleObject('Outlook.Application'); 
  i := o.CreateItem(0); 
  i. to := 'dbr.software@freenet.de'; 
  i.subject := 'Das ist der Betreff'; 
  i.body := 'Tas iss aine Ihmehl nach ter neuen Rechdschreipung'; 
  i.attachments.add('c:\test.txt'); 
  i.send; 
end;

 


Zugriffe seit 6.9.2001 auf Delphi-Ecke