Programlama yapalım ve Öğrenelim.

Sorgudan tabloya veri aktarımı

Bir sorgu neticesinde elde edilen veriler, bu fonksiyon kullanılarak, mevcut bir tabloya aktarılabilir.

Procedure DBAddQueryToTable(

DataSet : TQuery;

const

DestDatabaseName,

DestinationTable: string);

var

DTable : TTable;

BMove : TBatchMove;

begin

DTable := TTable.Create(nil);

BMove := TBatchMove.Create(nil);

Try

DataSet.Active := True;

DTable.DatabaseName := DestDatabaseName;

DTable.TableName := DestinationTable;

DTable.Active := True;

BMove.AbortOnKeyViol := False;

BMove.AbortOnProblem := False;

BMove.ChangedTableName := 'CTable';

BMove.Destination := DTable;

BMove.KeyViolTableName := 'KTable';

BMove.Mode := batAppend;

BMove.ProblemTableName := 'PTable';

BMove.Source := DataSet;

BMove.Execute;

Finally

DTable.Active := False;

DTable.Free;

BMove.Free;

End;

Tablodaki bir alana ait verilerin, başka bir alana kopyalanması

Bir tabloda bulunan alanlardan bir içerisinde bulunan veriler, başka bir alana kopyalanacağı zaman, aşağıdaki fonksiyon kullanılabilir.

function DBCopyFieldAToB(

DatabaseName,

TableName,

SourceField,

DestField: String): Boolean;

var

Query : TQuery;

CursorWas : TCursor;

Sess : TSession;

begin

CursorWas := Screen.Cursor;

Sess := DBSessionCreateNew;

Sess.Active := True;

Query := TQuery.Create(sess);

Query.SessionName := Sess.SessionName;

Sess.Active := True;

Query.Active := False;

Query.RequestLive := True;

try

Result := False;

Query.DatabaseName := DatabaseName;

Query.SQL.Clear;

Query.SQL.Add('Select ');

Query.SQL.Add(SourceField+',');

Query.SQL.Add(DestField);

Query.SQL.Add('From '+TableName);

Query.Open;

Query.First;

While Not Query.EOF Do

Begin

ProgressScreenCursor;

Try

Query.Edit;

Query.FieldByName(DestField).AsString :=

Query.FieldByName(SourceField).AsString;

Query.Post;

Except

End;

Query.Next;

End;

Result := True;

finally

Query.Free;

Screen.Cursor := CursorWas;

Sess.Active := False;

end;

Tablo kopyalama

Bir tablo olduğu gibi , başka bir veri tabanına veya aynı veri tabanına kopyalanabilir. <DestTable> isimli bir tablo mevcutsa, eskisi silinir.. Bu fonksiyon oldukça güçlü bir veri taşıma aracıdır. Tablolar, BDE tarafından desteklenen, herhangi bir veri tabanı ortamından, başka bir veri tabanı ortamına kopyalanabilir. Aşağıdaki örnekte, "DBDemos" veri tabanındaki "Customer.db" isimli tablo, "Sybase" veri tabanına kopyalanmaktadır.,

Tablo yapısı, <SourceTable> tablosundan alınmak suretiyle, karşı tarafta yeni bir tablo yaratılmaktadır. Tarafların, lokalde veya uzakta olmaları farketmez. Eğer karşı tarafta aynı adı taşıyan bir tablo varsa, silinir ve yerine yenisi yaratılır.

Function DBCreateTableBorrowStr(

SourceDatabaseName : String;

SourceTableName : String;

DestDatabaseName : String;

DestTableName : String): Boolean;

Var

S : TTable;

D : TTable;

i,j : Integer;

IMax : Integer;

IndexName : String;

IndexFields : String;

IndexFields2 : String;

Q : TQuery;

IDXO : TIndexOptions;

Begin

S := TTable.Create(nil);

D := TTable.Create(nil);

Try

S.Active := False;

S.DatabaseName := SourceDatabaseName;

S.TableName := SourceTableName;

S.TableType := ttDefault;

S.Active := True;

D.DatabaseName := DestDatabaseName;

D.TableName := DestTableName;

D.TableType := ttDefault;

D.FieldDefs.Assign(S.FieldDefs);

D.CreateTable;

{Similar method could be used to create the indices}

{D.IndexDefs.Assign(S.IndexDefs);}

S.IndexDefs.Update;

D.IndexDefs.Update;

D.IndexDefs.Clear;

D.IndexDefs.Update;

For i := 0 To S.IndexDefs.Count - 1 Do

Begin

If Pos('.DB',UpperCase(DestTableName)) > 0 Then

Begin

{Paradox or DBase Tables}

If S.IndexDefs.Items[i].Name = '' Then

Begin

If Pos('.DB',UpperCase(DestTableName)) = 0 Then

Begin

IndexName := DestTableName+IntToStr(i);

End

Else

Begin

IndexName := '';

End;

End

Else

Begin

IndexName := DestTableName+IntToStr(i);

End;

IndexFields := S.IndexDefs.Items[i].Fields;

D.AddIndex(IndexName,IndexFields,

S.IndexDefs.Items[i].Options);

D.IndexDefs.Update;

End

Else

Begin

{Non Local Tables}

Q := TQuery.Create(nil);

Try

S.IndexDefs.Update;

D.IndexDefs.Update;

D.IndexDefs.Clear;

D.IndexDefs.Update;

IMax := S.IndexDefs.Count - 1;

For j := 0 To IMax Do

Begin

Q. Active := False;

Q.DatabaseName := DestDatabaseName;

IndexName := DestTableName+IntToStr(i);

IndexFields := S.IndexDefs.Items[i].Fields;

IndexFields2 :=

ReplaceCharInString(IndexFields,';',',');

Q.SQL.Clear;

Q.SQL.Add('Create');

If ixUnique in S. IndexDefs.Items[j].Options

Then Begin

Q.SQL.Add('Unique');

End;

If ixDescending in S.IndexDefs.Items[j].Options

Then Begin

Q.SQL.Add('Desc');

End

Else

Begin

Q.SQL.Add('Asc');

End;

Q.SQL.Add('Index');

Q.SQL.Add(IndexName);

Q.SQL.Add('On');

Q.SQL.Add(DestTableName);

Q.SQL.Add('(');

Q.SQL.Add(IndexFields2);

Q.SQL.Add(')');

Try

Q.ExecSql;

D.IndexDefs.Update;

D.AddIndex(IndexName,IndexFields,

S.IndexDefs.Items[j].Options);

D.IndexDefs.Update;

Except

On E : EDBEngineError Do

Begin

If E.Message = 'Invalid array of index

descriptors.'

Then Begin

Try

D.IndexDefs.Update;

D.DeleteIndex(IndexName);

D.IndexDefs.Update;

Except

End;

End

Else

Begin

Try

D.IndexDefs.Update;

IDXO := D.IndexDefs.Items[j].Options;

Except

End;

//i:= IMax;

Finally

Q.Free;

End;

S.Active := False;

Result := True;

Finally

S.Free;

D.Free;

End;

Except

On E : Exception Do

Begin

ShowMessage('DBCreateTableBorrowStr Error: '+E.Message);

Result := False;

End;

Tablo silme

Herhangi bir veri tabanından tablo silmek gerektiğinde, aşağıdaki fonksiyon kullanılabilir.

Function DBDropTable(const DatabaseName, TableName : string):Boolean;

var Query : TQuery;

begin

Result := False;

If Not IsTable(DatabaseName, TableName) Then

Begin

Exit;

End;

Query := TQuery.Create(nil);

try

Query.DatabaseName := DatabaseName;

Query.SQL.Clear;

Query.SQL.Add('Drop Table ');

If (Pos('.DB', UpperCase(TableName)) > 0) Or

(Pos('.DBF',UpperCase(TableName)) > 0) Then

Begin

Query.Sql.Add('"'+TableName+'"');

End

Else

Begin

Query.Sql.Add(TableName);

End;

Result := True;

Try

Query.ExecSQL;

Except

Result := False;

End;

finally

Query.Free;

end;

Alan adının bulunması

Sıra numarası verilen bir tablo alanının alan adı bu fonksiyonla alınabilir.

Function DBFieldNameByNo(

DatabaseName : String;

TableName : String;

FieldNo : Integer): String;

Var

Table : TTable;

Begin

Result := '';

If Not IsTable(DatabaseName, TableName) Then Exit;

If FieldNo < 0 Then Exit;

If FieldNo >= DBNFields(DatabaseName, TableName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

Result := Table.FieldDefs[FieldNo].Name;

Except

End;

Finally

Table.Free;

End;

Ortak alan isimleri

Bu fonksiyonda, her iki tabloda da mevcut olan alan isimleri, aralarına konan virgüllerle ayrılmış olarak dönerler.

Function DBFieldNamesCommonToString(

DatabaseName1 : String;

TableName1 : String;

DatabaseName2 : String;

TableName2 : String): String;

Var

List1 : TStringList;

List2 : TStringList;

i : Integer;

Suffix: String;

Begin

Result := '';

List1 := TStringList.Create();

List2 := TStringList.Create();

Try

DBFieldNamesToTStrings(

DatabaseName1,

TableName1,

List1);

For i := 0 To List1.Count - 1 Do

Begin

List1[i] := UpperCase(List1[i]);

End;

DBFieldNamesToTStrings(

DatabaseName2,

TableName2,

List2);

For i := 0 To List2.Count - 1 Do

Begin

List2[i] := UpperCase(List2[i]);

End;

For i := 0 To List1.Count - 1 Do

Begin

If Result = '' Then

Begin

Suffix := '';

End

Else

Begin

Suffix := ', ';

End;

If List2.IndexOf(List1[i]) <> -1 Then

Begin

Result := Result + Suffix + List1[i];

End;

Finally

List1.Free;

List2.Free;

End;

Tablodaki alan isimleri

Bu fonksiyon, tablodaki alanlara ait isimleri, bir Tstrings nesnesi içerisine doldurur.

Function DBFieldNamesToTStrings(

DatabaseName : String;

TableName : String;

Strings : TStrings): Boolean;

Var

Table : TTable;

FieldNo : Integer;

Begin

Result := False;

If Not IsTable(DatabaseName, TableName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

Strings.Clear;

For FieldNo := 0 To Table.FieldDefs.Count -1 Do

Begin

Strings.Add(Table.FieldDefs[FieldNo].Name);

End;

Result := True;

Except

End;

Finally

Table.Free;

End;

Alan numarası

Bu fonksiyon, adı bilinen bir alanın, tablo içerisindeki sırasını bulur.

Function DBFieldNo(DatabaseName, TableName, FieldName: String): Integer;

Var

Table : TTable;

FieldIndex : Integer;

FieldNumber: Integer;

Begin

Result := -1;

If Not IsTable(DatabaseName, TableName) Then Exit;

If Not IsField(DatabaseName, TableName, FieldName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

FieldIndex :=

Table.FieldDefs.IndexOf(FieldName);

FieldNumber :=

Table.FieldDefs[FieldIndex].FieldNo;

Result := FieldNumber;

Except

End;

Finally

Table.Free;

End;

Alan uzunluğu

Tablo içerisindeki bir alanın, uzunluğu, bu fonksiyon ile bulunur.

Function DBFieldSize(DatabaseName, TableName, FieldName: String): Integer;

Var

Table : TTable;

FieldIndex : Integer;

FieldSize : Integer;

Begin

Result := 0;

If Not IsTable(DatabaseName, TableName) Then Exit;

If Not IsField(DatabaseName, TableName, FieldName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

FieldIndex :=

Table.FieldDefs.IndexOf(FieldName);

FieldSize :=

Table.FieldDefs[FieldIndex].Size;

Result := FieldSize;

Except

End;

Finally

Table.Free;

End;

Alan tipleri

Adı bilinen bir alanın tipini bulmak için aşağıdaki fonksiyon kullanılabilir.

Function TypeField(DatabaseName, TableName, FieldName: String): String;

Var

Table : TTable;

FieldIndex : Integer;

FieldType : TFieldType;

Begin

Result := '';

If Not IsTable(DatabaseName, TableName) Then Exit;

If Not IsField(DatabaseName, TableName, FieldName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

FieldIndex :=

Table.FieldDefs.IndexOf(FieldName);

FieldType :=

Table.FieldDefs[FieldIndex].DataType;

If FieldType=ftUnknown Then Result := 'Unknown';

If FieldType=ftString Then Result := 'String';

If FieldType=ftSmallInt Then Result := 'SmallInt';

If FieldType=ftInteger Then Result := 'Integer';

If FieldType=ftWord Then Result := 'Word';

If FieldType=ftBoolean Then Result := 'Boolean';

If FieldType=ftFloat Then Result := 'Float';

If FieldType=ftCurrency Then Result := 'Currency';

If FieldType=ftBCD Then Result := 'BCD';

If FieldType=ftDate Then Result := 'Date';

If FieldType=ftTime Then Result := 'Time';

If FieldType=ftDateTime Then Result := 'DateTime';

If FieldType=ftBytes Then Result := 'Bytes';

If FieldType=ftVarBytes Then Result := 'VarBytes';

If FieldType=ftBlob Then Result := 'Blob';

If FieldType=ftMemo Then Result := 'Memo';

If FieldType=ftGraphic Then Result := 'Graphic';

{$IFDEF WIN32}

If FieldType=ftAutoInc Then Result := 'AutoInc';

If FieldType=ftFmtMemo Then Result := 'FmtMemo';

If FieldType=ftParadoxOle Then Result := 'ParadoxOle';

If FieldType=ftDBaseOle Then Result := 'DBaseOle';

If FieldType=ftTypedBinary Then Result := 'TypedBinary';

{$ENDIF}

Except

End;

Finally

Table.Free;

End;

Yukarıdaki fonksiyon ile aynı işleve sahip bir fonksiyondur. Fakat fonksiyona alan adı değil, sıra numarası verilir.

Function DBFieldTypeByNo(DatabaseName, TableName: String; FieldNo: Integer): String;

Var

Table : TTable;

FieldIndex : Integer;

FieldType : TFieldType;

Begin

Result := '';

If Not IsTable(DatabaseName, TableName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

FieldIndex := FieldNo;

Try

FieldType :=

Table.FieldDefs[FieldIndex].DataType;

Except

FieldType := ftUnknown;

End;

{TFieldType Possible values are

ftUnknown, ftString, ftSmallint,

ftInteger, ftWord, ftBoolean,

ftFloat, ftCurrency, ftBCD, ftDate,

ftTime, ftDateTime, ftBytes, ftVarBytes,

ftBlob, ftMemo or ftGraphic}

If FieldType=ftUnknown Then Result := 'Unknown';

If FieldType=ftString Then Result := 'String';

If FieldType=ftSmallInt Then Result := 'SmallInt';

If FieldType=ftInteger Then Result := 'Integer';

If FieldType=ftWord Then Result := 'Word';

If FieldType=ftBoolean Then Result := 'Boolean';

If FieldType=ftFloat Then Result := 'Float';

If FieldType=ftCurrency Then Result := 'Currency';

If FieldType=ftBCD Then Result := 'BCD';

If FieldType=ftDate Then Result := 'Date';

If FieldType=ftTime Then Result := 'Time';

If FieldType=ftDateTime Then Result := 'DateTime';

If FieldType=ftBytes Then Result := 'Bytes';

If FieldType=ftVarBytes Then Result := 'VarBytes';

If FieldType=ftBlob Then Result := 'Blob';

If FieldType=ftMemo Then Result := 'Memo';

If FieldType=ftGraphic Then Result := 'Graphic';

Except

End;

Finally

Table.Free;

End;

Tablonun anahtar alanları

Bir tabloda, anahtar olarak kullanılan alanlar, Tstrings nesnesine doldurulur.

Function DBKeyFieldNamesToTStrings(

DatabaseName : String;

TableName : String;

Strings : TStrings): Boolean;

Var

Table : TTable;

FieldNo : Integer;

Begin

Result := False;

If Not IsTable(DatabaseName, TableName) Then Exit;

Table := TTable.Create(nil);

Try

Table.Active := False;

Table.DatabaseName := DatabaseName;

Table.TableName := TableName;

Table.Active := True;

Strings.Clear;

For FieldNo := 0 To Table.FieldDefs.Count -1 Do

Begin

If IsFieldKeyed(

DatabaseName,

TableName,

Table.FieldDefs[FieldNo].Name) Then

Begin

Strings.Add(Table.FieldDefs[FieldNo].Name);

End;

Result := True;

Except

End;

Finally

Table.Free;

End;

LookUp yöntemiyle değer seçme diyaloğu

Kullanıcıya bir LookUp diyaloğu gösterip, seçtiği değeri döndüren bir fonksiyondur. Eğer kullanıcı "Cancel" butonuna basarsa, boş bir karakter dizisi döner.

Function DialogLookupDetail(

Const DialogCaption : string;

Const InputPrompt : string;

Const DefaultValue : string;

Const Values : TStringList;

Const ButtonSpacing : Integer;

Const SpacerHeight : Integer;

Const TopBevelWidth : Integer;

Const PromptHeight : Integer;

Const FormHeight : Integer;

Const FormWidth : Integer;

Const Hint_OK : string;

Const Hint_Cancel : string;

Const Hint_ListBox : string;

Const ListSorted : Boolean;

Const AllowDuplicates : Boolean

): string;

Var

Form : TForm;

Base_Panel : TPanel;

Base_Buttons : TPanel;

Spacer : TPanel;

Base_Top : TPanel;

ButtonSlider : TPanel;

ButtonSpacer : TPanel;

Prompt : TPanel;

ListBox : TListBox;

ButtonCancelB: TPanel;

ButtonOKB : TPanel;

Button_Cancel: TButton;

Button_OK : TButton;

DefItemIndex : Integer;

TempValues : TStringList;

Begin

Result := DefaultValue;

Form := TForm.Create(Application);

TempValues := TStringList.Create();

Try

TempValues.Sorted := ListSorted;

TempValues.Clear;

If AllowDuplicates Then

Begin

TempValues.Duplicates := dupAccept;

End

Else

Begin

TempValues.Duplicates := dupIgnore;

End;

If Values <> nil Then

Begin

TempValues.Assign(Values);

End;

With Form Do

Begin

Try

Canvas.Font := Font;

BorderStyle := bsSizeable;

Caption := DialogCaption;

Height := FormHeight;

Width := FormWidth;

ShowHint := True;

Position := poScreenCenter;

BorderIcons := [biMaximize];

Base_Panel := TPanel.Create(Form);

With Base_Panel Do

Begin

Parent := Form;

Align := alClient;

Caption := ' ';

BorderWidth := 10;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

End;

Base_Buttons := TPanel.Create(Form);

With Base_Buttons Do

Begin

Parent := Base_Panel;

Align := alBottom;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Height := 27;

End;

ButtonSlider := TPanel.Create(Form);

With ButtonSlider Do

Begin

Parent := Base_Buttons;

Align := alClient;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

End;

ButtonCancelB := TPanel.Create(Form);

With ButtonCancelB Do

Begin

Parent := ButtonSlider;

Align := alRight;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Width := 75+ButtonSpacing;

End;

ButtonSpacer := TPanel.Create(Form);

With ButtonSpacer Do

Begin

Parent := ButtonCancelB;

Align := alLeft;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Width := ButtonSpacing;

End;

ButtonOKB := TPanel.Create(Form);

With ButtonOKB Do

Begin

Parent := ButtonSlider;

Align := alRight;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Width := 75;

End;

Spacer := TPanel.Create(Form);

With Spacer Do

Begin

Parent := Base_Panel;

Align := alBottom;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Height := SpacerHeight;

End;

Base_Top := TPanel.Create(Form);

With Base_Top Do

Begin

Parent := Base_Panel;

Align := alClient;

Caption := ' ';

BorderWidth := 10;

BorderStyle := bsNone;

BevelOuter := bvRaised;

BevelInner := bvNone;

BevelWidth := TopBevelWidth;

End;

Prompt := TPanel.Create(Form);

With Prompt Do

Begin

Parent := Base_Top;

Align := alTop;

Caption := ' ';

BorderWidth := 0;

BorderStyle := bsNone;

BevelOuter := bvNone;

BevelInner := bvNone;

Caption := InputPrompt;

Height := PromptHeight;

Alignment := taCenter;

End;

Button_Cancel := TButton.Create(Form);

With Button_Cancel Do

Begin

Parent := ButtonCancelB;

Caption := 'Cancel';

ModalResult := mrCancel;

Default := True;

Align := alClient;

Hint := Hint_Cancel;

End;

Button_OK := TButton.Create(Form);

With Button_OK Do

Begin

Parent := ButtonOKB;

Caption := 'OK';

ModalResult := mrOK;

Default := False;

Align := alClient;

Hint := Hint_OK;

End;

ListBox := TListBox.Create(Form);

With ListBox Do

Begin

Parent := Base_Top;

Align := alClient;

Hint := Hint_ListBox;

Sorted := ListSorted;

Focused;

If TempValues <> nil Then

Begin

Items.Assign(TempValues);

DefItemIndex := Items.IndexOf(DefaultValue);

If DefItemIndex <> -1 Then

Begin

ItemIndex := DefItemIndex;

Selected[DefItemIndex];

End

Else

Begin

Result := '';

ItemIndex := 0;

Selected[0];

End;

IntegralHeight := True;

Button_OK.Default := True;

Button_Cancel.Default := False;

End

Else

Begin

Result := '';

End;

SetFocusedControl(ListBox);

If ShowModal = mrOk Then

Begin

If ListBox.ItemIndex<>-1 Then

Result := ListBox.Items[ListBox.ItemIndex];

End;

Finally

Form.Free;

End;

Finally

TempValues.Free;

End;