Programlama yapalım ve Öğrenelim.

DBGridde bir kolonunda bulunan veriye göre renklendirmek için.

//Hostun_Turu.Text = 'Windows' OLAN SATIRI RENK VER

//DBGrid4 dün DrawColumnCell kısmına bu kodu yazmalısın.

var

Renk:Tcolor;

begin

if Table4Hostun_Turu.Text = 'Windows' then

Begin

Renk:=DBGrid4.Canvas.Brush.color;

DBGrid4.Canvas.Brush.Color:=$000000EA;//clInactiveCaptionText;

DBGrid4.Canvas.Font.Color:=clWhite;//clNavy;

DBGrid4.DefaultDrawColumnCell(Rect,Datacol,column,state);

DBGrid4.Canvas.Brush.Color:=Renk;

Renk:=DBGrid4.Canvas.Brush.color;

End;

end;

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

Windows tarihini unixe çevirme

// Unix zaman değerini Datetimepicker e aktarma.

// Windows zaman değerini Unix zaman değerine aktarma.

// Saygılar.. ozgur@serveturk.com

unit unix_utils;

interface

implementation

const

// Unix baslangic saatini 01/01/1970 olarak ayarla

UnixStartDate: TDateTime = 25569.0;

function DateTimeToUnix(ConvDate: TDateTime): Longint;

begin

//Ornek DateTimeToUnix(now);

Result := Round((ConvDate - UnixStartDate) * 86400);

end;

function UnixToDateTime(USec: Longint): TDateTime;

begin

//Ornek: UnixToDateTime(1003187418);

Result := (Usec / 86400) + UnixStartDate;

end;

end.

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

MD5 .NET Delphi

Uses system.Security.Cryptography,System.Text;

Function GetMD5(const input:string):String;

Var

hashedBytes : array of Byte;

md5Hasher : MD5;

Begin

md5Hasher := MD5CryptoServiceProvider.Create;

hashedBytes := md5Hasher.ComputeHash(Encoding.Default.GetBytes(input));

Result := BitConverter.ToString(hashedBytes);

Result := Result.Replace('-',System.String.Empty);

End;

//ercumentsari@gmail.com

Delphi.NET - .....................................

cicekci programı(open source)

gecici bi sure için kaldırılmıştır...

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

SModem

unit SModem;

interface

uses

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

Registry, FileCtrl;

Const

{Hope we do not have more than 10 modems attached}

MAX_COM = 10;

DEFAULTDEBUGPATH = '.debug.txt';

NOREGENUM = -2;

NOERROR = 0;

NOMODEM = 0;

type

{ This structures copies what is stored in the registry

for a modem. }

TModemInfo = record

ModemIsThere: boolean;

Classtype : string;

CompatibleIDs: string;

ConfigFlags: TRegdataInfo;

DeviceDesc: string;

Driver: string;

FriendlyName: string;

HardwareID: string;

Mfg: string;

PORTNAME: string;

end;

EOutOfRange = class(EListError);

TSenseModem = class(TComponent)

private

{This array kepts all info on modems}

FModemArray: array[1..MAX_COM] of TModemInfo;

FDebugFile: Boolean;

FDebugFilePath: string;

FError: Integer;

FModemCount: Integer;

procedure CheckKeyForModem;

procedure SetEmpty;

protected

procedure SetDebugPath(path:string);

public

constructor Create( AOwner: TComponent); override;

destructor Destroy; override;

function FindModem: Integer;

function GetFirst: TModemInfo;

function GetLast: TModemInfo;

function Get(modem_number:integer): TModemInfo;

function GetError: String;

published

property DebugFile : boolean read FDebugFile write FDebugFIle default False;

property DebugFilePath : string read FDebugFilePath write SetDebugPath;

function InternalFindModem(StartLocation: string): Integer;

end;

procedure Register;

Var

Debug_file:TextFile;

RegistryEntries: TRegistry;

implementation

{ Default constructor

Initial variable ssetup }

constructor TSenseModem.Create( AOwner: Tcomponent);

begin

inherited Create( AOwner);

DebugFile := False;

DebugFilePath := FDebugFilePath;

FError := NOERROR;

FModemCount := 0;

RegistryEntries := TRegistry.Create;

end;

{ Default Destructor }

destructor TSenseModem.Destroy;

begin

RegistryEntries.Free;

end;

{ Set all info structure to intial empty

state}

procedure TSenseModem.SetEmpty;

Var i: integer;

begin

for i:=1 to MAX_COM do

begin

FModemArray[i].ModemIsThere := False;

FModemArray[i].Classtype := '';

FModemArray[i].CompatibleIDs := '';

FModemArray[i].DeviceDesc := '';

FModemArray[i].Driver := '';

FModemArray[i].FriendlyName := '';

FModemArray[i].HardwareID := '';

FModemArray[i].Mfg := '';

FModemArray[i].PORTNAME := '';

end;

{Check to see if the debug file path exists.

If it does not then setup the default path}

procedure TSenseModem.SetDebugPath(path:string);

begin

if (DirectoryExists(ExtractFilePath(path))) then

FDebugFilePath := path

else

FDebugFilePath := DEFAULTDEBUGPATH;

end;

{Get info on requested modem}

function TSenseModem.Get(modem_number:integer): TModemInfo;

begin

{ Error out if number requested is > max }

{ Note: We always return a info structure even if it is

empty. The ModemIsThere field should be used by

the user to double check to see if there is real

info.}

if (modem_number > MAX_COM) then

raise EOutOfRange.CreateFmt('Input into "Get" function out of range',[modem_number])

else

Get := FModemArray[modem_number];

end;

{ Get info on the first modem found }

function TSenseModem.GetFirst: TModemInfo;

begin

GetFirst := FModemArray[1];

end;

{ Get info on last modem found }

function TSenseModem.GetLast: TModemInfo;

begin

GetLast := FModemArray[FModemCount];

end;

{Get string explanation of error code returned

by findmodem}

function TSenseModem.GetError: String;

begin

case FError of

NOERROR: GetError := '';

NOREGENUM: GetError:= 'Registry key ENUM could not be opened.';

end;

function TSenseModem.FindModem:integer;

begin

{ Set stuff to inital }

{ Yes this may be have already been done in the constructor }

FError := NOERROR;

FModemCount := 0;

{ Set Root key to HKEY_LOCAL_MACHINE }

RegistryEntries.RootKey := HKEY_LOCAL_MACHINE;

{ Open debug file if it exists}

if (DebugFile) then

begin

AssignFile(Debug_file,DebugFilePath);

Rewrite(Debug_file);

end;

{ Set everyone to false}

SetEmpty;

{Modem should be in Enum/ISAPNP}

if (RegistryEntries.keyExists('Enum')) then

RegistryEntries.OpenKey('Enum',False)

else

begin

{This tells us that for somereason we could not

open the registry}

FindModem := NOREGENUM;

FError := NOREGENUM;

exit;

end;

{ Find them }

InternalFindModem('ISAPNP');

{ Return count }

FindModem := FModemCount;

{ Close Debug file if it exists}

if (DebugFile) then

CloseFile(Debug_file);

RegistryEntries.CloseKey;

end;

procedure TSenseModem.CheckKeyForModem;

begin

{ Look for Class Value in current key }

if (registryEntries.ValueExists('Class') and

(FModemCount < MAX_COM) ) then

begin

{ Check for Modem class }

if (registryEntries.ReadString('Class') = 'Modem') then

begin

FModemCount := FModemCount + 1;

FModemArray[FModemCount].ModemIsThere := True;

{Start Filling Modem Structure }

FModemArray[FModemCount].Classtype := registryEntries.ReadString('Class');

if (registryEntries.ValueExists('CompatibleIDs') and

(registryEntries.GetDataType('CompatibleIDs') = rdString) ) then

FModemArray[FModemCount].CompatibleIDs :=

(registryEntries.ReadString('CompatibleIDs'))

else

FModemArray[FModemCount].CompatibleIDs := ' ';

if (registryEntries.ValueExists('DeviceDesc') and

(registryEntries.GetDataType('DeviceDesc') = rdString) ) then

FModemArray[FModemCount].DeviceDesc :=

(registryEntries.ReadString('DeviceDesc'))

else

FModemArray[FModemCount].DeviceDesc := ' ';

if (registryEntries.ValueExists('Driver') and

(registryEntries.GetDataType('Driver') = rdString) ) then

FModemArray[FModemCount].Driver :=

(registryEntries.ReadString('Driver'))

else

FModemArray[FModemCount].Driver := ' ';

if (registryEntries.ValueExists('FriendlyName') and

(registryEntries.GetDataType('FriendlyName') = rdString) ) then

FModemArray[FModemCount].FriendlyName :=

(registryEntries.ReadString('FriendlyName'))

else

FModemArray[FModemCount].FriendlyName := ' ';

if (registryEntries.ValueExists('HardwareID') and

(registryEntries.GetDataType('HardwareID') = rdString) ) then

FModemArray[FModemCount].HardwareID :=

(registryEntries.ReadString('HardwareID'))

else

FModemArray[FModemCount].HardwareID := ' ';

if (registryEntries.ValueExists('Mfg') and

(registryEntries.GetDataType('Mfg') = rdString) ) then

FModemArray[FModemCount].Mfg :=

(registryEntries.ReadString('Mfg'))

else

FModemArray[FModemCount].Mfg := ' ';

if (registryEntries.ValueExists('PORTNAME') and

(registryEntries.GetDataType('PORTNAME') = rdString) ) then

FModemArray[FModemCount].PORTNAME :=

(registryEntries.ReadString('PORTNAME'))

else

FModemArray[FModemCount].PORTNAME := ' ';

if (registryEntries.ValueExists('ConfigFlags')) then

registryEntries.GetDataInfo('ConfigFlags',

FModemArray[FModemCount].ConfigFlags);

end;

if (FDebugFile) then

writeln(Debug_file,'Found a Match -> ' +

FModemArray[FModemCount].FriendlyName);

end;

{This function does all the work. It uses recusion to walk

through the tree structure,of the registry looking, for Modem

Classes.}

function TSenseModem.InternalFindModem(StartLocation: string):integer;

var i,j,k: integer;

Alist: TstringList;

Alist2:TstringList;

Valuelist: TstringList;

currentPath:String;

myPath :String;

begin

{ Create all }

Alist := TstringList.Create;

Alist2 := TstringList.Create;

ValueList := TstringList.Create;

{Open key at current position}

RegistryEntries.OpenKey(StartLocation,False);

{Get the current path in registry }

myPath := registryEntries.currentPath;

if (FDebugFile) then

begin

writeln(Debug_file,'* Starting FindModem with Key ' + StartLocation);

writeln(Debug_file,'* Current Path ' + myPath);

end;

{ Get the value list for this key }

RegistryEntries.GetValueNames(ValueList);

{ Look for "Modem" class in value list}

CheckKeyForModem;

{ Now look for sub keys}

if (RegistryEntries.HasSubKeys) then

begin

{ Get a list of sub keys}

RegistryEntries.GetKeyNames(Alist);

{ Walk through sub keys looking for Modem classes }

for i:= 0 to (AList.Count-1) do

begin

if (FDebugFile) then

writeln(Debug_file,' -> Calling FindModem with ' + AList.Strings[i] +

' Count ' + Inttostr(i));

{ Call myself to check subkeys }

{ This is the neat call }

InternalFindModem(AList.Strings[i]);

{ Back up the tree to original path }

RegistryEntries.CloseKey();

RegistryEntries.OpenKey(myPath,False);

end;

end

else { Need to check first key for modem class}

CheckKeyForModem;

{ Free All }

Alist.Free;

Alist2.Free;

ValueList.Free;

end;

procedure Register;

begin

RegisterComponents('System', [TSenseModem]);

end;

end.

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

ASMSample

unit ASMSample;

interface

uses Windows;

type

TExpData = DWord;

function EncodeExpData(

const UseRemLogins: LongBool; // Must use LongBool for some reason I don't know

const RemLogins, Year, Month, Day: Integer): TExpData;

procedure DecodeExpData(

const Data: TExpData;

var UseRemLogins: LongBool;

var RemLogins, Year, Month, Day: Integer);

implementation

function EncodeExpData(

const UseRemLogins: LongBool; // Must use LongBool for some reason I don't know

const RemLogins, Year, Month, Day: Integer): TExpData;

{

This procedure places the parameters into one DWord:

.----------------------------------++--------------------------------.

| MSW || LSW |

|--.----------------------.--------++----------.---------------------|

|* | remaining logins | Day || Month | Year |

|--+----------------------+--------++----------+---------------------|

|31|30 21|20 16||15 12|11 0|

'--'----------------------'--------''----------'---------------------'

*) UseRemLogins

On start is:

EAX UseRemLogins ok

ECX Year ok

EDX RemLogins

SS:[ESP+8] Day

SS:[ESP+12] Month

At return EAX holds the result

}

asm

{ we need to save some registers at first

(if we won't do so delphi would give us some access violations) }

PUSHF

PUSH EBX

{ if RemainingLogins > 1023 set RemaingLogins to 1023 }

CMP EDX, 1023

JBE @@1

MOV EDX, 1023

@@1:

{ copy the UseRemLogins to the first bit of EAX }

XOR EBX,EBX { set EBX to 0 }

CMP EAX,0

SETNE BL { set BL to 1 if UseRemainingLogins is True (<>0) }

PUSH EBX { copy EBX... }

POP EAX { ... to EAX }

SHL EAX,31 { move the set bit to bit 31 }

AND ECX,0FFFh { remember, ECX is Years parameter until we change it }

OR EAX,ECX { copy the lowest 3 halfbytes (rem.: we masked) of ECX into EAX }

SHL EDX,21 { Shift the the RemainingLogins parameter to the right position }

AND EDX,7FE00000h { Mask the unwanted part out }

OR EAX,EDX { copy the remaining bits into the result (EAX) }

MOV EBX,Month { EBX holds now the Month parameter }

MOV EDX,Day { EDX holds now the Day parameter }

SHL EBX,12 { Shift EBX (now the month) to the right position to merge }

SHL EDX,16 { Shift EDX (now the day) to the right position }

AND EBX,0F000h { mask out the unwanted bits }

AND EDX,1F0000h { " " }

OR EAX,EBX { merge result with the month }

OR EAX,EDX { merge result with the day }

{ finally we want to restore the saved registers }

POP EBX

POPF

{

now we did it. If you have questions or suggestions to optimize this code

feel free to mail me at: socke-99@gmx.de

But: I am not here to teach you assembly language!

}

end;

procedure DecodeExpData(

const Data: TExpData;

var UseRemLogins: LongBool;

var RemLogins, Year, Month, Day: Integer);

{ it the EncodeExpData function is warp 10 this is warp 8 }

asm

{ save registers }

PUSH EBX

AND dword ptr[EDX], 0 { UseRemLogins := 0 }

BT EAX,31 { if bit 31 of Data is set then ... }

SETC byte ptr[EDX] { ... UseRemLogins := True else UseRemLogins := False }

{ figure out RemLogins }

PUSH EAX { copy EAX ... }

POP EBX { ... to EBX }

AND EBX,7FE00000h { mask out all bits not belonging to RemLogins }

SHR EBX,21 { Shift EBX to the right position }

PUSH EBX { copy EBX ... }

POP dword ptr[ECX] { ... to RemLogins }

//now all X-registers except EAX are free to juggle with

PUSH EAX

POP EBX

AND EBX,0FFFh { extract bits for Day }

PUSH dword ptr [ebp+16]

POP ECX

MOV dword ptr[ECX],EBX { Day := EBX }

PUSH EAX

POP EBX

AND EBX,0F000h { extract bits for Month }

SHR EBX,12 { shift EBX into right position }

PUSH dword ptr [ebp+12]

POP ECX

MOV dword ptr[ECX],EBX { Month := EBX }

AND EAX,1F0000h { extract bits for Day }

SHR EAX,16 { shift EAX into right position }

PUSH dword ptr [ebp+8]

POP ECX

MOV dword ptr[ECX],EAX { Day := EAX }

{ restore registers }

POP EBX

end;

end.

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

TSpecialFolders component

unit ShellPaths;

interface

uses

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

type

TSpecialFolders = class(TComponent)

private

function getShellPath(nFolder : Integer) : String;

function Get_BitBucket: String;

procedure Set_BitBucket(const Value: String);

function Get_Controls: String;

procedure Set_Controls(const Value: String);

function Get_Desktop: String;

procedure Set_Desktop(const Value: String);

function Get_DesktopDirectory: String;

procedure Set_DesktopDirectory(const Value: String);

function Get_Drives: String;

procedure Set_Drives(const Value: String);

function Get_Fonts: String;

procedure Set_Fonts(const Value: String);

function Get_NetHood: String;

procedure Set_NetHood(const Value: String);

function Get_Network: String;

procedure Set_Network(const Value: String);

function Get_Personal: String;

procedure Set_Personal(const Value: String);

function Get_Printers: String;

procedure Set_Printers(const Value: String);

function Get_Programs: String;

procedure Set_Programs(const Value: String);

function Get_Recent: String;

procedure Set_Recent(const Value: String);

function Get_SendTo: String;

procedure Set_SendTo(const Value: String);

function Get_StartMenu: String;

procedure Set_StartMenu(const Value: String);

function Get_StartUp: String;

procedure Set_Startup(const Value: String);

function Get_Templates: String;

procedure Set_Templates(const Value: String);

{ Private-Deklarationen }

protected

{ Protected-Deklarationen }

public

{ Public-Deklarationen }

published

{ Published-Deklarationen }

property BitBucket : String read Get_BitBucket write Set_BitBucket;

property Controls : String read Get_Controls write Set_Controls;

property Desktop : String read Get_Desktop write Set_Desktop;

property DesktopDirectory : String read Get_DesktopDirectory write Set_DesktopDirectory;

property Drives : String read Get_Drives write Set_Drives;

property Fonts : String read Get_Fonts write Set_Fonts;

property NetHood : String read Get_NetHood write Set_NetHood;

property Network : String read Get_Network write Set_Network;

property Personal : String read Get_Personal write Set_Personal;

property Printers : String read Get_Printers write Set_Printers;

property Programs : String read Get_Programs write Set_Programs;

property Recent : String read Get_Recent write Set_Recent;

property SendTo : String read Get_SendTo write Set_SendTo;

property StartMenu : String read Get_StartMenu write Set_StartMenu;

property Startup : String read Get_StartUp write Set_Startup;

property Templates : String read Get_Templates write Set_Templates;

end;

procedure Register;

implementation

{$R ShellPaths.res}

uses ShlObj, ActiveX, COMObj;

procedure Register;

begin

RegisterComponents('3rdParty', [TSpecialFolders]);

end;

{ TShellPaths }

function TSpecialFolders.getShellPath(nFolder: Integer): String;

var

ppidl : PItemIDList;

szPath : array[0..MAX_PATH] of Char;

// aMalloc : IMalloc;

begin

OleCheck(SHGetSpecialFolderLocation(0, nFolder, ppidl));

SHGetPathFromIDList(ppidl, szPath);

// Der auskommentierte Code entspricht CoTaskMemFree

// OleCheck(SHGetMalloc(aMalloc));

// aMalloc.Free(pIIL);

CoTaskMemFree(ppidl);

Result := szPath;

end;

function TSpecialFolders.Get_Controls: String;

begin

Result := getShellPath(CSIDL_CONTROLS );

end;

function TSpecialFolders.Get_DesktopDirectory: String;

begin

Result := getShellPath(CSIDL_DESKTOPDIRECTORY);

end;

function TSpecialFolders.Get_Fonts: String;

begin

Result := getShellPath(CSIDL_FONTS);

end;

function TSpecialFolders.Get_Drives: String;

begin

Result := getShellPath(CSIDL_DRIVES);

end;

function TSpecialFolders.Get_BitBucket: String;

begin

Result := getShellPath(CSIDL_BITBUCKET);

end;

function TSpecialFolders.Get_Desktop: String;

begin

Result := getShellPath(CSIDL_DESKTOP);

end;

function TSpecialFolders.Get_NetHood: String;

begin

Result := getShellPath(CSIDL_NETHOOD);

end;

function TSpecialFolders.Get_Network: String;

begin

Result := getShellPath(CSIDL_NETWORK);

end;

function TSpecialFolders.Get_Personal: String;

begin

Result := getShellPath(CSIDL_PERSONAL);

end;

function TSpecialFolders.Get_Printers: String;

begin

Result := getShellPath(CSIDL_PRINTERS);

end;

function TSpecialFolders.Get_Programs: String;

begin

Result := getShellPath(CSIDL_PROGRAMS);

end;

function TSpecialFolders.Get_Recent: String;

begin

Result := getShellPath(CSIDL_RECENT);

end;

function TSpecialFolders.Get_SendTo: String;

begin

Result := getShellPath(CSIDL_SENDTO);

end;

function TSpecialFolders.Get_StartMenu: String;

begin

Result := getShellPath(CSIDL_STARTMENU);

end;

function TSpecialFolders.Get_StartUp: String;

begin

Result := getShellPath(CSIDL_STARTUP);

end;

function TSpecialFolders.Get_Templates: String;

begin

Result := getShellPath(CSIDL_TEMPLATES);

end;

procedure TSpecialFolders.Set_Controls(const Value: String);

begin

end;

procedure TSpecialFolders.Set_DesktopDirectory(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Fonts(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Drives(const Value: String);

begin

end;

procedure TSpecialFolders.Set_BitBucket(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Desktop(const Value: String);

begin

end;

procedure TSpecialFolders.Set_NetHood(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Network(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Personal(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Printers(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Programs(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Recent(const Value: String);

begin

end;

procedure TSpecialFolders.Set_SendTo(const Value: String);

begin

end;

procedure TSpecialFolders.Set_StartMenu(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Templates(const Value: String);

begin

end;

procedure TSpecialFolders.Set_Startup(const Value: String);

begin

end;

end.

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

SQLConnectionPanel

unit SQLConnectionPanel;

interface

uses

Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, StdCtrls;

type

TSQLConnectionPanel = class(TPanel)

private

rgLogin: TRadioGroup;

GroupBox1: TGroupBox;

Label3: TLabel;

Label4: TLabel;

eUserName: TEdit;

ePassword: TEdit;

GroupBox2: TGroupBox;

Label1: TLabel;

EserverName: TEdit;

Label2: TLabel;

EdatabaseName: TEdit;

procedure rgLoginClick(Sender: TObject);

function GetUserName: String;

function GetPassword: string;

function GetServerName: string;

function GetDatabaseName: string;

function GetConnectionType: integer;

procedure SetUserName(Value: string);

procedure SetPassword(Value: string);

procedure SetServerName(Value: string);

procedure SetDataBaseName(Value: string);

procedure SetConnectionType(Value: integer);

protected

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure Paint; override;

function GetConnectionString: string;

published

property UserName: String read GetUserName write SetUserName;

property Password: String read GetPassword write SetPassword;

property ServerName: string read GetServerName write SetServerName;

property DatabaseName: String read GetDatabaseName write SetDataBaseName;

property ConnectionType: integer read GetConnectionType write SetConnectionType;

end;

procedure Register;

implementation

uses Dialogs;

procedure Register;

begin

RegisterComponents('DB Connection', [TSQLConnectionPanel]);

end;

{ TConnectionPanel }

constructor TSQLConnectionPanel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

BevelOuter := bvNone;

BevelInner := bvNone;

Align := alClient;

GroupBox2 := TGroupBox.Create(self);

GroupBox2.Parent := Self;

GroupBox2.Caption := '';

GroupBox2.Left := 8;

GroupBox2.Top := 5;

GroupBox2.Width := 169;

GroupBox2.Height := 93;

Label1 := TLabel.Create(GroupBox2);

Label1.Parent := GroupBox2;

Label1.Caption := 'Server';

Label1.Left := 8;

Label1.Top := 12;

Label2 := TLabel.Create(GroupBox2);

Label2.Parent := GroupBox2;

Label2.Caption := 'Data Base';

Label2.Left := 8;

Label2.Top := 49;

EserverName := TEdit.Create(GroupBox2);

EserverName.Parent := GroupBox2;

EserverName.Text := '(local)';

EserverName.Left := 16;

EserverName.Top := 26;

EserverName.Width := 140;

EserverName.Height := 21;

EdatabaseName := TEdit.Create(GroupBox2);

EdatabaseName.Parent := GroupBox2;

EdatabaseName.Text := '';

EdatabaseName.Left := 16;

EdatabaseName.Top := 63;

EdatabaseName.Width := 140;

EdatabaseName.Height := 21;

rgLogin := TRadioGroup.Create(Self);

rgLogin.Parent := Self;

rgLogin.Caption := ' Authorization method ';

rgLogin.Top := 5;

rgLogin.Left := 183;

rgLogin.Width := 193;

rgLogin.Height := 93;

GroupBox1 := TGroupBox.Create(self);

GroupBox1.Parent := Self;

GroupBox1.Caption := ' SQL Server authorization ';

GroupBox1.Left := 8;

GroupBox1.Top := 101;

GroupBox1.Width := 169;

GroupBox1.Height := 84;

Label3 := TLabel.Create(GroupBox1);

Label3.Parent := GroupBox1;

Label3.Caption := 'Login';

Label3.Left := 8;

Label3.Top := 24;

Label3.Enabled := false;

Label4 := TLabel.Create(GroupBox1);

Label4.Parent := GroupBox1;

Label4.Caption := 'Password';

Label4.Left := 8;

Label4.Top := 54;

Label4.Enabled := false;

eUserName := TEdit.Create(GroupBox1);

eUserName.Parent := GroupBox1;

eUserName.Text := 'sa';

eUserName.Left := 61;

eUserName.Top := 18;

eUserName.Width := 100;

eUserName.Height := 21;

eUserName.Enabled := false;

ePassword := TEdit.Create(GroupBox1);

ePassword.Parent := GroupBox1;

ePassword.Text := '';

ePassword.Left := 61;

ePassword.Top := 50;

ePassword.Width := 100;

ePassword.Height := 21;

ePassword.Enabled := false;

ePassword.PasswordChar := '*';

rgLogin.OnClick := rgLoginClick;

Caption := '';

end;

destructor TSQLConnectionPanel.Destroy;

begin

ePassword.Free;

ePassword := nil;

eUserName.Free;

eUserName := nil;

Label4.Free;

Label4 := nil;

Label3.Free;

Label3 := nil;

GroupBox1.Free;

GroupBox1 := nil;

rgLogin.Free;

rgLogin := nil;

EdatabaseName.Free;

EdatabaseName := nil;

EserverName.Free;

EserverName := nil;

Label2.Free;

Label2 := nil;

Label1.Free;

Label1 := nil;

GroupBox2.Free;

GroupBox2 := nil;

inherited;

end;

function TSQLConnectionPanel.GetConnectionString: string;

begin

case ConnectionType of

0: Result := Format('Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=%s;Data Source=%s', [DatabaseName, ServerName]);

1: Result := Format('Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s;Initial Catalog=%s;Data Source=%s', [Password, UserName, DatabaseName, ServerName]);

end;

function TSQLConnectionPanel.GetConnectionType: integer;

begin

Result := rgLogin.ItemIndex;

end;

function TSQLConnectionPanel.GetDatabaseName: string;

begin

Result := EdatabaseName.Text;

end;

function TSQLConnectionPanel.GetPassword: string;

begin

Result := ePassword.Text;

end;

function TSQLConnectionPanel.GetServerName: string;

begin

Result := EserverName.Text;

end;

function TSQLConnectionPanel.GetUserName: String;

begin

Result := eUserName.Text;

end;

procedure TSQLConnectionPanel.Paint;

begin

inherited;

Caption := '';

if rgLogin.Items.Count = 0 then

begin

rgLogin.Items.Add('Windows NT');

rgLogin.Items.Add('SQL Server Login');

ConnectionType := 0;

end;

procedure TSQLConnectionPanel.rgLoginClick(Sender: TObject);

begin

Label3.Enabled := rgLogin.ItemIndex = 1;

Label4.Enabled := rgLogin.ItemIndex = 1;

eUserName.Enabled := rgLogin.ItemIndex = 1;

ePassword.Enabled := rgLogin.ItemIndex = 1;

end;

procedure TSQLConnectionPanel.SetConnectionType(Value: integer);

begin

rgLogin.ItemIndex := Value;

end;

procedure TSQLConnectionPanel.SetDataBaseName(Value: string);

begin

EdatabaseName.Text := Value;

end;

procedure TSQLConnectionPanel.SetPassword(Value: string);

begin

ePassword.Text := Value;

end;

procedure TSQLConnectionPanel.SetServerName(Value: string);

begin

EserverName.Text := Value;

end;

procedure TSQLConnectionPanel.SetUserName(Value: string);

begin

eUserName.Text := Value;

end;

end.

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