Changeset 132 for trunk/Packages


Ignore:
Timestamp:
Mar 18, 2022, 3:47:27 PM (3 years ago)
Author:
chronos
Message:
  • Modified: Code cleanup.
Location:
trunk/Packages
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CoolWeb/CoolWeb.lpk

    r114 r132  
    11<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <Name Value="CoolWeb"/>
    55    <Type Value="RunAndDesignTime"/>
    … …  
    1111        <IncludeFiles Value="WebServer"/>
    1212        <OtherUnitFiles Value="WebServer;Persistence;Network;Modules;Common;/usr/lib/mysql/;/usr/lib64/mysql/"/>
    13         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     13        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1414      </SearchPaths>
    1515      <Parsing>
    1616        <SyntaxOptions>
    1717          <SyntaxMode Value="Delphi"/>
     18          <CStyleOperator Value="False"/>
     19          <AllowLabel Value="False"/>
     20          <CPPInline Value="False"/>
    1821        </SyntaxOptions>
    1922      </Parsing>
     23      <CodeGeneration>
     24        <Optimizations>
     25          <OptimizationLevel Value="0"/>
     26        </Optimizations>
     27      </CodeGeneration>
     28      <Linking>
     29        <Debugging>
     30          <GenerateDebugInfo Value="False"/>
     31        </Debugging>
     32      </Linking>
     33      <Other>
     34        <CompilerMessages>
     35          <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/>
     36        </CompilerMessages>
     37      </Other>
    2038    </CompilerOptions>
    2139    <Description Value="Unit set for generating CGI or server web application."/>
    … …  
    104122      </Item18>
    105123    </Files>
     124    <CompatibilityMode Value="True"/>
    106125    <RequiredPkgs Count="8">
    107126      <Item1>

  • trunk/Packages/CoolWeb/LazIDEReg.pas

    r84 r132  
    3939  CGIAppDescriptor: TCGIApplicationDescriptor;
    4040
     41procedure Register;
    4142
    42 procedure Register;
    4343
    4444implementation
    … …  
    100100function TCGIApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
    101101var
    102   le: string;
    103102  NewSource: TStringList;
    104103  MainFile: TLazProjectFile;

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

    r114 r132  
    267267  Result := False;
    268268  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
     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
    275284        Result := True;
    276285        Exit;
    277286      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;
     287    end;
     288  finally
     289    DbRows2.Free;
     290  end;
    291291end;
    292292

  • trunk/Packages/CoolWeb/WebServer/UWebApp.pas

    r108 r132  
    66
    77uses
    8   Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
    9   UHTTPServer, Forms, FileUtil;
     8  Classes, SysUtils, UWebPage, UHTTPSessionFile,
     9  UHTTPServer, Forms, FileUtil, fgl;
    1010
    1111type
    … …  
    2222  { TPageList }
    2323
    24   TPageList = class(TListObject)
     24  TPageList = class(TFPGObjectList<TRegistredPage>)
    2525    RootDir: string;
    2626    function FindByPage(Page: TWebPage): TRegistredPage;
    … …  
    2929    procedure UnregisterPage(Page: TWebPage);
    3030    function ProducePage(HandlerData: THTTPHandlerData): Boolean;
    31     constructor Create; override;
     31    constructor Create(FreeObjects: Boolean = True);
    3232  end;
    3333
    … …  
    6464  UHTTPServerCGI, UHTTPServerTCP, UHTTPServerTurboPower;
    6565
    66 
    6766procedure Register;
    6867begin
    … …  
    7776end;
    7877
    79 
    8078{ TPageList }
    8179
    … …  
    8583begin
    8684  I := 0;
    87   while (I < Count) and (TRegistredPage(Items[I]).Page <> Page) do Inc(I);
    88   if I < Count then Result := TRegistredPage(Items[I])
     85  while (I < Count) and (Items[I].Page <> Page) do Inc(I);
     86  if I < Count then Result := Items[I]
    8987    else Result := nil;
    9088end;
    … …  
    9593begin
    9694  I := 0;
    97   while (I < Count) and (TRegistredPage(Items[I]).Name <> Name) do Inc(I);
    98   if I < Count then Result := TRegistredPage(Items[I])
     95  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
     96  if I < Count then Result := Items[I]
    9997    else Result := nil;
    10098end;
    … …  
    132130var
    133131  NewPage: TRegistredPage;
    134   Instance: TWebPage;
    135 begin
    136   NewPage := TRegistredPage(AddNew(TRegistredPage.Create));
     132begin
     133  NewPage := TRegistredPage.Create;
    137134//  NewPage.Page := PageClass.Create(Self);
    138135  NewPage.Page := Page;
    139136  NewPage.Name := Path;
     137  Add(NewPage);
    140138end;
    141139
    … …  
    166164constructor TPageList.Create;
    167165begin
    168   inherited Create;
    169   OwnsObjects := False;
     166  inherited;
     167  FreeObjects := False;
    170168end;
    171169
    … …  
    212210constructor TWebApp.Create(AOwner: TComponent);
    213211begin
    214   inherited Create(AOwner);
     212  inherited;
    215213  HTTPServer := THTTPServerCGI.Create(nil);
    216214  HTTPServer.OnRequest := HTTPServerRequest;
    … …  
    219217destructor TWebApp.Destroy;
    220218begin
    221   HTTPServer.Free;
    222   inherited Destroy;
     219  FreeAndNil(HTTPServer);
     220  inherited;
    223221end;
    224222

  • trunk/Packages/ModularSystem/ModularSystem.lpk

    r105 r132  
    1 <?xml version="1.0"?>
     1<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <PathDelim Value="\"/>
    55    <Name Value="ModularSystem"/>
     6    <Type Value="RunAndDesignTime"/>
    67    <Author Value="Chronos (robie@centrum.cz)"/>
    78    <CompilerOptions>
    … …  
    910      <PathDelim Value="\"/>
    1011      <SearchPaths>
    11         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     12        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    1213      </SearchPaths>
     14      <Parsing>
     15        <SyntaxOptions>
     16          <CStyleOperator Value="False"/>
     17          <AllowLabel Value="False"/>
     18          <CPPInline Value="False"/>
     19        </SyntaxOptions>
     20      </Parsing>
     21      <CodeGeneration>
     22        <Optimizations>
     23          <OptimizationLevel Value="0"/>
     24        </Optimizations>
     25      </CodeGeneration>
     26      <Linking>
     27        <Debugging>
     28          <GenerateDebugInfo Value="False"/>
     29        </Debugging>
     30      </Linking>
    1331      <Other>
    1432        <CompilerMessages>
    15           <MsgFileName Value=""/>
     33          <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/>
    1634        </CompilerMessages>
    17         <CompilerPath Value="$(CompPath)"/>
    1835      </Other>
    1936    </CompilerOptions>
    … …  
    2845      </Item1>
    2946    </Files>
     47    <CompatibilityMode Value="True"/>
    3048    <i18n>
    3149      <EnableI18N Value="True"/>
    … …  
    3351      <EnableI18NForLFM Value="True"/>
    3452    </i18n>
    35     <Type Value="RunAndDesignTime"/>
    3653    <RequiredPkgs Count="2">
    3754      <Item1>

  • trunk/Packages/ModularSystem/UModularSystem.pas

    r105 r132  
    66
    77uses
    8   Classes, SysUtils, Contnrs, URegistry;
     8  Classes, SysUtils, fgl, URegistry;
    99
    1010type
    … …  
    1212
    1313  TAPI = class(TComponent)
    14 
    1514  end;
    1615
    … …  
    6665  end;
    6766
     67  TModules = class(TFPGObjectList<TModule>)
     68  end;
     69
    6870  TModuleEvent = procedure (Sender: TObject; Module: TModule) of object;
    6971
    … …  
    7678    procedure SetAPI(AValue: TAPI);
    7779  public
    78     Modules: TObjectList; // TObjectList<TModule>
     80    Modules: TModules;
    7981    function FindModuleByName(Name: string): TModule;
    8082    function ModuleRunning(Name: string): Boolean;
    … …  
    310312begin
    311313  inherited;
    312   Modules := TObjectList.Create;
     314  Modules := TModules.Create;
    313315  //Modules.OwnsObjects := False;
    314316end;
Note: See TracChangeset for help on using the changeset viewer.