//==============================================================================
//从注册表中找出有关系统默认浏览器的信息****************************************
//==============================================================================
function GetBrowser:string;
const Extension: array[0..3] of string = ('.HTM', '.HTML', '.SHTML', '.SHTM');
var
i: byte;
Hkey1,Hkey2: Hkey;
Typ,Taille: integer;
Temp: array[0..1024] of char;
Tempstr: string;
//****************************************************************************
procedure Arrange;
var j:word;
begin
Tempstr:=StrPas(Temp);
j:=1;
repeat
if Tempstr[j] <> '%' then Inc(j) else Delete(Tempstr,j,2);
until j>=Length(Tempstr);
RegCloseKey(Hkey2);
GetBrowser := Tempstr;
end;
begin
i:=0;
repeat
if RegOpenKeyEx(Hkey_CLASSES_ROOT, pchar(Extension), 0, KEY_ALL_ACCESS, Hkey1) = 0 then
begin
if RegQueryValueEx(Hkey1, nil, nil, @Typ, nil, @Taille) = ERROR_SUCCESS then
begin
RegQueryValueEx(Hkey1, nil, nil, nil, @Temp, @Taille);
if Temp<>'' then
if RegOpenKeyEx(Hkey_CLASSES_ROOT, pchar(Temp+'/shell/open/command'), 0, key_all_access, Hkey2) = ERROR_SUCCESS then
begin
if RegQueryValueEx(Hkey2, nil, nil, @Typ, nil, @Taille) = ERROR_SUCCESS then
begin
RegQueryValueEx(Hkey2, nil, nil, nil, @Temp, @Taille);
if Temp <> '' then
begin
Arrange;
Exit;
end;
end;
RegCloseKey(Hkey2);
end;
if RegOpenKeyEx(Hkey1, 'shell/open/command', 0, KEY_ALL_ACCESS, Hkey2) = ERROR_SUCCESS then
begin
if RegQueryValueEx(Hkey2, nil, nil, @Typ, nil, @Taille) = ERROR_SUCCESS then
begin
RegQueryValueEx(Hkey2, nil, nil, nil, @Temp, @Taille);
if Temp<>'' then
begin
Arrange;
Exit;
end;
end;
end;
end;
RegCloseKey(Hkey1);
end;
inc(i);
until i = 4;
Result := '';
end;
//==============================================================================
//检索Windows默认的Internet浏览器的执行文件名及有关参数*************************
//==============================================================================
function GetBrowserNameAndParam(var Param: string): string;
var Temp:string;
i:word;
begin
Temp:=UpperCase(GetBrowser);
if Temp<>'' then
begin
i:=Length(Temp)+1;
repeat
Dec(i);
Param:=Copy(Temp,i-3,4);
until (Param='.EXE') or (Param='.BAT') or (Param='.COM');
if i<length(Temp) then
begin
Param:=Trim(Copy(Temp,i+1,Length(Temp)-(i)));
while (Param<>'') and (Param[1]='"') do Delete(Param,1,1);
Delete(Temp,i+1,Length(Temp)-(i));
end else Param:='';
if Temp[1]='"' then Delete(Temp,1,1);
end;
Result := Temp;
end;
//==============================================================================
//执行Internet浏览器发送E_Mail及有关参数****************************************
//==============================================================================
function GotoWeb(hwnd: HWND; Kind: integer; BrowserName: string; Param: string; Address: string; nShowCmd: integer): Boolean;
begin
if BrowserName <> ''
then begin{Web:=0,EMail:=1}
if Kind=0 then Result := not (ShellExecute(hwnd, nil, PChar(BrowserName), PChar(Param + ' '+ Address), nil, nShowCmd)<33)
{shellexecute函数如返回值等于或小于32则表示发生一个错误，详细情况请参阅Win32手册}
else if Kind=1 then Result := not (ShellExecute(hwnd, nil, PChar(BrowserName), PChar(Param + ' mailto:'+ Address), nil, nShowCmd)<33)
else Result := false;
end
else Result := false;
end;
