unit utslvclinstall; interface uses tslvcl; type t_tsl_window_reg = class() function create(); begin exe := sysexecname(); end ///////////////安装uninstall////////////////////////// function get_install_values(); begin reg := getuninstallregkey(fexename,1); if ifobj(reg) then begin r := array(); for i,v in reg.GetValueNames() do begin r[v] := reg.GetValueA(v,vt); end return r; end else return reg; end function set_install_values(vs); begin reg := getuninstallregkey(fexename,2); if ifobj(reg) then begin for i,v in vs do begin reg.SetValueStringA(i,v); end return r; end else return reg; end function install_info_set(); //设置默认的value begin reg := getuninstallregkey(fexename); if not ifobj(reg) then return reg; //打开注册表错误 reg.SetValueStringA("DisplayIcon",fexe); reg.SetValueStringA("DisplayName",getdisplayname()); reg.SetValueStringA("DisplayVersion",getdisplayversion()); reg.SetValueStringA("Publisher",getpublisher()); reg.SetValueStringA("UninstallString",getuninstallstring()); reg.SetValueStringA("InstallLocation",fdefaultexedir); reg.SetValueStringA("InstallTime",datetimetostr(now())); return install_info_setex(reg); end function install_info_setex(reg);virtual; //写入额外信息 begin return 0; end function install_info_remove();virtual; //移除安装信息 begin reg := getuninstallregkey(); if not ifobj(reg) then return reg; //打开注册表错误 return reg.DeleteKeyA(fexename); end function has_reg_authority(); begin return ifobj(getuninstallregkey(nil,rw)); end function get_uninstall_reg(rw); begin return getuninstallregkey(fexename,rw); end ///////////////安装右键菜单////////////////////////////////////// function install_backmenu(); //背景菜单 begin if not fexe then return -1; //软件错误 ////////////////////////写入背景菜单//////////////////////////////////// reg := getbackregkey(fexename); if not ifobj(reg) then return -2; //打开注册表错误 reg.SetValueStringA(nil,fexename); reg.SetValueStringA("Icon",fexe); regcmd := reg.openKeyA("command"); regcmd.SetValueStringA(nil,backmenuparam()); end function uninstall_backmenu(); //卸载 begin reg := getbackregkey(nil,2); if not ifobj(reg) then return reg; //打开注册表错误 return reg.DeleteTreeA(fexename); end ///////////////////安装右键打开菜单///////////////////////////////// function install_backmenuopen();//右键打开菜单 begin if not fexe then return -1; //软件错误 ////////////////////////写入到打开菜单////////////////////////////////////////////// reg := getshellkey(fexename); if not ifobj(reg) then return reg; //打开注册表错误 reg.SetValueStringA(nil,fexename); reg.SetValueStringA("Icon",fexe); regcmd := reg.openKeyA("command"); regcmd.SetValueStringA(nil,(backmenuopenparam())); return 0; end function uninstall_backmenuopen();//卸载 begin reg := getshellkey(nil,2); if not ifobj(reg) then return reg; //打开注册表错误 return reg.DeleteTreeA(fexename); end //////////////////////////重写函数/////////////////////////////////////////// function getdisplayname();virtual; //显示 begin return fexename; end function getdisplayversion();virtual; //版本 begin return "1.0.0"; end function getpublisher();virtual; //开发者 begin return "tinysoft"; end function getuninstallstring();virtual; //卸载字符串 begin return format('"%s" "%s"',funexe,"-uninstall"); end function backmenuparam();virtual; //背景菜单参数 begin return format('"%s"',fexe); end function backmenuopenparam();virtual; // begin return format('"%s" "%s"',fexe,"%1"); end property installforall read finstallforall write finstallforall; property exe read fexe write setexe; property unexe read funexe write setunexe; property exename read fexename write setexename; private fexe; funexe; fexename; fdefaultexedir; finstallforall; private function setexename(s); begin if ifstring(s) and s and (s<>fexename) and not(pos("\\",s)) then begin fexename := s; end end function setunexe(e); begin if (funexe<> e) and (ifstring(e) and fileexists("",e)) then begin funexe := e; end end function setexe(e); begin if (fexe<>e) and (ifstring(e) and fileexists("",e)) then begin fexe := e; funexe := e; fexename := ""; for i:= length(fexe) downto 1 do begin vi := fexe[i]; if vi="\\" then begin fdefaultexedir := fexe[1:i]; for j := i+1 to length(fexe) do begin vj := fexe[j]; if vj ="." then break; fexename+=vj; end break; end end end end ///////////////////////常量///////////////////// {$ifdef win32} const c_uninstall_regkey = "SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall"; {$else} const c_uninstall_regkey = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall"; {$endif} const c_install_backshell = "SOFTWARE\\Classes\\Directory\\background\\shell"; const c_install_Starshell = "SOFTWARE\\Classes\\*\\shell"; function getbasereg(); //基准 begin if finstallforall then return class(TRegKey).GetRegKeyMachine(); ; return class(TRegKey).GetRegKeyUser(); end function getuninstallregkey(n,rw);// begin o := getbasereg(); if n then return o.openKeyA((c_uninstall_regkey+"\\"+n),rw); return o.openKeyA(c_uninstall_regkey,rw); end function getshellkey(n,rw) ; //右键打开菜单 begin o := getbasereg(); if n then return o.openKeyA((c_install_Starshell+"\\"+n),rw); return o.openKeyA(c_install_Starshell,rw); end function getbackregkey(n,rw); //右键菜单 begin o := getbasereg(flg); if n then return o.openKeyA((c_install_backshell+"\\"+n),rw); return o.openKeyA(c_install_backshell,rw); end end end.