Fehler beim Verbinden

[HeikoAdams]

Hallo,
ich habe ein sehr merkwürdiges Problem:
Um unser E-Mail-System nicht mit internen Nachrichten zu zu müllen, nutzen wir eine selbst geschriebene Software. Solange nur ein Benutzer das Programm startet, gibt es keine Probleme.
Sobald ein weiterer Benutzer das Programm jedoch startet, bekommen alle Programmnutzer die Fehlermeldungen "Allgemeiner Netzwerktfehler" und "Fehler beim Verbinden". Das Programm lässt sich anschließend nur noch über den Taskmanager beenden.

Bei dem Server-OS handelt es sich um Windows Server 2003 Standard SP 1

Hat hier jemand eine Idee, wo die Ursache des Problems liegt?

Gruß

Heiko

[s-off]

Zitat:

Zitat von HeikoAdams

Hat hier jemand eine Idee, wo die Ursache des Problems liegt?

Das ist, unter Berücksichtigung der Informationsfülle, die Du zur Verfügung stellst, nicht Dein Ernst, oder?

[HeikoAdams]

Was für Informationen bräuchtest Du denn noch?

[s-off]

Zitat:

Zitat von HeikoAdams

Was für Informationen bräuchtest Du denn noch?

Ok, Du hast gewonnen - da kam mein Gemeckere vielleicht etwas frühzeitig - tschuldigung.
Wahrscheinlich gibt es einfach nicht mehr an Infos, die man zu so einem Problem abgeben kann, ohne das komplette Projekt anzuhängen.

Was würde ich machen?
Ich würde das Programm mit Hilfe zweier Rechner debuggen.

[HeikoAdams]

Also ich habe das Programm mal versucht mit einem zweiten PC zu debuggen und so wie es aussieht, nimmt der zweite PC dem ersten die Verbindung weg.

[s-off]

Zitat:

Zitat von HeikoAdams

Also ich habe das Programm mal versucht mit einem zweiten PC zu debuggen und so wie es aussieht, nimmt der zweite PC dem ersten die Verbindung weg.

Loggen sich vielleicht alle mit dem gleichen Usernamen ein?

[HeikoAdams]

Das glaube ich nicht, da als Connection-String folgendes eingetragen ist

Delphi-Quellcode:

Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=RifMessenger;Data Source=PL3210;Application Name=RifMessenger

und ich mich auf beiden PCs mit unterschiedlichen Usernamen eingeloggt habe.

Darüber hinaus nutzt ein anderes Programm eine genau so aufgebauten CS (bis auf die Datenbank) und dort besteht das Problem nicht

[HeikoAdams]

Zitat:

Zitat von HeikoAdams

Das glaube ich nicht, da als Connection-String folgendes eingetragen ist

Delphi-Quellcode:

Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=RifMessenger;Data Source=PL3210;Application Name=RifMessenger

und ich mich auf beiden PCs mit unterschiedlichen Usernamen eingeloggt habe.

Darüber hinaus nutzt ein anderes Programm eine genau so aufgebauten CS (bis auf die Datenbank) und dort besteht das Problem nicht

Dagegen spricht auch, das in der Prozessinfo des SQL Servers die erste Session verschwunden ist, sobald jemand anderes das Programm gestartet hat

[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;

[s-off]

Zitat:

Zitat von HeikoAdams

Ursache gefunden.

Glückwunsch :-D

Zitat:

Zitat von HeikoAdams

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

Den lese ich mir jetzt nicht durch :wink:

Fazit: Der Debugger ist doch zu was gut :zwinker:

Edit: mit dem Schliessen der Quote-Tags hab' ich's heute irgendwie...