حالت موضوعی | حالت خطی

reza_g

كسي مي دونه چه طور مي تونيم يك مقدار در رجيستري در يك مسير دلخواه بنويسيم؟با تشكر

**veyskarami**

با این یونیت می تونی هر کاری تو رجیستری انجام بدی.

کد: 
unit apiregistry;

interface

uses Windows;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;

function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;

function RegSetExpandString(RootKey: HKEY; Name: string; Value: string): boolean;

function RegSetDWORD(RootKey: HKEY; Name: string; Value: Cardinal): boolean;

function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte): boolean;

function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;

function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string): boolean;

function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string): boolean;

function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;

function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;

function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;

function RegValueExists(RootKey: HKEY; Name: string): boolean;

function RegKeyExists(RootKey: HKEY; Name: string): boolean;

function RegDelValue(RootKey: HKEY; Name: string): boolean;

function RegDelKey(RootKey: HKEY; Name: string): boolean;

function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY): boolean;

function RegDisconnect(RemoteKey: HKEY): boolean;

function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;

function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string): boolean;

implementation

function LastPos(Needle: Char; Haystack: string): integer;

begin

for Result := Length(Haystack) downto 1 do

if Haystack[Result] = Needle then

Break;

end;

function RegConnect(MachineName: string; RootKey: HKEY; var RemoteKey: HKEY):

boolean;

begin

Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) =

ERROR_SUCCESS);

end;

function RegDisconnect(RemoteKey: HKEY): boolean;

begin

Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);

end;

function RegSetValue(RootKey: HKEY; Name: string; ValType: Cardinal; PVal:

Pointer; ValSize: Cardinal): boolean;

var

SubKey: string;

n: integer;

dispo: DWORD;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE,

KEY_WRITE,

nil, hTemp, @dispo) = ERROR_SUCCESS then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize)

= ERROR_SUCCESS);

RegCloseKey(hTemp);

end;

end;

end;

function RegGetValue(RootKey: HKEY; Name: string; ValType: Cardinal; var PVal:

Pointer;

var ValSize: Cardinal): boolean;

var

SubKey: string;

n: integer;

MyValType: DWORD;

hTemp: HKEY;

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS

then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) =

ERROR_SUCCESS then

begin

GetMem(Buf, BufSize);

if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize)

= ERROR_SUCCESS then

begin

if ValType = MyValType then

begin

PVal := Buf;

ValSize := BufSize;

Result := True;

end

else

begin

FreeMem(Buf);

end;

end

else

begin

FreeMem(Buf);

end;

end;

RegCloseKey(hTemp);

end;

end;

end;

function RegSetString(RootKey: HKEY; Name: string; Value: string): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value)

+ 1);

end;

function RegSetMultiString(RootKey: HKEY; Name: string; Value: string): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0),

Length(Value) + 2);

end;

function RegSetExpandString(RootKey: HKEY; Name: string; Value: string):

boolean;

begin

Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0),

Length(Value) + 1);

end;

function RegSetDword(RootKey: HKEY; Name: string; Value: Cardinal): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));

end;

function RegSetBinary(RootKey: HKEY; Name: string; Value: array of Byte):

boolean;

begin

Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],

length(Value));

end;

function RegGetString(RootKey: HKEY; Name: string; var Value: string): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then

begin

Dec(BufSize);

SetLength(Value, BufSize);

if BufSize > 0 then

CopyMemory(@Value[1], Buf, BufSize);

FreeMem(Buf);

Result := True;

end;

end;

function RegGetMultiString(RootKey: HKEY; Name: string; var Value: string):

boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then

begin

Dec(BufSize);

SetLength(Value, BufSize);

if BufSize > 0 then

CopyMemory(@Value[1], Buf, BufSize);

FreeMem(Buf);

Result := True;

end;

end;

function RegGetExpandString(RootKey: HKEY; Name: string; var Value: string):

boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then

begin

Dec(BufSize);

SetLength(Value, BufSize);

if BufSize > 0 then

CopyMemory(@Value[1], Buf, BufSize);

FreeMem(Buf);

Result := True;

end;

end;

function RegGetDWORD(RootKey: HKEY; Name: string; var Value: Cardinal): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then

begin

CopyMemory(@Value, Buf, BufSize);

FreeMem(Buf);

Result := True;

end;

end;

function RegGetBinary(RootKey: HKEY; Name: string; var Value: string): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then

begin

SetLength(Value, BufSize);

CopyMemory(@Value[1], Buf, BufSize);

FreeMem(Buf);

Result := True;

end;

end;

function RegValueExists(RootKey: HKEY; Name: string): boolean;

var

SubKey: string;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS

then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) =

ERROR_SUCCESS);

RegCloseKey(hTemp);

end;

end;

end;

function RegGetValueType(RootKey: HKEY; Name: string; var Value: Cardinal):

boolean;

var

SubKey: string;

n: integer;

hTemp: HKEY;

ValType: Cardinal;

begin

Result := False;

Value := REG_NONE;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS)

then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil)

= ERROR_SUCCESS);

if Result then

Value := ValType;

RegCloseKey(hTemp);

end;

end;

end;

function RegKeyExists(RootKey: HKEY; Name: string): boolean;

var

SubKey: string;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS

then

begin

Result := True;

RegCloseKey(hTemp);

end;

end;

end;

function RegDelValue(RootKey: HKEY; Name: string): boolean;

var

SubKey: string;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS

then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

RegCloseKey(hTemp);

end;

end;

end;

function RegDelKey(RootKey: HKEY; Name: string): boolean;

var

SubKey: string;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

SubKey := Copy(Name, 1, n - 1);

if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS

then

begin

SubKey := Copy(Name, n + 1, Length(Name) - n);

Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

RegCloseKey(hTemp);

end;

end;

end;

function RegEnum(RootKey: HKEY; Name: string; var ResultList: string; const

DoKeys: Boolean): boolean;

var

i: integer;

iRes: integer;

s: string;

hTemp: HKEY;

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

ResultList := '';

if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

begin

Result := True;

BufSize := 1024;

GetMem(buf, BufSize);

i := 0;

iRes := ERROR_SUCCESS;

while iRes = ERROR_SUCCESS do

begin

BufSize := 1024;

if DoKeys then

iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)

else

iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);

if iRes = ERROR_SUCCESS then

begin

SetLength(s, BufSize);

CopyMemory(@s[1], buf, BufSize);

if ResultList = '' then

ResultList := s

else

ResultList := Concat(ResultList, #13#10,s);

inc(i);

end;

end;

FreeMem(buf);

RegCloseKey(hTemp);

end;

end;

function RegEnumValues(RootKey: HKEY; Name: string; var ValueList: string):

boolean;

begin

Result := RegEnum(RootKey, Name, ValueList, False);

end;

function RegEnumKeys(RootKey: HKEY; Name: string; var KeyList: string): boolean;

begin

Result := RegEnum(RootKey, Name, KeyList, True);

end;

end.

ولی اگه می خوای فقط String بنویسی از این کد استفاده کن

کد: 
function RegSetString(key:Hkey; subkey,name,value:string):boolean;

var

regkey:hkey;

begin

  result := false;

  RegCreateKey(key,PChar(subkey),regkey);

  if RegSetValueEx(regkey,Pchar(name),0,2,pchar(value),length(value)) = 0 then

    result := true;

  RegCloseKey(regkey);

end;

reza_g

از كمكتون ممنونم.

**lord_viper**

رجيستر رو در زبان عاميانه قلب ويندوز ان تی می دانند . رجيستری يک مر کز بسيار مهم در ويندوز می باشد که در انجا تمامی برنامه ها و مقدار ها و فرمت ها و تنظيمات ثبت ميشوند در رجيستری می توان به تنظيمات ويندوز دست پيدا کرد و با استفاده از آن بدون استفاده از کنترل پنل تنظيمات ويندوز رو عوض کرد .

شما برای کار با رجيستری در دلفی نياز به تعريف و نوشتن هيچ کلاس و متد و آبجکت نداريد شرکت جيگر طلای من ( بورلند ) برای کار با رجيستر يه يونيت با همين نام Registry ارائه داده که تمام نياز های ملت رو برای کار با رجيستر تامين می کنه که شامل کلاس TRegistry می باشد که دارای روال ها و تابع های خاصی مثل

CreateKey يا WriteString يا DeleteKey يا MoveKey يا ReadFloat و....ميباشد. نحو اصلی کار با رجيستری و ثبت کردن مقدار ايجاد يک کليد و.... به اين صورت می باشد که :

ابتدا يونيت رجيستری رو به ليست Uses يونيتمون اضافه می کنيم به شکل زير :

کد: 
uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

   Dialogs,Registry;

خب حالا يه متغير بايد از نوع کلاس TRegistry تعريف کنيم تا بتوانيم از توابع آن ها استفاده کنيم. به شکل زير

کد: 
Var

B:TRegistry;

سپس بايد يک نوع از کلاس را بوجود بياوريم که طبق معمول بايد از constructor کرييت (Create) مر بوط به اکثر کلاس ها استفاده کنيم به شکل زير

کد: 
b:=TRegistry.Create;

برای کار با رجيستری بايد به يک لانه مربوط در آن اشاره کنيم که عبارتند از :

کد: 
HKEY_CLASSES_ROOT

HKEY_CURRENT_USER

HKEY_LOCAL_MACHINE

HKEY_USERS

HKEY_PERFORMANCE_DATA

HKEY_CURRENT_CONFIG

HKEY_DYN_DATA

برای اين که يکی از اين مقدار ها را انتخاب کنيم بايد از پراپرتی RootKey به شکل زير استفاده کنيد :

کد: 
B.RootKey:=HKEY_LOCAL_MACHINE;

سپس بايد آدرس مربوط به کليدی که می خواهيم در آن اعمال انجام دهيم رو با استفاده از تابع OpenKey مشخص کنيم به شکل زير :

کد: 
B.OpenKey(آدرس کليد مربوطه , اجازه بوجود آوردن کليد )

در مورد آدرس شما بايد آدرس کليد مربوطه رو بدون کی روت آن تایپ کنيد و به صورت يک استرينگ در مورد اجازه بوجود آوردن که با يک مقدارFalse يا True ست ميشود اين صورت است که شما می توانيد با ست کردن آن به صورت True به آن اجازه بدهيد تا يک کليد با آدرس که شما تایپک کرديد بوجود بياورد البته ما به شما يشنهاد می کنيم که مقدار مر بوطه را هميشه False کنيد چون شما می توانيد با تابع CreateKey يک کی بسازيد پس بهتره که شما از تابع اپن کیOpenKey آدرس کليد مربوطه تان را لود کنيد .

سپس شما در اين مرحله قادر هستيد تا هر کاری انجام دهيد مثلا می توانيد :

کليد بسازيد ( منظورم کليد رجيستری است)يک رشته وارد سازيد و يا يک عدد و يا يک زمان وارد سازيد و يا يک رشته را فرا بخوانيد و يا يک عدد را فرا بخوانيد و يا کليدی را از بين ببريد و يا کليدی را تغيير مکان (MoveKey) کنيد و تمامی اعمال که می خواهيد را انجام دهيد . برای مثال به کد زير يک نگاه بيندازيد اين کد تسک منيجر (ctrl+Alt+Delete) را غير فعال می کند:

کد: 
var

dbm: Tregistry;

begin

DbM:= tregistry.Create;

DbM.RootKey:= HKEY_CURRENT_USER;

DbM.OpenKey('Software\MicrosoFt\Windows\CurrentVersion\Policies\system\',false);

DbM.WriteInteger('DisableTaskMgr',0);

DbM.Free;

end;

خب فکر کنم که کار با توابع رجيستری رو آموخته باشيد همين طور که می بينيد تمام کار ها گفته شده انجام شده و تمام تابع ها آشنا می باشد در ضمن تابع WriteInteger توابعی از اين دست برای ثبت يک عدد ويا يک مقدار در رجيستری می باشد اين تابع ها خيلی زيادند وهمه دارای ساختمانی به شکل زير می باشند

نام تابع (نام مقداری که بايد از نو ثبت شود و يا با نويسی شود , مقدار)

همچنين توابعی نيز برای خوندن يک مقدار و باز گرداندن يک مقدار ووجود دارد مثل ReadString که اکثرا داری يک نوع ساختمان می باشند برای مثال با استفاده از کد زير می توانيد مسير کوکی ها را از رجيستری بخوانيد :

کد: 
var

reg : tregistry;

Cooki:String;

begin

 reg := tregistry.Create;

 reg.RootKey := hkey_current_user ;

   reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',true);

   Cooki := reg.ReadString('Cookies');

end;

reza_g

از كمكي كه كردين ممنونم

**lord_viper**

لطفا از دکمه تشکر استفاده کنید

reza_g

استفاده كردم

**veyskarami**

به نظرمن مسخره ترین کلاسی که بورلند واسه دلفی گذاشته همین TRegistry هستش چون
اولا: برنامه نویس به خوبی با توابع اصلی api در رجیستری آشنا نمیشه.
دوما: حجم خروجی فایل افزایش بیشتری نسبت با استفاده مستقیم از api مربوط پیدا می کنه.
سوما:انعطاف کمتری واسه customize کردن دستورات بوجود میاد و همیشه از یک روش ثابت باید پیروس کرد.
چهارما:همیشه نیاز برنامه به یک یا چند یونیت اضافه احساس میشه.

موضوعات مرتبط با این موضوع...
موضوع		نویسنده	پاسخ	بازدید	آخرین ارسال
	نوشتن پلاگین برای ollydbg	lord_viper	2	3,271	۰۴-مرداد-۱۳۹۵, ۲۲:۰۴:۴۰ آخرین ارسال: alimogmov
	Component هاي دلفي	veyskarami	20	29,704	۰۶-آبان-۱۳۹۳, ۱۳:۵۴:۰۶ آخرین ارسال: veyskarami
	Quick Report در دلفي	مهدي دهقان	2	5,637	۱۴-اردیبهشت-۱۳۹۲, ۲۰:۴۷:۵۳ آخرین ارسال: saadati1042
	تغيير رزوليشن با دلفي	NabiKAZ	5	6,142	۲۶-فروردین-۱۳۹۲, ۱۰:۰۶:۲۵ آخرین ارسال: m.havakeshiyan
	سورس کد ميل سندر براي دلفي 7	Ar4sh	6	11,800	۱۱-دى-۱۳۹۰, ۱۰:۳۷:۳۷ آخرین ارسال: lord_viper
	نوشتن درایور با دلفی	lord_viper	1	3,019	۱۶-خرداد-۱۳۹۰, ۱۰:۱۰:۰۷ آخرین ارسال: lord_viper
	نكات مفيد براي كار در محيط دلفي	storng_function	0	2,662	۲۶-اردیبهشت-۱۳۸۹, ۱۶:۴۳:۱۸ آخرین ارسال: storng_function
	مشكل با restore در دلفي	amolrobotic	0	2,680	۲۷-مرداد-۱۳۸۸, ۱۰:۴۲:۲۴ آخرین ارسال: amolrobotic
	كامپوننت نويسي در دلفي 7	mostafa_mohammadi	7	7,402	۰۳-خرداد-۱۳۸۸, ۱۷:۴۶:۵۲ آخرین ارسال: Programmer
	كرك كردن اگزه دلفي	ahvig	8	8,027	۰۳-خرداد-۱۳۸۸, ۱۳:۳۳:۵۰ آخرین ارسال: lolohacko

حالت موضوعی \| حالت خطی نوشتن در رجيستري با دلفي
نویسنده	پیام