Anfidya'nın arka bahçesi..

There is dark web in the deep web..

[Delphi] Rastgele Metin Dizisi

2 comments

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;

Written by anfidya

Ekim 4th, 2014 at 4:07 am

[Delphi] İnternetteki resmi image nesnesine çekme

2 comments

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);

Written by anfidya

Eylül 27th, 2014 at 3:26 pm

Posted in Delphi

Tagged with ,

[Delphi] Programı Suspend ve Resume Etme(Durdur&Çalıştır)

leave a comment

Merhaba,

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

Uses:

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;

Written by anfidya

Eylül 25th, 2014 at 1:32 am

Posted in Delphi

Tagged with

[Delphi] Ekran Görüntüsü Alma

leave a comment

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);

Written by anfidya

Eylül 14th, 2014 at 8:51 pm

[Delphi] Dosyayı Bozarak Silme

leave a comment

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;

Written by anfidya

Eylül 12th, 2014 at 2:17 am

[Delphi] CheckSum Değeri Alma

leave a comment

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;

Written by anfidya

Eylül 12th, 2014 at 1:48 am

[Delphi] Çalışma Zamanında Ana Form’u Değiştirme

leave a comment

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)

Written by anfidya

Eylül 11th, 2014 at 12:39 am

[Delphi] Rot13 Metin Şifreleme

leave a comment

Merhaba,

Metin şifreleme ve çözme konusunda pek güçlü olmasada iş görür bir kardeşimiz var, Rot13 (:

procedure ROT13(var Str: string);
const
 OrdBigA = Ord('A');
 OrdBigZ = Ord('Z');
 OrdSmlA = Ord('a');
 OrdSmlZ = Ord('z');
var
 i, o: integer;
begin
 for i := 1 to length(Str) do
 begin
 o := Ord(Str[i]);
 if InRange(o, OrdBigA, OrdBigZ) then
 Str[i] := Chr(OrdBigA + (o - OrdBigA + 13) mod 26)
 else if InRange(o, OrdSmlA, OrdSmlZ) then
 Str[i] := Chr(OrdSmlA + (o - OrdSmlA + 13) mod 26);
 end;
end;

function ROT13fun(const Str: string): string;
begin
 result := Str;
 ROT13(result);
end;

Kullanımı;

 Caption := Rot13Fun('www.AnanıBacınıŞifreleselerHoşunaGiderMi.com');

Written by anfidya

Eylül 11th, 2014 at 12:32 am

[Delphi] Çalıştırılabilir bir dosyanın dijital imzalı olup olmadığını kontrol etme

leave a comment

Merhaba,

Anti cheat yazarken dijital imzalı programları yakalamak için bir araştırma yapmıştım. Arşivimde gözüme çarptı paylaşmak istedim. Kodlar netten alıntıdır ve maalesef nereden aldığımı kaydetmemişim artık paylaşan hakkını helal etsin 😀

// Imagehlp.dll
const
 CERT_SECTION_TYPE_ANY = $FF; // Any Certificate type

function ImageEnumerateCertificates(FileHandle: THandle; TypeFilter: WORD;
 out CertificateCount: DWORD; Indicies: PDWORD; IndexCount: Integer): BOOL; stdcall; external 'Imagehlp.dll';
function ImageGetCertificateHeader(FileHandle: THandle; CertificateIndex: Integer;
 var CertificateHeader: TWinCertificate): BOOL; stdcall; external 'Imagehlp.dll';
function ImageGetCertificateData(FileHandle: THandle; CertificateIndex: Integer;
 Certificate: PWinCertificate; var RequiredLength: DWORD): BOOL; stdcall; external 'Imagehlp.dll';

// Crypt32.dll
const
 CERT_NAME_SIMPLE_DISPLAY_TYPE = 4;
 PKCS_7_ASN_ENCODING = $00010000;
 X509_ASN_ENCODING = $00000001;

type
 PCCERT_CONTEXT = type Pointer;
 HCRYPTPROV_LEGACY = type Pointer;
 PFN_CRYPT_GET_SIGNER_CERTIFICATE = type Pointer;

 CRYPT_VERIFY_MESSAGE_PARA = record
 cbSize: DWORD;
 dwMsgAndCertEncodingType: DWORD;
 hCryptProv: HCRYPTPROV_LEGACY;
 pfnGetSignerCertificate: PFN_CRYPT_GET_SIGNER_CERTIFICATE;
 pvGetArg: Pointer;
 end;

function CryptVerifyMessageSignature(const pVerifyPara: CRYPT_VERIFY_MESSAGE_PARA;
 dwSignerIndex: DWORD; pbSignedBlob: PByte; cbSignedBlob: DWORD; pbDecoded: PBYTE;
 pcbDecoded: PDWORD; ppSignerCert: PCCERT_CONTEXT): BOOL; stdcall; external 'Crypt32.dll';
function CertGetNameStringA(pCertContext: PCCERT_CONTEXT; dwType: DWORD; dwFlags: DWORD; pvTypePara: Pointer;
 pszNameString: PAnsiChar; cchNameString: DWORD): DWORD; stdcall; external 'Crypt32.dll';
function CertFreeCertificateContext(pCertContext: PCCERT_CONTEXT): BOOL; stdcall; external 'Crypt32.dll';
function CertCreateCertificateContext(dwCertEncodingType: DWORD;
 pbCertEncoded: PBYTE; cbCertEncoded: DWORD): PCCERT_CONTEXT; stdcall; external 'Crypt32.dll';

// WinTrust.dll
const
 WINTRUST_ACTION_GENERIC_VERIFY_V2: TGUID = '{00AAC56B-CD44-11d0-8CC2-00C04FC295EE}';
 WTD_CHOICE_FILE = 1;
 WTD_REVOKE_NONE = 0;
 WTD_UI_NONE = 2;

type
 PWinTrustFileInfo = ^TWinTrustFileInfo;
 TWinTrustFileInfo = record
 cbStruct: DWORD; // = sizeof(WINTRUST_FILE_INFO)
 pcwszFilePath: PWideChar; // required, file name to be verified
 hFile: THandle; // optional, open handle to pcwszFilePath
 pgKnownSubject: PGUID; // optional: fill if the subject type is known
 end;

 PWinTrustData = ^TWinTrustData;
 TWinTrustData = record
 cbStruct: DWORD;
 pPolicyCallbackData: Pointer;
 pSIPClientData: Pointer;
 dwUIChoice: DWORD;
 fdwRevocationChecks: DWORD;
 dwUnionChoice: DWORD;
 pFile: PWinTrustFileInfo;
 dwStateAction: DWORD;
 hWVTStateData: THandle;
 pwszURLReference: PWideChar;
 dwProvFlags: DWORD;
 dwUIContext: DWORD;
 end;

function WinVerifyTrust(hwnd: HWND; const ActionID: TGUID; ActionData: Pointer): Longint; stdcall; external wintrust;

{-----------------------------------------------}

function IsCodeSigned(const Filename: string): Boolean;
var 
 file_info: TWinTrustFileInfo;
 trust_data: TWinTrustData;
begin
 // Verify that the exe is signed and the checksum matches
 FillChar(file_info, SizeOf(file_info), 0);
 file_info.cbStruct := sizeof(file_info);
 file_info.pcwszFilePath := PWideChar(WideString(Filename));
 FillChar(trust_data, SizeOf(trust_data), 0);
 trust_data.cbStruct := sizeof(trust_data);
 trust_data.dwUIChoice := WTD_UI_NONE;
 trust_data.fdwRevocationChecks := WTD_REVOKE_NONE;
 trust_data.dwUnionChoice := WTD_CHOICE_FILE;
 trust_data.pFile := @file_info;
 Result := WinVerifyTrust(INVALID_HANDLE_VALUE, WINTRUST_ACTION_GENERIC_VERIFY_V2,
 @trust_data) = ERROR_SUCCESS
end;

{-----------------------------------------------}

function IsCompanySigningCertificate(const Filename, CompanyName :string): Boolean;
var
 hExe: HMODULE;
 Cert: PWinCertificate;
 CertContext: PCCERT_CONTEXT;
 CertCount: DWORD;
 CertName: AnsiString;
 CertNameLen: DWORD;
 VerifyParams: CRYPT_VERIFY_MESSAGE_PARA;
begin
 // Returns TRUE if the SubjectName on the certificate used to sign the exe is
 // "Company Name". Should prevent a cracker from modifying the file and
 // re-signing it with their own certificate.
 //
 // Microsoft has an example that does this using CryptQueryObject and
 // CertFindCertificateInStore instead of CryptVerifyMessageSignature, but
 // CryptQueryObject is NT-only. Using CertCreateCertificateContext doesn't work
 // either, though I don't know why.
 Result := False;
 // Verify that the exe was signed by our private key
 hExe := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ,
 nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_RANDOM_ACCESS, 0);
 if hExe = INVALID_HANDLE_VALUE then
 Exit;
 try
 // There should only be one certificate associated with the exe
 if (not ImageEnumerateCertificates(hExe, CERT_SECTION_TYPE_ANY, CertCount, nil, 0)) or
 (CertCount <> 1) then
 Exit;
 // Read the certificate header so we can get the size needed for the full cert
 GetMem(Cert, SizeOf(TWinCertificate) + 3); // ImageGetCertificateHeader writes an DWORD at bCertificate for some reason
 try
 Cert.dwLength := 0;
 Cert.wRevision := WIN_CERT_REVISION_1_0;
 if not ImageGetCertificateHeader(hExe, 0, Cert^) then
 Exit;
 // Read the full certificate
 ReallocMem(Cert, SizeOf(TWinCertificate) + Cert.dwLength);
 if not ImageGetCertificateData(hExe, 0, Cert, Cert.dwLength) then
 Exit;
 // Get the certificate context. CryptVerifyMessageSignature has the
 // side effect of creating a context for the signing certificate.
 FillChar(VerifyParams, SizeOf(VerifyParams), 0);
 VerifyParams.cbSize := SizeOf(VerifyParams);
 VerifyParams.dwMsgAndCertEncodingType := X509_ASN_ENCODING or PKCS_7_ASN_ENCODING;
 if not CryptVerifyMessageSignature(VerifyParams, 0, @Cert.bCertificate,
 Cert.dwLength, nil, nil, @CertContext) then
 Exit;
 try
 // Extract and compare the certificate's subject names. Don't
 // compare the entire certificate or the public key as those will
 // change when the certificate is renewed.
 CertNameLen := CertGetNameStringA(CertContext,
 CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, nil, nil, 0);
 SetLength(CertName, CertNameLen - 1);
 CertGetNameStringA(CertContext, CERT_NAME_SIMPLE_DISPLAY_TYPE, 0,
 nil, PAnsiChar(CertName), CertNameLen);
 if CertName <> CompanyName then 
 Exit;
 finally
 CertFreeCertificateContext(CertContext)
 end;
 finally
 FreeMem(Cert);
 end;
 finally
 CloseHandle(hExe);
 end;
 Result := True;
end;

Written by anfidya

Eylül 11th, 2014 at 12:11 am

[Delphi] Zamanlı Mesaj Kutusu

leave a comment

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;

Written by anfidya

Eylül 9th, 2014 at 11:54 pm