function TFrmMain.GetConnectionsCount(): integer;
var
nConnections: integer;
szName:
string;
szHost:
string;
begin
nConnections := 0;
szName := GetLocalComputerName;
with ConnectionsSP
do
begin
Close;
ProcedureName := '
sp_who';
Open;
Filter := '
dbname = ' + QuotedStr(Database.DefaultDatabase) +
'
AND status <> ''
sleeping''
';
Filtered := True;
end;
ConnectionsSP.First;
repeat
szHost := ConnectionsSP.FieldByName('
hostname').AsString;
if (Trim(szHost) <> szName)
and (Length(Trim(szHost)) > 0)
then
Inc(nConnections);
ConnectionsSP.Next;
until ConnectionsSP.EOF;
Result := nConnections;
end;
procedure TFrmMain.UpdateDB;
var
Files: TStringList;
Update: TStringList;
Pfad:
string;
Backup:
string;
Count: integer;
Counter: integer;
UpdInst: integer;
Block: boolean;
begin
if (GetConnectionsCount = 0)
then
begin
Block := False;
UpdInst := 0;
Pfad := ExtractFilePath(Application.ExeName) + '
Updates\';
Backup := ExtractFilePath(Application.ExeName) + '
Updates Backup\';
Files := TStringList.Create;
if not DirectoryExists(Pfad)
then
ForceDirectories(Pfad);
if not DirectoryExists(Backup)
then
ForceDirectories(Backup);
if not BuildFileList(Pfad + '
*.sql', faAnyFile, Files)
then
begin
MessageBox(
Handle, PChar(SysErrorMessage(GetLastError)), '
Fehler', MB_OK
or
MB_ICONWARNING + MB_SYSTEMMODAL);
Exit;
end;
if (Files.Count > 0)
then
if (MessageBox(0, MainWin08, MsgUpdAv, MB_ICONQUESTION
or MB_YESNO
or
MB_SYSTEMMODAL) = idNo)
then
Exit;
with UpdateScript
do
begin
CommandText :=
'
ALTER DATABASE RifMessenger SET SINGLE_USER WITH ROLLBACK IMMEDIATE';
Execute;
end;
try
UpdateList.Open;
for Count := 0
to Files.Count - 1
do
begin
if UpdateList.Locate('
Skrip', Files.Strings[Count], [])
then
begin
if not FileExists(Backup + Files.Strings[Count])
then
FileMove((Pfad + Files.Strings[Count]),
(Backup + Files.Strings[Count]),
True)
else
FileDelete(Pfad + Files.Strings[Count], True);
Continue;
end;
Inc(UpdInst);
Update := TStringList.Create;
Update.LoadFromFile(Pfad + Files.Strings[Count]);
UpdateScript.CommandText := '
';
for Counter := 0
to Update.Count - 1
do
begin
if (Pos('
/*', Update.Strings[Counter]) > 0)
then
Block := True;
if (Pos('
*/', Update.Strings[Counter]) > 0)
then
Block := False;
if (LeftStr(Trim(UpperCase(Update.Strings[Counter])), 2) = '
--')
or
(UpperCase(Update.Strings[Counter]) = '
')
or Block
then
Continue;
if (UpperCase(Update.Strings[Counter]) = '
GO')
then
begin
with UpdateScript
do
begin
Execute;
CommandText := '
';
end;
Continue;
end;
with UpdateScript
do
CommandText := CommandText + Update.Strings[Counter] + #13 + #10;
end;
if (UpdateScript.CommandText <> '
')
then
UpdateScript.Execute;
Update.Free;
if FileMove((Pfad + Files.Strings[Count]),
(Backup + Files.Strings[Count]), True)
then
begin
with UpdateList2
do
begin
with SQL do
begin
Clear;
Add('
INSERT INTO UpdateProtokoll (Skrip, Datum, Benutzer)');
Add('
VALUES (''
' + (Files.Strings[Count]) +
'
''
, ' + FloatToStr(Date) + '
,''
' + GetLocalUserName + '
''
)');
end;
ExecSQL;
Close;
end;
end;
end;
if (UpdInst > 0)
then
MessageBox(0, MainWin09, MsgUpdAv,
MB_ICONINFORMATION
or MB_OK
or MB_SYSTEMMODAL);
finally
with UpdateScript
do
begin
CommandText := '
ALTER DATABASE RifMessenger SET MULTI_USER';
Execute;
end;
end;
UpdateList.Close;
Files.Free;
end;
end;