1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162:
|
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; 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.SwissDelphiCenter.ch'); end;
uses DdeMan, {$IFDEF WIN32} Registry; {$ELSE} IniFiles; {$ENDIF}
{$IFNDEF WIN32} const MAX_PATH = 144; {$ENDIF}
function GetProgramAssociation(Ext: string): string; var {$IFDEF WIN32} reg: TRegistry; s: string; {$ELSE} WinIni: TIniFile; WinIniFileName: array[0..MAX_PATH] of Char; s: string; {$ENDIF} begin {$IFDEF WIN32} s := ''; reg := TRegistry.Create; reg.RootKey := HKEY_CLASSES_ROOT; if reg.OpenKey('.' + ext + '\shell\open\command', False) <> False then begin s := reg.ReadString(''); reg.CloseKey; end else begin if reg.OpenKey('.' + ext, False) <> False then begin s := reg.ReadString(''); reg.CloseKey; if s <> '' then begin if reg.OpenKey(s + '\shell\open\command', False) <> False then s := reg.ReadString(''); reg.CloseKey; end; end; end; if Pos('%', s) > 0 then Delete(s, Pos('%', s), Length(s)); if ((Length(s) > 0) and (s[1] = '"')) then Delete(s, 1, 1); if ((Length(s) > 0) and (Pos('"', s) > 0)) then Delete(s, Pos('"', s), Length(s)); while ((Length(s) > 0) and (s[Length(s)] = #32)) do Delete(s, Length(s), 1); {$ELSE} GetWindowsDirectory(WinIniFileName, SizeOf(WinIniFileName)); StrCat(WinIniFileName, '\win.ini'); WinIni := TIniFile.Create(WinIniFileName); s := WinIni.ReadString('Extensions',ext,''); WinIni.Free; if Pos(' ^', s) > 0 then Delete(s, Pos(' ^', s), Length(s)); {$ENDIF} Result := s; end;
procedure StartNewBrowserWindow(URL: string); var DDEConv: TDDEClientConv; URLFired: bool; App: string; UpApp: string; p: array[0..MAX_PATH] of Char; begin UrlFired := False; App := GetProgramAssociation('HTM'); UpApp := Uppercase(App); Delete(App, Pos('.EXE', UpAPP), Length(App)); if Pos('NETSCAPE.EXE', UpApp) > 0 then begin DDEConv := TDDEClientConv.Create(nil); DDEConv.ServiceApplication := App; if DDEConv.SetLink('NETSCAPE', 'WWW_OpenURL') then if DDEConv.RequestData(URL + ',,0x0,0x0') <> nil then if DDEConv.SetLink('NETSCAPE', 'WWW_Activate') then URLFired := DDEConv.RequestData('0xFFFFFFFF,0x0') <> nil; DDEConv.Free; end else if Pos('IEXPLORE.EXE', UpApp) > 0 then begin DDEConv := TDDEClientConv.Create(nil); DDEConv.ServiceApplication := App; if DDEConv.SetLink('iexplore', 'WWW_OpenURL') then if DDEConv.RequestData(URL + ',,0') <> nil then if DDEConv.SetLink('iexplore', 'WWW_Activate') then URLFired := DDEConv.RequestData('0,0') <> nil; DDEConv.Free; end; if UrlFired = False then WinExec(StrPCopy(@p, URL), SW_SHOWNORMAL); end;
procedure TForm1.Button1Click(Sender: TObject); begin StartNewBrowserWindow('http://www.borland.com'); StartNewBrowserWindow('http://www.yahoo.com'); end; |