| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Что может быть причиной невыгрузки библиотеки? [D7, WinXP]

Aleksandr. ©   (2005-06-06 15:48:00) 

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

---

sniknik   (2005-06-06 17:49:00) [1]

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

---

Aleksandr.   (2005-06-06 17:39:00) [2]

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

---

sniknik   (2005-06-06 17:02:00) [3]

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

---

Aleksandr.   (2005-06-06 16:35:00) [4]

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

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

---

Aleksandr.   (2005-06-06 16:32:00) [5]

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

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;



---

Anatoly Podgoretsky   (2005-06-06 16:29:00) [6]

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

try
  ...
except
end;

---

sniknik   (2005-06-06 16:06:00) [7]

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

---

Digitman   (2005-06-06 16:01:00) [8]

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


не факт


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


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

---

Aleksandr.   (2005-06-06 15:56:00) [9]

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

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

---

Digitman   (2005-06-06 15:50:00) [10]

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


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


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


нет

---

Наверх