mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2026-03-13 09:24:25 +08:00
fix: compiler warnings, re-enable active line background
This commit is contained in:
Ansgar Becker
@@ -1,275 +1,277 @@
|
||||
unit createdatabase;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SynEdit,
|
||||
dbconnection, dbstructures, RegExpr, extra_controls;
|
||||
|
||||
type
|
||||
TCreateDatabaseForm = class(TExtForm)
|
||||
editDBName: TEdit;
|
||||
lblDBName: TLabel;
|
||||
btnOK: TButton;
|
||||
btnCancel: TButton;
|
||||
lblCollation: TLabel;
|
||||
comboCollation: TComboBox;
|
||||
lblCreateCode: TLabel;
|
||||
SynMemoCreateCode: TSynEdit;
|
||||
lblServerDefaultCollation: TLabel;
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure Modified(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
function GetCreateStatement: String;
|
||||
private
|
||||
{ Private declarations }
|
||||
FConnection: TDBConnection;
|
||||
public
|
||||
{ Public declarations }
|
||||
modifyDB : String;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses main, apphelpers;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
|
||||
procedure TCreateDatabaseForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
lblCreateCode.Caption := lblCreateCode.Caption + ':';
|
||||
// Setup SynMemoPreview
|
||||
SynMemoCreateCode.Highlighter := Mainform.SynSQLSynUsed;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Form gets displayed: Set default values.
|
||||
}
|
||||
procedure TCreateDatabaseForm.FormShow(Sender: TObject);
|
||||
var
|
||||
ServerCollation, PreviousCollation, CurrentCollation: String;
|
||||
Charset, CreateCode: String;
|
||||
CollationTable: TDBQuery;
|
||||
rx: TRegExpr;
|
||||
begin
|
||||
FConnection := MainForm.ActiveConnection;
|
||||
CollationTable := FConnection.CollationTable;
|
||||
CurrentCollation := '';
|
||||
PreviousCollation := AppSettings.ReadString(asCreateDbCollation);
|
||||
|
||||
// Detect servers default collation
|
||||
case FConnection.Parameters.NetTypeGroup of
|
||||
ngMySQL:
|
||||
ServerCollation := FConnection.GetSessionVariable('collation_server');
|
||||
else // TODO: Find out how to retrieve the server's default collation here
|
||||
ServerCollation := '';
|
||||
end;
|
||||
lblServerDefaultCollation.Caption := f_('Servers default: %s', [ServerCollation]);
|
||||
|
||||
if modifyDB.IsEmpty then begin
|
||||
Caption := _('Create database ...');
|
||||
editDBName.Text := '';
|
||||
end
|
||||
else begin
|
||||
Caption := _('Alter database ...');
|
||||
editDBName.Text := modifyDB;
|
||||
|
||||
// Detect current collation
|
||||
CreateCode := FConnection.GetVar('SHOW CREATE DATABASE '+FConnection.QuoteIdent(modifyDB), 1);
|
||||
rx := TRegExpr.Create;
|
||||
rx.Expression := '\sCHARACTER\s+SET\s+(\w+)\b';
|
||||
if rx.Exec(CreateCode) then
|
||||
Charset := rx.Match[1];
|
||||
rx.Expression := '\sCOLLATE\s+(\w+)\b';
|
||||
if rx.Exec(CreateCode) then
|
||||
CurrentCollation := rx.Match[1];
|
||||
rx.Free;
|
||||
// Find default collation of given charset
|
||||
if (CurrentCollation = '') and (Charset <> '') and Assigned(CollationTable) then begin
|
||||
while not CollationTable.Eof do begin
|
||||
if (CollationTable.Col('Charset') = Charset) and (LowerCase(CollationTable.Col('Default')) = 'yes') then
|
||||
CurrentCollation := CollationTable.Col('Collation');
|
||||
CollationTable.Next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Populate collation combo box
|
||||
comboCollation.Enabled := Assigned(CollationTable);
|
||||
lblCollation.Enabled := comboCollation.Enabled;
|
||||
comboCollation.Clear;
|
||||
if comboCollation.Enabled then begin
|
||||
CollationTable.First;
|
||||
while not CollationTable.Eof do begin
|
||||
comboCollation.Items.Add(CollationTable.Col('Collation'));
|
||||
CollationTable.Next;
|
||||
end;
|
||||
// Pre-select best fitting collation
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(CurrentCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(PreviousCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(ServerCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf('utf8mb4_unicode_ci');
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := 0; // give up, use the first one
|
||||
end;
|
||||
|
||||
editDBName.SetFocus;
|
||||
editDBName.SelectAll;
|
||||
|
||||
// Invoke SQL preview
|
||||
Modified(Sender);
|
||||
MainForm.SetupSynEditors(Self);
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Create the database
|
||||
}
|
||||
procedure TCreateDatabaseForm.btnOKClick(Sender: TObject);
|
||||
var
|
||||
sql : String;
|
||||
AllDatabases: TStringList;
|
||||
ObjectsLeft: TDBObjectList;
|
||||
ObjectsInNewDb, ObjectsInOldDb: TDBObjectList;
|
||||
i, j: Integer;
|
||||
begin
|
||||
if modifyDB.IsEmpty then try
|
||||
sql := GetCreateStatement;
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
AppSettings.WriteString(asCreateDbCollation, comboCollation.Text);
|
||||
MainForm.RefreshTree;
|
||||
// Close form
|
||||
ModalResult := mrOK;
|
||||
except
|
||||
on E:EDbError do
|
||||
ErrorDialog(f_('Creating database "%s" failed.', [editDBName.Text]), E.Message);
|
||||
// Keep form open
|
||||
end else try
|
||||
sql := 'ALTER DATABASE ' + FConnection.QuoteIdent(modifyDB);
|
||||
if comboCollation.Text <> '' then
|
||||
sql := sql + ' COLLATE ' + FConnection.EscapeString(comboCollation.Text);
|
||||
|
||||
if modifyDB = editDBName.Text then begin
|
||||
// Alter database
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
end else begin
|
||||
// Rename database
|
||||
ObjectsInOldDb := FConnection.GetDBObjects(modifyDB, True);
|
||||
AllDatabases := FConnection.GetCol('SHOW DATABASES');
|
||||
if AllDatabases.IndexOf(editDBName.Text) > -1 then
|
||||
ObjectsInNewDb := FConnection.GetDBObjects(editDBName.Text, True)
|
||||
else
|
||||
ObjectsInNewDb := nil; // Silence compiler warning
|
||||
// Warn if there are tables with same names in new db
|
||||
for i:=0 to ObjectsInOldDb.Count-1 do begin
|
||||
if not (ObjectsInOldDb[i].NodeType in [lntTable, lntView]) then
|
||||
Raise Exception.CreateFmt(_('Database "%s" contains stored routine(s), which cannot be moved.'), [modifyDB]);
|
||||
if Assigned(ObjectsInNewDb) then begin
|
||||
for j:=0 to ObjectsInNewDb.Count-1 do begin
|
||||
if (ObjectsInOldDb[i].Name = ObjectsInNewDb[j].Name)
|
||||
and (ObjectsInOldDb[i].NodeType = ObjectsInNewDb[j].NodeType) then begin
|
||||
// One or more objects have a naming conflict
|
||||
Raise Exception.CreateFmt(_('Database "%s" exists and has objects with same names as in "%s"'), [editDBName.Text, modifyDB]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AllDatabases.IndexOf(editDBName.Text) = -1 then begin
|
||||
// Target db does not exist - create it
|
||||
FConnection.Query(GetCreateStatement);
|
||||
FConnection.ShowWarnings;
|
||||
end else begin
|
||||
if MessageDialog(f_('Database "%s" exists. But it does not contain objects with same names as in "%s", so it''s uncritical to move everything. Move all objects to "%s"?', [editDBName.Text, modifyDB, editDBName.Text]),
|
||||
mtConfirmation, [mbYes, mbCancel]) <> mrYes then
|
||||
Exit;
|
||||
end;
|
||||
// Move all tables, views and procedures to target db
|
||||
sql := '';
|
||||
for i:=0 to ObjectsInOldDb.Count-1 do begin
|
||||
sql := sql + FConnection.QuoteIdent(modifyDb)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+' TO '+
|
||||
FConnection.QuoteIdent(editDBName.Text)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+', ';
|
||||
end;
|
||||
if sql <> '' then begin
|
||||
Delete(sql, Length(sql)-1, 2);
|
||||
sql := 'RENAME TABLE '+sql;
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
FConnection.ClearDbObjects(modifyDB);
|
||||
FConnection.ClearDbObjects(editDBName.Text);
|
||||
end;
|
||||
// Last check if old db is really empty, before we drop it.
|
||||
ObjectsLeft := FConnection.GetDBObjects(modifyDB);
|
||||
if ObjectsLeft.Count = 0 then begin
|
||||
FConnection.Query('DROP DATABASE '+FConnection.QuoteIdent(modifyDB));
|
||||
FConnection.ShowWarnings;
|
||||
MainForm.RefreshTree;
|
||||
end;
|
||||
end;
|
||||
// Close form
|
||||
ModalResult := mrOK;
|
||||
except
|
||||
on E:Exception do
|
||||
ErrorDialog(f_('Altering database "%s" failed.', [editDBName.Text]), E.Message);
|
||||
// Keep form open
|
||||
end;
|
||||
|
||||
// Save new db name to registry
|
||||
AllDatabases := Explode(';', FConnection.Parameters.AllDatabasesStr);
|
||||
if AllDatabases.Count > 0 then begin
|
||||
i := AllDatabases.IndexOf(modifyDB);
|
||||
if i > -1 then
|
||||
AllDatabases[i] := editDBname.Text
|
||||
else
|
||||
AllDatabases.Add(editDBname.Text);
|
||||
AppSettings.SessionPath := FConnection.Parameters.SessionPath;
|
||||
FConnection.Parameters.AllDatabasesStr := Implode(';', AllDatabases);
|
||||
AppSettings.WriteString(asDatabases, FConnection.Parameters.AllDatabasesStr);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Called on each change
|
||||
}
|
||||
procedure TCreateDatabaseForm.Modified(Sender: TObject);
|
||||
begin
|
||||
SynMemoCreateCode.Clear;
|
||||
SynMemoCreateCode.Text := GetCreateStatement;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Generate CREATE DATABASE statement, used for preview and execution
|
||||
}
|
||||
function TCreateDatabaseForm.GetCreateStatement: String;
|
||||
begin
|
||||
Result := 'CREATE DATABASE ' + FConnection.QuoteIdent( editDBName.Text );
|
||||
if comboCollation.Enabled and (comboCollation.Text <> '') then
|
||||
Result := Result + ' /*!40100 COLLATE ' + FConnection.EscapeString(comboCollation.Text) + ' */';
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Form gets closed: Reset potential modifyDB-value.
|
||||
}
|
||||
procedure TCreateDatabaseForm.FormClose(Sender: TObject; var Action:
|
||||
TCloseAction);
|
||||
begin
|
||||
modifyDB := '';
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
unit createdatabase;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SynEdit,
|
||||
dbconnection, dbstructures, RegExpr, extra_controls;
|
||||
|
||||
type
|
||||
TCreateDatabaseForm = class(TExtForm)
|
||||
editDBName: TEdit;
|
||||
lblDBName: TLabel;
|
||||
btnOK: TButton;
|
||||
btnCancel: TButton;
|
||||
lblCollation: TLabel;
|
||||
comboCollation: TComboBox;
|
||||
lblCreateCode: TLabel;
|
||||
SynMemoCreateCode: TSynEdit;
|
||||
lblServerDefaultCollation: TLabel;
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure Modified(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
function GetCreateStatement: String;
|
||||
private
|
||||
{ Private declarations }
|
||||
FConnection: TDBConnection;
|
||||
public
|
||||
{ Public declarations }
|
||||
modifyDB : String;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses main, apphelpers;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
|
||||
procedure TCreateDatabaseForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
lblCreateCode.Caption := lblCreateCode.Caption + ':';
|
||||
// Setup SynMemoPreview
|
||||
SynMemoCreateCode.Highlighter := Mainform.SynSQLSynUsed;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Form gets displayed: Set default values.
|
||||
}
|
||||
procedure TCreateDatabaseForm.FormShow(Sender: TObject);
|
||||
var
|
||||
ServerCollation, PreviousCollation, CurrentCollation: String;
|
||||
Charset, CreateCode: String;
|
||||
CollationTable: TDBQuery;
|
||||
rx: TRegExpr;
|
||||
begin
|
||||
FConnection := MainForm.ActiveConnection;
|
||||
CollationTable := FConnection.CollationTable;
|
||||
CurrentCollation := '';
|
||||
PreviousCollation := AppSettings.ReadString(asCreateDbCollation);
|
||||
|
||||
// Detect servers default collation
|
||||
case FConnection.Parameters.NetTypeGroup of
|
||||
ngMySQL:
|
||||
ServerCollation := FConnection.GetSessionVariable('collation_server');
|
||||
else // TODO: Find out how to retrieve the server's default collation here
|
||||
ServerCollation := '';
|
||||
end;
|
||||
lblServerDefaultCollation.Caption := f_('Servers default: %s', [ServerCollation]);
|
||||
|
||||
if modifyDB.IsEmpty then begin
|
||||
Caption := _('Create database ...');
|
||||
editDBName.Text := '';
|
||||
end
|
||||
else begin
|
||||
Caption := _('Alter database ...');
|
||||
editDBName.Text := modifyDB;
|
||||
|
||||
// Detect current collation
|
||||
CreateCode := FConnection.GetVar('SHOW CREATE DATABASE '+FConnection.QuoteIdent(modifyDB), 1);
|
||||
rx := TRegExpr.Create;
|
||||
rx.Expression := '\sCHARACTER\s+SET\s+(\w+)\b';
|
||||
if rx.Exec(CreateCode) then
|
||||
Charset := rx.Match[1]
|
||||
else
|
||||
Charset := '';
|
||||
rx.Expression := '\sCOLLATE\s+(\w+)\b';
|
||||
if rx.Exec(CreateCode) then
|
||||
CurrentCollation := rx.Match[1];
|
||||
rx.Free;
|
||||
// Find default collation of given charset
|
||||
if (CurrentCollation = '') and (Charset <> '') and Assigned(CollationTable) then begin
|
||||
while not CollationTable.Eof do begin
|
||||
if (CollationTable.Col('Charset') = Charset) and (LowerCase(CollationTable.Col('Default')) = 'yes') then
|
||||
CurrentCollation := CollationTable.Col('Collation');
|
||||
CollationTable.Next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Populate collation combo box
|
||||
comboCollation.Enabled := Assigned(CollationTable);
|
||||
lblCollation.Enabled := comboCollation.Enabled;
|
||||
comboCollation.Clear;
|
||||
if comboCollation.Enabled then begin
|
||||
CollationTable.First;
|
||||
while not CollationTable.Eof do begin
|
||||
comboCollation.Items.Add(CollationTable.Col('Collation'));
|
||||
CollationTable.Next;
|
||||
end;
|
||||
// Pre-select best fitting collation
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(CurrentCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(PreviousCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf(ServerCollation);
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := comboCollation.Items.IndexOf('utf8mb4_unicode_ci');
|
||||
if comboCollation.ItemIndex = -1 then
|
||||
comboCollation.ItemIndex := 0; // give up, use the first one
|
||||
end;
|
||||
|
||||
editDBName.SetFocus;
|
||||
editDBName.SelectAll;
|
||||
|
||||
// Invoke SQL preview
|
||||
Modified(Sender);
|
||||
MainForm.SetupSynEditors(Self);
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Create the database
|
||||
}
|
||||
procedure TCreateDatabaseForm.btnOKClick(Sender: TObject);
|
||||
var
|
||||
sql : String;
|
||||
AllDatabases: TStringList;
|
||||
ObjectsLeft: TDBObjectList;
|
||||
ObjectsInNewDb, ObjectsInOldDb: TDBObjectList;
|
||||
i, j: Integer;
|
||||
begin
|
||||
if modifyDB.IsEmpty then try
|
||||
sql := GetCreateStatement;
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
AppSettings.WriteString(asCreateDbCollation, comboCollation.Text);
|
||||
MainForm.RefreshTree;
|
||||
// Close form
|
||||
ModalResult := mrOK;
|
||||
except
|
||||
on E:EDbError do
|
||||
ErrorDialog(f_('Creating database "%s" failed.', [editDBName.Text]), E.Message);
|
||||
// Keep form open
|
||||
end else try
|
||||
sql := 'ALTER DATABASE ' + FConnection.QuoteIdent(modifyDB);
|
||||
if comboCollation.Text <> '' then
|
||||
sql := sql + ' COLLATE ' + FConnection.EscapeString(comboCollation.Text);
|
||||
|
||||
if modifyDB = editDBName.Text then begin
|
||||
// Alter database
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
end else begin
|
||||
// Rename database
|
||||
ObjectsInOldDb := FConnection.GetDBObjects(modifyDB, True);
|
||||
AllDatabases := FConnection.GetCol('SHOW DATABASES');
|
||||
if AllDatabases.IndexOf(editDBName.Text) > -1 then
|
||||
ObjectsInNewDb := FConnection.GetDBObjects(editDBName.Text, True)
|
||||
else
|
||||
ObjectsInNewDb := nil; // Silence compiler warning
|
||||
// Warn if there are tables with same names in new db
|
||||
for i:=0 to ObjectsInOldDb.Count-1 do begin
|
||||
if not (ObjectsInOldDb[i].NodeType in [lntTable, lntView]) then
|
||||
Raise Exception.CreateFmt(_('Database "%s" contains stored routine(s), which cannot be moved.'), [modifyDB]);
|
||||
if Assigned(ObjectsInNewDb) then begin
|
||||
for j:=0 to ObjectsInNewDb.Count-1 do begin
|
||||
if (ObjectsInOldDb[i].Name = ObjectsInNewDb[j].Name)
|
||||
and (ObjectsInOldDb[i].NodeType = ObjectsInNewDb[j].NodeType) then begin
|
||||
// One or more objects have a naming conflict
|
||||
Raise Exception.CreateFmt(_('Database "%s" exists and has objects with same names as in "%s"'), [editDBName.Text, modifyDB]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AllDatabases.IndexOf(editDBName.Text) = -1 then begin
|
||||
// Target db does not exist - create it
|
||||
FConnection.Query(GetCreateStatement);
|
||||
FConnection.ShowWarnings;
|
||||
end else begin
|
||||
if MessageDialog(f_('Database "%s" exists. But it does not contain objects with same names as in "%s", so it''s uncritical to move everything. Move all objects to "%s"?', [editDBName.Text, modifyDB, editDBName.Text]),
|
||||
mtConfirmation, [mbYes, mbCancel]) <> mrYes then
|
||||
Exit;
|
||||
end;
|
||||
// Move all tables, views and procedures to target db
|
||||
sql := '';
|
||||
for i:=0 to ObjectsInOldDb.Count-1 do begin
|
||||
sql := sql + FConnection.QuoteIdent(modifyDb)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+' TO '+
|
||||
FConnection.QuoteIdent(editDBName.Text)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+', ';
|
||||
end;
|
||||
if sql <> '' then begin
|
||||
Delete(sql, Length(sql)-1, 2);
|
||||
sql := 'RENAME TABLE '+sql;
|
||||
FConnection.Query(sql);
|
||||
FConnection.ShowWarnings;
|
||||
FConnection.ClearDbObjects(modifyDB);
|
||||
FConnection.ClearDbObjects(editDBName.Text);
|
||||
end;
|
||||
// Last check if old db is really empty, before we drop it.
|
||||
ObjectsLeft := FConnection.GetDBObjects(modifyDB);
|
||||
if ObjectsLeft.Count = 0 then begin
|
||||
FConnection.Query('DROP DATABASE '+FConnection.QuoteIdent(modifyDB));
|
||||
FConnection.ShowWarnings;
|
||||
MainForm.RefreshTree;
|
||||
end;
|
||||
end;
|
||||
// Close form
|
||||
ModalResult := mrOK;
|
||||
except
|
||||
on E:Exception do
|
||||
ErrorDialog(f_('Altering database "%s" failed.', [editDBName.Text]), E.Message);
|
||||
// Keep form open
|
||||
end;
|
||||
|
||||
// Save new db name to registry
|
||||
AllDatabases := Explode(';', FConnection.Parameters.AllDatabasesStr);
|
||||
if AllDatabases.Count > 0 then begin
|
||||
i := AllDatabases.IndexOf(modifyDB);
|
||||
if i > -1 then
|
||||
AllDatabases[i] := editDBname.Text
|
||||
else
|
||||
AllDatabases.Add(editDBname.Text);
|
||||
AppSettings.SessionPath := FConnection.Parameters.SessionPath;
|
||||
FConnection.Parameters.AllDatabasesStr := Implode(';', AllDatabases);
|
||||
AppSettings.WriteString(asDatabases, FConnection.Parameters.AllDatabasesStr);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Called on each change
|
||||
}
|
||||
procedure TCreateDatabaseForm.Modified(Sender: TObject);
|
||||
begin
|
||||
SynMemoCreateCode.Clear;
|
||||
SynMemoCreateCode.Text := GetCreateStatement;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Generate CREATE DATABASE statement, used for preview and execution
|
||||
}
|
||||
function TCreateDatabaseForm.GetCreateStatement: String;
|
||||
begin
|
||||
Result := 'CREATE DATABASE ' + FConnection.QuoteIdent( editDBName.Text );
|
||||
if comboCollation.Enabled and (comboCollation.Text <> '') then
|
||||
Result := Result + ' /*!40100 COLLATE ' + FConnection.EscapeString(comboCollation.Text) + ' */';
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Form gets closed: Reset potential modifyDB-value.
|
||||
}
|
||||
procedure TCreateDatabaseForm.FormClose(Sender: TObject; var Action:
|
||||
TCloseAction);
|
||||
begin
|
||||
modifyDB := '';
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@@ -2584,11 +2584,10 @@ end;
|
||||
|
||||
procedure TSqlSrvConnection.SetActive(Value: Boolean);
|
||||
var
|
||||
Error, NetLib, DataSource, QuotedPassword, ServerVersion, ErrorHint: String;
|
||||
Error, ServerVersion, ErrorHint: String;
|
||||
FinalHost: String;
|
||||
rx: TRegExpr;
|
||||
FinalPort, i: Integer;
|
||||
IsOldProvider: Boolean;
|
||||
FinalPort: Integer;
|
||||
begin
|
||||
if Value then begin
|
||||
DoBeforeConnect;
|
||||
@@ -5078,6 +5077,8 @@ begin
|
||||
Result := escChars(Text, EscChar, c1, c2, c3, c4);
|
||||
end;
|
||||
|
||||
else Result := '';
|
||||
|
||||
end;
|
||||
|
||||
if DoQuote then begin
|
||||
@@ -5248,6 +5249,7 @@ begin
|
||||
if rx.Exec(SQL) then begin
|
||||
LitStart := rx.MatchLen[0]+1;
|
||||
InLiteral := True;
|
||||
i := 0;
|
||||
for i:=LitStart to Length(SQL) do begin
|
||||
if SQL[i] = '''' then
|
||||
InLiteral := not InLiteral
|
||||
@@ -6718,6 +6720,7 @@ begin
|
||||
frInvisibleColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100303)) or
|
||||
(FParameters.IsMySQL(True) and (ServerVersionInt >= 80023));
|
||||
frCompressedColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100301));
|
||||
else Result := False;
|
||||
end;
|
||||
else Result := False;
|
||||
end;
|
||||
@@ -8963,6 +8966,7 @@ var
|
||||
c: Char;
|
||||
Field: PMYSQL_FIELD;
|
||||
begin
|
||||
Result := '';
|
||||
if ColumnExists(Column) then begin
|
||||
if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
|
||||
// Row was edited and only valid in a TGridRow
|
||||
@@ -9035,6 +9039,7 @@ function TPGQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String;
|
||||
var
|
||||
AnsiStr: AnsiString;
|
||||
begin
|
||||
Result := '';
|
||||
if ColumnExists(Column) then begin
|
||||
if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
|
||||
Result := FCurrentUpdateRow[Column].NewText;
|
||||
@@ -9054,6 +9059,7 @@ end;
|
||||
|
||||
function TSQLiteQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String;
|
||||
begin
|
||||
Result := '';
|
||||
if ColumnExists(Column) then begin
|
||||
if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin
|
||||
Result := FCurrentUpdateRow[Column].NewText;
|
||||
@@ -9084,6 +9090,7 @@ var
|
||||
begin
|
||||
// ColumnNames is case insensitive, so we can select wrong cased columns in MariaDB 10.4
|
||||
// See #599
|
||||
Result := '';
|
||||
idx := ColumnNames.IndexOf(ColumnName);
|
||||
if idx > -1 then
|
||||
Result := Col(idx)
|
||||
@@ -9858,6 +9865,7 @@ begin
|
||||
end else begin
|
||||
// Return first available Field.db property, or just the current database as fallback.
|
||||
// For a view in db1 selecting from db2, this returns db2, which triggers errors in GetCreateViewCode!
|
||||
Result := '';
|
||||
for i:=0 to ColumnCount-1 do begin
|
||||
Field := FConnection.Lib.mysql_fetch_field_direct(FCurrentResults, i);
|
||||
if Field.db <> '' then begin
|
||||
@@ -10871,6 +10879,7 @@ begin
|
||||
InLiteral := False;
|
||||
ParenthLeft := Pos('(', Source);
|
||||
if (ParenthLeft > 0) and DataType.HasLength then begin
|
||||
i := 0;
|
||||
for i:=ParenthLeft+1 to Length(Source) do begin
|
||||
if (Source[i] = ')') and (not InLiteral) then
|
||||
break;
|
||||
|
||||
@@ -12313,7 +12313,7 @@ begin
|
||||
//QueryTab.Memo.Gutter.Parts.Add(TSynGutterCodeFolding.Create(QueryTab.Memo.Gutter.Parts));
|
||||
//QueryTab.Memo.Gutter.Parts[1].Width := SynMemoQuery.Gutter.Parts[1].Width;
|
||||
QueryTab.Memo.Font.Assign(SynMemoQuery.Font);
|
||||
//QueryTab.Memo.ActiveLineColor := SynMemoQuery.ActiveLineColor;
|
||||
QueryTab.Memo.LineHighlightColor.Background := SynMemoQuery.LineHighlightColor.Background;
|
||||
QueryTab.Memo.OnStatusChange := SynMemoQuery.OnStatusChange;
|
||||
QueryTab.Memo.OnSpecialLineColors := SynMemoQuery.OnSpecialLineColors;
|
||||
QueryTab.Memo.OnDragDrop := SynMemoQuery.OnDragDrop;
|
||||
@@ -13253,7 +13253,8 @@ begin
|
||||
else if tab = tabDatabase then f := FFilterTextDatabase
|
||||
else if tab = tabEditor then f := FFilterTextEditor
|
||||
else if tab = tabData then f := FFilterTextData
|
||||
else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText;
|
||||
else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText
|
||||
else f := '';
|
||||
if editFilterVT.Text <> f then
|
||||
editFilterVT.Text := f
|
||||
else
|
||||
@@ -13392,7 +13393,7 @@ begin
|
||||
Editor.OnScanForFoldRanges := BaseEditor.OnScanForFoldRanges;
|
||||
Editor.UseCodeFolding := actCodeFolding.Checked;}
|
||||
end;
|
||||
//Editor.ActiveLineColor := StringToColor(AppSettings.ReadString(asSQLColActiveLine));
|
||||
Editor.LineHighlightColor.Background := StringToColor(AppSettings.ReadString(asSQLColActiveLine));
|
||||
Editor.Options := BaseEditor.Options;
|
||||
if Editor = SynMemoSQLLog then
|
||||
Editor.Options := Editor.Options + [eoRightMouseMovesCursor];
|
||||
@@ -13550,7 +13551,10 @@ begin
|
||||
end else if MenuItem = menuQueryHelpersGenerateDelete then begin
|
||||
sql := 'DELETE FROM '+ActiveDbObj.QuotedName(False)+' WHERE ' + WhereClause;
|
||||
|
||||
end else begin
|
||||
sql := '';
|
||||
end;
|
||||
|
||||
//QueryTabs.ActiveMemo.UndoList.AddGroupBreak;
|
||||
QueryTabs.ActiveMemo.SelText := sql;
|
||||
end;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -620,7 +620,6 @@ var
|
||||
Col, PreviousCol: TTableColumn;
|
||||
TblKey: TTableKey;
|
||||
Constraint: TCheckConstraint;
|
||||
Node: PVirtualNode;
|
||||
Conn: TDBConnection;
|
||||
|
||||
procedure FinishSpecs;
|
||||
@@ -714,7 +713,6 @@ begin
|
||||
end;
|
||||
|
||||
// Update columns
|
||||
Node := listColumns.GetFirst;
|
||||
PreviousCol := nil;
|
||||
for Col in FColumns do begin
|
||||
if Col.Status <> esUntouched then begin
|
||||
|
||||
@@ -1,342 +1,344 @@
|
||||
unit updatecheck;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics,
|
||||
apphelpers, ExtCtrls, extra_controls, StrUtils, Dialogs,
|
||||
Menus, Clipbrd, generic_types, DateUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmUpdateCheck }
|
||||
|
||||
TfrmUpdateCheck = class(TExtForm)
|
||||
btnCancel: TButton;
|
||||
groupBuild: TGroupBox;
|
||||
btnBuild: TButton;
|
||||
groupRelease: TGroupBox;
|
||||
LinkLabelRelease: TLabel;
|
||||
lblStatus: TLabel;
|
||||
memoRelease: TMemo;
|
||||
memoBuild: TMemo;
|
||||
btnChangelog: TButton;
|
||||
popupDownloadRelease: TPopupMenu;
|
||||
CopydownloadURL1: TMenuItem;
|
||||
btnDonate: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnBuildClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure LinkLabelReleaseLinkClick(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure btnChangelogClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure CopydownloadURL1Click(Sender: TObject);
|
||||
const
|
||||
SLinkDownloadRelease= 'download-release';
|
||||
SLinkInstructionsPortable = 'instructions-portable';
|
||||
SLinkChangelog = 'changelog';
|
||||
private
|
||||
{ Private declarations }
|
||||
BuildURL: String;
|
||||
FRestartTaskName: String;
|
||||
procedure Status(txt: String);
|
||||
function GetLinkUrl(Sender: TObject; LinkType: String): String;
|
||||
function GetTaskXmlFileContents: String;
|
||||
public
|
||||
{ Public declarations }
|
||||
BuildRevision: Integer;
|
||||
procedure ReadCheckFile;
|
||||
end;
|
||||
|
||||
procedure DeleteRestartTask;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses main;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{$I const.inc}
|
||||
|
||||
|
||||
|
||||
{**
|
||||
Set defaults
|
||||
}
|
||||
procedure TfrmUpdateCheck.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// Should be false by default. Callers can set this to True after Create()
|
||||
btnDonate.OnClick := MainForm.DonateClick;
|
||||
btnDonate.Visible := MainForm.HasDonated(False) = nbFalse;
|
||||
btnDonate.Caption := f_('Donate to the %s project', [APPNAME]);
|
||||
HasSizeGrip := True;
|
||||
Width := AppSettings.ReadInt(asUpdateCheckWindowWidth);
|
||||
Height := AppSettings.ReadInt(asUpdateCheckWindowHeight);
|
||||
FRestartTaskName := 'yet_invalid';
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
if ModalResult <> btnBuild.ModalResult then begin
|
||||
DeleteRestartTask;
|
||||
end;
|
||||
end;
|
||||
|
||||
{**
|
||||
Update status text
|
||||
}
|
||||
procedure TfrmUpdateCheck.Status(txt: String);
|
||||
begin
|
||||
lblStatus.Caption := txt;
|
||||
lblStatus.Repaint;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Download check file
|
||||
}
|
||||
procedure TfrmUpdateCheck.FormShow(Sender: TObject);
|
||||
begin
|
||||
Caption := f_('Check for %s updates', [APPNAME]) + ' ...';
|
||||
Screen.Cursor := crHourglass;
|
||||
try
|
||||
Status(_('Downloading check file')+' ...');
|
||||
ReadCheckFile;
|
||||
// Developer versions probably have "unknown" (0) as revision,
|
||||
// which makes it impossible to compare the revisions.
|
||||
if Mainform.AppVerRevision = 0 then
|
||||
Status(_('Error: Cannot determine current revision. Using a developer version?'))
|
||||
else if Mainform.AppVerRevision = BuildRevision then
|
||||
Status(f_('Your %s is up-to-date (no update available).', [APPNAME]))
|
||||
else if groupRelease.Enabled or btnBuild.Enabled then
|
||||
Status(_('Updates available.'));
|
||||
except
|
||||
// Do not popup errors, just display them in the status label
|
||||
on E:Exception do
|
||||
Status(E.Message);
|
||||
end;
|
||||
Screen.Cursor := crDefault;
|
||||
btnCancel.TrySetFocus;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Parse check file for updated version + release
|
||||
}
|
||||
procedure TfrmUpdateCheck.ReadCheckFile;
|
||||
var
|
||||
CheckfileDownload: THttpDownLoad;
|
||||
CheckFilename, TaskXmlFile: String;
|
||||
Ini: TIniFile;
|
||||
ReleaseVersion, ReleasePackage: String;
|
||||
ReleaseRevision: Integer;
|
||||
Note: String;
|
||||
Compiled: TDateTime;
|
||||
const
|
||||
INISECT_RELEASE = 'Release';
|
||||
INISECT_BUILD = 'Build';
|
||||
begin
|
||||
// Init GUI controls
|
||||
LinkLabelRelease.Enabled := False;
|
||||
btnBuild.Enabled := False;
|
||||
memoRelease.Clear;
|
||||
memoBuild.Clear;
|
||||
|
||||
// Prepare download
|
||||
CheckfileDownload := THttpDownload.Create(Self);
|
||||
CheckfileDownload.TimeOut := 5;
|
||||
CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&bits='+IntToStr(GetExecutableBits)+'&os='+EncodeURLParam(GetOS.ToLower)+'&t='+EncodeURLParam(DateTimeToStr(Now));
|
||||
CheckFilename := GetTempDir + APPNAME + '_updatecheck.ini';
|
||||
|
||||
// Download the check file
|
||||
CheckfileDownload.SendRequest(CheckFilename);
|
||||
// Remember when we did the updatecheck to enable the automatic interval
|
||||
AppSettings.WriteString(asUpdatecheckLastrun, DateTimeToStr(Now));
|
||||
|
||||
// Read [Release] section of check file
|
||||
Ini := TIniFile.Create(CheckFilename);
|
||||
if Ini.SectionExists(INISECT_RELEASE) then begin
|
||||
ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown');
|
||||
ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0);
|
||||
ReleasePackage := IfThen(AppSettings.PortableMode, 'portable', 'installer');
|
||||
memoRelease.Lines.Add(f_('Version %s (yours: %s)', [ReleaseVersion, Mainform.AppVersion]));
|
||||
memoRelease.Lines.Add(f_('Released: %s', [Ini.ReadString(INISECT_RELEASE, 'Date', '')]));
|
||||
Note := Ini.ReadString(INISECT_RELEASE, 'Note', '');
|
||||
if Note <> '' then
|
||||
memoRelease.Lines.Add(_('Notes') + ': ' + Note);
|
||||
|
||||
LinkLabelRelease.Caption := f_('Download version %s (%s)', [ReleaseVersion, ReleasePackage]);
|
||||
//LinkLabelRelease.Caption := '<a id="'+SLinkDownloadRelease+'">' + LinkLabelRelease.Caption + '</a>';
|
||||
//if AppSettings.PortableMode then begin
|
||||
// LinkLabelRelease.Caption := LinkLabelRelease.Caption + ' <a id="'+SLinkInstructionsPortable+'">'+_('Update instructions')+'</a>';
|
||||
//end;
|
||||
|
||||
// Enable the download button if the current version is outdated
|
||||
groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision;
|
||||
LinkLabelRelease.Enabled := groupRelease.Enabled;
|
||||
LinkLabelRelease.Font.Style := LinkLabelRelease.Font.Style + [fsUnderline];
|
||||
memoRelease.Enabled := groupRelease.Enabled;
|
||||
if not memoRelease.Enabled then
|
||||
memoRelease.Font.Color := GetThemeColor(cl3DDkShadow)
|
||||
else
|
||||
memoRelease.Font.Color := GetThemeColor(clWindowText);
|
||||
end;
|
||||
|
||||
// Read [Build] section of check file
|
||||
if Ini.SectionExists(INISECT_BUILD) then begin
|
||||
BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0);
|
||||
BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', '');
|
||||
memoBuild.Lines.Add(f_('Revision %d (yours: %d)', [BuildRevision, Mainform.AppVerRevision]));
|
||||
FileAge(ParamStr(0), Compiled);
|
||||
memoBuild.Lines.Add(f_('Compiled: %s (yours: %s)', [Ini.ReadString(INISECT_BUILD, 'Date', ''), DateToStr(Compiled)]));
|
||||
Note := Ini.ReadString(INISECT_BUILD, 'Note', '');
|
||||
if Note <> '' then
|
||||
memoBuild.Lines.Add(_('Notes') + ': * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) );
|
||||
if GetExecutableBits = 64 then begin
|
||||
btnBuild.Caption := f_('Download and install build %d', [BuildRevision]);
|
||||
// A new release should have priority over a new nightly build.
|
||||
// So the user should not be able to download a newer build here
|
||||
// before having installed the new release.
|
||||
//btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not LinkLabelRelease.Enabled));
|
||||
end
|
||||
else begin
|
||||
btnBuild.Caption := _('No build updates for 32 bit version');
|
||||
end;
|
||||
|
||||
if btnBuild.Enabled then begin
|
||||
TaskXmlFile := GetTempDir + APPNAME + '_task_restart.xml';
|
||||
SaveUnicodeFile(TaskXmlFile, GetTaskXmlFileContents, UTF8NoBOMEncoding);
|
||||
FRestartTaskName := ValidFilename(ParamStr(0));
|
||||
ShellExec('schtasks', '', '/Create /TN "'+FRestartTaskName+'" /xml '+TaskXmlFile, True);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
if FileExists(CheckFilename) then
|
||||
DeleteFile(CheckFilename);
|
||||
FreeAndNil(CheckfileDownload);
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Download release package via web browser
|
||||
}
|
||||
procedure TfrmUpdateCheck.LinkLabelReleaseLinkClick(Sender: TObject);
|
||||
begin
|
||||
ShellExec(GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease));
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmUpdateCheck.btnChangelogClick(Sender: TObject);
|
||||
begin
|
||||
ShellExec(GetLinkUrl(Sender, SLinkChangelog));
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmUpdateCheck.CopydownloadURL1Click(Sender: TObject);
|
||||
begin
|
||||
Clipboard.TryAsText := GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease);
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject);
|
||||
begin
|
||||
// No auto-update
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
AppSettings.WriteInt(asUpdateCheckWindowWidth, ScaleFormToDesign(Width));
|
||||
AppSettings.WriteInt(asUpdateCheckWindowHeight, ScaleFormToDesign(Height));
|
||||
end;
|
||||
|
||||
|
||||
function TfrmUpdateCheck.GetLinkUrl(Sender: TObject; LinkType: String): String;
|
||||
var
|
||||
DownloadParam, PlaceParam, OsParam: String;
|
||||
begin
|
||||
PlaceParam := 'place='+EncodeURLParam(TWinControl(Sender).Name);
|
||||
OsParam := 'os='+EncodeURLParam(GetOS.ToLower);
|
||||
|
||||
if LinkType = SLinkDownloadRelease then begin
|
||||
if AppSettings.PortableMode then begin
|
||||
if GetExecutableBits = 64 then
|
||||
DownloadParam := 'download=portable-64'
|
||||
else
|
||||
DownloadParam := 'download=portable';
|
||||
end else begin
|
||||
DownloadParam := 'download=installer';
|
||||
end;
|
||||
Result := 'download.php?'+DownloadParam+'&'+PlaceParam+'&'+OsParam;
|
||||
end
|
||||
|
||||
else if LinkType = SLinkChangelog then begin
|
||||
Result := 'changes-lazarus';
|
||||
end;
|
||||
|
||||
Result := APPDOMAIN + Result;
|
||||
end;
|
||||
|
||||
|
||||
function TfrmUpdateCheck.GetTaskXmlFileContents: String;
|
||||
begin
|
||||
Result := '<?xml version="1.0" encoding="UTF-16"?>' + sLineBreak +
|
||||
'<Task version="1.2" xmlns="http://schemas.microsoft.com/windows/2004/02/mit/task">' + sLineBreak +
|
||||
' <RegistrationInfo>' + sLineBreak +
|
||||
' <Date>2022-12-24T12:39:17.5068755</Date>' + sLineBreak +
|
||||
' <Author>' + APPNAME + ' ' + MainForm.AppVersion + '</Author>' + sLineBreak +
|
||||
' <URI>\' + APPNAME + '_restart</URI>' + sLineBreak +
|
||||
' </RegistrationInfo>' + sLineBreak +
|
||||
' <Triggers>' + sLineBreak +
|
||||
' <TimeTrigger>' + sLineBreak +
|
||||
' <StartBoundary>2022-12-24T12:42:36</StartBoundary>' + sLineBreak +
|
||||
' <Enabled>true</Enabled>' + sLineBreak +
|
||||
' </TimeTrigger>' + sLineBreak +
|
||||
' </Triggers>' + sLineBreak +
|
||||
' <Principals>' + sLineBreak +
|
||||
' <Principal id="Author">' + sLineBreak +
|
||||
// Note: no <UserId> with the current users SID
|
||||
' <LogonType>InteractiveToken</LogonType>' + sLineBreak +
|
||||
' <RunLevel>LeastPrivilege</RunLevel>' + sLineBreak +
|
||||
' </Principal>' + sLineBreak +
|
||||
' </Principals>' + sLineBreak +
|
||||
' <Settings>' + sLineBreak +
|
||||
' <MultipleInstancesPolicy>IgnoreNew</MultipleInstancesPolicy>' + sLineBreak +
|
||||
' <DisallowStartIfOnBatteries>true</DisallowStartIfOnBatteries>' + sLineBreak +
|
||||
' <StopIfGoingOnBatteries>true</StopIfGoingOnBatteries>' + sLineBreak +
|
||||
' <AllowHardTerminate>true</AllowHardTerminate>' + sLineBreak +
|
||||
' <StartWhenAvailable>false</StartWhenAvailable>' + sLineBreak +
|
||||
' <RunOnlyIfNetworkAvailable>false</RunOnlyIfNetworkAvailable>' + sLineBreak +
|
||||
' <IdleSettings>' + sLineBreak +
|
||||
' <StopOnIdleEnd>true</StopOnIdleEnd>' + sLineBreak +
|
||||
' <RestartOnIdle>false</RestartOnIdle>' + sLineBreak +
|
||||
' </IdleSettings>' + sLineBreak +
|
||||
' <AllowStartOnDemand>true</AllowStartOnDemand>' + sLineBreak +
|
||||
' <Enabled>true</Enabled>' + sLineBreak +
|
||||
' <Hidden>false</Hidden>' + sLineBreak +
|
||||
' <RunOnlyIfIdle>false</RunOnlyIfIdle>' + sLineBreak +
|
||||
' <WakeToRun>false</WakeToRun>' + sLineBreak +
|
||||
' <ExecutionTimeLimit>PT72H</ExecutionTimeLimit>' + sLineBreak +
|
||||
' <Priority>7</Priority>' + sLineBreak +
|
||||
' </Settings>' + sLineBreak +
|
||||
' <Actions Context="Author">' + sLineBreak +
|
||||
' <Exec>' + sLineBreak +
|
||||
' <Command>"' + ParamStr(0) + '"</Command>' + sLineBreak +
|
||||
' <Arguments>--runfrom=scheduler</Arguments>' + sLineBreak +
|
||||
' </Exec>' + sLineBreak +
|
||||
' </Actions>' + sLineBreak +
|
||||
'</Task>';
|
||||
end;
|
||||
|
||||
|
||||
procedure DeleteRestartTask;
|
||||
begin
|
||||
// TN = Task Name
|
||||
// F = Force, suppress prompt
|
||||
ShellExec('schtasks', '', '/Delete /TN "'+ValidFilename(ParamStr(0))+'" /F', True);
|
||||
end;
|
||||
|
||||
end.
|
||||
unit updatecheck;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics,
|
||||
apphelpers, ExtCtrls, extra_controls, StrUtils, Dialogs,
|
||||
Menus, Clipbrd, generic_types, DateUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmUpdateCheck }
|
||||
|
||||
TfrmUpdateCheck = class(TExtForm)
|
||||
btnCancel: TButton;
|
||||
groupBuild: TGroupBox;
|
||||
btnBuild: TButton;
|
||||
groupRelease: TGroupBox;
|
||||
LinkLabelRelease: TLabel;
|
||||
lblStatus: TLabel;
|
||||
memoRelease: TMemo;
|
||||
memoBuild: TMemo;
|
||||
btnChangelog: TButton;
|
||||
popupDownloadRelease: TPopupMenu;
|
||||
CopydownloadURL1: TMenuItem;
|
||||
btnDonate: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnBuildClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure LinkLabelReleaseLinkClick(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure btnChangelogClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure CopydownloadURL1Click(Sender: TObject);
|
||||
const
|
||||
SLinkDownloadRelease= 'download-release';
|
||||
SLinkInstructionsPortable = 'instructions-portable';
|
||||
SLinkChangelog = 'changelog';
|
||||
private
|
||||
{ Private declarations }
|
||||
BuildURL: String;
|
||||
FRestartTaskName: String;
|
||||
procedure Status(txt: String);
|
||||
function GetLinkUrl(Sender: TObject; LinkType: String): String;
|
||||
function GetTaskXmlFileContents: String;
|
||||
public
|
||||
{ Public declarations }
|
||||
BuildRevision: Integer;
|
||||
procedure ReadCheckFile;
|
||||
end;
|
||||
|
||||
procedure DeleteRestartTask;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses main;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{$I const.inc}
|
||||
|
||||
|
||||
|
||||
{**
|
||||
Set defaults
|
||||
}
|
||||
procedure TfrmUpdateCheck.FormCreate(Sender: TObject);
|
||||
begin
|
||||
// Should be false by default. Callers can set this to True after Create()
|
||||
btnDonate.OnClick := MainForm.DonateClick;
|
||||
btnDonate.Visible := MainForm.HasDonated(False) = nbFalse;
|
||||
btnDonate.Caption := f_('Donate to the %s project', [APPNAME]);
|
||||
HasSizeGrip := True;
|
||||
Width := AppSettings.ReadInt(asUpdateCheckWindowWidth);
|
||||
Height := AppSettings.ReadInt(asUpdateCheckWindowHeight);
|
||||
FRestartTaskName := 'yet_invalid';
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
if ModalResult <> btnBuild.ModalResult then begin
|
||||
DeleteRestartTask;
|
||||
end;
|
||||
end;
|
||||
|
||||
{**
|
||||
Update status text
|
||||
}
|
||||
procedure TfrmUpdateCheck.Status(txt: String);
|
||||
begin
|
||||
lblStatus.Caption := txt;
|
||||
lblStatus.Repaint;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Download check file
|
||||
}
|
||||
procedure TfrmUpdateCheck.FormShow(Sender: TObject);
|
||||
begin
|
||||
Caption := f_('Check for %s updates', [APPNAME]) + ' ...';
|
||||
Screen.Cursor := crHourglass;
|
||||
try
|
||||
Status(_('Downloading check file')+' ...');
|
||||
ReadCheckFile;
|
||||
// Developer versions probably have "unknown" (0) as revision,
|
||||
// which makes it impossible to compare the revisions.
|
||||
if Mainform.AppVerRevision = 0 then
|
||||
Status(_('Error: Cannot determine current revision. Using a developer version?'))
|
||||
else if Mainform.AppVerRevision = BuildRevision then
|
||||
Status(f_('Your %s is up-to-date (no update available).', [APPNAME]))
|
||||
else if groupRelease.Enabled or btnBuild.Enabled then
|
||||
Status(_('Updates available.'));
|
||||
except
|
||||
// Do not popup errors, just display them in the status label
|
||||
on E:Exception do
|
||||
Status(E.Message);
|
||||
end;
|
||||
Screen.Cursor := crDefault;
|
||||
btnCancel.TrySetFocus;
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Parse check file for updated version + release
|
||||
}
|
||||
procedure TfrmUpdateCheck.ReadCheckFile;
|
||||
var
|
||||
CheckfileDownload: THttpDownLoad;
|
||||
CheckFilename, TaskXmlFile: String;
|
||||
Ini: TIniFile;
|
||||
ReleaseVersion, ReleasePackage: String;
|
||||
ReleaseRevision: Integer;
|
||||
Note: String;
|
||||
Compiled: TDateTime;
|
||||
const
|
||||
INISECT_RELEASE = 'Release';
|
||||
INISECT_BUILD = 'Build';
|
||||
begin
|
||||
// Init GUI controls
|
||||
LinkLabelRelease.Enabled := False;
|
||||
btnBuild.Enabled := False;
|
||||
memoRelease.Clear;
|
||||
memoBuild.Clear;
|
||||
|
||||
// Prepare download
|
||||
CheckfileDownload := THttpDownload.Create(Self);
|
||||
CheckfileDownload.TimeOut := 5;
|
||||
CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&bits='+IntToStr(GetExecutableBits)+'&os='+EncodeURLParam(GetOS.ToLower)+'&t='+EncodeURLParam(DateTimeToStr(Now));
|
||||
CheckFilename := GetTempDir + APPNAME + '_updatecheck.ini';
|
||||
|
||||
// Download the check file
|
||||
CheckfileDownload.SendRequest(CheckFilename);
|
||||
// Remember when we did the updatecheck to enable the automatic interval
|
||||
AppSettings.WriteString(asUpdatecheckLastrun, DateTimeToStr(Now));
|
||||
|
||||
// Read [Release] section of check file
|
||||
Ini := TIniFile.Create(CheckFilename);
|
||||
if Ini.SectionExists(INISECT_RELEASE) then begin
|
||||
ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown');
|
||||
ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0);
|
||||
ReleasePackage := IfThen(AppSettings.PortableMode, 'portable', 'installer');
|
||||
memoRelease.Lines.Add(f_('Version %s (yours: %s)', [ReleaseVersion, Mainform.AppVersion]));
|
||||
memoRelease.Lines.Add(f_('Released: %s', [Ini.ReadString(INISECT_RELEASE, 'Date', '')]));
|
||||
Note := Ini.ReadString(INISECT_RELEASE, 'Note', '');
|
||||
if Note <> '' then
|
||||
memoRelease.Lines.Add(_('Notes') + ': ' + Note);
|
||||
|
||||
LinkLabelRelease.Caption := f_('Download version %s (%s)', [ReleaseVersion, ReleasePackage]);
|
||||
//LinkLabelRelease.Caption := '<a id="'+SLinkDownloadRelease+'">' + LinkLabelRelease.Caption + '</a>';
|
||||
//if AppSettings.PortableMode then begin
|
||||
// LinkLabelRelease.Caption := LinkLabelRelease.Caption + ' <a id="'+SLinkInstructionsPortable+'">'+_('Update instructions')+'</a>';
|
||||
//end;
|
||||
|
||||
// Enable the download button if the current version is outdated
|
||||
groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision;
|
||||
LinkLabelRelease.Enabled := groupRelease.Enabled;
|
||||
LinkLabelRelease.Font.Style := LinkLabelRelease.Font.Style + [fsUnderline];
|
||||
memoRelease.Enabled := groupRelease.Enabled;
|
||||
if not memoRelease.Enabled then
|
||||
memoRelease.Font.Color := GetThemeColor(cl3DDkShadow)
|
||||
else
|
||||
memoRelease.Font.Color := GetThemeColor(clWindowText);
|
||||
end;
|
||||
|
||||
// Read [Build] section of check file
|
||||
if Ini.SectionExists(INISECT_BUILD) then begin
|
||||
BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0);
|
||||
BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', '');
|
||||
memoBuild.Lines.Add(f_('Revision %d (yours: %d)', [BuildRevision, Mainform.AppVerRevision]));
|
||||
FileAge(ParamStr(0), Compiled);
|
||||
memoBuild.Lines.Add(f_('Compiled: %s (yours: %s)', [Ini.ReadString(INISECT_BUILD, 'Date', ''), DateToStr(Compiled)]));
|
||||
Note := Ini.ReadString(INISECT_BUILD, 'Note', '');
|
||||
if Note <> '' then
|
||||
memoBuild.Lines.Add(_('Notes') + ': * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) );
|
||||
if GetExecutableBits = 64 then begin
|
||||
btnBuild.Caption := f_('Download and install build %d', [BuildRevision]);
|
||||
// A new release should have priority over a new nightly build.
|
||||
// So the user should not be able to download a newer build here
|
||||
// before having installed the new release.
|
||||
//btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not LinkLabelRelease.Enabled));
|
||||
end
|
||||
else begin
|
||||
btnBuild.Caption := _('No build updates for 32 bit version');
|
||||
end;
|
||||
|
||||
if btnBuild.Enabled then begin
|
||||
TaskXmlFile := GetTempDir + APPNAME + '_task_restart.xml';
|
||||
SaveUnicodeFile(TaskXmlFile, GetTaskXmlFileContents, UTF8NoBOMEncoding);
|
||||
FRestartTaskName := ValidFilename(ParamStr(0));
|
||||
ShellExec('schtasks', '', '/Create /TN "'+FRestartTaskName+'" /xml '+TaskXmlFile, True);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
if FileExists(CheckFilename) then
|
||||
DeleteFile(CheckFilename);
|
||||
FreeAndNil(CheckfileDownload);
|
||||
end;
|
||||
|
||||
|
||||
{**
|
||||
Download release package via web browser
|
||||
}
|
||||
procedure TfrmUpdateCheck.LinkLabelReleaseLinkClick(Sender: TObject);
|
||||
begin
|
||||
ShellExec(GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease));
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmUpdateCheck.btnChangelogClick(Sender: TObject);
|
||||
begin
|
||||
ShellExec(GetLinkUrl(Sender, SLinkChangelog));
|
||||
end;
|
||||
|
||||
|
||||
procedure TfrmUpdateCheck.CopydownloadURL1Click(Sender: TObject);
|
||||
begin
|
||||
Clipboard.TryAsText := GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease);
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject);
|
||||
begin
|
||||
// No auto-update
|
||||
end;
|
||||
|
||||
procedure TfrmUpdateCheck.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
AppSettings.WriteInt(asUpdateCheckWindowWidth, ScaleFormToDesign(Width));
|
||||
AppSettings.WriteInt(asUpdateCheckWindowHeight, ScaleFormToDesign(Height));
|
||||
end;
|
||||
|
||||
|
||||
function TfrmUpdateCheck.GetLinkUrl(Sender: TObject; LinkType: String): String;
|
||||
var
|
||||
DownloadParam, PlaceParam, OsParam: String;
|
||||
begin
|
||||
PlaceParam := 'place='+EncodeURLParam(TWinControl(Sender).Name);
|
||||
OsParam := 'os='+EncodeURLParam(GetOS.ToLower);
|
||||
|
||||
if LinkType = SLinkDownloadRelease then begin
|
||||
if AppSettings.PortableMode then begin
|
||||
if GetExecutableBits = 64 then
|
||||
DownloadParam := 'download=portable-64'
|
||||
else
|
||||
DownloadParam := 'download=portable';
|
||||
end else begin
|
||||
DownloadParam := 'download=installer';
|
||||
end;
|
||||
Result := 'download.php?'+DownloadParam+'&'+PlaceParam+'&'+OsParam;
|
||||
end
|
||||
|
||||
else if LinkType = SLinkChangelog then
|
||||
Result := 'changes-lazarus'
|
||||
|
||||
else
|
||||
Result := '';
|
||||
|
||||
Result := APPDOMAIN + Result;
|
||||
end;
|
||||
|
||||
|
||||
function TfrmUpdateCheck.GetTaskXmlFileContents: String;
|
||||
begin
|
||||
Result := '<?xml version="1.0" encoding="UTF-16"?>' + sLineBreak +
|
||||
'<Task version="1.2" xmlns="http://schemas.microsoft.com/windows/2004/02/mit/task">' + sLineBreak +
|
||||
' <RegistrationInfo>' + sLineBreak +
|
||||
' <Date>2022-12-24T12:39:17.5068755</Date>' + sLineBreak +
|
||||
' <Author>' + APPNAME + ' ' + MainForm.AppVersion + '</Author>' + sLineBreak +
|
||||
' <URI>\' + APPNAME + '_restart</URI>' + sLineBreak +
|
||||
' </RegistrationInfo>' + sLineBreak +
|
||||
' <Triggers>' + sLineBreak +
|
||||
' <TimeTrigger>' + sLineBreak +
|
||||
' <StartBoundary>2022-12-24T12:42:36</StartBoundary>' + sLineBreak +
|
||||
' <Enabled>true</Enabled>' + sLineBreak +
|
||||
' </TimeTrigger>' + sLineBreak +
|
||||
' </Triggers>' + sLineBreak +
|
||||
' <Principals>' + sLineBreak +
|
||||
' <Principal id="Author">' + sLineBreak +
|
||||
// Note: no <UserId> with the current users SID
|
||||
' <LogonType>InteractiveToken</LogonType>' + sLineBreak +
|
||||
' <RunLevel>LeastPrivilege</RunLevel>' + sLineBreak +
|
||||
' </Principal>' + sLineBreak +
|
||||
' </Principals>' + sLineBreak +
|
||||
' <Settings>' + sLineBreak +
|
||||
' <MultipleInstancesPolicy>IgnoreNew</MultipleInstancesPolicy>' + sLineBreak +
|
||||
' <DisallowStartIfOnBatteries>true</DisallowStartIfOnBatteries>' + sLineBreak +
|
||||
' <StopIfGoingOnBatteries>true</StopIfGoingOnBatteries>' + sLineBreak +
|
||||
' <AllowHardTerminate>true</AllowHardTerminate>' + sLineBreak +
|
||||
' <StartWhenAvailable>false</StartWhenAvailable>' + sLineBreak +
|
||||
' <RunOnlyIfNetworkAvailable>false</RunOnlyIfNetworkAvailable>' + sLineBreak +
|
||||
' <IdleSettings>' + sLineBreak +
|
||||
' <StopOnIdleEnd>true</StopOnIdleEnd>' + sLineBreak +
|
||||
' <RestartOnIdle>false</RestartOnIdle>' + sLineBreak +
|
||||
' </IdleSettings>' + sLineBreak +
|
||||
' <AllowStartOnDemand>true</AllowStartOnDemand>' + sLineBreak +
|
||||
' <Enabled>true</Enabled>' + sLineBreak +
|
||||
' <Hidden>false</Hidden>' + sLineBreak +
|
||||
' <RunOnlyIfIdle>false</RunOnlyIfIdle>' + sLineBreak +
|
||||
' <WakeToRun>false</WakeToRun>' + sLineBreak +
|
||||
' <ExecutionTimeLimit>PT72H</ExecutionTimeLimit>' + sLineBreak +
|
||||
' <Priority>7</Priority>' + sLineBreak +
|
||||
' </Settings>' + sLineBreak +
|
||||
' <Actions Context="Author">' + sLineBreak +
|
||||
' <Exec>' + sLineBreak +
|
||||
' <Command>"' + ParamStr(0) + '"</Command>' + sLineBreak +
|
||||
' <Arguments>--runfrom=scheduler</Arguments>' + sLineBreak +
|
||||
' </Exec>' + sLineBreak +
|
||||
' </Actions>' + sLineBreak +
|
||||
'</Task>';
|
||||
end;
|
||||
|
||||
|
||||
procedure DeleteRestartTask;
|
||||
begin
|
||||
// TN = Task Name
|
||||
// F = Force, suppress prompt
|
||||
ShellExec('schtasks', '', '/Delete /TN "'+ValidFilename(ParamStr(0))+'" /F', True);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user