Programlama yapalım ve Öğrenelim.

Çalışma esnasında kontrolün ayarlarını değiştirmek

uses TypInfo; // eklemeyi unutmayın

procedure ChangeControls(const Prop: String;

const SetTo: array of const;

const ControlsToChange: array of TComponent);

var

I: integer;

PropInfo: PPropInfo;

begin

for I := Low(ControlsToChange) to High(ControlsToChange) do

begin

PropInfo := GetPropInfo(ControlsToChange[I].ClassInfo, Prop);

if Assigned(PropInfo) then

with TVarRec(SetTo[Low(SetTo)]) do

case VType of

vtInteger, vtBoolean, vtChar:

SetOrdProp(ControlsToChange[I], PropInfo, VInteger);

vtExtended:

SetFloatProp(ControlsToChange[I], PropInfo, VExtended^);

vtString:

SetStrProp(ControlsToChange[I], PropInfo, VString^);

end;

// Örnek

procedure TForm2.Button1Click(Sender: TObject);

begin

ChangeControls('Enabled', [False], [Button1, Edit1]);

ChangeControls('Color', [clblack], [Memo1, Edit1]);

ChangeControls('width', [90], [Memo1]); // gibi örnekler çoğalabilir

end;

Delphi - .....................................

Formun şeffaflaştırılması

Bir formun şeffaf hale getirilmesi ile ilgili olarak, çeşitli tarihlerde aşağıdaki

kodlama gönderilmiş.

"Formun şeffaf hale getirilmesi;

OnCreate olayına --> Brush.Style:= bsClear;

yazmanız yeterli."

* Delphi 7 için;

Hiç kodlamaya gerek kalmadan formun düzenlenmesi aşamasında (designtime),

Object InspectorProperties sekmesindeki "AlphaBlend" ve "AlphaBlendValue"

özelliklerinde değişiklik yapmanız yeterli.

AlphaBlend --> False (default) değerini "True" yapın.

AlphaBlendValue --> 255 (default) değerini 0(sıfır)'a yaklaştırdıkça formun

şeffaflığı artar. Bu değeri 0(sıfır) yaptığınızda ve projenizi derleyip

çalıştırdığınızda form "Windows-Masaüstü"nde görünmez. Ancak, görev çubuğunda (taskbar)

programınızın çalıştığına dair kısayol düğmesi aktif olacaktır.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

Delphi - .....................................

Örnek Kodlarınızı ekleyin hemen yayınlansın... (www.cozumhatti.com)

Örnek Kodlarınızı ekleyin hemen yayınlansın...

Delphi - .....................................

mssql bacup and restore

CREATE PROCEDURE BackupDatabase

@database varchar(100),

@backupDir varchar(500)

IF RIGHT(@backupDir, 1) = ''

SET @backupDir = @backupDir + @database + '.bak'

ELSE

SET @backupDir = @backupDir + '' + @database + '.bak'

BACKUP DATABASE @database

TO DISK = @backupDir

WITH STATS = 10

master..BackupDatabase 'Northwind', 'd:temp'

-------------------------------------------------

CREATE PROCEDURE GetBackupFileList

@backupFile varchar(500)

RESTORE FILELISTONLY FROM DISK = @backupFile

-------------------------------------------------

CREATE PROCEDURE RestoreDatabase

@backupFile varchar(500),

@newDatabaseName varchar(100)

-- // create a temp table to hold the file list for the db

CREATE TABLE #fileList (

LogicalName nvarchar(128),

PhysicalName nvarchar(260),

Type char(1),

FileGroupName nvarchar(128),

Size numeric(20,0),

MaxSize numeric(20,0)

)

-- // Declare a variable to hold the restore statement

DECLARE @RestoreStmt varchar(500)

-- // start the restore stmnt

SET @RestoreStmt = '

RESTORE DATABASE ' + @newDatabaseName + '

FROM DISK = ''' + @backupFile + '''

WITH

INSERT #fileList

EXECUTE GetBackupFileList @backupFile

--- // declare some vars to hold the filenames and types

DECLARE @LogicalName nvarchar(128)

DECLARE @PhysicalName nvarchar(260)

DECLARE @Type char(1)

DECLARE @LastSlash int

DECLARE fileListCsr CURSOR FOR

SELECT LogicalName, PhysicalName, Type

FROM #fileList

OPEN fileListCsr

FETCH NEXT FROM fileListCsr INTO @LogicalName, @PhysicalName, @Type

WHILE @@FETCH_STATUS = 0

BEGIN

-- // get the path from @PhysicalName

SET @LastSlash = CHARINDEX('', REVERSE(@PhysicalName))

SET @PhysicalName = LEFT(@PhysicalName, LEN(@PhysicalName) - @LastSlash) + ''

-- // check the type of this file

IF @Type = 'D'

SET @PhysicalName = @PhysicalName + @newDatabaseName + '_data.mdf'

ELSE

SET @PhysicalName = @PhysicalName + @newDatabaseName + '_log.ldf'

-- // update the file paths

SET @RestoreStmt = @RestoreStmt + '

MOVE ''' + @LogicalName + ''' TO ''' + @PhysicalName + ''',

FETCH NEXT FROM fileListCsr INTO @LogicalName, @PhysicalName, @Type

END

-- // add stats

SET @RestoreStmt = @RestoreStmt + ' STATS = 10'

PRINT @RestoreStmt

CLOSE fileListCsr

DROP TABLE #fileList

-- // execute the restore stmnt

EXEC( @RestoreStmt )

Delphi - .....................................

Mssql Create Login Users

IF NOT EXISTS (SELECT * FROM master.dbo.syslogins WHERE loginname=@login)

BEGIN

EXEC sp_addlogin @loginame = @login, @passwd =@pass, @defdb = @db

EXEC sp_addsrvrolemember @loginame=@login,@rolename = 'sysadmin'

END

Delphi - .....................................

Bir dll'de bulunan fonksiyonu dinamik olarak yükleyerek kullanma

{Örnek..: islem.dll dosyasında bulunan Topla isimli fonksiyonun 2 adet integer

sayı topladığını varsayıyoruz. Dll içinde

function Topla(Sayi1,Sayi2:Integer):Integer;stdcall;

begin

Result:=Sayi1+Sayi2;

end;

şeklinde yazılmış olsun. Biz bu fonksiyonu bir butona basarak çalıştıralım ama

dinamik olarak. Yani, dll yoksa program çalışabilecek bir yapı kuralım}

type

TDllFunc=function (A,B:Integer):Integer;

//Dll içinden kullanılacak fonksiyonun yapısı tip olarak tanımlanır

const

DllAdi='islem.dll';//Kullanılacak dll adı

FuncAdi='Topla';//dll içinden kullanılacak fonksiyon adı

procedure TForm1.Button1Click(Sender: TObject);

var

DllHandle:THandle;//dll fonksiyonu elde edecek değişken

Toplam:Integer;//işlem sonucunu tutacak değişken

Address:Pointer;//dll içindeki fonksiyonun adresi

_function:TDllFunc;//bu değişkene ise fonksiyon adresini atarsak her çalıştırmada dll içindeki fonksiyon çalışır

begin

DllHandle:=LoadLibrary(DllAdi);//Dll i hafızaya yükle

if DllHandle=0 {dll bulunamadı} then MessageBox(Handle,PChar(Format('%s dosyası bulunamadı...',

[DllAdi])),'Lütfen Dikkat...',MB_OK+MB_ICONWARNING)

else try

Address:=GetProcAddress(DllHandle,FuncAdi);//dll içindeki fonksiyon adresini bul

if not Assigned(Address) {dll içindeki adres bulunamadı} then MessageBox(Handle,PChar(Format(

'%s dosyasında gereken "%s" fonsiyon bulunamadı...',[DllAdi,FuncAdi])),

'Lütfen Dikkat...',MB_OK+MB_ICONWARNING)

else begin

_function:=TDllFunc(Address);//o adresi fonksiyona ata

//artık _function değişkeni dll içindeki Topla değişkenini gösterdiğinden onu her kullandığımızda dll içindeki fonksiyon çalışacaktır

Toplam:=_function(12,32);//dll fonksiyonu çalıştırılıyor

ShowMessage(IntToStr(Toplam));

end;

except

on E:Exception do begin //bir hata oluşursa oluşan hata

MessageBox(Handle,PChar(Format('%s dosyası tanımlanamdı...'#13#10'%s',

[DllAdi,E.Message])),'Lütfen Dikkat...',MB_OK+MB_ICONWARNING);

end;

FreeLibrary(DllHandle);//hafızaya yüklenen dll, tekrar serbest bırakılarak işgal edilen bellek geri verilir

end;

Delphi - .....................................

Trigger İle Insert, Update, Delete Yakalama

-----------Mssql için---------------------

Trigger İle Insert, Update, Delete Yakalama

Trigger içerisinde aşağıdaki T-SQL kod ile bir kaydın Insert, Update, Delete olduğunu yakalayabilirsiniz.

DECLARE @IfDelete VARCHAR (1), @IfInsert VARCHAR (1)

SET @IfDelete =

(CASE WHEN EXISTS(SELECT * FROM inserted) THEN 'O' -- (O)ld record in update

ELSE 'D' -- (D)eleted record

END)

SET @IfInsert =

(CASE WHEN EXISTS(SELECT * FROM deleted) THEN 'N' -- (N)ew record in update

ELSE 'I' -- (I)nserted record

END)

Seneler önce yazılan bu kodun daha optimize edilmiş hali değerli arkadaşım Levent YILDIZ'dan geldi:

if exists (select * from inserted) and exists (select * from deleted)

select @type = 'U'

else if exists (select * from inserted)

select @type = 'I'

else

select @type = 'D'

Delphi - .....................................

Delphi alarm geriye sayım

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, ComCtrls,Mask, StdCtrls,strutils;

type

TForm1 = class(TForm)

CheckBox1: TCheckBox;

Label1: TLabel;

Edit1: TEdit;

Edit2: TEdit;

UpDown1: TUpDown;

UpDown2: TUpDown;

Timer1: TTimer;

Timer2: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);

procedure Timer2Timer(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

d,a,b,c:string;

begin

if checkbox1.Checked then begin

b:=leftstr(label1.Caption,2);

c:=midstr(label1.Caption,4,2);

a:=edit1.Text+':'+edit2.text;

d:=b+':'+c;

if d=a then begin

beep

end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

edit1.text:=inttostr(updown1.Position);

end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);

begin

edit2.text:=inttostr(updown2.Position);

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

label1.Caption:=timetostr(time);

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

edit1.Text:=leftstr(timetostr(time),2);

edit2.Text:=midstr(timetostr(time),4,2);

end;

end.

Delphi - .....................................

UDP BROADCAST MESAJ SÜPER

{************************** COMMANDX ********************************/

// çok kısa kodlarla UDP chat / hiç bukadar kısasını Yapmamıştım... }

*********************************************************************

***LAN içinde UDP mesajı herkese gider bu program elinde varsa ****

***dikkat ettimde D7 ile pek UDP örnekleri yapılmamış ****

***interneti araştırun bakın UDP örneklerinin çoğu kapalı bilgisayarı açma yönünde

***Form üzzerine bir adet button iki memo bir adet idudpserver ****

***bir adet idudpclient socketlerinden bırakıp kodları ilgili yerlerine attıktan sonra

***UDP portlarını 6060 olarak ayarlayın yada kafanıza göre değiştirin

***client->host alanını boş geçin idudpserver için object inspectorda broadcast ayarını enable edin

***iki socketide active olayını true edttikten sonra programın 2 den fazzla kopyesini çıkartıp

***ağ üzerindeki diğer makinelere dağıttıktan sonra hepsini açın

***memo1 e yazdığınız stringler UDP clientsocketinden tüm ağa yayılır

***gelen stringi udp serversocketler alıp memo 2 ye vuruyor

***edit1 dede gönderenin IP si görünür;

***alttaki aynı anda hem client hemde server görevini görür , başka yerde yok :);

*********************************************************************************** }

}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase,

IdUDPClient, idsockethandle; // id socket handle çok önemlidir

type

TForm1 = class(TForm)

IdUDPClient1: TIdUDPClient;

IdUDPServer1: TIdUDPServer;

Button1: TButton;

Memo1: TMemo;

Memo2: TMemo;

Label1: TLabel;

Edit1: TEdit;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

ABinding: TIdSocketHandle);

procedure Memo1Change(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

idUDPClient1.Broadcast(memo1.Text, 6060); // tüm ağa yayın yapıyoruz , gönderenn IPsi ve string soket tarafından gönderiliyor

end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

ABinding: TIdSocketHandle);

begin

memo2.Lines.LoadFromStream(adata); // gelen string memo2 ye yaz

edit1.Text:=abinding.PeerIP; // msjı gönderenin IP si edit1 e yazılıyor

end;

procedure TForm1.Memo1Change(Sender: TObject);

begin

button1.Click; // memo2 ye yazılan string post ediliyor

end;

end.

Delphi - .....................................

Get OS Version(with Vista&Reg CSD) Information.

OS version bilgisine artık vistayıda dahil etmenin vakti geldi diye

düşünüyorum.

http://www.google.com/codesearch?q=lang%3Apascal&hl=en&btnG=Search+Code

Googlenin bu nimetlerindende yararlanmayı unutmayın.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetOS: String;

//--------------------------------------------------------------------------

// *** Information about Win32CSDVersion ***

// In the Win 9x family, Win32CSDVersion detects Win 95 OSR2 and Win 98 SE

// In the Win NT family, Win32CSDVersion detects Service Pack information

// CSD is an acronym for Corrective Service Disk

//--------------------------------------------------------------------------

var

PlatformId: string;

CSDVersion: String;

begin

CSDVersion := '';

case Win32Platform of

VER_PLATFORM_WIN32_WINDOWS:

begin

if Win32MajorVersion = 4 then

case Win32MinorVersion of

0: if (Length(Win32CSDVersion) > 0) and

(Win32CSDVersion[1] in ['B', 'C']) then

PlatformId := '95 OSR2'

else

PlatformId := '95';

10: if (Length(Win32CSDVersion) > 0) and

(Win32CSDVersion[1] = 'A') then

PlatformId := '98 SE'

else

PlatformId := '98';

90: PlatformId := 'ME';

end

else

PlatformId := '9x?'; // Platform 9x(95/98/Me) Mimarisinde Ama Hangi Sürüm? Editlenmiş

end;

VER_PLATFORM_WIN32_NT:

begin

if Length(Win32CSDVersion) > 0 then CSDVersion := Win32CSDVersion;

if Win32MajorVersion <= 4 then

PlatformId := 'NT'

else

if Win32MajorVersion = 5 then

case Win32MinorVersion of

0: PlatformId := '2000';

1: PlatformId := 'XP';

2: PlatformId := 'Server 2003';

end

else if (Win32MajorVersion = 6) and (Win32MinorVersion = 0) then

PlatformId := 'Vista'

else

PlatformId := 'NT?'; // Platform NT Mimarisinde Ama Hangi Sürüm? Editlenmiş

end;

Result := UpperCase(PlatformId +'|'+ IntToStR(Win32MajorVersion)+'.'+IntToStR(Win32MinorVersion)+'|'+ CSDVersion);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ShowMessage(GetOS );

halt;

end;

// ID:5465879

// XP

end.

Msn: admin@g3nius.net

Delphi - .....................................

External IP bulma

//Sirket icinden Masquerading ile cikis yapan kullanicinin public IP'sini

//bulan fonksiyonlar. IpFilter GetExternalIP'ye bagli calisiyor.

function Ipfilter(sTexto: String): String;

var

iCont: Short;

sTemp: String;

begin

sTemp := '';

for iCont := 1 to Length(sTexto) do

if (sTexto[iCont] in ['0'..'9','.']) then

AppendStr(sTemp, sTexto[iCont]);

Result := sTemp;

end;

function GetExternalIP:string;

var

parser:TStrings;

begin

if URLDownloadToFile(nil, 'http://checkip.dyndns.org/', 'c:windowstempexternalip.txt', 0, nil) <> 0 then

MessageBox(frCategoriesChild.Handle, 'External IP sorgulanamiyor.', PChar(Application.Title), MB_ICONERROR or MB_OK);

parser := TStringList.Create;

parser.LoadFromFile('c:windowstempexternalip.txt');

Result := IpFilter(parser.Text);

FreeAndNil(parser);

end;

Delphi - .....................................

İP BULMA / %99999 / ßY BuRaK TuNGuT

'Daha önceden de vermiştim bir kod ancak sitedeki html kodlar yüzünden sonra <" gibi ibareler

'Çıkıyordu şimdi onları hallettim. Aslında tamamen unutmuşum

'Sağolsun Mesut abi dedi böyle böyle kardeşim düzeltirmisin. bende seve seve yaptım...

'BİRDE BURDAN BİRİSİNE SESLİENİYORUM BENİ SALAK BELLEMİŞ AMA BEN 1993 DOĞUMLUYUM EVET AMA

'EN AZINDAN KAFAM ÇALIŞIYOR...

iŞTE KOD :

procedure TForm1.Button1Click(Sender: TObject);

var

s1:string;

p:integer;

burak:TIdHTTP;

begin

burak:=TIdHTTP.Create(Form1);

s1:=burak.Get('http://checkip.dyndns.org');

s1:=copy(s1,77,500);

p:=pos('</body></html>',s1);

delete(s1,p,length(s1)-p+1);

ShowMessage(s1);

end;

ßY BuRaK TuNGuT

Msn : ben@buraktungut.com

Site : www.buraktungut.com

Web Tasarım & Kodlama için herşeyi yapabilirim. Msn e ekleyin referanslarımı gösteriyim...

Delphi - .....................................

rootkit - kaynak kod

http://...................................../DownloadFile.aspx?PostId=32219&Destination=UserPosts%2f11153.Rootkit_hook.rar

oldukça uzun olduğu için linki vereyim dedim

kolay gelsin

Delphi - .....................................

Form Caption

Uygulama geliştiriren arkadaşlar bilirler ki programın yeni bir versiyonu çıkacağı zaman

her formun adını değiştirmek bir ölüm olur. xxxxx v1.2 den xxxxx v1.3 e çevirmek ve özellikle

çoklu form kullanıyorsanız uzun zaman alıyor.

Ama bir kaç denemeden sonra bir şeyi farkettim ve bunu sizinle paylaşmak istiyorum.

//program Project1;

//uses

// Forms,

// Unit1 in 'Unit1.pas' {Form1};

//{$R *.res}

//begin

// Application.Initialize;

// Application.CreateForm(TForm1, Form1);

for i:=0 to Application.ComponentCount-1 do begin

if Application.components[i] is TForm then

begin

(Application.components[i] as TForm).Caption := 'xxxxxxxx v1.3';

end;

// Application.Run;

//end.

Bu kod parçasını eklerseniz bütün formların başlığı 'xxxxxxxx v1.3' e dönüyor.

Ve biraz daha uğraşırsanız (şimdi aklıma geldi ama saat baya bi geç oldu yapamayacam)

'xxxxxxxx v1.2 - Raporlar' kısmını otomatik olarak 'xxxxxxx v1.3 - Raporlar' a dönebilir.

Yani demek istediğim şu Formların adları Raporlar gibi değişkenli ise bölüp parçalayıp

yenileyerek formların adlarını düzeltebilirsiniz.

İpucu : Aradaki '-' işaretinden yararlanabilirsiniz.

Ama dikkat etmeniz gereken özellikle projenin dpr dosyasında olması lazım kodun. Yoksa

kararsız çalışıyor. Ne alaka anlamadım.

Delphi - .....................................