AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Datenbanken Delphi Fehler beim Verbinden
Thema durchsuchen
Ansicht
Themen-Optionen

Fehler beim Verbinden

Ein Thema von HeikoAdams · begonnen am 13. Sep 2007 · letzter Beitrag vom 14. Sep 2007
Antwort Antwort
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#1

Re: Fehler beim Verbinden

  Alt 13. Sep 2007, 15:17
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;
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz