Programlama yapalım ve Öğrenelim.

Çok Satırlı Showmessage Kullanımı

Eğer mesajlarınızda birden fazla satır kullanmak isterseniz aşağıdaki

kodu kullanabilirsiniz...

showmessage('Bu bir '+#10#13+

'çok satırlı'+#10#13+

'Showmessage'+#10#13+

'örneğidir');

KodBankta arattım ama bunu bulamadım... Sadece başka kodların içinde vardı

bende belki özellikle bunu isteyen olursa diye ekledim...

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

Toolbar a imeci yerleştirme tamamen türkçe

//yapmanız gereken tek şey bu arkadaşlar.....

procedure TForm1.ToolBar1CustomDraw(Sender: TToolBar; const ARect: TRect;

var DefaultDraw: Boolean);

var img:timage;

begin

img:=TImage.Create(nil);

img.Picture.LoadFromFile('C:Aezeminlerbase 01.bmp');//bmp olmak zorunda

Sender.Canvas.StretchDraw(ARect,img.Picture.Bitmap);

end;

// img yerine forma koymuş olduğunuz bir Timage nesneside aynı görevi yapacaktır

//Emin olun çok düzgün calışıyo

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

Toolbar a imeyc yerleştirme tamamen türkçe

//yapmanız gereken tek şey bu arkadaşlar.....

procedure TForm1.ToolBar1CustomDraw(Sender: TToolBar; const ARect: TRect;

var DefaultDraw: Boolean);

var img:timage;

begin

img:=TImage.Create(nil);

img.Picture.LoadFromFile('C:Aezeminlerbase 01.bmp');//bmp olmak zorunda

Sender.Canvas.StretchDraw(ARect,img.Picture.Bitmap);

end;

// img yerine forma koymuş olduğunuz bir Timage nesneside aynı görevi yapacaktır

//Emin olun çok düzgün calışıyo

///////////////////////// A E K O D T E K N O L O J İ S İ//////////////////////////

//// E M R E B Ü Y Ü K A S L A N ////

//// K O N Y A ////

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

delphide program yazma hatası

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, DB, DBTables;

type

TForm1 = class(TForm)

Table1: TTable;

Table1STOKKODU: TStringField;

Table1STOKADI: TStringField;

Table1BIRIMI: TStringField;

Table1ADEDI: TFloatField;

Table1ALISFIYATI: TFloatField;

Table1SATISFIYAT: TFloatField;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Button1: TButton;

Button2: TButton;

Edit6: TEdit;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Label1: TLabel;

Label2: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label3: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

//İLK KAYIT

procedure TForm1.Button1Click(Sender: TObject);

begin

table1.Next;

edit1.Text:=table1STOKKODU.Text;

edit1.Text:=table1STOKADI.Text;

edit1.Text:=table1BIRIMI.Text;

edit1.Text:=table1ADEDI.Text;

edit1.Text:=table1ALISFIYATI.Text;

edit1.Text:=table1SATISFIYAT.Text;

end;

// SONRAKİ KAYIT

procedure TForm1.Button2Click(Sender: TObject);

begin

table1.Prior;

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

//YENİ KAYIT

procedure TForm1.Button3Click(Sender: TObject);

begin

table1.Append;

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

edit5.Text:='';

edit6.Text:='';

edit1.SetFocus;

end;

//KAYDET

procedure TForm1.Button4Click(Sender: TObject);

begin

table1.UpdateRecord;

table1STOKKODU.Text:=edit1.Text;

table1STOKADI.Text:=edit2.Text;

table1BIRIMI.Text:=edit3.Text;

table1ADEDI.Text:=edit4.Text;

table1ALISFIYATI.Text:=edit5.Text;

table1SATISFIYAT.Text:=edit6.Text;

end;

//SİL

procedure TForm1.Button5Click(Sender: TObject);

BEGIN

tus:=application.MessageBox('kayıt silinsinmi','uyarı',mb_yesno);

if tus=idyes then

begin

table1.Delete;

table1.Prior;

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

end.

BU PROGRAMI ÇALIŞTIRDIĞIMDA İLK ÖNCE SİL BUTONU KISMINDA HATA VERİYOR İMLEC "TUS" KELİMESİNDEN SONRAYA KONUMLANIYOR. BUALANI SİLİP PROGRAMI ÇALIŞTIRIP EDİTLERE DEĞERLER GİRDİĞİMDE HERHANGİ BUTONA BASTIĞIMDA "DEBUGBER EXCEPTION NOTIFICATION" ADINDA Bİ UYARI PENCERESİ GELİYO VE İÇİNDE "PROJECT PROJECT1.EXE RAISED EXCEPTION CLASS EDATABASEERROR WITH MESSAGE 'TABLO1: CANNOT PERFORM THİS OPERATION ON A CLOSED DATASET'. PROCES STOPPED.USE STEP OR RUN TO CONTİNUE." SORUNUN NE OLDUĞUNU BULAMADIM İNLEYEYİP BULAN OLURSA NEDENİNİ YAZARSA SEVİNİRİM.İYİ BAYRAMLAR

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

delphide program yazma hatası

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, DB, DBTables;

type

TForm1 = class(TForm)

Table1: TTable;

Table1STOKKODU: TStringField;

Table1STOKADI: TStringField;

Table1BIRIMI: TStringField;

Table1ADEDI: TFloatField;

Table1ALISFIYATI: TFloatField;

Table1SATISFIYAT: TFloatField;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Button1: TButton;

Button2: TButton;

Edit6: TEdit;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Label1: TLabel;

Label2: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label3: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

//İLK KAYIT

procedure TForm1.Button1Click(Sender: TObject);

begin

table1.Next;

edit1.Text:=table1STOKKODU.Text;

edit1.Text:=table1STOKADI.Text;

edit1.Text:=table1BIRIMI.Text;

edit1.Text:=table1ADEDI.Text;

edit1.Text:=table1ALISFIYATI.Text;

edit1.Text:=table1SATISFIYAT.Text;

end;

// SONRAKİ KAYIT

procedure TForm1.Button2Click(Sender: TObject);

begin

table1.Prior;

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

//YENİ KAYIT

procedure TForm1.Button3Click(Sender: TObject);

begin

table1.Append;

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

edit5.Text:='';

edit6.Text:='';

edit1.SetFocus;

end;

//KAYDET

procedure TForm1.Button4Click(Sender: TObject);

begin

table1.UpdateRecord;

table1STOKKODU.Text:=edit1.Text;

table1STOKADI.Text:=edit2.Text;

table1BIRIMI.Text:=edit3.Text;

table1ADEDI.Text:=edit4.Text;

table1ALISFIYATI.Text:=edit5.Text;

table1SATISFIYAT.Text:=edit6.Text;

end;

//SİL

procedure TForm1.Button5Click(Sender: TObject);

BEGIN

tus:=application.MessageBox('kayıt silinsinmi','uyarı',mb_yesno);

if tus=idyes then

begin

table1.Delete;

table1.Prior;

edit1.Text:=table1STOKKODU.Text;

edit2.Text:=table1STOKADI.Text;

edit3.Text:=table1BIRIMI.Text;

edit4.Text:=table1ADEDI.Text;

edit5.Text:=table1ALISFIYATI.Text;

edit6.Text:=table1SATISFIYAT.Text;

end;

end.

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

Form açılışına şifre koymak

// Formun oncreate olayına...

procedure TForm1.FormCreate(Sender: TObject);

var

x,b:string;

begin

b:='Buraya şifre giriniz';

x:=inputbox('Programa Giriş','Programa girmek için şifreyi Giriniz:','');

if x=b then

application.messagebox('Programa Girişiniz Onaylandı.Tebrikler ..!','Tebrikler',mb_ok+mb_defbutton1)

else

halt;

end;

end.

Tarafımdan DENENMEMİŞTİR...

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

Form açılışına şifre koymak

// Formun oncreate olayına...

procedure TForm1.FormCreate(Sender: TObject);

var

x,b:string;

begin

b:='Buraya şifre giriniz';

x:=inputbox('Programa Giriş','Programa girmek için şifreyi Giriniz:','');

if x=b then

application.messagebox('Programa Girişiniz Onaylandı.Tebrikler ..!','Tebrikler',mb_ok+mb_defbutton1)

else

halt;

end;

end.

Tarafımdan DENENMEMİŞTİR...

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

blood - Bulmaca Yapici

{

http://www.delphiforfun.org/Programs/CrosswordGen0.htm

Bu kodlar, istenilen boyutta sözlüklere dayanarak bulmaca yapar.

Yukaridaki adreste daha fazla bilgi bulunabilir.

}

unit U_Crosswords;

This program may be used or modified for any non-commercial purpose

so long as this original notice remains in place.

All other rights are reserved

}

{Prototype of logic for a crossword puzzle generator}

interface

uses

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

Grids, StdCtrls, Spin, ComCtrls;

type

TDir=(H,V); {direction type H=horizontal, V= vertical}

TUsed=class(Tobject) {object attached to usedwords showing origin and direction}

start:TPoint;

direction:TDir;

end;

TForm1 = class(TForm)

BoardGrid: TStringGrid;

MinWordSize: TSpinEdit;

MaxWordSize: TSpinEdit;

Label1: TLabel;

Label3: TLabel;

Label4: TLabel;

GenerateBtn: TButton;

Maxwords: TSpinEdit;

Label2: TLabel;

Label5: TLabel;

Label6: TLabel;

Hsizeedt: TSpinEdit;

VSizeedt: TSpinEdit;

Label7: TLabel;

StatusBar1: TStatusBar;

CountLbl: TLabel;

Memo1: TMemo;

procedure FormActivate(Sender: TObject);

procedure GenerateBtnClick(Sender: TObject);

procedure SizeedtChange(Sender: TObject);

public

{ Public declarations }

board:array of array of char;

hsize,vsize:integer; {horizontal and vertical board sizes}

words, usedwords:Tstringlist;

wordcount:integer; {count of words placed in the puzzle}

procedure loadlist(list:TStringList);

procedure setboardsize;

function getnextword(dir:TDir):boolean;

procedure showboard;

procedure addword(dir:TDir; w:string; p:TPoint);

function findaword(maxsize:integer; ch:char; loc:integer; findmax:boolean):string;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{**************** AdjustGridSize ***********}

procedure adjustGridSize(grid:TStringGrid);

{Adjust borders of grid to just fit cells}

begin

with grid do

begin

height:=(defaultrowheight+GridLineWidth)*rowcount+gridlinewidth+2 {+2 for border};

width:=colcount*(defaultcolwidth+gridlinewidth)+gridlinewidth+2 {+2 for border};

end;

{***************** AddWord *************}

procedure TForm1.addword(dir:TDir; w:string; p:TPoint);

{Insert the passed word, "w", into the board in direction "dir" starting at point "p"}

var i:integer;

t:Tused;

begin

case dir of

H: for i:= 1 to length(w) do board[p.x-1+i,p.y]:=w[i];

V: for i:= 1 to length(w) do board[p.x,p.y-1+i]:=w[i];

end;

t:=TUsed.create;

t.direction:=dir;

t.start:=p;

usedwords.addobject(w,t);

inc(wordcount);

countlbl.caption:=inttostr(wordcount);

application.processmessages;

showboard;

end;

{****************** LoadList *************}

procedure TForm1.Loadlist(list:TStringList);

{Load a list of candidate words and randomly shuffle them}

{**local procedure Swap **}

procedure swap(var s1,s2:string);

var t:string;

begin t:=s1; s2:=s2; s2:=t; end;

var i,j:integer;

s1,s2:string;

begin

list.loadfromfile(extractfilepath(application.exename)+'Small.txt');

with list do

begin

{scramble the list and make sure it is uppercase}

for i:= count-1 downto 0 do

begin

if length(strings[i])<=2 then delete(i)

else

begin

s1:=uppercase(strings[i]);

strings[i]:=s1;

end;

for i:= count-1 downto 2 do

begin

s1:=strings[i];

j:=random(i);

s2:=strings[j];

swap(s1,s2);

strings[i]:=s1;

strings[j]:=s2;

end;

{************* FormActivate **********}

procedure TForm1.FormActivate(Sender: TObject);

{Initialization}

begin

Words:=TStringlist.create;

usedwords:=Tstringlist.create;

SizeedtChange(sender);

randomize;

end;

{************** SetBoardSize ***********}

procedure TForm1.setboardsize;

var i,j:integer;

begin

hsize:=hsizeedt.value; vsize:=vsizeedt.value;

setlength(board,Hsize+2,Vsize+2);

{clear board and place a semaphore border around the board to simplify border testing}

for i:=0 to Hsize+1 do

for j:=0 to Vsize+1 do

If (i=0) or (i=hsize+1) or (j=0) or (j=vsize+1) then board[i,j]:=' '

else board[i,j]:=' ';

wordcount:=0;

end;

{************* ShowBoard *******}

procedure TForm1.showboard;

var i,j:integer;

begin

for i:=0 to high(board)-2 do

for j:= 0 to high(board[i])-2 do BoardGrid.cells[i,j]:=board[i+1,j+1];

Boardgrid.update;

sleep(500);

end;

{*********************** FindAWord **************}

function TForm1.findaword(maxsize:integer; ch:char; loc:integer; findmax:boolean):string;

{search the words list for the largest word <= "maxsize" with character "ch"

in postion "loc"}

var

i,j:integer;

s, bestS:string;

slen:integer;

begin

result:='';

slen:=0;

for i:= 0 to words.count-1 do

begin

s:=words[i];

if (length(s)>slen) and (length(s)<=maxsize) and (length(s)<=maxwordsize.Value)

and (length(s)>=minwordsize.value)

then

begin

if (loc=0) then

begin

{make sure it hasn't already been used}

j:= usedwords.indexof(s);

if j=-1 then

begin

bests:=s;

slen:=length(s);

end;

end

else if (loc>0) then

begin

j:=pos(ch,s);

if j=loc then

begin

j:= usedwords.indexof(s);

if j=-1 then

begin

bests:=s;

slen:=length(s);

end;

if ((not findmax) and (slen>0))

or (findmax and (slen=maxsize)) then break; {find 1st or longest based on findmax}

end;

if slen>0 then result:=bests else result:='';

end;

{*********** GetNextWord *********}

function TForm1.getnextword(dir:TDir):boolean;

{Recursive routine to generte the next word in the next directions}

var

s:string;

n:integer;

i,j,k:integer;

u,b:integer; {upper and bottom, or left and right limits of word space found}

p:TPoint;

Testdir:Tdir;

begin

result:=false;

testdir:=dir;

if wordcount>=maxwords.Value then exit;

if wordcount=0 then

begin {get the first word}

if (hsize<=8) or (hsize>2*minwordsize.value-1) then {single word across top row}

begin

s:=findAword(hsize,' ',0,true);

If s<>'' then

begin

addword(dir,s,point(1,1));

result:=getnextword(V);

end

else result:=false;

end

else

begin {fit two words across top row}

s:=findaword(hsize div 2 -1, ' ',0,true);

if s<>'' then

begin

addword(dir,s,point(1,1));

n:=length(s);

s:=findaword(hsize div 2 -1, ' ',0,true); {maxword size,'match char, match position}

if s<>'' then

begin

addword(dir,s,point(n+2,1));

result:=getnextword(V);

end

else result:=false;

end

else result:=false;

end;

end {first word}

else {after first}

repeat

with usedwords do

case testdir of

V: {place a Vertical word}

begin {search horizontal words for an potential vertical word site}

i:=count-1;

s:='';

while i>=0 do {try horizontal words from back to front of usedword list}

begin

if TUsed(objects[i]).direction=H then

begin

{search up and down from each letter until we find a place that a word

could fit}

p:=TUsed(objects[i]).start;

with p do

repeat

while (x<=hsize) and (x<TUsed(objects[i]).start.x+length(usedwords[i])-1)

and ((board[x-1,y+1]<>' ') or (board[x+1,y+1]<>' ')

or (board[x,y-1]<>' ') or (board[x,y+1]<>' ')) do inc(x);

if (x<=hsize) then

begin

{look up and down and find highest starting cell and longest word

that could fit here}

u:=y-1;

while (u>0) and (board[x-1,u]=' ')

and (board[x,u]=' ') and (board[x+1,u]=' ')

and (board[x,u-1]=' ') and (board[x+1,u-1]=' ')

do dec(u);

b:=y+1;

while (b<=hsize)

and (board[x-1,b]=' ') and (board[x,b]=' ')

and (board[x,b+1]=' ') and (board[x+1,b]=' ')

do inc(b);

inc(u);

dec(b);

j:=b-u+1; {length of word space}

k:=y-u+1; {loc of matching letter}

s:=findaword(j,board[x,y],k,false);

if s<>'' then

begin

addword(V,s,point(x,u));

break;

end;

if s='' then inc(x);

until (s<>'') or (x>=hsize);

end;

if s<>'' then break;

dec(i);

end;

if (s<>'')

then result:=getnextword(H)

else testdir:=H; {if we failed, try the other direction}

end;

{Note - horizontal logic below is the same a vertical logic with role of

directional x and y coordinates swapped}

begin {search vertical words for an potential horizontal word site}

i:=count-1;

s:='';

while i>=0 do {try vertical words from back to front of usedword list}

begin

if TUsed(objects[i]).direction=V then

begin

{search left and right from each letter until we find a place that a word

could fit}

p:=TUsed(objects[i]).start;

with p do

repeat

while (y<=vsize) and (y<TUsed(objects[i]).start.y+length(usedwords[i])-1)

and ((board[x-1,y+1]<>' ') or (board[x+1,y+1]<>' ')

or (board[x-1,y-1]<>' ') or (board[x+1,y-1]<>' ')

or (board[x-1,y]<>' ') or (board[x+1,y]<>' ')

) do inc(y);

if (y<=vsize) then

begin

{look left/right and find first possible starting cell and longesgt word

that could fit here}

u:=x{-1};

while (u>0) and (board[u-1,y-1]=' ')

and (board[u-1,y]=' ') and (board[u-1,y+1]=' ') do dec(u);

b:=x+1;

while (b<=vsize)

and (board[b,y-1]=' ') and (board[b,y]=' ')

and (board[b+1,y]=' ') and (board[b,y+1]=' ')

do inc(b);

inc(u);

dec(b);

j:=b-u+1; {length of word space}

k:=x-u+1; {loc of matching letter}

s:=findaword(j,board[x,y],k,false);

if s<>'' then

begin

addword(H,s,point(u,y));

break;

end;

if s='' then inc(y);

until (s>'') or (y>=vsize); {continue searching this word if necessary}

end;

if s<>'' then break;

dec(i);

end;

if (s<>'')

then result:=getnextword(V)

else testdir:=V; {if we failed, try the other direction}

end;

until (s<>'') or (testdir=dir);

end;

{**************** GenerateBtnClick ************}

procedure TForm1.GenerateBtnClick(Sender: TObject);

var i:integer;

begin

setboardsize;

loadlist(Words);

wordcount:=0;

if usedwords.count>0 then

for i:=0 to usedwords.count-1 do TUsed(usedwords.objects[i]).free;

usedwords.clear;

getnextword(H);

end;

{************* SizeEdtChnage ************}

procedure TForm1.SizeedtChange(Sender: TObject);

{Board size changed - redraw it}

begin

with boardgrid do

begin

rowcount:= VSizeEdt.value;

colcount:= HSizeedt.value;

end;

adjustgridsize(boardgrid);

setboardsize;

end;

end.

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

blood - Bulmaca Yapici

{

http://www.delphiforfun.org/Programs/CrosswordGen0.htm

Bu kodlar, istenilen boyutta sözlüklere dayanarak bulmaca yapar.

Yukaridaki adreste daha fazla bilgi bulunabilir.

}

unit U_Crosswords;

This program may be used or modified for any non-commercial purpose

so long as this original notice remains in place.

All other rights are reserved

}

{Prototype of logic for a crossword puzzle generator}

interface

uses

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

Grids, StdCtrls, Spin, ComCtrls;

type

TDir=(H,V); {direction type H=horizontal, V= vertical}

TUsed=class(Tobject) {object attached to usedwords showing origin and direction}

start:TPoint;

direction:TDir;

end;

TForm1 = class(TForm)

BoardGrid: TStringGrid;

MinWordSize: TSpinEdit;

MaxWordSize: TSpinEdit;

Label1: TLabel;

Label3: TLabel;

Label4: TLabel;

GenerateBtn: TButton;

Maxwords: TSpinEdit;

Label2: TLabel;

Label5: TLabel;

Label6: TLabel;

Hsizeedt: TSpinEdit;

VSizeedt: TSpinEdit;

Label7: TLabel;

StatusBar1: TStatusBar;

CountLbl: TLabel;

Memo1: TMemo;

procedure FormActivate(Sender: TObject);

procedure GenerateBtnClick(Sender: TObject);

procedure SizeedtChange(Sender: TObject);

public

{ Public declarations }

board:array of array of char;

hsize,vsize:integer; {horizontal and vertical board sizes}

words, usedwords:Tstringlist;

wordcount:integer; {count of words placed in the puzzle}

procedure loadlist(list:TStringList);

procedure setboardsize;

function getnextword(dir:TDir):boolean;

procedure showboard;

procedure addword(dir:TDir; w:string; p:TPoint);

function findaword(maxsize:integer; ch:char; loc:integer; findmax:boolean):string;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{**************** AdjustGridSize ***********}

procedure adjustGridSize(grid:TStringGrid);

{Adjust borders of grid to just fit cells}

begin

with grid do

begin

height:=(defaultrowheight+GridLineWidth)*rowcount+gridlinewidth+2 {+2 for border};

width:=colcount*(defaultcolwidth+gridlinewidth)+gridlinewidth+2 {+2 for border};

end;

{***************** AddWord *************}

procedure TForm1.addword(dir:TDir; w:string; p:TPoint);

{Insert the passed word, "w", into the board in direction "dir" starting at point "p"}

var i:integer;

t:Tused;

begin

case dir of

H: for i:= 1 to length(w) do board[p.x-1+i,p.y]:=w[i];

V: for i:= 1 to length(w) do board[p.x,p.y-1+i]:=w[i];

end;

t:=TUsed.create;

t.direction:=dir;

t.start:=p;

usedwords.addobject(w,t);

inc(wordcount);

countlbl.caption:=inttostr(wordcount);

application.processmessages;

showboard;

end;

{****************** LoadList *************}

procedure TForm1.Loadlist(list:TStringList);

{Load a list of candidate words and randomly shuffle them}

{**local procedure Swap **}

procedure swap(var s1,s2:string);

var t:string;

begin t:=s1; s2:=s2; s2:=t; end;

var i,j:integer;

s1,s2:string;

begin

list.loadfromfile(extractfilepath(application.exename)+'Small.txt');

with list do

begin

{scramble the list and make sure it is uppercase}

for i:= count-1 downto 0 do

begin

if length(strings[i])<=2 then delete(i)

else

begin

s1:=uppercase(strings[i]);

strings[i]:=s1;

end;

for i:= count-1 downto 2 do

begin

s1:=strings[i];

j:=random(i);

s2:=strings[j];

swap(s1,s2);

strings[i]:=s1;

strings[j]:=s2;

end;

{************* FormActivate **********}

procedure TForm1.FormActivate(Sender: TObject);

{Initialization}

begin

Words:=TStringlist.create;

usedwords:=Tstringlist.create;

SizeedtChange(sender);

randomize;

end;

{************** SetBoardSize ***********}

procedure TForm1.setboardsize;

var i,j:integer;

begin

hsize:=hsizeedt.value; vsize:=vsizeedt.value;

setlength(board,Hsize+2,Vsize+2);

{clear board and place a semaphore border around the board to simplify border testing}

for i:=0 to Hsize+1 do

for j:=0 to Vsize+1 do

If (i=0) or (i=hsize+1) or (j=0) or (j=vsize+1) then board[i,j]:=' '

else board[i,j]:=' ';

wordcount:=0;

end;

{************* ShowBoard *******}

procedure TForm1.showboard;

var i,j:integer;

begin

for i:=0 to high(board)-2 do

for j:= 0 to high(board[i])-2 do BoardGrid.cells[i,j]:=board[i+1,j+1];

Boardgrid.update;

sleep(500);

end;

{*********************** FindAWord **************}

function TForm1.findaword(maxsize:integer; ch:char; loc:integer; findmax:boolean):string;

{search the words list for the largest word <= "maxsize" with character "ch"

in postion "loc"}

var

i,j:integer;

s, bestS:string;

slen:integer;

begin

result:='';

slen:=0;

for i:= 0 to words.count-1 do

begin

s:=words[i];

if (length(s)>slen) and (length(s)<=maxsize) and (length(s)<=maxwordsize.Value)

and (length(s)>=minwordsize.value)

then

begin

if (loc=0) then

begin

{make sure it hasn't already been used}

j:= usedwords.indexof(s);

if j=-1 then

begin

bests:=s;

slen:=length(s);

end;

end

else if (loc>0) then

begin

j:=pos(ch,s);

if j=loc then

begin

j:= usedwords.indexof(s);

if j=-1 then

begin

bests:=s;

slen:=length(s);

end;

if ((not findmax) and (slen>0))

or (findmax and (slen=maxsize)) then break; {find 1st or longest based on findmax}

end;

if slen>0 then result:=bests else result:='';

end;

{*********** GetNextWord *********}

function TForm1.getnextword(dir:TDir):boolean;

{Recursive routine to generte the next word in the next directions}

var

s:string;

n:integer;

i,j,k:integer;

u,b:integer; {upper and bottom, or left and right limits of word space found}

p:TPoint;

Testdir:Tdir;

begin

result:=false;

testdir:=dir;

if wordcount>=maxwords.Value then exit;

if wordcount=0 then

begin {get the first word}

if (hsize<=8) or (hsize>2*minwordsize.value-1) then {single word across top row}

begin

s:=findAword(hsize,' ',0,true);

If s<>'' then

begin

addword(dir,s,point(1,1));

result:=getnextword(V);

end

else result:=false;

end

else

begin {fit two words across top row}

s:=findaword(hsize div 2 -1, ' ',0,true);

if s<>'' then

begin

addword(dir,s,point(1,1));

n:=length(s);

s:=findaword(hsize div 2 -1, ' ',0,true); {maxword size,'match char, match position}

if s<>'' then

begin

addword(dir,s,point(n+2,1));

result:=getnextword(V);

end

else result:=false;

end

else result:=false;

end;

end {first word}

else {after first}

repeat

with usedwords do

case testdir of

V: {place a Vertical word}

begin {search horizontal words for an potential vertical word site}

i:=count-1;

s:='';

while i>=0 do {try horizontal words from back to front of usedword list}

begin

if TUsed(objects[i]).direction=H then

begin

{search up and down from each letter until we find a place that a word

could fit}

p:=TUsed(objects[i]).start;

with p do

repeat

while (x<=hsize) and (x<TUsed(objects[i]).start.x+length(usedwords[i])-1)

and ((board[x-1,y+1]<>' ') or (board[x+1,y+1]<>' ')

or (board[x,y-1]<>' ') or (board[x,y+1]<>' ')) do inc(x);

if (x<=hsize) then

begin

{look up and down and find highest starting cell and longest word

that could fit here}

u:=y-1;

while (u>0) and (board[x-1,u]=' ')

and (board[x,u]=' ') and (board[x+1,u]=' ')

and (board[x,u-1]=' ') and (board[x+1,u-1]=' ')

do dec(u);

b:=y+1;

while (b<=hsize)

and (board[x-1,b]=' ') and (board[x,b]=' ')

and (board[x,b+1]=' ') and (board[x+1,b]=' ')

do inc(b);

inc(u);

dec(b);

j:=b-u+1; {length of word space}

k:=y-u+1; {loc of matching letter}

s:=findaword(j,board[x,y],k,false);

if s<>'' then

begin

addword(V,s,point(x,u));

break;

end;

if s='' then inc(x);

until (s<>'') or (x>=hsize);

end;

if s<>'' then break;

dec(i);

end;

if (s<>'')

then result:=getnextword(H)

else testdir:=H; {if we failed, try the other direction}

end;

{Note - horizontal logic below is the same a vertical logic with role of

directional x and y coordinates swapped}

begin {search vertical words for an potential horizontal word site}

i:=count-1;

s:='';

while i>=0 do {try vertical words from back to front of usedword list}

begin

if TUsed(objects[i]).direction=V then

begin

{search left and right from each letter until we find a place that a word

could fit}

p:=TUsed(objects[i]).start;

with p do

repeat

while (y<=vsize) and (y<TUsed(objects[i]).start.y+length(usedwords[i])-1)

and ((board[x-1,y+1]<>' ') or (board[x+1,y+1]<>' ')

or (board[x-1,y-1]<>' ') or (board[x+1,y-1]<>' ')

or (board[x-1,y]<>' ') or (board[x+1,y]<>' ')

) do inc(y);

if (y<=vsize) then

begin

{look left/right and find first possible starting cell and longesgt word

that could fit here}

u:=x{-1};

while (u>0) and (board[u-1,y-1]=' ')

and (board[u-1,y]=' ') and (board[u-1,y+1]=' ') do dec(u);

b:=x+1;

while (b<=vsize)

and (board[b,y-1]=' ') and (board[b,y]=' ')

and (board[b+1,y]=' ') and (board[b,y+1]=' ')

do inc(b);

inc(u);

dec(b);

j:=b-u+1; {length of word space}

k:=x-u+1; {loc of matching letter}

s:=findaword(j,board[x,y],k,false);

if s<>'' then

begin

addword(H,s,point(u,y));

break;

end;

if s='' then inc(y);

until (s>'') or (y>=vsize); {continue searching this word if necessary}

end;

if s<>'' then break;

dec(i);

end;

if (s<>'')

then result:=getnextword(V)

else testdir:=V; {if we failed, try the other direction}

end;

until (s<>'') or (testdir=dir);

end;

{**************** GenerateBtnClick ************}

procedure TForm1.GenerateBtnClick(Sender: TObject);

var i:integer;

begin

setboardsize;

loadlist(Words);

wordcount:=0;

if usedwords.count>0 then

for i:=0 to usedwords.count-1 do TUsed(usedwords.objects[i]).free;

usedwords.clear;

getnextword(H);

end;

{************* SizeEdtChnage ************}

procedure TForm1.SizeedtChange(Sender: TObject);

{Board size changed - redraw it}

begin

with boardgrid do

begin

rowcount:= VSizeEdt.value;

colcount:= HSizeedt.value;

end;

adjustgridsize(boardgrid);

setboardsize;

end;

end.

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

Dr. Kill sen harikasın(delphiforum da ta...)

{Lan kodbank ı kirlettin durdun sen şerefsizmisin he utanmıyormusun

haysiyetsiz köpek şerefsiz insan...

Sen ne sanıyon kendini senin gibilerden

HAYVAN OLMAZ be!!! İnsan değilsin sen

BÖCEK SİN anlıyormusun.... İnsanlar burda birşeyler

öğreniyor sense hit kazanma çabasında iyiye kullanılan

bir programı kötü yönler için kullanıyorsun..

Sana Açık Açık söylüyorum senin ANANIN .......... KOYAYIM anlıyormusun. } Haklısın kardeşim

son kez kod harici birşey yazıyorum... Burayı kirletenlerin ve kirleteceklerin ta ..... .mına ..yim

İnsan olun biraz.. Tabi diğer arkadaşlarımız kesinlikle alınmasın

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

Dr. Kill sen harikasın(delphiforum da ta...)

{Lan kodbank ı kirlettin durdun sen şerefsizmisin he utanmıyormusun

haysiyetsiz köpek şerefsiz insan...

Sen ne sanıyon kendini senin gibilerden

HAYVAN OLMAZ be!!! İnsan değilsin sen

BÖCEK SİN anlıyormusun.... İnsanlar burda birşeyler

öğreniyor sense hit kazanma çabasında iyiye kullanılan

bir programı kötü yönler için kullanıyorsun..

Sana Açık Açık söylüyorum senin ANANIN .......... KOYAYIM anlıyormusun. } Haklısın kardeşim

son kez kod harici birşey yazıyorum... Burayı kirletenlerin ve kirleteceklerin ta ..... .mına ..yim

İnsan olun biraz.. Tabi diğer arkadaşlarımız kesinlikle alınmasın

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

Mail bomber(YENİ)

//-----------Declared-----------

//----cw_morfin@msn.com---------

//---delphi_hacker@hotmail.com--

<STRoNG>Delphi ile Mail Bomber Hazırlamak

Bu dökümanımızda sizlere delphi 6 ile smtp serverlarını kullanarak mail yollanması ve bunu illegal olarak kullanmanın yollarını anlatacağım.

Gerekenler

1. Delphi 6

2. Smtp server adresleri

Şimdi birşeyler yapmaya başlayalım.Öncelikle formumuzu düzenleyelim Formumuza öncelikle Fasnet Component tabındaki NMSMTP componentini yerleştiriyoruz. Ardından 3 tane editbox 1 tane memo 1 tane combobox 1 tane spinedit 3 tane label ve 1 tane de button yerleştiriyoruz. Comboboxımızın items kısmına kullanacağımız smtp serverlarını yazıyoruz mesela:Gmail ve Yahoo bunları seçerken dikkat etmemiz gereken tek şey elmizde bu adresin smtp serverı mevcutmu?.

Form a istediğiniz görünümü verdikten sonra geri kalan işlerimizi kodlarla halletmemiz gerekiyor.

Butonumuzun onclick olayını aşağıdaki gibi düzenliyoruz.

procedure TForm1.Button1Click(Sender: TObject);

begin

Nmsmtp.Connect;//Az sonra belirteceğim smtp serverına bağlanıyoruz.

end;

Comboboxımızın OnChange olayını aşağıdaki şekilde düzenliyoruz Bu işlem kullanıcımızın mail yollayacağı adresin smtp serverını ayarlamamıza yarayacaktır.

procedure TForm1.cb1Change(Sender: TObject);

begin

if cb1.ItemIndex=0 then

Nmsmtp.Host:='mx3.mail.yahoo.com';//comboboxın ilk itemi yani yahoo seçili ise smtp serverını atıyoruz.

if cb1.ItemIndex=1 then

Nmsmtp.Host:='gsmtp171.google.com';//comboboxın ikinci itemi yani gmail seçili ise smtp serverını atıyoruz.

end;

Şimdi herşeyi hallettik mailımızı yollamamız gerekiyor. Yapmamız gereken şey smtp server a send komutu vermektir.

NMsmtp server ın OnConnect olayını aşağıdaki şekilde düzenliyoruz...

procedure TForm1.mailConnect(Sender: TObject);

begin

Nmsmtp.PostMessage.ToAddress.Text:=edit1.Text;// Gönderilecek adresimizi edit1 in textinden aktarıyoruz

Nmsmtp.PostMessage.Subject:=edit2.Text;//Göderilecek konuyu edit2 nin text inden aktarıyoruz

Nmsmtp.PostMessage.FromAddress.Text:=edit3.Text;//Göderenin mail adresini edit3 ün textinden aktarıyoruz

Nmsmtp.PostMessage.BOdy.Text:=memo1.Lines.Text;// gönderilecek konuyu memo1 in içeriğinden alıyoruz

label1.Caption:='Bağlı';//Server a bağlandığımızı bize bildirmesi için label1de belirtiyoruz.

Nmsmtp.SendMail;// ve mail ımızı yolluyoruz.

end;

Son olarak başarılı olup olmadığımızı öğrenme zamanı geldi. Bunun için Nmsmtp serverın OnSuccess olayını şöyle düzenliyoruz.

procedure TForm1.mailSuccess(Sender: TObject);

begin

Nmsmtp.Disconnect;//server ile bağlantımızı kesiyoruz.

label2.Caption:='OK';//bunu anlamak için label2 aracılığı ile kendimizi bilgilendiriyoruz.

end;

Buraya kadar yalnızca bir mail yollamanın nasıl yapılacağını hep birlikte öğrendik.Bu yöntemle karşımızdaki kişiye fake mail yollayabiliriz. Gerekli html kodlarını memo1 diye adlandırdığımız bölüme yazarsak ve edit 3 diye adlandırdığımız bölüme mailın kimden gittiğini belirtirsek gayet güzel bir fake mail yollamış olursunuz.Yukardaki anllattığım program yalnızca Gmail ve Yahoo ya mail yollar diğer serverlara mail yollamak için combobox a girdiğimiz smtp serverlarına ekleme yapabilirsiniz.

Şimdi birden fazla mail ı otomatik olarak yollamayı öğrenelim.

Aynı kodlara birkaç eklenti yaptığımızda sorunumuz çözülecektir.

Formumuza kaç mailın başarılı bir şekilde yollandığını görmemizi sağlayacaak bir label daha ekleyelim.

Ve Nmsmtp serverın OnSuccess olayını şu şekilde değiştirelim.

procedure TForm1.mailSuccess(Sender: TObject);

var x:integer;//sayaç olarak kullanacağımız bir tam sayı değişkeni tanımlıyoruz.

begin

Nmsmtp.Disconnect;//server ile bağlantımızı kesiyoruz.

label7.Caption:='OK';/bunu anlamak için label2 aracılığı ile kendimizi bilgilendiriyoruz.

x:=x+1;//Tanımladığımız değişkeni başarılı bir işlem yaptığımız için 1 arttırıyoruz.

label3.Caption:=inttostr(x);//label3'e değişkenimizin değerini string'e çevirerek atıyoruz.

if se1.Value<>x then//eğer spineditte belirttiğimiz değer le değişkenimiz eşit değilse

Nmsmtp.Connect;//smtp serverımıza yeniden bağlanıyoruz. Bu işlem Spineditte belirttiğimiz değerle değişkenimizin değeri edşitleninceye kadar devam edecektir.

end;

Yukarda anlattığım programı hazırladığımızda kişinin mail adresini yüzlerce hatta binlerce mail ile doldurabiliriz veya fake mail atarak kişimizi yanıltabiliriz. Yapmamız gereken tek şey hayal gücümüzü kullanmak.

Not: alıntı yapılarak yazıLmıstır !!</Declared>

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