Çok Yakında Yeni Bir Arayüzle karşınızdayız! http://yeni.delphican.com/

Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Yararlı Kütüphane için Fonksiyonlar
#1
Bilgisayardaki network kartlarının tanımlı olan mac adres bilgilerini liste halinde getirir.
//uses Winapi.Nb30 eklenmeli
function GetMACAddress: TStringList;
var
  AdapterList: TLanaEnum;
  NCB: TNCB;
  nIndex: integer;
begin
  Result := TStringList.Create;
  FillChar(NCB, SizeOf(NCB), 0);
  NCB.ncb_command := Char(NCBENUM);
  NCB.ncb_buffer := @AdapterList;
  NCB.ncb_length := SizeOf(AdapterList);
  Netbios(@NCB);
  if Byte(AdapterList.length) > 0 then
  begin
    for nIndex := 0 to Byte(AdapterList.length) - 1 do
    begin
      Result.Add(GetAdapterInfo(AdapterList.lana[nIndex]));
    end;
  end;
end;
Verilen dosyayı 
//verilen dosya adını byte array olarak sonuç veriyor.
function FileToByteArray(const FileName: WideString): TArray<Byte>;
const
 BLOCK_SIZE = 1024;
var
 BytesRead, BytesToWrite, Count: integer;
 F: file of Byte;
 pTemp: Pointer;
begin
 AssignFile(F, FileName);
 Reset(F);
 try
   Count := FileSize(F);
   SetLength(Result, Count);
   pTemp := @Result[0];
   BytesRead := BLOCK_SIZE;
   while (BytesRead = BLOCK_SIZE) do
   begin
     BytesToWrite := Min(Count, BLOCK_SIZE);
     BlockRead(F, pTemp^, BytesToWrite, BytesRead);
     pTemp := Pointer(LongInt(pTemp) + BLOCK_SIZE);
     Count := Count - BytesRead;
   end;
 finally
   CloseFile(F);
 end;
end;

//parametre olarak verilen byte array bilgiyi verilen dosyaya yazıyor.
procedure ByteArrayToFile(const ByteArray: TBytes; const FileName: string);
var
 Count: Integer;
 F: file of Byte;
 pTemp: Pointer;
begin
 AssignFile(F, FileName);
 Rewrite(F);
 try
   Count := Length(ByteArray);
   pTemp := @ByteArray[0];
   BlockWrite(F, pTemp^, Count);
 finally
   CloseFile(F);
 end;
end;

//CharInSet fonksiyonu gibi array içinde istenilen bilgi var mı kontrol ediyor. Birden fazla farklı veri tiplerine göre bilgilerde kontrol yapıyor.
function CheckIntegerInArray(pArr: ArrayInteger; pKey: Integer): Boolean;
var
  n1: Integer;
begin
  Result := False;
  for n1 := 0 to Length(pArr) - 1 do
  begin
    if pKey = pArr[n1] then
      Result := True;
    Exit;
  end;
end;

function CheckStringInArray(pArr: TArray<string>; pKey: string): Boolean;
var
  n1: Integer;
begin
  Result := False;
  for n1 := 0 to Length(pArr) - 1 do
  begin
    if pKey = pArr[n1] then
      Result := True;
    Exit;
  end;
end;

Dosyanın boyutunu veriyor
{$IFDEF MSWINDOWS}
function GetFileSize(pFileName: string): Int64;
var
 vSearchRec: TSearchRec;
begin
{$WARN SYMBOL_PLATFORM OFF}
 //SearchRec.Size property works, but only for files less than 2GB
 if FindFirst(pFileName, faAnyFile, vSearchRec) = 0 then
   Result := Int64(vSearchRec.FindData.nFileSizeHigh) shl Int64(32) + Int64(vSearchRec.FindData.nFileSizeLow)
 else
   Result := 0;
 FindClose(vSearchRec);
{$WARN SYMBOL_PLATFORM ON}
end;
{$ENDIF MSWINDOWS}

string içinde hangi karakterden kaç tane olduğunu söylüyor
Bu fonksiyon string helper içinde CountOfChar olarak tanımlı ama eski sürümlerde bu bilgi yok bu nedenle bunları da paylaşıyorum.
function CountOfChar(pSrc: string; pDelimiter: Char): Integer;
var
  n1: Integer;
begin
  Result := 0;
  for n1 := Low(pSrc) to High(pSrc) do
    if pSrc[n1] = pDelimiter then
      Inc(Result);
end;

Verilen bilgiyi girilen anahtar ile şifreler. Şifre anahtar değeri (0-65535 aralığında) ile bilgiyi şifrelemek için kullanılır. TC Kimlik No bilgisini şifrelemek için
Tam tersi şifreli bilgiyi çözmek için şifreli bilgiyi, öncesinde kullanılan şifreleme anahtarı gönderip normal bilgiye ulaşabiliriz.
EncryptStr('30850331144', 14257); //Sonuç: 040EF0D744DA01BA36DAE5
DeCryptStr('040EF0D744DA01BA36DAE5', 14257); //Sonuç: 30850331144
function EncryptStr(const S: WideString; Key: Word): string;
var
 n1: Integer;
 vRStr: RawByteString;
 vRStrB: TBytes absolute vRStr;
begin
 Result := '';
 vRStr := UTF8Encode(S);
 for n1 := 0 to Length(vRStr) - 1 do
 begin
   vRStrB[n1] := vRStrB[n1] xor (Key shr 8);
   Key := (vRStrB[n1] + Key) * CKEY1 + CKEY2;
 end;

 for n1 := 0 to Length(vRStr) - 1 do
   Result := Result + IntToHex(vRStrB[n1], 2);
end;

function DecryptStr(const S: string; Key: Word): string;
var
 n1, vTmpKey: Integer;
 vRStr: RawByteString;
 vRStrB: TBytes absolute vRStr;
 vTmpStr: string;
begin
 vTmpStr := UpperCase(S);
 SetLength(vRStr, Length(vTmpStr) div 2);
 n1 := 1;
 try
   while (n1 < Length(vTmpStr)) do
   begin
     vRStrB[n1 div 2] := StrToInt('$' + vTmpStr[n1] + vTmpStr[n1 + 1]);
     Inc(n1, 2);
   end;
 except
   Result := '';
   Exit;
 end;

 for n1 := 0 to Length(vRStr) - 1 do
 begin
   vTmpKey := vRStrB[n1];
   vRStrB[n1] := vRStrB[n1] xor (Key shr 8);
   Key := (vTmpKey + Key) * CKEY1 + CKEY2;
 end;

 Result := UTF8ToString(vRStr);
end;

//Color dialog penceresi varsayılan renk ataması yapıyoruz.
function GetDialogColor(pColor: TColor = 0): TColor;
var
 vColorDialog: TColorDialog;
begin
 vColorDialog := TColorDialog.Create(nil);
 try
   vColorDialog.Color := pColor;
   vColorDialog.Execute(Application.Handle);
   Result := vColorDialog.Color;
 finally
   vColorDialog.Free;
 end;
end;

//klasör seçtirme dialog u seçilen klasörün yolunu veriyor.
{$WARN SYMBOL_PLATFORM OFF}
function GetDialogDirectory(pInitialDir: string): string;
var
 OpenDialog: TFileOpenDialog;
begin

 OpenDialog := TFileOpenDialog.Create(nil);
 try
   if pInitialDir = '' then
     OpenDialog.DefaultFolder := '%USERPROFILE%\desktop'
   else
     OpenDialog.DefaultFolder := pInitialDir;

   OpenDialog.Title := 'Select Directory';
   OpenDialog.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem]; // YMMV
   OpenDialog.OkButtonLabel := 'Select';

   if OpenDialog.Execute then
     Result := OpenDialog.FileName;
 finally
   OpenDialog.Free;
 end
end;
{$WARN SYMBOL_PLATFORM ON}

Kendi işlerimde kullandığım fonksiyonları paylaşıyorum.
PostgreSQL - Linux - Delphi, Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.
WWW
Cevapla
#2
Teşekkürler
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Android ve IOS için Debug işlemini hızlandırma Tuğrul HELVACI 0 677 01-06-2018, Saat: 09:19
Son Yorum: Tuğrul HELVACI
  Exception için Çoklu Satır Kullanımı Halil Han Badem 0 657 23-02-2018, Saat: 17:28
Son Yorum: Halil Han Badem
Thumbs Up [Delphi] Yeni Başlayanlar İçin Güzel Kaynak Halil Han Badem 1 1.995 06-02-2018, Saat: 01:25
Son Yorum: Halil Han Badem



Konuyu Okuyanlar: 1 Ziyaretçi