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

Question

procedure Tmainfrm.N3Click(Sender: TObject);
begin
     application.Terminate;
end;//--------------------------------------------------
//     根据传来的用户组代码.选出相应的菜单结点
//     然后初始化TREEVIEW（即显示相应的菜单)
//  --------------------------------------------------
procedure Tmainfrm.InitTreeView;
var
  midsql:string;
  i:integer;
  curmidnode:ttreenode;
begin
  dmshare.TVmenuQry.Close;
  midsql:='select MENU_NODEID, MENU_NAME, PARENT_ID, MENU_PACKAGE, FILE_AGE, REMARK, '+
          'BPL_LOADDATE from MENU_FILE where MENU_NODEID in '+
          '( select MENU_NODEID FROM GROUP_MENUCODE WHERE GROUP_CODE =:GROUPCODE )';
  dmshare.TVmenuQry.SQL.Clear;
  dmshare.TVmenuQry.SQL.ADD(midsql);
  dmshare.TVmenuQry.ParamByName('GROUPCODE').asstring:=group_code;
  dmshare.TVmenuQry.Open;
  //// 下载最新版本
  CheckFileAgeAndDownLoadNew();  TVmenu.Items.Clear;
  filltree(nil,0);
  i:=0;
  while i<tvmenu.items.count do
    begin
      curmidnode:=TVmenu.Items[i];
      filltree(curmidnode,pmenu_file(curmidnode.data)^.MENU_NODEID);
      inc(i);
    end;  dmshare.TVmenuQry.Close;
end;
//-------------------------------------------------------------------------
//  本子程式为添充TREEVIEW菜单树的子程序。
//  结点.TEXT 为MENU_FILE中的MENU_NAME字段．
//  结点.DATA 为指向一个记录类型.它包括MENU_FILE中一条记录的所有信息.
//-------------------------------------------------------------------------
procedure tmainfrm.filltree(midnode:ttreenode;midfilter:integer);
var
  curmidnode:ttreenode;
  count:integer;
  Pcurrec:pmenu_file;
begin
  dmshare.TVmenuQry.filter:='PARENT_ID='+inttostr(midfilter);
  dmshare.TVmenuQry.filtered:=true;
  dmshare.TVmenuQry.First;
  count:=0;
  while count<dmshare.TVmenuQry.RecordCount do
    begin
      inc(count);
      new(pcurrec);
      pcurrec^.MENU_NODEID :=dmshare.TVmenuQry.fieldbyname('MENU_NODEID').asinteger;
      pcurrec^.MENU_NAME :=dmshare.TVmenuQry.fieldbyname('MENU_NAME').asstring;
      pcurrec^.PARENT_ID :=dmshare.TVmenuQry.fieldbyname('PARENT_ID').asinteger;
      pcurrec^.REMARK :=dmshare.TVmenuQry.fieldbyname('REMARK').asstring;
      pcurrec^.MENU_PACKAGE :=dmshare.TVmenuQry.fieldbyname('MENU_PACKAGE').asstring;
      if  midnode=nil   then
        curmidnode:=TVmenu.Items.addobject(nil,pcurrec^.MENU_NAME,pcurrec)
      else
        curmidnode:=TVmenu.Items.addchildobject(midnode,pcurrec^.MENU_NAME,pcurrec);
        curmidnode.selectedindex:=0;
        curmidnode.ImageIndex :=1;
        dmshare.TVmenuQry.Next;
    end;end;procedure tmainfrm.CheckFileAgeAndDownLoadNew();
var
  i, fhandle : integer;
  PkName : string;
  NewFileIds : array of integer;
  insql : string;
  t : TMemoryStream;
begin
  NewFileIds := nil;
  //若不存在 \pklib\目录，则创建
  try
    if not DirectoryExists('Pklib\') then
      MkDir('Pklib\');
  except
    raise exception.Create('磁盘写入错误，无法从服务器中下载程序！');
  end;  //查询需要更新的包，把它们的id放入一数组
  dmshare.TVmenuQry.First;
  while not dmshare.TVmenuQry.Eof do
  begin
    PkName := vartostr(dmshare.TVmenuQry['MENU_PACKAGE']);
    if (trim(PkName) <> '') and (DMSHARE.TVmenuQry.FieldByName('BPL_LOADDATE').asdatetime <> 0) then
      if (not FileExists('PKlib\'+PkName)) or  (
        FILEDATETODATETIME(FILEAGE('PKlib\'+PkName)) < DMSHARE.TVmenuQry.FieldByName('BPL_LOADDATE').asdatetime) then
      begin
        setlength(NewFileIds,length(NewFileIds)+1);
        NewFileIds[Length(NewFileIds)-1] := DmShare.TVmenuQry.fieldByName('MENU_NODEID').asinteger;
      end;
    dmshare.TVmenuQry.Next;
  end;  //根据上面产生的存放id的数组找出包和修改时间
  if length(NewFileIds) > 0 then
  begin
    insql := '';
    for i := 0 to Length(NewFileIds) - 1 do
      insql := insql + 'MENU_NODEID = '''+inttostr(NewFileIds[i])+''' or ';
    NewFileIds := nil;
    insql := copy(insql, 1,length(insql) - 3);
    insql := 'select MENU_NODEID,MENU_PACKAGE,CUR_BPL,Bpl_LoadDate from Menu_File where '+ insql;
    with dmshare.BplQuery do
    begin
      close;
      sql.Clear;
      sql.Add(insql);
      try
        Prepare;
        open;
      except
        application.MessageBox('读取模块最新版本的信息时出错！','提示',mb_ok+mb_iconInformation);
        exit;
      end;      //把找出到包更新到\pklib\下，为空的包不更新,按照file_age修改产生文件的最终修改时间
      //并生成一个进度提示
      DownLoadFileFrm := TDownLoadFileFrm.Create(self);
      while not eof do
      begin
        if vartostr(dmshare.BplQuery['MENU_PACKAGE']) <> '' then
        begin
          DownLoadFileFrm.Show;
          application.ProcessMessages;
          DownLoadFileFrm.Label3.Caption := vartostr(DmShare.BplQuery['MENU_PACKAGE']);
          PkName := vartostr(DmShare.BplQuery['MENU_PACKAGE']);
          try
            t := TMemoryStream.Create;
            try
              dmshare.BplQueryCUR_BPL.SaveToStream(t);
              if t.Size > 0 then
              begin
                t.SaveToFile(pchar(GetCurrentDir()+'\PKlib\'+PkName));
                fhandle := fileopen(pchar(GetCurrentDir()+'\PKlib\'+PkName),fmOpenWrite);
                FileSetDate(fhandle,DateTimeToFileDate(dmshare.BplQuery.fieldbyname('Bpl_LoadDate').asdatetime)+1);   //1为一秒，保证修改时间 >= 服务Bpl_LoadDate
                FileClose(fhandle);
              end;
            finally
              t.Free;
            end;
          except
            application.MessageBox('部分文件正在被使用，无法更新，请关闭相关程序并重新更新！','提示',mb_ok+mb_iconinformation);
            exit;
          end;
        end;
        Next;
      end;
      Close;
      UnPrepare;
    end;
    DownLoadFileFrm.Label3.Caption := '';
    DownLoadFileFrm.Label2.Caption := '更新完毕';
    DownLoadFileFrm.Close;
    DownLoadFileFrm.free;
  end;
end;procedure Tmainfrm.TBtvClick(Sender: TObject);
begin
      N4click(nil);
end;procedure Tmainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
      if MDICHILDCOUNT >=1 then
      begin
         if MessageDlg('是否真要退出整个系统?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
         try
           LoginFrm.free;
         finally
           action:=cafree;
         end
         else action:=canone;
      end;
end;procedure Tmainfrm.NReLoginClick(Sender: TObject);
begin
  if (MDICHILDCOUNT >=1) then
  begin
    application.MessageBox('重新登录前，请先关闭你在使用的模块！','提示',mb_iconinformation+mb_Ok);
    exit;
  end;  try
    //Application.CreateForm(Tloginfrm, loginfrm);
    if LoginFrm.ShowModal = mrok then
    begin
     StatusBar1.panels[0].text:='用户名称: '+userName+'@'+deptCode;
     StatusBar1.panels[1].text:='日期: '+datetostr(now);
     InitTreeview;
    end;
  finally
    LoginFrm.Hide;
  end;
end;procedure Tmainfrm.FormShow(Sender: TObject);
var
    CreateNewObject:TCreateNewObject; // -- test pass user ID, mybe OK--//
    params1:tstringlist;
    params2:tstringlist;
    pkname:string;
begin
   StatusBar1.panels[0].text:='用户名称: '+userName+'@'+deptCode;
   StatusBar1.panels[1].text:='日期: '+datetostr(now);
   InitTreeview;  // 按照登录用户的权限，初始化TREEVIEW（即显示相应的菜单)
//加载公用包
    params1 := TStringList.Create;
    params2 := TStringList.Create;
    params1.Add('userid='+trim(userid));
    params2.add('menuname=public');
    pkname:='PKlib\pkPubSearch50.bpl';
    pubobject:=Loadpackage(pkname);
    @CreateNewObject:=GetprocAddress(pubobject,'CreateObject');
    if integer(@CreateNewObject)<0 then application.messagebox('包加载失败!','Load Package',48)
    else
      createnewobject(params1,params2);   // -- test pass user ID, mybe OK--//
end;

Answer 1

procedure Tmainfrm.NChangePassWordClick(Sender: TObject);
begin
  try
    ChangePsWFrm.PreSet(UserId);
    ChangePsWFrm.ShowModal;
  except
    Application.CreateForm(TChangePsWFrm, ChangePsWFrm);
    ChangePsWFrm.PreSet(UserId);
    ChangePsWFrm.ShowModal;
  end;
end;procedure Tmainfrm.N1Click(Sender: TObject);
begin
     if N1.Checked=true then
     begin
         toolbar1.Visible:=false;
         N1.checked:=false;
     end else
     begin
         toolbar1.Visible:=true;
         N1.checked:=true;
     end;
end;procedure Tmainfrm.N4Click(Sender: TObject);
begin
     if N4.Checked=true then
     begin
        TVmenu.Visible:=false;
        TBtv.Hint:='打开树形菜单';
        N4.checked:=false;
     end else
     begin
        TVmenu.Visible:=true;
        TBtv.Hint:='关闭树形菜单';
        N4.checked:=true;
     end;
end;end.

Answer 2

你的程序使用了好多的第三方控件哦，
最多也就是看看那些delphi自带的控件的
程序了！

Answer 3

程序功能简单概要：
1、根据不同用户不同权限，动态生成树形目录，调用不同的BPL包
2、动态从数据库更新BPL包
3、易于管理维护

Answer 4

4、系统发布时，只发布外壳程序，根据不同的用户现在不同的BPL
5、每个程序模块都可以打成BPL包直接由外壳程序调用，只要你将不同的程序（库库管理，生产管理……）打成不同的BPL包，分给不同的用户使用，每个用户独立的使用自己的模块，根据自己的权限

Answer 5

不错，但是这个只是整个程序最外层的那个“包袱皮”吧。
把和数据库打交道的单元贴点出来嘛，这里看不出来是三层还是两层，还有什么COM+之类的。
如果需要的话，我们可以帮助测试测试嘛！呵呵。

Answer 6

fredfei(飞飞)，你有没有看得懂，这是应用在企业内部局域网，C/S两层，这是客户端程序。你明白更新流程吗，你知道怎么更新的吗？ 这和客户端时钟有什么关系，你是真的DELPHI 程序员还是假的

Answer 7

能给份源码吗？
[email protected]

Answer 8

不错，但是还不够，搞个zip什么的发送发送。。

Answer 9

学习（虽然看不太懂）
[email protected]

Answer 10

错，但是这个只是整个程序最外层的那个“包袱皮”吧。
把和数据库打交道的单元贴点出来嘛，这里看不出来是三层还是两层，还有什么COM+之类的

Answer 11

61.145.171.177里面有一整套erp系统,看你有没有本事去拿了.
而且是专线一天24小时在线.(Delphi+Sql Server写的)