dws2weblibmodule.pas

script language

    property OnEvalCookie: TOnISAPIEvalEvent read FOnEvalCookie write
      FOnEvalCookie;
    property OnEvalFormVar: TOnISAPIEvalEvent read FOnEvalFormVar write
      FOnEvalFormVar;
    property OnEvalDWS: TOnISAPIEvalEvent read FOnEvalDWS write FOnEvalDWS;
    property OnEvalRequest: TOnISAPIEvalEvent read FOnEvalRequest write
      FOnEvalRequest;
    property OnEvalResponse: TOnISAPIEvalEvent read FOnEvalResponse write
      FOnEvalResponse;
    property OnEvalScriptDoc: TOnISAPIEvalEvent read FOnEvalScriptDoc write
      FOnEvalScriptDoc;
  end;

procedure Register;

implementation

{$R *.dfm}

procedure Register;
begin
  RegisterComponents('DWS2', [Tdws2WebLib]);
end;

{ TDataModule2 }

constructor Tdws2WebLib.create(AOwner: TComponent);
begin
  inherited;
  FDumpPatternOpen := '<!--%%';
  FDumpPatternClose := '%%-->';
  FCustCommand := 'action';
  FHttpInfo := THttpInfo.Create;
end;

destructor Tdws2WebLib.destroy;
begin
  if not (FHttpInfo = nil) then
    FHttpInfo.Free;
  inherited;
end;

procedure Tdws2WebLib.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FScript) then
    SetScript(nil);
  if (Operation = opRemove) and (AComponent = FSessionManager) then
    SetSessionManager(nil);
  inherited;
end;

procedure Tdws2WebLib.SetScript(const Value: TDelphiWebScriptII);
var
  x: Integer;
begin
  if Assigned(FScript) then
    FScript.RemoveFreeNotification(Self);
  FScript := Value;
  if Assigned(FScript) then
    FScript.FreeNotification(Self);
  if not (csDesigning in ComponentState) then
    for x := 0 to ComponentCount - 1 do
      if Components[x] is Tdws2Unit then
        Tdws2Unit(Components[x]).Script := Value;
  //  customWebUnit.Script := FScript;
end;

procedure Tdws2WebLib.SetSessionManager(const Value: TComponent);
begin
  if Assigned(Value) then
  begin
    if not Supports(Value, ISessionManager, FSessionManagerIntf) then
      raise
        Exception.CreateFmt('Component "%s" doesn''t support the ISessionManager interface', [Value.Name]);
  end
  else
    FSessionManagerIntf := nil;
  if Assigned(FSessionManager) then
    FSessionManager.RemoveFreeNotification(Self);
  FSessionManager := Value;
  if Assigned(FSessionManager) then
    FSessionManager.FreeNotification(Self);
end;

// ************************** Request Initialization *************************
{ XXX ************************** }

procedure Tdws2WebLib.InitISAPIsession(Request: TWebRequest; Response:
  TWebResponse);
var
  filename: ShortString; // speed this up
  treatspecial: char;
  cstate: Integer;
begin
  if Assigned(BeforeInitISAPISession) then
  begin
    BeforeInitISAPISession(self);
  end;

  treatspecial := #0;
  filename := changefileext(extractfilename(HttpInfo.ScriptDocFileName), '');
  cstate := length(filename) - 1;
  if (cstate >= 1) and (filename[cstate] = DWS_Spacer) then
    treatspecial := uppercase(filename[cstate])[1];

  with FHttpInfo do
  begin
    HttpRequest := TWebRequest(Request);
    HttpResponse := TWebResponse(Response);

    if Assigned(SessionManager) then
    begin
      ManageUserSession(FSessionManagerIntf);

      if (FSessionManagerIntf.LocateUserSession(FHttpInfo) <> dssOk) and
        (treatspecial <> #0) then
        raise ENeedSession.Create(M_NeedValidSession);

      if assigned(UserSession) then
        cstate := UserSession.ClientState
      else
        cstate := -9999;

      case treatspecial of
        //DWS_SessS: if cstate < 0 then
        //    raise ENeedSession.Create(M_NeedValidSession);
        DWS_LogS: if cstate < 9 then
            raise ENeedLogin.Create(M_NeedLogin);
        DWS_MaxS: if cstate < 10 then
            raise ENeedMemberLogin.Create(M_NeedToBeMember);
      end;
    end
    else if treatspecial <> #0 then
      raise ENeedSession.Create(M_NotAllowedAndLogged);

    if (Length(CustomCommand) > 0) and Assigned(OnCustomCommand) then
      // e.g. form input action=login
      if (Params.IndexOfName(CustomCommand) >= 0) then
      begin
        OnCustomCommand(self, HttpInfo,
          uppercase(Params.Values[CustomCommand]));
      end;
  end;

  if Assigned(AfterInitISAPISession) then
  begin
    AfterInitISAPISession(self);
  end;
end;

{ XXX ************************** }

procedure Tdws2WebLib.CloseIsapiSession;
begin
  if Assigned(BeforeCloseISAPISession) then
  begin
    BeforeCloseISAPISession(self);
  end;

  {  if Assigned(SessionManager) then
    begin
      ManageUserSession(FSessionManagerIntf);
    end;}

  if Assigned(AfterCloseISAPISession) then
  begin
    AfterCloseISAPISession(self);
  end;
end;

function Tdws2WebLib.ManageUserSession(SessionManager: ISessionManager): string;
var
  ustate: TSessionTrackingState;
begin
  result := '';
  if Assigned(SessionManager) then
  begin
    try
      ustate := SessionManager.LocateUserSession(FHttpInfo);
      if ustate = dssNoSession then
        result := 'NOP';
    except
      on e: Exception do
        result := e.ClassName + ' ' + e.Message;
    end;
  end;
end;

// ************************** Class-Methods *************************

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsParamEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.Params.Values[Info['Name']];
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsParamCountEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.Params.Count;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsParamNameEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.Params.Names[Integer(Info['Index'])];
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsParamValueEval(
  Info: TProgramInfo; ExtObject: TObject);
var
  name: string;
begin
  name :=
    FHttpInfo.Params.Names[Integer(Info['Index'])];
  Info['Result'] :=
    FHttpInfo.Params.Values[name];
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsAuthorizationEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Authorization;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsContentEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Content;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsContentLengthEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.ContentLength;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsContentTypeEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.ContentType;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsDateEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Date;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsFromEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.From;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsHostEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Host;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsPathInfoEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.PathInfo;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsRefererEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Referer;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsRemoteAddrEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.RemoteAddr;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsRemoteHostEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.RemoteHost;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsScriptNameEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.ScriptName;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsTitleEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Title;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsUrlEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.Url;
end;

procedure Tdws2WebLib.dws2WebUnitClassesRequestMethodsUserAgentEval(
  Info: TProgramInfo; ExtObject: TObject);
begin
  Info['Result'] :=
    FHttpInfo.HttpRequest.UserAgent;
end;

procedure Tdws2WebLib.dws2WebUnitClassesResponseMethodsSetAllowEval(