Datei im Netzwerk finden ohne unc Pfad

[SarDGer]

Moin Moin,

ich hab da ein kleines Problem...
und zwar läd eine meiner DLLs eine firebird gdb, wenn ich connected auf True
setzte kann es zu einer exception kommen, in diesem Fall soll auf eine andere
Datenbank ausgewichen werden (mit Try except abgefangen). Das funktioniert
alles auch ganz Toll.
Es kommt zwar immer 'ne nervige Exception wenn ich im Delphi das Programm starte,
aber die ist ja abgefangen.
ungefähr so: (Delphi7)

Delphi-Quellcode:

try 
  TestDB.Databasename := '\\TestComputer:c:\test\Test1.gdb'
  TestDB.Connected := true;
except
  TestDB.Databasename := '\\TestComputer:c:\test\Test2.gdb'
  TestDB.Connected := true;
end;

Jetzt das Problem:
Da die DLL dynamisch geladen wird muss sie ja auch wieder entladen werden.
Und genau da hängt sich die DLL aufrufenden (bzw. entladenede) Applikation auf.
Danach bewegt sich nix mehr... :wall:

Ich hatte die waage Hoffnung über TIBDatabase mit einem Fileexist, oder Ähnliches,
die Try Except Geschichte zu umgehen und somit ohne Exeption auszukommen.
Wenn der gar nicht erst in den Except-Part springt habe ich das Problem nicht.
Natürlich befindet sich die gdb nicht lokal und ausser dem Databasepath ist nichts
bekannt also auch keinen Unc-Pfad.(wäre ja auch zu einfach dann...)
Also hab ich nur Rechnername und Lokalerpfad auf diesem Rechner.
Hab aber nichts gefunden.

Vielen dank im voraus.

Sar D'Ger

[hoika]

Hallo,

umgehen kannst du das try except nicht.
Ich würde mal den Code ohne Dll prüfen
(also alles in eine externe Unti auslagern),
was heisst denn "hängt" ?
Wo genau hängt er.

Du kannst unter Delphi ja auch Dlls debuggen.


Heiko

[SarDGer]

Ich kann den Post von Hoika nur lesen wenn ich den zitiere, merkwürdig...
Für den Fall das andere dasgleiche Problem haben hier nochmal:

Zitat:

Zitat von hoika

Hallo,

umgehen kannst du das try except nicht.
Ich würde mal den Code ohne Dll prüfen (also alles in eine externe Unti auslagern),
was heisst denn "hängt" ?
Wo genau hängt er.

Du kannst unter Delphi ja auch Dlls debuggen.


Heiko

in einem normalen Programm ist das natürlich kein Problem, leider auch
keine Lösung, da sich die DLL nunmal zwingend mit der Datenbank verbinden muss.
"Er hängt" heisst das er nachdem das Programm beim entladen der DLL

Delphi-Quellcode:

FreeLibrary(hDLLTest);

nichts mehr tut. Ich komm dann nur noch mit Strg+F2 raus.
Das debugen der DLL bringt nichts. Das Problem tritt ja erst im Programm auf,
aber eben nur wenn die Exception ausgelöst wurde.

Grüsse,
Sar D'Ger

[hoika]

Hallo,

1. Benutzt du Threads ?

2. Ist die IBDataBase in der Dll erzeugt oder "irgendwie" übergeben ?

3. Hängt er genau in dem FreeLibrary ?

4. Was passiert, wenn du selber eine Exeption in der Dll erzeugst
(raise Exception.Create('hoika weiss (fast) alles'))
nur um zu testen, dass dort nicht irgendwas rumlungert.


5. nimm mal memcheck oder madexcept,
vielleicht überschreibt deine Dll Speicher.


Heiko

[SarDGer]

huhu,

zu 1. Nein.

zu 2. Die Dll einthält ein TDataModule auf dem die TIBDatabase liegt.
Vor dem TDatabase.destroy setzte ich Conneted := False;

zu 3. Ja - genau da.

zu 4. raise Exception.Create('hoika weiss (fast) alles') hat keine weiteren Auswirkungen. Programm läuft weiter.

zu 5. hab FastMM am laufen - da steht aber nix was daruf schliessen liesse.


Es sieht so aus als ob die TIBDatabase, obwohl das TDatamodule und somit auch die TIBDatabase, bereits "gefreed"
wurde noch irgentwo "den Finger" drauf hätte und deswegen nicht entladen werden kann.
Mal sehen ob ich auf der Schiene weiter komme...

Sar D'Ger

[hoika]

Hallo,

zu 2.
das ist nicht notwendig.

Ausserdem: was heisst hier "vor dem DataBase.Destroy" ?

Wenn die IBDataBase über das DataModul automatisch erzeugt wird,
wird es vom diesem DataModul auch selber freigeben.
Beim Freigeben des IBDataBase wird automatisch disconnected.

Wo genau gibst du denn das DataModul frei ?

Heiko

[SarDGer]

So war das ja nicht gemeint.
Ich hab das ganz so aufgebaut.

Programm part:
Dll laden
Funktions aufruf Test

DLL part:
TDatamodul (DM) erzeugen inkl. TDatabase
Database vebinden <- hier ist die try except Geschichte
Daten aus der Datenbank laden
verändern
Daten in Datenbank schreiben
Databaseverbindung trennen
TDatamodul freigeben Freeandnil(DM)

Programm Part:
DLL entladen FreeLibrary(hDLLInterface); <- ab hier bewegt sich das Programm nicht mehr wenn er durch den Except-Part musste, sonst auch hier kein Problem

Wie gesagt, wenn der die erste Datei findet, läuft alles wie es soll.
Springt er in den except-Part, dann ist beim entladen Schicht im Schacht...

Sar D'Ger

[hoika]

Hallo,

probier mal folgendes

Delphi-Quellcode:

bConnected:= False;
try 
  bConnected:= ConnectDB1...
  bConnected:= IBDB.Connected;
except
end;

if not bConnected then
begin
  try 
    bConnected:= ConnectDB22222...
    bConnected:= IBDB.Connected;
  except
  end;
end;

Heiko

[SarDGer]

Hab die Nuss geknackt !!! :coder2:

in der DLL prüfen:

Delphi-Quellcode:

  function CheckDBisAvailable(DB: TIBDatabase): Boolean;
  Var
    GDSL               : IGDSLibrary;
    DPB                : String;
    DPBLength          : short;
    I                  : Integer;
  Begin
    GDSL := GetGDSLibrary;
    GenerateDPB(DB.Params, DPB, DPBLength);

    I := DB.Call(GDSL.isc_attach_database(StatusVector, Length(DB.DatabaseName),
                                          PChar(DB.DatabaseName), @DB.Handle,
                                          DPBLength, PChar(DPB)), False);
    if I = 0 then
      Result := true
    else
      Result := False;
  end;


.
.
.
    DM.TestDB.DatabaseName := 'C:\Test1.gdb';
    DM.TestDB.LoginPrompt := False;
    DM.TestDB.Params.Add('USER_NAME=Test');
    DM.TestDB.Params.Add('password=Test');

    if CheckDBisAvailable(DM.TestDB) then
      DM.TestDB.Connected := true
    else
    Begin
      DM.TestDB.DatabaseName := 'C:\Test2.gdb';
      DM.TestDB.Connected := True;
    end;
.
.
.

So bekomme ich keine Exception und somit auch keine Problem beim entladen der DLL. :dancer:

So ich geh jetzt 'ne Kuh töten... man man man, was für ein gefummel. Aber jetzt läufts.

Vielen lieben Dank für die viele Mühe, hoika.
Deine Lösung werd ich aber auch noch testen.

Ich hoffe dieser Threat hilft anderen auch. :)

Cya,
Sar D'Ger

P.S.

Zitat:

Zitat von hoika

(raise Exception.Create('hoika weiss (fast) alles'))

jetzt: (raise Exception.Create('hoika weiss (fast) alles, und jetzt ein kleines bischen mehr')) :-D

[hoika]

Hm,

das wäre also ein schnellere Variante,
wie das was ich immer gemacht hatte (dummy query schicken)

*kopier* ;)


Heiko

[SarDGer]

So ich hab das ganze mal etwas sauberer getippet,
Gestern hatt ich da einfach keine Nerven mehr für... :zwinker:

Ich hab eine Form mit einem TButton drauf und eine TIBDatabase Komponente.
Die Datenbanken (Test1.gdb und Test2.gdb) liegen auf dem Server auf "C:\Test"

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, Controls, StdCtrls, Classes, Forms, SysUtils,
  IBDatabase, DB, IBCustomDataSet, IBQuery, IBIntf, IB;

type
  TForm1 = class(TForm)
    TestDB: TIBDatabase;
    Button1: TButton;
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  function CheckIBDBStatus(DB: TIBDatabase; var ErrCode : Integer): Boolean;

var
  Form1           : TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var
  ErrorVal : Integer;
begin
  TestDB.DatabaseName := 'Server:c:\Test\Test1.gdb';
  TestDB.LoginPrompt := False;
  TestDB.Params.Add('USER_NAME=TEST');
  TestDB.Params.Add('password=test');

  if CheckIBDBStatus(TestDB, ErrorVal) then
    TestDB.Connected := true
  else
  Begin
    TestDB.DatabaseName := 'Server:c:\Test\Test2.gdb';
    TestDB.Connected := true; 
  end;
  TestDB.Connected := False;
end;

function CheckIBDBStatus(DB: TIBDatabase; var ErrCode : Integer): Boolean;
Var
  GDSL               : IGDSLibrary;
  DPB                : String;
  DPBLength          : short;
Begin
  Result := False;
  GDSL := GetGDSLibrary;
  GenerateDPB(DB.Params, DPB, DPBLength);

  // details zum ErrCode sind in der Unit IBErrorCodes
  ErrCode := DB.Call(GDSL.isc_attach_database(StatusVector, Length(DB.DatabaseName),
                     PChar(DB.DatabaseName), @DB.Handle,
                     DPBLength, PChar(DPB)), False);
  if ErrCode = 0 then
    Result := true;
end;

end.

Auf bald,
Sar D'Ger

[SarDGer]

Als ich unlängst mal versucht habe älteren Source nach XE2
zu portieren ist mir meine Funktion CheckIBDBStatus um die Ohren geflogen.
Hab also versucht sie wieder zu reanimieren. Ist derzeit noch nicht die schönste
Variante funktioniert aber zunächstmal.

Die Procedure GenerateDPB ist nachwievor in der IBDatabase.pas aber warum in
aller Welt sie jetzt private an der TIBDataBase hängt ist mir völlig
Schleierhaft.

Wie gesagt nicht elegant, funktioniert aber (zumindest bei mir ^^)

Delphi-Quellcode:

unit Unit1;

interface

  System.SysUtils, System.Classes, IBDatabase, Data.DB, IBQuery,
  Windows, IBHeader, IB, IBIntf, IBCustomDataSet;


type
  TForm1 = class(TForm)
    TestDB: TIBDatabase;
    Button1: TButton;
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  function CheckIBDBStatus(DB: TIBDatabase; var ErrCode : Integer): Boolean;

var
  Form1 : TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var
  ErrorVal : Integer;
begin
  TestDB.DatabaseName := 'Server:c:\Test\Test1.gdb';
  TestDB.LoginPrompt := False;
  TestDB.Params.Add('USER_NAME=TEST');
  TestDB.Params.Add('password=test');

  if CheckIBDBStatus(TestDB, ErrorVal) then
    TestDB.Connected := true
  else
  Begin
    TestDB.DatabaseName := 'Server:c:\Test\Test2.gdb';
    TestDB.Connected := true;
  end;
  TestDB.Connected := False;
end;

function CheckIBDBStatus(DB: TIBDatabase; var ErrCode : Integer): Boolean;

    {$REGION 'GenerateDPB'}
    procedure GenerateDPB(_DB: TIBDatabase; sl: TStrings; var DPB: AnsiString; var DPBLength: Short);
    var
      i, j, pval: Integer;
      DPBVal: UShort;
      ParamName, ParamValue: AnsiString;
    begin
      { The DPB is initially empty, with the exception that
        the DPB version must be the first byte of the string. }
      DPBLength := 1;
      DPB := AnsiChar(isc_dpb_version1);

      {Iterate through the textual database parameters, constructing
       a DPB on-the-fly }
      for i := 0 to sl.Count - 1 do
      begin
        { Get the parameter's name and value from the list,
          and make sure that the name is all lowercase with
          no leading 'isc_dpb_' prefix
        }
        if (Trim(sl.Names[i]) = '') then
          continue;
        ParamName := AnsiString(LowerCase(sl.Names[i])); {mbcs ok}
        ParamValue := AnsiString(Copy(sl[i], Pos('=', sl[i]) + 1, Length(sl[i]))); {mbcs ok}  {do not localize}
        if (Pos(AnsiString(DPBPrefix), ParamName) = 1) then {mbcs ok}
          Delete(ParamName, 1, Length(DPBPrefix));
         { We want to translate the parameter name to some Integer
           value. We do this by scanning through a list of known
           database parameter names (DPBConstantNames, defined above) }
        DPBVal := 0;
        { Find the parameter }
        for j := 1 to isc_dpb_last_dpb_constant do
          if (ParamName = AnsiString(DPBConstantNames[j])) then
          begin
            DPBVal := j;
            break;
          end;
         {  A database parameter either contains a string value (case 1)
           or an Integer value (case 2)
           or no value at all (case 3)
           or an error needs to be generated (case else)  }

        case DPBVal of
          isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
          isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
          isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_sql_role_name,
          isc_dpb_sql_dialect, isc_dpb_instance_name, isc_dpb_old_file_name,
          isc_dpb_sys_encrypt_password:
          begin
            if DPBVal = isc_dpb_sql_dialect then
              ParamValue[1] := AnsiChar(Ord(ParamValue[1]) - 48);
            DPB := DPB + AnsiChar(DPBVal) + AnsiChar(Length(ParamValue)) + ParamValue;
            Inc(DPBLength, 2 + Length(ParamValue));
            if DPBVal = isc_dpb_lc_ctype then
            begin
    //          _DB.CharacterSet := String(ParamValue);
    //          _DB.SetCodePage;
            end;
          end;
          isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
          isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify,
          isc_dpb_online_dump, isc_dpb_overwrite, isc_dpb_old_file_size:
          begin
            DPB := DPB + AnsiChar(DPBVal) + #1 + AnsiChar(StrToInt(String(ParamValue)));
            Inc(DPBLength, 3);
          end;
          isc_dpb_sweep:
          begin
            DPB := DPB + AnsiChar(DPBVal) + #1 + AnsiChar(isc_dpb_records);
            Inc(DPBLength, 3);
          end;
          isc_dpb_sweep_interval:
          begin
            pval := StrToInt(String(ParamValue));
            DPB := DPB + AnsiChar(DPBVal) + #4 + PAnsiChar(@pval)[0] + PAnsiChar(@pval)[1] +
                   PAnsiChar(@pval)[2] + PAnsiChar(@pval)[3];
            Inc(DPBLength, 6);
          end;
          isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
          isc_dpb_quit_log:
          begin
            DPB := DPB + AnsiChar(DPBVal) + #1 + #0;
            Inc(DPBLength, 3);
          end;
          else
          begin
            if (DPBVal > 0) and
               (DPBVal <= isc_dpb_last_dpb_constant) then
              IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
            else
              IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
          end;
        end;
      end;
    end;
    {$ENDREGION}

Var
  FGDSLibrary        : IGDSLibrary;
  FDPB               : AnsiString;
  FDPBLength         : short;
Begin
  result := False;
  FGDSLibrary := DB.GDSLibrary;
  GenerateDPB(DB, DB.Params, FDPB, FDPBLength);

  ErrCode := DB.Call(FGDSLibrary.isc_attach_database(StatusVector, Length(AnsiString(DB.DatabaseName)),
                     PAnsiChar(AnsiString(DB.DatabaseName)), @DB.Handle,
                     FDPBLength, PByte(FDPB)), False);
  if ErrCode = 0 then
    Result := true;
end;

end.

Ich hoffe ich konnte irgendwem damit helfen.

Grüße und so,
Sar D'Ger