delphi4arab منتديات دلفي للعرب
مكتبة الاْكواد - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : مصادر دلفي مفتوحة تعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=14)
+--- الموضوع : مكتبة الاْكواد (/showthread.php?tid=9407)

الصفحات: 1 2

مكتبة الاْكواد - AX302 - 17-05-2018

السلام عليكم ورحمة الله
رمضان مبارك لكل الاْمة الاسلامية بحلول شهر رمضان جائتني فكرة بسيطة وهي عمل مكتبة فيها اكواد مفيدة تخص الدلفي كل يوم من هدا الشهر نضع اكواد في هدا الموضوع وبعد 30 يوم ستكون مكتبة ضخمة يستفيد منها كل رواد المنتدى للمشاركة فقط قم باضافة الكود في الردود بالتوفيق للجميع.
خاصية تقوم بتحويل String الى Hex 
PHP كود :
Function StringToHex(Str:String):string;
var i:integer;
begin
 for I := 1 to Length(Str) do
  begin
    Result := Result + IntToHex(Ord(Str[i]),2);
  end;
end; 


RE: مكتبة الاْكواد - Agmcz - 18-05-2018

الدالة IntToHex بإستعمال دوال API
PHP كود :
function IntToHex(Value: Cardinal; Digits: Cardinal): string;
var
  F: PChar;
begin
  case Digits of
    0: Exit;
    1..9: GetMem(F, 1);
  else
    Exit;
  end;
  wvsprintf(@F[0], '%d', @Digits);
  SetLength(Result, Digits);
  wvsprintf(@Result[1], PChar('%.' + F + 'X'), @Value);
  FreeMem(F);
end; 


RE: مكتبة الاْكواد - Ben.Ja - 18-05-2018

دالة select directory لاختيار مجلد وحفظه مساره

PHP كود :
uses filectrl; 
PHP كود :
SelectDirectory('Caption', 'init_dir',variable,[sdNewUI, sdShowEdit]); 

caption = عنوان الdialog
init_dir = المسار الابتدائي
variable = المتغير الذي يُسجل فيه المسار الذي اختاره المستخدم.
داخل [] خواص اضافية  للـdialog وهي: 

PHP كود :
sdNewUI,sdNewFolder,sdShowEdit,sdShowShares,sdValidateDir 

مثال:
PHP كود :
procedure Tfrm_main.button_dirClick(Sender: TObject);
var
  sel_dir: string;
begin
  SelectDirectory('Select a folder', '', sel_dir, [sdNewUI, sdShowEdit, sdNewFolder]);
  edit_dir.Text := sel_dir;
end; 

ويمكن اختصار هذا بوضع مكون TFileOpenDialog وتحديد خاصية fdoPickFolders  في الoption الخاص به

RE: مكتبة الاْكواد - AX302 - 18-05-2018

الخاصية الاولى للحصول على اسم الحاسوب 
الخاصية الثانية للحصول على اسم المستخدم
PHP كود :
Function GetComputerName:string;
begin
  Result := GetEnvironmentVariable('COMPUTERNAME');
end;

Function GetUserName:string;
begin
  Result := GetEnvironmentVariable('USERNAME');
end; 

طريقة الاستعمال : 
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetComputerName);
  ShowMessage(GetUserName);
end; 
الخاصية الاولى للحصول على الايبي الخارجي
الخاصية الثانية للحصول على الايبي الداخلي
PHP كود :
Function GetExternalIPAddress:string;
var HTTP : TIdHTTP;
begin
  HTTP := TIdHTTP.Create(Nil);
  try
    Result := HTTP.Get('http://bot.whatismyipaddress.com/');
  finally
    HTTP.Free;
  end;
end;

Function GetInternalIPAddress:string;
var IP : TIdIPWatch;
begin
  IP := TIdIPWatch.Create(Nil);
  try
   Result := IP.LocalIP;
  finally
    IP.Free;
  end;
end; 

طريقة الاستعمال : 
اضافة الوحدتين IdHttp و IdIPWatch الى قائمة الوحدات
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetExternalIPAddress);
 ShowMessage(GetInternalIPAddress);
end; 


RE: مكتبة الاْكواد - Agmcz - 18-05-2018

التحقق من النظام 32بت أو 64بت
PHP كود :
function Is64OS: LongBool;
asm
  XOR EAX, EAX
  MOV EAX, FS:[$C0]
end; 


RE: مكتبة الاْكواد - AX302 - 18-05-2018

خاصية للحصول على عدد المعالجات في الجهاز
PHP كود :
Function GetNumberOfProcessors:string;
begin
  Result := GetEnvironmentVariable('NUMBER_OF_PROCESSORS');
end; 

طريقة الاستعمال : 
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetNumberOfProcessors);
end; 
خاصية للحصول على خصائص المعالج 

PHP كود :
Function GetProcessorCharacteristics:string;
begin
  Result := GetEnvironmentVariable('PROCESSOR_IDENTIFIER');
end; 


طريقة الاستعمال :

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetProcessorCharacteristics);
end; 
خاصية للحصول على دقة الشاشة 
PHP كود :
Function GetScreenResolution:string;
begin
  Result := Screen.DesktopWidth.ToString+'x'+Screen.DesktopHeight.ToString;
end; 

طريقة الاستعمال :
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetScreenResolution);
end; 


RE: مكتبة الاْكواد - AX302 - 19-05-2018

خاصية لعكس سلسلة 
PHP كود :
Function GetReverseString(Str: string): string;
var
  i: integer;
begin
  for i := Length(Str) downto 1 do
  begin
    Result := Result + Str[i];
  end;
end; 

طريقة الاستعمال :
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetReverseString('D4A'));
end; 
خاصية للتحقق من ان مكتبة الربط الديناميكي (DLL) محملة في الداكرة ام لا 
PHP كود :
Function CheckDLLIsLoaded(DLLName: PWideChar): Boolean;
var
  LibraryHandle: Cardinal;
begin
  LibraryHandle := LoadLibrary(DLLName);
  if LibraryHandle <> 0 then
  begin
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end; 

طريقة الاستعمال : 
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
  if CheckDLLIsLoaded('kernel32.dll') then
  begin
    ShowMessage('Loaded');
  end
  else
  begin
    ShowMessage('Not Loaded');
  end;
end; 
خاصية للحقق من ملف PE ان كان x64 ام لا 
PHP كود :
Function CheckPEIs64(StreamName: TStream): Boolean;
var
  PEHeader: TImageDosHeader;
  PEImageNtHeaders: TImageNtHeaders;
begin
  StreamName.ReadBuffer(PEHeader, SizeOf(PEHeader));
  StreamName.Position := PEHeader._lfanew;
  StreamName.ReadBuffer(PEImageNtHeaders, SizeOf(PEImageNtHeaders));
  if PEImageNtHeaders.FileHeader.Machine <> $014C then
  begin
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end; 

طريقة الاستعمال :
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
var
  MS: TMemoryStream;
begin
  MS := TMemoryStream.Create;
  try
    MS.LoadFromFile('test.exe');
    if CheckPEIs64(MS) then
    begin
      ShowMessage('PE x64');
    end
    else
    begin
      ShowMessage('PE x86');
    end;
  finally
    MS.Free;
  end;
end; 


RE: مكتبة الاْكواد - AX302 - 20-05-2018

الخاصية الاولى لعمل هاش سلسلة عن طريق خوارزمية MD5
الخاصية الثانية لعمل هاش سلسلة عن طريق خوارزمية SHA1
PHP كود :
Function GetMD5Hash(Str:String):String;
var
 MD5 : THashMD5;
begin
  MD5 := THashMD5.Create;
  Result := MD5.GetHashString(Str);
end;

Function GetSHA1Hash(Str:String):String;
var
 SHA1 : THashSHA1;
begin
  SHA1 := THashSHA1.Create;
  Result := SHA1.GetHashString(Str);
end; 

طريقة الاستعمال : 
اضافة الوحدة System.Hash الى قائمة الوحدات 
PHP كود :
procedure TForm1.FormCreate(Sender: TObject);
begin
 ShowMessage(GetMD5Hash('Test'));
 ShowMessage(GetSHA1Hash('Test'));
end; 


RE: مكتبة الاْكواد - AX302 - 21-05-2018

خاصية لجلب معلومات هوست موقع واب 
PHP كود :
Function ExtractWebSiteInfo(const WebSiteUrl: String): String;
var
  WhoIs: TIdWhois;
begin
  WhoIs := TIdWhois.Create(Nil);
  try
    Result := WhoIs.WhoIs(WebSiteUrl);
  finally
    WhoIs.Free;
  end;
end; 

طريقة الاستعمال :
اضافة الوحدة IdWhois الى قائمة الوحدات
PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ExtractWebSiteInfo('delphi4arab.net'));
end; 
تعديل بسيط لخاصية ExtractWebSiteInfo لاظهار المعلومات فقط 
PHP كود :
Function ExtractWebSiteInfo(const WebSiteUrl: String): String;
var
  WhoIs: TIdWhois;
  Response:String;
begin
  WhoIs := TIdWhois.Create(Nil);
  try
    Response := WhoIs.WhoIs(WebSiteUrl);
    SetLength(Response,AnsiPos(' URL of the ICANN Whois',Response));
    Result := Response;
  finally
    WhoIs.Free;
  end;
end; 


RE: مكتبة الاْكواد - Agmcz - 25-05-2018

التحقق من النظام 32بت أو 64بت
PHP كود :
function Is64OS: Boolean;
asm
  XOR EAX, EAX
  MOV AX, ES
  ROR AX, 3
  AND EAX, 1
end;