Host Application에서 DLL내의 Procedure를 호출하여 Host application에 있는
Treeview에다가 자료를 집어넣는 프로그램입니다.....
그런데...정상적으로 동작을 하기는 하는데... FreeLibrary로 하여 DLL을
해제해버리면 Host Applicaton쪽에서 Access Violation이 발생합니다.
제생각에는 DLL에서 Host Applicaton에 있는 Treeview에 집어넣은 Node관련
자료가 Freelibrary가 호출되면서 메모리상에서 없어지는것 같은데...
정확한 원인은 모르겠네요....
아시는 분 왕초보 좀 살려주세요....
{ DLL Source }
library libmenu;
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActnList, StdCtrls, ExtCtrls, Buttons, ComCtrls, Db, DBTables, ImgList,
ToolWin, Menus, bde;
{$r bullet.res}
type
pTreeview = ^Ttreeview;
type
Pinfo = ^TINfo;
Tinfo = record
jobid: integer;
buttonid: integer;
pgmid: integer;
menutext: string;
module: string;
end;
var
database: tdatabase;
query: Tquery;
Procedure libmenu_init(dbhandle: HDBIDB); stdcall;
Begin
database := Tdatabase.create(nil);
database.databasename := 'dll_db';
database.Handle := dbHandle;
query := tquery.create(nil);
query.databasename := database.databasename;
end;
Procedure libmenu_loadmenu(treeview1: TTreeview); stdcall;
var
i: integer;
a1,a2,a3: integer;
t,t2: string;
CurItem, subitem, lastitem: TTreeNode;
NewInfo: Pinfo;
Treeview2: TTreeView;
begin
with query do Begin
close;
sql.add('SELECT JOBID, BUTTONID, PGMID, MENUTEXT, PGMTEXT, MODULE, REMARK ');
sql.add(' FROM menu Menu ');
sql.add(' ORDER BY JOBID DESC, BUTTONID, PGMID ' );
open;
end;
with query, treeview1 do
for i:=0 to recordcount - 1 do Begin
a1 := fields[0].asinteger;
a2 := fields[1].asinteger;
a3 := fields[2].asinteger;
t := fields[3].asstring;
if (a3 <> 0) then Begin
lastitem := items.addchild(subitem,t);
lastitem.imageindex := 0;
end
else if (a2 <> 0) then begin
New(NewInfo);
NewInfo^.jobid := a1;
NewInfo^.buttonid := a2;
NewInfo^.Pgmid := a3;
NewInfo^.menutext := t;
if fields[5].isNull then NewInfo^.module := ''
else NewInfo^.module := fields[5].asstring;
subitem := items.AddChildObject(curitem,t,NewInfo);
subitem.imageindex := 2;
end
else begin
New(NewInfo);
NewInfo^.jobid := a1;
NewInfo^.buttonid := a2;
NewInfo^.Pgmid := a3;
NewInfo^.menutext := t;
if fields[4].isNull then NewInfo^.module := ''
else NewInfo^.module := fields[4].asstring;
curitem := items.AddChildObjectFirst(nil,t,newInfo);
curitem.imageindex := 1;
end;
next;
end;
query.free;
database.free;
end;
exports
libmenu_init,
libmenu_loadmenu;
end.
{ EXE Source }
unit mainfrm_;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, DBTables,bde, ExtCtrls, ACPanels, StdCtrls, AHMTButton,
AHMTBackground, ImgList;
type
TCallInitMenu = Procedure(dbhandle: HDBIDB); stdcall;
TCallLoadMenu = Procedure(treeview1: TTreeview); stdcall;
type
TfrmMain = class(TForm)
Database1: TDatabase;
PnlLeft: TACRollPanel;
Panel1: TPanel;
TreeviewMenu: TTreeView;
AHMBackground1: TAHMBackground;
AHMButton1: TAHMButton;
ImglistMenu: TImageList;
procedure FormCreate(Sender: TObject);
procedure AHMButton1Click(Sender: TObject);
private
DllMenuHandle: Thandle;
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses Unit1;
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
var
CallInitMenu: TCallInitMenu;
CallLoadMenu: TCallLoadMenu;
FuncPtrInit,FuncPtrLoad: TFarProc;
ErrorMessage: String;
begin
Left := 1;
top := 1;
DllMenuHandle := LoadLibrary('libmenu.dll');
if DllMenuhandle = HINSTANCE_ERROR then Begin
application.MessageBox('LibMenu.DLL을 찾을수 없습니다'+chr(13)+
'LibMenu.DLL이 정상적으로 설치되었는지 먼저확인을 하시고'+chr(13)+
'이미 설치가 되어 있다면 LibMenu.DLL이 손상되었을 가능성이 있으니'+chr(13)+
'LibMenu.DLL을 다시 설치하기기 바랍니다',
'프로그램 오류',
mb_ok);
end
else Begin
FuncPtrInit := GetProcAddress(DllMenuhandle,'libmenu_init');
@CallInitMenu := FuncPtrInit;
if @CallInitMenu <> nil then Begin
CallInitMenu(Database1.Handle)
end
else Begin
ErrorMessage := 'DLL Function 구동오류1'+chr(13)+inttostr(GetLastError);
Application.MessageBox(pchar(ErrorMessage),'프로그램 오류',mb_ok);
end;
@CallLoadMenu := GetProcAddress(DLLMenuHandle,'libmenu_loadmenu');
if @CallLoadMenu <> nil then CallLoadMenu(TreeviewMenu)
else Begin
ErrorMessage := 'DLL Function 구동오류'+chr(13)+inttostr(GetLastError);
Application.MessageBox(pchar(ErrorMessage),'프로그램 오류',mb_ok);
end;
end;
FreeLibrary(DLLMenuHandle);
end;
procedure TfrmMain.AHMButton1Click(Sender: TObject);
begin
application.CreateForm(tform1, form1);
end;
end.