RegFiles.~pas
上传用户:mjqmds
上传日期:2022-05-05
资源大小:2827k
文件大小:24k
源码类别:

DirextX编程

开发平台:

Delphi

  1. Unit RegFiles;
  2. Interface
  3. Uses
  4.   Windows,
  5.   SysUtils,
  6.   Dialogs,
  7.   Classes,
  8.   Registry,
  9.   ShellAPI,
  10.   ShlObj;
  11. Procedure UpdateAssociationToSystem;
  12. //Check AssociationPath and update Path
  13. Procedure UpdateAssociationPath(Const KeyName, FileName: String);
  14. //Set a value in the registry;
  15. Procedure SetValInReg(RKey: HKey; KeyPath: String; ValName: String; NewVal: String);
  16. Procedure RegisterAllFileType(MenuName, Command: String);
  17. {Click on a File in Explorer with right mouse key ,
  18. uses this function you may add new menu item to popup menu
  19. MenuName:display on the popup menu name
  20. Command: execute command
  21. eg:
  22. RegisterAllFileType(sFileMenuName, '"' + Application.ExeName + '" "%1"');
  23. }
  24. Procedure UnRegisterAllFileType(MenuName: String);
  25. Function ExtDescription(Ext: String): String;
  26. {if ExtDescription(File type description) then return such description}
  27. Function AssociationExists(Ext: String; Var FileName: String): String;
  28. { Ext: Extension Name (eg: ".txt")
  29.   if no AssociationExists then return ''
  30.   else return Association Key Name and Execute File Name
  31. }
  32. Function DoesKeyExist(AKey: String): Boolean;
  33. Function DeleteAssociation(RegKey, Ext: String): Boolean;
  34. { Desc: if old association exists then fisrt restore old one , then delete.
  35. }
  36. Function ClearAssociation(RegKey, Ext: String): Boolean;
  37. { Desc: if old association exists then fisrt restore old one , then clear.
  38. }
  39. //Clears or Removes an Association with or without updating desktop
  40. Function RemoveAssociation(RegKey, Ext: String; RemoveKeyName: Boolean; UpdateSystem: Boolean): Boolean;
  41. { Desc: if old association exists then fisrt restore old one , then Remove.
  42. }
  43. Procedure CreateAssociation(Ext: String; FileName: String;
  44.   DefaultIcon: String; KeyName: String;
  45.   FileType: String; ShowInNew: Boolean);
  46. { Params Description:
  47.   Ext: Extension Name
  48.   FileName: Execute File Name include path(eg "d:appsxxx.exe")
  49.   DefaultIcon: eg, use the first icon in execute file: "D:APPSxxxx.exe,0"
  50.   KeyName: Ext Key Name, such as "JediEdit.c"
  51.   FileType: File Type Description, such as 'C Language File'
  52.   ShowInNew: if true then put command(Execute File Name) into 'ShellNew' register Key
  53.              else  put into 'Shell' register key
  54.   Desc: first try to backup old Association then CreateAssociation.
  55. }
  56. //Makes association
  57. Procedure MakeAssociation(Ext: String; PgmToLinkTo: String;
  58.   DefaultIcon: String; KeyName: String;
  59.   TypeName: String; ShowInNew: Boolean);
  60. { Ext: Extension Name
  61.   pgmToLinkTo: Execute File Name include path(eg "d:appsxxx.exe")
  62.   KeyName:
  63.   Desc: see above, this function no error check.
  64. }
  65. {------------Low Level Functions---------}
  66. Function RemoveParams(Value: String): String;
  67. Function SaveIntToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Boolean;
  68. Function LoadIntFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Integer;
  69. Function SaveStrToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): Boolean;
  70. Function LoadStrFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): String;
  71. Function SaveBoolToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  72. Function LoadBoolFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  73. {Deletes a key with and subkeys on win95}
  74. Function DeleteRegKey(MainKey: LongInt; AKey: String): Boolean;
  75. {Deletes a key with and subkeys on win95/NT}
  76. Function NTDeleteRegKey(MainKey: LongInt; Const AKey: String): Boolean;
  77. {Sets a stringlist with all subkeys}
  78. Function GetRegSubTree(MainKey: LongInt; AKey, AValue: String; Const AList: TStrings): Boolean;
  79. { if aValue <> '' then these subkeys must include aValue string.
  80. }
  81. {The following methods return or set the default key values}
  82. Procedure ChangeRegistryInt(mainKey: LongInt; AKey: String; AValue: LongInt);
  83. Procedure ChangeRegistryStr(mainKey: LongInt; AKey: String; AValue: String);
  84. Procedure ChangeRegistryBool(mainKey: LongInt; AKey: String; AValue: Boolean);
  85. Function GetRegistryStr(mainKey: LongInt; AKey: String; Default: String): String;
  86. Function GetRegistryInt(mainKey: LongInt; AKey: String; Default: Integer): Integer;
  87. Function GetRegistryBool(MainKey: LongInt; AKey: String; Default: Boolean): Boolean;
  88. Const
  89.   sOldDefault = 'Old Default';
  90. Implementation
  91. //Set a value in the registry;
  92. Procedure SetValInReg(RKey: HKey; KeyPath: String;
  93.   ValName: String; NewVal: String);
  94. Begin
  95.   With TRegistry.Create Do Try
  96.     RootKey := RKey;
  97.     OpenKey(KeyPath, True);
  98.     WriteString(ValName, NewVal);
  99.   Finally
  100.     Free;
  101.   End;
  102. End;
  103. Procedure RegisterAllFileType(MenuName, Command: String);
  104. {Click on a File in Explorer with right mouse key ,
  105. uses this function you may add new menu item to popup menu
  106. MenuName:display on the popup menu name
  107. Command: execute command}
  108. Begin
  109.   SetValInReg(HKEY_CLASSES_ROOT, '*shell' + MenuName + 'command', '', Command);
  110.   //  SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_FLUSH,pchar(''),pchar(''));  {update system of assocciation change}
  111. End;
  112. Procedure UnRegisterAllFileType(MenuName: String);
  113. Begin
  114.   NTDeleteRegKey(LongInt(HKEY_CLASSES_ROOT), '*Shell' + MenuName);
  115.   //  SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_FLUSH,pchar(''),pchar(''));  {update system of assocciation change}
  116. End;
  117. Function ExtDescription(Ext: String): String;
  118. Var
  119.   AReg: TRegistry;
  120.   AssocKey: String;
  121. Begin
  122.   Result := ''; {initialize result to empty string if exception occurrs}
  123.   AReg := TRegistry.Create;
  124.   Try
  125.     AReg.RootKey := HKEY_CLASSES_ROOT;
  126.     //Lowercase to avoid trouble
  127.     Ext := LowerCase(Ext);
  128.     If AReg.KeyExists(Ext) Then Begin
  129.       AReg.OpenKey(Ext, False);
  130.       AssocKey := AReg.ReadString('');
  131.       AReg.CloseKey;
  132.       If AReg.OpenKey(AssocKey, False) Then Begin
  133.         Result := AReg.ReadString('');
  134.         Exit;
  135.       End;
  136.     End;
  137.   Finally
  138.     AReg.Free;
  139.   End; //try
  140. End;
  141. Procedure UpdateAssociationPath(Const KeyName, FileName: String);
  142. Var
  143.   AReg: TRegistry;
  144.   s: String;
  145. Begin
  146.   AReg := TRegistry.Create;
  147.   Try
  148.     AReg.RootKey := HKEY_CLASSES_ROOT;
  149.     If AReg.OpenKey(KeyName, False) Then Begin
  150.       If AReg.OpenKey('ShellOpenCommand', False) Then Begin
  151.         s := RemoveParams(AReg.ReadString(''));
  152.         If UpperCase(s) <> UpperCase(FileName) Then
  153.           AReg.WriteString('', '"' + FileName + '" "%1"');
  154.       End;
  155.     End;
  156.   Finally
  157.     AReg.Free;
  158.   End; //try
  159. End;
  160. Function AssociationExists(Ext: String; Var FileName: String): String;
  161. Var
  162.   AReg: TRegistry;
  163.   AssocKey: String;
  164. Begin
  165.   Result := ''; {initialize result to empty string if exception occurrs}
  166.   FileName := '';
  167.   AReg := TRegistry.Create;
  168.   Try
  169.     AReg.RootKey := HKEY_CLASSES_ROOT;
  170.     //Lowercase to avoid trouble
  171.     Ext := LowerCase(Ext);
  172.     //Check if the key (.???) exists
  173.     //  If Pos('.', Ext)=0 then Ext:='.'+Ext;
  174.     If Not AReg.KeyExists(Ext) Then Begin
  175.       Result := '';
  176.     End
  177.     Else Begin
  178.       AReg.OpenKey(Ext, False);
  179.       AssocKey := AReg.ReadString('');
  180.       Result := AssocKey;
  181.       AReg.CloseKey;
  182.       If Not AReg.OpenKey(AssocKey, False) Then Begin
  183.         Result := '';
  184.         Exit;
  185.       End;
  186.       If Not AReg.OpenKey('ShellOpenCommand', False) Then Begin
  187.         Result := AReg.ReadString('');
  188.         Exit;
  189.       End;
  190.       FileName := RemoveParams(AReg.ReadString(''));
  191.     End;
  192.   Finally
  193.     AReg.Free;
  194.   End; //try
  195. End;
  196. //Clears or Removes an Association with or without updating desktop
  197. Function RemoveAssociation(RegKey, Ext: String; RemoveKeyName: Boolean; UpdateSystem: Boolean): Boolean;
  198. Begin
  199.   If RemoveKeyName Then
  200.     Result := DeleteAssociation(RegKey, Ext)
  201.   Else
  202.     Result := ClearAssociation(RegKey, Ext);
  203.   If UpdateSystem Then
  204.     SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar('')); {update system of assocciation change}
  205. End;
  206. Function ClearAssociation(RegKey, Ext: String): Boolean;
  207. Var
  208.   OldKeyName: String;
  209. Begin
  210.   Result := False;
  211.   If Ext = '' Then Exit; {only perform if valid}
  212.   //  If Pos('.', Ext)=0 then Ext:='.'+FExt;
  213.   If DoesKeyExist(RegKey) Then Begin
  214.     OldKeyName := LoadStrFromRegistry(LongInt(HKEY_CLASSES_ROOT), RegKey, //register key
  215.       sOldDefault, //specify the data item
  216.       ''); //default return Value
  217.     SetValInReg(HKEY_CLASSES_ROOT,
  218.       Ext, { extension we want to define }
  219.       '', { specify the default data item }
  220.       OldKeyName); { clear or restore reference to association  }
  221.   End;
  222. End;
  223. Function DeleteAssociation(RegKey, Ext: String): Boolean;
  224. Var
  225.   OldKeyName: String;
  226. Begin
  227.   Result := False; {initialize result}
  228.   If Ext = '' Then Exit; {only perform if not empty}
  229.   //  If Pos('.', Ext)=0 then Ext:='.'+Ext;  {make sure its a extension}
  230.   Ext := LowerCase(Ext);
  231.   If Not DoesKeyExist(Ext) Then Exit; {only perform if registered file extension}
  232.   OldKeyName := GetRegistryStr(LongInt(HKEY_CLASSES_ROOT), Ext, ''); {Get the registered file extension' regKey}
  233.   If OldKeyName <> RegKey Then Exit; {only perform if OldKeyName matches the regKey}
  234.   OldKeyName := LoadStrFromRegistry(LongInt(HKEY_CLASSES_ROOT),
  235.     RegKey, //register key
  236.     sOldDefault, //specify the data item
  237.     ''); //default return Value
  238.   Result := NTDeleteRegKey(LongInt(HKEY_CLASSES_ROOT), Ext); {remove keys and subkeys for extension}
  239.   If Not Result Then Exit; {error occurred get out}
  240.   Result := NTDeleteRegKey(LongInt(HKEY_CLASSES_ROOT), RegKey); {remove keys and subkeys for association}
  241.   If OldKeyName <> '' Then {Restore Old Default association}  Begin
  242.     SetValInReg(HKEY_CLASSES_ROOT,
  243.       Ext, { extension we want to define }
  244.       '', { specify the default data item }
  245.       OldKeyName); { restore reference to association  }
  246.   End;
  247. End;
  248. Function DoesKeyExist(AKey: String): Boolean;
  249. Var
  250.   AReg: TRegistry;
  251. Begin
  252.   AReg := TRegistry.Create;
  253.   Try
  254.     AReg.RootKey := HKEY_CLASSES_ROOT;
  255.     Result := AReg.OpenKey(AKey, False);
  256.   Finally
  257.     AReg.Free;
  258.   End;
  259. End;
  260. Procedure UpdateAssociationToSystem;
  261. Begin
  262.   SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar('')); {update system of assocciation change}
  263. End;
  264. Procedure CreateAssociation(Ext: String; FileName: String;
  265.   DefaultIcon: String; KeyName: String;
  266.   FileType: String; ShowInNew: Boolean);
  267. Begin
  268.   if Not ShowInNew then
  269.       If (Ext = '') Or (KeyName = '') Then Exit;
  270.       //  If Pos('.', Ext)=0 then Ext:='.'+Ext;
  271.       MakeAssociation(Ext, FileName, DefaultIcon, KeyName, FileType, ShowInNew);
  272.   end;
  273.   if ShowInNew then
  274.     SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar('')); {update system of assocciation change}
  275. End;
  276. //Makes association
  277. Procedure MakeAssociation(Ext: String; PgmToLinkTo: String;
  278.   DefaultIcon: String; KeyName: String;
  279.   TypeName: String; ShowInNew: Boolean);
  280. Var
  281.   oldKeyName: String;
  282. Begin
  283.   { ALL extensions must be in lowercase to avoid trouble! }
  284.   Ext := LowerCase(Ext);
  285.   If FileExists(PgmToLinkTo) Then Begin
  286.     OldKeyName := LoadStrFromRegistry(LongInt(HKEY_CLASSES_ROOT),
  287.       Ext, //register key
  288.       '', //specify the default data item
  289.       ''); //default return Value
  290.     SetValInReg(HKEY_CLASSES_ROOT,
  291.       Ext, { extension we want to define }
  292.       '', { specify the default data item }
  293.       KeyName); { This is the value of the default data item -
  294.     this referances our new type to be defined  }
  295.     If ShowInNew Then Begin
  296.       SetValInReg(HKEY_CLASSES_ROOT,
  297.         Ext + 'ShellNew', // you forgot to add the shellnew Almer
  298.         'Nullfile',
  299.         '');
  300.       SetValInReg(HKEY_CLASSES_ROOT,
  301.         KeyName + 'ShellNew', // you forgot to set the key shellnew Also
  302.         '',
  303.         'Nullfile');
  304.     End;
  305.     SetValInReg(HKEY_CLASSES_ROOT,
  306.       KeyName, { this is the type we want to define }
  307.       '', { specify the default data item }
  308.       TypeName); { This is the value of the default data item -
  309.     this is the English description of the file type }
  310. //lxy 2001-9-11    SetValInReg(HKEY_CLASSES_ROOT,
  311. //lxy 2001-9-11      KeyName + 'shellopencommand', { create a file...open key }
  312. //lxy 2001-9-11      '', { specify the default data item }
  313. //lxy 2001-9-11      '"' + PgmToLinkTo + '" "%1"'); { command line to open file with }
  314.     SetValInReg(HKEY_CLASSES_ROOT,                                 //lxy 2001-9-11
  315.       KeyName + 'shellopencommand', { create a file...open key }//lxy 2001-9-11
  316.       '', { specify the default data item }                        //lxy 2001-9-11
  317.       PgmToLinkTo + ' "%1"'); { command line to open file with }   //lxy 2001-9-11
  318.     SetValInReg(HKEY_CLASSES_ROOT,                                 //lxy 2001-9-11
  319.       KeyName + 'DefaultIcon',                                    //lxy 2001-9-11
  320.       '', { specify the default data item }                        //lxy 2001-9-11
  321.       PgmToLinkTo + ',0');                                         //lxy 2001-9-11
  322.     If DefaultIcon <> '' Then
  323.       SetValInReg(HKEY_CLASSES_ROOT,
  324.         KeyName + 'DefaultIcon', '', DefaultIcon);
  325.     If OldKeyName <> '' Then
  326.       SetValInReg(HKEY_CLASSES_ROOT,
  327.         KeyName, sOldDefault, OldKeyName);
  328.   End {of MakeAssociation}
  329.   Else
  330. //    ShowMessage('Error: Program not found: ' + PgmToLinkTo);
  331. //    MessageDlg('Error: Program not found: ' + PgmToLinkTo, mtInformation,[mbOk], 0);
  332.     MessageBox(0,PChar('Error: Program not found: ' + PgmToLinkTo),'提示信息',MB_ICONERROR + MB_OK);
  333. End;
  334. {------------Low Level Functions---------}
  335. Function RemoveParams(Value: String): String;
  336. Var
  337.   i: Integer;
  338. Begin
  339.   Value := UpperCase(Value);
  340.   i := Pos('.EXE', Value);
  341.   If ((i < (Length(Value) - 4)) And (i > 0)) Then
  342.     Result := Copy(Value, 1, i + 3)
  343.   Else
  344.     Result := Value;
  345.   If Result[1] = '"' Then Delete(Result, 1, 1);
  346. End;
  347. //  Writen by Dale (stryder) Clarke
  348. // This function sets the default value of the key to a string.
  349. Procedure ChangeRegistryStr(mainKey: LongInt; AKey: String; AValue: String);
  350. Var
  351.   szKey, SzValue: PChar;
  352. Begin
  353.   szKey := StrAlloc(Length(AKey) + 1);
  354.   SzValue := StrAlloc(Length(AValue) + 1);
  355.   StrPCopy(szKey, AKey);
  356.   StrPCopy(SzValue, AValue);
  357.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  358.   StrDispose(szKey);
  359.   StrDispose(SzValue);
  360. End;
  361. //  Writen by Dale (stryder) Clarke
  362. // This function sets the default value of the key to a boolean.
  363. Procedure ChangeRegistryBool(mainKey: LongInt; AKey: String; AValue: Boolean);
  364. Var
  365.   szKey, SzValue: PChar;
  366.   BoolStr: String;
  367. Begin
  368.   If AValue = True Then
  369.     BoolStr := 'TRUE'
  370.   Else
  371.     BoolStr := 'FALSE';
  372.   szKey := StrAlloc(Length(AKey) + 1);
  373.   SzValue := StrAlloc(Length(BoolStr) + 1);
  374.   StrPCopy(szKey, AKey);
  375.   StrPCopy(SzValue, BoolStr);
  376.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  377.   StrDispose(szKey);
  378.   StrDispose(SzValue);
  379. End;
  380. //  Writen by Dale (stryder) Clarke
  381. // This function sets the default value of the key to a integer.
  382. Procedure ChangeRegistryInt(mainKey: LongInt; AKey: String; AValue: LongInt);
  383. Var
  384.   szKey, SzValue: PChar;
  385.   IntegerStr: String;
  386. Begin
  387.   IntegerStr := IntToStr(AValue);
  388.   szKey := StrAlloc(Length(AKey) + 1);
  389.   SzValue := StrAlloc(Length(IntegerStr) + 1);
  390.   StrPCopy(szKey, AKey);
  391.   StrPCopy(SzValue, IntegerStr);
  392.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  393.   StrDispose(szKey);
  394.   StrDispose(SzValue);
  395. End;
  396. //  Writen by Dale (stryder) Clarke
  397. // This function returns a string value for the given key if the key does not exist
  398. // the key will be created with the default value.
  399. Function GetRegistryStr(MainKey: LongInt; AKey: String; Default: String): String;
  400. Var
  401.   szKey, SzValue: PChar;
  402.   nRet, NSize: LongInt;
  403. Begin
  404.   szKey := StrAlloc(Length(AKey) + 1);
  405.   SzValue := StrAlloc(1000);
  406.   StrPCopy(szKey, AKey);
  407.   StrPCopy(SzValue, '');
  408.   NSize := 1000;
  409.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  410.   If (nRet = ERROR_SUCCESS) Then
  411.     Result := StrPas(SzValue)
  412.   Else
  413.     Result := Default;
  414.   StrDispose(szKey);
  415.   StrDispose(SzValue);
  416. End;
  417. //  Writen by Dale (stryder) Clarke
  418. // This function returns a boolean value for the given key if the key does not exist
  419. // the key will be created with the default value.
  420. Function GetRegistryBool(MainKey: LongInt; AKey: String; Default: Boolean): Boolean;
  421. Var
  422.   BoolStr: String;
  423.   szKey, SzValue: PChar;
  424.   nRet, NSize: LongInt;
  425. Begin
  426.   If Default = True Then
  427.     BoolStr := 'TRUE'
  428.   Else
  429.     BoolStr := 'FALSE';
  430.   szKey := StrAlloc(Length(AKey) + 1);
  431.   SzValue := StrAlloc(1000);
  432.   StrPCopy(szKey, AKey);
  433.   StrPCopy(SzValue, BoolStr);
  434.   NSize := 1000;
  435.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  436.   If (nRet = ERROR_SUCCESS) Then Begin
  437.     BoolStr := StrPas(SzValue);
  438.     If BoolStr = 'TRUE' Then
  439.       Result := True
  440.     Else
  441.       Result := False;
  442.   End
  443.   Else
  444.     Result := Default;
  445.   StrDispose(szKey);
  446.   StrDispose(SzValue);
  447. End;
  448. //  Writen by Dale (stryder) Clarke
  449. // This function returns a integer value for the given key if the key does not exist
  450. // the key will be created with the default value.
  451. Function GetRegistryInt(MainKey: LongInt; AKey: String; Default: Integer): Integer;
  452. Var
  453.   szKey, SzValue: PChar;
  454.   AString: String;
  455.   nRet, NSize: LongInt;
  456. Begin
  457.   szKey := StrAlloc(Length(AKey) + 1);
  458.   SzValue := StrAlloc(32);
  459.   StrPCopy(szKey, AKey);
  460.   NSize := 32;
  461.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  462.   AString := StrPas(SzValue);
  463.   StrDispose(szKey);
  464.   StrDispose(SzValue);
  465.   If (nRet = ERROR_SUCCESS) Then
  466.     GetRegistryInt := StrToInt(AString)
  467.   Else
  468.     GetRegistryInt := Default;
  469. End;
  470. //  Writen by Dale (stryder) Clarke
  471. // This function returns a stringlist of names of a valid
  472. // registration key. You can yous this to recursivly look for
  473. // more subkeys. Remember to always pass a initialized stringlist
  474. // and to free it yourself.
  475. Function GetRegSubTree(MainKey: LongInt; AKey, AValue: String;
  476.   Const AList: TStrings): Boolean;
  477. Var
  478.   hRoot: HKey;
  479.   lItem: LongInt;
  480.   hError: LongInt;
  481.   szKey, Pdata: PChar;
  482.   //  aString        : String;
  483. Begin
  484.   GetRegSubTree := False;
  485.   If AList = Nil Then Exit;
  486.   {create pointers for the API}
  487.   szKey := StrAlloc(Length(AKey) + 1);
  488.   try
  489.     StrPCopy(szKey, AKey);
  490.     lItem := 0;
  491.     Pdata := StrAlloc(1024);
  492.     try
  493.       hError := RegOpenKey(MainKey, szKey, hRoot);
  494.       If hError = ERROR_SUCCESS Then Begin
  495.         While (hError = ERROR_SUCCESS) Do Begin
  496.           hError := RegEnumKey(hRoot, lItem, Pdata, 1024);
  497.           If (hError = ERROR_SUCCESS) Then Begin
  498.             GetRegSubTree := True;
  499.             Inc(lItem);
  500.             If (AValue <> '') And (AnsiPos(UpperCase(AValue), UpperCase(Pdata)) = 0) Then
  501.               Continue; //no match, skip, don't add to list.
  502.             AList.Add(StrPas(Pdata));
  503.           End;
  504.         End;
  505.         RegCloseKey(hRoot);
  506.       End;
  507.     finally
  508.       StrDispose(Pdata);
  509.     end;
  510.   finally
  511.     StrDispose(szKey);
  512.   end;
  513. End;
  514. //  Writen by Dale (stryder) Clarke
  515. //  On Win 95 this removes all subkeys but on NT the key is
  516. //  only removed if it has NO subkeys.  So always call NTDeleteRegKey
  517. //  so if this fails it will recursively remove the keys.
  518. Function DeleteRegKey(MainKey: LongInt; AKey: String): Boolean;
  519. Var
  520.   szKey: PChar;
  521. Begin
  522.   {RegDeletKey API wants a pointer}
  523.   szKey := StrAlloc(Length(AKey) + 1);
  524.   StrPCopy(szKey, AKey);
  525.   // Let windows remove the subkey's safely by bypassing VCL
  526.   // This call is exported in the winreg unit to a call to the ADVAPI.DLL
  527.   // I have never encounter a exception here but better safe than sorry.
  528.   // Mickey may change the API (as if they've done that before)
  529.   Try
  530.     Result := (RegDeleteKey(MainKey, szKey) = ERROR_SUCCESS);
  531.   Finally
  532.     StrDispose(szKey); {make sure pointer is free when exit}
  533.   End;
  534. End;
  535. //  Writen by Dale (stryder) Clarke
  536. //  This function is extreemly dangerous. The key specified and all subkeys WILL be removed.
  537. //  Especially DO NOT pass the string SOFTWARE or anyother important registry root folder.
  538. //  On NT RegDeleteKey will not remove a key if it has subkeys.
  539. //  This function will remove all sukeys on NT
  540. Function NTDeleteRegKey(MainKey: LongInt; Const AKey: String): Boolean;
  541. Var
  542.   AList: TStringList;
  543.   s: String;
  544.   i: Integer;
  545. Begin
  546.   AList := TStringList.Create;
  547.   Result := False;
  548.   Try
  549.     s := AKey;
  550.     If GetRegSubTree(MainKey, AKey, '', AList) Then {check for subkeys}  Begin
  551.       For i := 0 To AList.Count - 1 Do Begin
  552.         NTDeleteRegKey(MainKey, s + '' + AList[i]); {recurse to look for more subkeys}
  553.         Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
  554.       End;
  555.     End Else Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
  556.   Finally
  557.     AList.Free;
  558.   End;
  559. End;
  560. //  Writen by Dale (stryder) Clarke
  561. // This function saves a string to a registry key.
  562. Function SaveIntToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Boolean;
  563. Var
  564.   RegVar: TRegistry;
  565. Begin
  566.   Result := False;
  567.   RegVar := TRegistry.Create;
  568.   RegVar.RootKey := MainKey;
  569.   Try
  570.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  571.       RegVar.WriteInteger(AItem, AValue);
  572.       Result := True;
  573.     End;
  574.   Finally
  575.     RegVar.Free;
  576.   End;
  577. End;
  578. //  Writen by Dale (stryder) Clarke
  579. // This function returns a integer from a registry key.
  580. Function LoadIntFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Integer;
  581. Var
  582.   RegVar: TRegistry;
  583. Begin
  584.   Result := AValue;
  585.   RegVar := TRegistry.Create;
  586.   RegVar.RootKey := MainKey;
  587.   Try
  588.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  589.       If RegVar.ValueExists(AItem) Then Begin
  590.         Result := RegVar.ReadInteger(AItem);
  591.       End;
  592.     End;
  593.   Finally
  594.     RegVar.Free;
  595.   End;
  596. End;
  597. //  Writen by Dale (stryder) Clarke
  598. // This function saves a string to a registry key.
  599. Function SaveStrToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): Boolean;
  600. Var
  601.   RegVar: TRegistry;
  602. Begin
  603.   Result := False;
  604.   RegVar := TRegistry.Create;
  605.   RegVar.RootKey := MainKey;
  606.   Try
  607.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  608.       RegVar.WriteString(AItem, AValue);
  609.       Result := True;
  610.     End;
  611.   Finally
  612.     RegVar.Free;
  613.   End;
  614. End;
  615. //  Writen by Dale (stryder) Clarke
  616. // This function returs a string from a registry key.
  617. Function LoadStrFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): String;
  618. Var
  619.   RegVar: TRegistry;
  620. Begin
  621.   Result := AValue;
  622.   RegVar := TRegistry.Create;
  623.   RegVar.RootKey := MainKey;
  624.   Try
  625.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  626.       If RegVar.ValueExists(AItem) Then Begin
  627.         Result := RegVar.ReadString(AItem);
  628.       End;
  629.     End;
  630.   Finally
  631.     RegVar.Free;
  632.   End;
  633. End;
  634. //  Writen by Dale (stryder) Clarke
  635. // This function saves a boolean to a registry key.
  636. Function SaveBoolToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  637. Var
  638.   RegVar: TRegistry;
  639. Begin
  640.   Result := False;
  641.   RegVar := TRegistry.Create;
  642.   RegVar.RootKey := MainKey;
  643.   Try
  644.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  645.       RegVar.WriteBool(AItem, AValue);
  646.       Result := True;
  647.     End;
  648.   Finally
  649.     RegVar.Free;
  650.   End;
  651. End;
  652. //  Writen by Dale (stryder) Clarke
  653. // This function returns a boolean from a registry key.
  654. Function LoadBoolFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  655. Var
  656.   RegVar: TRegistry;
  657. Begin
  658.   Result := AValue;
  659.   RegVar := TRegistry.Create;
  660.   RegVar.RootKey := MainKey;
  661.   Try
  662.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  663.       If RegVar.ValueExists(AItem) Then Begin
  664.         Result := RegVar.ReadBool(AItem);
  665.       End;
  666.     End;
  667.   Finally
  668.     RegVar.Free;
  669.   End;
  670. End;
  671. Initialization
  672. Finalization
  673. End.