Changeset 132 for trunk/Packages/CoolWeb

Timestamp:

Mar 18, 2022, 3:47:27 PM (3 years ago)

Author:

chronos

Message:

• Modified: Code cleanup.

Location:

trunk/Packages/CoolWeb

Files:

• CoolWeb.lpk (modified) (3 diffs)
• LazIDEReg.pas (modified) (2 diffs)
• Modules/UWebUser.pas (modified) (1 diff)
• WebServer/UWebApp.pas (modified) (11 diffs)

trunk/Packages/CoolWeb/CoolWeb.lpk

@@ -1 +1 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <Package Version="4">
+  <Package Version="5">
     <Name Value="CoolWeb"/>
     <Type Value="RunAndDesignTime"/>
@@ -11 +11 @@
         <IncludeFiles Value="WebServer"/>
         <OtherUnitFiles Value="WebServer;Persistence;Network;Modules;Common;/usr/lib/mysql/;/usr/lib64/mysql/"/>
-        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
       </SearchPaths>
       <Parsing>
         <SyntaxOptions>
           <SyntaxMode Value="Delphi"/>
+          <CStyleOperator Value="False"/>
+          <AllowLabel Value="False"/>
+          <CPPInline Value="False"/>
         </SyntaxOptions>
       </Parsing>
+      <CodeGeneration>
+        <Optimizations>
+          <OptimizationLevel Value="0"/>
+        </Optimizations>
+      </CodeGeneration>
+      <Linking>
+        <Debugging>
+          <GenerateDebugInfo Value="False"/>
+        </Debugging>
+      </Linking>
+      <Other>
+        <CompilerMessages>
+          <IgnoredMessages idx6058="True" idx3124="True" idx3123="True"/>
+        </CompilerMessages>
+      </Other>
     </CompilerOptions>
     <Description Value="Unit set for generating CGI or server web application."/>
@@ -104 +122 @@
       </Item18>
     </Files>
+    <CompatibilityMode Value="True"/>
     <RequiredPkgs Count="8">
       <Item1>

trunk/Packages/CoolWeb/LazIDEReg.pas

@@ -39 +39 @@
   CGIAppDescriptor: TCGIApplicationDescriptor;
 
+procedure Register;
 
-procedure Register;
 
 implementation
@@ -100 +100 @@
 function TCGIApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
 var
-  le: string;
   NewSource: TStringList;
   MainFile: TLazProjectFile;

trunk/Packages/CoolWeb/Modules/UWebUser.pas

@@ -267 +267 @@
   Result := False;
   try
-      DbRows2 := TDbRows.Create;
-
-      // Check group-operation relation
-      Database.Select(DbRows2, 'PermissionGroupAssignment', 'Id',
-        '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(Operation));
-      if DbRows2.Count > 0 then begin
+    DbRows2 := TDbRows.Create;
+
+    // Check group-operation relation
+    Database.Select(DbRows2, 'PermissionGroupAssignment', 'Id',
+      '`User` = ' + IntToStr(Id) + ' AND `AssignedOperation` = ' + IntToStr(Operation));
+    if DbRows2.Count > 0 then begin
+      Result := True;
+      Exit;
+    end;
+
+    // Check group-group relation
+    Database.Select(DbRows2, 'PermissionGroupAssignment', 'AssignedGroup',
+      '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
+    if DbRows2.Count > 0 then begin
+      if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), Operation) then begin
         Result := True;
         Exit;
       end;
-
-      // Check group-group relation
-      Database.Select(DbRows2, 'PermissionGroupAssignment', 'AssignedGroup',
-        '`User` = ' + IntToStr(Id) + ' AND `AssignedGroup` IS NOT NULL');
-      if DbRows2.Count > 0 then begin
-        if CheckGroupPermission(StrToInt(DbRows2[0].Values['AssignedGroup']), Operation) then begin
-          Result := True;
-          Exit;
-        end;
-      end;
-    finally
-      DbRows2.Free;
-    end;
+    end;
+  finally
+    DbRows2.Free;
+  end;
 end;
 

trunk/Packages/CoolWeb/WebServer/UWebApp.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
-  UHTTPServer, Forms, FileUtil;
+  Classes, SysUtils, UWebPage, UHTTPSessionFile,
+  UHTTPServer, Forms, FileUtil, fgl;
 
 type
@@ -22 +22 @@
   { TPageList }
 
-  TPageList = class(TListObject)
+  TPageList = class(TFPGObjectList<TRegistredPage>)
     RootDir: string;
     function FindByPage(Page: TWebPage): TRegistredPage;
@@ -29 +29 @@
     procedure UnregisterPage(Page: TWebPage);
     function ProducePage(HandlerData: THTTPHandlerData): Boolean;
-    constructor Create; override;
+    constructor Create(FreeObjects: Boolean = True);
   end;
 
@@ -64 +64 @@
   UHTTPServerCGI, UHTTPServerTCP, UHTTPServerTurboPower;
 
-
 procedure Register;
 begin
@@ -77 +76 @@
 end;
 
-
 { TPageList }
 
@@ -85 +83 @@
 begin
   I := 0;
-  while (I < Count) and (TRegistredPage(Items[I]).Page <> Page) do Inc(I);
-  if I < Count then Result := TRegistredPage(Items[I])
+  while (I < Count) and (Items[I].Page <> Page) do Inc(I);
+  if I < Count then Result := Items[I]
     else Result := nil;
 end;
@@ -95 +93 @@
 begin
   I := 0;
-  while (I < Count) and (TRegistredPage(Items[I]).Name <> Name) do Inc(I);
-  if I < Count then Result := TRegistredPage(Items[I])
+  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
+  if I < Count then Result := Items[I]
     else Result := nil;
 end;
@@ -132 +130 @@
 var
   NewPage: TRegistredPage;
-  Instance: TWebPage;
-begin
-  NewPage := TRegistredPage(AddNew(TRegistredPage.Create));
+begin
+  NewPage := TRegistredPage.Create;
 //  NewPage.Page := PageClass.Create(Self);
   NewPage.Page := Page;
   NewPage.Name := Path;
+  Add(NewPage);
 end;
 
@@ -166 +164 @@
 constructor TPageList.Create;
 begin
-  inherited Create;
-  OwnsObjects := False;
+  inherited;
+  FreeObjects := False;
 end;
 
@@ -212 +210 @@
 constructor TWebApp.Create(AOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited;
   HTTPServer := THTTPServerCGI.Create(nil);
   HTTPServer.OnRequest := HTTPServerRequest;
@@ -219 +217 @@
 destructor TWebApp.Destroy;
 begin
-  HTTPServer.Free;
-  inherited Destroy;
+  FreeAndNil(HTTPServer);
+  inherited;
 end;