Datei im Netzwerk finden ohne unc Pfad

[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