home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / unity / d56 / DW / DW10242.ZIP / RegWorks.pas < prev    next >
Pascal/Delphi Source File  |  2002-08-11  |  14KB  |  390 lines

  1. (*---------------------------------RegWorks.pas--------------------------
  2.  V1.0.237 - 11.08.2002 current release
  3. ------------------------------------------------------------------------*)
  4. unit RegWorks;
  5.  
  6. interface
  7.  
  8. uses Windows, Graphics, Registry, SysUtils, Classes, StringWorks;
  9.  
  10. type
  11.    TDWAutorunRootKey = (dwarkHKCU,
  12.                         dwarkHKLM);
  13.    TDWAutorunOption  = (dwaoRun,
  14.                         dwaoRunOnce,
  15.                         dwaoRunOnceEx,
  16.                         dwaoRunServices,
  17.                         dwaoRunServicesOnce);
  18.  
  19. //added rev. 1.0.237 / 30.05.2002
  20. function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
  21.                                const AutorunOption:  TDWAutorunOption;
  22.                                const ValueName:      String): Boolean; overload;
  23.  
  24. function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
  25.                                const AutorunOption:  TDWAutorunOption;
  26.                                const ValueName,
  27.                                      CommandString:  String): Boolean; overload;
  28.  
  29. function GetAutostart(const AutorunRootKey: TDWAutorunRootKey;
  30.                       const AutorunOption:  TDWAutorunOption;
  31.                       const ValueName:      String): String;
  32.  
  33. function RefreshIconCache: Boolean;
  34.  
  35. function RegisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
  36.                            const AutorunOption:     TDWAutorunOption;
  37.                            const ValueName,
  38.                                  CommandString:     String;
  39.                            const OverwriteExisting: Boolean): Boolean;
  40.  
  41. function UnregisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
  42.                              const AutorunOption:     TDWAutorunOption;
  43.                              const ValueName:         String): Boolean;
  44.  
  45. // Added rev. 1.0.236 / 10.01.2002
  46. function RegColorToStr(const RegColor: String): String;
  47. function ColorToRegColor(const Color: TColor): String;
  48. function ReadRegColor(const RootKey: HKEY; const KeyName, ValueName: String): TColor;
  49. function WriteRegColor(const Color: TColor; const RootKey: HKEY; const KeyName, ValueName: String): Boolean;
  50.  
  51. // Added rev. 1.0.235 / 27.12.2001
  52. function HKEYToStr(const KEY: HKEY): String;
  53. function StrToHKEY(const KEY: String): HKEY;
  54.  
  55. implementation
  56.  
  57. uses Messages;
  58.  
  59. const
  60.    sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
  61.    sRun =             'Run\';
  62.    sRunOnce =         'RunOnce\';
  63.    sRunOnceEx =       'RunOnceEx\';
  64.    sRunServices =     'RunServices\';
  65.    sRunServicesOnce = 'RunServicesOnce\';
  66.  
  67. function _AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
  68.                                 const AutorunOption:  TDWAutorunOption;
  69.                                 const ValueName,
  70.                                       CommandString:  String;
  71.                                 const ProofCmdStr:    Boolean): Boolean;
  72. var
  73.    bCanOpenKey,
  74.    bValueExists,
  75.    bCmdSame: Boolean;
  76.    sOpenKey,
  77.    sValue: String;
  78. begin
  79.    bCmdSame:= TRUE;
  80.    bValueExists:= FALSE;
  81.    with TRegistry.Create do begin
  82.       case AutorunRootKey of
  83.       dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
  84.       dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
  85.       end;
  86.       case AutorunOption of
  87.       dwaoRun:             sOpenKey:= sBaseKey + sRun;
  88.       dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
  89.       dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
  90.       dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
  91.       dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
  92.       end;
  93.       bCanOpenKey:= OpenKey(sOpenKey, FALSE);
  94.       if bCanOpenKey then begin
  95.          bValueExists:= ValueExists(ValueName);
  96.          if bValueExists then begin
  97.             sValue:= ReadString(ValueName);
  98.             if ProofCmdStr then bCmdSame:= (sValue = CommandString);
  99.          end;
  100.       end;
  101.       Free;
  102.    end;
  103.    result:= (bCanOpenKey and bValueExists and bCmdSame);
  104. end;
  105.  
  106. function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
  107.                                const AutorunOption:  TDWAutorunOption;
  108.                                const ValueName:      String): Boolean; overload;
  109. begin
  110.    result:= _AutostartIsRegistered(AutorunRootKey, AutorunOption, ValueName, '', FALSE);
  111. end;
  112.  
  113. function AutostartIsRegistered(const AutorunRootKey: TDWAutorunRootKey;
  114.                                const AutorunOption:  TDWAutorunOption;
  115.                                const ValueName,
  116.                                      CommandString:  String): Boolean; overload;
  117. begin
  118.    result:= _AutostartIsRegistered(AutorunRootKey, AutorunOption, ValueName, CommandString, TRUE);
  119. end;
  120.  
  121. function GetAutostart(const AutorunRootKey: TDWAutorunRootKey;
  122.                       const AutorunOption:  TDWAutorunOption;
  123.                       const ValueName:      String): String;
  124. var
  125.    sOpenKey: String;
  126. begin
  127.    with TRegistry.Create do begin
  128.       case AutorunRootKey of
  129.       dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
  130.       dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
  131.       end;
  132.       case AutorunOption of
  133.       dwaoRun:             sOpenKey:= sBaseKey + sRun;
  134.       dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
  135.       dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
  136.       dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
  137.       dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
  138.       end;
  139.       Free;
  140.    end;
  141.    result:= sOpenKey;
  142. end;
  143.  
  144. function RefreshIconCache: Boolean;
  145. const
  146.   KEY_TYPE = HKEY_CURRENT_USER;
  147.   KEY_NAME = 'Control Panel\Desktop\WindowMetrics';
  148.   KEY_VALUE = 'Shell Icon Size';
  149. var
  150.   Reg: TRegistry;
  151.   strDataRet, strDataRet2: string;
  152.  procedure BroadcastChanges;
  153.  var
  154.    success: DWORD;
  155.  begin
  156.    SendMessageTimeout(HWND_BROADCAST,
  157.                       WM_SETTINGCHANGE,
  158.                       SPI_SETNONCLIENTMETRICS,
  159.                       0,
  160.                       SMTO_ABORTIFHUNG,
  161.                       10000,
  162.                       success);
  163.  end;
  164. begin
  165.   Result := False;
  166.   Reg := TRegistry.Create;
  167.   try
  168.     Reg.RootKey := KEY_TYPE;
  169.     // 1. open HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics
  170.     if Reg.OpenKey(KEY_NAME, False) then
  171.     begin
  172.       // 2. Get the value for that key
  173.       strDataRet := Reg.ReadString(KEY_VALUE);
  174.       Reg.CloseKey;
  175.       if strDataRet <> '' then
  176.       begin
  177.         // 3. Convert sDataRet to a number and subtract 1,
  178.         //    convert back to a string, and write it to the registry
  179.         strDataRet2 := IntToStr(StrToInt(strDataRet) - 1);
  180.         if Reg.OpenKey(KEY_NAME, False) then
  181.         begin
  182.           Reg.WriteString(KEY_VALUE, strDataRet2);
  183.           Reg.CloseKey;
  184.           // 4. because the registry was changed, broadcast
  185.           //    the fact passing SPI_SETNONCLIENTMETRICS,
  186.           //    with a timeout of 10000 milliseconds (10 seconds)
  187.           BroadcastChanges;
  188.           // 5. the desktop will have refreshed with the
  189.           //    new (shrunken) icon size. Now restore things
  190.           //    back to the correct settings by again writing
  191.           //    to the registry and posing another message.
  192.           if Reg.OpenKey(KEY_NAME, False) then
  193.           begin
  194.             Reg.WriteString(KEY_VALUE, strDataRet);
  195.             Reg.CloseKey;
  196.             // 6.  broadcast the change again
  197.             BroadcastChanges;
  198.             Result := True;
  199.           end;
  200.         end;
  201.       end;
  202.     end;
  203.   finally
  204.     Reg.Free;
  205.   end;
  206. end;
  207.  
  208. function RegisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
  209.                            const AutorunOption:     TDWAutorunOption;
  210.                            const ValueName,
  211.                                  CommandString:     String;
  212.                            const OverwriteExisting: Boolean): Boolean;
  213. {const
  214.    sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
  215.    sRun =             'Run\';
  216.    sRunOnce =         'RunOnce\';
  217.    sRunOnceEx =       'RunOnceEx\';
  218.    sRunServices =     'RunServices\';
  219.    sRunServicesOnce = 'RunServicesOnce\';}
  220. var
  221.    bCanOpenKey,
  222.    bCanWriteValue,
  223.    bValueExists: Boolean;
  224.    sOpenKey: String;
  225. begin
  226.    bCanWriteValue:= FALSE;
  227.    with TRegistry.Create do begin
  228.       case AutorunRootKey of
  229.       dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
  230.       dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
  231.       end;
  232.       case AutorunOption of
  233.       dwaoRun:             sOpenKey:= sBaseKey + sRun;
  234.       dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
  235.       dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
  236.       dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
  237.       dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
  238.       end;
  239.       bCanOpenKey:= OpenKey(sOpenKey, FALSE);
  240.       if bCanOpenKey then begin
  241.          bValueExists:= ValueExists(ValueName);
  242.          bCanWriteValue:= ((bValueExists and OverwriteExisting) or (not bValueExists));
  243.          if bCanWriteValue then WriteString(ValueName, CommandString);
  244.       end;
  245.       Free;
  246.       result:= (bCanOpenKey and bCanWriteValue);
  247.    end;
  248. end;
  249.  
  250. function UnregisterAutostart(const AutorunRootKey:    TDWAutorunRootKey;
  251.                              const AutorunOption:     TDWAutorunOption;
  252.                              const ValueName:         String): Boolean;
  253. {const
  254.    sBaseKey =         '\Software\Microsoft\Windows\CurrentVersion\';
  255.    sRun =             'Run\';
  256.    sRunOnce =         'RunOnce\';
  257.    sRunOnceEx =       'RunOnceEx\';
  258.    sRunServices =     'RunServices\';
  259.    sRunServicesOnce = 'RunServicesOnce\';}
  260. var
  261.    bCanOpenKey,
  262.    bValueExists: Boolean;
  263.    sOpenKey: String;
  264. begin
  265.    bValueExists:= FALSE;
  266.    with TRegistry.Create do begin
  267.       case AutorunRootKey of
  268.       dwarkHKCU: RootKey:= HKEY_CURRENT_USER;
  269.       dwarkHKLM: RootKey:= HKEY_LOCAL_MACHINE;
  270.       end;
  271.       case AutorunOption of
  272.       dwaoRun:             sOpenKey:= sBaseKey + sRun;
  273.       dwaoRunOnce:         sOpenKey:= sBaseKey + sRunOnce;
  274.       dwaoRunOnceEx:       sOpenKey:= sBaseKey + sRunOnceEx;
  275.       dwaoRunServices:     sOpenKey:= sBaseKey + sRunServices;
  276.       dwaoRunServicesOnce: sOpenKey:= sBaseKey + sRunServicesOnce;
  277.       end;
  278.       bCanOpenKey:= OpenKey(sOpenKey, FALSE);
  279.       if bCanOpenKey then begin
  280.          bValueExists:= ValueExists(ValueName);
  281.          if bValueExists then DeleteValue(ValueName);
  282.       end;
  283.       result:= (bCanOpenKey and bValueExists);
  284.       Free;
  285.    end;
  286. end;
  287.  
  288.  
  289. function HKEYToStr(const KEY: HKEY): String;
  290. begin
  291.    case KEY of
  292.    HKEY_CLASSES_ROOT: result:= 'HKEY_CLASSES_ROOT';
  293.    HKEY_CURRENT_USER: result:= 'HKEY_CURRENT_USER';
  294.    HKEY_LOCAL_MACHINE: result:= 'HKEY_LOCAL_MACHINE';
  295.    HKEY_USERS: result:= 'HKEY_USERS';
  296.    HKEY_PERFORMANCE_DATA: result:= 'HKEY_PERFORMANCE_DATA';
  297.    HKEY_CURRENT_CONFIG: result:= 'HKEY_CURRENT_CONFIG';
  298.    HKEY_DYN_DATA: result:= 'HKEY_DYN_DATA';
  299.    else result:= 'HKEY_LOCAL_MACHINE';
  300.    end;
  301. end;
  302.  
  303. function StrToHKEY(const KEY: String): HKEY;
  304. begin
  305.    if KEY = 'HKEY_CLASSES_ROOT' then result:= HKEY_CLASSES_ROOT else
  306.    if KEY = 'HKEY_CURRENT_USER' then result:= HKEY_CURRENT_USER else
  307.    if KEY = 'HKEY_LOCAL_MACHINE' then result:= HKEY_LOCAL_MACHINE else
  308.    if KEY = 'HKEY_USERS' then result:= HKEY_USERS else
  309.    if KEY = 'HKEY_PERFORMANCE_DATA' then result:= HKEY_PERFORMANCE_DATA else
  310.    if KEY = 'HKEY_CURRENT_CONFIG' then result:= HKEY_CURRENT_CONFIG else
  311.    if KEY = 'HKEY_DYN_DATA' then result:= HKEY_DYN_DATA else
  312.    result:= HKEY_LOCAL_MACHINE;
  313. end;
  314.  
  315. function RegColorToStr(const RegColor: String): String;
  316. var
  317.    TempList: TStringList;
  318.    sR, sG, sB: String;
  319. begin
  320.    result:= '';
  321.    if CountCharInStr(RegColor, ' ') <> 2 then exit;
  322.    if (StringLen(RegColor) > 11) or
  323.       (StringLen(RegColor) <  5) then exit;
  324.    TempList:= TStringList.Create;
  325.    TempList.Assign(StrToList(RegColor, ' '));
  326.    sR:= TempList[0];
  327.    sG:= TempList[1];
  328.    sB:= TempList[2];
  329.    result:= '$00' +
  330.             IntToHex(StrToIntDef(sB, 0), 2) +
  331.             IntToHex(StrToIntDef(sG, 0), 2) +
  332.             IntToHex(StrToIntDef(sR, 0), 2);
  333.    TempList.Free;
  334. end;
  335.  
  336. function ColorToRegColor(const Color: TColor): String;
  337. var
  338.    clStr, sR, sG, sB: String;
  339. const
  340.    spc: Char = ' ';
  341.    dlr: Char = '$';
  342. begin
  343.    clStr:= IntToHex(Color, 6);
  344.    sR:= StrRight(clStr, 2);
  345.    sG:= StrMid(clStr, 3, 2);
  346.    sB:= StrMid(clStr, 2, 2);
  347.    sR:= IntToStr(StrToInt(dlr + sR));
  348.    sG:= IntToStr(StrToInt(dlr + sG));
  349.    sB:= IntToStr(StrToInt(dlr + sB));
  350.    result:= sR + spc + sG + spc + sB;
  351. end;
  352.  
  353. function ReadRegColor(const RootKey: HKEY; const KeyName, ValueName: String): TColor;
  354. var
  355.    Reg: TRegistry;
  356.    DataInfo: TRegDataInfo;
  357. begin
  358.    result:= clNone;
  359.    Reg:= TRegistry.Create(KEY_READ);
  360.    Reg.RootKey:= RootKey;
  361.    with Reg do begin
  362.       if OpenKey(KeyName, FALSE) then begin
  363.          GetDataInfo(ValueName, DataInfo);
  364.          if (DataInfo.RegData = rdString) then begin
  365.             result:= StringToColor(RegColorToStr(ReadString(ValueName)));
  366.          end;
  367.       end;
  368.       Free;
  369.    end;
  370. end;
  371.  
  372. function WriteRegColor(const Color: TColor; const RootKey: HKEY; const KeyName, ValueName: String): Boolean;
  373. var
  374.    Reg: TRegistry;
  375. begin
  376.    result:= FALSE;
  377.    Reg:= TRegistry.Create;
  378.    with Reg do begin
  379.       RootKey:= RootKey;
  380.       if OpenKey(KeyName, TRUE) then begin
  381.          WriteString(ValueName, ColorToRegColor(Color));
  382.          result:= TRUE;
  383.       end;
  384.       Free;
  385.    end;
  386. end;
  387.  
  388. end.
  389.  
  390.