Bu unit program "database 2" işleminde kullanılır.
Kod: Tümünü seç
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
Please note if you are viewing this Delphi unit as a web page all you have to
do to turn it into a Delphi unit is save it with a ".pas" extension. The
html in the unit should not affect its performance.
}
Unit Ads_Db;
Description: ads_Db.pas
This unit contains the following routines.
*)
Interface
Uses DBTables, Classes, ExtCtrls, DB;
{!~ Add source table to destination table}
Function AddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Creates a new table from a Query.
Complex joins can be output to a new table.}
Function CreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
{!~ Add source query to destination table}
Procedure DBAddQueryToTable(
DataSet : TQuery;
const
DestDatabaseName,
DestinationTable: string);
{!~ Add source table to destination table}
Function DBAddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Copies Field A To Field B.}
function DBCopyFieldAToB(
DatabaseName,
TableName,
SourceField,
DestField: String): Boolean;
{!~ Copies SourceTable To DestTable.
If DestTable exists it is deleted}
Function DBCopyTable(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String): Boolean;
{!~ Copies Table A To Table B. If Table B exists it
is emptied}
Function DBCopyTableAToB(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String): Boolean;
{!~ Copies a table from the source to the destination.
If the destination table exists the function will not
throw an error, the existing table will be replaced with the new
table.}
Function DBCopyTableToServer(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
{!~ Creates an empty table with indices by borrowing the structure
of a source table. Source and destination can be remote or local
tables. If the destination table exists the function will not
throw an error, the existing table will be replaced with the new
table.}
Function DBCreateTableBorrowStr(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
{!~ Creates a new table from a Query.
Complex joins can be output to a new table.}
Function DBCreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
{!~ Deletes A Table}
Function DBDeleteTable(const DatabaseName, TableName : string):Boolean;
{!~ Drops A Table}
Function DBDropTable(const DatabaseName, TableName : string):Boolean;
{!~ Empties a table of all records}
Function DBEmptyTable(
const DatabaseName,
TableName : string): Boolean;
{!~ Returns the field Name as a String. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason '' is returned.}
Function DBFieldNameByNo(
DatabaseName : String;
TableName : String;
FieldNo : Integer): String;
{!~ Returns Field Names shared by 2 tables as a string.
Fields are separated by commas with no trailing comma.}
Function DBFieldNamesCommonToString(
DatabaseName1 : String;
TableName1 : String;
DatabaseName2 : String;
TableName2 : String): String;
{!~ Copies Field Names shared by 2 tables to a TStrings object.
Returns true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned. }
Function DBFieldNamesCommonToTStrings(
DatabaseName1 : String;
TableName1 : String;
DatabaseName2 : String;
TableName2 : String;
Strings : TStrings): Boolean;
{!~ Copies Table Field Names to a TStrings object, e.g.,
ListBox1.Items, Memo1.Lines.
Returns the true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned. }
Function DBFieldNamesToTStrings(
DatabaseName : String;
TableName : String;
Strings : TStrings): Boolean;
{!~ Returns the field Number as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason -1 is returned.}
Function DBFieldNo(DatabaseName, TableName, FieldName: String): Integer;
{!~ Returns the database field Size as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason 0 is returned.}
Function DBFieldSize(DatabaseName, TableName, FieldName: String): Integer;
{!~ Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
Function DBFieldType(DatabaseName, TableName, FieldName: String): String;
{!~ Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
Function DBFieldTypeByNo(DatabaseName, TableName: String; FieldNo: Integer): String;
{!~ Replace all the values in a field that match a
condition value with a new value}
procedure DBGlobalStringFieldChange(
const DatabaseName,
TableName,
FieldName,
NewValue : string);
{!~ Replace all the values in a field with a new value}
procedure DBGlobalStringFieldChangeWhere(
const DatabaseName,
TableName,
FieldName,
CurrentValue,
NewValue : string);
{!~ Replace values in a field (NewValueField) with NewValue
based on a where condition in CurrentValueField with a value
of CurrentValue}
procedure DBGlobalStringFieldChangeWhere2(
const DatabaseName,
TableName,
NewValueField,
NewValue,
CurrentValueField,
CurrentValue: string);
{!~ Inserts matching fields in a destination table.
Source Table records are deleted if the record was inserted properly.
Records unsuccessfully inserted are retained and the problems recorded
in the ErrorField.}
Function DBInsertMatchingFields(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable,
ErrorField: string): Boolean;
{!~ Copies Table Key Field Names to a TStrings object.
Returns the true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned. }
Function DBKeyFieldNamesToTStrings(
DatabaseName : String;
TableName : String;
Strings : TStrings): Boolean;
{!~ Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
Function DBLookUpDialog(
Const DataBaseName : String;
Const TableName : String;
Const FieldName : String;
Const SessionName : String;
Const DefaultValue : String;
const DialogCaption : string;
const InputPrompt : string;
const DialogWidth : Integer
): String;
{!~ Returns the median value for a column in a table
as type single}
Function DBMedianSingle(
const DatabaseName,
TableName,
FieldName,
WhereString
: string): Single;
{!~ Moves SourceTable From SourceDatabaseName
To DestDatabasename. If a table exists
with the same name at DestDatabaseName it
is overwritten.}
Function DBMoveTable(
SourceTable,
SourceDatabaseName,
DestDatabaseName: String): Boolean;
{!~ Returns the number of fields in a table}
Function DBNFields(DatabaseName, TableName: String): Integer;
{!~ Returns the next key value when the table keys are
numbers as strings, e.g., ' 12' key would return
' 13'}
Function DBNextAlphaKey(DatabaseName, TableName, FieldName: String):String;
{!~ Returns the next key value when the table keys are
integers, e.g., 12 key would return 13}
Function DBNextInteger(
DatabaseName,
TableName,
FieldName: String):LongInt;
{!~ ReKeys a Paradox Table to the first N fields}
Function DBParadoxCreateNKeys(
DatabaseName : String;
TableName : String;
NKeys : Integer): Boolean;
{!~ ReNames a table}
Function DBReNameTable(
DatabaseName,
TableNameOld,
TableNameNew: String): Boolean;
{!~ Applies BatchMode Types As Appropriate To
Source and Destination Tables}
Function DBRecordMove(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String;
BMode: TBatchMode): Boolean;
{!~ Returns True If The Tables Have Identical Structures, False Otherwise.
If 1 Local Table is involved then Indices are ignored!!!!!!}
Function DBSchemaSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
{!~ Creates a new TSession object.}
{$IFDEF WIN32}
Function DBSessionCreateNew: TSession;
{$ENDIF WIN32}
{!~ Returns a value for use in a sql where clause with the
appropriate Quoting of the value based on its datatype. If
an error occurs the original string value is returned unchanged}
Function DBSqlValueQuoted(
const
DatabaseName,
TableName,
FieldName,
FieldValue: string): String;
{!~ Subtracts the records in the source
table from the destination table}
Function DBSubtractTable(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Trims blank spaces from the Left of the string}
Function DBTrimBlanksLeft(
DatabaseName : String;
TableName : String;
FieldName : String): Boolean;
{!~ Trims blank spaces from the right of the string}
Function DBTrimBlanksRight(
DatabaseName : String;
TableName : String;
FieldName : String): Boolean;
{!~ Updates matching fields in a destination table.
Source Table records are deleted if the record was updated properly.
Records unsuccessfully updated are retained and the problems recorded
in the ErrorField.}
Function DBUpdateMatchingFields(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable,
ErrorField: string;
MsgPanel: TPanel;
FilePath: String): Boolean;
{!~ Deletes A Table}
Function DeleteTable(const DatabaseName, TableName : string):Boolean;
{!~ Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
Function DialogDBLookUp(
Const DataBaseName : String;
Const TableName : String;
Const FieldName : String;
Const SessionName : String;
Const DefaultValue : String;
const DialogCaption : string;
const InputPrompt : string;
const DialogWidth : Integer
): String;
{!~ Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
Function DialogLookup(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string;
const Values : TStringList
): string;
{!~ Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
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;
{!~ Drops A Table}
Function DropTable(const DatabaseName, TableName : string):Boolean;
{!~ Empties a table of all records}
Function EmptyTable(
const DatabaseName,
TableName : string): Boolean;
{!~ Returns the meaning of the given result code. Error codes are for
Delphi 1.0.}
function ErrorMeaning (ResultCode: Integer): string;
{!~ Returns the field Number as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason 0 is returned.}
Function FieldNo(DatabaseName, TableName, FieldName: String): Integer;
{!~ Returns the database field Size as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason 0 is returned.}
Function FieldSize(DatabaseName, TableName, FieldName: String): Integer;
{!~ Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
Function FieldType(DatabaseName, TableName, FieldName: String): String;
{!~ Returns the database field type as a string. If there
is an error a null string is returned.}
Function FieldTypeFromDataSet(DataSet: TDataSet; FieldName: String): String;
{!~ Tests whether a TDataSource is empty, i.e., has no records }
Function IsEmptyDataSource(DS: TDataSource): Boolean;
{!~ Tests whether a TQuery is empty, i.e., has no records }
Function IsEmptyTQuery(Query: TQuery): Boolean;
{!~ Tests whether a TTable is empty, i.e., has no records }
Function IsEmptyTTable(Table: TTable): Boolean;
{!~ Tests whether a table is empty, i.e., has no records }
Function IsEmptyTable(DatabaseName, TableName: String): Boolean;
{!~ Returns True If DatabaseName:TableName:FieldName Exists,
False Otherwise}
Function IsField(DatabaseName, TableName, FieldName: String): Boolean;
{!~ Returns True If DatabaseName:TableName:FieldName
Exists and is Keyed, False Otherwise}
Function IsFieldKeyed(DatabaseName, TableName, FieldName: String): Boolean;
{!~ Returns True If The Record Exists, False Otherwise}
Function IsRecord(
DatabaseName : String;
TableName : String;
TableKeys : TStringList;
KeyValues : TStringList): Boolean;
{!~ Returns True If The Tables Have Identical Structures, False Otherwise.
If 1 Local Table is involved then Indices are ignored!!!!!!}
Function IsSchemaSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
{!~ Returns True If The Tables Have Identical Structures, False Otherwise.
If 1 Local Table is involved then Indices are ignored!!!!!!}
Function IsStructureSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
{!~ Returns True If The Table Exists, False Otherwise.
This procedure needs to be improved.
Please give recommendations or new code.}
Function IsTable(DatabaseName, TableName: String): Boolean;
{!~ Returns True If DatabaseName:TableName
Exists and has a primary key, False Otherwise}
Function IsTableKeyed(DatabaseName, TableName: String): Boolean;
{!~ Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
Function LookupDialog(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string;
const Values : TStringList
): string;
{!~ Moves SourceTable From SourceDatabaseName
To DestDatabasename. If a table exists
with the same name at DestDatabaseName it
is overwritten.}
Function MoveTable(
SourceTable,
SourceDatabaseName,
DestDatabaseName: String): Boolean;
{!~ Returns the number of fields in a table}
Function NFields(DatabaseName, TableName: String): Integer;
{!~ Subtracts the records in the source
table from the destination table}
Function SubtractTable(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Add source table to destination table}
Function TableAdd(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Creates a new table from a Query.
Complex joins can be output to a new table.}
Function TableCreateFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
{!~ Moves SourceTable From SourceDatabaseName
To DestDatabasename. If a table exists
with the same name at DestDatabaseName it
is overwritten.}
Function TableMove(
SourceTable,
SourceDatabaseName,
DestDatabaseName: String): Boolean;
{!~ Subtracts the records in the source
table from the destination table}
Function TableSubtract(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
{!~ Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
Function TypeField(DatabaseName, TableName, FieldName: String): String;
{!~ Returns the database field type as a string. If there
is an error a null string is returned.}
Function TypeFieldFromDataSet(DataSet: TDataSet; FieldName: String): String;
implementation
Uses ads_Strg, StdCtrls, Controls, Forms, SysUtils, Dialogs;
Type
{!~
TPanel_Cmp_Sec_ads
}
TPanel_Cmp_Sec_ads = class(TPanel)
Public
procedure ResizeShadowLabel(Sender: TObject);
End;
{!~
TPanel_Cmp_Sec_ads.ResizeShadowLabel
}
procedure TPanel_Cmp_Sec_ads.ResizeShadowLabel(
Sender : TObject);
Var
PH, PW : Integer;
LH, LW : Integer;
begin
PH := TPanel(Sender).Height;
PW := TPanel(Sender).Width;
LH := TLabel(Controls[0]).Height;
LW := TLabel(Controls[0]).Width;
TLabel(Controls[0]).Top := ((PH-LH) div 2)-3;
TLabel(Controls[0]).Left := ((Pw-Lw) div 2)-3;
End;
Type
{!~
TEditKeyFilter
}
TEditKeyFilter = Class(TEdit)
Published
{!~ Throws away all keys except 0-9,-,+,.}
Procedure OnlyNumbers(Sender: TObject; var Key: Char);
{!~ Throws away all keys except 0-9}
Procedure OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
{!~ Throws away all keys except a-z and A-Z}
Procedure OnlyAToZ(Sender: TObject; var Key: Char);
End;
{!~
TEditKeyFilter.OnlyNumbers
Throws away all keys except 0-9,-,+,.}
Procedure TEditKeyFilter.OnlyNumbers(Sender: TObject; var Key: Char);
Begin
KeyPressOnlyNumbers(Key);
End;
{!~
TEditKeyFilter.OnlyNumbersAbsolute
Throws away all keys except 0-9}
Procedure TEditKeyFilter.OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
Begin
KeyPressOnlyNumbersAbsolute(Key);
End;
{!~
TEditKeyFilter.OnlyAToZ
Throws away all keys except a-z and A-Z}
Procedure TEditKeyFilter.OnlyAToZ(Sender: TObject; var Key: Char);
Begin
KeyPressOnlyAToZ(Key);
End;
{!~
AddTables
Add source table to destination table}
Function AddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
Var
BMode : TBatchMode;
Begin
If IsTableKeyed(DestDatabaseName,DestinationTable) Then
Begin
If IsTableKeyed(SourceDatabaseName,SourceTable) Then
Begin
BMode := BatAppendUpdate;
End
Else
Begin
BMode := BatAppend;
End;
End
Else
Begin
BMode := BatAppend;
End;
Result := DBRecordMove(SourceDatabaseName,SourceTable,
DestDatabaseName,DestinationTable,BMode);
End;
{!~
CreateTableFromQuery
Creates a new table from a Query.
Complex joins can be output to a new table.}
Function CreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
Begin
Result := DBCreateTableFromQuery(Query,NewTableName,TableDatabaseName);
End;
{!~
DBAddQueryToTable
Add source query to destination table}
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;
End;
{!~
DBAddTables
Add source table to destination table}
Function DBAddTables(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable: string): Boolean;
begin
Result := AddTables(SourceDatabaseName,SourceTable,
DestDatabaseName,DestinationTable);
End;
{!~
DBCopyFieldAToB
Copies Field A To Field B.}
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;
End;
{!~
DBCopyTable
Copies SourceTable To DestTable.
If DestTable exists it is deleted}
Function DBCopyTable(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String): Boolean;
Begin
Result := DBRecordMove(SourceDatabaseName,SourceTable,
DestDatabaseName,DestTable,batCopy);
End;
{!~
DBCopyTableAToB
Copies Table A To Table B. If Table B exists it
is emptied}
Function DBCopyTableAToB(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String): Boolean;
begin
Result :=
DBCopyTable(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable);
End;
{!~
DBCopyTableToServer
Copies a table from the source to the destination.
If the destination table exists the function will not
throw an error, the existing table will be replaced with the new
table.
example:
This is a very powerful migration utility.
It can be used to copy tables from and to any location.
The following example copies the DBDemos "Customer.db" table to
a Sybase client server database.
DBCopyTableToServer(
'DBDemos',
'Customer.Db',
'SybaseDb',
'Customer');
}
Function DBCopyTableToServer(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
Begin
Result := False;
Try
If DBCreateTableBorrowStr(
SourceDatabaseName,
SourceTableName,
DestDatabaseName,
DestTableName)
Then
Begin
If AddTables(
SourceDatabaseName,
SourceTableName,
DestDatabaseName,
DestTableName)
Then
Begin
Result := True;
End;
End;
Except
On E : Exception Do
Begin
ShowMessage('DBCopyTableToServer Error: '+E.Message);
Result := False;
End;
End;
End;
{!~
DBCreateTableBorrowStr
Creates an empty table with indices by borrowing the structure
of a source table. Source and destination can be remote or local
tables. If the destination table exists the function will not
throw an error, the existing table will be replaced with the new
table.
example:
This is a very powerful migration utility.
The function creates an empty table with indices by borrowing the
structure of a source table. Source and destination can be remote
or local tables. If the destination table exists the function will not
throw an error, the existing table will be replaced with the new
table.
The following example creates an empty version of the DBDemos
"Customer.Db" table on a Sybase Client Server Database.
DBCreateTableBorrowStr(
'DBDemos',
'Customer.Db',
'SybaseDb',
'Customer');
}
Function DBCreateTableBorrowStr(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
Var
S : TTable;
D : TTable;
i : Integer;
j : Integer;
IMax : Integer;
IndexName : String;
IndexFields : String;
IndexFields2 : String;
Q : TQuery;
IDXO : TIndexOptions;
Begin
S := TTable.Create(nil);
D := TTable.Create(nil);
Try
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(j);
IndexFields := S.IndexDefs.Items[j].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;
{Msg('DBCreateTableBorrowStr Error: '+E.Message);}
End;
End;
End;
End;
Finally
Q.Free;
End;
End;
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;
End;
End;
{!~
DBCreateTableFromQuery
Creates a new table from a Query.
Complex joins can be output to a new table.}
Function DBCreateTableFromQuery(
Query: TQuery;
NewTableName,
TableDatabaseName: String): Boolean;
var
D : TTable;
ActiveWas : Boolean;
begin
D := nil;
try
{The Source Table}
ActiveWas := Query.Active;
Query.Active := true;
{Create The Destination Table}
D := TTable.Create(nil);
D.Active := False;
D.DatabaseName := TableDatabaseName;
D.TableName := NewTableName;
D.ReadOnly := False;
{Make the table copy}
D.BatchMove(Query,batCopy);
Query.Active := ActiveWas;
Result := True;
finally
D.Free;
end;
End;
{!~
DBDeleteTable
Deletes A Table}
Function DBDeleteTable(const DatabaseName, TableName : string):Boolean;
Begin
Try
If Not IsTable(DatabaseName, TableName) Then
Begin
Result := False;
Exit;
End;
Result := DBDropTable(DatabaseName, TableName);
Except
Result := False;
End;
End;
{!~
DBDropTable
Drops A Table}
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;
End;
{!~
DBEmptyTable
Empties a table of all records}
Function DBEmptyTable(
const DatabaseName,
TableName : string): Boolean;
var Query : TQuery;
begin
Query := TQuery.Create(nil);
try
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('DELETE FROM '+TableName);
Query.ExecSQL;
Result := True;
finally
Query.Free;
end;
End;
{!~
DBFieldNameByNo
Returns the field Name as a String. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason '' is returned.
example:
Returns the field Name as a String. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason '' is returned.
The field number is zero based so the first column would
be 0, the 2nd column 1 etc.
This example returns "Company" as the name of the 2nd
column in the table. "1" is entered as the column
number because it is zero based.
FieldName :=
DBFieldNameByNo(
'DBDemos',
'Customer.Db',
1);
}
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
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Result := Table.FieldDefs[FieldNo].Name;
Except
End;
Finally
Table.Free;
End;
End;
{!~
DBFieldNamesCommonToString
Returns Field Names shared by 2 tables as a string.
Fields are separated by commas with no trailing comma.}
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;
End;
Finally
List1.Free;
List2.Free;
End;
End;
{!~
DBFieldNamesCommonToTStrings
Copies Field Names shared by 2 tables to a TStrings object.
Returns true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned. }
Function DBFieldNamesCommonToTStrings(
DatabaseName1 : String;
TableName1 : String;
DatabaseName2 : String;
TableName2 : String;
Strings : TStrings): Boolean;
Var
List1 : TStringList;
List2 : TStringList;
i : Integer;
Begin
{ Result := False;}{zzz}
List1 := TStringList.Create();
List2 := TStringList.Create();
Try
Strings.Clear;
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 List2.IndexOf(List1[i]) <> -1 Then
Begin
Strings.Add(List1[i]);
End;
End;
Result := True;
Finally
List1.Free;
List2.Free;
End;
End;
{!~
DBFieldNamesToTStrings
Copies Table Field Names to a TStrings object, e.g.,
ListBox1.Items, Memo1.Lines.
Returns true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned.
example:
DBFieldNamesToTStrings copies Table Field Names to a TStrings object, e.g.,
ListBox1.Items, Memo1.Lines.
It returns true if successful, False otherwise. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned.
In this example the DBDemos "Customer.Db" table Field Names
populate a TStringList that is passed as a parameter to the
procedure.
Procedure TForm1.GetFieldNames(
DatabaseName : String;
TableName : String;
TSL : TStrings);
Begin
DBFieldNamesToTStrings(
DatabaseName,
TableName,
TSL);
End;
Procedure TForm1.FormCreate(
Begin
TSL := TStringList.Create();
GetFieldNames(
'DBDemos',
'Customer.Db',
TSL);
End;
}
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
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;
End;
{!~
DBFieldNo
Returns the field Number as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason -1 is returned.}
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
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;
End;
{!~
DBFieldSize
Returns the database field Size as an integer. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason 0 is returned.}
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
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;
End;
{!~
DBFieldType
Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
Function DBFieldType(DatabaseName, TableName, FieldName: String): String;
Begin
Result := TypeField(DatabaseName, TableName, FieldName);
End;
{!~
DBFieldTypeByNo
Returns the database field type as a string. If there
is an error, the table doesn't exist, the field doesn't
exist or some other reason a null string is returned.}
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
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;
End;
{!~
DBGlobalStringFieldChange
Replace all the values in a field that match a
condition value with a new value}
procedure DBGlobalStringFieldChange(
const DatabaseName,
TableName,
FieldName,
NewValue : string);
begin
DBGlobalStringFieldChangeWhere(
DatabaseName,
TableName,
FieldName,
'',
NewValue);
End;
{!~
DBGlobalStringFieldChangeWhere
Replace all the values in a field with a new value}
procedure DBGlobalStringFieldChangeWhere(
const DatabaseName,
TableName,
FieldName,
CurrentValue,
NewValue : string);
var
Query : TQuery;
begin
Query := TQuery.Create(nil);
Try
Query.Active := False;
Query.DatabaseName := DatabaseName;
Query.RequestLive := True;
Query.RequestLive := True;
Query.Sql.Clear;
Query.Sql.Add('UpDate');
Query.Sql.Add('"'+TableName+'"');
Query.Sql.Add('Set');
Query.Sql.Add(
'"'+TableName+'"."'+FieldName+'"'+
' = '+
'"'+NewValue+'"');
Query.Sql.Add('Where');
Query.Sql.Add(
'"'+TableName+'"."'+FieldName+'"'+
' <> '+
'"'+NewValue+'"');
If Not (CurrentValue = '') Then
Begin
Query.Sql.Add('And ');
Query.Sql.Add(
'"'+TableName+'"."'+FieldName+'"'+
' = '+
'"'+CurrentValue+'"');
End;
Query.ExecSql;
Query.Active := False;
Finally
Query.Free;
End;
End;
{!~
DBGlobalStringFieldChangeWhere2
Replace values in a field (NewValueField) with NewValue
based on a where condition in CurrentValueField with a value
of CurrentValue}
procedure DBGlobalStringFieldChangeWhere2(
const DatabaseName,
TableName,
NewValueField,
NewValue,
CurrentValueField,
CurrentValue: string);
var
Query : TQuery;
CValueQuoted : String;
begin
Query := TQuery.Create(nil);
Try
CValueQuoted := DBSqlValueQuoted(
DatabaseName,
TableName,
CurrentValueField,
CurrentValue);
Query.Active := False;
Query.DatabaseName := DatabaseName;
Query.RequestLive := True;
Query.RequestLive := True;
Query.Sql.Clear;
Query.Sql.Add('UpDate');
Query.Sql.Add('"'+TableName+'"');
Query.Sql.Add('Set');
Query.Sql.Add(
'"'+TableName+'"."'+NewValueField+'"'+
' = '+
'"'+NewValue+'"');
If Not (CurrentValue = '') Then
Begin
Query.Sql.Add('Where');
Query.Sql.Add(
'"'+TableName+'"."'+CurrentValueField+'"'+
' = '+
CValueQuoted);
End;
{Query.Sql.SaveToFile(ExtractFileNameNoExt(TableName)+'.sql');}
Query.ExecSql;
Query.Active := False;
Finally
Query.Free;
End;
End;
{!~
DBInsertMatchingFields
Inserts matching fields in a destination table.
Source Table records are deleted if the record was inserted properly.
Records unsuccessfully inserted are retained and the problems recorded
in the ErrorField.}
Function DBInsertMatchingFields(
const
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable,
ErrorField: string): Boolean;
Var
S : TTable;
T : TTable;
D : TQuery;
i,j,K : Integer;
Keys : TStringList;
KeyValues : TStringList;
CommonFields : TStringList;
{WhereAnd : String;}{zzz}
{CurField : String;}{zzz}
{CurValue_S : String;}{zzz}
{DFieldType : String;}{zzz}
EMessage : String;
ESuccess : String;
Begin
Result := False;
ESuccess := 'Successful';
S := TTable.Create(nil);
D := TQuery.Create(nil);
T := TTable.Create(nil);
Keys := TStringList.Create();
CommonFields := TStringList.Create();
KeyValues := TStringList.Create();
Try
Try
D.Active := False;
D.DatabaseName := DestDatabaseName;
DBKeyFieldNamesToTStrings(
SourceDatabaseName,
SourceTable,
Keys);
DBFieldNamesCommonToTStrings(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestinationTable,
CommonFields);
S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.TableName := SourceTable;
S.Active := True;
S.First;
While Not S.EOF Do
Begin
Try
{Capture the key field values}
KeyValues.Clear;
For j := 0 To Keys.Count - 1 Do
Begin
KeyValues.Add(S.FieldByName(Keys[j]).AsString);
End;
If IsRecord(
DestDatabaseName,
DestinationTable,
Keys,
KeyValues)
Then
Begin
{The record already exists in the destination table}
Try
S.Edit;
S.FieldByName(ErrorField).AsString :=
'Error-Insert-Record already exists in destination table';
S.Post;
Except
End;
S.Next;
Continue;
End
Else
Begin
{The record does not exist in the destination table}
Try
EMessage := ESuccess;
S.Edit;
S.FieldByName(ErrorField).AsString := EMessage;
S.Post;
Except
End;
End;
Try
T.Active := False;
T.DatabaseName := DestDatabaseName;
T.TableName := DestinationTable;
T.Active := True;
T.Insert;
For i := 0 To CommonFields.Count - 1 Do
Begin
T.FieldByName(CommonFields[i]).AsString :=
S.FieldByName(CommonFields[i]).AsString;
End;
T.Post;
Except
If EMessage = ESuccess Then
Begin
EMessage := 'Error-Insert- Keys:';
For K := 0 To Keys.Count -1 Do
Begin
EMessage := EMessage + Keys[K]+'='+S.FieldByName(Keys[K]).AsString+', ';
End;
End;
Try
S.Edit;
S.FieldByName(ErrorField).AsString := EMessage;
S.Post;
Except
End;
End;
Except
If EMessage = ESuccess Then
Begin
EMessage := 'Error-Insert- Keys:';
For K := 0 To Keys.Count -1 Do
Begin
EMessage := EMessage + Keys[K]+'='+S.FieldByName(Keys[K]).AsString+', ';
End;
End;
Try
S.Edit;
S.FieldByName(ErrorField).AsString := EMessage;
S.Post;
Except
End;
End;
S.Next;
End;
If Not IsField(SourceDatabaseName, SourceTable, ErrorField) Then
Begin
ShowMessage('Cannot delete records from '+
SourceTable+' table because '+ErrorField+
' Field does not exist');
End
Else
Begin
D.Active := False;
D.RequestLive := True;
D.DatabaseName := SourceDatabaseName;
D.Sql.Clear;
D.Sql.Add('Delete From '+SourceTable);
D.Sql.Add('Where');
D.Sql.Add(ErrorField+' = "'+ESuccess+'"');
D.ExecSql;
D.Active := False;
End;
Result := True;
Except
If EMessage = ESuccess Then
Begin
EMessage := 'Error-Process Level- Keys:';
For K := 0 To Keys.Count -1 Do
Begin
EMessage := EMessage + Keys[K]+'='+S.FieldByName(Keys[K]).AsString+', ';
End;
End
Else
Begin
EMessage := EMessage + 'Process Error Also';
End;
Try
S.Edit;
S.FieldByName(ErrorField).AsString := EMessage;
S.Post;
Except
End;
End;
Finally
S.Free;
D.Free;
T.Free;
Keys.Free;
CommonFields.Free;
KeyValues.Free;
End;
End;
{!~
DBKeyFieldNamesToTStrings
Copies Table Key Field Names to a TStrings object.
Returns the true if successful. If there
is an error, the DatabaseName doesn't exist, the table doesn't
exist or some other reason False is returned. }
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
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;
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;
{!~
DBLookUpDialog
Presents a lookup Dialog to the user. The selected
value is returned if the user presses OK and the Default
value is returned if the user presses Cancel unless the
TStringList is nil in which case a blank string is returned}
Function DBLookUpDialog(
Const DataBaseName : String;
Const TableName : String;
Const FieldName : String;
Const SessionName : String;
Const DefaultValue : String;
const DialogCaption : string;
const InputPrompt : string;
const DialogWidth : Integer
): String;
Begin
Result :=
DialogDBLookUp(
DataBaseName,
TableName,
FieldName,
SessionName,
DefaultValue,
DialogCaption,
InputPrompt,
DialogWidth
);
End;
{!~
DBMedianSingle
Returns the median value for a column in a table
as type single}
Function DBMedianSingle(
const DatabaseName,
TableName,
FieldName,
WhereString
: string): Single;
Var
Query : TQuery;
NRecords : LongInt;
NMedian : LongInt;
Value1 : Single;
Value2 : Single;
Begin
Query := TQuery.Create(nil);
Try
{Get the number of values}
Query.Active := False;
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Select Count(*)');
Query.SQL.Add('From');
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;
Query.SQL.Add('Where');
Query.SQL.Add(FieldName+' is not null');
If Not (WhereString = '') Then
Begin
Query.SQL.Add('And');
Query.SQL.Add(WhereString);
End;
Query.Active := True;
NRecords := Query.Fields[0].AsInteger;
NMedian := NRecords div 2;
{Get the median value}
Query.Active := False;
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add('Select');
Query.SQL.Add(FieldName);
Query.SQL.Add('From');
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;
Query.SQL.Add('Where');
Query.SQL.Add(FieldName+' is not null');
If Not (WhereString = '') Then
Begin
Query.SQL.Add('And');
Query.SQL.Add(WhereString);
End;
Query.SQL.Add('Order By');
Query.SQL.Add(FieldName);
Query.Active := True;
Query.First;
If Odd(NRecords) Then
Begin
{Odd Number of records}
Query.MoveBy(NMedian);
Result := Query.FieldByName(FieldName).AsFloat;
End
Else
Begin
{Even Number of records}
Query.MoveBy(NMedian-1);
Value1 := Query.FieldByName(FieldName).AsFloat;
Query.Next;
Value2 := Query.FieldByName(FieldName).AsFloat;
Result := (Value1+Value2)/2;
End;
Finally
Query.Free;
End;
End;
{!~
DBMoveTable
Moves SourceTable From SourceDatabaseName
To DestDatabasename. If a table exists
with the same name at DestDatabaseName it
is overwritten.}
Function DBMoveTable(
SourceTable,
SourceDatabaseName,
DestDatabaseName: String): Boolean;
Begin
Result := True;
Try
{First Copy The Source Table To The New Table}
If Not DBCopyTable(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
SourceTable) Then
Begin
Result := False;
Exit;
End;
{Now Drop The Source Table}
If Not DBDropTable(SourceDatabaseName, SourceTable) Then
Begin
Result := False;
Exit;
End;
Except
Result := False;
End;
End;
{!~
DBNFields
Returns the number of fields in a table}
Function DBNFields(DatabaseName, TableName: String): Integer;
Begin
Result := NFields(DatabaseName, TableName);
End;