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.   begin
  270.       If (Ext = '') Or (KeyName = '') Then Exit;
  271.       //  If Pos('.', Ext)=0 then Ext:='.'+Ext;
  272.       MakeAssociation(Ext, FileName, DefaultIcon, KeyName, FileType, ShowInNew);
  273.   end;
  274.   if ShowInNew then
  275.     SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSH, PChar(''), PChar('')); {update system of assocciation change}
  276. End;
  277. //Makes association
  278. Procedure MakeAssociation(Ext: String; PgmToLinkTo: String;
  279.   DefaultIcon: String; KeyName: String;
  280.   TypeName: String; ShowInNew: Boolean);
  281. Var
  282.   oldKeyName: String;
  283. Begin
  284.   { ALL extensions must be in lowercase to avoid trouble! }
  285.   Ext := LowerCase(Ext);
  286.   If FileExists(PgmToLinkTo) Then Begin
  287.     OldKeyName := LoadStrFromRegistry(LongInt(HKEY_CLASSES_ROOT),
  288.       Ext, //register key
  289.       '', //specify the default data item
  290.       ''); //default return Value
  291.     SetValInReg(HKEY_CLASSES_ROOT,
  292.       Ext, { extension we want to define }
  293.       '', { specify the default data item }
  294.       KeyName); { This is the value of the default data item -
  295.     this referances our new type to be defined  }
  296.     If ShowInNew Then Begin
  297.       SetValInReg(HKEY_CLASSES_ROOT,
  298.         Ext + 'ShellNew', // you forgot to add the shellnew Almer
  299.         'Nullfile',
  300.         '');
  301.       SetValInReg(HKEY_CLASSES_ROOT,
  302.         KeyName + 'ShellNew', // you forgot to set the key shellnew Also
  303.         '',
  304.         'Nullfile');
  305.     End;
  306.     SetValInReg(HKEY_CLASSES_ROOT,
  307.       KeyName, { this is the type we want to define }
  308.       '', { specify the default data item }
  309.       TypeName); { This is the value of the default data item -
  310.     this is the English description of the file type }
  311. //lxy 2001-9-11    SetValInReg(HKEY_CLASSES_ROOT,
  312. //lxy 2001-9-11      KeyName + 'shellopencommand', { create a file...open key }
  313. //lxy 2001-9-11      '', { specify the default data item }
  314. //lxy 2001-9-11      '"' + PgmToLinkTo + '" "%1"'); { command line to open file with }
  315.     SetValInReg(HKEY_CLASSES_ROOT,                                 //lxy 2001-9-11
  316.       KeyName + 'shellopencommand', { create a file...open key }//lxy 2001-9-11
  317.       '', { specify the default data item }                        //lxy 2001-9-11
  318.       PgmToLinkTo + ' "%1"'); { command line to open file with }   //lxy 2001-9-11
  319.     SetValInReg(HKEY_CLASSES_ROOT,                                 //lxy 2001-9-11
  320.       KeyName + 'DefaultIcon',                                    //lxy 2001-9-11
  321.       '', { specify the default data item }                        //lxy 2001-9-11
  322.       PgmToLinkTo + ',0');                                         //lxy 2001-9-11
  323.     If DefaultIcon <> '' Then
  324.       SetValInReg(HKEY_CLASSES_ROOT,
  325.         KeyName + 'DefaultIcon', '', DefaultIcon);
  326.     If OldKeyName <> '' Then
  327.       SetValInReg(HKEY_CLASSES_ROOT,
  328.         KeyName, sOldDefault, OldKeyName);
  329.   End {of MakeAssociation}
  330.   Else
  331. //    ShowMessage('Error: Program not found: ' + PgmToLinkTo);
  332. //    MessageDlg('Error: Program not found: ' + PgmToLinkTo, mtInformation,[mbOk], 0);
  333.     MessageBox(0,PChar('Error: Program not found: ' + PgmToLinkTo),'提示信息',MB_ICONERROR + MB_OK);
  334. End;
  335. {------------Low Level Functions---------}
  336. Function RemoveParams(Value: String): String;
  337. Var
  338.   i: Integer;
  339. Begin
  340.   Value := UpperCase(Value);
  341.   i := Pos('.EXE', Value);
  342.   If ((i < (Length(Value) - 4)) And (i > 0)) Then
  343.     Result := Copy(Value, 1, i + 3)
  344.   Else
  345.     Result := Value;
  346.   If Result[1] = '"' Then Delete(Result, 1, 1);
  347. End;
  348. //  Writen by Dale (stryder) Clarke
  349. // This function sets the default value of the key to a string.
  350. Procedure ChangeRegistryStr(mainKey: LongInt; AKey: String; AValue: String);
  351. Var
  352.   szKey, SzValue: PChar;
  353. Begin
  354.   szKey := StrAlloc(Length(AKey) + 1);
  355.   SzValue := StrAlloc(Length(AValue) + 1);
  356.   StrPCopy(szKey, AKey);
  357.   StrPCopy(SzValue, AValue);
  358.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  359.   StrDispose(szKey);
  360.   StrDispose(SzValue);
  361. End;
  362. //  Writen by Dale (stryder) Clarke
  363. // This function sets the default value of the key to a boolean.
  364. Procedure ChangeRegistryBool(mainKey: LongInt; AKey: String; AValue: Boolean);
  365. Var
  366.   szKey, SzValue: PChar;
  367.   BoolStr: String;
  368. Begin
  369.   If AValue = True Then
  370.     BoolStr := 'TRUE'
  371.   Else
  372.     BoolStr := 'FALSE';
  373.   szKey := StrAlloc(Length(AKey) + 1);
  374.   SzValue := StrAlloc(Length(BoolStr) + 1);
  375.   StrPCopy(szKey, AKey);
  376.   StrPCopy(SzValue, BoolStr);
  377.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  378.   StrDispose(szKey);
  379.   StrDispose(SzValue);
  380. End;
  381. //  Writen by Dale (stryder) Clarke
  382. // This function sets the default value of the key to a integer.
  383. Procedure ChangeRegistryInt(mainKey: LongInt; AKey: String; AValue: LongInt);
  384. Var
  385.   szKey, SzValue: PChar;
  386.   IntegerStr: String;
  387. Begin
  388.   IntegerStr := IntToStr(AValue);
  389.   szKey := StrAlloc(Length(AKey) + 1);
  390.   SzValue := StrAlloc(Length(IntegerStr) + 1);
  391.   StrPCopy(szKey, AKey);
  392.   StrPCopy(SzValue, IntegerStr);
  393.   RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  394.   StrDispose(szKey);
  395.   StrDispose(SzValue);
  396. End;
  397. //  Writen by Dale (stryder) Clarke
  398. // This function returns a string value for the given key if the key does not exist
  399. // the key will be created with the default value.
  400. Function GetRegistryStr(MainKey: LongInt; AKey: String; Default: String): String;
  401. Var
  402.   szKey, SzValue: PChar;
  403.   nRet, NSize: LongInt;
  404. Begin
  405.   szKey := StrAlloc(Length(AKey) + 1);
  406.   SzValue := StrAlloc(1000);
  407.   StrPCopy(szKey, AKey);
  408.   StrPCopy(SzValue, '');
  409.   NSize := 1000;
  410.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  411.   If (nRet = ERROR_SUCCESS) Then
  412.     Result := StrPas(SzValue)
  413.   Else
  414.     Result := Default;
  415.   StrDispose(szKey);
  416.   StrDispose(SzValue);
  417. End;
  418. //  Writen by Dale (stryder) Clarke
  419. // This function returns a boolean value for the given key if the key does not exist
  420. // the key will be created with the default value.
  421. Function GetRegistryBool(MainKey: LongInt; AKey: String; Default: Boolean): Boolean;
  422. Var
  423.   BoolStr: String;
  424.   szKey, SzValue: PChar;
  425.   nRet, NSize: LongInt;
  426. Begin
  427.   If Default = True Then
  428.     BoolStr := 'TRUE'
  429.   Else
  430.     BoolStr := 'FALSE';
  431.   szKey := StrAlloc(Length(AKey) + 1);
  432.   SzValue := StrAlloc(1000);
  433.   StrPCopy(szKey, AKey);
  434.   StrPCopy(SzValue, BoolStr);
  435.   NSize := 1000;
  436.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  437.   If (nRet = ERROR_SUCCESS) Then Begin
  438.     BoolStr := StrPas(SzValue);
  439.     If BoolStr = 'TRUE' Then
  440.       Result := True
  441.     Else
  442.       Result := False;
  443.   End
  444.   Else
  445.     Result := Default;
  446.   StrDispose(szKey);
  447.   StrDispose(SzValue);
  448. End;
  449. //  Writen by Dale (stryder) Clarke
  450. // This function returns a integer value for the given key if the key does not exist
  451. // the key will be created with the default value.
  452. Function GetRegistryInt(MainKey: LongInt; AKey: String; Default: Integer): Integer;
  453. Var
  454.   szKey, SzValue: PChar;
  455.   AString: String;
  456.   nRet, NSize: LongInt;
  457. Begin
  458.   szKey := StrAlloc(Length(AKey) + 1);
  459.   SzValue := StrAlloc(32);
  460.   StrPCopy(szKey, AKey);
  461.   NSize := 32;
  462.   nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  463.   AString := StrPas(SzValue);
  464.   StrDispose(szKey);
  465.   StrDispose(SzValue);
  466.   If (nRet = ERROR_SUCCESS) Then
  467.     GetRegistryInt := StrToInt(AString)
  468.   Else
  469.     GetRegistryInt := Default;
  470. End;
  471. //  Writen by Dale (stryder) Clarke
  472. // This function returns a stringlist of names of a valid
  473. // registration key. You can yous this to recursivly look for
  474. // more subkeys. Remember to always pass a initialized stringlist
  475. // and to free it yourself.
  476. Function GetRegSubTree(MainKey: LongInt; AKey, AValue: String;
  477.   Const AList: TStrings): Boolean;
  478. Var
  479.   hRoot: HKey;
  480.   lItem: LongInt;
  481.   hError: LongInt;
  482.   szKey, Pdata: PChar;
  483.   //  aString        : String;
  484. Begin
  485.   GetRegSubTree := False;
  486.   If AList = Nil Then Exit;
  487.   {create pointers for the API}
  488.   szKey := StrAlloc(Length(AKey) + 1);
  489.   try
  490.     StrPCopy(szKey, AKey);
  491.     lItem := 0;
  492.     Pdata := StrAlloc(1024);
  493.     try
  494.       hError := RegOpenKey(MainKey, szKey, hRoot);
  495.       If hError = ERROR_SUCCESS Then Begin
  496.         While (hError = ERROR_SUCCESS) Do Begin
  497.           hError := RegEnumKey(hRoot, lItem, Pdata, 1024);
  498.           If (hError = ERROR_SUCCESS) Then Begin
  499.             GetRegSubTree := True;
  500.             Inc(lItem);
  501.             If (AValue <> '') And (AnsiPos(UpperCase(AValue), UpperCase(Pdata)) = 0) Then
  502.               Continue; //no match, skip, don't add to list.
  503.             AList.Add(StrPas(Pdata));
  504.           End;
  505.         End;
  506.         RegCloseKey(hRoot);
  507.       End;
  508.     finally
  509.       StrDispose(Pdata);
  510.     end;
  511.   finally
  512.     StrDispose(szKey);
  513.   end;
  514. End;
  515. //  Writen by Dale (stryder) Clarke
  516. //  On Win 95 this removes all subkeys but on NT the key is
  517. //  only removed if it has NO subkeys.  So always call NTDeleteRegKey
  518. //  so if this fails it will recursively remove the keys.
  519. Function DeleteRegKey(MainKey: LongInt; AKey: String): Boolean;
  520. Var
  521.   szKey: PChar;
  522. Begin
  523.   {RegDeletKey API wants a pointer}
  524.   szKey := StrAlloc(Length(AKey) + 1);
  525.   StrPCopy(szKey, AKey);
  526.   // Let windows remove the subkey's safely by bypassing VCL
  527.   // This call is exported in the winreg unit to a call to the ADVAPI.DLL
  528.   // I have never encounter a exception here but better safe than sorry.
  529.   // Mickey may change the API (as if they've done that before)
  530.   Try
  531.     Result := (RegDeleteKey(MainKey, szKey) = ERROR_SUCCESS);
  532.   Finally
  533.     StrDispose(szKey); {make sure pointer is free when exit}
  534.   End;
  535. End;
  536. //  Writen by Dale (stryder) Clarke
  537. //  This function is extreemly dangerous. The key specified and all subkeys WILL be removed.
  538. //  Especially DO NOT pass the string SOFTWARE or anyother important registry root folder.
  539. //  On NT RegDeleteKey will not remove a key if it has subkeys.
  540. //  This function will remove all sukeys on NT
  541. Function NTDeleteRegKey(MainKey: LongInt; Const AKey: String): Boolean;
  542. Var
  543.   AList: TStringList;
  544.   s: String;
  545.   i: Integer;
  546. Begin
  547.   AList := TStringList.Create;
  548.   Result := False;
  549.   Try
  550.     s := AKey;
  551.     If GetRegSubTree(MainKey, AKey, '', AList) Then {check for subkeys}  Begin
  552.       For i := 0 To AList.Count - 1 Do Begin
  553.         NTDeleteRegKey(MainKey, s + '' + AList[i]); {recurse to look for more subkeys}
  554.         Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
  555.       End;
  556.     End Else Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
  557.   Finally
  558.     AList.Free;
  559.   End;
  560. End;
  561. //  Writen by Dale (stryder) Clarke
  562. // This function saves a string to a registry key.
  563. Function SaveIntToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Boolean;
  564. Var
  565.   RegVar: TRegistry;
  566. Begin
  567.   Result := False;
  568.   RegVar := TRegistry.Create;
  569.   RegVar.RootKey := MainKey;
  570.   Try
  571.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  572.       RegVar.WriteInteger(AItem, AValue);
  573.       Result := True;
  574.     End;
  575.   Finally
  576.     RegVar.Free;
  577.   End;
  578. End;
  579. //  Writen by Dale (stryder) Clarke
  580. // This function returns a integer from a registry key.
  581. Function LoadIntFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Integer;
  582. Var
  583.   RegVar: TRegistry;
  584. Begin
  585.   Result := AValue;
  586.   RegVar := TRegistry.Create;
  587.   RegVar.RootKey := MainKey;
  588.   Try
  589.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  590.       If RegVar.ValueExists(AItem) Then Begin
  591.         Result := RegVar.ReadInteger(AItem);
  592.       End;
  593.     End;
  594.   Finally
  595.     RegVar.Free;
  596.   End;
  597. End;
  598. //  Writen by Dale (stryder) Clarke
  599. // This function saves a string to a registry key.
  600. Function SaveStrToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): Boolean;
  601. Var
  602.   RegVar: TRegistry;
  603. Begin
  604.   Result := False;
  605.   RegVar := TRegistry.Create;
  606.   RegVar.RootKey := MainKey;
  607.   Try
  608.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  609.       RegVar.WriteString(AItem, AValue);
  610.       Result := True;
  611.     End;
  612.   Finally
  613.     RegVar.Free;
  614.   End;
  615. End;
  616. //  Writen by Dale (stryder) Clarke
  617. // This function returs a string from a registry key.
  618. Function LoadStrFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): String;
  619. Var
  620.   RegVar: TRegistry;
  621. Begin
  622.   Result := AValue;
  623.   RegVar := TRegistry.Create;
  624.   RegVar.RootKey := MainKey;
  625.   Try
  626.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  627.       If RegVar.ValueExists(AItem) Then Begin
  628.         Result := RegVar.ReadString(AItem);
  629.       End;
  630.     End;
  631.   Finally
  632.     RegVar.Free;
  633.   End;
  634. End;
  635. //  Writen by Dale (stryder) Clarke
  636. // This function saves a boolean to a registry key.
  637. Function SaveBoolToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  638. Var
  639.   RegVar: TRegistry;
  640. Begin
  641.   Result := False;
  642.   RegVar := TRegistry.Create;
  643.   RegVar.RootKey := MainKey;
  644.   Try
  645.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  646.       RegVar.WriteBool(AItem, AValue);
  647.       Result := True;
  648.     End;
  649.   Finally
  650.     RegVar.Free;
  651.   End;
  652. End;
  653. //  Writen by Dale (stryder) Clarke
  654. // This function returns a boolean from a registry key.
  655. Function LoadBoolFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
  656. Var
  657.   RegVar: TRegistry;
  658. Begin
  659.   Result := AValue;
  660.   RegVar := TRegistry.Create;
  661.   RegVar.RootKey := MainKey;
  662.   Try
  663.     If RegVar.OpenKey(RegistryKey, True) Then Begin
  664.       If RegVar.ValueExists(AItem) Then Begin
  665.         Result := RegVar.ReadBool(AItem);
  666.       End;
  667.     End;
  668.   Finally
  669.     RegVar.Free;
  670.   End;
  671. End;
  672. Initialization
  673. Finalization
  674. End.