【搞定】UFIDA升级问题**

ufida

使用RUN2方法后，出现如图效果，初步判断还是系统初始化功能，因为升级不支持RUN2方法，应该没有调用TIEFuncContainer功能，请尽快处理，以支持我们需要的功能。
另在从初始化运行中，切换岗位后，功能列表消失。

jiahaiminghr

楼主，升级后可能把你旧的资源覆盖掉了。

能否提供相关资源，我这里恢复一个环境调试一下。

ufida

{*******************************************************}
{                                                       }
{                  Business Init Func                   }
{                                                       }
{       Copyright (c) Justep Software Corporation       }
{                                                       }
{        业务运行平台初始化功能，系统的入口功能         }
{                                                       }
{*******************************************************}

unit Init;

interface

uses
  System.Collections,
  Borland.Delphi.msxml,
  Business.System, Business.Data, Business.Model, Business.Forms,
  SystemCore, SystemUtils, CommonComponentLibrary;

type

  { TInit }

  TInit = class(TFunc)
  private
    FLogoned: Boolean;
    FCMPlatform: TFunc;

    FRunningClients: TRunningClients;

    FShutdown: TBusinessRuntimeServerMethod;
    FShow: TBusinessRuntimeServerMethod;
    FRegisterClient: TRegisgerClient;
    FUnregisterClient: TUnregisgerClient;
    FTouchClient: TTouchClient;
    FGetServerURL: TGetServerURL;
    FGetOperatorID: TGetOperatorID;
    FGetClientAccount: TGetClientAccount;

    FRunning: TRunning;

    static function UseAD: Boolean;
    static function LoginUseAD: Boolean;

    static function InternalLogon: Boolean;

    { 以下方法由 Business 内部调用，不需要在其他任何地方调用，但可在其中加入需
      要在系统启动前初始化、系统退出之前释放的代码。 }
    static function Logon(const LogonID, Password: string): TOperator;
    static procedure Logoff;
    static procedure Init;
    static procedure Uninit;
  protected
    procedure DoRun; override;
    procedure DoTerminate; override;
  public
    constructor Create(AContext: TContext);
    destructor Destroy; override;

    { 系统初始化功能的实例 }
    static function InitInstance: TInit;
    { 提供给主界面注销用的方法 }
    static procedure LogoffByUser;

    procedure StartServer;
    procedure StopServer;

    property RunningClients: TRunningClients read FRunningClients;
  end;

  { TRunningClient }
  TRunningClient = class(TObject)
    LastActive: TDateTime;
    Timeout: Integer;
  end;

  { TRunningClients }
  TRunningClients = class
  private
    FItems: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;

    function Find(const ID: string): TRunningClient;
    procedure Add(const ID: string; Timeout: Integer);
    procedure Remove(const ID: string);
    procedure Touch(const ID: string);
    procedure TouchOrAdd(const ID: string; Timeout: Integer);
  end;

implementation

type
  { TRunning }
  TRunning = class(TBusinessRuntimeServerMethod)
    Running: Boolean;
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TShutdown }
  TShutdown = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TShow }
  TShow = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TRegisgerClient }
  TRegisgerClient = class(TBusinessRuntimeServerMethod)
    FRegister: TRunningClients;
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TUnregisgerClient }
  TUnregisgerClient = class(TBusinessRuntimeServerMethod)
    FRegister: TRunningClients;
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TTouchClient }
  TTouchClient = class(TBusinessRuntimeServerMethod)
    FRegister: TRunningClients;
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TGetServerURL }
  TGetServerURL = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TGetOperatorID }
  TGetOperatorID = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TGetClientAccount }
  TGetClientAccount = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

  { TCreateFunc }
  TCreateFunc = class(TBusinessRuntimeServerMethod)
    function GetName: string; override;
    function Invoke(var Params: array of object): object; override;
  end;

var
  FInitInstance: TInit;
  FInternalDisableAutoLogon: Boolean;
  CreateFunc: TCreateFunc;

{ TInit }

constructor TInit.Create(AContext: TContext);
begin
  inherited;
  FInitInstance := self;

  FRunningClients := TRunningClients.Create;

  FShutdown := TShutdown.Create;
  FShow := TShow.Create;

  FRegisterClient := TRegisgerClient.Create;
  FRegisterClient.FRegister := FRunningClients;
  FUnregisterClient := TUnregisgerClient.Create;
  FUnregisterClient.FRegister := FRunningClients;
  FTouchClient := TTouchClient.Create;
  FTouchClient.FRegister := FRunningClients;

  FGetServerURL := TGetServerURL.Create;
  FGetOperatorID := TGetOperatorID.Create;

  FGetClientAccount := TGetClientAccount.Create;

  FRunning := TRunning.Create;

  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FShutdown);
  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FShow);

  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FRegisterClient);
  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FUnregisterClient);
  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FTouchClient);

  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FGetServerURL);
  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FGetOperatorID);

  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FRunning);

  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(FGetClientAccount);

  StartServer;
end;

destructor TInit.Destroy;
begin
  StopServer;

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FGetClientAccount);

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FRunning);

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FGetOperatorID);
  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FGetServerURL);

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FRegisterClient);
  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FUnregisterClient);
  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FTouchClient);

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FShow);
  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(FShutdown);

  FGetClientAccount.Free;

  FRunning.Free;

  FGetOperatorID.Free;
  FGetServerURL.Free;

  FRegisterClient.Free;
  FUnregisterClient.Free;
  FTouchClient.Free;

  FShow.Free;
  FShutdown.Free;

  inherited;
end;

static function TInit.InitInstance: TInit;
begin
  Result := FInitInstance;
end;

static procedure TInit.LogoffByUser;
var
  SaveInternalDisableAutoLogon: Boolean;
begin
  SaveInternalDisableAutoLogon := FInternalDisableAutoLogon;
  FInternalDisableAutoLogon := True;
  try
    TSystemCore.Logoff;
    InitInstance.FLogoned := False;

    if TSystemCore.Operator = nil then
    begin
      if not InternalLogon then
      begin
        InitInstance.Terminate;
        Exit;
      end;
    end;
    InitInstance.FLogoned := True;

    // IE嵌入登陆
    if TSystemCore.Operator <> nil then
      InitInstance.MainForm := TSystemCore.SystemInterface.CreateMainForm(TSystemCore.Operator.Context)
    else
      InitInstance.MainForm := TSystemCore.SystemInterface.CreateMainForm(InitInstance.Context);
  finally
    FInternalDisableAutoLogon := SaveInternalDisableAutoLogon;
  end;
end;

static function TInit.UseAD: Boolean;
begin
  Result := SysUtils.SameText(SysSrv.SysService.Config.Attributes('addomain/enabled', ''), 'true');
end;

static function TInit.LoginUseAD: Boolean;
var
  I: Integer;
  o: object;
  disp: System.dispatchhelper;
  s, domain, pdc, username: string;
  person: Org.TPerson;
  domains: IXMLDOMNodeList;
  domainNode: IXMLDOMElement;
  pdcip: array of string;
begin
  Result := False;
  try
    o := ComObj.CreateOleObject('WinNTSystemInfo');
    try
      disp := TDispatchHelper.Create(o);
      domain := disp.PropertyGet('DomainName', []) as System.String;
      if domain = '' then
        Exit;

      pdc := disp.PropertyGet('PDC', []) as System.String;

      username := disp.PropertyGet('UserName', []) as System.String;
      if username = '' then
        Exit;
    finally
      (o as System.IDisposable).Dispose;
    end;

    domains := SysSrv.SysService.Config.Element.getElementsByTagName('domain');
    for I := 0 to domains.length - 1 do
    begin
      domainNode := domains.item[I] as IXMLDOMElement;
      s := ObjectHelper.ToString(domainNode.getAttribute('name'), '');
      if SysUtils.SameText(s, domain) then
      begin
        s := ObjectHelper.ToString(domainNode.getAttribute('pdcip'), '');
        if s <> '' then
        begin
          pdcip := s.Split([';', ',', ' ']);
          if not (pdcip as IList).Contains(jsSysUtils.GetComputerIPStr(pdc)) then
            Exit;
        end;

        s := ObjectHelper.ToString(domainNode.getAttribute('account'), domain);
        BizSys.BizSystem.ClientAccount := s;
        s := Opr.OperatorLoader.FindPersonID(username, '', False);
        if s = '' then
          Exit;

        person := Org.OrgSys.OrgSystem.FindPerson(s);

        if person = nil then
          Exit;

        Result := TSystemCore.Logon(person.ID, person.Password);

        Exit;
      end;
    end;
  except
  end;
end;


static function TInit.InternalLogon: Boolean;
const
  MaxLogonFailCount = 3;
  LogonErrorMsg01 = '登录失败';
  LogonErrorMsg02 = '用户不存在或者密码错误，请注意大小写，密码是区分大小写的。';
  LogonErrorMsg03 = '对不起，您已经 %d 次登录失败，将退出系统。';
var
  I: Integer;
  lAccept: Boolean;
  sUser, sPass, lAccountID, lUserID: String;
  lIniFile: TIniFile;
  lIniFileName: String;
begin
  if not FInternalDisableAutoLogon then
  begin
    if UseAD and LoginUseAD then
    begin
      Result := True;
      Exit;
    end;
  end;

  lIniFileName := jsCommon.ModulePath + 'Business.ini';

  lIniFile := TIniFile.Create(lIniFileName);
  try
    sUser := lIniFile.ReadString('System', 'LastLogonUserID', '');
    sPass := '';
    I := MaxLogonFailCount;
    repeat
      if I <> MaxLogonFailCount then
        Dialogs.MessageDlg(LogonErrorMsg02, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK] , 0);
      lAccept := TSystemCore.SystemInterface.ShowLogonForm(sUser, sPass);
      if not lAccept then Break;

      // IE嵌入登陆 sUser的返回可以为空（这个方案不好，为了做嵌入IE登陆）
      if sUser <>  '' then
      begin
        lAccountID := sUser;
        lUserID := JSCommon.SplitStr('@', lAccountID);
        BizSys.BizSystem.ClientAccount := lAccountID;

        Result := (not Opr.IsSystemManager(lUserID) or ExtUtils.ClientAccountExist(BizSys.BizSystem.ClientAccount)) and
          TSystemCore.Logon(lUserID, sPass);
      end
      else
        Result := True;

      if Result then Break;
      Dec(I);
    until I = 0;
    if Result then
      try
        lIniFile.WriteString('System', 'LastLogonUserID', sUser);
      except

      end
    else
      if lAccept then
        Dialogs.MessageDlg(SysUtils.Format(LogonErrorMsg03, [MaxLogonFailCount]),
          TMsgDlgType.mtError, [TMsgDlgBtn.mbOK] , 0);
  finally
    lIniFile.Free;
  end;
end;

procedure TInit.DoRun;
var
  lContext: TContext;
  lOperator: TOperator;
  lClassURL: TBizClassURL;
begin
  inherited DoRun;

  lClassURL := TBizClassURL.Create;
  try
    lClassURL.BizURL.URL := 'Biz:\COLLABORATION\TaskServiceFunc.Func';
    if BizSys.BizSystem.URLExists(lClassURL.BizURL) then
    begin
      FCMPlatform := BizSys.BizService.CreateBizObject(lClassURL, Context) as TFunc;
      FCMPlatform.Run('');
    end
    else
      FCMPlatform := nil;
  finally
    lClassURL.Free;
  end;

  lContext := Context.FindParentContext(BizSys.IL_PERSON);
  if lContext <> nil then
    lOperator := lContext.Owner as TOperator;

  if lOperator <> nil then
    TSystemCore.SetOperator(lOperator);

  if TSystemCore.Operator = nil then
  begin
    FLogoned := InternalLogon;
    if not FLogoned then
    begin
      Terminate;
      Exit;
    end;
  end;

  MainForm := TSystemCore.SystemInterface.CreateMainForm(Context);

  FRunning.Running := True;
end;

procedure TInit.DoTerminate;
begin
  FRunning.Running := False;

  if MainForm <> nil then
  begin
    if MainForm.Visible then
      MainForm.Close;
    MainForm.ParentWindow := 0;
    MainForm.Release;
    MainForm := nil;
    Forms.Application.ProcessMessages;
  end;

  TSystemCore.FuncManager.TerminateAllFuncs(True);

  // IE嵌入登陆 因为嵌入IE登陆的方案原因，导致这个代码难受
  if FLogoned and (TSystemCore.Operator <> nil) then
    TSystemCore.Logoff;

  if FCMPlatform <> nil then
  begin
    FCMPlatform.Terminate;
    FCMPlatform.Free;
  end;

  inherited;
end;

static function TInit.Logon(const LogonID, Password: string): TOperator;
begin
  if TSystemCore.Logon(LogonID, Password) then
    Result := TSystemCore.Operator
  else
    Result := nil;
end;

static procedure TInit.Logoff;
begin
  TSystemCore.Logoff;
end;

static procedure TInit.Init;
begin
  // 速度优化增加，调试期间建议去除，可以方便发现错误
  BizDict.CheckTablePhysicalField := False;

  TSystemCore.Init;

  TCommonComponentLibrary.Init;

  CreateFunc := TCreateFunc.Create;
  BizRtSrvr.BusinessRuntimeServer.RegisterMethod(CreateFunc);
end;

static procedure TInit.Uninit;
var
  F: TForm;
begin
  if FInitInstance <> nil then
  begin
    TSystemCore.FuncManager.TerminateAllFuncs(True);

    F := FInitInstance.MainForm;
    FInitInstance.MainForm := nil;
    if F <> nil then
      F.Free;

    Forms.Application.ProcessMessages;
  end;

  BizRtSrvr.BusinessRuntimeServer.UnregisterMethod(CreateFunc);
  FreeAndNil(CreateFunc);

  TCommonComponentLibrary.Uninit;

  TSystemCore.Uninit;
end;

procedure TInit.StartServer;
begin
  BizRtSrvr.BusinessRuntimeServer.Listener.AutoListen := True;
end;

procedure TInit.StopServer;
begin
  BizRtSrvr.BusinessRuntimeServer.Listener.AutoListen := False;
  if BizRtSrvr.BusinessRuntimeServer.Listener.Listening then
    BizRtSrvr.BusinessRuntimeServer.Listener.Unlisten;
end;

{ TShutdown }
function TShutdown.GetName: string;
begin
  Result := 'Shutdown';
end;

function TShutdown.Invoke(var Params: array of object): object;
begin
  TInit.InitInstance.Terminate;
  Result := nil;
end;

{ TShow }
function TShow.GetName: string;
begin
  Result := 'Show';
end;

function TShow.Invoke(var Params: array of object): object;
begin
  if TInit.InitInstance.MainForm <> nil then
  begin
    TInit.InitInstance.MainForm.Show;
    Borland.Delphi.Windows.SetForegroundWindow(TInit.InitInstance.MainForm.Handle);
  end;
  Result := nil;
end;

{ TRunningClients }
constructor TRunningClients.Create;
begin
  inherited;
  FItems := TStringList.Create;
  FItems.Sorted := True;
end;

destructor TRunningClients.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

procedure TRunningClients.Clear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    FItems.Objects[I].Free;
  FItems.Clear;
end;

function TRunningClients.Find(const ID: string): TRunningClient;
var
  I: Integer;
begin
  I := FItems.IndexOf(ID);
  if I >= 0 then
  begin
    Result := FItems.Objects[I] as TRunningClient;
    if DateUtils.MilliSecondsBetween(SysUtils.Now, Result.LastActive) > Result.Timeout then
    begin
      FItems.Objects[I].Free;
      FItems.Delete(I);
      Result := nil;
    end;
  end
  else
    Result := nil;
end;

procedure TRunningClients.Add(const ID: string; Timeout: Integer);
var
  C: TRunningClient;
begin
  if Find(ID) <> nil then
    raise Exception.Create(ID + '已经注册');
  C := TRunningClient.Create;
  try
    C.LastActive := SysUtils.Now;
    C.Timeout := Timeout;
    FItems.AddObject(ID, C);
  except
    C.Free;
    raise;
  end;
end;

procedure TRunningClients.Remove(const ID: string);
var
  I: Integer;
begin
  I := FItems.IndexOf(ID);
  if I >= 0 then
  begin
    FItems.Objects[I].Free;
    FItems.Delete(I);
  end;
end;

procedure TRunningClients.Touch(const ID: string);
var
  C: TRunningClient;
begin
  C := Find(ID);
  if C = nil then
    raise Exception.Create(ID + '并没有注册');
  C.LastActive := SysUtils.Now;
end;

procedure TRunningClients.TouchOrAdd(const ID: string; Timeout: Integer);
var
  C: TRunningClient;
begin
  C := Find(ID);
  if C = nil then
    Add(ID, Timeout)
  else
    Touch(ID);
end;

{ TRegisgerClient }
function TRegisgerClient.GetName: string;
begin
  Result := 'RegisterClient';
end;

function TRegisgerClient.Invoke(var Params: array of object): object;
begin
  FRegister.Add(Params[0] as System.String, Integer(Params[1]));
end;

{ TUnregisgerClient }
function TUnregisgerClient.GetName: string;
begin
  Result := 'UnregisterClient';
end;

function TUnregisgerClient.Invoke(var Params: array of object): object;
begin
  FRegister.Remove(Params[0] as System.String);
end;

{ TTouchClient }
function TTouchClient.GetName: string;
begin
  Result := 'TouchClient';
end;

function TTouchClient.Invoke(var Params: array of object): object;
begin
  FRegister.TouchOrAdd(Params[0] as System.String, Integer(Params[1]));
end;

{ TGetOperatorID }
function TGetOperatorID.GetName: string;
begin
  Result := 'GetOperatorID';
end;

function TGetOperatorID.Invoke(var Params: array of object): object;
begin
  if TSystemCore.Operator = nil then
    Result := ''
  else
    Result := TSystemCore.Operator.ID;
end;

{ TGetServerURL }
function TGetServerURL.GetName: string;
begin
  Result := 'GetServerURL';
end;

function TGetServerURL.Invoke(var Params: array of object): object;
begin
  Result := SysSrv.SysService.ServerURL;
end;

{ TRunning }
function TRunning.GetName: string;
begin
  Result := 'Running';
end;

function TRunning.Invoke(var Params: array of object): object;
begin
  Result := Running;
end;

  { TGetClientAccount }
function TGetClientAccount.GetName: string;
begin
  Result := 'GetClientAccount';
end;

function TGetClientAccount.Invoke(var Params: array of object): object;
begin
  Result := BizSys.BizSystem.ClientAccount;
end;

{ TCreateFunc }
function TCreateFunc.GetName: string;
begin
  Result := 'CreateFunc';
end;

{
//原始实现
function TCreateFunc.Invoke(var Params: array of object): object;
var
  FuncItem: TOperatorFuncItem;
begin
  if (TSystemCore.Operator = nil) and not TInit.InternalLogon then
    raise Exception.Create('无法登录系统');

  FuncItem := TSystemCore.Operator.FuncItems.Get(System.String(Params[0]));

  if FuncItem.PositionCount = 0 then
  begin
    Result := TSystemCore.FuncManager.CreateFunc(TSystemCore.Operator.Context,
      FuncItem.FuncURL.URL);
    Exit;
  end;

  if FuncItem.PositionCount = 1 then
  begin
    Result := TSystemCore.FuncManager.CreateFunc(FuncItem.Positions[0].Context,
      FuncItem.FuncURL.URL);
    Exit;
  end;

  // to do 应该让用户选择岗位
  Result := TSystemCore.FuncManager.CreateFunc(FuncItem.Positions[0].Context,
      FuncItem.FuncURL.URL);
end;
}

{
//无法支持相同网页放置多个OCX
function TCreateFunc.Invoke(var Params: array of object): object;
const
  cInitFunc = 'Biz:\YYCSKJ\QSGN.Func';
  cUserNameIndex = 'UserName';
  cPasswordIndex = 'Password';
  cPositionIDIndex = 'Position';
var
  FuncItem: TOperatorFuncItem;
  lFunc: TFunc;
  lFuncURL, lUserName, lPassword, lPositionID: string;
  lOper: TOperator;
  lStrings: TStrings;
  I: integer;
begin
  if Params.Length >1 then
  begin
    lFuncURL := System.String(Params[0]);
    lStrings := TStringList.Create;
    try
      lStrings.Delimiter := ';';
      lStrings.DelimitedText := System.String(Params[1]);
      lUserName := lStrings.Values[cUserNameIndex];
      lPassword := lStrings.Values[cPasswordIndex];
      lPositionID := lStrings.Values[cPositionIDIndex];
    finally
      lStrings.Free;
    end;
    if TSystemCore.Logon(lUserName, lPassword) then
      lOper := TSystemCore.Operator
    else
      raise Exception.Create('无法登录系统');
    end;
  end else
    raise Exception.Create('参数不够！');

  FuncItem := TSystemCore.Operator.FuncItems.Get(cInitFunc);

  case FuncItem.PositionCount of
    0: lFunc := TSystemCore.FuncManager.CreateFunc(TSystemCore.Operator.Context,
      FuncItem.FuncURL.URL);
    1: lFunc := TSystemCore.FuncManager.CreateFunc(FuncItem.Positions[0].Context,
      FuncItem.FuncURL.URL);
  else
    for I := 0 to FuncItem.PositionCount - 1 do
      if sysUtils.SameText(FuncItem.Positions[I].PositionID, lPositionID) then
      begin
        lFunc := TSystemCore.FuncManager.CreateFunc(FuncItem.Positions[I].Context,
          FuncItem.FuncURL.URL);
        break;
      end;
  end;

  //Assert(lFunc <> nil, '无法创建TFunc');
  if lFunc = nil then
    raise Exception.Create('无法创建TFunc');
  QSGN.TQSGN(lFunc).RunFuncURL := lFuncURL;
  QSGN.TQSGN(lFunc).UserName := lUserName;
  QSGN.TQSGN(lFunc).Password := lPassword;
  QSGN.TQSGN(lFunc).PositionID := lPositionID;
  QSGN.TQSGN(lFunc).CurOperator := TSystemCore.Operator;
  Result := lFunc;
end;

}

(*
//完全正确，使用起始功能的函数
function TCreateFunc.Invoke(var Params: array of object): object;
const
  cInitFunc = 'Biz:\YYCSKJ\QSGN.Func';
  cUserNameIndex = 'UserName';
  cPasswordIndex = 'Password';
  cPositionIDIndex = 'Position';
var
  FuncItem: TOperatorFuncItem;
  lFunc: TFunc;
  lFuncURL, lUserName, lPassword, lPositionID: string;
  lStrings: TStrings;
  I: integer;
begin

  if Params.Length >1 then
  begin
    lFuncURL := System.String(Params[0]);
    lStrings := TStringList.Create;
    try
      lStrings.Delimiter := ';';
      lStrings.DelimitedText := System.String(Params[1]);
      lUserName := lStrings.Values[cUserNameIndex];
      lPassword := lStrings.Values[cPasswordIndex];
      lPositionID := lStrings.Values[cPositionIDIndex];
    finally
      lStrings.Free;
    end;
  end else
    raise Exception.Create('参数不够！');

  lFunc := TSystemCore.FuncManager.CreateFunc(BizSys.GlobalContext, cInitFunc);
  //Assert(lFunc <> nil, '无法创建TFunc');
  if lFunc = nil then
    raise Exception.Create('无法创建TFunc');
  QSGN.TQSGN(lFunc).RunFuncURL := lFuncURL;
  QSGN.TQSGN(lFunc).UserName := lUserName;
  QSGN.TQSGN(lFunc).Password := lPassword;
  QSGN.TQSGN(lFunc).PositionID := lPositionID;
  QSGN.TQSGN(lFunc).CurOperator := TSystemCore.Operator;
  Result := lFunc;
end;
*)
function TCreateFunc.Invoke(var Params: array of object): object;
const
  cInitFunc = 'Biz:\YYCSKJ\TIEFuncContainer.Func';
  cUserNameIndex = 'UserName';
  cPasswordIndex = 'Password';
  cPositionIDIndex = 'Position';
var
  FuncItem: TOperatorFuncItem;
  lFunc: TFunc;
  lFuncURL, lUserName, lPassword, lPositionID: string;
  lStrings: TStrings;
  I: integer;
begin

  if Params.Length >1 then
  begin
    lFuncURL := System.String(Params[0]);
    lStrings := TStringList.Create;
    try
      lStrings.Delimiter := ';';
      lStrings.DelimitedText := System.String(Params[1]);
      lUserName := lStrings.Values[cUserNameIndex];
      lPassword := lStrings.Values[cPasswordIndex];
      lPositionID := lStrings.Values[cPositionIDIndex];
    finally
      lStrings.Free;
    end;
  end else
    raise Exception.Create('参数不够！');

  lFunc := TSystemCore.FuncManager.CreateFunc(BizSys.GlobalContext, cInitFunc);
  //Assert(lFunc <> nil, '无法创建TFunc');
  if lFunc = nil then
    raise Exception.Create('无法创建TFunc');
  TIEFuncContainer.TTIEFuncContainer(lFunc).RunFuncURL := lFuncURL;
  TIEFuncContainer.TTIEFuncContainer(lFunc).UserName := lUserName;
  TIEFuncContainer.TTIEFuncContainer(lFunc).Password := lPassword;
  TIEFuncContainer.TTIEFuncContainer(lFunc).PositionID := lPositionID;
  Result := lFunc;
end;


end.

ufida

unit MainForm;

interface

uses
  Business.System, Business.Forms, Business.Model,
  SystemCore, SystemUtils, Business.Model.Org, Business.Model.Flow;

type
  TMainForm = class(TForm)
    FuncBroker1: TFuncBroker;
    procedure BizFormShow(Sender: TObject);
  private
    FFuncURL: string;
    FUserName, FPassword, FPositionID: string;
    FOperator: TOperator;
    function CreateFuncByFuncItem(AContext: TContext; AFuncItem: TOperatorFuncItem): TFunc;
    procedure RunFuncFromHtml;

    procedure CheckLogon(ALogon: Boolean);
    function Logon(const ALogonID, APassword: string): Boolean;
    procedure FuncDestroy(Sender: TObject);
  public
    CurFunc: TFunc;
  end;

implementation
var
  FLControls: TList = nil;

function FlowControlList: TList;
begin
  if not Assigned(FLControls) then
    FLControls := TList.Create;
  Result := FLControls;
end;

procedure FreeControlList;
var
  i: Integer;
begin
  if Assigned(FLControls) then
    for i:=0 to FLControls.Count-1 do
      FLControls.Free;
  FLControls.Clear;
  FreeAndNil(FLControls);
end;

function TMainForm.CreateFuncByFuncItem(AContext: TContext; AFuncItem: TOperatorFuncItem): TFunc;
var
  lPosition: TOperatorPosition;
  lProc: TProc;
  lEntryID: string;
  lFlowControl: TFlowControl;
  lOrgURL: TOrgURL;
begin
  if not AFuncItem.IsProcEntry then
    Result := TSystemCore.FuncManager.CreateFunc(AContext, AFuncItem.FuncURL.URL)
  else
  begin
    lPosition := TContextUtils.GetOperatorPosition(AContext);

    lProc := TSystemCore.GetBizObject(BizSys.GlobalContext, AFuncItem.ProcURL.URL) as TProc;
    lFlowControl := TFlowControl.Create(AContext);
    try
      lEntryID := lProc.GetEntryUnitByFuncURL(AFuncItem.FuncURL).ID;

      // 不能使用AFuncItem的OrgURL,因为它不一定是人员成员
      lOrgURL := TOrgURL.Create(lPosition.PositionMember.Parent.ID,
        lPosition.PositionMember.ID, lPosition.PersonMember.ID);
      try
        lFlowControl.ExecuteFlow(AFuncItem.ProcURL, lEntryID, lOrgURL);
      finally
        lOrgURL.Free;
      end;

      Result := TSystemCore.FuncManager.CreateFunc(lFlowControl.Context, AFuncItem.FuncURL.URL);
      try
        lFlowControl.Func := Result;
      except
        Result.Free;
        raise;
      end;
    except
      lFlowControl.Free;
    end;
    FlowControlList.Add(lFlowControl);
  end;
end;

procedure TMainForm.RunFuncFromHtml;
var
  I: integer;
  FuncItem: TOperatorFuncItem;
  lFunc: TFunc;
  lBrowseDialog: TSelectPositionDialog;
  selposition:TOperatorPosition;
  selpositionid: string;

begin
  selpositionid:='';
  if FOperator = nil then
    raise Exception.Create('FOperator = nil');

  FuncItem := FOperator.FuncItems.Get(FFuncURL);
  case FuncItem.PositionCount of
    0: lFunc := CreateFuncByFuncItem(Context, FuncItem);
    1:
    begin
    lFunc := CreateFuncByFuncItem(FuncItem.Positions[0].Context, FuncItem);
    FPositionID:=FuncItem.Positions[0].PositionID;
    end
  else
    //同一人员同一功能多个岗位需选择岗位
    lBrowseDialog:=TSelectPositionDialog.Create(nil);
//Operator1 := Opr.Logon('blning','ufida@x3' );
  try
    lBrowseDialog.load(FuncItem);

    if  lBrowseDialog.ShowModal = Business.Forms.Controls.mrOK  then
    begin
      selposition:= lBrowseDialog.Selected;
      selpositionid :=selposition.PositionID;
    end;
  finally
    lBrowseDialog.Free;
    //jsdialogs.ShowMsg(selpositionid,'');
  end;

    //end
    for I := 0 to FuncItem.PositionCount - 1 do
    begin

      //if SysUtils.SameText(FuncItem.Positions[I].PositionID, TTIEFuncContainer(FuncBroker1.Func).PositionID) then
      if SysUtils.SameText(FuncItem.Positions[I].PositionID,selpositionid ) then
      begin
        //lFunc := CreateFuncByFuncItem(FuncItem.Positions[0].Context, FuncItem);
        lFunc := CreateFuncByFuncItem(FuncItem.Positions.Context, FuncItem);
        break;
      end;
    end;
    FPositionID:=selpositionid;
  end;
  if lFunc = nil then
    raise Exception.Create('没有合适的岗位运行功能！');

  CurFunc := lFunc;
  TSystemCore.FuncManager.RunFunc(CurFunc, '', 'Run2-' + sysUtils.FloatToStr(sysUtils.Now));
  CurFunc.MainForm.ManualDock(Self, nil, TAlign.alClient);
  CurFunc.OnDestroy := FuncDestroy;
end;

procedure TMainForm.CheckLogon(ALogon: Boolean);
const
  Msg01 = '并没有登录，请登录后再试';
  Msg02 = '已经登录了，请注销后再试';
begin
  if (FOperator = nil) = ALogon then
    if FOperator = nil then
      raise Exception.Create(Msg01)
    else
      raise Exception.Create(Msg02);
end;

function TMainForm.Logon(const ALogonID, APassword: string): Boolean;
const
  ErrMsg = '用户%s不能登陆，因为没有分配岗位或者用户%s已经被其他用户代理.';
var
  lOperator: TOperator;
begin
  CheckLogon(False);
  lOperator := Opr.Logon(ALogonID, APassword);
  Result := lOperator <> nil;
  if Result then
  begin
    if not Opr.IsSystemManager(ALogonID) and
      (lOperator.PositionCount = 0) then
    begin
      Opr.Logoff(lOperator);
      raise Exception.CreateFmt(ErrMsg, [ALogonID, ALogonID]);
    end;
    FOperator := lOperator;
  end;
end;

procedure TMainForm.FuncDestroy(Sender: TObject);
var
  lFunc: TFunc;
  I: integer;
begin
  for I := 0 to FOperator.PositionCount - 1 do
    if SysUtils.SameText(FOperator.Positions[I].PositionID, FPositionID) then
    begin
      lFunc := TSystemCore.FuncManager.RunFunc(FOperator.Positions[I].Context,  '', 'Biz:\SYSTEM\TasksFunc.Func', '', nil , False);
      break;
    end;
  if lFunc = nil then
    raise Exception.Create('没有合适的岗位运行任务中心的功能！');
  lFunc.MainForm.ManualDock(Self, nil, TAlign.alClient);
end;

procedure TMainForm.BizFormShow(Sender: TObject);
begin
  if FuncBroker1.Func <> nil then
  begin
    FFuncURL := TTIEFuncContainer(FuncBroker1.Func).RunFuncURL;
    FUserName := TTIEFuncContainer(FuncBroker1.Func).UserName;
    FPassword := TTIEFuncContainer(FuncBroker1.Func).Password;
    FPositionID := TTIEFuncContainer(FuncBroker1.Func).PositionID;
    Logon(FUserName, FPassword);
    if FOperator <> nil then
      RunFuncFromHtml;
  end;
end;

end.

ufida

第一部分是系统初始化功能代码，你们修改过。
第二部分是配合该上面的TIEFuncContainer主窗体代码，此部分由于独立空间应该没有被覆盖

jiahaiminghr

楼主，能否提供系统初始化功能和TIEFuncContainer功能的资源，最好是直接通过Studio中的资源管理器拷贝出来。
另外，还需要你提供调用ocx 的相关jsp脚本

ufida

<%@ page contentType="text/html; charset=GBK" %>
<%@ page import="com.justep.loader.LibContext"%>
<%@ page import="java.lang.reflect.Method" %>

<%
String usernametest = "",usernametestSub ="";
int pos_1 = 0,pos_2 = 0;
/**usernametest=request.getRemoteUser();**/
usernametest="domain\\liuyu";
pos_1=usernametest.indexOf("\\");
pos_2=usernametest.length();
out.print  (usernametest) ;
if(pos_1 >0)
{
usernametestSub=usernametest.substring(pos_1+1,pos_2);
}
out.print  ("SUB:"+usernametestSub) ;
%>
<%
Class pclass = LibContext.getInstance().getLoader().loadClass("com.justep.web.SysServerProvider");
Object pobj = pclass.newInstance();
Method getBXClassIDMethod = pclass.getMethod("getBXClassID",new Class[]{});
Method getBXCodeMethod = pclass.getMethod("getBXCodebase",new Class[]{});
Method getSysServerURLMethod = pclass.getMethod("getSysServerURL",new Class[]{});

String classId = (String)getBXClassIDMethod.invoke(pobj,new Object[]{});
String codeBase = (String)getBXCodeMethod.invoke(pobj,new Object[]{});
String url = (String)getSysServerURLMethod.invoke(pobj,new Object[]{});
%>
<HTML>
<HEAD>
<title>>X3 协同管理系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</HEAD>

<BODY leftmargin="0" topmargin="0" scroll="no">

<OBJECT  id = "X3X"
          classid="<%= classId%>"
          codebase="<%= codeBase%>"
          width="100%"
          height="100%"
          align=center
          hspace=0
          vspace=0
>
</OBJECT>

<object id="WebBrowser" width=0 height=0 classid="CLSID:8856F961-340A-11D0-A96B-00C04FD705A2">
</object>

<script ID="BusinessCloseEventHandler" language="javascript" FOR="X3X" EVENT="OnTerminate">
  WebBrowser.ExecWB(45,1); // close window
</script>

<script type="text/javascript">
var getusername,UrlStr,LogonStr;
     getusername="<%= usernametestSub%>";       
         //UrlStr=window.location.search;
         UrlStr=document.URL;
     LogonStr="UserName="+getusername+"assword=;"+"osition=";
         //LogonStr="UserName=lqb"+"assword=;"+"osition=";
         alert (UrlStr);
         alert (getusername);       
         alert (LogonStr);

  function BeforeClose()
  {
    if(!X3X.TerminateQuery())
    {
      event.returnValue = "";
    }
  }

String.prototype.getQuery = function(name)
    {
　 　var reg = new RegExp("(^|&)"+ name +"=([^&]*)(&|$)");
　 　var r = this.substr(this.indexOf("\?")+1).match(reg);
　　 if (r!=null) return unescape(r[2]); return null;
    }

  alert(UrlStr.getQuery("FuncUrl"));

  //document.title = X3X.DisplayName;
  X3X.ServerURL = "<%= url%>"
  //X3X.ShowSplash();
  X3X.UpdateVersion();
  X3X.Init();
  //X3X.CloseSplash();
  //X3X.Run("", "", "", "");
  X3X.Run2(UrlStr.getQuery("FuncUrl"),LogonStr);
  //document.body.onbeforeunload=BeforeClose;
  //document.title = X3X.DisplayName;
</script>

</BODY>
</HTML>

ufida

能看出问题所在吗？还需要什末资料？
另帮忙试一下，密码加密是否后是否有问题？

jiahaiminghr

楼主，请稍候，正在测试。

WZH

楼主，我这里用你们的版本恢复了环境，但是没有出现错误。
不过我没有使用你的jsp文件。这是我的jsp文件：
<%@ page contentType="text/html; charset=GBK" %>
<%@ page import="com.justep.loader.LibContext"%>
<%@ page import="java.lang.reflect.Method" %>
<%
Class pclass = LibContext.getInstance().getLoader().loadClass("com.justep.web.SysServerProvider");
Object pobj = pclass.newInstance();
Method getBXClassIDMethod = pclass.getMethod("getBXClassID",new Class[]{});
Method getBXCodeMethod = pclass.getMethod("getBXCodebase",new Class[]{});
Method getSysServerURLMethod = pclass.getMethod("getSysServerURL",new Class[]{});

String classId = (String)getBXClassIDMethod.invoke(pobj,new Object[]{});
String codeBase = (String)getBXCodeMethod.invoke(pobj,new Object[]{});
String url = (String)getSysServerURLMethod.invoke(pobj,new Object[]{});
%>
<HTML>
<HEAD>
<title>>X3 协同管理系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</HEAD>

<BODY leftmargin="0" topmargin="0" scroll="no">

<OBJECT  id = "X3X"
          classid="<%= classId%>"
          codebase="<%= codeBase%>"
          width="100%"
          height="100%"
          align=center
          hspace=0
          vspace=0
>
</OBJECT>

<object id="WebBrowser" width=0 height=0 classid="CLSID:8856F961-340A-11D0-A96B-00C04FD705A2">
</object>

<script ID="BusinessCloseEventHandler" language="javascript" FOR="X3X" EVENT="OnTerminate">
  WebBrowser.ExecWB(45,1); // close window
</script>

<script type="text/javascript">
  function BeforeClose()
  {
    if(!X3X.TerminateQuery())
    {
      event.returnValue = "";
    }
  }

  document.title = X3X.DisplayName;
  X3X.ServerURL = "<%= url%>"
  //X3X.ShowSplash();
  X3X.UpdateVersion();
  X3X.Init();
  //X3X.CloseSplash();
  X3X.Run2("Biz:\\SYSTEM\\TasksFunc.Func", "UserName=zsassword=osition=");
  document.body.onbeforeunload=BeforeClose;
  //document.title = X3X.DisplayName;
</script>

</BODY>
</HTML>

请确认：
1 你使用我的jsp调用“工作任务”功能，看有没有错误。
2 如果同样出错，请直接登录系统，运行“工作任务”功能，看有没有错误。