startupmanger.pas

del *.obj del *.dcu del *.~* del *.hpp del *.dcp del *.dpl del *.cesettings del *.log upx sy

{*******************************************************}
{                                                       }
{       在系统自启动程序管理模块中用到的函数过程        }
{                                                       }
{             Copyright (c) 2005, MICHAEL               }
{    http://xuhaohome.yeah.net OR xuhaohome.2008.cc     }
{     E-Mail:[e-mail]   QQ:10660578 8416321       }
{                                                       }
{*******************************************************}



unit StartUpManger;


interface

uses
   Globals,ComObj,ActiveX,Windows,Dialogs,Sysutils,Classes,Forms,ComCtrls,jpeg,Registry,ShellAPI,ShlObj,StrUtils;





function   Getshowpath(num: integer): string;
function   GetStartType(Const StartType:String):String;
function   ReadLink(AFileName: string): string;
Procedure  AddDirProgramToList(ListTString:TStrings;Const TreeName:String;ListViewName:TListView);
procedure  AddRegProgramToList(RootKEY:HKEY;Const Openkey,TreeName:string;ListViewName:TListView);
Function   DelStartUpFile(FileName:string):Boolean;
Function   DelStartUpRegKey(RootKEY:HKEY;Const Openkey,DelKeyName:string):Boolean;
Function   CreateLink(Const ProgramFile,ProgramArg,CreateLinkPath,Descr: String):boolean; //创建快捷方式的函数
Function   CreateStartUpRegKey(RootKEY:HKEY;Const Openkey,NewKeyName,NewKeyValue:string):Boolean;
Function   CreateStartUpLinkFile(Const BootListSelectName,BootListSelectCmd,BootListSelectPath:String):boolean;
Function   AddRegStartup(Const BootListSelectName,BootListSelectCmd,BootListSelectPath:String):boolean;
Function   ClearFilePath(FilePath:string):string;
function   GetFileIcon(const FileName: string;IsSmall:Boolean): HIcon;


var
BootListSelectName,BootListSelectCmd,BootListSelectPath,BootListSelectType:string;   //当前自启动记录的各项参数值



implementation


function Getshowpath(num: integer): string;
begin   //把对应的启动目录编号转化为
  case num of
   1:  result := '启动文件夹-所有用户';
   2:  result := '启动文件夹-当前用户';
   3:  result := '注册表\所有用户\Run';
   4:  result := '注册表\所有用户\Run-';
   5:  result := '注册表\所有用户\RunOnce';
   6:  result := '注册表\所有用户\RunOnce-';
   7:  result := '注册表\所有用户\RunServices';
   8:  result := '注册表\所有用户\RunServices-';
   9:  result := '注册表\所有用户\RunServicesOnce';
   10: result := '注册表\所有用户\RunServicesOnce-';
   11: result := '注册表\当前用户\Run';
   12: result := '注册表\当前用户\Run-';
   13: result := '注册表\当前用户\RunOnce';
   14: result := '注册表\当前用户\RunOnce-';
 end;
end;

function GetStartType(Const StartType:String):String;
  function Get_REGSTR_PATH(name: integer): string;
  var //取得系统定义的全局变量(系统自定义路径)的值 在想要得到系统开始中'启动'的绝对路径时用到
    Pidl: PItemIDList;    //加ShlObj单元
    buffer: array[0..255] of char;
  begin
    SHGetSpecialFolderLocation(Application.Handle, name, Pidl);
    SHGetPathFromIDList(Pidl, buffer);
    result := StrPas(buffer);
  end;
begin   //把启动简称转化为对应的真实位置路径
  if StartType= '启动文件夹-所有用户' then result:= Get_REGSTR_PATH(CSIDL_COMMON_STARTUP)
  else
  if StartType= '启动文件夹-当前用户' then result:= Get_REGSTR_PATH(CSIDL_STARTUP)
  else
  if StartType= '注册表\所有用户\Run' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\Run'
  else
  if StartType= '注册表\所有用户\Run-' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\Run-'
  else
  if StartType= '注册表\所有用户\RunOnce' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunOnce'
  else
  if StartType= '注册表\所有用户\RunOnce-' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunOnce-'
  else
  if StartType= '注册表\所有用户\RunServices' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunServices'
  else
  if StartType= '注册表\所有用户\RunServices-' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunServices-'
  else
  if StartType= '注册表\所有用户\RunServicesOnce' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce'
  else
  if StartType= '注册表\所有用户\RunServicesOnce-' then result:= 'HKEY_LOCAL_MACHINE'+'\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce-'
  else
  if StartType= '注册表\当前用户\Run' then result:= 'HKEY_CURRENT_USER'+'\Software\Microsoft\Windows\CurrentVersion\Run'
  else
  if StartType= '注册表\当前用户\Run-' then result:= 'HKEY_CURRENT_USER'+'\Software\Microsoft\Windows\CurrentVersion\Run-'
  else
  if StartType= '注册表\当前用户\RunOnce' then result:= 'HKEY_CURRENT_USER'+'\Software\Microsoft\Windows\CurrentVersion\RunOnce'
  else
  if StartType= '注册表\当前用户\RunOnce-' then result:= 'HKEY_CURRENT_USER'+'\Software\Microsoft\Windows\CurrentVersion\RunOnce-'
  else result:= 'HKEY_CURRENT_USER'+'\Software\Microsoft\Windows\CurrentVersion\Run';
end;


function ReadLink(AFileName: string): string;
var    //返回快捷方式的目标文件路径全名
  psl: IShellLink;   //加入ShlObj单元
  ppf: IPersistFile;  //加入ActiveX单元
  WCLinkName: array[0..Max_Path] of WideChar;
  Buf, buf2: array[0..255] of Char;
  Data: TWin32FindData;
begin
  psl := CreateComObject(CLSID_ShellLink) as IShellLink; //加入ComObj单元
  ppf := psl as IPersistFile;

  StringToWideChar(AFileName, WCLinkName, MAX_PATH);
  ppf.Load(WCLinkName, STGM_READ);

  psl.GetPath(@Buf, Max_Path, Data, SLGP_RAWPATH);
  psl.GetArguments(@Buf2, Max_Path);
  //Result := StrPas(Buf);
  if buf2 <> '' then
    Result := format('%s %s', [Buf, Buf2])
  else
    Result := format('"%s"', [Buf]);
end;


Procedure AddDirProgramToList(ListTString:TStrings;Const TreeName:String;ListViewName:TListView);
var
  i:integer;
begin
    for i := 0 to ListTString.Count - 1 do
      begin
        with ListViewName.Items.add do                                            
          begin
            caption :=ExtractFileName(ListTString[i]);
            Checked := true;
            if ExtractFileExt(ListTString[i]) = '.lnk' then
            begin
              subitems.add(ReadLink(ListTString[i]));
            end
            else subitems.Add(ListTString[i]);
            Subitems.Add(ExtractFileDir(ListTString[i]));
            subitems.Add(Getshowpath(strtoint(TreeName)));
          end;
      end;
end;

procedure AddRegProgramToList(RootKEY:HKEY;Const Openkey,TreeName:string;ListViewName:TListView);
var
  Reg: TRegistry;
  List: TStrings;
  i: integer;
begin
  Reg := TRegistry.Create;
  try
    List := TStringList.Create;
    try
      Reg.RootKey :=RootKEY; 
      if reg.OpenKey(openkey, false) then
        begin            
          reg.GetValueNames(list);
          if list.Count > 0 then
            begin
              for i := 0 to list.Count - 1 do
                with ListViewName.Items.Add do
                  begin
                    caption := list[i];
                    checked:=True;
                    subitems.Add(reg.ReadString(list[i]));
                    if (inttostr(RootKey)='2147483650') then subitems.Add('HKEY_LOCAL_MACHINE'+Openkey) else subitems.Add('HKEY_CURRENT_USER'+Openkey);
                    subitems.Add(Getshowpath(strtoint(TreeName)));
                  end;
              list.Clear;
            end;
        end;
      if reg.OpenKey(openkey + '-', false) then
        begin
          reg.GetValueNames(list);
          if list.Count > 0 then
            begin
              for i := 0 to list.Count - 1 do
                with ListViewName.Items.add do
                  begin
                    caption := list[i];
                    checked := False;
                    subitems.Add(reg.ReadString(list[i]));
                    if (inttostr(RootKey)='2147483650') then subitems.Add('HKEY_LOCAL_MACHINE'+Openkey+'-') else subitems.Add('HKEY_CURRENT_USER'+Openkey+'-');
                    subitems.Add(Getshowpath(strtoint(TreeName)+1));
                  end;
              list.Clear;
            end
        end;
    finally
      list.Free;
    end;
  finally
    reg.CloseKey;
    reg.Free;
  end;
end;

Function DelStartUpFile(FileName:string):Boolean;
begin
try
  SetFileAttributes(Pchar(FileName),FILE_ATTRIBUTE_NORMAL);
  Result:=DeleteFile(FileName);
finally
end;
end;

Function DelStartUpRegKey(RootKEY:HKEY;Const Openkey,DelKeyName:string):Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
  Reg.RootKey:=RootKEY;
  Reg.OpenKey(OpenKey,true);
  Result:=Reg.DeleteValue(DelKeyName);
  Reg.Free;
  Except
  Reg.Free;
  Result:=False;
  end;
end;

Function CreateLink(Const ProgramFile,ProgramArg,CreateLinkPath,Descr: String):boolean; //创建快捷方式的函数
  var //ProgramFile是目标文件的全路径;ProgramArg是执行的参数;CreateLinkPath是要创建到快捷方式的全路径;Descr是此快捷方式的描述
    AnObj: IUnknown;
    ShellLink: IShellLink;
    AFile: IPersistFile;
    FileName: WideString;
begin
  try
    OleInitialize(nil);//初始化OLE库,在使用OLE函数前必须调用初始化
    AnObj := CreateComObject(CLSID_ShellLink);//根据给定的ClassID生成一个COM对象,此处是快捷方式
    ShellLink := AnObj as IShellLink;//强制转换为快捷方式接口
    AFile := AnObj as IPersistFile;//强制转换为文件接口
    ShellLink.SetPath(PChar(ProgramFile)); // 快捷方式的目标文件,一般为可执行文件
    ShellLink.SetArguments(PChar(ProgramArg));// 目标文件参数
    ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(ProgramFile)));//目标文件的工作目录
    ShellLink.SetDescription(PChar(Descr));// 对目标文件的描述
    FileName :=CreateLinkPath;//把文件名转换为WideString类型
    AFile.Save(PWChar(FileName),False);//保存快捷方式
    OleUninitialize;//关闭OLE库,此函数必须与OleInitialize成对调用
  except
    OleUninitialize;//关闭OLE库,此函数必须与OleInitialize成对调用
    result:=False;
  end;
result:=True;
end;

Function CreateStartUpRegKey(RootKEY:HKEY;Const Openkey,NewKeyName,NewKeyValue:string):Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
  Reg.RootKey:=RootKEY;
  Reg.OpenKey(OpenKey,true);
  Reg.WriteString(NewKeyName,NewKeyValue);
  Result:=True;
  Reg.Free;
  Except
  Reg.Free;
  Result:=False;
  end;
end;

Function CreateStartUpLinkFile(Const BootListSelectName,BootListSelectCmd,BootListSelectPath:String):boolean;
begin
if lowercase(ExtractFileExt(BootListSelectCmd))='.lnk' then
  begin
    result:=Copyfile(Pchar(BootListSelectCmd) , Pchar(format('%s\%s',[BootListSelectPath,BootListSelectName])+'.lnk'),False);
  end
else
  begin
    Result:=CreateLink(BootListSelectCmd,'',ChangeFileExt(Format('%s\%s',[BootListSelectPath,BootListSelectName]),'.lnk'),'');
  end;
end;

Function AddRegStartup(Const BootListSelectName,BootListSelectCmd,BootListSelectPath:String):boolean;
var
  RootKey:HKEY;
begin
if AnsiContainsText(BootListSelectPath,'HKEY_') then
  begin
    if Copy(BootListSelectPath,0,Pos('\',BootListSelectPath)-1)='HKEY_LOCAL_MACHINE' then RootKEY:=HKEY_LOCAL_MACHINE else RootKEY:=HKEY_CURRENT_USER;
    if Not CreateStartUpRegKey(RootKey,(Copy(BootListSelectPath,Pos('\',BootListSelectPath),Length(BootListSelectPath))) , BootListSelectName, BootListSelectCmd) then
    begin
    showmessage('注册表写入键键未成功，请检查注册表路径及访问权限后再试。');
    result:=False;
    exit;
    end;
  end else
  begin
    if Not CreateStartUpLinkFile(BootListSelectName,BootListSelectCmd,BootListSelectPath) then
    begin
    showmessage('创建快捷方式失败，请检查磁盘路径及访问权限后再试。');
    result:=False;
    exit;
    end;
  end;
result:=True;
end;

Function  ClearFilePath(FilePath:string):string;
var
  i, i2: integer;
  s, s2: string;
begin   //去除一个完整路径中的多余字符或参数
FilePath:=StringReplace(Trim(FilePath),'"','',[rfReplaceAll, rfIgnoreCase]);
  s := lowercase(trim(FilePath));
  if AnsiStartsText('"', s) then
    begin
      s2 := copy(FilePath, 2, length(s));
      i := pos('"', s2);
      FilePath := copy(s2, 1, i - 1);
    end else
    begin
      i := pos('.', s);
      i2 := length(s) - i;
      if i2 <= 3 then begin s2 := copy(s, 1, i + 3); FilePath:= s2;  end
      else begin  i := pos('.exe ', s); s2 := copy(s, 1, i + 3); FilePath:= s2;  end;
    end;
result:=FilePath;
end;

function GetFileIcon(const FileName: string;IsSmall:Boolean): HIcon;
var       //取得指定文件的图标，IsSmall用来指示是取大图标还是小图标
  Info: TSHFileInfo;
  Flags: Cardinal;
begin
if AnsiContainsText(FileName,':') and AnsiContainsText(FileName,'\') then
  begin
  if IsSmall then Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES
  else Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES;
  SHGetFileInfo(PChar(FileName), FILE_ATTRIBUTE_NORMAL, Info, SizeOf(TSHFileInfo), Flags);
  Result := Info.hIcon;
  end else
  begin
  Result :=ExtractIcon(Hinstance,PChar(FileName),0);
  end;
end;









end.