Anfidya'nın arka bahçesi..

Selamlar canişkolarım,

Yıl olmuş 2017 ve ben hâla gönderi atmamışım buraya..

Yine über gereksiz araştırmalar yaparken GetModuleFileNameEx diye bir zımbırtı buldum. Nasıl kullanılır sorusunu hazreti google emmiden edinirken, yine bir yerlerden kod arakladım ve hemen sizleri de bu günaha ortak ediyorum (kötü_adam_gülüşü)! Çok ufak bir kaç değişiklik yaparak amacımıza uygun hale getirdim tabi ki!!

function GetProcessPathFromPID(classx,title:PChar): String;
var
  pid     : DWORD;       hwd : HWND;
  hProcess: THandle;
  path    : array[0..4095] of Char;
begin
  hwd := FindWindow(classx,title);
  GetWindowThreadProcessId(hwd, pid);

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, pid);
  if hProcess <> 0 then
    try
      if GetModuleFileNameEx(hProcess, 0, @path[0], Length(path)) = 0 then
        RaiseLastOSError;

      result := path;
    finally
      CloseHandle(hProcess);
    end
  else
    RaiseLastOSError;
end;

Kaynak: http://stackoverflow.com/questions/4178443/get-the-full-path-from-a-pid-using-delphi

Selam baboşlar,

Uzun süredir yazmıyordum, zaten sizde pek takip etmiyorsunuz :/

Delphi XE8 de kullandığım, mobil uygulamalarımda ini dosyalarımı depoladığım ufak bir fonksiyonu sizinle tanıştırmak istiyorum (:

Hi mates,

I havent wrotten a long time, anyway you dont follow me.

I want to share a function for specific documents folder for mobile. Generally I use it for placed my ini files.

Uses
  System.IOUtils;

Function IniYolu:String;
begin
 Result := GetHomePath + PathDelim + 'Documents' + PathDelim + 'CozBabamCoz.ini';
 {$IFDEF ANDROID}
  Result := TPath.GetDocumentsPath + PathDelim + 'CozBabamCoz.ini';
 {$ENDIF}
end;

Merahaba,

Programınızı uyarı verdirerek performanslı bir şekilde kapatabilirsiniz.

procedure ExitWithMessage; assembler;
asm
  // Bazı adresleri temizleyerek yol açıyoruz
  mov ecx, 5
  @clear_loop:
  dec ecx
  mov dword ptr [ecx * 4 + esp], 0
  cmp ecx, 0
  jnz @clear_loop
  // ExitProcess 'ın parametresini belirliyoruz
  push 0
  // MessageBoxA 'nın parametresini belirliyoruz
  push MB_ICONERROR
  push Title
  push Text
  push 0
  //  MessageBox 'ın devam eden adresinden ExitProcess 'ı çağarıyoruz
  lea eax, ExitProcess
  push eax
  jmp MessageBoxA
end;

Merhaba arkadaşlar,
Bu başlık altında daha önce her hangi bir derleyiciyle(dil fark etmez) derlenmiş dll içerisinden, dışarıya export ettiği fonksiyon ve prosedür isimlerini göreceğiz.
Uses kısmı:

uses
  ImageHlp;

Dışarı aktarmayı yapacak babayiğit;

procedure ListDLLExports(const FileName: string; List: TStrings);
type
  TDWordArray = array [0..$FFFFF] of DWORD;
var
  imageinfo: LoadedImage;
  pExportDirectory: PImageExportDirectory;
  dirsize: Cardinal;
  pDummy: PImageSectionHeader;
  i: Cardinal;
  pNameRVAs: ^TDWordArray;
  Name: string;
begin
  List.Clear;
  if MapAndLoad(PChar(FileName), nil, @imageinfo, True, True) then
  begin
    try
      pExportDirectory := ImageDirectoryEntryToData(imageinfo.MappedAddress,
        False, IMAGE_DIRECTORY_ENTRY_EXPORT, dirsize);
      if (pExportDirectory <> nil) then
      begin
        pNameRVAs := ImageRvaToVa(imageinfo.FileHeader, imageinfo.MappedAddress,
          DWORD(pExportDirectory^.AddressOfNames), pDummy);
        for i := 0 to pExportDirectory^.NumberOfNames - 1 do
        begin
          Name := PChar(ImageRvaToVa(imageinfo.FileHeader, imageinfo.MappedAddress,
            pNameRVAs^[i], pDummy));
          List.Add(Name);
        end;
      end;
    finally
      UnMapAndLoad(@imageinfo);
    end;
  end;
end;

Kullanımı:

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStrings;
  i: Integer;
  s: string;
begin
  List := TStringList.Create;
  try
    ListDLLExports('C:\WINDOWS\SYSTEM32\browseui.dll', List);
    ShowMessage(IntToStr(list.Count) + ' functions in dll');
    s := 'List of functions:';
    for i := 0 to List.Count - 1 do
      s := s + #13#10 + List[i];
    ShowMessage(S);
  finally
    List.Free
  end;
end;

Tepe tepe kullanın (:

Merhaba,

Öncelikle herkese iyi bayramlar (:

Aşağıdaki kod örneklerimizle Delphi’de metin dizisi oluşturmayı göreceğiz.

function RastgeleMetinDizisi:string;
const
  Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
var
  S: string;
  i, N: integer;
begin
  Randomize;
  S := '';
  for i := 1 to 5 do begin
    N := Random(Length(Chars)) + 1;
    S := S + Chars[N];
  end;
  result := S;
end;

Merhaba,

Aşağıda ki kod ile kolayca nette ki resmi programımızda göstereceğiz.

Uses:

IdHTTP,Classes,jpeg;

Kodumuz:

procedure res_cek(url:string,image:timage);
var
 MS : TMemoryStream;
 jpg : TJPEGImage;
 http : TidHTTP;
begin
 MS := TMemoryStream.Create;
 jpg := TJPEGImage.Create;
 http := tidhttp.create;
 try
  http.get(url,MS);
  Ms.Seek(0,soFromBeginning);
  jpg.LoadFromStream(MS);
  Image.Picture.Assign(jpg);
 finally
  FreeAndNil(jpg);
  FreeAndNil(MS);
  FreeAndNil(http);
 end;
end;

Kullanımı:

res_cek('http://img3.wikia.nocookie.net/__cb20130804012914/zootycoon/images/0/09/Bengal_tiger.jpg',image1);

Merhaba,

Delphi ile kolayca ekran görüntüsü alıp image nesnesine aktarabiliriz.

procedure ScreenShot(x: Integer;
 y: Integer; //(x, y) = Left-top coordinate
 Width: Integer;
 Height: Integer; //(Width-Height) = Bottom-Right coordinate
 bm: TBitMap); //Destination
var
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
 {test width and height}
 if ((Width = 0) or
 (Height = 0)) then
 Exit;
 bm.Width := Width;
 bm.Height := Height;
 {get the screen dc}
 dc := GetDc(0);
 if (dc = 0) then
 Exit;
 {do we have a palette device?}
 if (GetDeviceCaps(dc, RASTERCAPS) and
 RC_PALETTE = RC_PALETTE) then
 begin
 {allocate memory for a logical palette}
 GetMem(lpPal,
 SizeOf(TLOGPALETTE) +
 (255 * SizeOf(TPALETTEENTRY)));
 {zero it out to be neat}
 FillChar(lpPal^,
 SizeOf(TLOGPALETTE) +
 (255 * SizeOf(TPALETTEENTRY)),
 #0);
 {fill in the palette version}
 lpPal^.palVersion := $300;
 {grab the system palette entries}
 lpPal^.palNumEntries :=
 GetSystemPaletteEntries(dc,
 0,
 256,
 lpPal^.palPalEntry);
 if (lpPal^.PalNumEntries <> 0) then
 {create the palette}
 bm.Palette := CreatePalette(lpPal^);
 FreeMem(lpPal, SizeOf(TLOGPALETTE) +
 (255 * SizeOf(TPALETTEENTRY)));
 end;
 {copy from the screen to the bitmap}
 BitBlt(bm.Canvas.Handle,
 0,
 0,
 Width,
 Height,
 Dc,
 x,
 y,
 SRCCOPY);
 {release the screen dc}
 ReleaseDc(0, dc);
end;

Kullanımı;

ScreenShot(0,0,Screen.Width, Screen.Height, Image1.Picture.Bitmap);

Merhaba,

Şimdi bildiğimiz üzere yaratan da Allah yok edende Allah (: Bu sebeple biz kullar hiç bir zaman ne sanal alemde nede yer yüzünde bir şeyi yok edemeyiz. Daş olur gum olur bir şeyler olur..

Bilgisayarda dosyaları sildiğimiz zaman, bu dosyalar puff oluyor fakat sabit sürücümüzün bir köşesinde babasından dayak yemişcesine saklanıyor ve recover yazılımlarıyla tam anlamıyla geri getirilebilir durumda oluyor. Tamda burada aşağıdaki kodumuz devreye girecek. Aşağıdaki kod sayesinde dosyaları yapılarını bozarak sileceğiz, böylece dosyalar geri getirilse bile kullanılamaz durumda olacak.

procedure OperekSil(FileName: string);
var
 buffer: array [0..4095] of Byte;
 max, n: LongInt;
 i: Integer;
 fs: TFileStream;

 procedure RandomizeBuffer;
 var
 i: Integer;
 begin
 for i := Low(buffer) to High(buffer) do
 buffer[i] := Random(256);
 end;
begin
 fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
 try
 for i := 1 to 3 do
 begin
 RandomizeBuffer;
 max := fs.Size;
 fs.Position := 0;
 while max > 0 do
 begin
 if max > SizeOf(buffer) then
 n := SizeOf(buffer)
 else
 n := max;
 fs.Write(Buffer, n);
 max := max - n;
 end;
 FlushFileBuffers(fs.Handle);
 end;
 finally
 fs.Free;
 end;
 Deletefile(FileName);
end;

Merhaba,

Checksum nedir? Kısaca bir dosyanın eşsiz(benzersiz) karakter bazlı yansımasıdır.

Checksum ne işe yarar? Bir dosyada sonradan değişiklik yapılmış mı kontrol ettirmek için kullanabilirsiniz.

Checksum iyi bir şey mi? Bilmiyorum ki.

function GetCheckSum(FileName: string): DWORD;
var
 F: file of DWORD;
 P: Pointer;
 Fsize: DWORD;
 Buffer: array [0..500] of DWORD;
begin
 FileMode := 0;
 AssignFile(F, FileName);
 Reset(F);
 Seek(F, FileSize(F) div 2);
 Fsize := FileSize(F) - 1 - FilePos(F);
 if Fsize > 500 then Fsize := 500;
 BlockRead(F, Buffer, Fsize);
 Close(F);
 P := @Buffer;
 asm
 xor eax, eax
 xor ecx, ecx
 mov edi , p
 @again:
 add eax, [edi + 4*ecx]
 inc ecx
 cmp ecx, fsize
 jl @again
 mov @result, eax
 end;
end;

Merhaba,

Bildiğimiz üzere programımız ne kadar form içerirse içersin bir tanesi ana form(main form) şeklinde oluşturuluyor. Aşağıdaki kod ile çalışma zamanında(at run-time) ana formumuzu değiştirebiliriz.

procedure SetAsMainForm(aForm:TForm);
var
 P:Pointer;
begin
 P := @Application.Mainform;
 Pointer(P^) := aForm;
end;

Buradan alıntı yaptım(http://www.swissdelphicenter.ch/torry/showcode.php?id=665)