Programlama yapalım ve Öğrenelim.

Eğitim notlarım:
......................................................................................................................

Otomatik metin tamamlama

Örneğin "A" yazdığınızda "A" ile başlayan kayıtlardaki ilk kelime Örneğin "Ahmet"

"Al" yazdığınızda "Ali" kelimesini otomatik gelmesi.

Örnekte DBDEMOS tan customer.db tablosunun Company alanı otomatik tanımlama olarak verilmiştir.Edit2 ye yazı girildikçe tablodaki Company sütununa göre otomatik tamamlama yapılır.

procedure TForm1.Edit2Change(Sender: TObject);

Var SIRKET:String;

uzunluk:integer;

begin

If Length(Edit2.Text)<>0 then

begin

Table1.IndexName:='ByCompany';

Table1.FindNearest([Edit2.Text]);

If Copy(table1.fieldbyname('Company').asstring,1,Length(Edit2.Text))=

Copy(Edit2.Text,1,Length(Edit2.Text)) then

begin

SIRKET:=table1.fieldbyname('Company').asstring;

uzunluk:=Length(Edit2.Text);

SIRKET:=copy(SIRKET,Uzunluk+1,Length(SIRKET)-uzunluk);

Edit2.Text:=edit2.Text+SIRKET;

Edit2.selstart:=uzunluk;

Edit2.Sellength:=Length(Edit2.Text)-uzunluk;

end;

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

If key=VK_back then//İşaretli alan ve bir karakter sil

if edit2.seltext<>'' then

Edit2.Text:=copy(Edit2.Text,1,Edit2.selstart-1);;

end;

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

Otomatik metin tamamlama

Örneğin "A" yazdığınızda "A" ile başlayan kayıtlardaki ilk kelime Örneğin "Ahmet"

"Al" yazdığınızda "Ali" kelimesini otomatik gelmesi.

Örnekte DBDEMOS tan customer.db tablosunun Company alanı otomatik tanımlama olarak verilmiştir.Edit2 ye yazı girildikçe tablodaki Company sütununa göre otomatik tamamlama yapılır.

procedure TForm1.Edit2Change(Sender: TObject);

Var SIRKET:String;

uzunluk:integer;

begin

If Length(Edit2.Text)<>0 then

begin

Table1.IndexName:='ByCompany';

Table1.FindNearest([Edit2.Text]);

If Copy(table1.fieldbyname('Company').asstring,1,Length(Edit2.Text))=

Copy(Edit2.Text,1,Length(Edit2.Text)) then

begin

SIRKET:=table1.fieldbyname('Company').asstring;

uzunluk:=Length(Edit2.Text);

SIRKET:=copy(SIRKET,Uzunluk+1,Length(SIRKET)-uzunluk);

Edit2.Text:=edit2.Text+SIRKET;

Edit2.selstart:=uzunluk;

Edit2.Sellength:=Length(Edit2.Text)-uzunluk;

end;

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

If key=VK_back then//İşaretli alan ve bir karakter sil

if edit2.seltext<>'' then

Edit2.Text:=copy(Edit2.Text,1,Edit2.selstart-1);;

end;

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

Memo İçinde İmlecin hangi satır ve kolonda olduğunu bulma

var

LineNum:logint;

CharBeforeLine:logint;

begin

LineNum:=SendMessage(Memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);

CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,LineNum,0);

Label1.Caption:='Satır'+IntToStr(LineNum+1);

Label2.Caption:='Kolon'+IntToStr((Memo1.SelStart-CharsBeforeLine)+1);

ListBox1.ItemIndex:=-1;

Combobox1.ItemIndex:=-1;

end;

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

Memo İçinde İmlecin hangi satır ve kolonda olduğunu bulma

var

LineNum:logint;

CharBeforeLine:logint;

begin

LineNum:=SendMessage(Memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);

CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,LineNum,0);

Label1.Caption:='Satır'+IntToStr(LineNum+1);

Label2.Caption:='Kolon'+IntToStr((Memo1.SelStart-CharsBeforeLine)+1);

ListBox1.ItemIndex:=-1;

Combobox1.ItemIndex:=-1;

end;

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

Edit'e Girilen metnin ilk harfini büyük yapmak

//Bunu için edit'in OnKeyPress olayına aşağıdaki kodu ekleyin..

with Sender as TEdit do

if (SelStart=0) or

(Text[SelStart]=' ') then

if Key in ['a'..'z'] then

Key := UpCase(Key);

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

Edit'e Girilen metnin ilk harfini büyük yapmak

//Bunu için edit'in OnKeyPress olayına aşağıdaki kodu ekleyin..

with Sender as TEdit do

if (SelStart=0) or

(Text[SelStart]=' ') then

if Key in ['a'..'z'] then

Key := UpCase(Key);

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

Formun Boyutunu Sabitlemek

//FORMUN BOUTUNU SABİTLEMEK...

//Form Create olayına

var

orj,aktif:integer;

Begin

orj:=800 //Tasarımın yapıldığı çözünürlük

aktif:=screen.width;

Form1.ScaleBy(aktif,orj);

end;

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

Formun Boyutunu Sabitlemek

//FORMUN BOUTUNU SABİTLEMEK...

//Form Create olayına

var

orj,aktif:integer;

Begin

orj:=800 //Tasarımın yapıldığı çözünürlük

aktif:=screen.width;

Form1.ScaleBy(aktif,orj);

end;

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

Bir Popup menüyü kod ile göstermek

PopupMenu1.Popup(Form1.Left+60, Form1.Top+140);

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

Bir Popup menüyü kod ile göstermek

PopupMenu1.Popup(Form1.Left+60, Form1.Top+140);

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

Memo içinde Mouse Scroll düğmesini kullanma (metni tekerlekle kaydırma)

// ben dbMemo kullanarak yaptım. memoda farklı olabilir....

procedure TAnaForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;

WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

begin

case WheelDelta of

120:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEUP,0);

end;

-120:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEDOWN,0);

end;

240:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEUP,0);

end;

-240:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEDOWN,0);

end;

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

Memo içinde Mouse Scroll düğmesini kullanma (metni tekerlekle kaydırma)

// ben dbMemo kullanarak yaptım. memoda farklı olabilir....

procedure TAnaForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;

WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

begin

case WheelDelta of

120:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEUP,0);

end;

-120:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEDOWN,0);

end;

240:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEUP,0);

end;

-240:

begin

SendMessage(MEMO.Handle,WM_VSCROLL,SB_LINEDOWN,0);

end;

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

Açılış Ekranı (Component)

// delphi 7 ile yapıldı.

// diğer versiyonlarda denenmedi.

// formun creat ine

// ACILISEKRANI.EXCECUTE;

// yazın ayarladığınız resim program başlamadan önce verdiği süre ve ebatlarda

// ekranda görünsün.

// hepinize kolay gelsin

unit ACILISEKRANI;

interface

uses

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

Dialogs, ExtCtrls, jpeg, StdCtrls;

type

TACILISEKRANI = class(TComponent)

private

FResim:TPicture;

fyukseklik,fuzunluk,fuyku:Integer;

procedure SResim(Value:TPicture);

procedure Syukseklik(Value:integer);

procedure SUzunluk(Value:integer);

procedure Suyku(Value:integer);

{ Private declarations }

protected

{ Protected declarations }

public

constructor create(aOwner : TComponent); override;

destructor destroy; override;

procedure Execute;

{ Public declarations }

published

property Resim:TPicture read FResim write SResim;

Property Yukseklik:Integer Read fyukseklik Write Syukseklik;

Property Uzunluk:Integer Read fuzunluk Write SUzunluk;

Property Uyku:Integer Read fuyku Write Suyku;

{ Published declarations }

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Diğerleri', [TACILISEKRANI]);

end;

{ TACILISEKRANI }

constructor TACILISEKRANI.create(aOwner: TComponent);

begin

inherited create(aOwner);

FResim:=TPicture.Create;

end;

destructor TACILISEKRANI.destroy;

begin

FResim.Free;

inherited;

end;

procedure TACILISEKRANI.SResim(Value: TPicture);

begin

if Value<>FResim then

begin

FResim.Assign(Value);

end;

procedure TACILISEKRANI.SUzunluk(Value: integer);

begin

fuzunluk:=Value;

end;

procedure TACILISEKRANI.Syukseklik(Value: integer);

begin

fyukseklik:=Value;

end;

procedure TACILISEKRANI.Execute;

var

fr:TForm;

res:TImage;

begin

Application.ProcessMessages;

fr:=TForm.Create(nil);

with fr do

begin

Height:=Yukseklik;

Width:=Uzunluk;

BorderStyle:=bsNone;

FormStyle:=fsStayOnTop;

Position:=poScreenCenter;

res:=TImage.Create(fr);

with res do

begin

Parent:=fr;

Picture:=Resim;

Align:=alClient;

Stretch:=True;

end;

fr.Show;

fr.Update;

Application.ProcessMessages;

Sleep(Uyku);

end;

res.Free;

fr.Free;

end;

procedure TACILISEKRANI.Suyku(Value: integer);

begin

fuyku:=Value;

end;

end.

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

Açılış Ekranı (Component)

// delphi 7 ile yapıldı.

// diğer versiyonlarda denenmedi.

// formun creat ine

// ACILISEKRANI.EXCECUTE;

// yazın ayarladığınız resim program başlamadan önce verdiği süre ve ebatlarda

// ekranda görünsün.

// hepinize kolay gelsin

unit ACILISEKRANI;

interface

uses

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

Dialogs, ExtCtrls, jpeg, StdCtrls;

type

TACILISEKRANI = class(TComponent)

private

FResim:TPicture;

fyukseklik,fuzunluk,fuyku:Integer;

procedure SResim(Value:TPicture);

procedure Syukseklik(Value:integer);

procedure SUzunluk(Value:integer);

procedure Suyku(Value:integer);

{ Private declarations }

protected

{ Protected declarations }

public

constructor create(aOwner : TComponent); override;

destructor destroy; override;

procedure Execute;

{ Public declarations }

published

property Resim:TPicture read FResim write SResim;

Property Yukseklik:Integer Read fyukseklik Write Syukseklik;

Property Uzunluk:Integer Read fuzunluk Write SUzunluk;

Property Uyku:Integer Read fuyku Write Suyku;

{ Published declarations }

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Diğerleri', [TACILISEKRANI]);

end;

{ TACILISEKRANI }

constructor TACILISEKRANI.create(aOwner: TComponent);

begin

inherited create(aOwner);

FResim:=TPicture.Create;

end;

destructor TACILISEKRANI.destroy;

begin

FResim.Free;

inherited;

end;

procedure TACILISEKRANI.SResim(Value: TPicture);

begin

if Value<>FResim then

begin

FResim.Assign(Value);

end;

procedure TACILISEKRANI.SUzunluk(Value: integer);

begin

fuzunluk:=Value;

end;

procedure TACILISEKRANI.Syukseklik(Value: integer);

begin

fyukseklik:=Value;

end;

procedure TACILISEKRANI.Execute;

var

fr:TForm;

res:TImage;

begin

Application.ProcessMessages;

fr:=TForm.Create(nil);

with fr do

begin

Height:=Yukseklik;

Width:=Uzunluk;

BorderStyle:=bsNone;

FormStyle:=fsStayOnTop;

Position:=poScreenCenter;

res:=TImage.Create(fr);

with res do

begin

Parent:=fr;

Picture:=Resim;

Align:=alClient;

Stretch:=True;

end;

fr.Show;

fr.Update;

Application.ProcessMessages;

Sleep(Uyku);

end;

res.Free;

fr.Free;

end;

procedure TACILISEKRANI.Suyku(Value: integer);

begin

fuyku:=Value;

end;

end.

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

YUKLU PROGRAMLARI GOSTER (REGISTER)

//HKEY_LOCAL_MACHINE using SoftwareMicrosoftWindowsCurrentVersionUninstall

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

MyList: TStringList;

MyRegistry: TRegistry;

i: Integer;

Str: string;

begin

MyRegistry:=TRegistry.Create;

MyList:=TStringList.Create;

with MyRegistry do

begin

RootKey:=HKEY_LOCAL_MACHINE;

if OpenKey(

'SoftwareMicrosoftWindowsCurrentVersionUninstall',

False)=True then GetKeyNames(MyList);

CloseKey;

for i:=0 to MyList.Count-1 do

begin

RootKey:=HKEY_LOCAL_MACHINE;

OpenKey(

'SoftwareMicrosoftWindowsCurrentVersionUninstall'+

MyList[i],

False);

Str:=ReadString('DisplayName');

if Str<>'' then

Memo1.Lines.Add(ReadString('DisplayName'));

CloseKey;

end;

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

YUKLU PROGRAMLARI GOSTER (REGISTER)

//HKEY_LOCAL_MACHINE using SoftwareMicrosoftWindowsCurrentVersionUninstall

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var

MyList: TStringList;

MyRegistry: TRegistry;

i: Integer;

Str: string;

begin

MyRegistry:=TRegistry.Create;

MyList:=TStringList.Create;

with MyRegistry do

begin

RootKey:=HKEY_LOCAL_MACHINE;

if OpenKey(

'SoftwareMicrosoftWindowsCurrentVersionUninstall',

False)=True then GetKeyNames(MyList);

CloseKey;

for i:=0 to MyList.Count-1 do

begin

RootKey:=HKEY_LOCAL_MACHINE;

OpenKey(

'SoftwareMicrosoftWindowsCurrentVersionUninstall'+

MyList[i],

False);

Str:=ReadString('DisplayName');

if Str<>'' then

Memo1.Lines.Add(ReadString('DisplayName'));

CloseKey;

end;

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

Enumerating the current user's privileges

Enumerating the current user's privileges

Question:

How can I obtain the current user's privileges?

Answer:

Use OpenProcessToken() to obtain an access token for the current process (it could be a different process as well). This access token contains the security information for your session. All processes run under the same logon (session) have the same access token, so it doesn't matter which process you use.

The access token identifies the user, the user's groups and privileges.

Then you need to call GetTokenInformation() to obtain the information associated with the access token.

LookupPrivilegeName() and LookupPrivilegeDisplayName() are used to obtain a human readable string representation of each privilege.

procedure TForm1.Button1Click(Sender: TObject);

const

TokenSize = 800; // (SizeOf(Pointer) = 4*200)

var

hToken: THandle;

pTokenInfo: PTOKENPRIVILEGES;

ReturnLen: Cardinal;

i: Integer;

PrivName: PChar;

DisplayName: PChar;

NameSize: Cardinal;

DisplSize: Cardinal;

LangId: Cardinal;

begin

GetMem(pTokenInfo, TokenSize);

if not OpenProcessToken(GetCurrentProcess(),

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then

ShowMessage('OpenProcessToken error');

if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then

ShowMessage('GetTokenInformation error');

GetMem(PrivName, 255);

GetMem(DisplayName, 255);

for i := 0 to pTokenInfo.PrivilegeCount - 1 do

begin

DisplSize := 255;

NameSize := 255;

LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);

LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);

ListBox1.Items.Add(PrivName + #9 + DisplayName);

end; // for

FreeMem(PrivName);

FreeMem(DisplayName);

FreeMem(pTokenInfo);

end;

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

Enumerating the current user's privileges

Enumerating the current user's privileges

Question:

How can I obtain the current user's privileges?

Answer:

The access token identifies the user, the user's groups and privileges.

Then you need to call GetTokenInformation() to obtain the information associated with the access token.

LookupPrivilegeName() and LookupPrivilegeDisplayName() are used to obtain a human readable string representation of each privilege.

procedure TForm1.Button1Click(Sender: TObject);

const

TokenSize = 800; // (SizeOf(Pointer) = 4*200)

var

hToken: THandle;

pTokenInfo: PTOKENPRIVILEGES;

ReturnLen: Cardinal;

i: Integer;

PrivName: PChar;

DisplayName: PChar;

NameSize: Cardinal;

DisplSize: Cardinal;

LangId: Cardinal;

begin

GetMem(pTokenInfo, TokenSize);

if not OpenProcessToken(GetCurrentProcess(),

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then

ShowMessage('OpenProcessToken error');

if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then

ShowMessage('GetTokenInformation error');

GetMem(PrivName, 255);

GetMem(DisplayName, 255);

for i := 0 to pTokenInfo.PrivilegeCount - 1 do

begin

DisplSize := 255;

NameSize := 255;

LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);

LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);

ListBox1.Items.Add(PrivName + #9 + DisplayName);

end; // for

FreeMem(PrivName);

FreeMem(DisplayName);

FreeMem(pTokenInfo);

end;

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

List all installed services and drivers

List all installed services and drivers

In order to enumerate all installed drivers and/or services on either your local computer or even a remote machine, you need to use EnumServicesStatus(). This function doesn't work with a callback function; instead it expects a static array in which it will return the information.

The example below implements a wrapper function ServiceGetList() that keeps this static array on the stack and returns the result in TStrings string list.

The FormCreate() event shows how to call the function. You can download a complete sample Delphi project here (5 kB).

unit fMain;

interface

uses

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

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

Label1: TLabel;

Label2: TLabel;

procedure FormCreate(Sender: TObject);

private

{ private declarations }

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses

WinSvc;

const

// Service Types

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_FILE_SYSTEM_DRIVER = $00000002;

SERVICE_ADAPTER = $00000004;

SERVICE_RECOGNIZER_DRIVER = $00000008;

SERVICE_DRIVER = (SERVICE_KERNEL_DRIVER or

SERVICE_FILE_SYSTEM_DRIVER or

SERVICE_RECOGNIZER_DRIVER);

SERVICE_WIN32_OWN_PROCESS = $00000010;

SERVICE_WIN32_SHARE_PROCESS = $00000020;

SERVICE_WIN32 = (SERVICE_WIN32_OWN_PROCESS or SERVICE_WIN32_SHARE_PROCESS);

SERVICE_INTERACTIVE_PROCESS = $00000100;

SERVICE_TYPE_ALL = (SERVICE_WIN32 or

SERVICE_ADAPTER or

SERVICE_DRIVER or

SERVICE_INTERACTIVE_PROCESS);

//-------------------------------------

// Get a list of services

// return TRUE if successful

// sMachine:

// machine name, ie: SERVER

// empty = local machine

// dwServiceType

// SERVICE_WIN32,

// SERVICE_DRIVER or

// SERVICE_TYPE_ALL

// dwServiceState

// SERVICE_ACTIVE,

// SERVICE_INACTIVE or

// SERVICE_STATE_ALL

// slServicesList

// TStrings variable to storage

function ServiceGetList(sMachine: string;

dwServiceType, dwServiceState: DWord;

slServicesList: TStrings) : boolean;

const

// assume that the total number of services is less than 4096.

//Increase if necessary

cnMaxServices = 4096;

type

TSvcA = array [0..cnMaxServices] of TEnumServiceStatus;

PSvcA = ^TSvcA;

var

j: integer;

// service control manager handle

schm: SC_Handle;

// bytes needed for the next buffer, if any

nBytesNeeded,

// number of services

nServices,

// pointer to the next unread service entry

nResumeHandle: DWord;

// service status array

ssa: PSvcA;

begin { ServiceGetList }

Result := false;

// connect to the service control manager

schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_ALL_ACCESS);

// if successful...

if (schm>0) then

begin

nResumeHandle := 0;

New(ssa);

EnumServicesStatus(schm, dwServiceType, dwServiceState, ssa^[0],

sizeof(ssa^), nBytesNeeded, nServices,

nResumeHandle);

// assume that our initial array was large enough to hold all

// entries. add code to enumerate if necessary.

for j := 0 to nServices-1 do

begin

slServicesList.Add(StrPas(ssa^[j].lpDisplayName));

end; { for j }

Result := true;

Dispose(ssa);

// close service control manager handle

CloseServiceHandle(schm);

end; { (schm>0) }

end; { ServiceGetList }

procedure TForm1.FormCreate(Sender: TObject);

begin { TForm1.FormCreate }

ServiceGetList('', SERVICE_TYPE_ALL, SERVICE_ACTIVE, ListBox1.Items);

ServiceGetList('', SERVICE_TYPE_ALL, SERVICE_INACTIVE, ListBox2.Items);

end; { TForm1.FormCreate }

end.

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

List all installed services and drivers

List all installed services and drivers

The example below implements a wrapper function ServiceGetList() that keeps this static array on the stack and returns the result in TStrings string list.

The FormCreate() event shows how to call the function. You can download a complete sample Delphi project here (5 kB).

unit fMain;

interface

uses

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

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

Label1: TLabel;

Label2: TLabel;

procedure FormCreate(Sender: TObject);

private

{ private declarations }

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses

WinSvc;

const

// Service Types

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_FILE_SYSTEM_DRIVER = $00000002;

SERVICE_ADAPTER = $00000004;

SERVICE_RECOGNIZER_DRIVER = $00000008;

SERVICE_DRIVER = (SERVICE_KERNEL_DRIVER or

SERVICE_FILE_SYSTEM_DRIVER or

SERVICE_RECOGNIZER_DRIVER);

SERVICE_WIN32_OWN_PROCESS = $00000010;

SERVICE_WIN32_SHARE_PROCESS = $00000020;

SERVICE_WIN32 = (SERVICE_WIN32_OWN_PROCESS or SERVICE_WIN32_SHARE_PROCESS);

SERVICE_INTERACTIVE_PROCESS = $00000100;

SERVICE_TYPE_ALL = (SERVICE_WIN32 or

SERVICE_ADAPTER or

SERVICE_DRIVER or

SERVICE_INTERACTIVE_PROCESS);

//-------------------------------------

// Get a list of services

// return TRUE if successful

// sMachine:

// machine name, ie: SERVER

// empty = local machine

// dwServiceType

// SERVICE_WIN32,

// SERVICE_DRIVER or

// SERVICE_TYPE_ALL

// dwServiceState

// SERVICE_ACTIVE,

// SERVICE_INACTIVE or

// SERVICE_STATE_ALL

// slServicesList

// TStrings variable to storage

function ServiceGetList(sMachine: string;

dwServiceType, dwServiceState: DWord;

slServicesList: TStrings) : boolean;

const

// assume that the total number of services is less than 4096.

//Increase if necessary

cnMaxServices = 4096;

type

TSvcA = array [0..cnMaxServices] of TEnumServiceStatus;

PSvcA = ^TSvcA;

var

j: integer;

// service control manager handle

schm: SC_Handle;

// bytes needed for the next buffer, if any

nBytesNeeded,

// number of services

nServices,

// pointer to the next unread service entry

nResumeHandle: DWord;

// service status array

ssa: PSvcA;

begin { ServiceGetList }

Result := false;

// connect to the service control manager

schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_ALL_ACCESS);

// if successful...

if (schm>0) then

begin

nResumeHandle := 0;

New(ssa);

EnumServicesStatus(schm, dwServiceType, dwServiceState, ssa^[0],

sizeof(ssa^), nBytesNeeded, nServices,

nResumeHandle);

// assume that our initial array was large enough to hold all

// entries. add code to enumerate if necessary.

for j := 0 to nServices-1 do

begin

slServicesList.Add(StrPas(ssa^[j].lpDisplayName));

end; { for j }

Result := true;

Dispose(ssa);

// close service control manager handle

CloseServiceHandle(schm);

end; { (schm>0) }

end; { ServiceGetList }

procedure TForm1.FormCreate(Sender: TObject);

begin { TForm1.FormCreate }

ServiceGetList('', SERVICE_TYPE_ALL, SERVICE_ACTIVE, ListBox1.Items);

ServiceGetList('', SERVICE_TYPE_ALL, SERVICE_INACTIVE, ListBox2.Items);

end; { TForm1.FormCreate }

end.

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

mysql in yerine exists

EXISTS ın yerine

mysql de in cok yavaş onun yerine EXISTS kulanmak baya hızlandırıyor

SELECT *

FROM tab

WHERE col1 IN (SELECT col2 FROM TAB2)

sorgusunu, aşağıdaki ile değiştirin:

SELECT *

FROM tab

WHERE EXISTS (SELECT col2 FROM TAB2 WHERE col1 = col2)

Bu işlemin hızlı olması için, subcol'un indexlenmiş bir kolon olması gerekmektedir

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

mysql in yerine exists

EXISTS ın yerine

mysql de in cok yavaş onun yerine EXISTS kulanmak baya hızlandırıyor

SELECT *

FROM tab

WHERE col1 IN (SELECT col2 FROM TAB2)

sorgusunu, aşağıdaki ile değiştirin:

SELECT *

FROM tab

WHERE EXISTS (SELECT col2 FROM TAB2 WHERE col1 = col2)

Bu işlemin hızlı olması için, subcol'un indexlenmiş bir kolon olması gerekmektedir

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

dikkat

arkadaslar yazdiginiz kodlarin bazilari hata veriyor.biraz daha aciklayici ve

dikkatli olursaniz biz acemiler icin iyi olucak tesekkurler.......

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

dikkat

arkadaslar yazdiginiz kodlarin bazilari hata veriyor.biraz daha aciklayici ve

dikkatli olursaniz biz acemiler icin iyi olucak tesekkurler.......

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

Avi dosyasından istenilen framenin alınması

uses

VfW { from download };

function GrabAVIFrame(avifn: string; iFrameNumber: Integer; ToFileName: TFileName): Boolean;

var

Error: Integer;

pFile: PAVIFile;

AVIStream: PAVIStream;

gapgf: PGETFRAME;

lpbi: PBITMAPINFOHEADER;

bits: PChar;

hBmp: HBITMAP;

AviInfo: TAVIFILEINFOW;

sError: string;

TmpBmp: TBitmap;

DC_Handle: HDC;

begin

Result := False;

// Initialize the AVIFile library.

AVIFileInit;

// The AVIFileOpen function opens an AVI file

Error := AVIFileOpen(pFile, PChar(avifn), 0, nil);

if Error <> 0 then

begin

AVIFileExit;

case Error of

AVIERR_BADFORMAT: sError := 'The file couldn''t be read';

AVIERR_MEMORY: sError := 'The file could not be opened because of insufficient memory.';

AVIERR_FILEREAD: sError := 'A disk error occurred while reading the file.';

AVIERR_FILEOPEN: sError := 'A disk error occurred while opening the file.';

end;

ShowMessage(sError);

Exit;

end;

// AVIFileInfo obtains information about an AVI file

if AVIFileInfo(pFile, @AVIINFO, SizeOf(AVIINFO)) <> AVIERR_OK then

begin

// Clean up and exit

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Show some information about the AVI

Form1.Memo1.Lines.Add('AVI Width : ' + IntToStr(AVIINFO.dwWidth));

Form1.Memo1.Lines.Add('AVI Height : ' + IntToStr(AVIINFO.dwHeight));

Form1.Memo1.Lines.Add('AVI Length : ' + IntToStr(AVIINFO.dwLength));

// Open a Stream from the file

Error := AVIFileGetStream(pFile, AVIStream, streamtypeVIDEO, 0);

if Error <> AVIERR_OK then

begin

// Clean up and exit

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Prepares to decompress video frames

gapgf := AVIStreamGetFrameOpen(AVIStream, nil);

if gapgf = nil then

begin

AVIStreamRelease(AVIStream);

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Read current Frame

// AVIStreamGetFrame Returns the address of a decompressed video frame

lpbi := AVIStreamGetFrame(gapgf, iFrameNumber);

if lpbi = nil then

begin

AVIStreamGetFrameClose(gapgf);

AVIStreamRelease(AVIStream);

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Show number of frames:

Form1.Memo1.Lines.Add(Format('Framstart: %d FrameEnd: %d',

[AVIStreamStart(AVIStream), AVIStreamEnd(AVIStream)]));

TmpBmp := TBitmap.Create;

try

TmpBmp.Height := lpbi.biHeight;

TmpBmp.Width := lpbi.biWidth;

bits := Pointer(Integer(lpbi) + SizeOf(TBITMAPINFOHEADER));

DC_Handle := CreateDC('Display', nil, nil, nil);

try

hBmp := CreateDIBitmap(DC_Handle, // handle of device context

lpbi^, // address of bitmap size and format data

CBM_INIT, // initialization flag

bits, // address of initialization data

PBITMAPINFO(lpbi)^, // address of bitmap color-format data

DIB_RGB_COLORS); // color-data usage

finally

DeleteDC(DC_Handle);

end;

TmpBmp.Handle := hBmp;

AVIStreamGetFrameClose(gapgf);

AVIStreamRelease(AVIStream);

AVIFileRelease(pfile);

AVIFileExit;

try

TmpBmp.SaveToFile(ToFileName);

Result := True;

except

end;

finally

TmpBmp.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

// Extract Frame 3 from AVI file

GrabAVIFrame('C:Test.avi', 3, 'c:avifram.bmp');

end;

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

Avi dosyasından istenilen framenin alınması

uses

VfW { from download };

function GrabAVIFrame(avifn: string; iFrameNumber: Integer; ToFileName: TFileName): Boolean;

var

Error: Integer;

pFile: PAVIFile;

AVIStream: PAVIStream;

gapgf: PGETFRAME;

lpbi: PBITMAPINFOHEADER;

bits: PChar;

hBmp: HBITMAP;

AviInfo: TAVIFILEINFOW;

sError: string;

TmpBmp: TBitmap;

DC_Handle: HDC;

begin

Result := False;

// Initialize the AVIFile library.

AVIFileInit;

// The AVIFileOpen function opens an AVI file

Error := AVIFileOpen(pFile, PChar(avifn), 0, nil);

if Error <> 0 then

begin

AVIFileExit;

case Error of

AVIERR_BADFORMAT: sError := 'The file couldn''t be read';

AVIERR_MEMORY: sError := 'The file could not be opened because of insufficient memory.';

AVIERR_FILEREAD: sError := 'A disk error occurred while reading the file.';

AVIERR_FILEOPEN: sError := 'A disk error occurred while opening the file.';

end;

ShowMessage(sError);

Exit;

end;

// AVIFileInfo obtains information about an AVI file

if AVIFileInfo(pFile, @AVIINFO, SizeOf(AVIINFO)) <> AVIERR_OK then

begin

// Clean up and exit

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Show some information about the AVI

Form1.Memo1.Lines.Add('AVI Width : ' + IntToStr(AVIINFO.dwWidth));

Form1.Memo1.Lines.Add('AVI Height : ' + IntToStr(AVIINFO.dwHeight));

Form1.Memo1.Lines.Add('AVI Length : ' + IntToStr(AVIINFO.dwLength));

// Open a Stream from the file

Error := AVIFileGetStream(pFile, AVIStream, streamtypeVIDEO, 0);

if Error <> AVIERR_OK then

begin

// Clean up and exit

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Prepares to decompress video frames

gapgf := AVIStreamGetFrameOpen(AVIStream, nil);

if gapgf = nil then

begin

AVIStreamRelease(AVIStream);

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Read current Frame

// AVIStreamGetFrame Returns the address of a decompressed video frame

lpbi := AVIStreamGetFrame(gapgf, iFrameNumber);

if lpbi = nil then

begin

AVIStreamGetFrameClose(gapgf);

AVIStreamRelease(AVIStream);

AVIFileRelease(pFile);

AVIFileExit;

Exit;

end;

// Show number of frames:

Form1.Memo1.Lines.Add(Format('Framstart: %d FrameEnd: %d',

[AVIStreamStart(AVIStream), AVIStreamEnd(AVIStream)]));

TmpBmp := TBitmap.Create;

try

TmpBmp.Height := lpbi.biHeight;

TmpBmp.Width := lpbi.biWidth;

bits := Pointer(Integer(lpbi) + SizeOf(TBITMAPINFOHEADER));

DC_Handle := CreateDC('Display', nil, nil, nil);

try

hBmp := CreateDIBitmap(DC_Handle, // handle of device context

lpbi^, // address of bitmap size and format data

CBM_INIT, // initialization flag

bits, // address of initialization data

PBITMAPINFO(lpbi)^, // address of bitmap color-format data

DIB_RGB_COLORS); // color-data usage

finally

DeleteDC(DC_Handle);

end;

TmpBmp.Handle := hBmp;

AVIStreamGetFrameClose(gapgf);

AVIStreamRelease(AVIStream);

AVIFileRelease(pfile);

AVIFileExit;

try

TmpBmp.SaveToFile(ToFileName);

Result := True;

except

end;

finally

TmpBmp.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

// Extract Frame 3 from AVI file

GrabAVIFrame('C:Test.avi', 3, 'c:avifram.bmp');

end;

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

Formları animasonla göstermek

procedure TForm1.animin(Sender: TObject);

procedure delay(msec: Longint);

var

start, stop: Longint;

begin

start := GetTickCount;

repeat

stop := GetTickCount;

Application.ProcessMessages;

until (stop - start) >= msec;

end;

var

maxx, maxy: Integer;

MyHand: HWND;

MyDc: HDC;

MyCanvas: TCanvas;

hal, hat, hak, haa: Integer;

begin

maxx := (Sender as TForm).Width;

maxy := (Sender as TForm).Height;

hal := 2;

hat := 2;

MyHand := GetDesktopWindow;

MyDc := GetWindowDC(MyHand);

MyCanvas := TCanvas.Create;

MyCanvas.Handle := MyDC;

MyCanvas.Brush.Color := (Sender as TForm).Color;

repeat

if hat + (maxy div 24) >= maxy then

begin

hat := maxy

end

else

begin

hat := hat + (maxy div 24);

end;

if hal + (maxx div 24) >= maxx then

begin

hal := maxx

end

else

begin

hal := hal + (maxx div 24);

end;

hak := (Sender as TForm).Left + ((Sender as TForm).Width div 2) - (hal div 2);

haa := (Sender as TForm).Top + ((Sender as TForm).Height div 2) - (hat div 2);

MyCanvas.Rectangle(hak, haa, hak + hal, haa + hat);

delay(10);

until (hal = maxx) and (hat = maxy);

(Sender as TForm).Show;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

animin(form2);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

animin(form3);

end;