Форум: "Основная";
Текущий архив: 2005.06.29;
Скачать: [xml.tar.bz2];

Вниз

Что может быть причиной невыгрузки библиотеки?   Найти похожие ветки 

← →
Aleksandr.   (2005-06-06 15:48) [0]

В программе динамически грузится библиотека, юзающая FireBird, при завершении работы программы, соответственно, вызывается FreeLibrary. Но в случае какой-либо ошибки в библиотеке, даже обработанной try..except, на FreeLibrary программа просто зависает. Что может вызывать такой вис и есть ли способ выгрузить библиотеку гарантированно?

---

← →
Digitman ©   (2005-06-06 15:50) [1]

> Что может вызывать такой вис


все что угодно


> есть ли способ выгрузить библиотеку гарантированно


нет

---

← →
Aleksandr.   (2005-06-06 15:56) [2]

Digitman:
> Все что угодно

Ну например? Exception"ы обрабатываются нормально, чего ей для жизни может не хватать?

---

← →
Digitman ©   (2005-06-06 16:01) [3]

> Exception"ы обрабатываются нормально


не факт


> чего ей для жизни может не хватать?


об этом можно говорить как минимум имея перед носом код деинициализации модуля

---

← →
sniknik ©   (2005-06-06 16:06) [4]

а код в которой "нормально" обрабатывается Exception? по моему тоже нужен. ;)

---

← →
Anatoly Podgoretsky ©   (2005-06-06 16:29) [5]

А как быть с такими случаями в библиотеке, как

try
  ...
except
end;

---

← →
Aleksandr.   (2005-06-06 16:32) [6]

Хорошо. Код, который работает с библиотекой:

procedure AddLog(S : shortstring);
var
 t : string;
begin
 writeln(GetOemStr(s));
 with TFileStream.Create("LOG\atidb.log",fmOpenReadWrite OR fmShareDenyNone) do try
   Seek(0,soEnd);
   t:=FormatDateTime("dd.mm.yyyy hh:nn:ss",Now)+":"+#9+s+#13#10;
   Write(t[1],length(t))
 finally
   Free
 end
end;

procedure InitDBSettings;
var
 P, C : PChar;
begin
 hm_SQLModule:=LoadLibrary("atidb.dll");
 if hm_SQLModule<>0 then try
   @vInitDBSettings:=GetProcAddress(hm_SQLModule,"InitDBSettings");
   @vDBInitProcs:=GetProcAddress(hm_SQLModule,"InitProcs");
   @vFreeDB:=GetProcAddress(hm_SQLModule,"FreeDB");
   vDBInitProcs(@AddLog);
   P:=StrNew(PChar(GetCurrentDir));
   C:=StrNew(PChar(CheckDir(GetCurrentDir)+"Bases\bases.fdb"));
   vInitDBSettings(C,P);
   @vInitBaseTables:=GetProcAddress(hm_SQLModule,"InitBaseTables");
   vInitBaseTables;
   vFreeDB
 finally
   FreeLibrary(hm_SQLModule)
 end
end;


вот код функций в Dll:

function InitDBSettings(szDataBaseName : PChar; const szMainDir : PChar=nil;
        const szDataBaseParams : PChar=nil) : integer; stdcall;
begin
 if FATI<>nil then
   FreeAndNil(FATI);
 FATI:=TATIDB.Create(StrPas(szMainDir), StrPas(szDataBaseName), strPas(szDataBaseParams));
 Result:=FATI.Status
end;

function FreeDB() : longbool; stdcall;
begin
 try
   if FATI<>nil then
     FreeAndNil(FATI);
   Result:=true
 except
   Result:=false
 end
end;

function InitProcs(LogPtr : Pointer; const ProgressPtr : Pointer=nil; const MessagePtr : Pointer=nil) : longbool; stdcall;
begin
 try
   vDBDllLog:=LogPtr;
   vDBDllProgress:=ProgressPtr;
   vDBDllShowMsgProc:=MessagePtr;
   Result:=true
 except
   Result:=false
 end
end;

function InitBaseTables : integer; stdcall;
begin
 if FATI=nil then
   Result:=0
 else begin
   FATI.InitBaseTables;
   Result:=FATI.Status
 end  
end;


Вот объявления:

var
 vDBDllLog : procedure (Msg : shortstring);

 vInitDBSettings   : function(szDataBaseName : PChar; const szMainDir : PChar=nil;
                              const szDataBaseParams : PChar=nil) : integer; stdcall;
 vInitBaseTables   : function : integer; stdcall;
 vFreeDB           : function : longbool; stdcall;
 vDBInitProcs      : function(LogPtr : Pointer; const ProgressPtr : Pointer=nil;
                              const MessagePtr : Pointer=nil) : longbool; stdcall;


Вот ключевые для вопроса методы FATI -

constructor TATIDB.Create(aMainDir, aDBName: TFileName; aDBParams: string);
begin
 Inherited Create;
 AddLog("Initialization...");
 try
   FStatus:=0;
   FActive:=false;
   FDBName:=aDBName;
   FMainDir:=CheckDir(aMainDir);
   if FMainDir="" then
     FMainDir:=CheckDir(GetCurrentDir);
   FBasesDir:=FMainDir+"BASES\";
   FOutDir:=FMainDir+"OUT\";
   FDB:=TIbDataBase.Create(nil);
   FDB.DatabaseName:=aDBName;
   FDB.Params.Text:=aDBParams;
   if aDBParams="" then
     FDB.Params.Add("lc_ctype=WIN1251");
   FDB.LoginPrompt:=false;
   FIT:=TIbTransaction.Create(nil);
   FIT.DefaultAction:=TACommitRetaining;
   FIT.Params.Text:="read_committed"#13#10"rec_version"#13#10"nowait";
   FIT.DefaultDataBase:=FDB;
   FDB.DefaultTransaction:=FIT;
   DoLog("OK")
 except
   on E:Exception do
     DoLog(E.Message)
 end
end;

procedure TATIDB.InitBaseTables;
var
 bWasConnect : boolean;
 s           : string;
 P           : PChar;
 i           : integer;
 L           : TStrings;
 Q           : TIbQuery;
begin
 AddLog("Init modules...");
 {$Region "Инициализация библиотеки запросов"}
 hm_SQLModule:=LoadLibrary(PChar(SQLModuleName));
 if hm_SQLModule<>0 then begin
   DoLog("OK");
   AddLog("Init procedures...");
   @vBaseCreateSQL:=GetProcAddress(hm_SQLModule,"BaseCreateSQL");
   @vCreateSQL:=GetProcAddress(hm_SQLModule,"CreateSQL");
   @vGetSQL:=GetProcAddress(hm_SQLModule,"GetSQL");
   @vGetUserTablesIDS:=GetProcAddress(hm_SQLModule,"GetUserTablesIDs");
   if (@vBaseCreateSQL<>nil) AND (@vCreateSQL<>nil) AND (@vGetSQL<>nil) then
     DoLog("OK")
   else if @vBaseCreateSQL=nil then
     DoLog("function BaseCreateSQL not found!")
   else if @vCreateSQL=nil then
     DoLog("function CreateSQL not found!")
   else if @vGetUserTablesIds=nil then
     DoLog("function GetUserTablesIds not found!")
   else if @vGetSQL=nil then
     DoLog("function GetSQL not found!")
 end
 else begin
   DoLog(Format("library %s not found!",[SQLModuleName]));
   Exit
 end; {$EndRegion}
 AddLog("Init DB connection...");
 bWasConnect:=FDB.Connected;
 if NOT bWasConnect then
   FDB.Connected:=true;
 DoLog("OK");
 try
   AddLog("Init userinfo...");
   {$Region "проверка на наличие и создание UserCard"} try
     FillChar(FUserCard,SizeOf(FUserCard),0);
     FUserCard.ID:=NewMinRegister;
     if NOT TableExists("userinfo") then begin
       if @vBaseCreateSQL<>nil then begin
         i:=vBaseCreateSQL(bs_CreateUserInfo);
         GetMem(P,i);
         try
           vBaseCreateSQL(bs_CreateUserInfo,P);
           s:=StrPas(P)
         finally
           FreeMem(P)
         end;
         Q:=TIbQuery.Create(nil);
         with Q do try
           DataBase:=FDB;
           L:=TStringList.Create;
           try
             L.Text:=s;
             while L.Count>0 do begin
               s:=L.Strings[0];
               L.Delete(0);
               if s<>"" then begin
                 SQL.Text:=s;

                Собственно, вот тут, если воткнуть ошибочную строку запроса, произойдет выход в следующий except

                 ExecSQL;                  
                 FIT.CommitRetaining
               end
             end
           finally
             L.Free
           end        
        finally
           Q.Free
         end;
         DoLog("Recreated");
       end
       else
         DoLog("Cannot init vBaseCreateSQL")
     end
     else
       DoLog("OK");
   except
     on E:Exception do
       DoLog(E.Message)      // вот этот эксепт обрабатывает ошибку, но выгрузки библиотеки больше не произойдет
   end; {$EndRegion}
 finally
   FDB.Connected:=bWasConnect
 end
end;

destructor TATIDB.Destroy;
begin
 AddLog("Finalization...");
 try
   if FIT.InTransaction then
     FIT.CheckAutoStop;
   if FIT.Active then
     FIT.Active:=false;
   FreeAndNil(FIT);
   if FDB.Connected then
     FDB.Connected:=false;
   FreeAndNil(FDB);
   if hm_SQLModule<>0 then
     FreeLibrary(hm_SQLModule);
   DoLog("OK")
 except
   on E:Exception do
     DoLog(E.Message)
 end;
 inherited
end;

procedure TATIDB.AddLog(Msg: shortstring);
begin
 FLogS:=Msg
end;

procedure TATIDB.DoLog(Msg: shortstring);
begin
 FLogS:=FLogS+Msg;
 if Assigned(VDBDllLog) then try
   vDBDllLog(FLogS)
 except
 end;
 FLogS:=""
end;



---

← →
Aleksandr.   (2005-06-06 16:35) [7]

В итоге лог работы будет выглядеть вот так:

06.06.2005 16:18:41: Initialization...OK
06.06.2005 16:18:41: Init modules...OK
06.06.2005 16:18:41: Init procedures...OK
06.06.2005 16:18:41: Init DB connection...OK
06.06.2005 16:18:46: Init userinfo...unsuccessful metadata update
Unknown columns in index USERINFO_IDX1
06.06.2005 16:18:46: Finalization...OK

---

← →
sniknik ©   (2005-06-06 17:02) [8]

может "пальцем в небо"... но, модуль ShareMem используется?

---

← →
Aleksandr.   (2005-06-06 17:39) [9]

неа. В параметрах string не используется.

---

← →
sniknik ©   (2005-06-06 17:49) [10]

а ты попробуй поставь, может забыл чего
...even those that are nested in records and classes...

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.06.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.043 c