Reg.pas
上传用户:sinothink
上传日期:2022-07-15
资源大小:459k
文件大小:6k
源码类别:

远程控制编程

开发平台:

Delphi

  1. unit Reg;
  2. interface
  3. uses windows;
  4. type
  5.   TFun=function(name:string):boolean;
  6. procedure AddValue(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar;
  7.   DataType: integer);
  8. procedure AddValue2(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar);
  9. procedure DelValue(Root: HKEY; StrPath: pchar; StrValue: pchar);
  10. procedure DelSub(Root: HKEY; StrPath: pchar; StrSub: pchar);
  11. function ReadValue(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
  12. function ReadValueBinary(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
  13. function ValueExists(Root: HKEY; StrPath: pchar; StrValue: pchar): Boolean;
  14. function KeyExists(Root: HKEY; StrPath: pchar; StrSub: pchar): Boolean;
  15. function GetValueName(Root: HKEY; StrPath: pchar; var Str: string): integer;
  16. function GetKeyName(Root: HKEY; StrPath: pchar; var Str: string): integer;
  17. procedure GetKeyName2(Root: HKEY; StrPath: pchar; fun:TFun);
  18. implementation
  19. function CreateKey(Root: HKEY; StrPath: pchar): Hkey;
  20. var
  21.   TempKey: HKey;
  22.   Disposition: Integer;
  23. begin
  24.   TempKey := 0;
  25.   RegCreateKeyEx(Root, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey,
  26.     @Disposition);
  27.   Result := TempKey;
  28. end;
  29. function OpenKey(Root: HKEY; StrPath: pchar): Hkey;
  30. var
  31.   TempKey: Hkey;
  32. begin
  33.   TempKey := 0;
  34.   RegOpenKeyEx(Root, StrPath, 0, KEY_ALL_ACCESS, TempKey);
  35.   Result := TempKey;
  36. end;
  37. procedure AddValue(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar;
  38.   DataType: integer);
  39. var
  40.   s: Hkey;
  41. begin
  42.   s := CreateKey(Root, StrPath);
  43.   RegSetValueEx(s, StrValue, 0, REG_SZ, Strdata, sizeof(Strdata));
  44.   RegCloseKey(s);
  45. end;
  46. function StrLen(const Str: PChar): Cardinal; assembler;
  47. asm
  48.         MOV     EDX,EDI
  49.         MOV     EDI,EAX
  50.         MOV     ECX,0FFFFFFFFH
  51.         XOR     AL,AL
  52.         REPNE   SCASB
  53.         MOV     EAX,0FFFFFFFEH
  54.         SUB     EAX,ECX
  55.         MOV     EDI,EDX
  56. end;
  57. procedure AddValue2(Root: HKEY; StrPath: pchar; StrValue: pchar; Strdata: pchar);
  58. var
  59.   s: Hkey;
  60. begin
  61.   s := CreateKey(Root, StrPath);
  62.   RegSetValueEx(s, StrValue, 0, REG_SZ, Strdata, strlen(Strdata));
  63.   RegCloseKey(s);
  64. end;
  65. procedure DelValue(Root: HKEY; StrPath: pchar; StrValue: pchar);
  66. var
  67.   s: Hkey;
  68. begin
  69.   s := OpenKey(Root, StrPath);
  70.   RegDeleteValue(s, StrValue);
  71.   RegCloseKey(s);
  72. end;
  73. procedure DelSub(Root: HKEY; StrPath: pchar; StrSub: pchar);
  74. var
  75.   s: Hkey;
  76. begin
  77.   s := OpenKey(Root, StrPath);
  78.   RegDeleteKey(s, StrSub);
  79.   RegCloseKey(s);
  80. end;
  81. function ReadValue(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
  82. var
  83.   s: Hkey;
  84.   ValueType: DWORD;
  85.   MyData: array[0..255] of char;
  86.   dLength: DWORD;
  87. begin
  88.   ValueType := REG_SZ;
  89.   s := OpenKey(Root, StrPath);
  90.   dLength := SizeOf(MyData);
  91.   if RegQueryValueEx(s, StrValue, nil, @ValueType, @MyData[0], @dLength) = 0
  92.     then
  93.   begin
  94.     Result := MyData;
  95.     RegCloseKey(s);
  96.   end
  97.   else
  98.   begin
  99.     Result := '';
  100.     RegCloseKey(s);
  101.   end;
  102. end;
  103. function ReadValueBinary(Root: HKEY; StrPath: pchar; StrValue: pchar): string;
  104. const
  105.   size=255;
  106. var
  107.   s: Hkey;
  108.   ValueType: DWORD;
  109.   dLength: DWORD;
  110. begin
  111.   ValueType := REG_BINARY;
  112.   s := OpenKey(Root, StrPath);
  113.   Setlength(Result,size);
  114.   dLength := size;
  115.   if RegQueryValueEx(s, StrValue, nil, @ValueType, @result[1], @dLength) = 0
  116.     then
  117.   begin
  118.     Setlength(result,dLength);
  119.     RegCloseKey(s);
  120.   end
  121.   else
  122.   begin
  123.     Result := '';
  124.     RegCloseKey(s);
  125.   end;
  126. end;
  127. function ValueExists(Root: HKEY; StrPath: pchar; StrValue: pchar): Boolean;
  128. var
  129.   s: Hkey;
  130.   ValueType: DWORD;
  131. begin
  132.   ValueType := REG_SZ;
  133.   s := OpenKey(Root, StrPath);
  134.   Result := RegQueryValueEx(s, StrValue, nil, @ValueType, nil, nil) = 0;
  135.   RegCloseKey(s);
  136. end;
  137. function KeyExists(Root: HKEY; StrPath: pchar; StrSub: pchar): Boolean;
  138. var
  139.   s: Hkey;
  140.   Str: string;
  141. begin
  142.   if StrPath <> nil then
  143.     Str := Strpath + '' + StrSub
  144.   else
  145.     Str := StrSub;
  146.   s := OpenKey(Root, pchar(Str));
  147.   Result := s <> 0;
  148.   if s <> 0 then
  149.     RegCloseKey(s);
  150. end;
  151. function GetValueName(Root: HKEY; StrPath: pchar; var Str: string): integer;
  152. var
  153.   s: Hkey;
  154.   Count: integer;
  155.   ValueName: array[0..100] of char;
  156.   BufSize, dType, dLength: DWORD;
  157.   IData: array[0..255] of char;
  158. begin
  159.   str:='';
  160.   Count := 0;
  161.   BufSize := 100;
  162.   dLength := 254;
  163.   s := OpenKey(Root, StrPath);
  164.   if s <> 0 then
  165.   begin
  166.     while RegEnumValue(s, Count, @ValueName[0], BufSize, nil, @dType, @iData,
  167.       @dLength) = 0 do
  168.     begin
  169.       BufSize := 100;
  170.       dLength := 254;
  171.       Str := Str + ValueName + ',';
  172.       Count := Count + 1;
  173.     end;
  174.     RegCloseKey(s);
  175.   end;
  176.   if copy(Str, 1, 1) = ',' then
  177.     delete(Str, 1, 1);
  178.   if copy(Str, Length(str), 1) = ',' then
  179.     delete(Str, Length(str), 1);
  180.   Result := Count;
  181. end;
  182. function GetKeyName(Root: HKEY; StrPath: pchar; var Str: string): integer;
  183. const
  184.   size=255;
  185. var
  186.   s: Hkey;
  187.   Count: integer;
  188.   BufSize: DWORD;
  189.   ValueName: array[0..size-1] of char;
  190. begin
  191.   str:='';
  192.   Count := 0;
  193.   BufSize := size;
  194.   s := OpenKey(Root, StrPath);
  195.   if s <> 0 then
  196.   begin
  197.     while RegEnumKeyEx(s, Count, @ValueName[0], BufSize, nil, nil, nil, nil) = 0 do
  198.     begin
  199.       BufSize := size;
  200.       Str := Str + ValueName + ',';
  201.       Count := Count + 1;
  202.     end;
  203.     RegCloseKey(s);
  204.   end;
  205.   if copy(Str, Length(str), 1) = ',' then
  206.     delete(Str, Length(str), 1);
  207.   Result := Count;
  208. end;
  209. procedure GetKeyName2(Root: HKEY; StrPath: pchar; fun:TFun);
  210. const
  211.   size=255;
  212. var
  213.   s: Hkey;
  214.   Count: integer;
  215.   BufSize: DWORD;
  216.   ValueName: array[0..size-1] of char;
  217. begin
  218.   Count := 0;
  219.   BufSize := size;
  220.   s := OpenKey(Root, StrPath);
  221.   if s <> 0 then
  222.   begin
  223.     while RegEnumKeyEx(s, Count, @ValueName[0], BufSize, nil, nil, nil, nil) = 0 do
  224.     begin
  225.       BufSize := size;
  226.       if @fun<>nil then
  227.         if not fun(ValueName) then break;
  228.       Count := Count + 1;
  229.     end;
  230.     RegCloseKey(s);
  231.   end;
  232. end;
  233. end.