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

**daneshpazho** · پنج شنبه 10 فروردین 1385, 18:05 عصر

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

**daneshpazho** · پنج شنبه 10 فروردین 1385, 18:06 عصر

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

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

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** · پنج شنبه 10 فروردین 1385, 18:06 عصر

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

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** · پنج شنبه 10 فروردین 1385, 18:07 عصر

بدست آوردن مسیر پوشه 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** · پنج شنبه 10 فروردین 1385, 18:08 عصر

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

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** · پنج شنبه 10 فروردین 1385, 18:09 عصر

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

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** · جمعه 11 فروردین 1385, 00:53 صبح

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

**Mahmood_M** · جمعه 11 فروردین 1385, 02:22 صبح

با این کد می تونید یه برنامه رو اجرا کنید ( مثلا 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** · جمعه 11 فروردین 1385, 17:44 عصر

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

**daneshpazho** · جمعه 11 فروردین 1385, 17:45 عصر

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

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

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

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

**daneshpazho** · شنبه 12 فروردین 1385, 11:09 صبح

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** · شنبه 12 فروردین 1385, 13:58 عصر

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

**khareh_siah** · شنبه 12 فروردین 1385, 14:09 عصر

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

**Mahmood_M** · یک شنبه 13 فروردین 1385, 15:49 عصر

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



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** · دوشنبه 14 فروردین 1385, 10:00 صبح

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

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

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

**daneshpazho** · سه شنبه 15 فروردین 1385, 18:06 عصر

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

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

مثال:

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

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

**daneshpazho** · چهارشنبه 16 فروردین 1385, 11:40 صبح

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

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** · جمعه 25 فروردین 1385, 19:00 عصر

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

Function clipcursor(iprect:prect):bool;

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

procedure TForm1.Timer1Timer(Sender: TObject);

var

     r:trect;

begin

   getwindowrect(form1.Handle,r);

   clipcursor(@r);

end;

**unique1984** · یک شنبه 03 اردیبهشت 1385, 17:38 عصر

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

**daneshpazho** · پنج شنبه 07 اردیبهشت 1385, 17:29 عصر

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

**daneshpazho** · پنج شنبه 07 اردیبهشت 1385, 17:37 عصر

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

getdrivetype(iprootpathname:pchar):unit;stdcall;

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

C:\

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

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

**ParsaNM** · پنج شنبه 03 مرداد 1387, 10:07 صبح

دست آوردن سريال 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** · پنج شنبه 03 مرداد 1387, 10:15 صبح

کپي کردن يک 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** · پنج شنبه 03 مرداد 1387, 10:16 صبح

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

 

 



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** · پنج شنبه 03 مرداد 1387, 10:18 صبح

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

 

 

 

function GetTaskbarRect: TRect;

var

 Hand: HWND;

begin

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

 if Hand > 0 then

   GetWindowRect(Hand, Result);

end;

**qazwsx** · جمعه 19 مهر 1387, 18:32 عصر

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

**ariobarzan** · شنبه 20 مهر 1387, 09:06 صبح

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

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

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

**ariobarzan** · شنبه 20 مهر 1387, 09:14 صبح

باز هم سلام

پيدا كردن 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** · شنبه 20 مهر 1387, 09:41 صبح

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

**ariobarzan** · دوشنبه 22 مهر 1387, 12:25 عصر

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

**qazwsx** · دوشنبه 22 مهر 1387, 19:11 عصر

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

**matinebi** · یک شنبه 08 دی 1387, 01:14 صبح

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

**matinebi** · یک شنبه 08 دی 1387, 01:26 صبح

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

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

نام تاپیک: استفاده از توابع API در دلفی

ابزار های تاپیک

نمایش