استفاده از توابع API در دلفی

[daneshpazho]

با عرض سلام خدمت همه برنامه نویسان

از آنجایی که توابع API کاربردهای زیادی در برنامه نویسی دارند و تو سایت هم منبع مشخصی برای این توابع وجود نداشت تصمیم گرفتیم این بخش رو راه بندازیم .
از اونجایی که توابع زیادی هست
اگر شما برنامه نویسان محترم همکاری کنید. میشه از این بخش به عنوان مرجعی برای توابع API استفاده کرد.
<<<خب بالاخره هر کسی یه تعدادی تابع رو بلده >>>

[daneshpazho]

اولیش رو خودم می نویسم :

بدست آوردن مسیرپوشه سیستم :

Function Getsyetemdirectory( Ipbuffer : pchar ; usize : unit) : unit ; stcall ;
usize : از نوع عدد می باشد و شامل حد اکثر تعداد کاراکتر های ipbuffer می باشد .
Ipbuffer: این پارامتر از نوع رشته بوده و مسیرپوشه سیستم را بر می گرداند .
مثال:

Function getsystem : string;
Var
Windir : array [0..255] of char;
Begin
Getsystemdirectory(windir,255);
Result := strpass(windir);
End;

[daneshpazho]

بدست آوردن مسیر پوشه ویندوز :

Function Getwindowsdirectory( Ipbuffer : pchar ; usize : unit) : unit ; stcall;
usize : از نوع عدد می باشد و شامل حد اکثر تعداد کاراکتر های ipbuffer می باشد .
Ipbuffer: این پارامتر از نوع رشته بوده و مسیر پوشه ویندوز را بر می گرداند .
مثال:

Function getwindows : string;
Var
sysdir : array [0..255] of char;
Begin
Getwindowsdirectory(sysdir,255);
Result := strpass(sysdir);
End;

[daneshpazho]

بدست آوردن مسیر پوشه temp :

Function Gettemppath( nbufferlength : dword , Ipbuffer : pchar ) : dword ; stcall;
Ipbuffer: این پارامتر از نوع رشته بوده و مسیر پوشه ویندوز را بر می گرداند .
Nbufferlength : از نوع عدد می باشد و شامل حد اکثر تعداد کاراکتر های ipbuffer می باشد .

خروجی این تابع از نوع عددی بوده اگر تابع کارش را به درستی انجام داده باشد مقدار برگشتی برابر با nbufferlength خواهد بود وگرنه برابر با صفر خواهد شد .
مثال:

Function gettemp : string;
Var
tempdir : array [0..255] of char;
Begin
Gettemppath(255 , tempdir);
Result := strpass(tempdir);
End;

[daneshpazho]

بدست آوردن نام کاربر:

Function getusername(ipbuffer : pchar ; var nsize : dword ) : boole ; stdcall;
Ipbuffer: این پارامتر از نوع رشته بوده و نام کاربر را بر می گرداند .
Nsize : از نوع عدد می باشد و شامل حد اکثر تعداد کاراکتر های ipbuffer می باشد .
مثال :

Function computername:strin;
Var
Len:dword;
Name:string;
Begin
Len := max_path+1;
Setlength(name , max_path+1);
Getusername(pchar(name) , len);
Setlength(name , strlen(pchar(name)));
Result := uppercase(name);
End;

[daneshpazho]

بدست آوردن نام کامپیوتر:

Function Getcomputername( Ipbuffer : pchar ; var nsize : Dword ) : bool ; stdcall;
Ipbuffer: این پارامتر از نوع رشته بوده و شامل متغیری بوده که نام کامپیوتر در آن قرار می گیرد .
Nsize : از نوع عدد می باشد و شامل تعداد کاراکتر هایی است که باید نمایش داده شود و باید از 31 بیشتر باشد .
اگر تابع کار خود را به خوبی انجام ندهد در متغیر در nsize صفر یا null قرار می گیرد
مثال :

Function computername:strin;
Var
Len:dword;
Name:string;
Begin
Len:=max_path+1;
Setlength(name,max_path+1);
Getcomputername(pchar(name),len);
Setlength(name,strlen(pchar(name)));
Result:=uppercase(name);
End;

[Mahmood_M]

دوست عزیز واقعا تاپیک جالبی راه انداختید ...
من خودم یه چیزهایی از API می دونم ولی خیلی دوست دارم بیشتر یاد بگیرم.
امیدوارم دوستان دیگه هم یاری کنند تا این تاپیک ادامه داشته باشه ...
موفق باشید ...

[Mahmood_M]

با این کد می تونید یه برنامه رو اجرا کنید ( مثلا NotePad )

ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL) ;
حالا اگه بخواید یک فایل متنی رو با NotePad باز کنید کدش باید به جای اولین Nil آدرس فایل رو بنویسید :

ShellExecute(Handle,'open', 'c:\windows\notepad.exe','c:\Example.txt', nil, SW_SHOWNORMAL) ;
با کد بالایی ( اولی ) می تونید یک پوشه رو هم باز کنید و هم چنین یک صفحه وب رو، فقط به جای آدرس NotePad باید آدرس پوشه یا آدرس صفحه وب رو بنویسید.

ارسال ایمیل :

var em_subject, em_body, em_mail : string;
begin
em_subject := 'This is the subject line';
em_body := 'Message body text goes here';
em_mail := 'mailto:delphi.guide@about.com?subject=' +
em_subject + '&body=' + em_body ;
ShellExecute(Handle,'open',
PChar(em_mail), nil, nil, SW_SHOWNORMAL) ;
end;

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

[daneshpazho]

آقا محمود خیلی ممنون از اینکه همکاری می کنید و امیدوارم که بقیه هم همکاری کنند
چیزی حدود به هزار تابع وجود داره و بعضی از توابع ممکنه چندین استفاه رو داشته باشه اگه بقیه هکاری کنند این تاپیک ادامه پیدا خواهد کرد .

[daneshpazho]

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

Function getdrivelogicalstring(nbufferlength:Dword ;ipbuffer:pansichar):Dword;
Nbufferlength : این پارامتر از نوع عددی بوده و مقدار فضای لازم برای ذخیره سازی دیسک درایو را مشخص می کند .
Ipbuffer: از نوع رشته بوده و ناو دیسک درایو را در خود جای می دهد .
نام دیسک درایو ها به صورت زیر در متغییر قرار می گیرد
A:\<null>B:\<null>C:\<null>D:\<null>

[daneshpazho]

Function createdc(ipszdriver,ipszdevice,ipszoutput:pchar;ip dwminit :pdevicemod):hdc;از این تابع برای ساختن پرده زمینه استفاده می شود.
Ipszdriver : این پارامتر از نوع رشته می باشد و شامل نام درایوری است که قرار است پرده زمینه روی آن ساخته شود .
Ipszdevice: این پارامتر از نوع رشته بوده و شامل device خروجی می باشد
ipszoutput: از نوع رشته بوده و port خروجی را مشخص می کند
Ipinitdata: یک اشاره گر به ساختار devmod می باشد ک


Function drawtext(hdc:hdc;ipstring:pchar;ncount:integer;var iprect:trect;uformat:unit):integer;از این تابع برای ترسیم متن روی پرده DC استفاده می شود .

مثال:
ابتدا یک تایمر قرار داده و hnterval آن را برابر با 10 قرار دهید و در قسمت implemention آن متغیر I از نوع Boolean تعریف کنید .

procedure TForm1.Timer1Timer(Sender: TObject);
var
h:hdc;
r:trect;
begin
h:=createdc('display',nil,nil,nil);
r:=rect(620,-60,1020,80);
drawtext(h,'SWAN SOFT GROUP',-1,r,dt_singleline or dt_center or dt_vcenter);
deletedc(h);
if i = false then
begin
timer1.Interval:=1000;
i:=true;
end;
form1.Hide;
end;

[khareh_siah]

آقایون من هم هستم همکاری فوکولم

[khareh_siah]

function GetCursorPos(var lpPoint:TPoint):BOOL;stdcall;
این تابع برای پیدا کردن مختصات ماوس به کار میرود

[Mahmood_M]

کپی ، کات و حذف یک پوشه ...


function CopyDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;


function MoveDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;

function DelDir(dir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;

برای استفاده از این کدها باید ShelAPI رو در بخش Uses اضافه کنید ...

[daneshpazho]

Function setcursorpos(x,y:integer):bool;
از این تابع برای تنظیم موقعیت موس استفاده می شود .

khareh_siah از همکاری تون متشکرم

[daneshpazho]

با این تابع کارهای زیادی میشه کرد
من خودم برای تغییر بک گروند ازش استفاده می کنم .

function SystemParametersInfo( uiaction:unit ;uiparam:unit;Pvparam:pvoid;fwinini:unit):bool;
مثال:

SystemParametersInfo(SPI_SETDESKWALLPAPER ,0,pchar(bmpfile),SPIF_SENDCHANGE );
البته برای تغییر باید یا فایل bmp باشه یا اونو به jpg تبدیل کنین که تو سایت یه پست برای تبدیل jpg به bmp هست .

[daneshpazho]

با این تابع میشه زبان را تغییر داد البته سیستم بای زبان مورد نظر داشته باشد .

Function activatekeyboardlayout(hkl:hkl;flags:unit)bool;
مثال:
در این مثال زبان صفحه کلید را به زبان بعدی که سیستم پشتیبانی می کند تغییر می دهد.

Function setlang : Boolean;
Begin
If activatekeyboardlayout ( hkl_next , kl_reorder ) then
Result : = true
Else
Result : = false;
End;

[daneshpazho]

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

Function clipcursor(iprect:prect):bool;
مثال:
تابع getwindowrect نیز محدوده پنجره مورد نظر را برمی گرداند .
این مثال موس را در محدوده فرم محدود می کند.

procedure TForm1.Timer1Timer(Sender: TObject);
var
r:trect;
begin
getwindowrect(form1.Handle,r);
clipcursor(@r);
end;
:متعجب:

[unique1984]

ممنون از همه دوستان اگه بازم ادامه بدین ممنون می شم.

[daneshpazho]

با عرض پوزش از اینکه یه مدتی نبودم
اگر شما یاری ادامه بدیم

[daneshpazho]

بدست آوردن نوع درایو

getdrivetype(iprootpathname:pchar):unit;stdcall;
iprootpathname: نام درایو مورد نظر می باشد به صورت C:\
0: درایو قابل دسترسی نیست
1:درایو وجود نداردک
2: دیسک از نوع قابل حمل بودهفلاپی
3: درایو از نوع هارد می باشد
4: درایو از نوع شبکه
5: از سی دی رام
6 از نوع درایو رم می باشد .

بابا همکاری کنید :گریه: :گریه:

[ParsaNM]

دست آوردن سريال CPU





function GetCPUSerialNumber: String;
var
_eax, _ebx, _ecx, _edx: Longword;
s, s1, s2: String;
begin
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := IntToHex(_eax, 8);
asm //determine the serial number
mov eax,3
db $0F,$A2
mov _ecx,ecx
mov _edx,edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
begin Result := (s + '-' + s1 + '-' + s2); asm push Result end; end;
end;

[ParsaNM]

کپي کردن يک Directory و کليه متعلقاتش








function CopyDir(const fromDir, toDir: string): Boolean;

var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_NOCONFIRMATION;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;

[ParsaNM]

جابجايي يک پوشه





function MoveDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_MOVE;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;

[ParsaNM]

بدست آوردن اندازه Taskbar





function GetTaskbarRect: TRect;
var
Hand: HWND;
begin
Hand := FindWindow('Shell_TrayWnd', '');
if Hand > 0 then
GetWindowRect(Hand, Result);
end;

[qazwsx]

آقا خیلی خوب بود ادامه برین دیگه

[ariobarzan]

سلام
تاپيك جالبيه

خاموش كردن مانيتور


SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);// montor off

[ariobarzan]

باز هم سلام

پيدا كردن Url هايي كه كاربر توي Explorer تايپ كرده



procedure ShowTypedUrls(Urls: TStrings);



var


Reg: TRegistry;
S: TStringList;
i: Integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', False) then
begin
S := TStringList.Create;
try
reg.GetValueNames(S);
for i := 0 to S.Count - 1 do
begin
Urls.Add(reg.ReadString(S.Strings[i]));
end;
finally
S.Free;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
end;


end;



حالا يه Listbox و يك button روي صفحه و حالا :


procedure TForm1.Button1Click(Sender: TObject);



begin

ShowTypedUrls(ListBox1.Items);

end;




اميدوارم جالب بوده باشه

[ariobarzan]

اين هم يه يونيت اساسي

[ariobarzan]

چرا ادامه نمي ديد؟
كسي نظري در مورد اين يونيت نداشت؟
بد بود ؟ خوب بود؟

[qazwsx]

خوب این چه کار میکنه یه مثالی چیزی

[matinebi]

در مورد بدست آوردن نام کامپیوتر لطفا بیشتر توضیح بده فکر کنم کد ناقص باشد

[matinebi]

دست آوردن سريال CPU





function GetCPUSerialNumber: String;
var
_eax, _ebx, _ecx, _edx: Longword;
s, s1, s2: String;
begin
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := IntToHex(_eax, 8);
asm //determine the serial number
mov eax,3
db $0F,$A2
mov _ecx,ecx
mov _edx,edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
begin Result := (s + '-' + s1 + '-' + s2); asm push Result end; end;
end;




زمانی که این کد رو مینویسم و میخوام به یک لیبل سریال بدم برنامه بسته میشه