// Field
function TDataUtil.HasField(aTB, aFD: string): Boolean;
var
i: Integer;
begin
aFD := UpperCase(aFD);
Result := False;
if IsFirebird then
FQuery.SQL.Text := 'SELECT FIRST 1 * FROM ' + aTB
else
FQuery.SQL.Text := 'SELECT * FROM ' + aTB + ' LIMIT 0, 1';
FQuery.Open;
for i := 0 to FQuery.Fields.Count - 1 do
if UpperCase(FQuery.Fields[i].FieldName) = aFD then
begin
Result := True;
Break;
end;
FQuery.Close;
end;
procedure TDataUtil.InsertField(aTB, aFD, aTY, After: string);
var
i, n: Integer;
s: string;
begin
if Connected then
begin
After := UpperCase(After);
s := 'ALTER TABLE ' + aTB + ' ADD ' + aFD + ' ';
if IsFirebird then
begin
s := s + aTY;
n := -1;
if After <> '' then
begin
FQuery.SQL.Text := 'SELECT FIRST 1 * FROM ' + aTB;
FQuery.Open;
for i := 0 to FQuery.Fields.Count - 1 do
if After = UpperCase(FQuery.Fields[i].FieldName) then
begin
n := i + 1;
Break;
end;
end;
if (n <> -1) then
s := s + ' POSITION ' + IntToStr(n);
end
else
begin
s := s + MySQLField(aTY);
if After <> '' then
s := s + ' AFTER ' + After;
end;
QueryExecSQL(s);
end;
end;
procedure TDataUtil.DeleteField(aTB, aFD: string);
begin
QueryExecSQL('ALTER TABLE ' + UpperCase(aTB) + ' DROP ' + UpperCase(aFD));
end;
function TDataUtil.FieldIsType(aTB, aFD: string): TFieldType;
var
s: string;
begin
Result := ftUnknown;
FQuery.SQL.Text := 'SELECT TABLE_SCHEMA, TABLE_NAME, COLUMN_NAME, DATA_TYPE ' +
'FROM information_schema.COLUMNS WHERE TABLE_NAME=' +
QuotedStr(aTB) + ' AND TABLE_SCHEMA=' +
QuotedStr(Database) + ' AND COLUMN_NAME=' +
QuotedStr(aFD);
{
if IsFirebird then
FQuery.SQL.Text := 'SELECT FIRST 1 FROM ' + aTB
else
FQuery.SQL.Text := 'SELECT * FROM ' + aTB + ' LIMIT 0,1';
}
FQuery.Open;
if FQuery.RecordCount <> 0 then
begin
s := UpperCase(FQuery.FieldByName('DATA_TYPE').AsString);
if (s = 'VARCHAR') or (s = 'CHAR') or (s = 'TEXT') or (s = 'TINYTEXT') or
(s = 'MEDIUMTEXT') or (s = 'LONGTEXT') or (s = 'SET') or (s = 'ENUM') or
(s = 'NCHAR') then
Result := ftString
else if (s = 'INT') or (s = 'BIGINT') or (s = 'INTEGER') or (s = 'TINYINT') or
(s = 'SMALLINT') or (s = 'MEDIUMINT') or (s = 'YEAR') then
Result := ftInteger
else if (s = 'DECIMAL') or (s = 'NUMERIC') then
Result := ftCurrency
else if (s = 'FLOAT') or (s = 'REAL') or (s = 'DOUBLE') then
Result := ftFloat
else if (s = 'DATE') then
Result := ftDate
else if (s = 'TIME') then
Result := ftTime
else if (s = 'DATETIME') then
Result := ftDateTime
else if (s = 'TIMESTAMP') then
Result := ftTimeStamp
else if (s = 'BINARY') or (s = 'VARBINARY') or (s = 'TINYBLOB') or
(s = 'BLOB') or (s = 'MEDIUMBLOB') or (s = 'LONGBLOB') then
Result := ftBlob
else
Result := ftUnknown;
end;
FQuery.Close;
end;
// Something
procedure TDataUtil.QueryExecSQL(aSQL: string);
begin
{$IFDEF DEBUGQUERY}
ShowMessage(aSQL);
{$ENDIF}
FQuery.SQL.Text := aSQL;
FQuery.ExecSQL;
end;
procedure TDataUtil.QuerySQL(var rField: string; var rValue: string; const aField, aValue: string); overload;
begin
if aValue <> '' then
begin
rField := AddComma(rField) + aField;
rValue := AddComma(rValue) + aValue;
end;
end;
procedure TDataUtil.QuerySQL(var rField: string; const aField, aValue: string); overload;
begin
if aValue <> '' then
rField := AddComma(rField) + aField + '=' + aValue;
end;
procedure TDataUtil.OpenQuery(aQuery: TZQuery; aSQL: string = ''; aID: Integer = -1);
begin
if (aQuery.SQL.Text = '') and (aSQL = '') then
raise Exception.Create('SQL Query not assign!');
if aQuery.Active then
aQuery.Close;
if aSQL <> '' then
aQuery.SQL.Text := aSQL;
aQuery.Open;
if aID <> -1 then
aQuery.Locate('ID', aID, []);
end;
procedure TDataUtil.Delete4ID(aQuery: TZQuery; aTB: string; aID: Integer);
begin
aQuery.Close;
QueryExecSQL('DELETE FROM ' + aTB + ' WHERE ID=' + IntToStr(aID));
OpenQuery(aQuery);
end;
procedure TDataUtil.Search(aQuery: TZQuery; FromTable, InField, ByText: string;
tso: TSearchOrder = tsoBefore);
var
sso, qry: string;
begin
if Connected then
begin
aQuery.Close;
qry := 'SELECT * FROM ' + FromTable + ' WHERE ';
if IsFirebird then
qry := qry + ' POSITION(' + QuotedStr(UpperCase(ByText)) +
' IN UPPER(' + InField + '))>0'
else
begin
case tso of
tsoBefore : sso := '%' + ByText;
tsoAfter : sso := ByText + '%';
else
sso := '%' + ByText + '%';
end;
qry := qry + InField + ' LIKE ' + QuotedStr(sso);
end;
aQuery.SQL.Text := qry + ' ORDER BY ' + InField + ' ASC';
aQuery.Open;
end;
end;
function TDataUtil.CanEditOrDelete(aQuery: TZQuery): Boolean;
begin
Result := aQuery.Active and (aQuery.RecordCount <> 0);
end;
function TDataUtil.GetHostName: string;
begin
Result := FConfig.HostName;
end;
function TDataUtil.GetUserName: string;
begin
Result := FConfig.UserName;
end;
function TDataUtil.GetPassword: string;
begin
Result := FConfig.Password;
end;
function TDataUtil.GetPort: Word;
begin
Result := FConfig.Port;
end;
function TDataUtil.GetDatabase: string;
begin
Result := FConfig.Database;
end;
function TDataUtil.GetDataType: TDataType;
begin
Result := FConfig.DataType;
end;
procedure TDataUtil.SetHostName(aHost: string);
begin
FConfig.HostName := aHost;
end;
procedure TDataUtil.SetUserName(aUser: string);
begin
FConfig.UserName := aUser;
end;
procedure TDataUtil.SetPassword(aPass: string);
begin
FConfig.Password := aPass;
end;
procedure TDataUtil.SetDatabase(aData: string);
begin
FConfig.Database := aData;
end;
procedure TDataUtil.SetDataType(aData: TDataType);
begin
FConfig.DataType := aData;
end;
procedure TDataUtil.SetPath(aPath: string);
begin
if Copy(aPath, Length(aPath), 1) <> '\' then
aPath := aPath + '\';
FPath := aPath;
end;
function TDataUtil.GetCodePage(aTB: string): string;
begin
Result := 'utf8';
if not IsFirebird then
begin
FQuery.SQL.Text := 'SELECT TABLE_COLLATION FROM information_schema.TABLES where TABLE_SCHEMA=' +
QuotedStr(Database) + ' AND TABLE_NAME=' +
QuotedStr(aTB);
FQuery.Open;
if FQuery.RecordCount <> 0 then
Result := Trim(FQuery.Fields[0].AsString);
FQuery.Close;
end;
end;
procedure TDataUtil.Backup2File(Filename: string);
var
ts: TStringList;
tb: TStringList;
i, j: Integer;
s: string;
CStream: TCompressionStream;
FStream: TFileStream;
MStream, DStream: TMemoryStream;
begin
tb := TStringList.Create;
try
TableList(tb);
if tb.Count <> 0 then
begin
ts := TStringList.Create;
try
if FProgress then
begin
ProFrm := TProFrm.Create(nil);
ProFrm.MessStr := 'Restoring...';
ProFrm.MaxValue := tb.Count;
ProFrm.Show;
end;
for i := 0 to tb.Count - 1 do
begin
if FProgress then
ProFrm.Next;
FQuery.SQL.Text := 'SELECT * FROM ' + tb.Strings[i] + ' ORDER BY ID ASC';
FQuery.Open;
if FQuery.RecordCount <> 0 then
begin
ts.Add('#N' + tb.Strings[i]);
s := '#F';
for j := 0 to FQuery.Fields.Count - 1 do
s := s + '|' + UpperCase(FQuery.Fields[j].FieldName);
ts.Add(s);
s := '#T';
for j := 0 to FQuery.Fields.Count - 1 do
begin
s := s + '|';
case FQuery.Fields[j].DataType of
ftInteger : s := s + 'I';
ftFloat,
ftCurrency : s := s + 'F';
else
s := s + 'S';
end;
end;
ts.Add(s);
FQuery.First;
while not FQuery.Eof do
begin
s := '#D';
for j := 0 to FQuery.Fields.Count - 1 do
begin
s := s + '|';
case FQuery.Fields[j].DataType of
ftInteger : s := s + IntToStr(FQuery.Fields[j].AsInteger);
ftFloat,
ftCurrency : s := s + FloatToStr(FQuery.Fields[j].AsFloat);
else
s := s + UTF8ToAnsi(Trim(FQuery.Fields[j].AsString));
end;
end;
ts.Add(s);
FQuery.Next;
end;
FQuery.Close;
j := 0;
if IsFirebird then
j := GetAutoInc(tb.Strings[i])
else
j := NextAutoInc(tb.Strings[i]);
ts.Add('#E|' + IntToStr(j));
end;
end;
if FBackupCompress then
begin
FStream := TFileStream.Create(UTF8ToAnsi(Filename), fmOpenReadWrite or fmCreate);
try
DStream := TMemoryStream.Create;
MStream := TMemoryStream.Create;
try
ts.SaveToStream(MStream);
MStream.Position := 0;
CStream := TCompressionStream.Create(clMax, DStream);
try
CStream.CopyFrom(MStream, MStream.Size);
finally
FreeAndNil(CStream);
end;
DStream.Position := 0;
FStream.CopyFrom(DStream, DStream.Size);
finally
FreeAndNil(MStream);
end;
finally
FreeAndNil(FStream);
FreeAndNil(DStream);
end;
end
else
ts.SaveToFile(UTF8ToAnsi(Filename));
if FProgress then
FreeAndNil(ProFrm);
finally
ts.Clear;
FreeAndNil(ts);
end;
end;
finally
tb.Clear;
FreeAndNil(tb);
end;
if Assigned(FOnBackup) then
FOnBackup(Self);
end;
procedure TDataUtil.Restore4File(Filename: string);
const
BufSize = 10240;
var
ts: TStringList;
s1, s2, s3, nm, ty, tb: string;
i, a: Integer;
Buffer: array[0..BufSize - 1] of Byte;
FStream: TFileStream;
MStream: TMemoryStream;
DStream: TDecompressionStream;
begin
ts := TStringList.Create;
try
if BackupCompress then
begin
FStream := TFileStream.Create(UTF8ToAnsi(Filename), fmOpenRead);
try
FStream.Position := 0;
MStream := TMemoryStream.Create;
try
DStream := TDecompressionStream.Create(FStream);
try
while True do
begin
a := DStream.Read(Buffer, BufSize);
if a <> 0 then
MStream.WriteBuffer(Buffer, a)
else
Break;
end;
finally
FreeAndNil(DStream);
end;
MStream.Position := 0;
ts.LoadFromStream(MStream);
finally
FreeAndNil(MStream);
end;
finally
FreeAndNil(FStream);
end;
end
else
ts.LoadFromFile(UTF8ToAnsi(Filename));
if FProgress then
begin
ProFrm := TProFrm.Create(nil);
ProFrm.MessStr := 'Restoring...';
ProFrm.MaxValue := ts.Count;
ProFrm.Show;
end;
for i := 0 to ts.Count - 1 do
begin
if FProgress then
ProFrm.Next;
s1 := ts.Strings[i];
if Copy(s1, 1, 2) = '#N' then
begin
Delete(s1, 1, 2);
tb := s1;
QueryExecSQL('DELETE FROM ' + tb);
end
else if Copy(s1, 1, 2) = '#E' then
begin
Delete(s1, 1, 3);
a := StrToInt(s1);
end
else if Copy(s1, 1, 2) = '#F' then
begin
Delete(s1, 1, 3);
nm := '';
while s1 <> '' do
begin
if nm <> '' then
nm := nm + ', ';
nm := nm + GetToken(s1, '|');
end;
end
else if Copy(s1, 1, 2) = '#T' then
begin
Delete(s1, 1, 3);
ty := s1;
end
else if Copy(s1, 1, 2) = '#D' then
begin
Delete(s1, 1, 3);
s2 := ty;
s3 := '';
while s1 <> '' do
begin
if s3 <> '' then
s3 := s3 + ', ';
if Pos('|', s1) <> 0 then
begin
if Copy(s2, 1, Pos('|', s2) - 1) = 'S' then
s3 := s3 + QuotedStr(AnsiToUTF8(Copy(s1, 1, Pos('|', s1) - 1)))
else
s3 := s3 + Copy(s1, 1, Pos('|', s1) - 1);
Delete(s1, 1, Pos('|', s1));
end
else
begin
if Copy(s2, 1, Pos('|', s2) - 1) = 'S' then
s3 := s3 + QuotedStr(AnsiToUTF8(s1))
else
s3 := s3 + s1;
s1 := '';
end;
Delete(s2, 1, Pos('|', s2));
end;
QueryExecSQL('INSERT INTO ' + tb + ' (' + nm + ') VALUES (' + s3 + ')');
end;
if (a <> 0) then
SetAutoInc(tb, a);
end;
if FProgress then
FreeAndNil(ProFrm);
finally
ts.Clear;
FreeAndNil(ts);
end;
if Assigned(FOnRestore) then
FOnRestore(Self);
end;
procedure TDataUtil.LoadConfig(aFile: string);
var
fl: file;
r: Integer;
begin
if not FileExists(UTF8ToAnsi(aFile)) then
begin
FConfig.HostName := '';
FConfig.UserName := 'SYSDBA';
FConfig.Password := 'masterkey';
FConfig.Database := '';
FConfig.Protocol := 'firebird-2.5';
FConfig.Port := 0;
FConfig.DataType := tdtEmbed;
end
else
begin
AssignFile(fl, aFile);
Reset(fl, 1);
BlockRead(fl, FConfig, SizeOf(TConfig), r);
CloseFile(fl);
end;
end;
procedure TDataUtil.SaveConfig(aFile: string);
var
fl: file;
w: Integer;
begin
AssignFile(fl, aFile);
Rewrite(fl, 1);
BlockWrite(fl, FConfig, SizeOf(TConfig), w);
CloseFile(fl);
end;
function TDataUtil.GetDBEmbed(aDB: string): string;
begin
if ExtractFilePath(aDB) = '' then
aDB := Path + aDB;
if Pos('.FDB', aDB) = 0 then
aDB := aDB + '.FDB';
Result := aDB;
end;
function TDataUtil.IsFirebird: Boolean;
begin
Result := (DataType = tdtEmbed) or (DataType = tdtFirebird);
end;
procedure TDataUtil.LoadFromStream(aQuery: TZQuery; aFD: string; aMemo: TMemo);
var
aStream: TStream;
begin
if aQuery.Active then
begin
aMemo.Lines.Clear;
try
aStream := aQuery.CreateBlobStream(aQuery.FieldByName(UpperCase(aFD)), bmRead);
aStream.Position := 0;
if aStream.Size <> 0 then
aMemo.Lines.LoadFromStream(aStream);
finally
aStream.Free;
end;
end;
end;
procedure TDataUtil.LoadFromBlob(aQuery: TZQuery; aFD: string; aImg: TImage);
var
aStream: TStream;
begin
if aQuery.Active then
begin
if aQuery.FieldByName(aFD).DataType <> ftBlob then
raise Exception.Create('Field "' + aFD + '" is not BLOB Field!');
if aQuery.FieldByName(aFD).IsNull then
with aImg.Canvas do
begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect(0, 0, aImg.Width, aImg.Height);
end
else
try
aStream := aQuery.CreateBlobStream(aQuery.FieldByName(UpperCase(aFD)), bmRead);
aStream.Position := 0;
if aStream.Size <> 0 then
aImg.Picture.LoadFromStream(aStream);
finally
aStream.Free;
end;
end;
end;
procedure TDataUtil.SaveToBlob(aQuery: TZQuery; aFD: string; aStream: TStream);
begin
if aQuery.Active then
if aQuery.FieldByName(aFD).DataType <> ftBlob then
raise Exception.Create('Field "' + aFD + '" is not BLOB Field!')
else
TBlobField(aQuery.FieldByName(UpperCase(aFD))).LoadFromStream(aStream);
end;
end.