Changeset 103 for trunk/Packages


Ignore:
Timestamp:
Oct 8, 2012, 8:48:16 AM (12 years ago)
Author:
chronos
Message:
  • Upraveno: TWebSession zobecněno pro možnost implementace více modulů s obsluhou vstupní stránky.
Location:
trunk/Packages/CoolWeb
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CoolWeb/CoolWeb.lpk

    r96 r103  
    2727    <License Value="GNU/GPL"/>
    2828    <Version Minor="3"/>
    29     <Files Count="18">
     29    <Files Count="17">
    3030      <Item1>
    3131        <Filename Value="WebServer/UHTTPServer.pas"/>
    … …  
    7474      </Item10>
    7575      <Item11>
    76         <Filename Value="Modules/UUser.pas"/>
    77         <UnitName Value="UUser"/>
     76        <Filename Value="Common/UHtmlClasses.pas"/>
     77        <UnitName Value="UHtmlClasses"/>
    7878      </Item11>
    7979      <Item12>
    80         <Filename Value="Common/UHtmlClasses.pas"/>
    81         <UnitName Value="UHtmlClasses"/>
     80        <Filename Value="Common/UMemoryStreamEx.pas"/>
     81        <UnitName Value="UMemoryStreamEx"/>
    8282      </Item12>
    8383      <Item13>
    84         <Filename Value="Common/UMemoryStreamEx.pas"/>
    85         <UnitName Value="UMemoryStreamEx"/>
     84        <Filename Value="Common/UMIMEType.pas"/>
     85        <UnitName Value="UMIMEType"/>
    8686      </Item13>
    8787      <Item14>
    88         <Filename Value="Common/UMIMEType.pas"/>
    89         <UnitName Value="UMIMEType"/>
     88        <Filename Value="Common/UXmlClasses.pas"/>
     89        <UnitName Value="UXmlClasses"/>
    9090      </Item14>
    9191      <Item15>
    92         <Filename Value="Common/UXmlClasses.pas"/>
    93         <UnitName Value="UXmlClasses"/>
    94       </Item15>
    95       <Item16>
    9692        <Filename Value="WebServer/UWebPage.pas"/>
    9793        <HasRegisterProc Value="True"/>
    9894        <UnitName Value="UWebPage"/>
    99       </Item16>
    100       <Item17>
     95      </Item15>
     96      <Item16>
    10197        <Filename Value="WebServer/UWebApp.pas"/>
    10298        <HasRegisterProc Value="True"/>
    10399        <UnitName Value="UWebApp"/>
    104       </Item17>
    105       <Item18>
     100      </Item16>
     101      <Item17>
    106102        <Filename Value="LazIDEReg.pas"/>
    107103        <HasRegisterProc Value="True"/>
    108104        <UnitName Value="LazIDEReg"/>
    109       </Item18>
     105      </Item17>
    110106    </Files>
    111107    <Type Value="RunAndDesignTime"/>

  • trunk/Packages/CoolWeb/CoolWeb.pas

    r84 r103  
    1010  UHTTPServer, UHTTPServerCGI, UHTTPServerTCP, UHTTPServerTurboPower,
    1111  UTurboPowerForm, UHTTPSessionFile, UHTTPSessionMySQL, USqlDatabase,
    12   UTCPServer, UPageList, UUser, UHtmlClasses, UMemoryStreamEx, UMIMEType,
     12  UTCPServer, UPageList, UHtmlClasses, UMemoryStreamEx, UMIMEType,
    1313  UXmlClasses, UWebPage, UWebApp, LazIDEReg, LazarusPackageIntf;
    1414

  • trunk/Packages/CoolWeb/Modules/UUser.pas

    r100 r103  
    3131    function GetIdByNamePassword(Name: string; PassWord: string): Integer;
    3232    procedure Load;
     33    function CheckPermission(Module, Operation: string; ItemType: string = '';
     34      ItemId: Integer = 0): Boolean;
     35    function CheckGroupPermission(Group, Operation: Integer): Boolean;
    3336  end;
    3437
    … …  
    215218end;
    216219
     220function TWebUser.CheckPermission(Module, Operation: string;
     221  ItemType: string = ''; ItemId: Integer = 0): Boolean;
     222var
     223  DbRows: TDbRows;
     224  DbRows2: TDbRows;
     225  OperationId: Integer;
     226begin
     227  Result := False;
     228  try
     229    DbRows := TDbRows.Create;
     230    Database.Query(DbRows, 'SELECT `Id` FROM `PermissionOperation` WHERE `Module`="' + Module + '"' +
     231    ' AND `Operation` = "' + Operation + '" AND `Item` = "' + ItemType + '"' +
     232    ' AND `ItemId` = ' + IntToStr(ItemId));
     233    if DbRows.Count > 0 then
     234    try
     235      DbRows2 := TDbRows.Create;
     236      OperationId := StrToInt(DbRows[0].Values['Id']);
     237
     238      // Check user-operation relation
     239      Database.Select(DbRows2, 'PermissionUserAssignment', 'Id',
     240        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(OperationId));
     241      if DbRows2.Count > 0 then begin
     242        Result := True;
     243        Exit;
     244      end;
     245
     246      // Check user-group relation
     247      Database.Select(DbRows2, 'PermissionUserAssignment', 'AssignedGroup',
     248        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
     249      if DbRows2.Count > 0 then begin
     250        if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), OperationId) then begin
     251          Result := True;
     252          Exit;
     253        end;
     254      end;
     255    finally
     256      DbRows2.Free;
     257    end;
     258  finally
     259    DBRows.Free;
     260  end;
     261end;
     262
     263function TWebUser.CheckGroupPermission(Group, Operation: Integer): Boolean;
     264var
     265  DbRows2: TDbRows;
     266begin
     267  Result := False;
     268  try
     269      DbRows2 := TDbRows.Create;
     270
     271      // Check group-operation relation
     272      Database.Select(DbRows2, 'PermissionGroupAssignment', 'Id',
     273        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(Operation));
     274      if DbRows2.Count > 0 then begin
     275        Result := True;
     276        Exit;
     277      end;
     278
     279      // Check group-group relation
     280      Database.Select(DbRows2, 'PermissionGroupAssignment', 'AssignedGroup',
     281        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
     282      if DbRows2.Count > 0 then begin
     283        if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), Operation) then begin
     284          Result := True;
     285          Exit;
     286        end;
     287      end;
     288    finally
     289      DbRows2.Free;
     290    end;
     291end;
     292
    217293end.
    218294

  • trunk/Packages/CoolWeb/Persistence/USqlDatabase.pas

    r99 r103  
    5252    procedure SetConnected(const AValue: Boolean);
    5353    procedure SetDatabase(const Value: string);
     54    procedure SetEncoding(AValue: string);
    5455  public
    5556    LastUsedTable: string;
    … …  
    8485    property Password: string read FPassword write FPassword;
    8586    property Port: Word read FPort write FPort;
    86     property Encoding: string read FEncoding write FEncoding;
     87    property Encoding: string read FEncoding write SetEncoding;
    8788    property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery;
    8889  end;
    … …  
    198199  try
    199200    Rows := TDbRows.Create;
    200     Query(Rows, 'SET NAMES ' + Encoding);
     201    Query(Rows, 'SET NAMES ' + FEncoding);
    201202  finally
    202203    Rows.Free;
    … …  
    452453end;
    453454
     455procedure TSqlDatabase.SetEncoding(AValue: string);
     456var
     457  Rows: TDbRows;
     458begin
     459  if FEncoding = AValue then Exit;
     460  FEncoding := AValue;
     461  if Connected then begin
     462    try
     463      Rows := TDbRows.Create;
     464      Query(Rows, 'SET NAMES ' + FEncoding);
     465    finally
     466      Rows.Free;
     467    end;
     468  end;
     469end;
     470
    454471function TSqlDatabase.EscapeString(Text: string): string;
    455472var
Note: See TracChangeset for help on using the changeset viewer.