dws2sessionserverclient.pas

script language

          // session not on the server - so this is an invalid session brand!!
          result.free;
          result := nil;
          exit;
        end;
        // we found a session on the server - now pull it onto the client..
        action := client.ReadLn(slf);
        result.FromString(action);
        client.ReadLn(slf); // touch
        action := client.ReadLn(slf); // action
        if result.ClientState <> dwsClientStateTOUT then
        begin
          Add(SessionBrand);
          SessionObjectList.add(Pointer(result));
          valid := true;
          DoNotTouch := False;
        end
        else
        begin
          result.free;
          result := nil;
        end;
      end; // with
    end;

    with result as TServerSession do
    begin
      // here we have got the session - now we have to update the touch-time!
      // this part is 1:1 from Hannes' WebLib
      if assigned(result) then
      begin
        LockUpdates;
        dtReqTime := now - ReqTime;
        if TchTime > 0 then
          dtTchTime := now - TchTime
        else
          dtTchTime := now - ReqTime;
        if (Result.TLastAction < dtReqTime) or (Result.TLastTouch < dtTchTime)
          then
          result.ClientState := dwsClientStateTOUT
        else
        begin
          result.TLastTouch := now;
          if getsession then
            result.TLastAction := now;
        end;
        // update session on server
        // session must be known on the server because we already created it in CreateUserSession!
        try
          UnlockUpdates; // update
        except
          on EAbort do // we are not connected to the server anymore!!
          begin
            LockUpdates;
            result.ClientState := dwsClientStateTOUT;
          end;
        end;
        if (result.ClientState = dwsClientStateTOUT) then
          result := nil;
      end; // if
    end;
  finally
    lock.Release;
  end;
end;

function TGlobalSessionServerClient.TouchUserSession(SBrand: string;
  lReqTime, lTchTime: real): TUserSession;
begin
  Result := TouchSession(SBrand);
end;

procedure InitClient;
begin
  GlobalSessionList.Free;
  GlobalSessionList := TGlobalSessionServerClient.create;
end;

procedure FinishClient;
begin
  GlobalSessionList.Free;
end;

{ TServerSession }

constructor TServerSession.create;
var
  input: string;
begin
  FUpdatesLocked := true;
  inherited Create;
  FSession := ASession;
  TLogin := 0;
  DoNotTouch := True;
  client := TIdTCPClient.Create(nil);
  client.Host := '127.0.0.1';
  client.Port := 9000;
  try
    client.Connect;
    // get expire times!
    input := client.ReadLn(slf);
    self.TchTime := strtofloat(input);
    input := client.ReadLn(slf);
    self.ReqTime := strtofloat(input);
    valid := true;
  except
    on e: exception do
    begin
{$IFDEF LOGGING}
      FSession.Lock.Acquire;
      try
        write(FSession.LogFile, 'Client Error: ' + e.message);
        flush(FSession.LogFile);
      finally
        FSession.Lock.Release;
      end;
{$ENDIF}
      raise;
    end;
  end;
end;

destructor TServerSession.destroy;
begin
  FUpdatesLocked := True;
  try
    if client.Connected then
      client.Disconnect;
    client.Free;
  except
    // eat all exceptions here...
    // what should we do anyway?
  end;
  inherited;
end;

function TServerSession.GenerateSessionBrand: string;
var
  Basis: ShortString;
  i, a, code: integer;
begin
  Basis := Format('%8.8f', [now]);
  for i := 1 to length(basis) do
  begin
    val(Basis[i], a, code);
    if code = 0 then
      Basis[i] := chr(a + 65)
    else
      Basis[i] := 'A';
  end;
  result := copy(basis, length(basis) - DWS_BRAND_LENGTH, length(basis));
end;

function TServerSession.GetClientState: Integer;
begin
  Result := inherited GetClientState;
end;

function TServerSession.GetIPaddr: string;
begin
  Result := inherited GetIPaddr;
end;

function TServerSession.GetSessionBrand: string;
begin
  Result := inherited GetSessionBrand;
end;

function TServerSession.GetTLastAction: TDateTime;
begin
  Result := inherited GetTLastAction;
end;

function TServerSession.GetTLastTouch: TDateTime;
begin
  Result := inherited GetTLastTouch;
end;

function TServerSession.GetTLogin: TDateTime;
begin
  Result := inherited GetTLogin;
end;

function TServerSession.GetTrackingState: TSessionTrackingState;
begin
  Result := inherited GetTrackingState;
end;

function TServerSession.GetUserData(const Name: string): variant;
begin
  Result := inherited GetUserData(Name);
end;

function TServerSession.LockUpdates: Boolean;
begin
  result := true;
  FUpdatesLocked := true;
end;

procedure TServerSession.reset;
begin
  inherited;
  SessionBrand := GenerateSessionBrand;
end;

procedure TServerSession.Setclient(const Value: TIdTCPClient);
begin
  Fclient := Value;
end;

procedure TServerSession.SetClientState(Value: Integer);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetDoNotTouch(const Value: Boolean);
begin
  FDoNotTouch := Value;
end;

procedure TServerSession.SetIPaddr(Value: string);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetReqTime(const Value: real);
begin
  FReqTime := Value;
end;

procedure TServerSession.SetSessionBrand(Value: string);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetTchTime(const Value: real);
begin
  FTchTime := Value;
end;

procedure TServerSession.SetTLastAction(Value: TDateTime);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetTLastTouch(Value: TDateTime);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetTLogin(Value: TDateTime);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetTrackingState(Value: TSessionTrackingState);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.SetUserData(const Name: string; Value: variant);
begin
  inherited;
  // now update the server
  if not UpdatesLocked then
    UpDateServer;
end;

procedure TServerSession.Setvalid(const Value: Boolean);
begin
  Fvalid := Value;
end;

procedure TServerSession.UnlockUpdates;
begin
  UpdateServer;
  FUpdatesLocked := false;
end;

procedure TServerSession.UpdateServer;
begin
  MySessionSync.BeginWrite;
  try
    if not client.Connected then
      raise EAbort.Create('');
    client.Write(inttostr(EditSessionData) + slf);
    client.Write(SessionBrand + slf);
    client.Write(ToString + slf);
    client.Write(datetimetostr(now) + slf);
    client.Write(datetimetostr(now) + slf); // action
    if client.ReadLn(slf) <> SessionBrand then
    begin
      ClientState := dwsClientStateTOUT;
      valid := false;
    end;
  finally
    MySessionSync.EndWrite;
  end;
end;

end.