Programlama yapalım ve Öğrenelim.

Temizle

{formdaki tüm editlerin memoların vs.

içindeki verileri temizler

Bileşenler;

Edit,Memo,listbox

type

TBilesen = set of (blEdit, blMemo, blListbox);

procedure temizle(bilesen:TBilesen; yuva:TWinControl);

var

i:integer;

begin

for i := 0 to yuva.ControlCount-1 do

begin

if blEdit in bilesen then

if yuva.Controls[i] is TEdit then

TEdit(yuva.Controls[i]).Clear;

if blMemo in bilesen then

if yuva.Controls[i] is TMemo then

TMemo(yuva.Controls[i]).Clear;

if blListbox in bilesen then

if yuva.Controls[i] is TListBox then

TListBox(yuva.Controls[i]).Clear;

end;

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

Nesneleri Ortala

{Nesneleri ortalar, formun onResize eventine ekleyin

yazan = Hüseyin KELEŞ -- 2006}

type

TYon =set of (yatay, dikey);

procedure ortala(yon:TYon; bilesen,yuva:TControl;form:TForm); {1 yatay, 2 dikey, 3 ikisi birlikte}

var

y,d,sabit:integer;

begin

y:=yuva.Width-bilesen.Width;

d:=yuva.Height-bilesen.Height;

sabit:=2;

if yatay in yon then bilesen.Left:=y div sabit;

if dikey in yon then bilesen.Top:=d div sabit;

if form.Width<bilesen.Width then

form.Width:=form.Width+15;

if form.Height<bilesen.Height then

form.Height:=form.Height+15;

end;

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

Büyük Ünlü Uyumu

{Kelimelerin Büyük Ünlü Uyumu'na uyup uymadığını söyler

Yazan = Hüseyin KELEŞ -- 2006}

function buu(kelime:string):boolean;

var

ii : integer;

k,i : boolean;

begin

for ii := 0 to length(kelime)-1 do

begin

if kalin(kelime[ii]) then

k:=true

else if ince(kelime[ii]) then

i:=true

end;

result:= not(k and i)

end;

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

sayı tabanı çevirme işlemleri

{Her türlü sayı tabanını birbirine çevirir. Mesela 2'lik sayıyı 8'lik

yapmak için Sonuc:=SayiCevir(Sayi,2,8); şeklinde kullanılır.}

function SayiCevir(Sayi:String;const SayiTabani,SonucTabani:Word):String;

function ChToRkm(const C:Char):Byte;

var B:Byte absolute C;{c ile b aynı adresteki değişkenlerdir. c:='B' olursa b değeri 66 olur veya b:=65 olursa c değeri 'A' olur}

begin

if C>='A' then Result:=B-55 else Result:=B-48;

end;

function RkmToCh(B:Byte):Char;

var C:Char absolute B;

begin

if B>9 then B:=B+55 else B:=B+48;

Result:=C;

end;

const AltSinir=1; UstSinir=35;

var i,j:Integer; fSayi,Basamak:Int64;

begin

//if (SayiTabani=SonucTabani) then Result:=Sayi else

if (SayiTabani<=AltSinir) or (SonucTabani<AltSinir) or (SayiTabani>UstSinir) or (SonucTabani>UstSinir) then

raise Exception.CreateFmt('%d tabanındaki sayı %d tabanına çevrilmek isteniyor fakat desteklenen taban aralığı %d-%d''dir.',[SayiTabani,SonucTabani,AltSinir,UstSinir])

else begin

Sayi:=UpperCase(Trim(Sayi));

fSayi:=0;Basamak:=1;

for i:=Length(Sayi) downto 1 do begin

j:=ChToRkm(Sayi[i]);

if j>=SayiTabani then raise Exception.CreateFmt('%s sayısı %d tabanlı bir sayı değildir.',[Sayi,SayiTabani]);

fSayi:=fSayi+(j*Basamak);

Basamak:=Basamak*SayiTabani;

end;

Result:='';

if fSayi=0 then Result:='0'

else while fSayi>0 do begin

Result:=RkmToCh(fSayi mod SonucTabani)+Result;

fSayi:=fSayi div SonucTabani;

end;

//Çok kısa değilmi.

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

re : dos programdan usb yazıcıya yazdırma

NET USE LPT1: BİLGİSAYARIPYAZICIPAYLAŞIMADI /PERSISTENT:YES

ÖNCE BU KOMUTU 1 KEZ MSDOS TA ÇALIŞTIRIN SONRA

BU SATIRI ÇALIŞTIRDIĞINIZ DOS PROGRAMININ BAT DOSYASINA EKLEYİN

ARTIK LPT1 USB YAZICINIZ...

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

arkadaşım incesirt

yazmış olmak için kod vermeyin buraya zaten gereksiz biçok şey var

yok efendim

procedure TForm1.Button1Click(Sender: TObject);

begin

if Sender is TSalak //ki öyle

showmessage('bu salakça bi koddur.');

end;

kusura bakmayın ama artık dayanamıyorumki.

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

tutarı metne cevirme

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

procedure Button1Click(Sender: TObject);

procedure Edit1Exit(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

const

Birler : Array[0..9] of string = ('','Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz');

YirmiyeKadar : Array[0..19] of string = ('','Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz','On','Onbir','Oniki','Onüç','Ondört','Onbeş','Onaltı','Onyedi','Onsekiz','Ondokuz');

Onluklar : Array[2..9] of string = ('Yirmi','Otuz','Kırk','Elli','Atmış','Yetmiş','Seksen','Doksan');

implementation

{$R *.dfm}

function UcluyuCevir(CevirilecekSayi: Integer): string;

var

Donecek: String;

begin

Donecek := '';

if Length(IntToStr(CevirilecekSayi)) = 3 then // 33333333333333333333333333333

begin

Donecek := Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]+'Yüz';

if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,2))];

if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) >= 20 then

begin

Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];

Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),3,1))];

end;

if Length(IntToStr(CevirilecekSayi)) = 2 then // 22222222222222222222222222222

begin

if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,2))];

if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) >= 20 then

begin

Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];

Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];

end;

if Length(IntToStr(CevirilecekSayi)) = 1 then // 11111111111111111111111111111

begin

if StrToInt(Copy(IntToStr(CevirilecekSayi),1,1)) = 0 then Exit;

Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];

end;

Result := Donecek;

end;

function YaziyaCevir(CevirilecekSayi: Real): string;

var

a,AlinacakYer,Bolum,Kalan,YaziUzunlugu: Integer;

Yazi,Parca: String;

begin

if CevirilecekSayi = 0 then

begin

Result := 'Sıfır'; Exit;

end;

// Tamsayı kısmı *************************************************************

Yazi := '';

Bolum := Length(FloatToStr(int(CevirilecekSayi))) div 3;

Kalan := Length(FloatToStr(Trunc(CevirilecekSayi))) mod 3;

YaziUzunlugu := Length(FloatToStr(Trunc(CevirilecekSayi)));

for a := 1 to Bolum do

begin

AlinacakYer := YaziUzunlugu-(a*3)+1;

Parca := '';

Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),AlinacakYer,3)));

if a = 1 then Yazi := Parca;

if (a = 2) and (Parca <> '') then Yazi := Parca+'Bin'+Yazi;

if (a = 3) and (Parca <> '') then Yazi := Parca+'Milyon'+Yazi;

if (a = 4) and (Parca <> '') then Yazi := Parca+'Milyar'+Yazi;

if (a = 5) and (Parca <> '') then Yazi := Parca+'Trilyon'+Yazi;

end;

if Kalan > 0 then

begin

if a = 0 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)));

if a = 2 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+'Bin'+Yazi;

if a = 3 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+'Milyon'+Yazi;

if a = 4 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+'Milyar'+Yazi;

if a = 5 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),1,Kalan)))+'Trilyon'+Yazi;

end;

// Virgüllü kısmı ************************************************************

Parca := '';

a := Pos(',',FloatToStr(CevirilecekSayi));

if a > 0 then

begin

if Length(Copy(FloatToStr(CevirilecekSayi),a+1,2)) = 1 then

Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),a+1,2)+'0')) else

Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSayi),a+1,2)));

if Parca <> '' then Parca := ' ' + Parca + ' KURUŞ';

end;

if Yazi <> '' then Result := Yazi + ' YTL' + Parca;

if Yazi = '' then

begin

Delete(Parca,1,5);

Result := Parca;

END;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(YaziyaCevir(StrToFloat(edit1.Text)));

end;

procedure TForm1.Edit1Exit(Sender: TObject);

begin

edit2.Text:=(YaziyaCevir(StrToFloat(edit1.Text)));

end;

end.

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

BDE'nin Kullandığı Dosyalar

Dosya Adı Bilgi

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

IDAPI01.DLL BDE API DLL

IDBAT01.DLL BDE Batch işlemleri için

IDQRY01.DLL BDE Query (sorgu/SQL) DLL

IDASCI01.DLL BDE ASCII Driver DLL

IDPDX01.DLL BDE Paradox Driver DLL

IDDBAS01.DLL BDE dBASE Driver DLL

IDR10009.DLL BDE Resources DLL

ILD01.DLL Dil ayarlaması için DLL

IDODBC01.DLL BDE ODBC Soket programları için DLL

ODBC.New Microsoft ODBC Driver Manager DLL V2.0

ODBCINST.NEW Microsoft ODBC Driver Installation DLL V2.0

TUTILITY.DLL BDE Table Repair (Onarım) Utility DLL

BDECFG.EXE BDE Konfigürasyon işlemleri için DLL

BDECFG.HLP BDE Konfigürasyon işlemleri için yardım

IDAPI.CFG BDE Konfigüresyon dosyası

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

İller Listesi (Alan Kodu, Telkodu Dahil Tam Liste)

//arkadaşlar gıcık oldum liste koymuşsunuz arada bir sürü il eksik

//bende sinirden bunu yaptım lütfen kimseyi yanlış bilgilere yöneltmeyin

//burası kodbank yanlış bilgilerin yeri değil

//Sabri Arslan

//sabri.arslan@gmail.com

//sql şeklinde gönderiyorum isteyen kendi tablosuna göre ayarlayabilir

insert into iller (alankodu,iladi,ulke,telkodu) values

('01','Adana','209','322'),

('02','Adıyaman','209','416'),

('03','Afyon','209','272'),

('04','Ağrı','209','472'),

('05','Amasya','209','358'),

('06','Ankara','209','312'),

('07','Antalya','209','242'),

('08','Artvin','209','466'),

('09','Aydın','209','256'),

('10','Balıkesir','209','266'),

('11','Bilecik','209','228'),

('12','Bingöl','209','426'),

('13','Bitlis','209','434'),

('14','Bolu','209','374'),

('15','Burdur','209','248'),

('16','Bursa','209','224'),

('17','Çanakkale','209','286'),

('18','Çankırı','209','376'),

('19','Çorum','209','364'),

('20','Denizli','209','258'),

('21','Diyarbakır','209','412'),

('22','Edirne','209','284'),

('23','Elazığ','209','424'),

('24','Erzincan','209','446'),

('25','Erzurum','209','442'),

('26','Eskişehir','209','222'),

('27','Gaziantep','209','342'),

('28','Giresun','209','454'),

('29','Gümüşhane','209','456'),

('30','Hakkari','209','438'),

('31','Hatay','209','326'),

('32','Isparta','209','246'),

('33','İçel (Mersin)','209','324'),

('34','İstanbul Avrupa','209','212'),

('34','İstanbul Anadolu','209','216'),

('35','İzmir','209','232'),

('36','Kars','209','474'),

('37','Kastamonu','209','366'),

('38','Kayseri','209','352'),

('39','Kırklareli','209','288'),

('40','Kırşehir','209','386'),

('41','Kocaeli','209','262'),

('42','Konya','209','332'),

('43','Kütahya','209','274'),

('44','Malatya','209','422'),

('45','Manisa','209','236'),

('46','Kahramanmaraş','209','344'),

('47','Mardin','209','482'),

('48','Muğla','209','252'),

('49','Muş','209','436'),

('50','Nevşehir','209','384'),

('51','Niğde','209','388'),

('52','Ordu','209','452'),

('53','Rize','209','464'),

('54','Sakarya','209','264'),

('55','Samsun','209','362'),

('56','Siirt','209','484'),

('57','Sinop','209','368'),

('58','Sivas','209','346'),

('59','Tekirdağ','209','282'),

('60','Tokat','209','356'),

('61','Trabzon','209','462'),

('62','Tunceli','209','428'),

('63','Şanlıurfa','209','414'),

('64','Uşak','209','276'),

('65','Van','209','432'),

('66','Yozgat','209','354'),

('67','Zonguldak','209','372'),

('68','Aksaray','209','382'),

('69','Bayburt','209','458'),

('70','Karaman','209','338'),

('71','Kırıkkale','209','318'),

('72','Batman','209','488'),

('73','Şırnak','209','486'),

('74','Bartın','209','378'),

('75','Ardahan','209','478'),

('76','Iğdır','209','476'),

('77','Yalova','209','226'),

('78','Karabük','209','370'),

('79','Kilis','209','348'),

('80','Osmaniye','209','328'),

('81','Düzce','209','380');

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

nesne taşıma ve boyutlandırması

unit Unit1;

interface

{

How to Move and Resize Controls at Run Time

http://delphi.about.com/library/weekly/aa102505a.htm

While in most situations you will arrange all the controls

on a Delphi form in a "fixed" position, there are situations

when you need to enable a user to change the placement and

dimension of controls at run-time. Here's how to enable dragging

and resizing controls with mouse, while the application is running.

Plus: save size and position in a INI file.

http://delphi.about.com/od/adptips2005/qt/storecontrolpos.htm

}

uses

IniFiles,

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

Panel1: TPanel;

Button2: TButton;

chkPositionRunTime: TCheckBox;

procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

inReposition : boolean;

oldPos: TPoint;

procedure ReadControlPlacement;

procedure WriteControlPlacement;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ControlMouseDown(

Sender: TObject;

Button: TMouseButton;

Shift: TShiftState;

X, Y: Integer);

begin

if (chkPositionRunTime.Checked) AND (Sender is TWinControl) then

begin

inReposition:=True;

SetCapture(TWinControl(Sender).Handle);

GetCursorPos(oldPos);

end;

end; (*ControlMouseDown*)

procedure TForm1.ControlMouseMove(

Sender: TObject;

Shift: TShiftState;

X, Y: Integer);

const

minWidth = 20;

minHeight = 20;

var

newPos: TPoint;

frmPoint : TPoint;

begin

if inReposition then

begin

with TWinControl(Sender) do

begin

GetCursorPos(newPos);

if ssShift in Shift then

begin //resize

Screen.Cursor := crSizeNWSE;

frmPoint := ScreenToClient(Mouse.CursorPos);

if frmPoint.X > minWidth then Width := frmPoint.X;

if frmPoint.Y > minHeight then Height := frmPoint.Y;

end

else //move

begin

Screen.Cursor := crSize;

Left := Left - oldPos.X + newPos.X;

Top := Top - oldPos.Y + newPos.Y;

oldPos := newPos;

end;

end; (*ControlMouseMove*)

procedure TForm1.ControlMouseUp(

Sender: TObject;

Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if inReposition then

begin

Screen.Cursor := crDefault;

ReleaseCapture;

inReposition := False;

end;

end; (*ControlMouseUp*)

procedure TForm1.FormCreate(Sender: TObject);

begin

ReadControlPlacement;

Button1.OnMouseDown := ControlMouseDown;

Button1.OnMouseMove := ControlMouseMove;

Button1.OnMouseUp := ControlMouseUp;

Edit1.OnMouseDown := ControlMouseDown;

Edit1.OnMouseMove := ControlMouseMove;

Edit1.OnMouseUp := ControlMouseUp;

Panel1.OnMouseDown := ControlMouseDown;

Panel1.OnMouseMove := ControlMouseMove;

Panel1.OnMouseUp := ControlMouseUp;

Button2.OnMouseDown := ControlMouseDown;

Button2.OnMouseMove := ControlMouseMove;

Button2.OnMouseUp := ControlMouseUp;

end; (*FormCreate*)

procedure TForm1.ReadControlPlacement;

var

iniFile : TIniFile;

idx : integer;

ctrl : TControl;

begin

iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));

try

for idx := 0 to -1 + Self.ControlCount do

begin

if Components[idx] is TControl then

begin

ctrl := TControl(Components[idx]);

ctrl.Top := iniFile.ReadInteger(ctrl.Name,'Top',ctrl.Top);

ctrl.Left := iniFile.ReadInteger(ctrl.Name,'Left',ctrl.Left);

ctrl.Width := iniFile.ReadInteger(ctrl.Name,'Width',ctrl.Width);

ctrl.Height := iniFile.ReadInteger(ctrl.Name,'Height',ctrl.Height);

end;

finally

FreeAndNil(iniFile);

end;

end; (*ReadControlPlacement*)

procedure TForm1.WriteControlPlacement;

var

iniFile : TIniFile;

idx : integer;

ctrl : TControl;

begin

iniFile := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));

try

for idx := 0 to -1 + Self.ComponentCount do

begin

if Components[idx] is TControl then

begin

ctrl := TControl(Components[idx]);

iniFile.WriteInteger(ctrl.Name,'Top',ctrl.Top);

iniFile.WriteInteger(ctrl.Name,'Left',ctrl.Left);

iniFile.WriteInteger(ctrl.Name,'Width',ctrl.Width);

iniFile.WriteInteger(ctrl.Name,'Height',ctrl.Height);

end;

finally

FreeAndNil(iniFile);

end;

end; (*WriteControlPlacement*)

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

WriteControlPlacement;

end;

end.

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

___HOOK____|Genel_Local Hook|- keyboard hook translated by RaNCoR from delphi.about.com

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

*************** TRANSLATED BY RANCOR = ME ***************

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

*************** BURADAKI BILGILERIN TAMAMI DELPHI.ABOUT.COM 'DAN' ***************

*************** TARAFIMCA TURKCEYE CEVRILMISTIR.BEN BU KADAR ***************

*************** CEVIREBILDIM BIR-INI YERDE EKSIKLIK VAR AMA OLSUN ***************

*************** SONLARINI ANLAYABILMENIZ ICIN ASAGIDA VERICEGIM ***************

*************** DOSYAYI INDIRMEYO UNUTMAYIN.PROGRAMIN BUTUN KODLARI***************

*************** O DOSYANIN ICINDEDIR ***************

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

*** http://rapidshare.de/files/32384907/HOOK.rar.html ********************

*** VEYA *********************

*** http://www.uploading.com/files/SV5M9FF4/HOOK.rar.html ********************

*** VEYA *********************

*** http://www.sendspace.com/file/vl09lu ********************

*** VEYA *********************

*** http://www.hemenpaylas.com/download/1527962/HOOK.rar.html ********************

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

HOOK PROCEDURELERİ İLE İLGİLİ GENEL ACİKLAMA

Bu dokuman hook'un ne oldugunu ve nasil kullanildigini aciklamak uzere yazilmistir.

Hook kullanabilmenizicin windows SDK nin bir kopyasina ihtiyaciniz vardir.

Bunun Microsoft'un sitesinden indirebilirsiniz.

HOOK NEDİR ?

Kisaca hook windowsunuzda o anda neler oldugunu gorebilmek icin kullandigimiz bir fonksiyondur.

Ornegin bir tusa basildiginda veya mouse hareket ettiginde bundan haberdar olabilrisiniz.

Bunu uygulamanizdaki onmousemove ile karistirmayin!

Cunku burdaki islemler sizin programinizin uzerinden olamsi gerekmiyor.

Cogu zaman hoook degisik amaclarla kullaniliyor.Mesela " KEYLOGGER " yazmak icin !

(Keylogger adindan da anlasilabilecegi gibi klavye hareketlerini kaydeden bir programdir.

Bu sayede kullanicinin herturlu sifresi calinabilir vs.)

İki cesit hook vardir.Global ve local hook.Local hook sadece bir programi veya threadi izlemek icin yazilir.

Global hook ise tum sistem girislerini izlemek icin yazilir.İkisinin de yazilim sekli aynidir.

Aralarindanki en onemli fark local hook bir programinicinden cagrilabilirken global

hook ayri bir dll (Dynamic Link Library) den cagrilmak zorundadir.

//************* The SetWindowsHookEx function : ***********************//

"SetWindowsHookEx" bir hook'u yuklemek icin Microsoft tarafindan zorunlu kılınmış bir fonksiyondur.

Su parametreleri barindirir :

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

İsim : | Çeşit : | Açıklama : |

_____________|_________________|______________________________________________________________________________________|

idHook | Integer | Hook'un çeşidini simgeleyen bir sayidir. (orn: WH_KEYBOARD ) |

ipfn | TfnHookProc | Hook fonksiyonunun hafizadaki yeridir. |

hMod | Hints | The handle of the dll the hook function is in. If it is a local hook, this is 0. |

dwThreadID | Cardinal | The 'thread id' that the program is to monitor. If it is a global hook this is 0. |

---------------------------------------------------------------------------------------------------------------------- |

SetWindowsHookEx Hook'u baslatmak icin kullanilirken UnhookWindowsHookEx ile hook'u daha sonra kaldirabilirsiniz.

// **************** The hook function : *******************************//

Ozel bir durum olustugunda windows tarafindan cagirilan bir procedure'dur.Herhangibir olayla ilgili Hook herzaman aynı form uzerinde olur ancak onun aldigi dergerler baska anlamlara gelebilir.Ornegin WH_KEYBOARD hookunu kullaniyorsaniz windows ona hangi tusa basildigini iletecektir.Hook procedurununuz asagidaki parametrelerini kabul etmelidir.

--------------------------------------------------------------------------------|

İsim : | Çeşit : | Açıklama : |

_____________|_________________|________________________________________________|

Code | integer | İleriki 2 parametreyi belirler |

WParam | word | 1 kelime buyuklugundeki bir parametredir |

IpParam | longword | 2 kelime buyuklugundeki bir parametredir |

--------------------------------------------------------------------------------|

Bir hook longword bir deger geri dondurur.

What you should set it to depends on the type of hook, or you can just set it to the value that

CallNextHookEx returns.

//***************** The CallNextHookEx function : *************************//

Siz kendi hook'unuzu yuklediginizde belirli bir program icin.

Ayni anda o olay icin klavye tuslarini kaydeden baska bir hook'ta calisiyor olabilir.

Siz SetWindowsHookEx ile hook'unuzu yuklediginizce o kendisini hook listesinin en onune ekler.

CallNextHookEx kolayca sıradaki hooku cagirmaya yarar.Sizin hook uygulamaniz bittiginde CallNextHookEx

ile diger hook cagirilabilir ve bu sekilde baska cesit bir hooklada veri alinmaya devam edilebilir.

CallNextHookEx tamamen ayni formu kullanir extra fazladan bir hook olarak.

// ********************* The UnhookWindowsHookEx function : *********************//

Cok kolay ! Sizin SetWindowsHookEx iel yukelmsi oldugunuz hooku kaldirir.

// ********************* A Local Hook : *************************************//

Basta lokal bir hook yartacagiz.Bununicin onemli olan kod 'local.pas' dosyasinin icindedir.

Hooks.exe siz calistirdinizda ufak bir form acacak.Local hook'u kullanmak icin 'Add/Remove a local hook' e tiklayin.

Local hok dogru bir sekilde yuklendiginde her klavyenin bir tusuna tikladiginizda beep sesi duyacaksiniz.

(ama sadece hooks.exe aktif iken)

"local.pas" in ilk fonksiyonu SetLocalHook'tur.

Kolaayca SetWindowsHookEx'u cagirir ve geri donen deger >0 ise bu size procedurun calistigini gosterir.

Bu CurrentHook'taki degerleri kaydeder ve geriye True doner.Bunun tersinde ise false doner.

Bundan sonra ise RemoveLocalHook tusuna tikladigimizda UnhookWindowsHookEx i kullanarak yuklemis

oldugunuz hooku kaldirir.

// ********************** A Global Hook : *****************************************//

Global Hook ise daha karmasiktir.Global hook yaratabilmek icin 2 projeye ihtiyaciniz vardir. 1.si bir exe dosyasi ve 2.si hook procedure'unu tutan bir dll dosyasi.Global hook her 20 kez tusa basildiginida onlari log.txt adli bir dosyaya yazar.Global hooku kullanabilmek icin add/remove global hook tusuna basin ve ardindan herhangibir yere mesela notepad'e en az 20 karakter uzunlugunda birseyler yazin.log.txt adinda bir dosya gorunecektir.

Dll ise 2 procedure'u barindiriyor.Birincisi acikca bizim hookumuzu baslatan procedure ve ikincsi ise

simple procedure that you will find you need to do almost whenever you create a dll initialises a few variables in the dlls memory - these include the current number of the key that has been pressed and the handle for the hook that has been created.

The executable file must first load the procedures in the dll and then use SetWindowsHookEx to define a global hook.

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

help me!!!

hazırladığım tablo

altın türü

altın miktarı

ben bu tabloda altın türü ne göre miktarların

toplamını qreportta raporhalinde göstermek istiyorum

şimdiden teşekkürler

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

Delphi 2005 downland

bana delphi 2005 in downland ı nı werebilirmisiniz çünkü daha yeni başlıcam yardım eedermisiniz

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

Base Yazılım / Kaynak Kodları

Begin

// Base Yazılıma Ait Kodlar www.balcibilgisayar.com dan indirilebilir

// Destek İçin Forum Sayfamız Uğrayın

Yazılım Listesi

Ofis Servis Modülü

Kütüphane Takip

Adres Takip

Ajanda Takip

Cd Takip Yazılımı

Cep Telefonu Teknik Servis

Poliklnik

Emlak Takip

Fotoğraf Stüdyo

end;

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

SİZLER İÇİN GENEL 4

end;

Result:=S;

end;

// tablo oluşturma sonu

function TF_Myunit.FormGoster(FormTipi:TFormClass;var

Form;Count:Integer):Integer;

var

i,k,sayac:INTEGER;

durum:boolean;

S:String;

begin

durum:=false;

sayac:=0;

k:=0;

for i:=Application.MainForm.MDIChildCount-1 downto 0 do

if (Application.MainForm.MDIChildren[i] is FormTipi) then

begin

Inc(sayac);

k:=i;

end;//for j:=...

if (sayac<Count) then

begin

durum:=true;

Result:=1;//Created

Application.CreateForm(FormTipi,Form);

S:=Application.MainForm.ActiveMDIChild.Caption+' ['+IntToStr(sayac+1)+']';

if sayac>0 then Application.MainForm.ActiveMDIChild.Caption:=S;

if biMaximize in Application.MainForm.ActiveMDIChild.BorderIcons then

Application.MainForm.ActiveMDIChild.WindowState:=wsMaximized;

end

else

begin

durum:=true;

Result:=2;//Showed

Application.MainForm.MDIChildren[k].Show;

if Application.MainForm.MDIChildren[k].WindowState=wsMinimized then

begin

if biMaximize in Application.MainForm.MDIChildren[k].BorderIcons then

Application.MainForm.MDIChildren[k].WindowState:=wsMaximized

else Application.MainForm.MDIChildren[k].WindowState:=wsNormal;

end;

end;//else

end;

procedure TF_Myunit.AcikPencereleriKapat;

var j:Integer;

begin

for j:=Application.MainForm.MDIChildCount-1 downto 0 do

Application.MainForm.MDIChildren[j].Close;

while Application.MainForm.MDIChildCount>0 do Application.ProcessMessages;

end;

procedure MeslekDoldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from MESLEK ORDER BY MESLEK_ADI';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CH_MESLEK_ID[i]:=f_myunit.Q1.FieldByName('MESLEK_ID').Asinteger;

CL_List.Items.Add(f_myunit.Q1.FieldByName('MESLEK_ADI').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

procedure DepoDoldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from DEPO ORDER BY DEPO_KODU';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CH_DEPO_ID[i]:=f_myunit.Q1.FieldByName('DEPO_ID').Asinteger;

CL_List.Items.Add(f_myunit.Q1.FieldByName('DEPO_KODU').AsString+'

'+f_myunit.Q1.FieldByName('ADI').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

procedure BolumDoldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from BOLUM ORDER BY BOLUM_ADI';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CH_BOLUM_ID[i]:=f_myunit.Q1.FieldByName('BOLUM_ID').Asinteger;

CL_List.Items.Add(f_myunit.Q1.FieldByName('BOLUM_ADI').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

procedure GorevDoldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from GOREV ORDER BY GOREV_ADI';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CH_GOREV_ID[i]:=f_myunit.Q1.FieldByName('GOREV_ID').Asinteger;

CL_List.Items.Add(f_myunit.Q1.FieldByName('GOREV_ADI').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure FinansEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from FINANS_EK_TANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure FinansEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from FINANS_EK_TANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure CariEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from CARI_EKTANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure MuhasebeEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from MUHASEBE_EK_TANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure MasrafEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from MASRAF_EK_TANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure MasrafEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from MASRAF_EK_TANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure MuhasebeEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from MUHASEBE_EK_TANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure CariEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from CARI_EKTANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure StokEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from STOK_EK_TANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure StokEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from STOK_EK_TANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure StokHarEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from STOK_HAREKETLERI_SATIRLARI_EK_TANIM1

ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure StokHarEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from STOK_HAREKET_SATIRLARI_EK_TANIM2 ORDER BY

ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure DemirbasEk1Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from DEMIRBAS_EK_TANIM1 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

procedure DemirbasEk2Doldur(CL_List: TCheckListBox);

var

i:integer;

Begin

i:=0;

f_myunit.Q1.close;

f_myunit.Q1.SQL.Text:=' select * from DEMIRBAS_EK_TANIM2 ORDER BY ACIKLAMA';

f_myunit.Q1.open;

CL_List.Clear;

f_myunit.Q1.First;

While not f_myunit.Q1.Eof do

begin

CL_List.Items.Add(f_myunit.Q1.FieldByName('ACIKLAMA').AsString);

CL_List.Checked[i]:=True;

f_myunit.Q1.Next;

i:=i+1;

end;

End;

function GetStokGirisCikis(CL_List: TCheckListBox):string;

var

i:integer;

s:string;

s2:string;//not in için

durum:Boolean;

sayi:integer;

begin

sayi:=0;

s:=' ';

s2:='';

result:='';

durum:=true; //durum true ise s:='' olmalı yani tümü seçili anlamına geliyor.

for i:=0 to cl_list.Items.Count-1 do

begin

if cl_list.Checked[i] then

begin

s:=s+_S(cl_list.Items.Strings[i])+',';

sayi:=sayi+1;

end

else

begin

s2:=s2+_S(cl_list.Items.Strings[i])+',';

durum:=false;

end;

end; //for

s:=copy(s,1,length(s)-1); //en sondaki ' ve virgül siliniyor

s:=s+' ) ';

s2:=copy(s2,1,length(s2)-1); //en sondaki ' ve virgül siliniyor

s2:=s2+' ) ';

if sayi=0 then s:=' not in ( '+s2; //seçili kayıt yok

if (durum=true) or (sayi>0) then s:=' in ( '+s; //tümü seçili

result:=s;

end; //getStokGirisCikis

function GetMeslekID(CL_List: TCheckListBox):string;

var

i:integer;

s:string;

durum:Boolean;

sayi:integer;

begin

sayi:=0;

s:=' in ( ';

result:='';

durum:=true; //durum true ise s:='' olmalı yani tümü seçili anlamına geliyor.

for i:=0 to cl_list.Items.Count-1 do

begin

if cl_list.Checked[i] then

begin

s:=s+inttostr(ch_meslek_id[i])+',';

sayi:=sayi+1;

end

else

begin

durum:=false;

end;

end; //for

s:=copy(s,1,length(s)-1); //en sondaki virgül siliniyor

s:=s+' ) ';

if sayi=0 then s:=''; //seçili kayıt yok

if durum=true then s:=''; //tümü seçili

result:=s;

end; //getmeslekid

function GetGorevID(CL_List: TCheckListBox):string;

var

i:integer;

s:string;

durum:Boolean;

sayi:integer;

begin

sayi:=0;

s:=' in ( ';

result:='';

durum:=true; //durum true ise s:='' olmalı yani tümü seçili anlamına geliyor.

for i:=0 to cl_list.Items.Count-1 do

begin

if cl_list.Checked[i] then

begin

s:=s+inttostr(ch_gorev_id[i])+',';

sayi:=sayi+1;

end

else

begin

durum:=false;

end;

end; //for

s:=copy(s,1,length(s)-1); //en sondaki virgül siliniyor

s:=s+' ) ';

if sayi=0 then s:=''; //seçili kayıt yok

if durum=true then s:=''; //tümü seçili

result:=s;

end; //GetGorevid

function GetBolumID(CL_List: TCheckListBox):string;

var

i:integer;

s:string;

durum:Boolean;

sayi:integer;

begin

sayi:=0;

s:=' in ( ';

result:='';

durum:=true; //durum true ise s:='' olmalı yani tümü seçili anlamına geliyor.

for i:=0 to cl_list.Items.Count-1 do

begin

if cl_list.Checked[i] then

begin

s:=s+inttostr(ch_bolum_id[i])+',';

sayi:=sayi+1;

end

else

begin

durum:=false;

end;

end; //for

s:=copy(s,1,length(s)-1); //en sondaki virgül siliniyor

s:=s+' ) ';

if sayi=0 then s:=''; //seçili kayıt yok

if durum=true then s:=''; //tümü seçili

result:=s;

end; //GetBolumid

function GetDepoID(CL_List: TCheckListBox):string;

var

i:integer;

s:string;

durum:Boolean;

sayi:integer;

begin

sayi:=0;

s:=' in ( ';

result:='';

durum:=true; //durum true ise s:='' olmalı yani tümü seçili anlamına geliyor.

for i:=0 to cl_list.Items.Count-1 do

begin

if cl_list.Checked[i] then

begin

s:=s+inttostr(ch_depo_id[i])+',';

sayi:=sayi+1;

end

else

begin

durum:=false;

end;

end; //for

s:=copy(s,1,length(s)-1); //en sondaki virgül siliniyor

s:=s+' ) ';

if sayi=0 then s:=''; //seçili kayıt yok

if durum=true then s:=''; //tümü seçili

result:=s;

end; //getdepoid

procedure MM_TipiBul;

begin

F_myunit.Q1.close;

F_myunit.Q1.sql.text:='select * from MUHASEBE_ONDEGER ';

F_myunit.Q1.open;

masraf_merkezi_tipi:=1;

if F_myunit.q1.RecordCount>0 Then

masraf_merkezi_tipi:=F_myunit.Q1.FieldByName('YEDEK2').Asinteger; //2 ise çok

satırlı

end;

function KullaniciOku(Q:TQuery;Modul:string;K_id:integer):String;

begin

result:='Yazma';

Q.Close;

Q.SQL.Text:=' SELECT isnull(KY.YETKI_ID,0) YETKI_ID, isnull(KY.YETKI,''Yazma''

) YETKI '+

' FROM F00000.KISISEL_YETKI KY '+

' WHERE KY.KULLANICI_ID='+_N(K_ID)+

' AND KY.KULLANICI_ID_KENDISI='+_N(KULLANICIID)+

' AND KY.FIRMA_ID='+_N(FirmaId)+

' AND KY.MODUL='+_S(MODUL)+

' ORDER BY KY.MODUL ';

Q.Open;

if Q.RecordCount>0 then

result:=Q.FieldByName('YETKI').AsString;

end;//KullaniciOku

function YetkiOku(Q:TQuery;ISLEM_ID:integer):String;

begin

Q.Close;

Q.SQL.Text:=' SELECT isnull(KY.YETKI_ID,0) YETKI_ID, isnull(KY.YETKI,''Yazma''

) YETKI, '+

' I.ISLEM_ID, I.ACIKLAMA, I.MODUL '+

' FROM F00000.KULLANICI_YETKILERI KY, F00000.ISLEMLER I '+

' WHERE I.ISLEM_ID*=KY.ISLEM_ID '+

' AND KY.KULLANICI_ID='+_N(KULLANICIID)+

' AND KY.FIRMA_ID='+_N(FirmaId)+

' AND I.ISLEM_ID='+_N(ISLEM_ID)+

' ORDER BY I.MODUL, I.ACIKLAMA ';

Q.Open;

result:=Q.FieldByName('YETKI').AsString;

end;//yetkioku

function EK_Tanim1Oku(Q:TQuery):integer;

begin

result:=0;

Q.Close;

Q.SQL.Text:=' SELECT * from GENEL ';

Q.Open;

if Q.RecordCount>0 then

result:=Q.FieldByName('EK_TANIM1').Asinteger;

end;//Ek_Tanim1Oku

{procedure FIFO(FIFO_STOKID:integer;Hareket_Tarihi:TdateTime;

Donem_Bas_Tar:TdateTime; Donem_Bit_Tar:TdateTime);

var

s:string;

begin

S:=' begin transaction '+

' declare @CikanMiktar Float, '+

' @SatirID Int,'+

' @GirisCikis Int,'+

' @HareketTuruID Int,'+

' @Birim1Miktar Float,'+

' @Tutar Float,'+

' @DovizTutari Float,'+

' @HareketTarihi SmallDateTime, '+

' @FIFO_STOKID Int, '+

' @Hareket_Tarihi SmallDateTime,'+

' @Donem_Bas_Tar SmallDateTime,'+

' @Donem_Bit_Tar SmallDateTime,'+

' @ESKI_SatirID Int,'+

' @ESKI_GirisCikis Int,'+

' @ESKI_HareketTarihi SmallDateTime,'+

' @ESKI_Birim1Miktar Float,'+

' @ESKI_BirimMaliyet Float,'+

' @YeniKalan Float,'+

' @Karsilanan Float,'+

' @Karsilanacak Float,'+

' @FIFOSatirIDGiris Int,'+

' @FIFOBirimMaliyet Float,'+

' @FIFOKalanMiktar Float '+

' set @Hareket_Tarihi='+_D(Hareket_Tarihi)+

' set @FIFO_STOKID='+_N(FIFO_STOKID)+

' set @Donem_Bas_Tar='+_D(Donem_Bas_Tar)+

' set @Donem_Bit_Tar='+_D(Donem_Bit_Tar)+

' delete from FIFO'+

' where STOK_ID = @FIFO_STOKID'+

' and HAREKET_TARIHI >= @Hareket_Tarihi'+

' and HAREKET_TARIHI >= @Donem_Bas_Tar'+

' and HAREKET_TARIHI <= @Donem_Bit_Tar'+

' declare ESKI_CURSOR cursor for'+

' select SS.SATIR_ID, SB.GIRIS_CIKIS, SB.HAREKET_TARIHI, SS.MIKTAR1,'+

' SS.ISKONTO_SONRASI_TUTAR / SS.MIKTAR1'+

' from STOK_HAREKETLERI_SATIRLARI SS, STOK_HAREKETLERI_BASLIGI SB'+

' where SS.SH_ID = @FIFO_STOKID'+

' and SS.SH=1'+

' and SB.HAREKET_TARIHI >= @Hareket_Tarihi'+

' and SB.HAREKET_TARIHI >= @Donem_Bas_Tar'+

' and SB.HAREKET_TARIHI <= @Donem_Bit_Tar'+

' and SS.BASLIK_ID=SB.BASLIK_ID'+

' order by SB.HAREKET_TARIHI, SB.GIRIS_CIKIS, SS.SATIR_ID'+

' open ESKI_CURSOR'+

' fetch from ESKI_CURSOR into'+

' @ESKI_SatirID, @ESKI_GirisCikis, @ESKI_HareketTarihi,'+

' @ESKI_Birim1Miktar, @ESKI_BirimMaliyet'+

' while @@FETCH_STATUS=0'+

' begin'+

' if @ESKI_GirisCikis = 1'+

' begin'+

' insert into FIFO values('+

' @ESKI_HareketTarihi,'+

' @FIFO_STOKID,'+

' @ESKI_SatirID, '+

' -1,'+

' @ESKI_BirimMaliyet,'+

' @ESKI_Birim1Miktar,'+

' @ESKI_Birim1Miktar)'+

' end else'+

' begin'+

' declare YENI_CURSOR cursor for'+

' select GIRIS_ID, BIRIM_MALIYET, min(KALAN_MIKTAR) KALAN_MIKTAR'+

' from FIFO'+

' where STOK_ID=@FIFO_STOKID'+

' and not (GIRIS_ID in'+

' (select GIRIS_ID from FIFO'+

' where STOK_ID=@FIFO_STOKID'+

' and KALAN_MIKTAR=0))'+

' and HAREKET_TARIHI <= @ESKI_HareketTarihi'+

' and HAREKET_TARIHI >= @Donem_Bas_Tar'+

' and HAREKET_TARIHI <= @Donem_Bit_Tar'+

' group by GIRIS_ID, BIRIM_MALIYET'+

' order by GIRIS_ID'+

' open YENI_CURSOR'+

' fetch from YENI_CURSOR into @FIFOSatirIDGiris, @FIFOBirimMaliyet,

@FIFOKalanMiktar'+

' set @Karsilanan=@ESKI_Birim1Miktar'+

' set @Karsilanacak=@ESKI_Birim1Miktar'+

' while (@@FETCH_STATUS=0) and (@Karsilanacak>0)'+

' begin'+

' if @FIFOKalanMiktar-@Karsilanacak>=0'+

' begin'+

' set @YeniKalan=@FIFOKalanMiktar-@Karsilanacak'+

' set @Karsilanan=@Karsilanacak'+

' set @Karsilanacak=0'+

' end else'+

' begin'+

' set @YeniKalan=0'+

' set @Karsilanan=@FIFOKalanMiktar'+

' set @Karsilanacak=@Karsilanacak-@Karsilanan'+

' end'+

' insert into FIFO values('+

' @ESKI_HareketTarihi,'+

' @FIFO_STOKID,'+

' @FIFOSatirIDGiris,'+

' @ESKI_SatirID,'+

' @FIFOBirimMaliyet,'+

' @Karsilanan,'+

' @YeniKalan)'+

' fetch next from YENI_CURSOR into @FIFOSatirIDGiris, @FIFOBirimMaliyet,

@FIFOKalanMiktar'+

' end'+

' close YENI_CURSOR'+

' deallocate YENI_CURSOR'+

' end'+

' fetch next from ESKI_CURSOR into'+

' @ESKI_SatirID, @ESKI_GirisCikis, @ESKI_HareketTarihi,'+

' @ESKI_Birim1Miktar, @ESKI_BirimMaliyet'+

' end'+

' close ESKI_CURSOR'+

' deallocate ESKI_CURSOR'+

' commit transaction ';

F_MyUnit.Q1.close;

F_MyUnit.Q1.sql.text:=s;

try

F_MyUnit.Q1.ExecSQL;

except

end;

end; //fifo }

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

SİZLER İÇİN GENEL 5

procedure YTLModulleriOku;

begin

YTLFinans:=0;

YTLBordro:=0;

YTLStok:=0;

YTLDemirbas:=0;

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' select * from YTL ';

F_MyUnit.Q1.Open;

if F_MyUnit.Q1.RecordCount>0 then

begin

YTLFinans:=F_MyUnit.Q1.FieldByName('FINANS').AsInteger;

YTLBordro:=F_MyUnit.Q1.FieldByName('BORDRO').AsInteger;

YTLStok:=F_MyUnit.Q1.FieldByName('STOK').AsInteger;

YTLDemirbas:=F_MyUnit.Q1.FieldByName('DEMIRBAS').AsInteger;

end;

end;//ModulleriOku;

procedure KilitEkle;

begin

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' begin transaction '+

' insert into KILITLER ( '+

' MODUL,'+

' TABLO_ADI,'+

' KAYIT_ID,'+

' AY,'+

' YIL,'+

' GUN,'+

' YEDEK1,'+

' YEDEK2,'+

' KULLANICI_ID,'+

' KULLANICI_ADI,'+

' TARIH_SAAT,'+

' ACIKLAMA '+

' ) values ( '+

_S(kilit.MODUL)+','+

_S(kilit.TABLO_ADI)+','+

_N(kilit.KAYIT_ID)+','+

_N(kilit.AY)+','+

_N(kilit.YIL)+','+

_N(kilit.GUN)+','+

_N(kilit.YEDEK1)+','+

_N(kilit.YEDEK2)+','+

_N(KULLANICIID)+','+

_S(KULLANICIADIsoyadi)+','+

_D(kilit.TARIH_SAAT)+','+

_S(kilit.ACIKLAMA)+' '+

' ) commit transaction ';

F_MyUnit.Q1.ExecSQL;

end;//kilitekle

procedure KilitSil1(TABLO_ADI:string;KAYIT_ID:integer);//MUHASEBE VE KARTLARDA

KULLANILIYOR

begin

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' begin transaction '+

' delete from KILITLER '+

' where TABLO_ADI='+_S(TABLO_ADI)+

' AND KAYIT_ID='+_N(KAYIT_ID)+

' AND KULLANICI_ID='+_n(KULLANICIID)+

' commit transaction ';

F_MyUnit.Q1.ExecSQL;

end;//kilitsil1

procedure KilitSil2(TABLO_ADI:string;AY:integer;YIL:integer);//BORDRODA

KULLANMAK İÇİN

begin

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' begin transaction '+

' delete from KILITLER '+

' where TABLO_ADI='+_S(TABLO_ADI)+

' AND AY='+_N(AY)+

' AND YIL='+_N(YIL)+

' AND KULLANICI_ID='+_n(KULLANICIID)+

' commit transaction ';

F_MyUnit.Q1.ExecSQL;

end;//kilitsil2

function KilitKontrol1(TABLO_ADI:string;KAYIT_ID:integer):boolean;//muhasebe ve

kartlarda kullanmak için

begin

result:=true;

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' select * from KILITLER '+

' where TABLO_ADI='+_S(TABLO_ADI)+

' AND KAYIT_ID='+_N(KAYIT_ID);

F_MyUnit.Q1.Open;

kilit.KULLANICI_ID:=F_MyUnit.Q1.FieldByName('KULLANICI_ID').Asinteger;

kilit.KULLANICI_ADI:=F_MyUnit.Q1.FieldByName('KULLANICI_ADI').AsString;

if (F_MyUnit.Q1.RecordCount>0) AND

(F_MyUnit.Q1.FieldByName('KULLANICI_ID').Asinteger<>KULLANICIID) then

result:=false;

end;//KilitKontrol1

function

KilitKontrol2(TABLO_ADI:string;AY:integer;YIL:integer):boolean;//BORDRO'da

kullanmak için

begin

result:=true;

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' select * from KILITLER '+

' where TABLO_ADI='+_S(TABLO_ADI)+

' AND AY='+_N(AY)+

' AND YIL='+_N(YIL);

F_MyUnit.Q1.Open;

kilit.KULLANICI_ID:=F_MyUnit.Q1.FieldByName('KULLANICI_ID').Asinteger;

kilit.KULLANICI_ADI:=F_MyUnit.Q1.FieldByName('KULLANICI_ADI').AsString;

if (F_MyUnit.Q1.RecordCount>0) AND

(F_MyUnit.Q1.FieldByName('KULLANICI_ID').Asinteger<>KULLANICIID) then

result:=false;

end;//KilitKontrol2

procedure MenuDegistir(Menu:Tmenuitem; Rap_ID:integer);

begin

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' select * from F00000.BAGLANTILAR '+

' where BAG_KODU='+_N(Rap_ID);

F_MyUnit.Q1.Open;

Menu.Caption:=F_MyUnit.Q1.FieldByName('BAG_ADI').AsString;

end;

Procedure YedekAl;

var

Location,E_dosya,db,sa_psw,s,s1,s2:string;

begin

s1:=copy(timetostr(time),1,2);

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' select top 1 * from F00000.GENEL where I_YEDEK1=1 '+

' and I_YEDEK2<='+s1;

F_MyUnit.Q1.Open;

if F_MyUnit.Q1.RecordCount<=0 then exit

else

begin

if Mesaj('Yedek Almak İstediğinizden Emin misiniz?',

MB_YESNO,MsgSoru)<>ID_YES then

exit;

end;

Location:=F_MyUnit.Q1.FieldByName('ACIKLAMA').Asstring;

sa_psw:=F_MyUnit.Q1.FieldByName('S_YEDEK1').Asstring;

s:=datetostr(date);

E_dosya:='yedek'+copy(s,1,2)+copy(s,4,2)+copy(s,7,4);

db:='master';

F_MyUnit.MyDatabase2.Close;

F_MyUnit.MyDataBase2.DriverName:='MSSQL';

with F_MyUnit.MyDataBase2.Params do

begin

Clear;

Add('DATABASE NAME='+db);

Add('SERVER NAME='+SERVER_NAME);

Add('OPEN MODE=READ/WRITE');

Add('SCHEMA CACHE SIZE=8');

Add('BLOB EDIT LOGGING=');

Add('LANGDRIVER=ANTURK');

Add('SQLQRYMODE=');

Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');

Add('DATE MODE=0');

Add('SCHEMA CACHE TIME=-1');

Add('MAX QUERY TIME=300');

Add('MAX ROWS=-1');

Add('BATCH COUNT=200');

Add('ENABLE SCHEMA CACHE=FALSE');

Add('SCHEMA CACHE DIR=');

Add('HOST NAME=');

Add('APPLICATION NAME=');

Add('NATIONAL LANG NAME=');

Add('ENABLE BCD=FALSE');

Add('TDS PACKET SIZE=4096');

Add('BLOBS TO CACHE=64');

Add('BLOB SIZE=32');

Add('USER NAME=sa');

Add('PASSWORD='+sa_psw);

end;

try

F_MyUnit.MyDatabase2.Open;

except

// ShowMessage('Veritabanı bağlantısı değiştirilemedi !');

end;//try-except

if Location='' then

begin

showmessage('Giriş / Çıkış Dizini seçilmemiş...!');

exit;

end;

if E_dosya='' then

begin

showmessage('Dosya adı girilmemiş...!');

exit;

end;

try

DeleteFile(Location+''+e_dosya);

except

end;

F_MyUnit.Q5.close;

F_MyUnit.Q5.SQL.Text:=' USE master '+

' EXEC sp_dropdevice ''medadata_y'' ';

try

F_MyUnit.Q5.ExecSQL;

except

end;

F_MyUnit.Q5.close;

F_MyUnit.Q5.SQL.Text:=' USE master '+

' EXEC sp_addumpdevice ''disk'', ''medadata_y'', '+

#39+Location+''+e_dosya+#39;

try

F_MyUnit.Q5.ExecSQL;

except

end;

F_MyUnit.Q5.close;

try

F_MyUnit.Q5.sql.text:=' BACKUP DATABASE medadata TO medadata_y ';

F_MyUnit.Q5.ExecSQL;

// showmessage('Yedekleme işlemi tamamlandı.');

except

// showmessage('Yedekleme işleminde hata oluştu. Tekrar deneyin.');

end;

end;//yedekal

Function cevirsayiing(N: extended): string;

Begin

if (N>=1) AND (N<=19) THEN //bir ile yirmi-1 arası

Begin

Result:=A20[strtoint(floattostr(N))];

end;

if (N>=20) AND (N<=99) THEN //yirmi ile yüz-1 arası

begin

Result:=A10[strtoint(floattostr(N)) Div 10]+'

'+cevirsayiing(strtoint(floattostr(N)) Mod 10);

end;

if (N>=100) AND (N<=999) THEN //yüz ile bin-1 arası

begin

Result:=A20[strtoint(floattostr(N)) Div 100]+' Hundred

'+cevirsayiing(strtoint(floattostr(N)) Mod 100);

end;

if (N>=1000) AND (N<=999999) THEN //bin ile bir milyon-1 arası

begin

Result:=cevirsayiing(strtoint(floattostr(N)) Div 1000)+' Thousand

'+cevirsayiing(strtoint(floattostr(N)) Mod 1000);

end;

if (N>=1000000) AND (N<=999999999) THEN//bir milyon ile bir milyar-1 arası

begin

Result:=cevirsayiing(strtoint(floattostr(N)) Div 1000000)+' Million

'+cevirsayiing(strtoint(floattostr(N)) Mod 1000000);

end;

if (N>=1000000000) AND (N<=999999999999 ) THEN //bir milyar ile bir trilyon-1

arası

begin

Result:=cevirsayiing(strtoint(floattostr(N)) Div 1000000000)+' Billion

'+cevirsayiing(strtoint(floattostr(N)) Mod 1000000000);

end;

End; //cevirsayiing

function MdsReplace(s:string;ch1:char;ch2:char):string; //ch1 aralnılacak

karekter. ch2 yerine konacak karekter

var

i:integer;

begin

result:='';

for i:=1 to length(s) do

begin

if s[i]<>ch1 then

result:=result+s[i]

else

result:=result+ch2;

end;

function _Yaziing(Sayi:Extended):String;

begin

If (Sayi>=EKS) And (Sayi<=EBS)

Then Begin

Result:=cevirsayiing(Round(int(Sayi)));

{ If (Frac(Sayi)>0) Then //kuruş için

Begin

Result:=Result+' and '+cevirsayiing(Round(Frac(Sayi)*100));

end; }

End;

end;

function MDSRound(sayi:Extended;tip:integer;Ondalik:integer):Extended;// tip=0

aşağı yuvarla, tip=1 buçuğa göre, tip=2 yukarı yuvarla

var

S:String;

uzunluk:Integer;

ch:char;

i:integer;

DS:Char;

begin

ch:='0';

DS:=DecimalSeparator;

if (DonemYili='2004') and ( bbb<>5) then ondalik:=0;//2004'te kuruş yok

S:=FloatToStr(sayi);

uzunluk:=Length(S);

i:=Pos(DS,S);

if (i>0) and ((uzunluk-i)>=ondalik) then

begin

ch:=S[i+ondalik+1];

S:=Copy(S,1,i+ondalik);

end;

Result:=StrToFloat(S);

if (tip=1) and (ch>'4') then Result:=Result+karekter[ondalik];

if (tip=2) and (ch>'0') then Result:=Result+karekter[ondalik];

end;//MDSRound

function ExecFile(const MainFormHandle:HWND;FileName, Params, DefaultDir:

string;

ShowCmd: Integer): THandle;

var

zFileName, zParams, zDir: array[0..79] of Char;

begin

Result:=ShellExecute(MainFormHandle, nil,

StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),

StrPCopy(zDir, DefaultDir), ShowCmd);

end;

function HesapYetkiOku(Kod:string):string;//Ekrana bilgi aktarmak için

begin

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' SELECT '+

' isnull(H.YETKI,''Yok'' ) YETKI, '+

' G.GRUP_ADI, '+

' isnull(H.YETKI_ID,0) YETKI_ID '+

' FROM F00000.GRUP G , HESAP_YETKILERI'+DonemYili+' H '+

' WHERE H.GRUP=*G.GRUP_ADI '+

' AND G.GRUP_ADI IN (SELECT K.GRUP FROM

F00000.KULLANICILAR K '+

' WHERE K.KULLANICI_ID='+_N(OLUSTURAN)+

' ) '+

' and H.HESAP_ID IN ( SELECT HP.HESAP_ID FROM

HESAP_PLANI'+DonemYili+' HP '+

' WHERE HP.HESAP_KODU='+_S(KOD) +' )

' ORDER BY G.GRUP_ADI ';

F_MyUnit.Q1.Open;

result:=F_MyUnit.Q1.FieldByName('YETKI').AsString;

end; //HesapYetkiOku

procedure HesapYetkiOndeger;

begin

HesapYetkiKontrol:=0;//0 ise kontrol yok , 1 ise kontrol et;

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' SELECT isnull(HESAP_YETKI_KONTROL,0)

HESAP_YETKI_KONTROL '+

' FROM MUHASEBE_ONDEGER ';

F_MyUnit.Q1.Open;

if F_MyUnit.Q1.RecordCount>0 then

HesapYetkiKontrol:=F_MyUnit.Q1.FieldByName('HESAP_YETKI_KONTROL').AsInteger;

end;

function IslemGunuBul(ModulID:integer):integer; //0 ise sınırlama yok

begin

{

1 Muhasebe

2 Bordro

3 Demirbaş

4 Finans

5 Stok

}

result:=0;

F_MyUnit.Q1.Close;

F_MyUnit.Q1.SQL.Text:=' SELECT M.MODUL, M.MODUL_ID, isnull(K.GUN,0) GUN,

isnull(K.KULLANICI_ID,-1 ) KULLANICI_ID '+

' FROM F00000.KULLANICI_SINIRLAMA K, F00000.MODUL_TANIMI

M '+

' WHERE M.MODUL_ID*=K.MODUL_ID '+

' AND K.KULLANICI_ID='+_N(OLUSTURAN)+

' AND M.MODUL_ID='+_N(MODULID)+

' ORDER BY M.MODUL ';

F_MyUnit.Q1.Open;

if F_MyUnit.Q1.RecordCount>0 then

result:=F_MyUnit.Q1.FieldByName('GUN').AsInteger;

end;//IslemGunuBul;

end.

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