Fehler beim Verbinden

[HeikoAdams]

Ursache gefunden. Folgender Code scheint die Ursache gewesen zu sein, warum auch immer:

Delphi-Quellcode:

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;