- .com
- Türkçe, Delphi ve SQL konusundaki deneyimler, örnek kodlar, eleştiri ve düşünceler...
Delphi ile "Login olmak" (Kullanıcı giriş denetimi)
- 20 Mayıs 2010 Perşembe
- Uğur Parlayan
Yazılara uzun bir süre ara verdikten sonra aşağıdaki gibi bir örnekle geri dönmek sanırım hepimiz için güzel bir başlangıç olacak... Yazdığımız programlarda kullanıcının programa girişini kontrol altına almak, yetkileri ve arabirimi kullanıcıya göre giriş esnasında şekillendirmek herzaman bizler için bir sıkıntı olmuştur. Bu yazıda bu sorunu nasıl aşabileceğimize dair hazırladığım özel bir bileşeni tanıtacağım; TupLoginDialog...
TupLogindialog Ne İşe Yarar
Bu bileşen, programcının tercihine bağlı kalarak açılış anında veya bir butonun tetiklemesiyle devreye girip kullanıcıdan kullanıcı adı ve şifresini bir forma girmesini, girdiği bilgileri kullanarak o kullanıcının veritabanından kontrol edilmesini, varsa programa girmesine izin vermesini, yoksa kullanıcıyı uyarmasını, belli bir miktar hatalı girişten sonra programı kapatmasını sağlayan nevişahsına münhasır özel bir bileşenimizdir.
Tasarım anında görsel olmayan bir nesne olarak kullanılır. Sizden, ana formunuza bu bileşeni eklediğinizde aşağıdaki alanları doldurmanızı ister. Temel parametreleri girdiğinizde çalıştırılmaya hazırdır. Ayrıca sonuca göre 2 farklı olay da tetikleyebilmektedir. 1. Olayda, kullanıcı adı ve şifresi doğrulanan bir kullanıcı veritabanında bulunduysa OnGirisKabulEdildi olayını tetikler. Eğer belirttiğiniz miktarda hatalı bir giriş denemesi yapıldıysa limit dolduğunda OnHataLimiti olayını tetikler. Bu olaylar size giriş düğmesine basıldığında programınızda kullanıcı ile ilgili diğer işlemleri yapmanıza, belli miktarda hatalı giriş yapıldığında ise programınızı kapatmadan önce yapmanız gereken diğer işlemleri gerçekleştirmenize veya ilgili kullanıcının hesabını kilitlemenize olanak verir.
TupLoginDialog Bileşeninin Kaynak Kodu
Aşağıda, size bu bileşenin kaynak kodunu veriyorum. Bu bileşen ile ilgili teknik detayları ayrı ayrı da anlatabilirdim fakat konu bütünlüğünün bozulmaması için gereken açıklamaları kodun içine serpiştirdim, neyi neden ve nerede yaptığımı böylece daha iyi anlatabileceğimi düşünüyorum...
{******************************************************************************}
{* *}
{* Programlayan: Uğur Parlayan (ugurparlayan@gmail.com) *}
{* Tarih: 17.05.2010 *}
{* *}
{* Kullanım: Ayrım gözetmeksizn külliyatıyla ÜCRETSİZDİR *}
{* Yazarın gönlü olsun diye kaynak belirtirseniz sevinirim... *}
{* *}
{* Uygulamanıza Kullanıcı adı ve şifre ile giriş yapılabilmesine imkân verir *}
{* *}
{* URL: http://www.kavramca.com/index.php?k=40 *}
{* *}
{******************************************************************************}
unit upLoginDialog;
interface
uses
SysUtils, Classes, StdCtrls, Mask, DBCtrls, DB, ExtCtrls, Controls, Buttons,
Variants, Messages, Windows, Forms, Dialogs, ADODB, Grids, DBGrids, Graphics,
AppEvnts;
const
WM_AFTER_SHOW = WM_USER + 300;
WM_AFTER_CREATE = WM_USER + 301;
type
TupLoginDialog = class(TCommonDialog)
private
FUygulamaOlayi : TApplicationEvents;
{Pencerenin iç nesneleri}
FPencere : TForm;
FCMB_Kullanici : TComboBox;
FEdit_Sifre : TEdit;
FBTN_Giris : TButton;
FBTN_Kapat : TButton;
FLBL_Kullanici : TLabel;
FLBL_Sifre : TLabel;
FBTN_Hatirlatici : TButton;
{Diğer zımbırtılar}
FConnection : TAdoConnection;
FGirisKabulEdildi : TNotifyEvent; {Girişte tetiklenen olay.}
FHataLimiti : TNotifyEvent;
FOtomatikBaslat : Boolean; {Program çalışınca devreye girecek mi}
FGirebilir : Boolean; {Giriş izni verildi mi}
FKullaniciListele : Boolean;
FKullanici_Tablosu : string;
FHatirlatmaGoster : Boolean;
FAlan_Soru : string;
FAlan_Cevap : string;
FAlan_Key : string;
FAlan_Kullanici : string;
FAlan_Sifre : string;
FAlan_Pasif : string;
FAlan_SonTarih : string;
FAlan_Yetkiler : string;
FAlan_Hesap : string;
FMetin_Baslik : string;
FMetin_Kullanici : string;
FMetin_Sifre : string;
FMetin_Login : string;
FMetin_Kapat : string;
FMetin_Hatirlat : string;
FValue_Kullanci : string;
FValue_Sifre : string;
FValue_Hesap : string;
FValue_Key : string;
FValue_Yetkiler : string;
FValue_Pasif : Boolean;
FHataSayaciKullan : Boolean;
FHataSayaci : Integer;
function GetSQL : string;
function GetBilesenDurumu: string;
function GetValue_Kullanci: string;
function GetValue_Sifre: string;
procedure SetConnection(const Value: TAdoConnection);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
{Ana programa sistem mesajı gönderir...}
procedure OnMsg(var Msg:tagMsg;var Handled:Boolean);
procedure Klik_Tus(Sender: TObject; var Key: Char);
procedure Klik_Giris(Sender: TObject);
procedure Klik_Kapat(Sender: TObject);
procedure Klik_Hatirlat(Sender: TObject);
procedure Sifirla;{Pencere açılmadan önce sonuçları sıfırlar...}
procedure Sonuclar;
procedure Olustur;{Penceremizi oluşturur...}
property OnClose;
property OnShow;
protected
procedure DoGirisKabulEdildi; virtual;
procedure DoHataLimiti; virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Calistir;{Dialog penceresini istenilen esnada gösterir}
published
property Connection : TAdoConnection read FConnection
write SetConnection;
{SQL cümlemizi parametrelere göre üretir.}
property SQL : string read GetSQL;
{Bileşen için gereken kritik değişkenler hakkında dış ortama bilgi verir.}
property BilesenDurumu : string read GetBilesenDurumu;
{Kaç kere hata yapılabileceğini bu değişken karar verir}
property HataSayaci : Integer read FHataSayaci
write FHataSayaci
Default 10;
{Eğer istersek kullanıcının hatalarını saymayabiliriz...}
property HataSayaciKullan : Boolean read FHataSayaciKullan
write FHataSayaciKullan
Default False;
{Şifresini unutan kullanıcıya soru sorabiliriz}
property HatirlatmaGoster : Boolean read FHatirlatmaGoster
write FHatirlatmaGoster
Default False;
{Ana form çalışır çalışmaz devreye girmesini sağlayabiliriz.}
property OtomatikBaslat : Boolean read FOtomatikBaslat
write FOtomatikBaslat
Default False;
{Kullanıcı adlarını eğer istersek listeleyebiliriz, ŞART DEĞİL !!!}
property Kullanici_Listele : Boolean read FKullaniciListele
write FKullaniciListele
Default False;
{Temel Parametre: Kullanıcıların veritabanındaki tablo adı}
property Kullanici_Tablosu : string read FKullanici_Tablosu
write FKullanici_Tablosu;
{Temel Parametre: USERNAME alanı}
property Alan_Kullanici : string read FAlan_Kullanici
write FAlan_Kullanici;
{Temel Parametre: PASSWORD alanı}
property Alan_Sifre : string read FAlan_Sifre
write FAlan_Sifre;
{Şart değil: Sorunun tutulduğu tablo alanı}
property Alan_Soru : string read FAlan_Soru
write FAlan_Soru;
{Şart değil: Cevabın tutlduğu tablo alanı}
property Alan_Cevap : string read FAlan_Cevap
write FAlan_Cevap;
{Temel Parametre: Her kullanıcı için bir referans numarası vardır}
{Bu alan işte o referansı kullanmanızı sağlar (PRIMARY KEY)}
property Alan_Key : string read FAlan_Key
write FAlan_Key;
{Şart değil: Pasifleştirilmiş kullanıcıları sonuçlardan dışlar...}
property Alan_Pasif : string read FAlan_Pasif
write FAlan_Pasif;
{Şart değil: Eğer kullanıcının belli bir tarihten sonra giriş }
{yapmasını istemiyorsanız bunu kullanabilirsiniz...}
property Alan_SonTarih : string read FAlan_SonTarih
write FAlan_SonTarih;
{Şart değil: Giriş yaptıktan sonra yetkileri denetlemenizi sağlar}
property Alan_Yetkiler : string read FAlan_Yetkiler
write FAlan_Yetkiler;
{Şart değil: ACCOUNT alanı...}
property Alan_Hesap : string read FAlan_Hesap
write FAlan_Hesap;
{Görsel: Pencerenin başlığı}
property Metin_Baslik : string read FMetin_Baslik
write FMetin_Baslik;
{Görsel: Giriş düğmesinin başlığı}
property Metin_Login : string read FMetin_Login
write FMetin_Login;
{Görsel: Kapat düğmesinin başlığı}
property Metin_Kapat : string read FMetin_Kapat
write FMetin_Kapat;
{Görsel: Kullanıcı adı text alanının başlığı}
property Metin_Kullanici : string read FMetin_Kullanici
write FMetin_Kullanici;
{Görsel: Şifre text alanının başlığı}
property Metin_Sifre : string read FMetin_Sifre
write FMetin_Sifre;
{Görsel: "Şifremi Unuttum" düğmesinin başlığı}
property Metin_Hatirlat : string read FMetin_Hatirlat
write FMetin_Hatirlat;
{SONUÇ: Kullanıcı adı}
property Value_Kullanici : string read GetValue_Kullanci
write FValue_Kullanci;
{SONUÇ: Şifresi}
property Value_Sifre : string read GetValue_Sifre
write FValue_Sifre;
{SONUÇ: PRIMARY KEY}
property Value_Key : string read FValue_Key;
{SONUÇ: Bu kullanıcının yetkileri}
property Value_Yetkiler : string read FValue_Yetkiler;
{SONUÇ: ACCOUNT adı...}
property Value_Hesap : string read FValue_Hesap;
{SONUÇ: Aktif / Pasif kullanıcı olup olmadığı...}
property Value_Pasif : Boolean read FValue_Pasif;
{SONUÇ: Kullanıcının mevcut olup olmadığının kararı...}
property Girebilir : Boolean read FGirebilir
Default False;
{OLAY: Giriş düğmesi olayı}
property GirisKabulEdildi : TNotifyEvent read FGirisKabulEdildi
write FGirisKabulEdildi;
{OlAY: Hata sayacı olayı}
property HataLimiti : TNotifyEvent read FHataLimiti
write FHataLimiti;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('UgurPack2007', [TupLoginDialog]);
end;
{ TupLoginDialog }
constructor TupLoginDialog.Create(AOwner: TComponent);
begin
inherited;
{ Varsayılanları ayarlıyoruz... }
if (FMetin_Baslik = '') then FMetin_Baslik := 'Kullanıcı Girişi';
if (FMetin_Kapat = '') then FMetin_Kapat := 'Kapat';
if (FMetin_Login = '') then FMetin_Login := 'Giriş';
if (FMetin_Kullanici = '') then FMetin_Kullanici := 'Kullanıcı Adı :';
if (FMetin_Sifre = '') then FMetin_Sifre := 'Şifre :';
if (FMetin_Hatirlat = '') then FMetin_Hatirlat := 'Şifremi Unuttum';
FHataSayaci := 10; {Kullansak da kullanmasak da bu varsayılan miktardır...}
{ Uygulama olayı tanımlıyoruz, Başlangıçta devreye girebilsin diye... }
FUygulamaOlayi := TApplicationEvents.Create(Self);
FUygulamaOlayi.OnMessage := OnMsg;
PostMessage(TForm(Owner).Handle, WM_AFTER_CREATE, 0, 0);
end;
destructor TupLoginDialog.Destroy;
begin
FUygulamaOlayi.Destroy;
inherited;
end;
procedure TupLoginDialog.DoGirisKabulEdildi;
begin
{ Giriş düğmesine bsama olayını burada atama yapıyoruz }
if Assigned(FGirisKabulEdildi) then FGirisKabulEdildi(SELF);
end;
procedure TupLoginDialog.DoHataLimiti;
begin
{ Hata miktarının tetiklenmesi olayını burada atama yapıyoruz }
if Assigned(FHataLimiti) then FHataLimiti(SELF);
end;
procedure TupLoginDialog.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ Form kapatıldığında onu yoketmeyip sadece gizliyoruz. }
Action := caHide;
{ caFREE kullansaydık nesneyi yoketmiş olurduk ki bu da hata üretir... }
if (FGirebilir = False) then begin
MessageBox(TForm(Owner).Handle, 'Program Kapatılacaktır.',
PWideChar(Application.Title), MB_OK + MB_ICONERROR);
PostMessage(TForm(Owner).Handle, WM_CLOSE, 0, 0);
{ Şifreyi giremediyse ana programı da kapat...}
end;
end;
procedure TupLoginDialog.FormShow(Sender: TObject);
var
FADS: TAdoDataSet;
SQL: String;
I: Integer;
Sonuc: String;
Ek: String;
begin
{ Formu çalıştırdığımızda bu kısım devreye giriyor }
{ Nesnelerimiz mevcutsa önce imleci kullanıcı adı text alanına }
{ konumlandırıyor, sonra da eğer kullanıcı listesi göstereceksek değerleri }
{ okuyup ilgili bileşene yazıyor... }
if Assigned(FPencere) and Assigned(FCMB_Kullanici) then begin
FCMB_Kullanici.SetFocus;
if (FAlan_Kullanici>'')
and (FKullanici_Tablosu>'')
and (FKullaniciListele = True)
then begin
SQL := '';
SQL := FORMAT('SELECT DISTINCT [%s] FROM dbo.[%s]',
[FAlan_Kullanici, FKullanici_Tablosu]);
if (FAlan_Pasif>'') or (FAlan_SonTarih>'') then begin
SQL := FORMAT('%s WHERE', [SQL]);
if (FAlan_Pasif > '') then SQL := FORMAT('%s ISNULL([%s],0) =
0', [SQL, Alan_Pasif]);
if (FAlan_Pasif>'') and (FAlan_SonTarih>'') then SQL :=
FORMAT('%s AND',[SQL]);
if (FAlan_SonTarih>'') then SQL := FORMAT('%s ISNULL([%s],0) <=
GETDATE()', [SQL, Alan_SonTarih]);
end;
if (SQL > '') then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := SQL;
Open;
First;
end;
if (FADS.IsEmpty = False) then begin
for I := 0 to FADS.RecordCount - 1 do begin
Sonuc := Sonuc +
FORMAT('"%s",',[FADS.FieldByName(FAlan_Kullanici).AsString]);
FADS.Next;
end;
with FCMB_Kullanici.Items do begin
QuoteChar := '"';
Delimiter := ',';
DelimitedText := Sonuc;
end;
end;
FADS.Close;
FADS.Destroy;
end;
end else begin
FCMB_Kullanici.Style := csSimple;
end;
end;
end;
function TupLoginDialog.GetSQL: string;
var
SQL_Cumlesi: String;
begin
{ Kullanıcı adı, şifre, tablo, varsa pasif ve varsa son tarihle birlikte }
{ bu bilgilerini kullanarak bir SQL cümlesi üretiyor}
SQL_Cumlesi := '';
SQL_Cumlesi := FORMAT('SELECT TOP 1 [%s]',[FAlan_Key]);
if (FAlan_Hesap>'') then SQL_Cumlesi := FORMAT('%s, [%s]',[SQL_Cumlesi,
FAlan_Hesap]);
if (FAlan_Yetkiler>'') then SQL_Cumlesi := FORMAT('%s, [%s]',[SQL_Cumlesi,
FAlan_Yetkiler]);
SQL_Cumlesi := FORMAT('%s FROM dbo.[%s] WHERE [%s]=''%s'' AND [%s]=''%s''',
[ SQL_Cumlesi
, FKullanici_Tablosu
, Alan_Kullanici
, GetValue_Kullanci
, Alan_Sifre
, GetValue_Sifre
]);
if (Alan_Pasif > '') then SQL_Cumlesi := FORMAT('%s AND ISNULL([%s],0) =
0', [SQL_Cumlesi, Alan_Pasif]);
if (FAlan_SonTarih>'') then SQL_Cumlesi := FORMAT('%s AND ISNULL([%s],0) <=
GETDATE()', [SQL_Cumlesi, Alan_SonTarih]);
Result := SQL_Cumlesi;
end;
function TupLoginDialog.GetBilesenDurumu: string;
var
Sonuc: String;
begin
{ Bu bileşen için gerekli olan kritik değişkenler hakkında dış ortama bilgi
verir. }
Sonuc := '';
if NOT Assigned(FConnection) then Sonuc := Sonuc + 'Bağlantı nesnesi eksik.
';
if Assigned(FConnection) then begin
if (FConnection.Connected = False) then Sonuc := Sonuc + 'Bağlantı
nesnesi KAPALI ! ';
end;
if (FAlan_Key = '') then Sonuc := Sonuc + 'Anahtar alan
belirtilmemiş. ';
if (FAlan_Kullanici = '') then Sonuc := Sonuc + 'Kullanıcı adı alanı
belirtilmemiş. ';
if (FAlan_Sifre = '') then Sonuc := Sonuc + 'Şifre alanı
belirtilmemiş. ';
if (FKullanici_Tablosu = '') then Sonuc := Sonuc + 'Kullanıcı tablosu
belirtilmemiş. ';
if (Sonuc = '') then Sonuc := 'Temel parametreler mükemmel';
Result := Sonuc;
end;
function TupLoginDialog.GetValue_Kullanci: string;
begin
{ girişten sonra dış ortama kullanıcı adını veriyor... }
if Assigned(FCMB_Kullanici)
then Result := FCMB_Kullanici.Text
else Result := FValue_Kullanci;
end;
function TupLoginDialog.GetValue_Sifre: string;
begin
{ girişten sonra dış ortama şifreyi veriyor... }
{ Tabii ki dış ortamdan kastım sadece "ana form"... }
if (Assigned(FEdit_Sifre) = True)
then Result := FEdit_Sifre.Text
else Result := FValue_Sifre;
end;
procedure TupLoginDialog.Calistir;
begin
{ Siz, ana formda "Kullanıcı Girişi" diye bir butondan bunu çağırırsanız }
{ önce oluşturulmamışsa giriş formunu üretir, sonra sonuçları sıfırlar }
{ en sonunda da giriş formunu gösterir... }
if NOT Assigned(FPencere)
then Olustur;
Sifirla;
FPencere.ShowModal;
end;
procedure TupLoginDialog.Klik_Kapat(Sender: TObject);
begin
{ Kapat düğmesine bastığımızda bu işlem gerçekleşir... }
Fpencere.Close;
end;
procedure TupLoginDialog.Klik_Giris(Sender: TObject);
begin
{ Giriş düğmesine bastığımızda burası devreye girer; Kısaca şu işleri yapar }
{ Kullanıcının kullanıcı adı ve parametresini veritabanından sorgular }
{ Sonuçta bu kişi girebiliyorsa ana forma geçiş yapar}
{ giremiyorsa uygun bir dille uyarır... }
{ Hatta hata sayacı da burada sayılır ve kontrol edilir...}
Sonuclar;
if (FGirebilir = True) then Begin
GirisKabulEdildi(SELF);
FPencere.Close;
End else Begin
if (FHataSayaciKullan = True) then Begin
FHataSayaci := FHataSayaci - 1;
if (FHataSayaci <= 0) then begin
FGirebilir := False;
if Assigned(FHataLimiti) then HataLimiti(SELF);
FPencere.Close;
//Exit;
end else begin
MessageBox(TForm(Owner).Handle,PWideChar('Hatalı giriş yaptınız.
'+IntToSTR(FHataSayaci)+' defa daha hatalı giriş yaparsanız program
kapanacaktır. '#13#10'Lütfen sistem yöneticinize
danışınız...'),'HATA',MB_OK+MB_ICONERROR);
end;
End else Begin
MessageBox(TForm(Owner).Handle,'Kullanıcı adı ve/ya Şifreniz yok
ve/ya yanlış.'#13#10'Lütfen sistem yöneticinize
danışınız...','HATA',MB_OK+MB_ICONERROR);
end;
end;
end;
procedure TupLoginDialog.Klik_Hatirlat(Sender: TObject);
var
Soru : String;
Cevap: String;
Yanit: String;
Sifre: String;
FADS : TAdoDataSet;
begin
{ Eğer kullanıcımız, sevgili şifresini unuttuysa ona bir soru sormamız }
{ gerekir. Verdiği cevap ile veritabanındaki yanıt aynı ise ona şifresini }
{ gösteririz, yanlış bir yanıt verdiyse hata mesajı üretiriz...}
{ Tüm bunları yapabilmek için kullanıcı adının yazılmış olması gerekir... }
if (FHatirlatmaGoster = True) and (FAlan_Soru > '') and (FAlan_Cevap > '')
then begin
if (FCMB_Kullanici.Text > '') then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := FORMAT('SELECT TOP 1 * FROM dbo.[%s] WHERE [%s]
= ''%s''', [FKullanici_Tablosu, FAlan_Kullanici, FCMB_Kullanici.Text]);
Open;
Soru := FieldByName(FAlan_Soru).AsString;
Cevap:= FieldByName(FAlan_Cevap).AsString;
Sifre:= FieldByName(FAlan_Sifre).AsString;
Close;
end;
FADS.Free;
Yanit := InputBox('Lütfen soruyu cevaplayın', Soru, '');
if lowercase(Yanit) = lowercase(Cevap) then ShowMessage(Sifre)
else MessageBox(TForm(Owner).Handle,'Yanlış
yanıt.','HATA',MB_OK+MB_ICONWARNING);
end else begin
MessageBox(TForm(Owner).Handle,'Lütfen Kullanıcı Adınızı
yazınız.','HATA',MB_OK+MB_ICONWARNING);
end;
end;
end;
procedure TupLoginDialog.Olustur;
const
sbt_Aralik = 4; { Penceredeki düğmeler arasındaki boşluk (Pixel
cinsinden...)}
sbt_Padding = 10;
sbt_ButonGenislik = 75;
sbt_ButonYukseklik = 25;
begin
{Dialog penceresini tüm unsurlarıyla birlikte üretir.}
if NOT Assigned (FPencere) then
FPencere := TForm.Create(Application.Owner);
with FPencere do begin
Position := poMainFormCenter;
KeyPreview := True;
Caption := Metin_Baslik;
ShowHint := True;
Width := 350;
Height := 130;
BorderStyle := bsDialog;
FormStyle := fsStayOnTop;
OnClose := FormClose;
OnShow := FormShow;
//OnPaint := PencereBoyutlandir;
//OnKeyDown := FormKeyDown; {Özel bir tuşa basılırsa...}
{ OnResize := PencereBoyutlandir; Bunu kullanmıyoruz, }
{ Çünkü nesne henüz "üretim" aşamasında olduğu için OnResize }
{ olayı anında devreye giriyor ve hata üretiyor. Bunu önlemek için }
{ bu kısma bir değer atamıyoruz. Belki OnPaint olayına tanımlanabilir. }
{ Show; Bunu özellikle çalıştırmadık... }
end;
if NOT Assigned (FLBL_Kullanici) then
FLBL_Kullanici := TLabel.Create(FPencere);
with FLBL_Kullanici do begin
Parent := FPencere;
Left := sbt_Padding;
Top := sbt_Padding + sbt_Aralik;
Height := 17;
Caption := Metin_Kullanici;
AutoSize := True; {Kendi genişliğini kendisi ayarlasın...}
Show;
end;
if NOT Assigned (FCMB_Kullanici) then
FCMB_Kullanici := TComboBox.Create(FPencere);
with FCMB_Kullanici do begin
Parent := FPencere;
Height := 20;
Top := sbt_Padding;
Left := FLBL_Kullanici.Left + FLBL_Kullanici.Width +
sbt_Aralik;
Width := FPencere.ClientWidth
- Left
- sbt_Padding;
if (FValue_Kullanci>'') then Text := FValue_Kullanci
else Text := '';
OnKeyPress := Klik_Tus;
Anchors := [akLeft,akTop,akRight]; { Pencere boyu değiştiğinde
uyum sağlasın }
Text := FValue_Kullanci;
Show;
end;
if NOT Assigned (FLBL_Sifre) then
FLBL_Sifre := TLabel.Create(FPencere);
with FLBL_Sifre do begin
Parent := FPencere;
Left := sbt_Padding;
Top := FCMB_Kullanici.Top +
FCMB_Kullanici.Height+sbt_Aralik+2;
Height := 17;
Caption := Metin_Sifre;
AutoSize := True; {Kendi genişliğini kendisi ayarlasın...}
Show;
end;
if NOT Assigned (FEdit_Sifre) then
FEdit_Sifre := TEdit.Create(FPencere);
with FEdit_Sifre do begin
Parent := FPencere;
Height := 20;
{şifremizi yazarken tepemizdekiler ne yazdığımız görmesin...}
PasswordChar := '?';
Top := FCMB_Kullanici.Top + FCMB_Kullanici.Height +
sbt_Aralik;
Left := FLBL_Kullanici.Left + FLBL_Kullanici.Width +
sbt_Aralik;
Width := FPencere.ClientWidth
- Left
- sbt_Padding;
if (FValue_Kullanci > '') then Text := FValue_Kullanci
else Text := '';
OnKeyPress := Klik_Tus;
Anchors := [akLeft,akTop,akRight]; { Pencere boyu değiştiğinde
uyum sağlasın }
Text := FValue_Sifre;
Show;
end;
if NOT Assigned (FBTN_Giris) then
FBTN_Giris := TButton.Create(FPencere);
with FBTN_Giris do begin
Caption := FMetin_Login;
Anchors := [akRight,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Login)+(sbt_Padding*2); // 40
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := FPencere.ClientWidth - sbt_Padding - width;
OnClick := Klik_Giris;
Show;
end;
if NOT Assigned (FBTN_Kapat) then
FBTN_Kapat := TButton.Create(FPencere);
with FBTN_Kapat do begin
Caption := FMetin_Kapat;
Anchors := [akRight,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Kapat)+(sbt_Padding*2);
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := FBTN_Giris.Left - sbt_Aralik - width;
OnClick := Klik_Kapat;
Show;
end;
if NOT Assigned(FBTN_Hatirlatici) then
FBTN_Hatirlatici:= TButton.Create(FPencere);
with FBTN_Hatirlatici do begin
Caption := FMetin_Hatirlat;
Anchors := [akLeft,akTop];
Parent := FPencere;
Width :=
TForm(Owner).Canvas.TextWidth(FMetin_Hatirlat)+sbt_Padding;
Height := sbt_ButonYukseklik;
Top := FEdit_Sifre.Top + FEdit_Sifre.Height + sbt_Aralik +
sbt_Padding;
Left := sbt_Padding;
OnClick := Klik_Hatirlat;
if (FHatirlatmaGoster = True) then Show else Hide;
end;
end;
procedure TupLoginDialog.OnMsg(var Msg: tagMsg; var Handled: Boolean);
begin
{ Ana forma burası aracılığıyla mesaj gönderiyoruz... }
case Msg.message of
WM_AFTER_SHOW:
begin
if (GetBilesenDurumu = 'Temel parametreler mükemmel') then begin
if not Assigned(FPencere) then Olustur;
Calistir;
end else begin
MessageBox(TForm(Owner).Handle,'Parametreler eksik veya yanlış
olabilir. Lütfen kontrol ediniz..','HATA',MB_OK+MB_ICONSTOP);
end;
end;
WM_AFTER_CREATE:
begin
if NOT (csDesigning in ComponentState) then
if (FOtomatikBaslat = True)
then PostMessage(TForm(Owner).Handle, WM_AFTER_SHOW, 0, 0);
end;
end;
end;
procedure TupLoginDialog.SetConnection(const Value: TAdoConnection);
begin
{ Malesef ADO (dbGO) bileşenlerini destekleyebiliyoruz. }
FConnection := Value;
end;
procedure TupLoginDialog.Sifirla;
begin
{ Anladınız siz bunu... }
FValue_Key := '';
FValue_Hesap := '';
FValue_Yetkiler:= '';
FValue_Kullanci:= '';
FValue_Sifre := '';
FValue_Pasif := FALSE;
end;
procedure TupLoginDialog.Sonuclar;
var
FADS: TAdoDataSet;
begin
{ Eğer temel parametrelerimizde herhangi bir pürüz yoksa sonuç alabiliriz...}
try
if (GetBilesenDurumu = 'Temel parametreler mükemmel') then begin
if NOT (csDesigning in ComponentState) then begin
FADS := TADODataSet.Create(Application);
with FADS do begin
Close;
Connection := FConnection;
CommandType := cmdText;
CommandText := GetSQL;
Open;
FGirebilir := NOT FADS.IsEmpty;
{ Sorgu sonucu BOŞ DEĞİL ve Sadece 1 KAYIT VAR İSE ! }
if (FGirebilir = True) AND (FADS.RecordCount = 1) then begin
if (FAlan_Key > '')
then FValue_Key := FieldByName(FAlan_Key).AsString;
if (FAlan_Hesap > '')
then FValue_Hesap := FieldByName(FAlan_Hesap).AsString;
if (FAlan_Yetkiler > '')
then FValue_Yetkiler:= FieldByName(FAlan_Yetkiler).AsString;
if (FAlan_Pasif > '' )
then FValue_Pasif := FieldByName(FAlan_Pasif).AsBoolean
end else begin
Sifirla;
end;
Close;
end;
FADS.Free;
end;
end;
except
// Hata verdirtmiyoruz...
end;
end;
procedure TupLoginDialog.Klik_Tus(Sender: TObject; var Key: Char);
begin
{ Klavyeden ESC'ye basıldığında KAPAT düğmesine basar}
{ ENDER'e basıldığında ise sonraki nesneye geçer... }
if (Key = #27) then Klik_Kapat(Sender) else
if (Key = #13) then begin
if (Sender = FCMB_Kullanici) then begin
if FCMB_Kullanici.Text>'' then begin
FEdit_Sifre.SetFocus
end;
end else
if (Sender = FEdit_Sifre) then begin
if (FEdit_Sifre.Text>'') then begin
FBTN_Giris.SetFocus;
FBTN_Giris.Click;
end;
end;
end;
end;
end.
T-SQL ile Dakikayı Metne Çevirmek
- 23 Kasım 2009 Pazartesi
- Uğur Parlayan
Bazı işleri veritabanına yaptırmak uygulamalara zaman kazandırabiliyor... Veriler üzerinde süre hesaplamak da bunların arasında sayılabilir, çünkü uygulama üzerinde süre hesaplamaktansa veritabanı tablosunu çekerken sürenin hesaplanmış olarak gelmesi hem hız, hem de performans açısından daha kârlıdır. Bununla birlikte bu tür işlere giriştiğinizde sunucunuzun da güçlü olması sıkıntılarınızı azaltabilir...
Aşağıda tanıtacağım kod, dakika (tamsayı) cinsinden verilen bir süreyi "Yıl + Ay + Gün + Saat + Dakika" cinsinden yazabilmenizi sağlıyor. Bir nevi dakikayı okunabilir bir metne çeviriyor. Kıytırık bir iş gibi gözükebilir fakat bu tür küçük şeylerle uğraşmak büyük sistemlerde kodların okunabilirliğini ve hataların çabuk giderilmesini sağlaması açısından gayet faydalıdır.
Şu an kullanmakta olduğumuz takvim konusundaki bilgiyi vikipedi'den edinebilirsiniz. Gevelemeden koda geçelim;
set ANSI_NULLS ON
set QUOTED_IDENTIFIER ON
go
/********************************************************************************\
|* Dakika cinsinden süreyi metne çevirir. Küllim beleş ve paylaşıma açıktır... *|
|* Uğur PARLAYAN © 23.11.2009 Pazartesi *|
\********************************************************************************/
ALTER FUNCTION [dbo].[FN_STR_SureYaz] ( @Parametre INT )
RETURNS VARCHAR(MAX)
AS BEGIN
DECLARE @Sonuc VARCHAR(MAX)
, @ToplamDakika INT
, @ArtanDakika INT
, @ToplamSaat INT
, @ArtanSaat INT
, @ToplamGun INT
, @ArtanGun INT
, @ToplamAy INT
, @ArtanAy INT
, @ToplamYil INT
SELECT @ToplamDakika = ISNULL(@Parametre, 0) /* Tutarlılık için küçük bir önlem :) */
, @ArtanDakika = @ToplamDakika % 60
, @ToplamSaat =(@ToplamDakika - @ArtanDakika) / 60
, @ArtanSaat = @ToplamSaat % 24
, @ToplamGun =(@ToplamSaat - @ArtanSaat) / 24
, @ArtanGun = @ToplamGun % 30.436875
, @ToplamAy =(@ToplamGun - @ArtanGun) / 30.436875
, @ArtanAy = @ToplamAy % 12
, @ToplamYil =(@ToplamAy - @ArtanAy) / 12
SELECT
@Sonuc = CASE WHEN @Parametre<=0 THEN 'yok'
ELSE CASE WHEN @ToplamYil > 0 THEN CAST(@ToplamYil AS VARCHAR)+' yıl ' ELSE '' END
+ CASE WHEN @ArtanAy > 0 THEN CAST(@ArtanAy AS VARCHAR)+' ay ' ELSE '' END
+ CASE WHEN @ArtanGun > 0 THEN CAST(@ArtanGun AS VARCHAR)+' gün ' ELSE '' END
+ CASE WHEN @ArtanSaat > 0 THEN CAST(@ArtanSaat AS VARCHAR)+' saat ' ELSE '' END
+ CASE WHEN @ArtanDakika>0 THEN CAST(@ArtanDakika AS VARCHAR)+' dk' ELSE '' END
END
RETURN (RTRIM(@Sonuc))
END
Şimdi bir de bu fonksiyonun nasıl kullanıldığına dair kısa ve öz bir kaç örnek verelim...
/* Mesela 1 Ocak 1753'den şimdiye kadar olan süreyi yazdıralım */
SELECT dbo.FN_STR_SureYaz(DATEDIFF(minute,'17530101',GETDATE())) as [Geçen Süre]
/* Veya belli iki tarih arasındaki süreyi yazdıralım */
SELECT dbo.FN_STR_SureYaz(DATEDIFF(minute,'20090101','20091010')) as [Geçen Süre]
Geçen Süre
---------------------------------
256 yıl 7 ay 22 gün 14 saat 12 dk
(1 row(s) affected)
Geçen Süre
---------------------------------
9 ay 7 gün
(1 row(s) affected)
T-SQL ile Metinleri Parçalarına Ayrıştırmak
- 01 Eylül 2009 Salı
- Uğur Parlayan
Pascal ile metinleri en küçük parçasına ayrıştırmak başlıklı yazımda Parse işlemine yönelik bir teknikten bahsetmiştim. İlgili yazıya şuradan ulaşabilirsiniz. Aynı konuyu SQL'de nasıl yaparız sorusunu bazı arkadaşlar sormaya başlamış olabilir. Bu konudaki merakı gidermek adına doğrudan bir Kullanıcı Tanımlı Fonksiyon (UDF) tanımlayıp kaynak kodunu aşağıda veriyoruz. Gerekli açıklamaları kod içerisinden takip edebilirsiniz.
set ANSI_NULLS ON
set QUOTED_IDENTIFIER ON
go
/*********************************************************/
/* */
/* Bu fonksiyon, verilen bir metni kelimelerine ayrış- */
/* tırır ve sonucu bir tablo olarak kullanıcıya sunar. */
/* */
/* Uğur PARLAYAN */
/* */
/*********************************************************/
ALTER FUNCTION [dbo].[FN_TBL_KelimeListesi] (
@Parametre VARCHAR(MAX)
, @Ayraclar VARCHAR(100)
)
RETURNS @Sonuc TABLE (
[Sıra] INT IDENTITY(1,1)
, [Boy] INT DEFAULT((0))
, [Ayrac] VARCHAR(1) DEFAULT('')
, [Kelime] VARCHAR(MAX) DEFAULT('')
) AS BEGIN
DECLARE @Basamak INT
, @Boy INT
, @Ayrac VARCHAR(1)
, @Kelime VARCHAR(MAX)
, @Paragraf VARCHAR(MAX)
SELECT @Basamak = 1
, @Ayraclar = ISNULL(@Ayraclar, '%[ ,.:; '
+ CHAR(10)+CHAR(13)
+ '!?"()<&>={}\/*+`_-]%')
, @Paragraf = ISNULL(@Parametre, '')
WHILE @Basamak <> 0 BEGIN
/* En soldan başlayıp ilk ayracımızın hangi basamakta olduğunu buluyoruz */
/* Ardından bu haltı hangi ayraç yemiş onu buluyoruz */
SELECT @Basamak = PATINDEX(@Ayraclar, @Paragraf)
, @Ayrac = SUBSTRING(@Paragraf, @Basamak, 1)
/* Kelimeyi Soldan ayraca kadar alıyoruz */
IF (@Basamak <> 0) SELECT @Kelime = RTRIM(LTRIM(LEFT(@Paragraf, @Basamak - 1)))
ELSE SELECT @Kelime = RTRIM(LTRIM(@Paragraf))
/* Kelimenin boyunu posunu ölçüyoruz */
SET @Boy = LEN(@Kelime)
IF (@Boy > 0) BEGIN
/* Kelimemizi ve boyunu posunu tablomuza yazıyoruz */
INSERT INTO
@Sonuc ( Kelime
, Boy
, Ayrac
)
VALUES ( @Kelime
, @Boy
, @Ayrac
)
END
/* Aldığımız kelimeyi paragraftan siliyoruz */
SELECT @Paragraf = RIGHT(@Paragraf,LEN(@Paragraf) - @Basamak)
/* Paragrafta kelime kalmadıysa döngüden kaçıyoruz */
IF LEN(@Paragraf) = 0 BREAK
END
RETURN
END
Bu kodu kullanabilmek için ise şöyle bir SQL cümlesi kullanmamız yeterli;
SELECT *
FROM dbo.FN_TBL_KelimeListesi('Test,amaçlı!deneysel&veriler.', NULL)
Yukarıdaki sorgumuz ise şöyle bir sonuç tablosu üretecektir;
Sıra Boy Ayrac Kelime
----------- ----------- ----- ----------------------
1 4 , Test
2 6 ! amaçlı
3 8 & deneysel
4 7 . veriler
Hatırlatma
Bu sayfa test aşamasında olup deneysel veriler içermektedir.
Cıvıltılar
- Herkes aynı fikirdeyse, hiç kimse yeterince düşünmüyor demektir
- Beleş malın ömrü kısa olur
- Bütün mucitler tembel olsaydı cilalıtaş devrine yeni girmiştik...
- Çaresizlik insana icat yaptırır...
- Yüzyılın Soykırımı
- Sparkfun elektronik 7 Ocak 2010'da 1000 kişiye 100$ değerinde hediye dağıtacakmış...
- Muharrem Ankara'da işbaşı yaptı, kendisine başarılı ve müreffeh bir iş hayatı diliyoruz :)
- Erhan'a da huzurlu ve mutlu bir ömür diliyoruz.
- MikroPascal'ın LCD kütüphanesinde ne tür bir sorun olabilir AÇAPAAAA! Nerede bu kodlar, nerede bu kaynak kodlar !!!
Kategori Bulutu
Algoritma Delphi Dialog Fonksiyon Kod Örneği Login Metin İşleme Mssql Parse Pascal Programlama Projeler Select Sql T-Sql Upeditbutton Uplogindialog Uplookupdialog Wıth Zaman Ölçme Öneri Şiir
Etikettekiler
- Etiket Sınırlamasını Kaldır
- Delphi ile "Login olmak" (Kullanıcı giriş denetimi)
- T-SQL ile Dakikayı Metne Çevirmek
- T-SQL ile Metinleri Parçalarına Ayrıştırmak
- T-SQL ile Sonuçlarda Sorgulamak
- T-SQL ile Yazım Kurallarını Uygulamak...
- T-SQL ile Metin Filtreleme
- Lookup'a Farklı Bir Yaklaşım (TupLookupDialog)
- Butonlu Edit Nesnesi (TupEditButon)
- Ölü Proje "Tazı"
- T-SQL İle Soy Ağacı Oluşturmak
- Pascal ile Metinleri parçalarına ayrıştırmak
- Düşünmek için algoritma kullanmak
- Bir Cemal Süreya Şiiri
Bağlantılar
- ARGE - Mikro Pascal
- ARGE - TOLA Elektronik
- Blog - Tuğruk Helvacı
- Delphi - Delphi Distiller
- Delphi - Delphi Peak (TR)
- Delphi - Delphi Product Page
- Delphi - Free Jans Components
- Delphi - Krsnsk (Blog)
- Delphi - Regular Expressions
- Delphi - TwinForms
- DHTML - Tab Box
- Donanım - Hardware ağırlıklı site...
- Gfx - Change DPI
- Komünite - Bildirgeç
- Komünite - Zamazing
- OpenXML
- PHP - PHP Designer 2007 - Personal
- SQL - PengoWorks
- SQL - SimpleTalk
- STÖ - Türkcan
- Web - Bluementals - Free CSS Toolbox
- Web - HTML Dog