公布源代码（ERP系统外壳程序）

kesa 2002-04-25 03:32:30

感谢大家对我的支持和帮助，我将公布部分核心代码，给大家参考
希望大家批评指教
unit mainunit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ExtCtrls, Menus, ToolWin, DBCtrls, ImgList, StdActns, ActnList,
DBActns ,FileCtrl ;

type
pmenu_file=^Tmenu_file;
Tmenu_file=record
MENU_NODEID:integer; //菜单结点ID号
MENU_NAME:string; //菜单名字
MENU_PACKAGE:string; //单击结点时运行的包名字。
PARENT_ID:integer; //父结点ID号
REMARK:string; //备注。
end;

type
TcreateNewObject = function(params1:tstringlist;params2:tstringlist) :Tobject;
//TdestroyloadObject = function :Boolean;
Tmainfrm = class(TForm)
TVmenu: TTreeView;
Splitter1: TSplitter;
MainMenu1: TMainMenu;
File1: TMenuItem;
Window2: TMenuItem;
Help1: TMenuItem;
StatusBar1: TStatusBar;
ImageList1: TImageList;
N2: TMenuItem;
N3: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
ImageList2: TImageList;
N15: TMenuItem;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton17: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton13: TToolButton;
ToolButton11: TToolButton;
TBtv: TToolButton;
ActionList1: TActionList;
EditCopy1: TEditCopy;
EditCut1: TEditCut;
EditPaste1: TEditPaste;
DataSetFirst1: TDataSetFirst;
DataSetLast1: TDataSetLast;
DataSetNext1: TDataSetNext;
DataSetPrior1: TDataSetPrior;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
CASCADE1: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
NReLogin: TMenuItem;
NChangePassWord: TMenuItem;
N1: TMenuItem;
N4: TMenuItem;
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure TVmenuDblClick(Sender: TObject);
procedure Loadpkbyname(pkname:string;pkmenuname:string);
procedure N3Click(Sender: TObject);
procedure TBtvClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure NReLoginClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure NChangePassWordClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
private
procedure InitTreeView;
procedure filltree(midnode:ttreenode;midfilter:integer);
procedure CheckFileAgeAndDownLoadNew();
public
{ Public declarations }
pubobject:THandle;
end;

var
mainfrm: Tmainfrm;

implementation
uses loginunit,dmunit, ChangePsWUnit, DownLoadFileUnit;

{$R *.DFM}

procedure Tmainfrm.ToolButton4Click(Sender: TObject);
begin
cascade;
end;

procedure Tmainfrm.ToolButton6Click(Sender: TObject);
begin
tilemode:=tbhorizontal;
tile;
end;

procedure Tmainfrm.ToolButton5Click(Sender: TObject);
begin
tilemode:=tbvertical;
tile;
end;

procedure Tmainfrm.ToolButton12Click(Sender: TObject);
begin
application.Terminate;
end;

procedure Tmainfrm.TVmenuDblClick(Sender: TObject);
var
i,l_len:integer;
pk_name:string;
pk_menuchoose:string;
begin
if MDICHILDCOUNT=3 then
begin
application.MessageBox('您最多可以同时打开三个窗口！','信息',48);
exit;
end;
pk_menuchoose:=pmenu_file(TVmenu.selected.Data)^.MENU_NAME;
pk_name:=pmenu_file(TVmenu.selected.Data)^.MENU_PACKAGE;
l_len:=length(pk_name);
pk_name:=copy(pk_name,3,l_len-8)+'frm';
for i:=0 to MDICHILDCOUNT-1 do
begin
if uppercase(MdiChildren[i].Name)=uppercase(pk_name) then // already open
begin
MdiChildren[i].BringToFront;
exit;
end;
end;

if pmenu_file(TVmenu.Selected.Data)^.MENU_PACKAGE<>'' then
begin
loadpkbyname(pmenu_file(TVmenu.selected.Data)^.MENU_PACKAGE,pmenu_file(TVmenu.selected.Data)^.MENU_NAME);
cascade;
//mainmenu1.Items.Caption:='abcd';
end;
end;
procedure Tmainfrm.loadpkbyname(pkname:string;pkmenuname:string);
var
pkobject:THandle;
// AForm: TForm;
CreateNewObject:TCreateNewObject; // -- test pass user ID, mybe OK--//
//ReturnObject:Tobject;
params1:tstringlist;
params2:tstringlist;

begin
params1 := TStringList.Create;//公用参数表
params2 := TStringList.Create;//动态参数表
params1.Add('userid='+trim(userid));//当前用户
params1.add('pubhandle='+inttostr(pubobject));//公用模块handle
params2.add('menuname='+trim(pkmenuname));//调用菜单项的名称
// showmessage('1-----'+params1.values['pubhandle']);
pkname:='PKlib\'+pkname; // package dir
pkobject:=Loadpackage(pkname);
@CreateNewObject:=GetprocAddress(pkobject,'CreateObject');
if integer(@CreateNewObject)<0 then application.messagebox('包加载失败!','Load Package',48)
else
createnewobject(params1,params2); // -- test pass user ID, mybe OK--//

end;

...全文