vergi kimlik bulan kod
arkada ş lar eğ ı n ı z ı n vergikimlik numaras ı n ı bulmas ı n ı istiyorsan ı z ...
i ş te kod fakat vergikimlik i ç in kompanentini kurman ı z gerekli
{------------------------------------------------------------------------------}
VergiKimlikNoBul1 . Active := tRUE ;
VergiKimlikNoBul1 . VergiKimlikNoBul ();
edit6 . Text := VergiKimlikNoBul1 . VergiKimlikNo ;
edit5 . text := VergiKimlikNoBul1 . VergiDairesi ;
Delphi - .....................................
verginumarası bulan kod
arkada ş lar eğ ı n ı z ı n vergikimlik numaras ı n ı bulmas ı n ı istiyorsan ı z ...
i ş te kod fakat vergikimlik i ç in kompanentini kurman ı z gerekli
{------------------------------------------------------------------------------}
VergiKimlikNoBul1 . Active := tRUE ;
VergiKimlikNoBul1 . VergiKimlikNoBul ();
edit6 . Text := VergiKimlikNoBul1 . VergiKimlikNo ;
edit5 . text := VergiKimlikNoBul1 . VergiDairesi ;
Delphi - .....................................
y.o.k.
unit Unit1 ;
{
the classification of the field names and table names from
different databases
}
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , ADODb , StdCtrls , DB , cxControls , cxContainer , cxEdit , cxCheckBox ;
type
TForm1 = class ( TForm )
Button1 : TButton ;
ADOConnection1 : TADOConnection ;
Memo1 : TMemo ;
Edit1 : TEdit ;
Label1 : TLabel ;
Edit2 : TEdit ;
Label2 : TLabel ;
Edit3 : TEdit ;
Label3 : TLabel ;
cxCheckBox1 : TcxCheckBox ;
procedure Button1Click ( Sender : TObject );
function funcall : integer ;
private
{ Private declarations }
public
{ Public declarations }
end ;
type
TTableType = ( ttTable , ttView , ttSynonym , ttSystemTable , ttAccessTable );
type
TTableTypes = set of TTableType ;
type
TTableItem = record
ItemName : string ;
ItemType : string ;
end ;
type
TTableItems = array of TTableItem ;
function addFilter ( string1 , string2 : string ): string ;
function ADODbTables ( ADOConnection : TADOConnection ; types : TTableTypes ): TTableItems ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
function addFilter ( string1 , string2 : string ): string ;
begin
if string1 <> '' then
Result := string1 + ' or ' + string2
else
Result := string2 ;
end ;
function ADODbTables ( ADOConnection : TADOConnection ; types : TTableTypes ): TTableItems ;
var
ADODataSet : TADODataSet ;
i : integer ;
begin
ADODataSet := TADODataSet . Create ( nil );
ADODataSet . Connection := ADOConnection ;
ADOConnection . OpenSchema ( siTables , EmptyParam , EmptyParam , ADODataSet );
if ( ttTable in types ) then
ADODataSet . Filter := addFilter ( ADODataSet . Filter , '(TABLE_TYPE = ''TABLE'')' );
if ( ttView in types ) then
ADODataSet . Filter := addFilter ( ADODataSet . Filter , '(TABLE_TYPE = ''VIEW'')' );
if ( ttSynonym in types ) then
ADODataSet . Filter := addFilter ( ADODataSet . Filter , '(TABLE_TYPE = ''SYNONYM'')' );
if ( ttSystemTable in types ) then
ADODataSet . Filter := addFilter ( ADODataSet . Filter , '(TABLE_TYPE = ''SYSTEM TABLE'')' );
if ( ttAccessTable in types ) then
ADODataSet . Filter := addFilter ( ADODataSet . Filter , '(TABLE_TYPE = ''ACCESS TABLE'')' );
ADODataSet . Filtered := True ;
SetLength ( Result , ADODataSet . RecordCount );
i := 0 ;
with ADODataSet do
begin
First ;
while not EOF do
begin
with Result [ i ] do
begin
ItemName := FieldByName ( 'TABLE_NAME' ). AsString ;
ItemType := FieldByName ( 'TABLE_TYPE' ). AsString ;
end ;
Inc ( i );
Next ;
end ;
end ;
ADODataSet . Free ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
output : ttableitems ;
i : integer ;
begin
if cxCheckBox1 . Checked then
begin
funcall ;
exit ;
end ;
ADOConnection1 . ConnectionTimeout := strtoint ( Edit2 . text );
ADOConnection1 . ConnectionString := Edit1 . Text ;
output := ADODbTables ( ADOConnection1 , [ ttTable , ttView , ttSynonym ]);
// output := ADODbTables(ADOConnection1, [ttSystemTable, ttAccessTable]);
for i := Low ( output ) to High ( output ) do
begin
Memo1 . Lines . Add ( output [ i ]. ItemName + '---' + output [ i ]. ItemType );
end ;
output := nil ;
end ;
function TForm1 . funcall : integer ;
var
output : ttableitems ;
i : integer ;
begin
ADOConnection1 . ConnectionTimeout := strtoint ( Edit2 . text );
ADOConnection1 . ConnectionString := Edit1 . Text ;
output := ADODbTables ( ADOConnection1 , [ ttTable , ttView , ttSynonym ]);
// output := ADODbTables(ADOConnection1, [ttSystemTable, ttAccessTable]);
for i := Low ( output ) to High ( output ) do
begin
if ( output [ i ]. ItemName = Edit3 . Text ) and ( cxCheckBox1 . Checked ) then
Memo1 . Lines . Add ( output [ i ]. ItemName + '---' + output [ i ]. ItemType );
end ;
output := nil ;
end ;
end .
// dewelloper@gmail.com
Delphi - .....................................
site guncelleme
arkadaslar delphi ile alakası yok ama bilenler i ç in soruyorum bi siteyi haz ı rlay ı p yay ı nlad ı ktan sonra guncelleme nas ı l yap ı l ı yor bilen varm ı aceba b ı rde delphide site yapabilirmiyiz
Delphi - .....................................
1273 Sayfalık Delphi 7 Kitabı + Delphi 7 Network uygulamaları + Delphi Trojan Uygulamaları
Size : 9.Mb
Download Linki : http : //www.unihiphop.com/yukleme/delphi.rar
Bu Kitab ı Para Kazanmak Amac ı İ le Ç o ğ alt ı p Satmak Yasakt ı r .
Not : Yeni Ba ş layan i ç in professional yaz ı l ı mc ı lar i ç in idealdir
Delphi - .....................................
C++ Builder TupDown icin Basit bir örnek
#include <vcl.h>
#pragma hdrstop
#include "Unit3.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm3 *Form3;
//---------------------------------------------------------------------------
__fastcall TForm3::TForm3(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
void __fastcall TForm3::UpDown1Changing(TObject *Sender, bool &AllowChange)
{
Edit1->Font->Size=UpDown1->Position;
}
//---------------------------------------------------------------------------
void __fastcall TForm3::UpDown2Changing(TObject *Sender, bool &AllowChange)
{
Edit2->Text=UpDown2->Position;
}
//---------------------------------------------------------------------------
void __fastcall TForm3::Edit2Change(TObject *Sender)
{
UpDown1->Position=StrToInt(Edit2->Text);
}
Bilgiler Paylastikca Güzeldir.
C++ Builder - .....................................
Registry'e Kayıt Ekleme
//Ramazan Arslantürk
//ramazan@deltasoft.com.tr
void __fastcall TDatabaseAyar::btSaveClick(TObject *Sender)
{
String Anahtar;
TRegistry *Reg = new TRegistry;
try
{
Reg->RootKey = HKEY_CURRENT_USER;
Anahtar = "SOFTWAREDELTASOFTAYARLAR";
if (Reg->OpenKey(Anahtar,true ))
{
Reg->WriteString("UserName",Edit1->Text);
Reg->WriteString("Password",Edit2->Text);
Reg->WriteString("Server",Edit3->Text);
Reg->WriteString("Database",Edit4->Text);
Reg->WriteString("Firma",Edit5->Text);
Reg->WriteString("Donem",Edit6->Text);
Reg->WriteString("Bolum",Edit7->Text);
Reg->CloseKey();
ShowMessage("Bilgiler Kaydedildi..");
DatabaseAyar->Free();
}
}
catch (Exception &A)
{
Reg->Free();
Application->MessageBoxA("Database Ayarlarını yapılamadı !..","Dikkat",16);
}
}
C++ Builder - .....................................
String içindeki kelime sayısını bulma
function KelimeSayisiniBul ( s : string )
: integer ;
var
ps : PChar ;
nSpaces ,
n : integer ;
begin
n := 0 ;
s := s + #0 ;
ps := @ s [ 1 ];
while ( #0 <> ps ^ ) do
begin
while(( ' ' = ps ^) and ( #0 <> ps ^)) do
begin
inc ( ps );
end ;
nSpaces := 0 ;
while (( ' ' <> ps ^) and ( #0 <> ps ^)) do
begin
inc ( nSpaces );
inc ( ps );
end ;
if ( nSpaces > 0 ) then
begin
inc ( n );
end ;
end ;
Result := n ;
end ;
code edited by www . mevlanabilgisayar . com
Delphi - .....................................
GİRİLEN SAYI YAZI BİÇİMİNDE İFADE ELİLİR (örn: 1000 - bin gibi)
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , Borland . Vcl . StdCtrls , System . ComponentModel ;
type
TForm1 = class ( TForm )
Edit1 : TEdit ;
Label1 : TLabel ;
Button1 : TButton ;
procedure Button1Click ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
//18 basamaklı-katrilyon, daha da artırılabilir
max_basamak_say : Integer = 18 ;
birler : array [ 0 .. 9 ] of string = ( '' , 'bir' , 'iki' , 'üç' , 'dört' , 'beş' ,
'altı' , 'yedi' , 'sekiz' , 'dokuz' );
onlar : array [ 0 .. 9 ] of string = ( '' , 'on' , 'yirmi' , 'otuz' , 'kırk' , 'elli' ,
'altmış' , 'yetmiş' , 'seksen' , 'doksan' );
//Eğer 18 basamaktan daha fazla kullanacaksanız
//katrilyondan önce o basamakları da ekleyin
binler : array [ 0 .. 5 ] of string = ( 'katrilyon' , 'trilyon' , 'milyar' ,
'milyon' , 'bin' , '' );
implementation
{$R *.nfm}
function cevir ( sayi : string ): string ;
var
i , uz : Integer ;
bas : Array [ 0 .. 2 ] of Integer ;
sonuc , ara_sonuc : String ;
Begin
sonuc := '' ;
ara_sonuc := '' ;
uz := sayi . Length ;
//sayının kullanılmayan basamaklarını sıfırla doldur
sayi := sayi . PadLeft ( max_basamak_say , '0' );
//sayiyı üçerli basamaklar halinde ele al
for i := 0 to max_basamak_say div 3 - 1 do
Begin
//üçlü basamaktaki birinci sayi yani yüzler basamağı
bas [ 0 ] := StrToInt ( sayi . Substring ( i * 3 , 1 ));
//üçlü basamaktaki ikinci sayi yani onlar basamağı
bas [ 1 ] := StrToInt ( sayi . Substring (( i * 3 ) + 1 , 1 ));
//üçlü basamaktaki üçüncü sayi yani birler basamağı
bas [ 2 ] := StrToInt ( sayi . Substring (( i * 3 ) + 2 , 1 ));
if ( bas [ 0 ] = 0 ) then
ara_sonuc := '' //yüzler basamağı boş
else
if ( bas [ 0 ] = 1 ) then
ara_sonuc := 'yüz'
//yüzler basamağında 1 varsa 1 yüz olmaz sadece yüz
else
ara_sonuc := birler [ bas [ 0 ]] + 'yüz' ;
//yüzler basamağındaki sayi ve yüz (beşyüz gibi)
//yüzler+onlar+birler basamağını birleştir
ara_sonuc := ara_sonuc + onlar [ bas [ 1 ]] + birler [ bas [ 2 ]];
//basamak değeri oluşmadıysa yani 000 ise binler basamağını ekle
if ( ara_sonuc <> '' ) then
ara_sonuc := ara_sonuc + binler [ i ];
//birbin olmaz
if (( i > 1 ) and ( ara_sonuc = 'birbin' )) then
ara_sonuc := 'bin' ;
if ( ara_sonuc <> '' ) then
sonuc := sonuc + ara_sonuc + ' ' ;
End ;
if ( sonuc . Trim () = '' ) then
sonuc := 'sıfır' ;
result := sonuc . Trim ();
End ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
try
Label1 . Caption := cevir ( Edit1 . Text );
except
ShowMessage ( 'Geçersiz sayı' );
End ;
end ;
end .
Delphi.NET - .....................................
YÜRÜYEN YAZI
unit Unit2 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , Borland . Vcl . ExtCtrls , System . ComponentModel , Borland . Vcl . StdCtrls ;
type
TForm2 = class ( TForm )
Edit1 : TEdit ;
Timer1 : TTimer ;
procedure Timer1Timer ( Sender : TObject );
procedure FormCreate ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form2 : TForm2 ;
implementation
{$R *.nfm}
procedure TForm2 . FormCreate ( Sender : TObject );
begin
edit1 . Text := 'YÜRÜYEN YAZI ' ;
timer1 . Interval := 50 ;
timer1 . Enabled := true ;
end ;
procedure TForm2 . Timer1Timer ( Sender : TObject );
begin
edit1 . Text := string ( edit1 . Text ). Substring ( 1 )+
string ( edit1 . Text ). Substring ( 0 , 1 );
end ;
end .
Delphi.NET - .....................................
::TrackBar Kullanimi ile ilgili basit bir örnek Form Boyutlandirma ::
Not:Form_üzerine iki tane TrackBar yerlestirin Win32 sekmesinde. Ve sonra su kodlari yazin.
:::FormCreate_Bölümü icin:::
TrackBar2->Orientation=trVertical;
TrackBar1->Orientation=trHorizental;
TrackBar1->Max=Screen->Width;
TrackBar1->Position=Form1->Width;
TrackBar2->Max=Screen->Height;
TrackBar2->Position=Position=Form1->Height;
TrackBar1->Left=0;
TrackBar1->Top=0;
TrackBar2->Left=0;
TrackBar2->Top=TrackBar1->Height;
::: FORMRESIZE_Bölümü icin :::
TrackBar1->Position=Form1->Width;
TrackBar1->Position=Form1->Height;
::: TrackBar1Change :::
Form1->WindowState=0;
Form1->Width=TrackBar1->Position;
::: TrackBar2Change :::
Form1->WindowState=0;
Form1->Height=TrackBar2->Position;
Bilgi Paslastikca Artar .. Saygilar.
C++ Builder - .....................................
media playerde süre (sayın programcı hacker)
var
saat , dakika , saniye : real ;
begin
if mp . mode = mpplay then
begin
saat := trunc (( mp . length - mp . position )/( 25 * 3600 )) mod 24 ;
dakika := trunc (( mp . length - mp . position )/( 25 * 60 )) mod 60 ;
saniye := trunc (( mp . length - mp . position )/ 25 ) mod 60 ;
edit1 . text := timetostr ( strtotime ( floattostr ( saat )+ ':' + floattostr ( dakika )+ ':' + floattostr ( saniye )));
end ;
end ;
say ı n programc ı hacker size 2 ş ey s ö yleyim ..
1 : Ger ç ek bir hacker asla kendine ben hackerim demez ve hackerim diye buralarda hava da atmaz
2 : Madem hackersiniz pardon ö z ü r diliyorum siz hacker programc ı yd ı n ı z hack amac ı yla kullanma ı lmak i ç in yazd ığı nz ı programlar ı g ö rmek isterim ... mail adresim mehmetkocabas2 @ hotmail . com ben sizin mail adresinizle u ğ ra ş amam diyorsan ı z ö rnek programlar b ö l ü m ü ne koyun madem herkes g ö rs ü n bizde bu forumda hacker da varm ış diyelim ..
Delphi - .....................................
2 sorum var
girdiğ im belli bir saat diliminden sonra ( yar ı m saat bir saat sonra ) bilgisayar ı m ı n kapanmas ı n ı istiyorum ne yapabilirim ?
diger sorum delphide m ü z ı k ü zerine program yap ı labilirmi
winamp gibi
Delphi - .....................................
Bir klasörü ve onun altindaki tüm dosyalari ve klasörleri silme
Ancak salt okunur ( read only ) ö zelligi olan ve kullanimda olan dosyalar silinmez .
procedure TForm1 . Button1Click ( Sender : TObject );
var
DirInfo : TSearchRec ;
r : Integer ;
begin
r := FindFirst ( 'C:DownloadTest*.*' , FaAnyfile , DirInfo );
while r = 0 do begin
if (( DirInfo . Attr and FaDirectory <> FaDirectory ) and
( DirInfo . Attr and FaVolumeId <> FaVolumeID )) then
if DeleteFile ( pChar ( 'C:Downloadtest' + DirInfo . Name ))
= false then
ShowMessage ( 'C:Downloadtest' + DirInfo . Name + ' silinemiyor!!!' );
r := FindNext ( DirInfo );
end ;
SysUtils . FindClose ( DirInfo );
if RemoveDirectory ( 'C:DownloadTest' ) = false then
ShowMessage ( 'C:Downloadtest klasörü silinemiyor!!!' );
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Çok Satırlı İp Ucu
procedure TForm1 . FormCreate ( Sender : TObject );
begin
SpeedButton1 . Hint := 'Çok satirli ipucunu ' + chr ( 13 )+
'mutlaka denemelisiniz ' + chr ( 13 )+
'çok güzel' ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Menü'ye bitmap (resim) ekleme
procedure TForm1 . FormCreate ( Sender : TObject );
var
Bmp1 : TPicture ;
begin
Bmp1 := TPicture . Create ;
Bmp1 . LoadFromFile ( 'c:denemeturkey.bmp' );
SetMenuItemBitmaps ( deneme1 . Handle ,
0 ,
MF_BYPOSITION ,
Bmp1 . Bitmap . Handle ,
Bmp1 . Bitmap . Handle );
end ;
Alt + Tab ve Ctrl + Esc tuslarinin kullanilmaz hale getirilmesi ;
var
OldVal : LongInt ;
begin
SystemParametersInfo ( 97 , Word ( True ), @ OldVal , 0 )
//Word(False) ile kullanirsaniz tuslari tekrar kullanabilirsiniz.
Windows ve System klas ö rlerinin bulunmasi
procedure TForm1 . Button1Click ( Sender : TObject );
var
a : Array [ 0 .. 144 ] of char ;
begin
GetWindowsDirectory ( a , sizeof ( a ));
ShowMessage ( StrPas ( a ));
GetSystemDirectory ( a , sizeof ( a ));
ShowMessage ( StrPas ( a ));
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Sayıyı Virgülle Yazma Fonksiyonu
Bunun iç in forma birtana label componenti yerlestirin ve visible ö zeligini false yapin .
function frmt ( yer : string ): string ;
var
s : string ;
uzunluk : integer ;
kalan , k , dgr : integer ;
begin
s := '.' ;
uzunluk := Length ( yer );
dgr := uzunluk div 3 ;
kalan := uzunluk - ( dgr * 3 );
label1 . caption := inttostr ( kalan );
if yer = '0' then
begin
yer := '0,' ;
result := yer ;
exit ;
end ;
if label1 . caption <> '0' then
begin
insert ( s , yer , kalan + 1 );
for k := 1 to dgr do begin
if k = dgr then begin
insert ( ',' , yer ,( kalan +( k * 3 )+ k + 1 ));
result := yer ;
exit ;
end ;
insert ( s , yer ,( kalan +( k * 3 )+ k + 1 ));
end ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Bir Resim Dosyasını Açıp İçine Resim Çizmek
var
Resim : TBitmap ;
Resim := TBitmap . Create ;
with Resim do
try
Width := 100 ;
Height := 100 ;
with Canvas do
begin
Rectangle ( 0 , 0 , 100 , 100 );
MoveTo ( 0 , 0 );
LineTo ( 100 , 100 );
MoveTo ( 0 , 100 );
LineTo ( 100 , 0 );
end ;
SaveToFile ( 'test.bmp' )
finally
Free ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Windows'a True Type Font Ekleme
uses Registry ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
reg : TRegistry ;
b : bool ;
begin CopyFile ( 'C:DOWNLOADFP000100.TTF' , 'C:WINDOWSFONTSFP000100.TTF' , b );
reg := TRegistry . Create ; reg . RootKey := HKEY_LOCAL_MACHINE ;
reg . LazyWrite := false ; reg . OpenKey ( 'SoftwareMicrosoftWindowsCurrentVersionFonts' , false ); reg . WriteString ( 'TESTMICR (TrueType)' , 'FP000100.TTF' );
reg . CloseKey ; reg . free ;
AddFontResource ( 'c:windowsfontsFP000100.TTF' ); SendMessage ( HWND_BROADCAST , WM_FONTCHANGE , 0 , 0 );
RemoveFontResource ( 'c:windowsfontsFP000100.TTF' ); SendMessage ( HWND_BROADCAST , WM_FONTCHANGE , 0 , 0 );
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Formun Boyutlarini Sabitleme
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms , Dialogs ;
type
TForm1 = class ( TForm )
private
{ Private declarations }
public
procedure WMGetMinMaxInfo ( var Message : TWMGetMinMaxInfo ); message WM_GETMINMAXINFO ;
{ Public declarations }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.DFM}
procedure TForm1 . WMGetMinMaxInfo ( var Message : TWMGetMinMaxInfo );
begin
with Message . MinMaxInfo ^ do
begin
ptMaxSize . X := 200 ;
ptMaxSize . Y := 200 ;
ptMaxPosition . X := 99 ;
ptMaxPosition . Y := 99 ;
ptMinTrackSize . X := 100 ;
ptMinTrackSize . Y := 100 ;
ptMaxTrackSize . X := 300 ;
ptMaxTrackSize . Y := 300 ;
end ;
Message . Result := 0 ;
inherited ;
end ;
end .
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Silinmiş Dosyaları Gösterme
type
TForm1 = class ( TForm )
Table1 : TTable ;
DataSource1 : TDataSource ;
DBGrid1 : TDBGrid ;
DBNavigator1 : TDBNavigator ;
CheckBox1 : TCheckBox ;
procedure CheckBox1Click ( Sender : TObject );
public
procedure ShowDeleted ( Table : TTable ; ShowDeleted : Boolean );
end ;
var
Form1 : TForm1 ;
implementation
uses DBITYPES , DBIERRS , DBIPROCS ;
{$R *.DFM}
procedure TForm1 . ShowDeleted ( Table : TTable ; ShowDeleted : Boolean );
var
rslt : DBIResult ;
szErrMsg : DBIMSG ;
begin
Table . DisableControls ;
try
Check ( DbiSetProp ( hDBIObj ( Table . Handle ), curSOFTDELETEON ,
LongInt ( ShowDeleted )));
finally
Table . EnableControls ;
end ;
Table . Refresh ;
end ;
procedure TForm1 . CheckBox1Click ( Sender : TObject );
begin
ShowDeleted ( Table1 , CheckBox1 . Checked );
end ;
end .
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Cd sürücüsünün seri numarasi
function GetDiskVolSerialID ( cDriveName : char ) : DWord ;
var dwTemp1 , dwTemp2 : DWord ;
begin GetVolumeInformation ( PChar ( cDriveName + ':' ), Nil , 0 , @ Result , dwTemp2 , dwTemp2 , Nil , 0 );
end ;
MessageDlg ( 'Serial number: ' + Format ( '%X' , [ GetDiskVolSerialID ( 'E' ) ] ),
mtInformation , [ mbOk ], 0 );
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Control paneldeki bölümleri açma (cpl dosyalarini açma)
unit open_cpl ;
interface
function RunControlPanelApplet ( sAppletFileName : string ) : integer ;
implementation
uses Windows ;
function RunControlPanelApplet ( sAppletFileName : string ) : integer ;
begin
Result := WinExec ( PChar ( 'rundll32.exe shell32.dll,' + 'Control_RunDLL ' + sAppletFileName ), SW_SHOWNORMAL );
end ;
end .
access . cpl : Accessibility Properties
appwiz . cpl : Add / Remove Programs Properties
desk . cpl : Display Properties
intl . cpl : Regional Settings Properties
joy . cpl : Joystick Properties
main . cpl : Mouse Properties
mmsys . cpl : Multimedia Properties
modem . cpl : Modems Properties
sysdm . cpl : System Properties
timedate . cpl : Time / Date Properties
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Avi dosyasinin görünüm alanini seçilen panele esitleme
begin
with MediaPlayer1 do begin
DeviceType := dtAutoSelect ;
visible := false ;
FileName := InputBox ( 'AVI' , 'Enter AVI file name' , 'c:windowsborland.avi' );
display := panel1 ;
open ;
DisplayRect := rect ( 0 , 0 , panel1 . width , panel1 . height ); {This is it!}
rewind ;
play ;
end ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
TStringgrid'i kaydetme ve açma
Procedure SaveGrid ;
var
f : textfile ;
x , y : integer ;
begin
assignfile ( f , 'Filename' );
rewrite ( f );
writeln ( f , stringgrid . colcount );
writeln ( f , stringgrid . rowcount );
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do
writeln ( F , stringgrid . cells [ x , y ]);
closefile ( f );
end ;
Procedure LoadGrid ;
var
f : textfile ;
temp , x , y : integer ;
tempstr : string ;
begin
assignfile ( f , 'Filename' );
reset ( f );
readln ( f , temp );
stringgrid . colcount := temp ;
readln ( f , temp );
stringgrid . rowcount := temp ;
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do begin
readln ( F , tempstr );
stringgrid . cells [ x , y ]:= tempstr ;
end ;
closefile ( f );
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
TStringgrid'i kaydetme ve açma
Procedure SaveGrid ;
var
f : textfile ;
x , y : integer ;
begin
assignfile ( f , 'Filename' );
rewrite ( f );
writeln ( f , stringgrid . colcount );
writeln ( f , stringgrid . rowcount );
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do
writeln ( F , stringgrid . cells [ x , y ]);
closefile ( f );
end ;
Procedure LoadGrid ;
var
f : textfile ;
temp , x , y : integer ;
tempstr : string ;
begin
assignfile ( f , 'Filename' );
reset ( f );
readln ( f , temp );
stringgrid . colcount := temp ;
readln ( f , temp );
stringgrid . rowcount := temp ;
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do begin
readln ( F , tempstr );
stringgrid . cells [ x , y ]:= tempstr ;
end ;
closefile ( f );
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
TStringgrid'i kaydetme ve açma
Procedure SaveGrid ;
var
f : textfile ;
x , y : integer ;
begin
assignfile ( f , 'Filename' );
rewrite ( f );
writeln ( f , stringgrid . colcount );
writeln ( f , stringgrid . rowcount );
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do
writeln ( F , stringgrid . cells [ x , y ]);
closefile ( f );
end ;
Procedure LoadGrid ;
var
f : textfile ;
temp , x , y : integer ;
tempstr : string ;
begin
assignfile ( f , 'Filename' );
reset ( f );
readln ( f , temp );
stringgrid . colcount := temp ;
readln ( f , temp );
stringgrid . rowcount := temp ;
For X := 0 to stringgrid . colcount - 1 do
For y := 0 to stringgrid . rowcount - 1 do begin
readln ( F , tempstr );
stringgrid . cells [ x , y ]:= tempstr ;
end ;
closefile ( f );
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Clipboard'a kopyalama ve yapistirma (copy,past)
procedure CopyButtonClick ( Sender : TObject );
begin
If ActiveControl is TMemo then TMemo ( ActiveControl ). CopyToClipboard ;
If ActiveControl is TDBMemo then TDBMemo ( ActiveControl ). CopyToClipboard ;
If ActiveControl is TEdit then TEdit ( ActiveControl ). CopyToClipboard ;
If ActiveControl is TDBedit then TDBedit ( ActiveControl ). CopyToClipboard ;
end ;
procedure PasteButtonClick ( Sender : TObject );
begin
If ActiveControl is TMemo then TMemo ( ActiveControl ). PasteFromClipboard ;
If ActiveControl is TDBMemo then TDBMemo ( ActiveControl ). PasteFromClipboard ;
If ActiveControl is TEdit then TEdit ( ActiveControl ). PasteFromClipboard ;
If ActiveControl is TDBedit then TDBedit ( ActiveControl ). PasteFromClipboard ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Başlığı Gizlemek Ve Göstermek
Procedure HideTitlebar ;
Var
Save : LongInt ;
Begin
If form1 . BorderStyle = bsNone then Exit ;
Save := GetWindowLong ( form1 . Handle , gwl_Style );
If ( Save and ws_Caption )= ws_Caption then Begin
Case form1 . BorderStyle of
bsSingle ,
bsSizeable : SetWindowLong ( form1 . Handle , gwl_Style , Save and
( Not ( ws_Caption )) or ws_border );
bsDialog : SetWindowLong ( form1 . Handle , gwl_Style , Save and
( Not ( ws_Caption )) or ds_modalframe or ws_dlgframe );
End ;
form1 . Height := form1 . Height - getSystemMetrics ( sm_cyCaption );
form1 . Refresh ;
End ;
end ;
////////////////////////////////////////////////////////////////////////
Procedure ShowTitlebar ;
Var
Save : LongInt ;
begin
If form1 . BorderStyle = bsNone then Exit ;
Save := GetWindowLong ( form1 . Handle , gwl_Style );
If ( Save and ws_Caption )<> ws_Caption then Begin
Case form1 . BorderStyle of
bsSingle ,
bsSizeable : SetWindowLong ( form1 . Handle , gwl_Style , Save or ws_Caption or
ws_border );
bsDialog : SetWindowLong ( form1 . Handle , gwl_Style , Save or ws_Caption or
ds_modalframe or ws_dlgframe );
End ;
form1 . Height := form1 . Height + getSystemMetrics ( sm_cyCaption );
form1 . Refresh ;
End ;
end .
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Başlığı Gizlemek Ve Göstermek
Procedure HideTitlebar ;
Var
Save : LongInt ;
Begin
If form1 . BorderStyle = bsNone then Exit ;
Save := GetWindowLong ( form1 . Handle , gwl_Style );
If ( Save and ws_Caption )= ws_Caption then Begin
Case form1 . BorderStyle of
bsSingle ,
bsSizeable : SetWindowLong ( form1 . Handle , gwl_Style , Save and
( Not ( ws_Caption )) or ws_border );
bsDialog : SetWindowLong ( form1 . Handle , gwl_Style , Save and
( Not ( ws_Caption )) or ds_modalframe or ws_dlgframe );
End ;
form1 . Height := form1 . Height - getSystemMetrics ( sm_cyCaption );
form1 . Refresh ;
End ;
end ;
////////////////////////////////////////////////////////////////////////
Procedure ShowTitlebar ;
Var
Save : LongInt ;
begin
If form1 . BorderStyle = bsNone then Exit ;
Save := GetWindowLong ( form1 . Handle , gwl_Style );
If ( Save and ws_Caption )<> ws_Caption then Begin
Case form1 . BorderStyle of
bsSingle ,
bsSizeable : SetWindowLong ( form1 . Handle , gwl_Style , Save or ws_Caption or
ws_border );
bsDialog : SetWindowLong ( form1 . Handle , gwl_Style , Save or ws_Caption or
ds_modalframe or ws_dlgframe );
End ;
form1 . Height := form1 . Height + getSystemMetrics ( sm_cyCaption );
form1 . Refresh ;
End ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Mouse'un yerini degistirmek
randomize;
SetCursorPos ( random ( 100 ), random ( 100 ));
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
String'i renk'e renk'i stringe çevirme
Uses graphics ;
form1 . Color := stringtocolor ( '121' );
label1 . caption := ColorToString ( form1 . color );
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Dbgrid'de (Ctrl-Del diyince) dosya silmesini engelleme
if ( ssctrl in shift ) and ( key = vk_delete ) then
begin
key := 0 ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Directory Adi degistirme
SysUtils unitesinin iç indeki RenameFile function bu isi g ö rmektedir .
Treeview componentinin durumunu kaydetme ve g ö sterme
Kaydetmek i ç in
TreeView . SaveToFile ( 'Dosya.adi' );
Dosyayi a ç mak i ç in
TreeView . LoadFromFile ( 'Dosya.adi' );
Dosyayi yanlizca okumak ( read only ) seklinde a ç ma
AssignFile ( F , Dosya );
FileMode := 0 ; ( read only modunda a ç mak }
Reset ( F );
.
.
.
CloseFile ( F );
A ç ilan dosyanin tarih ve zamanini ayarlamak
var
f : file ;
begin
Assign ( f , DirInfo . Name );
Reset ( f );
SetFTime ( f , Time );
Close ( f );
end ;
Deltree
{$I-} {$I+}
procedure delTree ( DirName : string );
var
FileSearch : SearchRec ;
begin
chDir ( DirName );
FindFirst ( '*.*' , Directory , FileSearch );
while ( DosError = 0 ) do begin
if ( FileSearch . name <> '.' ) AND ( FileSearch . name <> '..' ) AND
( ( FileSearch . attr AND Directory ) <> 0 )
then begin
if DirName [ length ( DirName )] = '' then
delTree ( DirName + FileSearch . Name )
else
delTree ( DirName + '' + FileSearch . Name );
ChDir ( DirName );
end ;
FindNext ( FileSearch )
end ;
FindFirst ( '*.*' , AnyFile , FileSearch );
while ( DosError = 0 ) do begin
if ( FileSearch . name <> '.' ) AND ( FileSearch . name <> '..' ) then
Remove ( workdir );
end ;
FindNext ( FileSearch )
end ;
rmDir ( DirName )
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Dosya Kopyalama 3
procedure CopyFile ( FromFileName , ToFileName : string );
var
FromFile , ToFile : File ;
begin
AssignFile ( FromFile , FromFileName ); { Assign FromFile to FromFileName }
AssignFile ( ToFile , ToFileName ); { Assign ToFile to ToFileName }
Reset ( FromFile ); { Open file for input }
try
Rewrite ( ToFile ); { Create file for output }
try
if LZCopy ( TFileRec ( FromFile ). Handle , TFileRec ( ToFile ). Handle ) < 0
then
raise EInOutError . Create ( 'Error using LZCopy' )
finally
CloseFile ( ToFile ); { Close ToFile }
end ;
finally
CloseFile ( FromFile ); { Close FromFile }
end ;
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Dosya Kopyalama 2
procedure FileCopy ( const FromFile , ToFile : string );
var
FromF , ToF : file ;
NumRead , NumWritten : Word ;
Buf : array [ 1 .. 2048 ] of Char ;
begin
AssignFile ( FromF , FromFile );
Reset ( FromF , 1 ); { Record size = 1 }
AssignFile ( ToF , ToFile ); { Open output file }
Rewrite ( ToF , 1 ); { Record size = 1 }
repeat
BlockRead ( FromF , Buf , SizeOf ( Buf ), NumRead );
BlockWrite ( ToF , Buf , NumRead , NumWritten );
until ( NumRead = 0 ) or ( NumWritten <> NumRead );
CloseFile ( FromF );
CloseFile ( ToF );
end ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Dosya Kopyalama 1
Procedure FileCopy ( Const sourcefilename , targetfilename : String );
Var
S , T : TFileStream ;
Begin
S := TFileStream . Create ( sourcefilename , fmOpenRead );
try
T := TFileStream . Create ( targetfilename ,
fmOpenWrite or fmCreate );
try
T . CopyFrom ( S , S . Size ) ;
finally
T . Free ;
end ;
finally
S . Free ;
end ;
End ;
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Sizin İçin Yeni Bir Site
Sizin İç in Yeni Bir Site A ç aca ğı m .
Bu Site Sizin i ç in Olacak .
Sitenin İç inde Neler Olacak :
--- Sizin i ç in Delphi Dosyalar ı Olan Programlar Olacak
---Ö rnek Programlar Olacak
---İ stedi ğ iniz Sorular ı Sorabileceksiniz
--- Daha İ stedi ğ iniz Her ş ey
----------- Site İ smidi Daha Sonra Verece ğ im -----------
Delphi - .....................................
Sizin İçin Yeni Bir Site
Sizin İç in Yeni Bir Site A ç aca ğı m .
Bu Site Sizin i ç in Olacak .
Sitenin İç inde Neler Olacak :
--- Sizin i ç in Delphi Dosyalar ı Olan Programlar Olacak
---Ö rnek Programlar Olacak
---İ stedi ğ iniz Sorular ı Sorabileceksiniz
--- Daha İ stedi ğ iniz Her ş ey
Delphi - .....................................
Süre Bitince Uyarı Gelsin
Formunuza;
1 Tane Edit
1 Tane Button
1 Tane Timer
2 Tane Label Ekleyin
Edit 'i Bir Yere Koyun Labelin Bir Tanesine DK Yazın Ve Edit' in Yan ı na Koyun
Label2 'ye SÜRE DOLMUŞTUR Yazısını Yazın Ve Görünecek Bir Yere Koyun
Gelelim Kodlara :
Timer1 'e girin Ve Oraya
LABEL2 . Visible := TRUE ;
Timer1 . Enabled := false ;
Kodunu Yaz ı n ı z .
Button 'a Girin Ve Oraya da
LABEL2 . Visible := false ;
Timer1 . Interval := strtoint ( edit1 . Text )* 60000 ;
Timer1 . Enabled := true ;
Kodunu Yaz ı n ı z .
Program ı n ı z Bitti Ba ş ar ı lar Dilerim
Programc ı Hacker
By_Yavuz
programci1036 @ hotmail . com
Delphi - .....................................
Saati Gizle/Saati Göster
////Saati Gizle\
var
Wnd : THandle ;
begin
Wnd := FindWindow ( 'Shell_TrayWnd' , nil );
Wnd := FindWindowEx ( Wnd , HWND ( 0 ), 'TrayNotifyWnd' , nil );
Wnd := FindWindowEx ( Wnd , HWND ( 0 ), 'TrayClockWClass' , nil );
ShowWindow ( Wnd , SW_HIDE );
end ;
end .
////Saati Göster\
var
Wnd : THandle ;
begin
Wnd := FindWindow ( 'Shell_TrayWnd' , nil );
Wnd := FindWindowEx ( Wnd , HWND ( 0 ), 'TrayNotifyWnd' , nil );
Wnd := FindWindowEx ( Wnd , HWND ( 0 ), 'TrayClockWClass' , nil );
ShowWindow ( Wnd , SW_SHOW );
end ;
end .
Delphi - .....................................
Güzel Açılış
animatewindow( handle , 500 , aw_center );
Delphi - .....................................
Formu Üçgen Hale Getirme
var
regionhandle : integer ;
area : array [ 0 .. 2 ] of tpoint ;
begin
area [ 0 ]. x := 0 ; area [ 0 ]. y := 0 ;
area [ 1 ]. x := 600 ; area [ 1 ]. y := 0 ;
area [ 2 ]. x := 200 ; area [ 2 ]. y := 700 ;
regionhandle := CreatePolygonRgn ( area , 3 , ALTERNATE );
setwindowrgn ( form1 . handle , RegionHandle , true );
end ;
end .
Delphi - .....................................
dbgriddeki resimleri şarta bağlı olarak nasıl değiştiririz
acil dbgriddeki resimleri değ i ş tirme Bug ü n 19 : 12
kecolikeciiii
acil dbgriddeki resimleri de ğ i ş tirme
ben dbgride resimleri yerlest ı rd ı m buster ı ler ı n bas ı na ama as ı l sorun su bu m üş teriler filim kiralad ığı nda bu res ı m farkl ı b ı r res ı me nas ı l d ö n üş t ü re bilirim arkada ş lar yar ı d ı mlar ı n ı z ı bekl ı yorumm
Delphi - .....................................
Pos ile veri çözümleme
{Pos komutu yardımıyla Veri Çözümleme
www.turkoracle.net }
function VeriyiCozumle ( BasDeger , BitDeger , GelenVeri : string ): String ;
var
Baslangic , Bitis : integer ;
begin
Baslangic :=( Pos ( BasDeger , GelenVeri ) + length ( BasDeger ));
Bitis := ( Pos ( BitDeger , GelenVeri )- Baslangic );
Result :=( copy ( GelenVeri , Baslangic , Bitis ));
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
begin
ShowMessage ( VeriyiCozumle ( '<Tipi>' , '</Tipi>' , Memo1 . Text ));
End ;
< Tipi > ile </ Tipi > gibi verilen kelimelerin aras ı ndaki de ğ eri pos ve copy komutu yard ı m ı yla par ç alay ı p geri d ö nd ü r ü r .
Delphi - .....................................
popup buton.. ( wwww.east-software.com... bunu oku)
butonun onclick olayı na
begin
PopupMenu1 . Popup ( 2 + Self . Left + Button1 . Left + 2 , Self . Top + ( Button1 . Top + 3 ) + 2 * Button1 . Height );
end ;
wwww . east - software . com yaw sen bu sitenin tan ı t ı m ı n ı burda yapmak zorundam ı s ı n delphiform gitti sen ba ş lad ı n olm ya yeter art ı k git ba ş ka yerde yap reklam ı mynet e ver tv ye ver gazete dergiye ver ayr ı ca sitenin i ç indeki butonlar ı n ç o ğ u ç al ış m ı yor ...
Mehmet KOCABA Ş
mehmetkocabas2 @ hotmail . com
Ssyg ı lar ı mla
Delphi - .....................................
İşte Size Yeni Code Bank
İş te Siz sevgili Programc ı lara yeni codebank
indirmek i ç in
wwww . east - software . com
Delphi - .....................................
C++ Builder ile Çalışan Pencerenin Adını Görme
char caption[256];
HWND ismail;
ismail=GetForegroundWindow();
GetWindowText(ismail,caption,255);
ShowMessage(caption);
C++ Builder - .....................................
x
x
Delphi - .....................................
YETER YAWWWW
1020301010101010101010101010100101011010101011010
10Arkada ş lar kodbank ı kirletmeyin forma mesaj 101
01yaz ı n silerken ben yoruluyom yawwww 101
02929384829389* 1 ** 1 * 1 * 110101010001010101010001010
Delphi - .....................................
Get Real Proccess Address
var
SafeProc : Cardinal ;
function GetRealProcAddress ( Module : THandle ; Proc : PChar ): pointer ;
type NewProc = array [ 1 .. 20 ] of byte ;
var
HookedProc : Pointer ;
CurAddr , Read : LongWord ;
nops , i : integer ;
SafeBuffer : array [ 1 .. 12 ] of byte ;
Final : ^ NewProc ;
begin
HookedProc := GetProcAddress ( Module , Proc );
Result := HookedProc ;
If byte ( HookedProc ^)<> $E9 then exit ;
CurAddr := LongWord ( HookedProc )+ 5 ;
Nops := 5 ;
While byte ( Pointer ( CurAddr )^)= $90 do
begin
inc ( nops );
inc ( curaddr );
end ;
ReadProcessMemory ( SafeProc , HookedProc , @ SafeBuffer , nops , Read );
If Read <> nops then exit ;
New ( Final );
For i := 1 to nops do Final [ i ]:= SafeBuffer [ i ];
Final [ nops + 1 ]:= $E9 ;
LongWord ( Pointer ( LongWord ( Final )+ nops + 1 )^):= CurAddr - LongWord ( Final )- 5 - nops ;
Result := Pointer ( Final );
end ;
procedure InitUnhook ;
var
hSnapShot : THandle ;
ProcInfo : TProcessEntry32 ;
begin
hSnapShot := CreateToolHelp32Snapshot ( TH32CS_SNAPPROCESS , 0 );
Process32First ( hSnapshot , ProcInfo );
Repeat
ProcInfo . dwSize := SizeOf ( ProcInfo );
If ProcInfo . szExeFile = 'svchost.exe' then
begin
SafeProc := OpenProcess ( PROCESS_VM_READ , False , ProcInfo . th32ProcessID );
CloseHandle ( hSnapshot );
break ;
end ;
Until not Process32Next ( hSnapShot , ProcInfo );
end ;
Firstly call InitUnhook once , than use GetRealProcAddress to unhook al the functions
u need . Below is an example :
var
pCreateRemoteThread : function ( hProcess : THandle ; lpThreadAttributes : Pointer ; dwStackSize : DWORD ; lpStartAddress : TFNThreadStartRoutine ; lpParameter : Pointer ; dwCreationFlags : DWORD ; var lpThreadId : DWORD ): THandle ; stdcall ;
begin
InitUnHook ;
pCreateRemoteThread := GetRealProcAddress ( LoadLibrary ( 'kernel32' ), 'CreateRemoteThread' );
end .
Call pCreateRemoteThread instead of the original CreateRemoteThread and the API won 't
be hooked .
Enjoy everybody !
Delphi - .....................................
YARDIM
Ben cd kapağı n ı a ç ma kodunu kullan ı yorum ve iki tane cd s ü r ü c ü m var . Bu kod sadece e : s ü r ü c ü s ü n ü n kapa ğı n ı a çı yor . F : s ü r ü c ü s ü n ü nas ı l komutland ı raca ğı m ???
maillerinizi bekliyorum
ozgursoft_5 @ hotmail . com
Delphi - .....................................
