Anfidya'nın arka bahçesi..

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,

Bir metin içerisindeki veriyi, belirlediğimiz başka bir veriyle değiştirebiliriz. Bunun için StringReplace fonksiyonunu kullanacağız.

StringReplace fonksiyonu SysUtils.pas içerisinde bulunur. Uses kısmına SysUtils ekleyerek rahatça ulaşabiliriz.

function StringReplace ( const SourceString, OldPattern, NewPattern : string; Flags : TReplaceFlags ) : string;

şeklinde tanımlanmıştır. Hadi bunu biraz açalım..

SourceString -> ana metnimizi tanımlayacağımız yer.
OldPattern -> metin içerisinde aranacak dizi
NewPattern -> ana metnimizde OldPattern yerine yazılacak dizi
Flags -> yazma izinleri

Örnek vererek devam edelim;

var
 metin,sonra : String;
begin
 metin := 'anfidya''ya el salla';
 sonra := StringReplace(metin,'el','kol',[rfReplaceAll, rfIgnoreCase]);
end;

Yukarıda “anfidya’ya el salla’ yazısındaki “el” metnini “kol” olarak değiştirdik. Eğer “metin” ve “sonra” değişkenlerini ShowMessage ile ekrana bastırırsak karşımıza şöyle bir sonuç çıkacaktır;

anfidya'ya el salla
anfidya'ya kol salla

Flags kısmına gelen yerde iki tane tanım kullandık. Bunlar rfReplaceAll ve rfIgnoreCase.
rfReplaceAll -> metin içerisinde bulunan tüm eşleşmeleri değiştirir.
rfIgnoreCase -> metin içerisinde eşleşme yaparken küçük,büyük harf uyumuna dikkat etmez.

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,

Aşağıdaki kodlar ile herhangi bir işlemi pid numarası ile durdurabilir ve tekrar aktif edebiliriz.

Uses:

Windows,ShlObj,ShFolder,ShellAPi, ImageHlp, messages, TLHelp32, psAPI;

Kod kısmımız:

 const
 THREAD_TERMINATE = ($0001);
 THREAD_SUSPEND_RESUME = ($0002);
 THREAD_GET_CONTEXT = ($0008);
 THREAD_SET_CONTEXT = ($0010);
 THREAD_SET_INFORMATION = ($0020);
 THREAD_QUERY_INFORMATION = ($0040);
 THREAD_SET_THREAD_TOKEN = ($0080);
 THREAD_IMPERSONATE = ($0100);
 THREAD_DIRECT_IMPERSONATION = ($0200);
 THREAD_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3FF);

procedure PauseProcess(Pid: integer);
 var
 Thread32: TThreadEntry32;
 ThreadSnapshot: THandle;
 ThreadHandle: THandle;
 begin
 ThreadSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, Pid);
 Thread32.dwSize := SizeOf(TThreadEntry32);
 Thread32First(ThreadSnapshot, Thread32);
 repeat
 if Thread32.th32OwnerProcessID = Pid then begin
 ThreadHandle := OpenThread(THREAD_ALL_ACCESS,False,Thread32.th32ThreadID);
 SuspendThread(ThreadHandle);
 CloseHandle(ThreadHandle);
 end;
 until not (Thread32Next(ThreadSnapshot, Thread32));
 CloseHandle(ThreadSnapshot);
 end;

procedure ResumeProcess(Pid: integer);
 var
 Thread32: TThreadEntry32;
 ThreadSnapshot: THandle;
 ThreadHandle: THandle;
 begin
 ThreadSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPTHREAD, Pid);
 Thread32.dwSize := SizeOf(TThreadEntry32);
 Thread32First(ThreadSnapshot, Thread32);
 repeat
 if Thread32.th32OwnerProcessID = Pid then begin
 ThreadHandle := OpenThread(THREAD_ALL_ACCESS,False,Thread32.th32ThreadID);
 ResumeThread(ThreadHandle);
 CloseHandle(ThreadHandle);
 end;
 until not (Thread32Next(ThreadSnapshot, Thread32));
 CloseHandle(ThreadSnapshot);
 end;

Yıllar sonra gelen güncelleme;

function OpenThread( dwDesiredAccess: DWORD ; bInheritHandle: Boolean;
dwThreadId: DWORD ): THandle;
implementation
function OpenThread; external 'kernel32.dll' name 'OpenThread';

Lazım oldu kullandım bunlar eksikmiş gençler sorry :/

Merhaba, Showmessage veya messagebox türevi kullanmadan, Form oluşturarak mesaj ekranı oluşturma işlemini yapabilirsiniz.

procedure ZamanliMesajKutusu(const Baslik, Mesaj: string; Zaman: Integer);
var
 Form: TForm;
 Prompt: TLabel;
 DialogUnits: TPoint;
 nX, Lines: Integer;

 function GetAveCharSize(Canvas: TCanvas): TPoint;
 var
 I: Integer;
 Buffer: array[0..51] of Char;
 begin
 for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
 for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
 GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
 Result.X := Result.X div 52;
 end;

begin
 Form := TForm.Create(Application);
 Lines := 0;

 For nX := 1 to Length(Mesaj) do
 if APrompt[nX]=#13 then Inc(Lines);

 with Form do
 try
 Font.Name:='Arial'; 
 Font.Size:=10; 
 Font.Style:=[fsBold];
 Canvas.Font := Font;
 DialogUnits := GetAveCharSize(Canvas);
 //BorderStyle := bsDialog;
 BorderStyle := bsToolWindow;
 FormStyle := fsStayOnTop;
 BorderIcons := [];
 Caption := Baslik;
 ClientWidth := MulDiv(Screen.Width div 4, DialogUnits.X, 4);
 ClientHeight := MulDiv(23 + (Lines*10), DialogUnits.Y, 8);
 Position := poScreenCenter;

 Prompt := TLabel.Create(Form);
 with Prompt do
 begin
 Parent := Form;
 AutoSize := True;
 Left := MulDiv(8, DialogUnits.X, 4);
 Top := MulDiv(8, DialogUnits.Y, 8);
 Caption := Mesaj;
 end;

 Form.Width:=Prompt.Width+Prompt.Left+50; 

 Show;
 Application.ProcessMessages;
 finally
 Sleep(Zaman*1000);
 Form.Free;
 end;
end;