tslediter/funcext/tvclib/utslvclinstall.tsf

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 createshortcut();virtual;
    begin
        uses utslvcl_com;
        wapi := initializeapplication()._wapi;
        path := "";
        setlength(path,1024);
        if not wapi.SHGetSpecialFolderPathA(0,path,2,0) then return -1;
        sn := gets(path)+"\\"+getdisplayname()+".lnk";
        return create_short_cutA(fexe,sn);
    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 gets(s);
    begin
        for i:= 1 to length(s) do 
        begin
            if s[i]="\0" then return s[1:(i-1)];
        end 
    end 
    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.