C
chp5231
Unregistered / Unconfirmed
GUEST, unregistred user!
我的主程序用一个共用的窗体infoform,来负责调用释放所有的DLL窗体,但是现在出现这样一个问题,就是我的DLL窗体连续打开6次后就无法释放.
代码如下:
主程序:
procedure TfrmMain.TreeView1DblClick_0;
var
i: integer;
begin
for i := 0 to Self.MdiChildCount - 1do
begin
if TCInfoForm( Self.MDIChildren ).Tag = PMyRecord(TreeView1.selected.Data)^.tag then
begin
TCInfoForm( Self.MDIChildren ).Show;
exit;
end;
end;
CurTag := PMyRecord(TreeView1.selected.Data)^.tag;
CurDllName := Trim(PMyRecord(TreeView1.selected.Data)^.DLLName);
if not FileExists( AppRunPath + CurDllName ) then
begin
Application.MessageBox( '功能载体没有发现,请联系供应商!', '加载错误', mb_OK+MB_ICONERROR);
exit;
end;
Animate1.Visible := True;
Animate1.Active := True;
Animate1.Refresh;
ToolBar1.Refresh;
CurTag := PMyRecord(TreeView1.selected.Data)^.tag;
CurDllName := Trim( PMyRecord(TreeView1.selected.Data)^.DLLName );
with TCInfoForm.Create( Self )do
begin
Name := 'MMName'+IntToStr(CurTag);
Show;
WindowState := wsMaximized;
end;
ToolBar1.Refresh;
Animate1.Refresh;
Animate1.Active := False;
Animate1.Visible := False;
end;
调用DLL的MDI窗体Infoform如下
unit inforForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, CForm, ActnList, ExportsConst, DB, DBClient, MConnect, Menus;
type
TInitInfoFun = function( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;
UserName,PassWord:String ): DWord;stdcall;
//初始化
TLastErrorFun = function: PChar;stdcall;
TSetWinSttteFun = function( State: DWord )Word;stdcall;
TDestroyFun = function: DWord;Stdcall;
TPreviewFun = function: DWord;stdcall;
TPrintFun = function: DWord;stdcall;
TPrintSetupFun = function: DWord;stdcall;
TRecAddFun = function: DWord;stdcall;
TRecModifyFun = functionWord;stdcall;
TRecDelFun = functionWord;stdcall;
TRecRefresh = functionWord;stdcall;
TSetColumnFun = functionWord;stdcall;
TRecSortFun = function: DWord;stdcall;
TRecFindFun = function: DWord;stdcall;
TRecAll = functionWord;stdcall;
TRecNavFun = function( nType: DWord )Word;stdcall;
TRecFunName = function: PChar;stdcall;
TCInfoForm = class(TZForm)
infoAList: TActionList;
RecFirst: TAction;
RecPrev: TAction;
RecNext: TAction;
RecLast: TAction;
ActionList1: TActionList;
aPreview: TAction;
aPrint: TAction;
aPrinterSetup: TAction;
aExit: TAction;
aNew: TAction;
aModify: TAction;
aDel: TAction;
aTotal: TAction;
aRefresh: TAction;
aSearch: TAction;
aAll: TAction;
aSetColumn: TAction;
aSetSort: TAction;
MainMenu1: TMainMenu;
smnFile: TMenuItem;
smnPreview: TMenuItem;
smnPrint: TMenuItem;
smnPrinterSetup: TMenuItem;
N1: TMenuItem;
smnExit: TMenuItem;
smnEdit: TMenuItem;
smnNew: TMenuItem;
smnModify: TMenuItem;
smnDel: TMenuItem;
smnRefresh: TMenuItem;
N9: TMenuItem;
mnuSetColumn: TMenuItem;
mnuSetSort: TMenuItem;
N2: TMenuItem;
smnSearch: TMenuItem;
smnAll: TMenuItem;
procedure RecFirstExecute(Sender: TObject);
procedure RecPrevExecute(Sender: TObject);
procedure RecNextExecute(Sender: TObject);
procedure RecLastExecute(Sender: TObject);
procedure RecNewExecute(Sender: TObject);
procedure RecModifyExecute(Sender: TObject);
procedure RecDelExecute(Sender: TObject);
procedure RecRefreshExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);override;
procedure SetDllName( s: String );
procedure FormResize(Sender: TObject);
procedure aExitExecute(Sender: TObject);
procedure aNewExecute(Sender: TObject);
procedure aPrinterSetupExecute(Sender: TObject);
procedure aPrintExecute(Sender: TObject);
procedure aPreviewExecute(Sender: TObject);
procedure aModifyExecute(Sender: TObject);
procedure aDelExecute(Sender: TObject);
procedure aRefreshExecute(Sender: TObject);
procedure aSearchExecute(Sender: TObject);
procedure aAllExecute(Sender: TObject);
procedure aSetColumnExecute(Sender: TObject);
procedure aSetSortExecute(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
sDLLName: String;
LibHandle: THandle;
FUserName: String;
FPassWord: String;
FLoginType: Integer;
FServerStr: String;
public
//公共函数
InitDllFun: TInitInfoFun;
GetLastError: TLastErrorFun;
SetWinState: TSetWinSttteFun;
DestroyFun: TDestroyFun;
PreviewFun: TPreviewFun;
PrintFun: TPrintFun;
PrintSetupFun: TPrintSetupFun;
RecAddFun: TRecAddFun;
RecModifyFun: TRecModifyFun;
RecDelFun: TRecDelFun;
RecRefresh: TRecRefresh;
SetColumnFun: TSetColumnFun;
RecSortFun: TRecSortFun;
RecFindFun: TRecFindFun;
RecAll: TRecAll;
RecNav: TRecNavFun;
RecFunName: TRecFunName;
constructor Create(AOwner: TComponent);
override;
end;
var
CInfoForm: TCInfoForm;
implementation
uses Main;
{$R *.dfm}
procedure TCInfoForm.RecFirstExecute(Sender: TObject);
begin
//头条记录
RecNav(0);
end;
procedure TCInfoForm.RecPrevExecute(Sender: TObject);
begin
//前条记录
RecNav(1);
end;
procedure TCInfoForm.RecNextExecute(Sender: TObject);
begin
//后条记录
RecNav(2);
end;
procedure TCInfoForm.RecLastExecute(Sender: TObject);
begin
//尾条记录
RecNav(3);
end;
procedure TCInfoForm.RecNewExecute(Sender: TObject);
begin
//新增记录
end;
procedure TCInfoForm.RecModifyExecute(Sender: TObject);
begin
//修改记录
end;
procedure TCInfoForm.RecDelExecute(Sender: TObject);
begin
//删除记录
end;
procedure TCInfoForm.RecRefreshExecute(Sender: TObject);
begin
//刷新记录
end;
procedure TCInfoForm.FormShow(Sender: TObject);
var
tmpCaption,tmpIP,tmpPort: String;
begin
inherited;
//
if LibHandle = 0 then
begin
LibHandle := LoadLibrary( PChar( sDLLName ) );
if LibHandle <> 0 then
begin
@InitDllFun := GetProcAddress( LibHandle, CON_INITFUNNAME );
@GetLastError := GetProcAddress( LibHandle, CON_LASTERRORFUN );
@SetWinState := GetProcAddress( LibHandle, CON_SETWINSTATE );
@DestroyFun := GetProcAddress( LibHandle, CON_DESTROYDLL );
@PreviewFun := GetProcAddress( LibHandle, CON_PREVIEW );
@PrintFun := GetProcAddress( LibHandle, CON_PRINT );
@PrintSetupFun := GetProcAddress( LibHandle, CON_PRINTSETUP );
@RecAddFun := GetProcAddress( LibHandle, CON_RECADD );
@RecModifyFun := GetProcAddress( LibHandle, CON_RECMODIFY );
@RecDelFun := GetProcAddress( LibHandle, CON_RECDEL );
@RecRefresh := GetProcAddress( LibHandle, CON_REFRESH );
@SetColumnFun := GetProcAddress( LibHandle, CON_SETCOLUMN );
@RecSortFun := GetProcAddress( LibHandle, CON_RECSORT );
@RecFindFun := GetProcAddress( LibHandle, CON_RECFIND );
@RecAll := GetProcAddress( LibHandle, CON_RECALL );
@RecNav := GetProcAddress( LibHandle, CON_RECNAV );
@RecFunName := GetProcAddress( LibHandle, CON_RECFUNNAME );
end;
end;
if LibHandle <> 0 then
begin
case FLoginType of
0:
begin
InitDllFun( Self.Handle, FLoginType, Pchar( FServerStr ), '',
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
1:
begin
tmpIP := Copy( FServerStr, 1, Pos( FServerStr, ':' )-1);
tmpPort := Copy( FServerStr, Pos( FServerStr, ':' ), Length( FServerStr ) );
InitDllFun( Self.Handle, FLoginType, Pchar( tmpIP ), PChar( tmpPort ),
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
2:
begin
InitDllFun( Self.Handle, FLoginType, Pchar( FServerStr ), '',
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
end;
end;
tmpCaption := String(RecFunName);
Self.Caption := tmpCaption;
end;
procedure TCInfoForm.FormCreate(Sender: TObject);
begin
inherited;
//
LibHandle := 0;
end;
procedure TCInfoForm.SetDllName(s: String);
begin
//
sDLLName := s;
end;
constructor TCInfoForm.Create(AOwner: TComponent);
begin
sDLLName := TfrmMain( AOwner ).CurDllName;
Self.Tag := TfrmMain( AOwner ).CurTag;
Self.FUserName := TfrmMain( AOwner ).FUserName;
Self.FPassWord := TfrmMain( AOwner ).FPassWord;
Self.FLoginType := TfrmMain( AOwner ).FLoginType;
Self.FServerStr := TfrmMain( AOwner ).FServerStr;
inherited;
end;
procedure TCInfoForm.FormResize(Sender: TObject);
begin
inherited;
//
try
if {(@SetWinState <> nil) and }(Self.Caption <> 'close') then
SetWinState(0);
except
;
end;
end;
procedure TCInfoForm.aExitExecute(Sender: TObject);
begin
Self.Close;
end;
procedure TCInfoForm.aNewExecute(Sender: TObject);
begin
if @RecAddFun <> nil then
RecAddFun;
end;
procedure TCInfoForm.aPrinterSetupExecute(Sender: TObject);
begin
if @PrintSetupFun <> nil then
PrintSetupFun;
end;
procedure TCInfoForm.aPrintExecute(Sender: TObject);
begin
if @PrintFun <> nil then
PrintFun;
end;
procedure TCInfoForm.aPreviewExecute(Sender: TObject);
begin
if @PreviewFun <> nil then
PreviewFun;
end;
procedure TCInfoForm.aModifyExecute(Sender: TObject);
begin
if @RecModifyFun <> nil then
RecModifyFun;
end;
procedure TCInfoForm.aDelExecute(Sender: TObject);
begin
if @RecDelFun <> nil then
RecDelFun;
end;
procedure TCInfoForm.aRefreshExecute(Sender: TObject);
begin
if @RecRefresh <> nil then
RecRefresh;
end;
procedure TCInfoForm.aSearchExecute(Sender: TObject);
begin
if @RecFindFun <> nil then
RecFindFun;
end;
procedure TCInfoForm.aAllExecute(Sender: TObject);
begin
if @RecAll <> nil then
RecAll;
end;
procedure TCInfoForm.aSetColumnExecute(Sender: TObject);
begin
if @SetColumnFun <> nil then
SetColumnFun;
end;
procedure TCInfoForm.aSetSortExecute(Sender: TObject);
begin
if @RecSortFun <> nil then
RecSortFun;
end;
procedure TCInfoForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
//exit;
Self.Caption := 'close';
try
DestroyFun;
except
;
end;
try
FreeLibrary( LibHandle );
except
;
end;
//LibHandle := 0;
Self.OnResize := nil;
@InitDllFun := NIL;
@GetLastError := NIL;
@SetWinState := NIL;
@DestroyFun := NIL;
@PreviewFun := NIL;
@PrintFun := NIL;
@PrintSetupFun := NIL;
@RecAddFun := NIL;
@RecModifyFun := NIL;
@RecDelFun := NIL;
@RecRefresh := NIL;
@SetColumnFun := NIL;
@RecSortFun := NIL;
@RecFindFun := NIL;
@RecAll := NIL;
@RecNav := NIL;
@RecFunName := NIL;
//exit;
inherited;
end;
end.
DLL的导出代码如下:
unit DLLMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrls, Grids, DBGrids,MConnect,DLLForm,Example;
function InitInfoFun( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;
UserName,PassWord:String ): DWord;stdcall;
function GetLastError: PChar;stdcall;
function SetWinState( State: DWord )Word;stdcall;
function DestroyDLL:Word;stdcall;
function DPreview: DWord;stdcall;
function DPrint: DWord;stdcall;
function PrintSetup: DWord;stdcall;
function RecAdd: DWord;stdcall;
function RecModifyWord;stdcall;
function RecDel: DWord;stdcall;
function RecRefreshWord;stdcall;
function FSetColumnWord;stdcall;
function RecSortWord;stdcall;
function RecFind: DWord;stdcall;
function RecAllWord;stdcall;
function RecNav( nTypeWord)Word;stdcall;
function GetFunNameChar;stdcall;
var
LastError: String;
fDLLForm: TCInvest;
PExePath: String;
implementation
function InitInfoFun( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;UserName,PassWord:String ): DWord;
begin
Result := 0;
PExePath := ExePath;
fDLLForm := TCInvest.Create( Application );
try
with fDLLFormdo
begin
FlinkType := linkType;
FLinkStr := linkStr;
FLinkPort := portStr;
FExePath := ExePath;
FUserName := UserName;
FPassWord := Password;
ParentWindow := hHandle;
Show;
WindowState := wsMaximized;
end;
except
on E: Exceptiondo
begin
LastError := E.Message;
Result := 1;
end;
end;
end;
function GetLastError: PChar;
begin
//返回最后的错误
Result := PChar( LastError );
end;
function SetWinState( State: DWord )Word;
begin
//设置DLL窗口状态
//0-最大化
//1-最小化
//2-恢复
Result := 0;
if fDLLForm = nil then
exit;
fDLLForm.Visible := False;
case State of
0: fDllForm.WindowState := wsMaximized;
1: fDllForm.WindowState := wsMinimized;
2: fDllForm.WindowState := wsNormal;
else
begin
Result := 1;
LastError := '参数错误';
end
end;
fDLLForm.show;
end;
function DestroyDLL:Word;
begin
//
Result := 0;
try
fDLLForm.Close;
fDLLForm.data.DCOMCONN.Close;
fDLLForm.data.SOCKCONN.Close;
fDLLForm.data.WEBCONN.Close;
fDLLForm.data.Free;
fDLLForm.frDesign.Free;
fDLLForm.frDBDataSet1.Free;
fDLLForm.frReport1.Free;
except
Result := 1;
end;
end;
function DPreview: DWord;
begin
fDllForm.aPreview.Execute;
Result := 0;
end;
function DPrint: DWord;
begin
fDLLForm.aPrint.Execute;
Result := 0;
end;
function PrintSetup: DWord;
begin
fDLLForm.aPrintSetup.Execute;
Result := 0;
end;
function RecAdd: DWord;
begin
fDLLForm.aNew.Execute;
Result := 0;
end;
function RecModifyWord;
begin
fDLLForm.aModify.Execute;
Result := 0;
end;
function RecDel: DWord;
begin
fDLLForm.aDel.Execute;
Result := 0;
end;
function RecRefreshWord;
begin
fDLLForm.aRefresh.Execute;
Result := 0;
end;
function FSetColumnWord;
begin
fDLLForm.aSetColumn.Execute;
Result := 0;
end;
function RecSortWord;
begin
fDLLForm.aSetSort.Execute;
Result := 0;
end;
function RecFind: DWord;
begin
fDLLForm.aSearch.Execute;
Result := 0;
end;
function RecAllWord;
begin
fDLLForm.aAll.Execute;
Result := 0;
end;
function RecNav( nType: DWord ): DWord;
begin
case nType of
0: fDLLForm.aFirst.Execute;
1: fDLLForm.aPrev.Execute;
2: fDLLForm.aNext.Execute;
3: fDLLForm.aLast.Execute;
end;
Result := 0;
end;
function GetFunNameChar;
begin
//
Result := PChar( fDLLForm.Caption );
end;
end.
为什么我前五次都是正常的,但第6次就出现问题了?
我总共就160分了,没办法,只能暂时送100分啦
代码如下:
主程序:
procedure TfrmMain.TreeView1DblClick_0;
var
i: integer;
begin
for i := 0 to Self.MdiChildCount - 1do
begin
if TCInfoForm( Self.MDIChildren ).Tag = PMyRecord(TreeView1.selected.Data)^.tag then
begin
TCInfoForm( Self.MDIChildren ).Show;
exit;
end;
end;
CurTag := PMyRecord(TreeView1.selected.Data)^.tag;
CurDllName := Trim(PMyRecord(TreeView1.selected.Data)^.DLLName);
if not FileExists( AppRunPath + CurDllName ) then
begin
Application.MessageBox( '功能载体没有发现,请联系供应商!', '加载错误', mb_OK+MB_ICONERROR);
exit;
end;
Animate1.Visible := True;
Animate1.Active := True;
Animate1.Refresh;
ToolBar1.Refresh;
CurTag := PMyRecord(TreeView1.selected.Data)^.tag;
CurDllName := Trim( PMyRecord(TreeView1.selected.Data)^.DLLName );
with TCInfoForm.Create( Self )do
begin
Name := 'MMName'+IntToStr(CurTag);
Show;
WindowState := wsMaximized;
end;
ToolBar1.Refresh;
Animate1.Refresh;
Animate1.Active := False;
Animate1.Visible := False;
end;
调用DLL的MDI窗体Infoform如下
unit inforForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, CForm, ActnList, ExportsConst, DB, DBClient, MConnect, Menus;
type
TInitInfoFun = function( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;
UserName,PassWord:String ): DWord;stdcall;
//初始化
TLastErrorFun = function: PChar;stdcall;
TSetWinSttteFun = function( State: DWord )Word;stdcall;
TDestroyFun = function: DWord;Stdcall;
TPreviewFun = function: DWord;stdcall;
TPrintFun = function: DWord;stdcall;
TPrintSetupFun = function: DWord;stdcall;
TRecAddFun = function: DWord;stdcall;
TRecModifyFun = functionWord;stdcall;
TRecDelFun = functionWord;stdcall;
TRecRefresh = functionWord;stdcall;
TSetColumnFun = functionWord;stdcall;
TRecSortFun = function: DWord;stdcall;
TRecFindFun = function: DWord;stdcall;
TRecAll = functionWord;stdcall;
TRecNavFun = function( nType: DWord )Word;stdcall;
TRecFunName = function: PChar;stdcall;
TCInfoForm = class(TZForm)
infoAList: TActionList;
RecFirst: TAction;
RecPrev: TAction;
RecNext: TAction;
RecLast: TAction;
ActionList1: TActionList;
aPreview: TAction;
aPrint: TAction;
aPrinterSetup: TAction;
aExit: TAction;
aNew: TAction;
aModify: TAction;
aDel: TAction;
aTotal: TAction;
aRefresh: TAction;
aSearch: TAction;
aAll: TAction;
aSetColumn: TAction;
aSetSort: TAction;
MainMenu1: TMainMenu;
smnFile: TMenuItem;
smnPreview: TMenuItem;
smnPrint: TMenuItem;
smnPrinterSetup: TMenuItem;
N1: TMenuItem;
smnExit: TMenuItem;
smnEdit: TMenuItem;
smnNew: TMenuItem;
smnModify: TMenuItem;
smnDel: TMenuItem;
smnRefresh: TMenuItem;
N9: TMenuItem;
mnuSetColumn: TMenuItem;
mnuSetSort: TMenuItem;
N2: TMenuItem;
smnSearch: TMenuItem;
smnAll: TMenuItem;
procedure RecFirstExecute(Sender: TObject);
procedure RecPrevExecute(Sender: TObject);
procedure RecNextExecute(Sender: TObject);
procedure RecLastExecute(Sender: TObject);
procedure RecNewExecute(Sender: TObject);
procedure RecModifyExecute(Sender: TObject);
procedure RecDelExecute(Sender: TObject);
procedure RecRefreshExecute(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);override;
procedure SetDllName( s: String );
procedure FormResize(Sender: TObject);
procedure aExitExecute(Sender: TObject);
procedure aNewExecute(Sender: TObject);
procedure aPrinterSetupExecute(Sender: TObject);
procedure aPrintExecute(Sender: TObject);
procedure aPreviewExecute(Sender: TObject);
procedure aModifyExecute(Sender: TObject);
procedure aDelExecute(Sender: TObject);
procedure aRefreshExecute(Sender: TObject);
procedure aSearchExecute(Sender: TObject);
procedure aAllExecute(Sender: TObject);
procedure aSetColumnExecute(Sender: TObject);
procedure aSetSortExecute(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
sDLLName: String;
LibHandle: THandle;
FUserName: String;
FPassWord: String;
FLoginType: Integer;
FServerStr: String;
public
//公共函数
InitDllFun: TInitInfoFun;
GetLastError: TLastErrorFun;
SetWinState: TSetWinSttteFun;
DestroyFun: TDestroyFun;
PreviewFun: TPreviewFun;
PrintFun: TPrintFun;
PrintSetupFun: TPrintSetupFun;
RecAddFun: TRecAddFun;
RecModifyFun: TRecModifyFun;
RecDelFun: TRecDelFun;
RecRefresh: TRecRefresh;
SetColumnFun: TSetColumnFun;
RecSortFun: TRecSortFun;
RecFindFun: TRecFindFun;
RecAll: TRecAll;
RecNav: TRecNavFun;
RecFunName: TRecFunName;
constructor Create(AOwner: TComponent);
override;
end;
var
CInfoForm: TCInfoForm;
implementation
uses Main;
{$R *.dfm}
procedure TCInfoForm.RecFirstExecute(Sender: TObject);
begin
//头条记录
RecNav(0);
end;
procedure TCInfoForm.RecPrevExecute(Sender: TObject);
begin
//前条记录
RecNav(1);
end;
procedure TCInfoForm.RecNextExecute(Sender: TObject);
begin
//后条记录
RecNav(2);
end;
procedure TCInfoForm.RecLastExecute(Sender: TObject);
begin
//尾条记录
RecNav(3);
end;
procedure TCInfoForm.RecNewExecute(Sender: TObject);
begin
//新增记录
end;
procedure TCInfoForm.RecModifyExecute(Sender: TObject);
begin
//修改记录
end;
procedure TCInfoForm.RecDelExecute(Sender: TObject);
begin
//删除记录
end;
procedure TCInfoForm.RecRefreshExecute(Sender: TObject);
begin
//刷新记录
end;
procedure TCInfoForm.FormShow(Sender: TObject);
var
tmpCaption,tmpIP,tmpPort: String;
begin
inherited;
//
if LibHandle = 0 then
begin
LibHandle := LoadLibrary( PChar( sDLLName ) );
if LibHandle <> 0 then
begin
@InitDllFun := GetProcAddress( LibHandle, CON_INITFUNNAME );
@GetLastError := GetProcAddress( LibHandle, CON_LASTERRORFUN );
@SetWinState := GetProcAddress( LibHandle, CON_SETWINSTATE );
@DestroyFun := GetProcAddress( LibHandle, CON_DESTROYDLL );
@PreviewFun := GetProcAddress( LibHandle, CON_PREVIEW );
@PrintFun := GetProcAddress( LibHandle, CON_PRINT );
@PrintSetupFun := GetProcAddress( LibHandle, CON_PRINTSETUP );
@RecAddFun := GetProcAddress( LibHandle, CON_RECADD );
@RecModifyFun := GetProcAddress( LibHandle, CON_RECMODIFY );
@RecDelFun := GetProcAddress( LibHandle, CON_RECDEL );
@RecRefresh := GetProcAddress( LibHandle, CON_REFRESH );
@SetColumnFun := GetProcAddress( LibHandle, CON_SETCOLUMN );
@RecSortFun := GetProcAddress( LibHandle, CON_RECSORT );
@RecFindFun := GetProcAddress( LibHandle, CON_RECFIND );
@RecAll := GetProcAddress( LibHandle, CON_RECALL );
@RecNav := GetProcAddress( LibHandle, CON_RECNAV );
@RecFunName := GetProcAddress( LibHandle, CON_RECFUNNAME );
end;
end;
if LibHandle <> 0 then
begin
case FLoginType of
0:
begin
InitDllFun( Self.Handle, FLoginType, Pchar( FServerStr ), '',
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
1:
begin
tmpIP := Copy( FServerStr, 1, Pos( FServerStr, ':' )-1);
tmpPort := Copy( FServerStr, Pos( FServerStr, ':' ), Length( FServerStr ) );
InitDllFun( Self.Handle, FLoginType, Pchar( tmpIP ), PChar( tmpPort ),
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
2:
begin
InitDllFun( Self.Handle, FLoginType, Pchar( FServerStr ), '',
PChar( frmMain.AppRunPath ),
PChar( FUserName), PChar( FPassWord ) );
end;
end;
end;
tmpCaption := String(RecFunName);
Self.Caption := tmpCaption;
end;
procedure TCInfoForm.FormCreate(Sender: TObject);
begin
inherited;
//
LibHandle := 0;
end;
procedure TCInfoForm.SetDllName(s: String);
begin
//
sDLLName := s;
end;
constructor TCInfoForm.Create(AOwner: TComponent);
begin
sDLLName := TfrmMain( AOwner ).CurDllName;
Self.Tag := TfrmMain( AOwner ).CurTag;
Self.FUserName := TfrmMain( AOwner ).FUserName;
Self.FPassWord := TfrmMain( AOwner ).FPassWord;
Self.FLoginType := TfrmMain( AOwner ).FLoginType;
Self.FServerStr := TfrmMain( AOwner ).FServerStr;
inherited;
end;
procedure TCInfoForm.FormResize(Sender: TObject);
begin
inherited;
//
try
if {(@SetWinState <> nil) and }(Self.Caption <> 'close') then
SetWinState(0);
except
;
end;
end;
procedure TCInfoForm.aExitExecute(Sender: TObject);
begin
Self.Close;
end;
procedure TCInfoForm.aNewExecute(Sender: TObject);
begin
if @RecAddFun <> nil then
RecAddFun;
end;
procedure TCInfoForm.aPrinterSetupExecute(Sender: TObject);
begin
if @PrintSetupFun <> nil then
PrintSetupFun;
end;
procedure TCInfoForm.aPrintExecute(Sender: TObject);
begin
if @PrintFun <> nil then
PrintFun;
end;
procedure TCInfoForm.aPreviewExecute(Sender: TObject);
begin
if @PreviewFun <> nil then
PreviewFun;
end;
procedure TCInfoForm.aModifyExecute(Sender: TObject);
begin
if @RecModifyFun <> nil then
RecModifyFun;
end;
procedure TCInfoForm.aDelExecute(Sender: TObject);
begin
if @RecDelFun <> nil then
RecDelFun;
end;
procedure TCInfoForm.aRefreshExecute(Sender: TObject);
begin
if @RecRefresh <> nil then
RecRefresh;
end;
procedure TCInfoForm.aSearchExecute(Sender: TObject);
begin
if @RecFindFun <> nil then
RecFindFun;
end;
procedure TCInfoForm.aAllExecute(Sender: TObject);
begin
if @RecAll <> nil then
RecAll;
end;
procedure TCInfoForm.aSetColumnExecute(Sender: TObject);
begin
if @SetColumnFun <> nil then
SetColumnFun;
end;
procedure TCInfoForm.aSetSortExecute(Sender: TObject);
begin
if @RecSortFun <> nil then
RecSortFun;
end;
procedure TCInfoForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
//exit;
Self.Caption := 'close';
try
DestroyFun;
except
;
end;
try
FreeLibrary( LibHandle );
except
;
end;
//LibHandle := 0;
Self.OnResize := nil;
@InitDllFun := NIL;
@GetLastError := NIL;
@SetWinState := NIL;
@DestroyFun := NIL;
@PreviewFun := NIL;
@PrintFun := NIL;
@PrintSetupFun := NIL;
@RecAddFun := NIL;
@RecModifyFun := NIL;
@RecDelFun := NIL;
@RecRefresh := NIL;
@SetColumnFun := NIL;
@RecSortFun := NIL;
@RecFindFun := NIL;
@RecAll := NIL;
@RecNav := NIL;
@RecFunName := NIL;
//exit;
inherited;
end;
end.
DLL的导出代码如下:
unit DLLMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Mask, DBCtrls, Grids, DBGrids,MConnect,DLLForm,Example;
function InitInfoFun( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;
UserName,PassWord:String ): DWord;stdcall;
function GetLastError: PChar;stdcall;
function SetWinState( State: DWord )Word;stdcall;
function DestroyDLL:Word;stdcall;
function DPreview: DWord;stdcall;
function DPrint: DWord;stdcall;
function PrintSetup: DWord;stdcall;
function RecAdd: DWord;stdcall;
function RecModifyWord;stdcall;
function RecDel: DWord;stdcall;
function RecRefreshWord;stdcall;
function FSetColumnWord;stdcall;
function RecSortWord;stdcall;
function RecFind: DWord;stdcall;
function RecAllWord;stdcall;
function RecNav( nTypeWord)Word;stdcall;
function GetFunNameChar;stdcall;
var
LastError: String;
fDLLForm: TCInvest;
PExePath: String;
implementation
function InitInfoFun( hHandle:HWND;
linkType: DWORD;
linkStr: PChar;
portStr: PChar;
ExePath: PChar;UserName,PassWord:String ): DWord;
begin
Result := 0;
PExePath := ExePath;
fDLLForm := TCInvest.Create( Application );
try
with fDLLFormdo
begin
FlinkType := linkType;
FLinkStr := linkStr;
FLinkPort := portStr;
FExePath := ExePath;
FUserName := UserName;
FPassWord := Password;
ParentWindow := hHandle;
Show;
WindowState := wsMaximized;
end;
except
on E: Exceptiondo
begin
LastError := E.Message;
Result := 1;
end;
end;
end;
function GetLastError: PChar;
begin
//返回最后的错误
Result := PChar( LastError );
end;
function SetWinState( State: DWord )Word;
begin
//设置DLL窗口状态
//0-最大化
//1-最小化
//2-恢复
Result := 0;
if fDLLForm = nil then
exit;
fDLLForm.Visible := False;
case State of
0: fDllForm.WindowState := wsMaximized;
1: fDllForm.WindowState := wsMinimized;
2: fDllForm.WindowState := wsNormal;
else
begin
Result := 1;
LastError := '参数错误';
end
end;
fDLLForm.show;
end;
function DestroyDLL:Word;
begin
//
Result := 0;
try
fDLLForm.Close;
fDLLForm.data.DCOMCONN.Close;
fDLLForm.data.SOCKCONN.Close;
fDLLForm.data.WEBCONN.Close;
fDLLForm.data.Free;
fDLLForm.frDesign.Free;
fDLLForm.frDBDataSet1.Free;
fDLLForm.frReport1.Free;
except
Result := 1;
end;
end;
function DPreview: DWord;
begin
fDllForm.aPreview.Execute;
Result := 0;
end;
function DPrint: DWord;
begin
fDLLForm.aPrint.Execute;
Result := 0;
end;
function PrintSetup: DWord;
begin
fDLLForm.aPrintSetup.Execute;
Result := 0;
end;
function RecAdd: DWord;
begin
fDLLForm.aNew.Execute;
Result := 0;
end;
function RecModifyWord;
begin
fDLLForm.aModify.Execute;
Result := 0;
end;
function RecDel: DWord;
begin
fDLLForm.aDel.Execute;
Result := 0;
end;
function RecRefreshWord;
begin
fDLLForm.aRefresh.Execute;
Result := 0;
end;
function FSetColumnWord;
begin
fDLLForm.aSetColumn.Execute;
Result := 0;
end;
function RecSortWord;
begin
fDLLForm.aSetSort.Execute;
Result := 0;
end;
function RecFind: DWord;
begin
fDLLForm.aSearch.Execute;
Result := 0;
end;
function RecAllWord;
begin
fDLLForm.aAll.Execute;
Result := 0;
end;
function RecNav( nType: DWord ): DWord;
begin
case nType of
0: fDLLForm.aFirst.Execute;
1: fDLLForm.aPrev.Execute;
2: fDLLForm.aNext.Execute;
3: fDLLForm.aLast.Execute;
end;
Result := 0;
end;
function GetFunNameChar;
begin
//
Result := PChar( fDLLForm.Caption );
end;
end.
为什么我前五次都是正常的,但第6次就出现问题了?
我总共就160分了,没办法,只能暂时送100分啦