مكتبة الاْكواد

[AX302]

السلام عليكم ورحمة الله
رمضان مبارك لكل الاْمة الاسلامية بحلول شهر رمضان جائتني فكرة بسيطة وهي عمل مكتبة فيها اكواد مفيدة تخص الدلفي كل يوم من هدا الشهر نضع اكواد في هدا الموضوع وبعد 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; 


[Agmcz]

الدالة 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; 


[Ben.Ja]

دالة 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 الخاص به

[AX302]

الخاصية الاولى للحصول على اسم الحاسوب 
الخاصية الثانية للحصول على اسم المستخدم

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; 


[Agmcz]

التحقق من النظام 32بت أو 64بت

PHP كود :

function Is64OS: LongBool;
asm
  XOR EAX, EAX
  MOV EAX, FS:[$C0]
end; 


[AX302]

خاصية للحصول على عدد المعالجات في الجهاز

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; 


[AX302]

خاصية لعكس سلسلة 

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; 


[AX302]

الخاصية الاولى لعمل هاش سلسلة عن طريق خوارزمية 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; 


[AX302]

خاصية لجلب معلومات هوست موقع واب 

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; 


[Agmcz]

التحقق من النظام 32بت أو 64بت

PHP كود :

function Is64OS: Boolean;
asm
  XOR EAX, EAX
  MOV AX, ES
  ROR AX, 3
  AND EAX, 1
end;