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

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

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

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

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;

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

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;

بدست آوردن مسیر پوشه 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;

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

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;

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

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;

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

با این کد می تونید یه برنامه رو اجرا کنید ( مثلا 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; 

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

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

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

Function getdrivelogicalstring(nbufferlength:Dword ;ipbuffer:pansichar):Dword;

Nbufferlength : این پارامتر از نوع عددی بوده و مقدار فضای لازم برای ذخیره سازی دیسک درایو را مشخص می کند .
Ipbuffer: از نوع رشته بوده و ناو دیسک درایو را در خود جای می دهد .
نام دیسک درایو ها به صورت زیر در متغییر قرار می گیرد

A:\<null>B:\<null>C:\<null>D:\<null>

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;

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

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

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

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 اضافه کنید ...

Function setcursorpos(x,y:integer):bool;

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

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

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

function SystemParametersInfo( uiaction:unit ;uiparam:unit;Pvparam:pvoid;fwinini:unit):bool;

مثال:

SystemParametersInfo(SPI_SETDESKWALLPAPER	,0,pchar(bmpfile),SPIF_SENDCHANGE );

البته برای تغییر باید یا فایل bmp باشه یا اونو به jpg تبدیل کنین که تو سایت یه پست برای تبدیل jpg به bmp هست .

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

Function activatekeyboardlayout(hkl:hkl;flags:unit)bool;

مثال:
در این مثال زبان صفحه کلید را به زبان بعدی که سیستم پشتیبانی می کند تغییر می دهد.

Function setlang : Boolean;

Begin

   If activatekeyboardlayout ( hkl_next , kl_reorder ) then

        Result : = true

   Else

         Result : = false;

End; 

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

Function clipcursor(iprect:prect):bool;

مثال:
تابع getwindowrect نیز محدوده پنجره مورد نظر را برمی گرداند .
این مثال موس را در محدوده فرم محدود می کند.

procedure TForm1.Timer1Timer(Sender: TObject);

var

     r:trect;

begin

   getwindowrect(form1.Handle,r);

   clipcursor(@r);

end;

:متعجب:

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

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

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

getdrivetype(iprootpathname:pchar):unit;stdcall;

iprootpathname: نام درایو مورد نظر می باشد به صورت

C:\

0: درایو قابل دسترسی نیست
1:درایو وجود نداردک
2: دیسک از نوع قابل حمل بودهفلاپی
3: درایو از نوع هارد می باشد
4: درایو از نوع شبکه
5: از سی دی رام
6 از نوع درایو رم می باشد .

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

دست آوردن سريال 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;
 

کپي کردن يک 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;

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

 

 



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;
 

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

 

 

 

function GetTaskbarRect: TRect;

var

 Hand: HWND;

begin

 Hand := FindWindow('Shell_TrayWnd', '');

 if Hand > 0 then

   GetWindowRect(Hand, Result);

end;
 

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

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

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


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

باز هم سلام

پيدا كردن 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;

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

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

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

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

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

نقل قول:

---

نوشته شده توسط 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;
 

---

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