dws2sessionlibmodule.pas

来自「script language」· PAS 代码 · 共 476 行 · 第 1/2 页

    else
      sBrand := params.Values[SessionBrandLabel];
    sH := DWS_TOUCHBRAND_PREFIX + SessionBrandLabel;

    sTouchBrand := params.Values[sH];
    if (length(sTouchBrand) = DWS_BRAND_LENGTH) then
    begin
      UserSession := GlobalSessionList.TouchUserSession(sTouchBrand, FSessionExpireTime, FSessionTouchTime);
      if not (UserSession = nil) then
        Result := dssOk;
    end
    else begin // else  length(sTouchBrand)<>DWS_BRAND_LENGTH
      if (length(sBrand) = DWS_BRAND_LENGTH) then
        UserSession := GlobalSessionList.GetUserSession(sBrand, FSessionExpireTime, FSessionTouchTime);
      if not (UserSession = nil) then
      begin // UserSession != nil
        Result := dssOk;
        if UseSessionCookie then
          with FHttpInfo.HttpResponse.Cookies.Add do
          begin
            Name := FSessionCookiePrefix + SessionBrandLabel; // set LastPassword-Cookie to active SessionBrand
            Value := UserSession.SessionBrand;
            Expires := Now + FSessionCookieExpireTime; // Cookie expires after x days
          end;
      end; // UserSession != nil
    end; // else  length(sTouchBrand)<>DWS_BRAND_LENGTH
  end;
end;

// ************************** CreateUserSession  *************************

function Tdws2SessionLib.CreateUserSession: TUserSession;
var
  ExpiredSessions: TObjectList;
  i: Integer;
begin
  ExpiredSessions := GlobalSessionList.GetExpiredSessions(
    FSessionExpireTime, FSessionTouchTime);
  with ExpiredSessions do
  begin
    for i := 0 to count - 1 do
    begin
      if Assigned(OnCloseUserSession) then
        OnCloseUserSession(Self, HttpInfo.UserSession);
    end;
    clear;
  end;

  try
    result := GlobalSessionList.CreateUserSession;
    result.IPaddr := FHttpInfo.HttpRequest.RemoteAddr;
    result.ClientState := dwsClientStateNLI;
    if Assigned(OnNewUserSession) then
    begin
      OnNewUserSession(Self, result);
    end;
    if UseSessionCookie then
      with FHttpInfo.HttpResponse.Cookies.Add do
      begin
        Name := FSessionCookiePrefix + SessionBrandLabel; // set LastPassword-Cookie to active SessionBrand
        Value := result.SessionBrand;
        Expires := Now + FSessionCookieExpireTime; // Cookie expires after x days
      end;
  except
    on e: ESessionOverflow do raise;
  end;
end;

procedure Tdws2SessionLib.CloseUserSession(USession: TUserSession);
begin
  if Assigned(OnCloseUserSession) and not (USession = nil) then
  begin
    OnCloseUserSession(Self, USession);
  end;
  USession.reset;
end;

function Tdws2SessionLib.GetSessionBrand: string;
begin
  if FHttpInfo.UserSession = nil then
  try
    FHttpInfo.UserSession := CreateUserSession;
    Result := FHttpInfo.UserSession.SessionBrand;
  except
    on ESessionOverflow do
      Result := 'overflow';
  else
    Result := '';
  end
  else
    Result := FHttpInfo.UserSession.SessionBrand;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsSetIpAddrEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if not (FHttpInfo.UserSession = nil) then
    FHttpInfo.UserSession.IPaddr := Info['Value'];
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsSetSstateEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if not (FHttpInfo.UserSession = nil) then
    FHttpInfo.UserSession.ClientState := Info['Value'];
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsSetSBrandEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if not (FHttpInfo.UserSession = nil) then
    FHttpInfo.UserSession.SessionBrand := Info['Value'];
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsSetTLoginEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if not (FHttpInfo.UserSession = nil) then
    FHttpInfo.UserSession.TLogin := Info['Value'];
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsSetTLastActionEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := ''
  else
    FHttpInfo.UserSession.TLastAction := Info['Value'];
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetActiveUsersEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := GlobalSessionList.Count;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetIpAddrEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := ''
  else
    Info['Result'] := FHttpInfo.UserSession.IPaddr;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetSstateEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := 0
  else
    Info['Result'] := FHttpInfo.UserSession.ClientState;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetSBrandEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] := GetSessionBrand;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetTLoginEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := 0
  else
    Info['Result'] := FHttpInfo.UserSession.TLogin;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetTLastActionEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := 0
  else
    Info['Result'] := FHttpInfo.UserSession.TLastAction;
end;

procedure Tdws2SessionLib.dws2UnitFunctionsTIDEval(Info: TProgramInfo);
begin
  Info['Result'] := GetSessionBrand;
end;

procedure Tdws2SessionLib.dws2UnitClassesUserMethodsGetUserdataEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  sH: string;
begin
  if FHttpInfo.UserSession = nil then
    Info['Result'] := ''
  else begin
    sH := Info['Name'];
    Info['Result'] := FHttpInfo.UserSession.UserData[sH];
  end;
end;

procedure Tdws2SessionLib.customSessionUnitClassesUserMethodsSetUserDataEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  sH: string;
begin
  if not (FHttpInfo.UserSession = nil) then
  begin
    sH := Info['Name'];
    FHttpInfo.UserSession.UserData[sH] := Info['Value'];
  end;
end;

procedure Tdws2SessionLib.customSessionUnitFunctionsActivSessionEval(
  Info: TProgramInfo);
begin
  Info['Result'] := not (FHttpInfo.UserSession = nil);
end;

procedure Tdws2SessionLib.customSessionUnitFunctionsURLEval(
  Info: TProgramInfo);
begin
  Info['Result'] := Info['AnURL'] + '?' + SessionBrandLabel + '=' + GetSessionBrand;
end;

procedure Tdws2SessionLib.SetFailedAuthMessage(const Value: TStringList);
begin
  FFailedAuthMessage := Value;
end;

destructor Tdws2SessionLib.destroy;
begin
  FFailedAuthMessage.Free;
  inherited;
end;

initialization
  GlobalSessionList := TGlobalSessionList.create;
finalization
  GlobalSessionList.free;
end.