Neoturk: Forum - "TIdSMTP "
"
Bugün 14:12
TIdSMTP
TIdMessage ve TIdSMTP nesnelerini kullanarak mail atabiliyorum.
Programda mailin gönderilip gönderilmediğini nasıl anlayabilirim.
Teşekkürler...
Heşin
"
cevap:
mailin gönderilip gönderilmediğini smtp nesnesinin "onstatus"
özelliğinden öğrenebilirsin.
procedure TForm1.IdSMTP1Status(axSender: TObject;
const axStatus: TIdStatus; const asStatusText: String);
begin
//...kontroller ve gereken kodlar burada yazılabilir....
case axstatus of
hsResolving: //IP adresi çözülmüştür
begin
end;
hsConnecting://bağlantı noktası açılmıştır
begin
end;
hsConnected://bağlantı kurulmuştur
begin
end;
hsDisconnecting://bağlantı kesilmek üzeredir.
begin
end;
hsDisconnected://bağlantı kalmamıştır, kapanmıştır
begin
end;
hsText://genel bilgi mesajı burada verilmektedir.
begin
label1.caption:=asstatustext;//genel info bilgisini labelde göster
//burada ilgili statustext bilgilerine göre
//mailinizin yerine ulaşıp ulaşmadığını anlayabilirsiniz.
end;
end;//case
//final
end;
size tavsiyem,
örnek bir mail atın, sağlam gönderilen maildeki "asstatustext"yazısını
kontrol edin bakın ne yazıyor içinde diye.
daha sonra hatalı bir mail adresi gönderin. tekrar bu metnin içeriğini kontrol
edin.
duruma göre "pos" functionundan faydalanarak mailin akibeti konusunda kullanıcıyı
bilgilendirebilirsiniz.
bu işlemler nmstrm nesnelerinde daha kolaydı, indy nesnelerinde neden daraltmışlar
anlayamadım bi türlü zaten...
çözüm yukarıda verdiğim mantığa uygundur,
bu nesne için başka yöntem varsa da bilmiyorum.....
kolay gelsin...
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: forum - "sqlde toplam alma"
"
12 Aralık 2005 05:19
Sql'de Toplam Alma
Merhabalar;
Delphi7 ve Paradox veritabanı kullanıyorum.
Stok dosyasında "GelisFiyatı" ve "Miktar" alanları var.
Ben her ürün için:Gelis Fiyatıyla Miktarını çarpıp sonuçta toplam almak istiyorum.
Şunları denedim olmadı:
Select Sum(GelisFiyatı*Miktar) As Maliyet
Select (Sum(GelisFiyatı))*(Sum(Miktar)) As maliyet
Her ikisinde de sonuç 0 Çıkıyor.
Tavsiyelerinizi bekliyorum.
Xvier
"
************************************************
12 Aralık 2005 10:20
çarpıma giren değerlerden birisinin(gelisfiyati veya miktar)
0 olma ihtimali yüksek o nedenle sonuç 0 çıkıyordur.
ayrıca sen gelisfiyatını tek başına topla bakalım sonuç elde edebiliyor musun?
danaci
************************************************
12 Aralık 2005 09:42
Select Sum(tablo.GelisFiyatı * tablo.Miktar) Maliyet from tablo
yazarak dene bide
ObscurE
************************************************
cevap:
adoquery1.close;
adoquery1.sql.text:='
select SUM(GELISFIYATI) as GELISTOPLAM, SUM(MIKTAR) as MIKTARTOPLAM,
SUM(GELISFIYATI*MIKTAR) as MALIYET from TABLO_ADI';
adoquery1.open;
yukarıdaki kodun çıktısı aşağıdaki gibi olur:
GELISTOPLAM MIKTARTOPLAM MALIYET
12500 445 5562500
tüm kayıtların giriş ve miktar çarpımlarının genel toplamını verir.
veri yapınızı ve kodlamanızı tekrar gözden geçirerek test ediniz.
not: ben ado kullandım, paradox için sql cümleciği farketmez. sonuçta sql
ortak bir dildir. yukarıda yazdığım kodu kendi pcimde örnek bir şablon
üzerinde test ettim sorun yok.
kolay gelsin...
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "Combobox ta Text ve Value"
"
Bugün 12:04
Combobox ta Text ve Value
.Net te Combobox taki bir item ın 2 değeri var.Text ve Value.
Combobox taki her item için
text ve value değerleri saklanabiliyor.
Örneğin firma adı ve firma_id diye 2 alan olsun.
Text özelliğine firma adı, value özelliğine firma_id konulabiliyor.
Delphideki combobox ta böle bir kullanım yokmu?
oğuzhann
"
cevap:
combobox'daki tag özelliğini kullanabilirsin.
Longint tipinden içine sayı barındırır.
combobox1.text:='vestel'; //firma_adı
combobox1.tag:=12345; //firma_ID sayısal değer
şeklinde kullanabilirsin.
kolay gelsin...
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "text dosyalar"
"
12 Aralık 2005 19:00
text dosyalar
arkadaşlar merhaba ben bir text dosya içerisinde örneğin
içinde "111" geçen satırları bulup bu satırlar içerisindeki
"abc" kelimsini "zxy" olarak değiştirmek istiyorum
bunun için nasıl bir kodlama yapmam gerekiyor yardımcı olursanız sevinirim
alperkurt
"
cevap:
aşağıda 2 farklı "find-replace"(bul ve değiştir) kod örneği vardır,
Kod: - 1 -
**********************************************************
*** memo1 içindeki "neo"ları "neoturk" olarak değiştir ***
**********************************************************
memo1.Text := StringReplace(memo1.Text,'abc','xyz',[rfReplaceAll]);
Kod: - 2 -
*************************************************************
*** richedit içindeki "abc"ları "xyz" olarak değiştir ***
*************************************************************
function bul_ve_degistir(RichEdit: TRichEdit;SearchText, ReplaceText: string): Boolean;
var
startpos, Position, endpos: integer;
xsart:boolean;
//richediti memo olarak düzenleyebilirsiniz.
//RicheEdit:Tmemo;.... gibi.. kullanın esnekliğinizi!
begin
startpos := 0;
xsart:=false;
with RichEdit do
begin
endpos := Length(RichEdit.Text);
Lines.BeginUpdate;
while FindText(SearchText, startpos, endpos, [stMatchCase])<>-1 do
begin
endpos := Length(RichEdit.Text) - startpos;
Position := FindText(SearchText, startpos, endpos, [stMatchCase]);
Inc(startpos, Length(SearchText));
SetFocus;
SelStart := Position;
SelLength := Length(SearchText);
richedit.clearselection;
SelText := ReplaceText;
xsart:=true;
end;
Lines.EndUpdate;
end;
result:=xsart;
//final
end;
//kullanım örneği:
procedure TForm1.Button1Click(Sender: TObject);
begin
if bul_ve_degistir(Richedit1, 'abc', 'xyz') then showmessage('değişiklik yapıldı')
else showmessage('herhangi bir değişiklik yapılmadı');
//final
end;
sorunuzun tam cevabı olarak aşağıdaki örneği kullanabilirsiniz:
procedure Tform1.button1click(sender:Tobject);
//içinde "111" geçen satırları bulup bu satırlar içerisindeki
//"abc" kelimsini "zxy" olarak değiştirmek istiyorum
var m:integer;x:string;
begin
for m:=0 to memo1.lines.count-1 do
begin
x:=memo1.lines[m];
if pos('111',x)>0 then
memo1.lines[m]:=StringReplace(x,'abc','zxy',[rfReplaceAll]);
end;
//final
end;
kodu daha da süslüyorum ve genel hale getiriyorum:
procedure bul_ve_degistir(memo:Tmemo;aranan,bulunan,yerinekonan:string);
var m:integer;x:string;
begin
for m:=0 to memo.lines.count-1 do
begin
x:=memo.lines[m];
if pos(aranan,x)>0 then
memo.lines[m]:=StringReplace(x,bulunan,yerinekonan,[rfReplaceAll]);
end;
//final
end;
kullanımı:
//button1 onclick
...
bul_ve_degistir(memo1,'111','abc','xyz');
....
daha estetik ve genele dökülmüş oldu.
bul_ve_degistir(memo2,'111','abc','xyz');
şeklinde kullanırsanız memo2 içinde gereken işlemleri yapacaktır....
daha da abartılıp formlar arası memolarda da kullanılabilir.
bul_ve_degistir(form5.memo28,'111','abc','xyz');
//uses unit5 eklenmiş olmalıdır.
kolay gelsin..........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "text dosyalar"
"
12 Aralık 2005 19:00
text dosyalar
arkadaşlar merhaba ben bir text dosya içerisinde örneğin
içinde "111" geçen satırları bulup bu satırlar içerisindeki
"abc" kelimsini "zxy" olarak değiştirmek istiyorum
bunun için nasıl bir kodlama yapmam gerekiyor yardımcı olursanız sevinirim
alperkurt
"
cevap:
aşağıda 2 farklı "find-replace"(bul ve değiştir) kod örneği vardır,
Kod: - 1 -
**********************************************************
*** memo1 içindeki "neo"ları "neoturk" olarak değiştir ***
**********************************************************
memo1.Text := StringReplace(memo1.Text,'abc','xyz',[rfReplaceAll]);
Kod: - 2 -
*************************************************************
*** richedit içindeki "abc"ları "xyz" olarak değiştir ***
*************************************************************
function bul_ve_degistir(RichEdit: TRichEdit;SearchText, ReplaceText: string): Boolean;
var
startpos, Position, endpos: integer;
xsart:boolean;
//richediti memo olarak düzenleyebilirsiniz.
//RicheEdit:Tmemo;.... gibi.. kullanın esnekliğinizi!
begin
startpos := 0;
xsart:=false;
with RichEdit do
begin
endpos := Length(RichEdit.Text);
Lines.BeginUpdate;
while FindText(SearchText, startpos, endpos, [stMatchCase])<>-1 do
begin
endpos := Length(RichEdit.Text) - startpos;
Position := FindText(SearchText, startpos, endpos, [stMatchCase]);
Inc(startpos, Length(SearchText));
SetFocus;
SelStart := Position;
SelLength := Length(SearchText);
richedit.clearselection;
SelText := ReplaceText;
xsart:=true;
end;
Lines.EndUpdate;
end;
result:=xsart;
//final
end;
//kullanım örneği:
procedure TForm1.Button1Click(Sender: TObject);
begin
if bul_ve_degistir(Richedit1, 'abc', 'xyz') then showmessage('değişiklik yapıldı')
else showmessage('herhangi bir değişiklik yapılmadı');
//final
end;
sorunuzun tam cevabı olarak aşağıdaki örneği kullanabilirsiniz:
procedure Tform1.button1click(sender:Tobject);
//içinde "111" geçen satırları bulup bu satırlar içerisindeki
//"abc" kelimsini "zxy" olarak değiştirmek istiyorum
var m:integer;x:string;
begin
for m:=0 to memo1.lines.count-1 do
begin
x:=memo1.lines[m];
if pos('111',x)>0 then
memo1.lines[m]:=StringReplace(x,'abc','zxy',[rfReplaceAll]);
end;
//final
end;
kodu daha da süslüyorum ve genel hale getiriyorum:
procedure bul_ve_degistir(memo:Tmemo;aranan,bulunan,yerinekonan:string);
var m:integer;x:string;
begin
for m:=0 to memo.lines.count-1 do
begin
x:=memo.lines[m];
if pos(aranan,x)>0 then
memo.lines[m]:=StringReplace(x,bulunan,yerinekonan,[rfReplaceAll]);
end;
//final
end;
kullanımı:
//button1 onclick
...
bul_ve_degistir(memo1,'111','abc','xyz');
....
daha estetik ve genele dökülmüş oldu.
bul_ve_degistir(memo2,'111','abc','xyz');
şeklinde kullanırsanız memo2 içinde gereken işlemleri yapacaktır....
daha da abartılıp formlar arası memolarda da kullanılabilir.
bul_ve_degistir(form5.memo28,'111','abc','xyz');
//uses unit5 eklenmiş olmalıdır.
kolay gelsin..........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "dbedit ile ilgili sorunlar"
"
11 Aralık 2005 19:27
dbedit ile ilgili bir sorun(lar)
delphi de ara sıra program yazıyorum basit bir sorun ama yapamadım.
bir formda 200 adet dbedit var ve ben her birinde "İ" harfine basıldığında
dbeditin beyaz arkaplanının sarı olmasını istiyorum.
i harfi silindiğinde de yeniden beyaz renge geri dönmesini istiyorum.
yardım ederseniz sevinirim.
BayBY
"
****************************************************
11 Aralık 2005 23:39
for i:=0 to ComponentCount-1 do
begin
try
if FindComponent(Components[i].Name) is TEdit then
(Components[i].Name).color:=clyellow;
except
Continue;
end;
end;
end;
if i de sen yazarsın artık kolay gelsin..
is_oz
****************************************************
cevap:
is_oz arkadaşımıza yazdığı kod için teşekkürler,
ama sorulan sorunun tam cevabı değil...
yukarıda verilen kod,
tüm Edit nesnelerinin zemin rengini sarı yapar.
BayBY arkadaşım öncelikle şunu belirtmek istiyorum ki,
hiç bir soruya "BASİT" demeyiniz....
bunda utanılacak veya çekinilecek bir durum yoktur.
Bilgim olduğu sürece soruları yanıtlarım, ve memnun olurum arkadaşım.
Soru sormak ayıp değildir, sorunuza "basit" demek de "cevap vereni" yüceltmez.
peki,
200 tane dbedit için estedik bir kod yazacağım,
okey,
dbedit1 in onkeyup olayına aşağıdaki kodu yaz:
if (pos('İ',(sender as TDBedit).Text)>0) or (pos('i',(sender as TDBedit).Text)>0) then
(sender as TDBedit).color:=clyellow
else
(sender as TDBedit).color:=clwhite;
diğer tüm dbeditleri form üzerinde seç ve onkeyup olaylarını dbedit1'in onkeyup
olayına eşitle.
istediğin halloldu.. programı çalıştır ve test et....
herhangi bir DBedit içerisinde küçük harf "i" veya büyük harf "İ" ye
basıldığında ilgili DBedit hücresinin içeriği SARI zemin rengi olacak,
aksi halde beyaz zemin rengi olacaktır.
kolay gelsin......
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "dbedit ile ilgili sorunlar"
"
11 Aralık 2005 19:27
dbedit ile ilgili bir sorun(lar)
delphi de ara sıra program yazıyorum basit bir sorun ama yapamadım.
bir formda 200 adet dbedit var ve ben her birinde "İ" harfine basıldığında
dbeditin beyaz arkaplanının sarı olmasını istiyorum.
i harfi silindiğinde de yeniden beyaz renge geri dönmesini istiyorum.
yardım ederseniz sevinirim.
BayBY
"
****************************************************
11 Aralık 2005 23:39
for i:=0 to ComponentCount-1 do
begin
try
if FindComponent(Components[i].Name) is TEdit then
(Components[i].Name).color:=clyellow;
except
Continue;
end;
end;
end;
if i de sen yazarsın artık kolay gelsin..
is_oz
****************************************************
cevap:
is_oz arkadaşımıza yazdığı kod için teşekkürler,
ama sorulan sorunun tam cevabı değil...
yukarıda verilen kod,
tüm Edit nesnelerinin zemin rengini sarı yapar.
BayBY arkadaşım öncelikle şunu belirtmek istiyorum ki,
hiç bir soruya "BASİT" demeyiniz....
bunda utanılacak veya çekinilecek bir durum yoktur.
Bilgim olduğu sürece soruları yanıtlarım, ve memnun olurum arkadaşım.
Soru sormak ayıp değildir, sorunuza "basit" demek de "cevap vereni" yüceltmez.
peki,
200 tane dbedit için estedik bir kod yazacağım,
okey,
dbedit1 in onkeyup olayına aşağıdaki kodu yaz:
if (pos('İ',(sender as TDBedit).Text)>0) or (pos('i',(sender as TDBedit).Text)>0) then
(sender as TDBedit).color:=clyellow
else
(sender as TDBedit).color:=clwhite;
diğer tüm dbeditleri form üzerinde seç ve onkeyup olaylarını dbedit1'in onkeyup
olayına eşitle.
istediğin halloldu.. programı çalıştır ve test et....
herhangi bir DBedit içerisinde küçük harf "i" veya büyük harf "İ" ye
basıldığında ilgili DBedit hücresinin içeriği SARI zemin rengi olacak,
aksi halde beyaz zemin rengi olacaktır.
kolay gelsin......
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "dbgrid sıralama"
"
11 Aralık 2005 02:12
dbgrid sıralama
arkadaşlar DBGridde alfabetik sıralama nasıl yapılır.yeni kayıt
girildiğinde en sona atıyor.A-Z olarak düzgün bir sıralama yapmam lazım.
Table olarak Adotable kullanıyorum..
bi sorum daha olacaktı arkadaşalar..
recordcount dbgridin satırsayısını verir.benim amacım DBgiriddeki bir
sutunun recordcountunu almak istiyorum.yani satırsayısından ziyade
(boş satırlarıda görüyor çünkü)dolu satırların sayısını almam..
arkadaşlar örnekte olduğu gibi sütunda 6 satır ama 3 kayıt var.
_______ ben labele 3 yazdırmak istiyorum.anlaşılmıştır umarım sağolun
_______]1
_______]2
_osman_]3
_kazım_]4
_______]5
_ali___]6
frantic00
"
*******************************
11 Aralık 2005 17:34
Adotable1.Sort := 'ADI ASC';
asc aslında default değerdir. Tersini yapma istersen desc kullanman gerekir.
İkinci soru için bir döngü kurman gerekir null olmayan satırları say gibi.
Kolay gelsin
asedizer
********************************
cevap:
asedizer arkadaşımıza teşekkürler, verdiği kodlama ve açıklaması doğrudur.
bu kodu biraz daha açmak istiyorum,
dbgrid üzerinde tıklanılan alana göre sıralama yaptırmak istersek;
( hep de bu soru soruluyordu şimdi cevap veriyorum topluca )
dbgridin ilgili click olayına ( tek-çift click,columclick, seçim sizin )
aşağıdaki kodu yazınız,
//written by neoturk - 2005
var m:integer;
begin
m:=dbgrid1.Columns.Grid.SelectedField.Index; //seçili olan field saha numarası
adotable1.sort:=dbgrid1.Columns[m].FieldName;//tıklanan kolondaki field sahasına göre sırala
//final
end;
bu yöntemi kendi programlarımda kullanıyorum.
sizler de kullanın.
ikinci sorunuza gelecek olur isek,
_______]1
_______]2
_osman_]3
_kazım_]4
_______]5
_ali___]6
böyle bir yapıda olan dbgridinizdeki 6 kayıt içersindeki görünen 3 adet
kaydın sayısını label içerisine aktarmak istiyorsunuz ?...
( toplamda 6 kayıt var, ama label içerisine 3 yazacak )
okey,
( teorik yazıyorum, syntax hatam olursa düzeltin )
peki, şık bir kod olsun...
button1 onclick olayına aşağıdaki kodu yaz:
//written by neoturk - 2005
var toplam:integer;
function say(sahaadi:string;tur:byte):integer;
var x:string;t:integer;
//tur=1 olursa dolu kayıt sayısını saysın
//tur=0 olursa boş kayıt sayısını saysın
begin
t:=0;//kayıt sayacı
adotable1.first;
while not(adotable1.eof) do
begin
x:=trim(adotable1.fieldbyname(sahaadi).astring);//ilgili field hücre içeriği
case tur of
0:if x='' then inc(t);//boş kayıt sayısı değerini +1 artır
1:if x<>'' then inc(t);//dolu kayıt sayısı değerini +1 artır
end;//case
adotable1.next;//sonraki kayda git
end;
result:=t;
//final
end;
//buttonun ana begini
begin
//ADSOYAD hanesine göre sorgulama yap
toplam:=say('ADSOYAD',1);label1.caption:='İçi dolu kayıt sayısı = '+inttostr(toplam);
toplam:=say('ADSOYAD',0);label2.caption:='İçi boş kayıt sayısı = '+inttostr(toplam);
//TELEFON hanesine göre sorgulama yap
//toplam:=say('TELEFON',1);label1.caption:='İçi dolu kayıt sayısı = '+inttostr(toplam);
//toplam:=say('TELEFON',0);label2.caption:='İçi boş kayıt sayısı = '+inttostr(toplam);
//final
end;
not-1: tablodaki aktif satırın yeri her defasında son kayda konumlanacaktır.
bunu da engelleyebilirdik, yerini ve istifini bozdurtmayabilirdik,
ama zamanım yok şu anda.
not-2: sorgulanacak field alanlarının içeriğini .asstring olarak algılattım.
buna dikkat edin. sayısal field içerikleri için hata verebilir. bunun için
biraz daha incelik ve detay kodlama gerektiriyor.
( functiona bir parametre daha ekletip saha türünün string mi sayısal mı
olduğunu peşin-peşin belirtip ona göre normal trim(stringler için)
ya da içi 0 mı değil mi mantığı ile çözümleyebilirdik.
sonuç olarak, yukarıdaki kod parçası, sadece string türü içeren field sahaları
için sorunsuz çalışmasını bekliyorum.
kodu teorik olarak yazdım. şimdilik bir hata görünmüyor.
bunu deneyin, ve kendinize göre geliştirin.
sanırım istediğiniz buydu.
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "dbgrid sıralama"
"
11 Aralık 2005 02:12
dbgrid sıralama
arkadaşlar DBGridde alfabetik sıralama nasıl yapılır.yeni kayıt
girildiğinde en sona atıyor.A-Z olarak düzgün bir sıralama yapmam lazım.
Table olarak Adotable kullanıyorum..
bi sorum daha olacaktı arkadaşalar..
recordcount dbgridin satırsayısını verir.benim amacım DBgiriddeki bir
sutunun recordcountunu almak istiyorum.yani satırsayısından ziyade
(boş satırlarıda görüyor çünkü)dolu satırların sayısını almam..
arkadaşlar örnekte olduğu gibi sütunda 6 satır ama 3 kayıt var.
_______ ben labele 3 yazdırmak istiyorum.anlaşılmıştır umarım sağolun
_______]1
_______]2
_osman_]3
_kazım_]4
_______]5
_ali___]6
frantic00
"
*******************************
11 Aralık 2005 17:34
Adotable1.Sort := 'ADI ASC';
asc aslında default değerdir. Tersini yapma istersen desc kullanman gerekir.
İkinci soru için bir döngü kurman gerekir null olmayan satırları say gibi.
Kolay gelsin
asedizer
********************************
cevap:
asedizer arkadaşımıza teşekkürler, verdiği kodlama ve açıklaması doğrudur.
bu kodu biraz daha açmak istiyorum,
dbgrid üzerinde tıklanılan alana göre sıralama yaptırmak istersek;
( hep de bu soru soruluyordu şimdi cevap veriyorum topluca )
dbgridin ilgili click olayına ( tek-çift click,columclick, seçim sizin )
aşağıdaki kodu yazınız,
//written by neoturk - 2005
var m:integer;
begin
m:=dbgrid1.Columns.Grid.SelectedField.Index; //seçili olan field saha numarası
adotable1.sort:=dbgrid1.Columns[m].FieldName;//tıklanan kolondaki field sahasına göre sırala
//final
end;
bu yöntemi kendi programlarımda kullanıyorum.
sizler de kullanın.
ikinci sorunuza gelecek olur isek,
_______]1
_______]2
_osman_]3
_kazım_]4
_______]5
_ali___]6
böyle bir yapıda olan dbgridinizdeki 6 kayıt içersindeki görünen 3 adet
kaydın sayısını label içerisine aktarmak istiyorsunuz ?...
( toplamda 6 kayıt var, ama label içerisine 3 yazacak )
okey,
( teorik yazıyorum, syntax hatam olursa düzeltin )
peki, şık bir kod olsun...
button1 onclick olayına aşağıdaki kodu yaz:
//written by neoturk - 2005
var toplam:integer;
function say(sahaadi:string;tur:byte):integer;
var x:string;t:integer;
//tur=1 olursa dolu kayıt sayısını saysın
//tur=0 olursa boş kayıt sayısını saysın
begin
t:=0;//kayıt sayacı
adotable1.first;
while not(adotable1.eof) do
begin
x:=trim(adotable1.fieldbyname(sahaadi).astring);//ilgili field hücre içeriği
case tur of
0:if x='' then inc(t);//boş kayıt sayısı değerini +1 artır
1:if x<>'' then inc(t);//dolu kayıt sayısı değerini +1 artır
end;//case
adotable1.next;//sonraki kayda git
end;
result:=t;
//final
end;
//buttonun ana begini
begin
//ADSOYAD hanesine göre sorgulama yap
toplam:=say('ADSOYAD',1);label1.caption:='İçi dolu kayıt sayısı = '+inttostr(toplam);
toplam:=say('ADSOYAD',0);label2.caption:='İçi boş kayıt sayısı = '+inttostr(toplam);
//TELEFON hanesine göre sorgulama yap
//toplam:=say('TELEFON',1);label1.caption:='İçi dolu kayıt sayısı = '+inttostr(toplam);
//toplam:=say('TELEFON',0);label2.caption:='İçi boş kayıt sayısı = '+inttostr(toplam);
//final
end;
not-1: tablodaki aktif satırın yeri her defasında son kayda konumlanacaktır.
bunu da engelleyebilirdik, yerini ve istifini bozdurtmayabilirdik,
ama zamanım yok şu anda.
not-2: sorgulanacak field alanlarının içeriğini .asstring olarak algılattım.
buna dikkat edin. sayısal field içerikleri için hata verebilir. bunun için
biraz daha incelik ve detay kodlama gerektiriyor.
( functiona bir parametre daha ekletip saha türünün string mi sayısal mı
olduğunu peşin-peşin belirtip ona göre normal trim(stringler için)
ya da içi 0 mı değil mi mantığı ile çözümleyebilirdik.
sonuç olarak, yukarıdaki kod parçası, sadece string türü içeren field sahaları
için sorunsuz çalışmasını bekliyorum.
kodu teorik olarak yazdım. şimdilik bir hata görünmüyor.
bunu deneyin, ve kendinize göre geliştirin.
sanırım istediğiniz buydu.
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "boş veri girişinin engellenmesi - 2"
*********************************************************
ilgili hücrelerin en az bir tanesinin doldurulması şartı
**********************************************************
//button1 cliğine ( kaydet butonu )
var x:string;
begin
x:=edit1.text+edit2.text+edit3.text+...+edit10.text; //hangi hücrelerin
//boş geçilmesini istemiyorsan yan yana ekle
x:=trim(x);
if x<>'' then
begin
...
kayıt işlemleri;
...
end
else ShowMessage('en az bir hücre doldurulmalıdır');
//final
end;
*********************************************************
tüm hücrelerin boş geçilememe şartı ve kontrolü
**********************************************************
//button1 cliğine ( kaydet butonu )
function bosmu(xx:string):boolean;
begin
if trim(xx)='' then result:=true else result:=false;
end;
begin
if bosmu(edit1.text) then
begin
showmessage('ad hanesi boş geçilemez');
edit1.setfocus;exit;
end
if bosmu(edit2.text) then
begin
showmessage('soyad hanesi boş geçilemez');
edit2.setfocus;exit;
end
if bosmu(edit3.text) then
begin
showmessage('tcno boş geçilemez');
edit3.setfocus;exit;
end
if bosmu(edit4.text) then
begin
showmessage('adres boş geçilemez');
edit4.setfocus;exit;
end
//buraya kadar exit ile çıkılmadan gelindiği için
//tüm hücreler doludur demektir.
...
kayıt işlemlerini burada yap;
...
//final
end;
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "boş veri girişinin engellenmesi - 2"
*********************************************************
ilgili hücrelerin en az bir tanesinin doldurulması şartı
**********************************************************
//button1 cliğine ( kaydet butonu )
var x:string;
begin
x:=edit1.text+edit2.text+edit3.text+...+edit10.text; //hangi hücrelerin
//boş geçilmesini istemiyorsan yan yana ekle
x:=trim(x);
if x<>'' then
begin
...
kayıt işlemleri;
...
end
else ShowMessage('en az bir hücre doldurulmalıdır');
//final
end;
*********************************************************
tüm hücrelerin boş geçilememe şartı ve kontrolü
**********************************************************
//button1 cliğine ( kaydet butonu )
function bosmu(xx:string):boolean;
begin
if trim(xx)='' then result:=true else result:=false;
end;
begin
if bosmu(edit1.text) then
begin
showmessage('ad hanesi boş geçilemez');
edit1.setfocus;exit;
end
if bosmu(edit2.text) then
begin
showmessage('soyad hanesi boş geçilemez');
edit2.setfocus;exit;
end
if bosmu(edit3.text) then
begin
showmessage('tcno boş geçilemez');
edit3.setfocus;exit;
end
if bosmu(edit4.text) then
begin
showmessage('adres boş geçilemez');
edit4.setfocus;exit;
end
//buraya kadar exit ile çıkılmadan gelindiği için
//tüm hücreler doludur demektir.
...
kayıt işlemlerini burada yap;
...
//final
end;
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "boş veri girişinin engellenmesi"
"
10 Aralık 2005 08:39
merhaba arkadaslar
nevigator kullanmak istemiyorum.bunu biliyorum aynı şeyi kodlarla yapmak
istiyorum.yinede teşekkürler mesajın için.
birde editlerim boş oldugu halde kaydet dediğim zaman boş veri olarak kayıt
yapıyor.bunu nasıl önleyebilirim.
1-//kaydet
append
edit1.text:=table1Adi.text;
"
"
"
bundan sonra editleri temizliyorum
edit1.clear;
"
"
"
başka ne ekleyebilirim boş kayıt yapmaması için
hepsini doldurma zorunluluğu dışında.
2-//düzelt
düzeltmede de buldugu kaydı
editlarda gösterip kayıt et diyorum
bana yeni bir tane kayıt olarak ekliyor.bunu nasıl yapabilirim.
(ben askerim şuan ve pek internete giremiyorum.o nedenle bilgilerim yok
elimde.askerlik insana herşeyi unutturuyor..)
şimdiden teşekkür ederim yardımlarınız için...
suskunking33
"
**************************
10 Aralık 2005 12:46
zorunlu alanlar içn
if ( (edit1.text<>'') and (edit2.text<>'')...) then
begin
kayt işlemleri >>
end else begin
ShowMessage('BOş alanları doldurun');
Exit;
end;
gibi kontrol yaptırabilirsin
ObscurE
***************************
cevap:
öncelikle hayırlı teskereler diliyorum,
askerliğin nasıl olduğunu bilirim......
Allah kolaylık versin...
Obscure arkadaşımıza teşekkürler verdiği yanıt için,
kendi yorumumla kodu şu şekilde düzeltiyorum:
1. düzeltemede bulduğu kaydı yeni bir kayıt olarak eklememek için:
table1.edit;
table1adi=edit1.text;
table1soyadi=edit2.text;
.....
table1.post;
şeklinde kodlama kullanman gerekir.
aktif kaydı düzeltmiş olarak aynı yere yazarsın.
2. yeni kayıt eklemek için:
table1.append;
table1adi=edit1.text;
table1soyadi=edit2.text;
.....
table1.post;
yeni bir kayıt olarak en sona ekler.
3. boş alanların kontrolü için:
yöntem-1:
sanırım paradox kullanıyorsun ( kodlama tercihinden anladığım kadarıyla )
active desktop veri tabanı yönetiminden ilgili field alanlarının
özelliklerine göz at. boş hücre geçememe şartı çentiğini koy.
yöntem-2:
kodlama ile kontrol yaptırmak istiyorsan:
Obscure arkadaşımızın dediği gibi,
if ( (edit1.text<>'') and (edit2.text<>'')...) then
begin
kayt işlemleri >>
end else begin
ShowMessage('BOş alanları doldurun');
Exit;
end;
şeklinde kullanabilirsin,
şayet edit sayısı çok fazla ise bu sana küflet getirecektir,
bunu da şu şekilde yapmanı öneririm,
hafif bir incelik katıyorum......
//button1 cliğine ( kaydet butonu )
var x:string;
begin
x:=edit1.text+edit2.text+edit3.text+...+edit10.text; //hangi hücrelerin
//boş geçilmesini istemiyorsan yan yana ekle
x:=trim(x);
if x<>'' then
begin
...
kayt işlemleri;
...
end
else ShowMessage('BOş alanları doldurun');
//final
end;
daha şık ve estedik bir kodlama oldu.
tüm editleri tek bir satırla kontrol ettirdik.
bu örnekle kodlama estetiğinizin daha da ilerlemesi dileklerimle,
kolay gelsin..........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "boş veri girişinin engellenmesi"
"
10 Aralık 2005 08:39
merhaba arkadaslar
nevigator kullanmak istemiyorum.bunu biliyorum aynı şeyi kodlarla yapmak
istiyorum.yinede teşekkürler mesajın için.
birde editlerim boş oldugu halde kaydet dediğim zaman boş veri olarak kayıt
yapıyor.bunu nasıl önleyebilirim.
1-//kaydet
append
edit1.text:=table1Adi.text;
"
"
"
bundan sonra editleri temizliyorum
edit1.clear;
"
"
"
başka ne ekleyebilirim boş kayıt yapmaması için
hepsini doldurma zorunluluğu dışında.
2-//düzelt
düzeltmede de buldugu kaydı
editlarda gösterip kayıt et diyorum
bana yeni bir tane kayıt olarak ekliyor.bunu nasıl yapabilirim.
(ben askerim şuan ve pek internete giremiyorum.o nedenle bilgilerim yok
elimde.askerlik insana herşeyi unutturuyor..)
şimdiden teşekkür ederim yardımlarınız için...
suskunking33
"
**************************
10 Aralık 2005 12:46
zorunlu alanlar içn
if ( (edit1.text<>'') and (edit2.text<>'')...) then
begin
kayt işlemleri >>
end else begin
ShowMessage('BOş alanları doldurun');
Exit;
end;
gibi kontrol yaptırabilirsin
ObscurE
***************************
cevap:
öncelikle hayırlı teskereler diliyorum,
askerliğin nasıl olduğunu bilirim......
Allah kolaylık versin...
Obscure arkadaşımıza teşekkürler verdiği yanıt için,
kendi yorumumla kodu şu şekilde düzeltiyorum:
1. düzeltemede bulduğu kaydı yeni bir kayıt olarak eklememek için:
table1.edit;
table1adi=edit1.text;
table1soyadi=edit2.text;
.....
table1.post;
şeklinde kodlama kullanman gerekir.
aktif kaydı düzeltmiş olarak aynı yere yazarsın.
2. yeni kayıt eklemek için:
table1.append;
table1adi=edit1.text;
table1soyadi=edit2.text;
.....
table1.post;
yeni bir kayıt olarak en sona ekler.
3. boş alanların kontrolü için:
yöntem-1:
sanırım paradox kullanıyorsun ( kodlama tercihinden anladığım kadarıyla )
active desktop veri tabanı yönetiminden ilgili field alanlarının
özelliklerine göz at. boş hücre geçememe şartı çentiğini koy.
yöntem-2:
kodlama ile kontrol yaptırmak istiyorsan:
Obscure arkadaşımızın dediği gibi,
if ( (edit1.text<>'') and (edit2.text<>'')...) then
begin
kayt işlemleri >>
end else begin
ShowMessage('BOş alanları doldurun');
Exit;
end;
şeklinde kullanabilirsin,
şayet edit sayısı çok fazla ise bu sana küflet getirecektir,
bunu da şu şekilde yapmanı öneririm,
hafif bir incelik katıyorum......
//button1 cliğine ( kaydet butonu )
var x:string;
begin
x:=edit1.text+edit2.text+edit3.text+...+edit10.text; //hangi hücrelerin
//boş geçilmesini istemiyorsan yan yana ekle
x:=trim(x);
if x<>'' then
begin
...
kayt işlemleri;
...
end
else ShowMessage('BOş alanları doldurun');
//final
end;
daha şık ve estedik bir kodlama oldu.
tüm editleri tek bir satırla kontrol ettirdik.
bu örnekle kodlama estetiğinizin daha da ilerlemesi dileklerimle,
kolay gelsin..........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "uzak masaüstü"
"
9 Aralık 2005 23:26
Uzak masaüstü
Ağdaki yada internete bağlı bi bilgisayarın masaüstünü kendi masaüstümüzmüş
gibi kullanabilme şansımız varmı.Açılan penceleri falan aynı kendi
bilgisayarımızda olduğu gibi.Bunu nasıl yapabilirim.
MK-Programing
"
cevap:
www.geocities.com/neoturk2003/remote_desktop.zip
bu örneği indirin ve inceleyin.
win98 de %100 olarak remote desktop yönetimi yapıyordu, zamanında test etmiştim.
xp için nasıl bir reaksiyon verir bilmiyorum.
delphi kaynak kodları içindedir.
kolay gelsin...
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "uzak masaüstü"
"
9 Aralık 2005 23:26
Uzak masaüstü
Ağdaki yada internete bağlı bi bilgisayarın masaüstünü kendi masaüstümüzmüş
gibi kullanabilme şansımız varmı.Açılan penceleri falan aynı kendi
bilgisayarımızda olduğu gibi.Bunu nasıl yapabilirim.
MK-Programing
"
cevap:
www.geocities.com/neoturk2003/remote_desktop.zip
bu örneği indirin ve inceleyin.
win98 de %100 olarak remote desktop yönetimi yapıyordu, zamanında test etmiştim.
xp için nasıl bir reaksiyon verir bilmiyorum.
delphi kaynak kodları içindedir.
kolay gelsin...
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "multi thread kullanarak dosya alıp göndermek"
"
9 Aralık 2005 22:49
multi thread kullanarak dosya alıp göndermek
Selam arkadaşlar.Bir şirket dosyalarını LAN üzerinde bir serverda toplayıp
kataloglayabileceği bir program istiyor. Dosyalar gönderildikten sonra
client'lar sorgularla istediği dosyayı alabilecek. Fakat şöyle bir problemim var:
1)Aynı anda birden fazla dosyanın gönderilebilmesini nasıl sağlarım?
server/clientsocket kullandım.UDP kullanmak dahamı mantıklı?
2)Serverda veritabanı kullanarak eklenen dosyaların konumları ve diğer
özelliklerini saklamak istiyorum.Böylece değişik kriterlerle kullanıcılar
arama yapabilecek.BDE kurulumu yapmadan çalışması için ADO bileşenlerini
kullanmak geldi aklıma.Bu querry sorgularını client'tan mesaj olarak yollayıp,
serverda işletmeye çalıştım.Fakat bu seferde server overload oluyor.
Başka bir çözümü varmı yapmaya çalıştığım işin?
Cevaplarınız için teşekkür ederim.
Binocular
"
cevap:
öncelikle güzel sorunuz için teşekkür ederim.
cevap-1:
-client üzerinden aynı anda birden fazla dosyayı servere göndermek istiyor iseniz,
sitedeki örnek programlar arşivinde örnek program bulabilirsiniz. arama kriteri olarak
"socket" yazınız.
***********************
program yazarından alıntıdır:
"
Socketler ile *çoklu* dosya transferi
Daha önce de bu konuda bir örnek yazmıştım. O örnekte bir çok hata vardı ve onunla
aynı anda yalnızca 1 dosya gönderiliyordu hatırladığım kadarıyla.
Ben de yeni bir örnek yazdım.
* Bu örnekte açılan dosya penceresinden bir çok dosya seçerek bunları
aynı anda gönderebilirsiniz.
* Hem server hem de client tarafında dosyaların transfer durumlarını görebilirsiniz.
Bu örnekte dosya thread üzerinde çalışan bir blocking socket ile gönderiliyor
ve server tarafından non-blocking socket ile alınıyor.
Neden dosyayı blocking socket ile gönderiyoruz derseniz:
1) non-blocking socketlerde (özellikle çift işlemcili bilgisayarlarda) arka arkaya
gönderilen veriler yerlerine sırasıyla ulaşmayabilir.
örneğin bir non-blocking socket ile sırasıyla:
Send(s, '1' ....
Send(s, '2' ....
verilerini yollarsak karşı tarafın ilk önce '2' sonra '1' verisini alması muhtemeldir.
2) dosya transferi yaptığımızdan arka arkaya büyük boyutlu veriler göndereceğiz.
Bu yüzden winsock'un bize ayırdığı buffer hemen dolacaktır ve biz de buffer
boşalana kadar bekleyeceğiz. Zaten o zaman da non-blocking socket kullanmamızın
hiç bir esprisi kalmıyor.
Gönderilen Veri servera düzgün ulaştıktan sonra serverın non-blocking veya
blocking socket kullanması önemli değil. Kolay olsun diye
(threadler ile uğraşmamak için) serverda non-blocking socket kullandım.
Daha da kolay olsun diye de Delphi'nin TServerSocket bileşenini kullandım.
Önemli
======
Programı Delphi7 ile yazdım. Normalde TClientSocket ve TServerSocket kurulum
sırasında yüklenmiyor. O yüzden bu bileşenleri yüklemek gerekiyor:
Delphi7 -> Component -> Install Packages -> Add -> Delphi7Bin -> dclsockets70.bpl
metinsdr@hotmail.com
470734
"
********************************
cevap-1:(devam)
LAN üzerinde UDP kullanmak daha mantıklıdır. maliyeti düşük ve hızı yüksektir.
dışarıdan internet üzerinden dosya gönderimi yapacak iseniz tcp/ip yani socket
programlamayı yapmanız uygundur.
dosya gönderimini udp ile yapabilirsiniz. ben bunu kendi bir örnek LAN projemde
kullandım. dosyayı byte-byte çok hızlı gönderiyor. buradan yola çıkarak web-cam
capture programı dahi yazmıştım. UDPnin hızı karşısında gerçekten şoka girmiştim
LAN üzerinde.
UDP nin güzel yanı, bağlantı şartının olmaması. istediğiniz bilgiyi gönderdiğinizde,
mesaj ya da paket farketmez, server üzerine rahatlıkla gönderilir.
Bu trafiği de yan mantıklarla yönlendirebilirsiniz.
Dosya aktarımını LAN üzerinde tcp/ip ile de yapabilirsiniz. Bunun avantajı ise
program içindeki kontrolleri daha bilinçli yaparsınız. seçim size kalıyor.
Gerekirse ana kontroller için tcp/ip, dosya gönderimleri için UDP kodlamasını
seçebilirsiniz.
cevap-2:
BDE ye gerek kalmadan ADO seçiminiz çok güzel !
bunu defalarca daha önceki yazılarımda da vurgulamaya çalışmıştım.
paradoxla vs uğraşmadan direkt olarak accessi kullanmanız size avantaj sağlar.
Ben bu politikayı uyguluyorum yazdığım programlarda. şu ana kadar beni yüzüstü
bırakmadı.
queryleri clientten mesaj olarak göndermeniz da harika bir yöntem.
Bu yöntemi de bir önceki projemde "remote db query" olarak kullanmıştım ve
sorgu sonuçlarını da dbgride tcp/ip üzerinden yansıttırıyordum. 15 kullanıcıya
kadar şu anda kullanılan kurumlar arası bir programım mevcuttur. herhangi bir
problemle karşılaşmadım. yönteminiz doğrudur.
overload işlemine gelince,
serverin overload işlemine maruz kalması şunlardan kaynaklanır,
aynı socket üzerinde hem mesaj hem dosya paketi işlemi yaptırmak isterseniz
overload işlemine maruz kalırsınız ki server hata üretir.
Bunu engellemenin en uygun yolu şöyledir ( ben şöyle kullandım )
- main haberleşme portu
- kullanıcılara belirli yetkiler ( sorgulama izni, upload - download izni vs )
- dosya iletişim portları ( en az 5 adet. 5 kullanıcı için varsayıyorum )
- query portu ( sorgu mesajları için )
bu mimariyi server üzerinde sağlıklı olarak kurarsanız ve yapılandırırsanız
şöyle bir mantığımız olacaktır:
- main haberleşme portu üzerinden kim ne işlem yapıyor yetkisi nedir, bağlantılar,
kopmalar vs bu port aracılığı ile hem tüm clientlere müdahale ettirebilirsiniz,
hem de client işlemlerinizi hiyararşik olarak kodlayabilirsiniz.
- kullanıcı yetkilendirmelerinizi yaparsanız, gereksiz queryleri engellemiş olursunuz,
gerekli flood ayarlarını da yaptırabilirsiniz, gereksiz hattı meşgul etmeleri de
engellemiş olursunuz.
- dosya iletişim portları sayesinde, hangi port müsaid ise ( 5 porttan )
server ilgili port numarasını cliente gönderir, client de ilgili port üzerinden
iş kuyruğuna göre dosyaları bu port üzerinden servere gönderir. tüm portlar
dolu ise ( 5 port birden ) , cliente "lütfen bekleyiniz" mesajı gönderip,
beklemesini söyleyebilirsiniz, veya bu clienti iş kuyruğuna atabilirsiniz.
servere düzenli bir iş kuyruğu mimarisini oturtmalısınız.
iyi hesaplayıp iyi düşünmeniz yararlı olacaktır.
- query portu da hangi clientten gelen sql cümleciklerini sorgulatır ve cliente
çıktı dosyasının yerini belirler. client de bu çıktı dosyasını kendi pc sine
indirir. bu da sağlıklı bir yöntem.
tüm bunları yaparsanız, N adet client, servere sırasıyla dosyaları gönderebilir,
query çekebilir, ve işlemler karışmadan işinizi yaptırabilirsiniz.
uğraşmakta olduğunuz bu konu gerçekten iyi bir çalışma sahası.
kodlamalarda takıldığınız yerler olursa yardımcı olurum,
çok ince noktalarla karşılaşacaksınız.....
kolay gelsin....
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "multi thread kullanarak dosya alıp göndermek"
"
9 Aralık 2005 22:49
multi thread kullanarak dosya alıp göndermek
Selam arkadaşlar.Bir şirket dosyalarını LAN üzerinde bir serverda toplayıp
kataloglayabileceği bir program istiyor. Dosyalar gönderildikten sonra
client'lar sorgularla istediği dosyayı alabilecek. Fakat şöyle bir problemim var:
1)Aynı anda birden fazla dosyanın gönderilebilmesini nasıl sağlarım?
server/clientsocket kullandım.UDP kullanmak dahamı mantıklı?
2)Serverda veritabanı kullanarak eklenen dosyaların konumları ve diğer
özelliklerini saklamak istiyorum.Böylece değişik kriterlerle kullanıcılar
arama yapabilecek.BDE kurulumu yapmadan çalışması için ADO bileşenlerini
kullanmak geldi aklıma.Bu querry sorgularını client'tan mesaj olarak yollayıp,
serverda işletmeye çalıştım.Fakat bu seferde server overload oluyor.
Başka bir çözümü varmı yapmaya çalıştığım işin?
Cevaplarınız için teşekkür ederim.
Binocular
"
cevap:
öncelikle güzel sorunuz için teşekkür ederim.
cevap-1:
-client üzerinden aynı anda birden fazla dosyayı servere göndermek istiyor iseniz,
sitedeki örnek programlar arşivinde örnek program bulabilirsiniz. arama kriteri olarak
"socket" yazınız.
***********************
program yazarından alıntıdır:
"
Socketler ile *çoklu* dosya transferi
Daha önce de bu konuda bir örnek yazmıştım. O örnekte bir çok hata vardı ve onunla
aynı anda yalnızca 1 dosya gönderiliyordu hatırladığım kadarıyla.
Ben de yeni bir örnek yazdım.
* Bu örnekte açılan dosya penceresinden bir çok dosya seçerek bunları
aynı anda gönderebilirsiniz.
* Hem server hem de client tarafında dosyaların transfer durumlarını görebilirsiniz.
Bu örnekte dosya thread üzerinde çalışan bir blocking socket ile gönderiliyor
ve server tarafından non-blocking socket ile alınıyor.
Neden dosyayı blocking socket ile gönderiyoruz derseniz:
1) non-blocking socketlerde (özellikle çift işlemcili bilgisayarlarda) arka arkaya
gönderilen veriler yerlerine sırasıyla ulaşmayabilir.
örneğin bir non-blocking socket ile sırasıyla:
Send(s, '1' ....
Send(s, '2' ....
verilerini yollarsak karşı tarafın ilk önce '2' sonra '1' verisini alması muhtemeldir.
2) dosya transferi yaptığımızdan arka arkaya büyük boyutlu veriler göndereceğiz.
Bu yüzden winsock'un bize ayırdığı buffer hemen dolacaktır ve biz de buffer
boşalana kadar bekleyeceğiz. Zaten o zaman da non-blocking socket kullanmamızın
hiç bir esprisi kalmıyor.
Gönderilen Veri servera düzgün ulaştıktan sonra serverın non-blocking veya
blocking socket kullanması önemli değil. Kolay olsun diye
(threadler ile uğraşmamak için) serverda non-blocking socket kullandım.
Daha da kolay olsun diye de Delphi'nin TServerSocket bileşenini kullandım.
Önemli
======
Programı Delphi7 ile yazdım. Normalde TClientSocket ve TServerSocket kurulum
sırasında yüklenmiyor. O yüzden bu bileşenleri yüklemek gerekiyor:
Delphi7 -> Component -> Install Packages -> Add -> Delphi7Bin -> dclsockets70.bpl
metinsdr@hotmail.com
470734
"
********************************
cevap-1:(devam)
LAN üzerinde UDP kullanmak daha mantıklıdır. maliyeti düşük ve hızı yüksektir.
dışarıdan internet üzerinden dosya gönderimi yapacak iseniz tcp/ip yani socket
programlamayı yapmanız uygundur.
dosya gönderimini udp ile yapabilirsiniz. ben bunu kendi bir örnek LAN projemde
kullandım. dosyayı byte-byte çok hızlı gönderiyor. buradan yola çıkarak web-cam
capture programı dahi yazmıştım. UDPnin hızı karşısında gerçekten şoka girmiştim
LAN üzerinde.
UDP nin güzel yanı, bağlantı şartının olmaması. istediğiniz bilgiyi gönderdiğinizde,
mesaj ya da paket farketmez, server üzerine rahatlıkla gönderilir.
Bu trafiği de yan mantıklarla yönlendirebilirsiniz.
Dosya aktarımını LAN üzerinde tcp/ip ile de yapabilirsiniz. Bunun avantajı ise
program içindeki kontrolleri daha bilinçli yaparsınız. seçim size kalıyor.
Gerekirse ana kontroller için tcp/ip, dosya gönderimleri için UDP kodlamasını
seçebilirsiniz.
cevap-2:
BDE ye gerek kalmadan ADO seçiminiz çok güzel !
bunu defalarca daha önceki yazılarımda da vurgulamaya çalışmıştım.
paradoxla vs uğraşmadan direkt olarak accessi kullanmanız size avantaj sağlar.
Ben bu politikayı uyguluyorum yazdığım programlarda. şu ana kadar beni yüzüstü
bırakmadı.
queryleri clientten mesaj olarak göndermeniz da harika bir yöntem.
Bu yöntemi de bir önceki projemde "remote db query" olarak kullanmıştım ve
sorgu sonuçlarını da dbgride tcp/ip üzerinden yansıttırıyordum. 15 kullanıcıya
kadar şu anda kullanılan kurumlar arası bir programım mevcuttur. herhangi bir
problemle karşılaşmadım. yönteminiz doğrudur.
overload işlemine gelince,
serverin overload işlemine maruz kalması şunlardan kaynaklanır,
aynı socket üzerinde hem mesaj hem dosya paketi işlemi yaptırmak isterseniz
overload işlemine maruz kalırsınız ki server hata üretir.
Bunu engellemenin en uygun yolu şöyledir ( ben şöyle kullandım )
- main haberleşme portu
- kullanıcılara belirli yetkiler ( sorgulama izni, upload - download izni vs )
- dosya iletişim portları ( en az 5 adet. 5 kullanıcı için varsayıyorum )
- query portu ( sorgu mesajları için )
bu mimariyi server üzerinde sağlıklı olarak kurarsanız ve yapılandırırsanız
şöyle bir mantığımız olacaktır:
- main haberleşme portu üzerinden kim ne işlem yapıyor yetkisi nedir, bağlantılar,
kopmalar vs bu port aracılığı ile hem tüm clientlere müdahale ettirebilirsiniz,
hem de client işlemlerinizi hiyararşik olarak kodlayabilirsiniz.
- kullanıcı yetkilendirmelerinizi yaparsanız, gereksiz queryleri engellemiş olursunuz,
gerekli flood ayarlarını da yaptırabilirsiniz, gereksiz hattı meşgul etmeleri de
engellemiş olursunuz.
- dosya iletişim portları sayesinde, hangi port müsaid ise ( 5 porttan )
server ilgili port numarasını cliente gönderir, client de ilgili port üzerinden
iş kuyruğuna göre dosyaları bu port üzerinden servere gönderir. tüm portlar
dolu ise ( 5 port birden ) , cliente "lütfen bekleyiniz" mesajı gönderip,
beklemesini söyleyebilirsiniz, veya bu clienti iş kuyruğuna atabilirsiniz.
servere düzenli bir iş kuyruğu mimarisini oturtmalısınız.
iyi hesaplayıp iyi düşünmeniz yararlı olacaktır.
- query portu da hangi clientten gelen sql cümleciklerini sorgulatır ve cliente
çıktı dosyasının yerini belirler. client de bu çıktı dosyasını kendi pc sine
indirir. bu da sağlıklı bir yöntem.
tüm bunları yaparsanız, N adet client, servere sırasıyla dosyaları gönderebilir,
query çekebilir, ve işlemler karışmadan işinizi yaptırabilirsiniz.
uğraşmakta olduğunuz bu konu gerçekten iyi bir çalışma sahası.
kodlamalarda takıldığınız yerler olursa yardımcı olurum,
çok ince noktalarla karşılaşacaksınız.....
kolay gelsin....
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "port kontrolü"
"
9 Aralık 2005 18:12
PORT KONTROLÜ
Selam arkadaşlar benim sorum port kontrolü ile xpde port kontrolü nasıl
yapılıyo win98 ile bi farkı varmı win98 de yazdığım program xpde
çalışırmı bide win98 apileri kulalnarak yazdığım bir görüntrülü
program xpde çalışırmı acaba?
herkese iyi akşamlar herkese teşekkürler
LeWo
"
cevap:
kod bankasında port viewer kodları mevcut, bunları inceleyebilirsiniz.
win98 apilerinin birçoğu xp de çalışmaz. Özellikle kerneli kullanan 98 apileri
xp de çalışmıyor. bu yüzden bir çok 98 programı çuvallamıştır.... ( ben de dahil )
xp çıktı mertlik bozuldu gibi bişey.. 98 de bir çok api vardı, ama birçoğu
xp de çalışmıyor. nedeni de apaçık ortada, xp yeni bir işletim sistemi,
ve kernel çekirdeği de buna bağlı olarak değiştirildi.
98 apilerini bence bırakmalısın, ne yapıyorsan, ne yazıyorsan,
hepsini xp ortamında yazmalısın...
kolay gelsin.........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "port kontrolü"
"
9 Aralık 2005 18:12
PORT KONTROLÜ
Selam arkadaşlar benim sorum port kontrolü ile xpde port kontrolü nasıl
yapılıyo win98 ile bi farkı varmı win98 de yazdığım program xpde
çalışırmı bide win98 apileri kulalnarak yazdığım bir görüntrülü
program xpde çalışırmı acaba?
herkese iyi akşamlar herkese teşekkürler
LeWo
"
cevap:
kod bankasında port viewer kodları mevcut, bunları inceleyebilirsiniz.
win98 apilerinin birçoğu xp de çalışmaz. Özellikle kerneli kullanan 98 apileri
xp de çalışmıyor. bu yüzden bir çok 98 programı çuvallamıştır.... ( ben de dahil )
xp çıktı mertlik bozuldu gibi bişey.. 98 de bir çok api vardı, ama birçoğu
xp de çalışmıyor. nedeni de apaçık ortada, xp yeni bir işletim sistemi,
ve kernel çekirdeği de buna bağlı olarak değiştirildi.
98 apilerini bence bırakmalısın, ne yapıyorsan, ne yazıyorsan,
hepsini xp ortamında yazmalısın...
kolay gelsin.........
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "listbox içindeki elemanları sıralamak"
"
9 Aralık 2005 15:01
Lidstbox'tekiler Harf sırasına göre
Selam arkadaşlar listbox'taki elemanları harf ve sayı sırasına göre
nasıl yaparım.Yardımcı olursanız çok sevinirim.
delphiibo
"
cevap:
merhaba delphiibo,
listbox içindeki elemanları sıralatman için,
listbox1.Sorted:=true;
not: bu sıralatma gerçek bir sıralatma değildir. harf sırasına göre sıralar.
sayıları gerçek olarak sıralamaz, alfabetik kurala göre sıralar.
gerçek sıralama yaptırabilmen için,
listbox1 içindeki elemanları bir diziye aktarıp, sıralatma algoritmasını kullanıp
(hangisini istersen) tekrar sıralanmış verilerden listbox1 içine yerleştirmen
aradığın tam çözüm olacaktır.
aşağıda veri sıralama yöntemleri ( bubblesort-quicksort-shellsort-selectionsort)
kodlarını gönderiyorum, biraz incele, kendine göre uyarlamaya çalış....
*********************************************************
***** delphinin kendi sıralama örnekleri ****************
***** kaynak: ****************
***** C:Program FilesBorlandDelphi6DemosThreads ****
*********************************************************
unit SortThds;
interface
uses
Classes, Graphics, ExtCtrls;
type
{ TSortThread }
PSortArray = ^TSortArray;
TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TSortThread = class(TThread)
private
FBox: TPaintBox;
FSortArray: PSortArray;
FSize: Integer;
FA, FB, FI, FJ: Integer;
procedure DoVisualSwap;
protected
procedure Execute; override;
procedure VisualSwap(A, B, I, J: Integer);
procedure Sort(var A: array of Integer); virtual; abstract;
public
constructor Create(Box: TPaintBox; var SortArray: array of Integer);
end;
{ TBubbleSort }
TBubbleSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TSelectionSort }
TSelectionSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TQuickSort }
TQuickSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
implementation
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;
{ TSortThread }
constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
begin
FBox := Box;
FSortArray := @SortArray;
FSize := High(SortArray) - Low(SortArray) + 1;
FreeOnTerminate := True;
inherited Create(False);
end;
{ Since DoVisualSwap uses a VCL component (i.e., the TPaintBox) it should never
be called directly by this thread. DoVisualSwap should be called by passing
it to the Synchronize method which causes DoVisualSwap to be executed by the
main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an
example of calling Synchronize. }
procedure TSortThread.DoVisualSwap;
begin
with FBox do
begin
Canvas.Pen.Color := clBtnFace;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color := clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
{ VisusalSwap is a wrapper on DoVisualSwap making it easier to use. The
parameters are copied to instance variables so they are accessable
by the main VCL thread when it executes DoVisualSwap }
procedure TSortThread.VisualSwap(A, B, I, J: Integer);
begin
FA := A;
FB := B;
FI := I;
FJ := J;
Synchronize(DoVisualSwap);
end;
{ The Execute method is called when the thread starts }
procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize));
end;
{ TBubbleSort }
***********************************************
********* BUBBLE SORT ÖRNEĞİ ******************
***********************************************
procedure TBubbleSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then
begin
VisualSwap(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
if Terminated then Exit;
end;
end;
{ TSelectionSort }
***********************************************
********* SELECTION SORT ÖRNEĞİ ***************
***********************************************
procedure TSelectionSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := Low(A) to High(A) - 1 do
for J := High(A) downto I + 1 do
if A[I] > A[J] then
begin
VisualSwap(A[I], A[J], I, J);
T := A[I];
A[I] := A[J];
A[J] := T;
if Terminated then Exit;
end;
end;
{ TQuickSort }
***********************************************
********* QUICK SORT ÖRNEĞİ ******************
***********************************************
procedure TQuickSort.Sort(var A: array of Integer);
procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do Inc(Lo);
while A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
VisualSwap(A[Lo], A[Hi], Lo, Hi);
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
if Terminated then Exit;
end;
begin
QuickSort(A, Low(A), High(A));
end;
end.
***********************************************
******* bubblesort örnek **********************
***********************************************
////////////////////////////////////////////////////////////////////////////////
///////////////////(* Bubble Sorting Arrays - By Jason M. *)////////////////////
////////////////////////////////////////////////////////////////////////////////
(* This example was written at as a console app in delphi 6 if you want to use
it in Turbo Pascal All you have to do is delete {$APPTYPE CONSOLE}
and underneath Uses change SysUtils to Crt *)
program Bubble;
{$APPTYPE CONSOLE}
uses
SysUtils;
Var
Ary : array[1..10] of byte;
InnerLoop : integer;
Outerloop : integer;
temp : integer; {The reason I use this temp is so I can swap the value in the
array over. If I had the following:
x := y;
y := x; y will just wont get y because you assigned y to x
and variables can only hold one Value 
So by using the Temp variable I can swap them over
temp := x;
x := y;
y := temp;}
begin
randomize;
for innerloop := 1 to 10 do
begin
ary[innerloop] := Random(100);
writeln(ary[innerloop]);
end; {assign some numbers to the array}
{start sorting the array}
for outerloop := 1 to 10 do
begin
for innerloop := outerloop to 10 do
begin
if ary[outerloop] > ary[innerloop] {To displa in decending order change
> to <}
then begin
temp := ary[outerloop]; {enables me to swap the values over}
ary[outerloop] := ary[innerloop]; {make the lowest value higher up in the
the array}
ary[innerloop] := temp;
end;{end IF}
end; {end inner loop}
end;{end outer loop}
writeln;
writeln('press ENTER to view data in asscending order');
readln;
for innerloop := 1 to 10 do
begin
writeln(ary[innerloop]);
end;
readln;
end.
***************************************************************
********** quicksort componenti ve uygulama örneği ************
***************************************************************
unit Qsort;
{TQSort by Mike Junkin 10/19/95.
DoQSort routine adapted from Peter Szymiczek's QSort procedure which
was presented in issue#8 of The Unofficial Delphi Newsletter.}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
TSwapEvent = procedure (Sender : TObject; e1,e2 : word) of Object;
TCompareEvent = procedure (Sender: TObject; e1,e2 : word; var Action : integer) of Object;
TQSort = class(TComponent)
private
FCompare : TCompareEvent;
FSwap : TSwapEvent;
public
procedure DoQSort(Sender: TObject; uNElem: word);
published
property Compare : TCompareEvent read FCompare write FCompare;
property Swap : TSwapEvent read FSwap write FSwap;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Mikes', [TQSort]);
end;
procedure TQSort.DoQSort(Sender: TObject; uNElem: word);
{ uNElem - number of elements to sort }
procedure qSortHelp(pivotP: word; nElem: word);
label
TailRecursion,
qBreak;
var
leftP, rightP, pivotEnd, pivotTemp, leftTemp: word;
lNum: word;
retval: integer;
begin
retval := 0;
TailRecursion:
if (nElem <= 2) then
begin
if (nElem = 2) then
begin
rightP := pivotP +1;
FCompare(Sender,pivotP,rightP,retval);
if (retval > 0) then Fswap(Sender,pivotP,rightP);
end;
exit;
end;
rightP := (nElem -1) + pivotP;
leftP := (nElem shr 1) + pivotP;
{ sort pivot, left, and right elements for "median of 3" }
FCompare(Sender,leftP,rightP,retval);
if (retval > 0) then Fswap(Sender,leftP, rightP);
FCompare(Sender,leftP,pivotP,retval);
if (retval > 0) then Fswap(Sender,leftP, pivotP)
else
begin
FCompare(Sender,pivotP,rightP,retval);
if retval > 0 then Fswap(Sender,pivotP, rightP);
end;
if (nElem = 3) then
begin
Fswap(Sender,pivotP, leftP);
exit;
end;
{ now for the classic Horae algorithm }
pivotEnd := pivotP + 1;
leftP := pivotEnd;
repeat
FCompare(Sender,leftP, pivotP,retval);
while (retval <= 0) do
begin
if (retval = 0) then
begin
Fswap(Sender,leftP, pivotEnd);
Inc(pivotEnd);
end;
if (leftP < rightP) then
Inc(leftP)
else
goto qBreak;
FCompare(Sender,leftP, pivotP,retval);
end; {while}
while (leftP < rightP) do
begin
FCompare(Sender,pivotP, rightP,retval);
if (retval < 0) then
Dec(rightP)
else
begin
FSwap(Sender,leftP, rightP);
if (retval <> 0) then
begin
Inc(leftP);
Dec(rightP);
end;
break;
end;
end; {while}
until (leftP >= rightP);
qBreak:
FCompare(Sender,leftP,pivotP,retval);
if (retval <= 0) then Inc(leftP);
leftTemp := leftP -1;
pivotTemp := pivotP;
while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
begin
Fswap(Sender,pivotTemp, leftTemp);
Inc(pivotTemp);
Dec(leftTemp);
end; {while}
lNum := (leftP - pivotEnd);
nElem := ((nElem + pivotP) -leftP);
if (nElem < lNum) then
begin
qSortHelp(leftP, nElem);
nElem := lNum;
end
else
begin
qSortHelp(pivotP, lNum);
pivotP := leftP;
end;
goto TailRecursion;
end; {qSortHelp }
begin
if Assigned(FCompare) and Assigned(FSwap) then
begin
if (uNElem < 2) then exit; { nothing to sort }
qSortHelp(1, uNElem);
end;
end; { QSort }
end.
{ demo }
***********************************************************
********* QUCIKSORT KULLANARAK STRINGGRIDI SIRALAR ********
***********************************************************
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, Qsort, StdCtrls;
type
TForm1 = class(TForm)
QSort1: TQSort;
StringGrid1: TStringGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure QSort1Compare(Sender: TObject; e1, e2: Word; var Action: Integer);
procedure QSort1Swap(Sender: TObject; e1, e2: Word);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
with StringGrid1 do
begin
Cells[1,1] := 'the';
Cells[1,2] := 'brown';
Cells[1,3] := 'dog';
Cells[1,4] := 'bit';
Cells[1,5] := 'me';
end;
end;
procedure TForm1.QSort1Compare(Sender: TObject; e1, e2: Word;
var Action: Integer);
begin
with Sender as TStringGrid do
begin
if (Cells[1, e1] < Cells[1, e2]) then
Action := -1
else if (Cells[1, e1] > Cells[1, e2]) then
Action := 1
else
Action := 0;
end; {with}
end;
procedure TForm1.QSort1Swap(Sender: TObject; e1, e2: Word);
var
s: string[63]; { must be large enough to contain the longest string in the grid }
i: integer;
begin
with Sender as TStringGrid do
for i := 0 to ColCount -1 do
begin
s := Cells[i, e1];
Cells[i, e1] := Cells[i, e2];
Cells[i, e2] := s;
end; {for}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
QSort1.DoQSort(StringGrid1,STringGrid1.RowCount-1);
end;
end.
*****************************************
******* SHELL SORT ÖRNEK ****************
******************************************
Procedure Sort_Shell(var a: array of Word);
var
bis, i, j, k: LongInt;
h: Word;
begin
bis := High(a);
k := bis shr 1;// div 2
while k > 0 do
begin
for i := 0 to bis - k do
begin
j := i;
while (j >= 0) and (a[j] > a[j + k]) do
begin
h := a[j];
a[j] := a[j + k];
a[j + k] := h;
if j > k then
Dec(j, k)
else
j := 0;
end; // {end while]
end; // { end for}
k := k shr 1; // div 2
end; // {end while}
end;
saygılarımla_
neoturk_
Delphi - .....................................
Neoturk: Forum - "listbox içindeki elemanları sıralamak"
"
9 Aralık 2005 15:01
Lidstbox'tekiler Harf sırasına göre
Selam arkadaşlar listbox'taki elemanları harf ve sayı sırasına göre
nasıl yaparım.Yardımcı olursanız çok sevinirim.
delphiibo
"
cevap:
merhaba delphiibo,
listbox içindeki elemanları sıralatman için,
listbox1.Sorted:=true;
not: bu sıralatma gerçek bir sıralatma değildir. harf sırasına göre sıralar.
sayıları gerçek olarak sıralamaz, alfabetik kurala göre sıralar.
gerçek sıralama yaptırabilmen için,
listbox1 içindeki elemanları bir diziye aktarıp, sıralatma algoritmasını kullanıp
(hangisini istersen) tekrar sıralanmış verilerden listbox1 içine yerleştirmen
aradığın tam çözüm olacaktır.
aşağıda veri sıralama yöntemleri ( bubblesort-quicksort-shellsort-selectionsort)
kodlarını gönderiyorum, biraz incele, kendine göre uyarlamaya çalış....
*********************************************************
***** delphinin kendi sıralama örnekleri ****************
***** kaynak: ****************
***** C:Program FilesBorlandDelphi6DemosThreads ****
*********************************************************
unit SortThds;
interface
uses
Classes, Graphics, ExtCtrls;
type
{ TSortThread }
PSortArray = ^TSortArray;
TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TSortThread = class(TThread)
private
FBox: TPaintBox;
FSortArray: PSortArray;
FSize: Integer;
FA, FB, FI, FJ: Integer;
procedure DoVisualSwap;
protected
procedure Execute; override;
procedure VisualSwap(A, B, I, J: Integer);
procedure Sort(var A: array of Integer); virtual; abstract;
public
constructor Create(Box: TPaintBox; var SortArray: array of Integer);
end;
{ TBubbleSort }
TBubbleSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TSelectionSort }
TSelectionSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
{ TQuickSort }
TQuickSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer); override;
end;
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
implementation
procedure PaintLine(Canvas: TCanvas; I, Len: Integer);
begin
Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;
{ TSortThread }
constructor TSortThread.Create(Box: TPaintBox; var SortArray: array of Integer);
begin
FBox := Box;
FSortArray := @SortArray;
FSize := High(SortArray) - Low(SortArray) + 1;
FreeOnTerminate := True;
inherited Create(False);
end;
{ Since DoVisualSwap uses a VCL component (i.e., the TPaintBox) it should never
be called directly by this thread. DoVisualSwap should be called by passing
it to the Synchronize method which causes DoVisualSwap to be executed by the
main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an
example of calling Synchronize. }
procedure TSortThread.DoVisualSwap;
begin
with FBox do
begin
Canvas.Pen.Color := clBtnFace;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color := clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;
{ VisusalSwap is a wrapper on DoVisualSwap making it easier to use. The
parameters are copied to instance variables so they are accessable
by the main VCL thread when it executes DoVisualSwap }
procedure TSortThread.VisualSwap(A, B, I, J: Integer);
begin
FA := A;
FB := B;
FI := I;
FJ := J;
Synchronize(DoVisualSwap);
end;
{ The Execute method is called when the thread starts }
procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize));
end;
{ TBubbleSort }
***********************************************
********* BUBBLE SORT ÖRNEĞİ ******************
***********************************************
procedure TBubbleSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := High(A) downto Low(A) do
for J := Low(A) to High(A) - 1 do
if A[J] > A[J + 1] then
begin
VisualSwap(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
if Terminated then Exit;
end;
end;
{ TSelectionSort }
***********************************************
********* SELECTION SORT ÖRNEĞİ ***************
***********************************************
procedure TSelectionSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := Low(A) to High(A) - 1 do
for J := High(A) downto I + 1 do
if A[I] > A[J] then
begin
VisualSwap(A[I], A[J], I, J);
T := A[I];
A[I] := A[J];
A[J] := T;
if Terminated then Exit;
end;
end;
{ TQuickSort }
***********************************************
********* QUICK SORT ÖRNEĞİ ******************
***********************************************
procedure TQuickSort.Sort(var A: array of Integer);
procedure QuickSort(var A: array of Integer; iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do Inc(Lo);
while A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
VisualSwap(A[Lo], A[Hi], Lo, Hi);
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi);
if Lo < iHi then QuickSort(A, Lo, iHi);
if Terminated then Exit;
end;
begin
QuickSort(A, Low(A), High(A));
end;
end.
***********************************************
******* bubblesort örnek **********************
***********************************************
////////////////////////////////////////////////////////////////////////////////
///////////////////(* Bubble Sorting Arrays - By Jason M. *)////////////////////
////////////////////////////////////////////////////////////////////////////////
(* This example was written at as a console app in delphi 6 if you want to use
it in Turbo Pascal All you have to do is delete {$APPTYPE CONSOLE}
and underneath Uses change SysUtils to Crt *)
program Bubble;
{$APPTYPE CONSOLE}
uses
SysUtils;
Var
Ary : array[1..10] of byte;
InnerLoop : integer;
Outerloop : integer;
temp : integer; {The reason I use this temp is so I can swap the value in the
array over. If I had the following:
x := y;
y := x; y will just wont get y because you assigned y to x
and variables can only hold one Value
So by using the Temp variable I can swap them over
temp := x;
x := y;
y := temp;}
begin
randomize;
for innerloop := 1 to 10 do
begin
ary[innerloop] := Random(100);
writeln(ary[innerloop]);
end; {assign some numbers to the array}
{start sorting the array}
for outerloop := 1 to 10 do
begin
for innerloop := outerloop to 10 do
begin
if ary[outerloop] > ary[innerloop] {To displa in decending order change
> to <}
then begin
temp := ary[outerloop]; {enables me to swap the values over}
ary[outerloop] := ary[innerloop]; {make the lowest value higher up in the
the array}
ary[innerloop] := temp;
end;{end IF}
end; {end inner loop}
end;{end outer loop}
writeln;
writeln('press ENTER to view data in asscending order');
readln;
for innerloop := 1 to 10 do
begin
writeln(ary[innerloop]);
end;
readln;
end.
***************************************************************
********** quicksort componenti ve uygulama örneği ************
***************************************************************
unit Qsort;
{TQSort by Mike Junkin 10/19/95.
DoQSort routine adapted from Peter Szymiczek's QSort procedure which
was presented in issue#8 of The Unofficial Delphi Newsletter.}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;
type
TSwapEvent = procedure (Sender : TObject; e1,e2 : word) of Object;
TCompareEvent = procedure (Sender: TObject; e1,e2 : word; var Action : integer) of Object;
TQSort = class(TComponent)
private
FCompare : TCompareEvent;
FSwap : TSwapEvent;
public
procedure DoQSort(Sender: TObject; uNElem: word);
published
property Compare : TCompareEvent read FCompare write FCompare;
property Swap : TSwapEvent read FSwap write FSwap;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Mikes', [TQSort]);
end;
procedure TQSort.DoQSort(Sender: TObject; uNElem: word);
{ uNElem - number of elements to sort }
procedure qSortHelp(pivotP: word; nElem: word);
label
TailRecursion,
qBreak;
var
leftP, rightP, pivotEnd, pivotTemp, leftTemp: word;
lNum: word;
retval: integer;
begin
retval := 0;
TailRecursion:
if (nElem <= 2) then
begin
if (nElem = 2) then
begin
rightP := pivotP +1;
FCompare(Sender,pivotP,rightP,retval);
if (retval > 0) then Fswap(Sender,pivotP,rightP);
end;
exit;
end;
rightP := (nElem -1) + pivotP;
leftP := (nElem shr 1) + pivotP;
{ sort pivot, left, and right elements for "median of 3" }
FCompare(Sender,leftP,rightP,retval);
if (retval > 0) then Fswap(Sender,leftP, rightP);
FCompare(Sender,leftP,pivotP,retval);
if (retval > 0) then Fswap(Sender,leftP, pivotP)
else
begin
FCompare(Sender,pivotP,rightP,retval);
if retval > 0 then Fswap(Sender,pivotP, rightP);
end;
if (nElem = 3) then
begin
Fswap(Sender,pivotP, leftP);
exit;
end;
{ now for the classic Horae algorithm }
pivotEnd := pivotP + 1;
leftP := pivotEnd;
repeat
FCompare(Sender,leftP, pivotP,retval);
while (retval <= 0) do
begin
if (retval = 0) then
begin
Fswap(Sender,leftP, pivotEnd);
Inc(pivotEnd);
end;
if (leftP < rightP) then
Inc(leftP)
else
goto qBreak;
FCompare(Sender,leftP, pivotP,retval);
end; {while}
while (leftP < rightP) do
begin
FCompare(Sender,pivotP, rightP,retval);
if (retval < 0) then
Dec(rightP)
else
begin
FSwap(Sender,leftP, rightP);
if (retval <> 0) then
begin
Inc(leftP);
Dec(rightP);
end;
break;
end;
end; {while}
until (leftP >= rightP);
qBreak:
FCompare(Sender,leftP,pivotP,retval);
if (retval <= 0) then Inc(leftP);
leftTemp := leftP -1;
pivotTemp := pivotP;
while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
begin
Fswap(Sender,pivotTemp, leftTemp);
Inc(pivotTemp);
Dec(leftTemp);
end; {while}
lNum := (leftP - pivotEnd);
nElem := ((nElem + pivotP) -leftP);
if (nElem < lNum) then
begin
qSortHelp(leftP, nElem);
nElem := lNum;
end
else
begin
qSortHelp(pivotP, lNum);
pivotP := leftP;
end;
goto TailRecursion;
end; {qSortHelp }
begin
if Assigned(FCompare) and Assigned(FSwap) then
begin
if (uNElem < 2) then exit; { nothing to sort }
qSortHelp(1, uNElem);
end;
end; { QSort }
end.
{ demo }
***********************************************************
********* QUCIKSORT KULLANARAK STRINGGRIDI SIRALAR ********
***********************************************************
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, Qsort, StdCtrls;
type
TForm1 = class(TForm)
QSort1: TQSort;
StringGrid1: TStringGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure QSort1Compare(Sender: TObject; e1, e2: Word; var Action: Integer);
procedure QSort1Swap(Sender: TObject; e1, e2: Word);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
with StringGrid1 do
begin
Cells[1,1] := 'the';
Cells[1,2] := 'brown';
Cells[1,3] := 'dog';
Cells[1,4] := 'bit';
Cells[1,5] := 'me';
end;
end;
procedure TForm1.QSort1Compare(Sender: TObject; e1, e2: Word;
var Action: Integer);
begin
with Sender as TStringGrid do
begin
if (Cells[1, e1] < Cells[1, e2]) then
Action := -1
else if (Cells[1, e1] > Cells[1, e2]) then
Action := 1
else
Action := 0;
end; {with}
end;
procedure TForm1.QSort1Swap(Sender: TObject; e1, e2: Word);
var
s: string[63]; { must be large enough to contain the longest string in the grid }
i: integer;
begin
with Sender as TStringGrid do
for i := 0 to ColCount -1 do
begin
s := Cells[i, e1];
Cells[i, e1] := Cells[i, e2];
Cells[i, e2] := s;
end; {for}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
QSort1.DoQSort(StringGrid1,STringGrid1.RowCount-1);
end;
end.
*****************************************
******* SHELL SORT ÖRNEK ****************
******************************************
Procedure Sort_Shell(var a: array of Word);
var
bis, i, j, k: LongInt;
h: Word;
begin
bis := High(a);
k := bis shr 1;// div 2
while k > 0 do
begin
for i := 0 to bis - k do
begin
j := i;
while (j >= 0) and (a[j] > a[j + k]) do
begin
h := a[j];
a[j] := a[j + k];
a[j + k] := h;
if j > k then
Dec(j, k)
else
j := 0;
end; // {end while]
end; // { end for}
k := k shr 1; // div 2
end; // {end while}
end;
saygılarımla_
neoturk_
Delphi - .....................................
