pngファイルはリソースで読む

[newbbs/newbbs.git] / WebModuleUnit1.pas

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 1c97507..7625c79 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -4,7 +4,7 @@ interface
 
 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
-  Data.DB, Web.DBXpressWeb;
+  Data.DB, Web.DBXpressWeb, System.Types;
 
 type
   TTWebModule1 = class(TWebModule)
@@ -126,15 +126,16 @@ uses Unit1, IdHashSHA, IdGlobal, IdHash, IdHashMessageDigest;
 {$R *.dfm}
 
 const
-  promotion: string = '\8dL\8d\90:';
+  promotion = '\8dL\8d\90:';
+  tcnt = 7;
 
 procedure TTWebModule1.adheadHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    ReplaceText:=promotion
-  else if (TagString = 'mente') and (DataModule1.FDTable3.FieldByName('mente')
-    .AsBoolean = true) then
+    ReplaceText := promotion
+  else if (TagString = 'mente') and
+    (DataModule1.FDTable3.FieldByName('mente').AsBoolean = true) then
     ReplaceText := 'checked'
   else if TagString = 'password' then
     ReplaceText := Request.CookieFields.Values['user'];
@@ -262,7 +263,7 @@ procedure TTWebModule1.helpHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    ReplaceText:=promotion;
+    ReplaceText := promotion;
 end;
 
 procedure TTWebModule1.indexHTMLTag(Sender: TObject; Tag: TTag;
@@ -348,14 +349,14 @@ procedure TTWebModule1.loginHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    ReplaceText:=promotion;
+    ReplaceText := promotion;
 end;
 
 procedure TTWebModule1.masterHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    Replacetext:=promotion
+    ReplaceText := promotion
   else if TagString = 'request' then
     with DataModule1.FDTable4 do
     begin
@@ -461,7 +462,7 @@ var
 
 begin
   if TagString = 'pr' then
-    ReplaceText:=promotion
+    ReplaceText := promotion
   else if (Request.MethodType = mtPost) and (TagString = 'items') then
   begin
     if Request.ContentFields.Values['type'] = 'OR' then
@@ -504,20 +505,23 @@ procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
 begin
   if TagString = 'count' then
   begin
-    DataModule1.FDTable1.Locate('database',
-      DataModule1.FDQuery1.FieldByName('database').AsString);
+    DataModule1.FDTable1.Locate('dbnum',
+      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger);
     ReplaceText := DataModule1.FDTable2.RecordCount.ToString;
-  end;
+  end
+  else if TagString = 'database' then
+    ReplaceText := DataModule1.FDTable1.Lookup('dbnum',
+      DataModule1.FDQuery1.FieldByName('dbnum').AsInteger, 'database');
 end;
 
 procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 begin
   if TagString = 'pr' then
-    ReplaceText:=promotion
+    ReplaceText := promotion
   else if TagString = 'js' then
     ReplaceText := detail(TagString, TagParams.Values['id'])
-  else
+  else if TagString = 'main' then
     with DataModule1.FDQuery1 do
     begin
       Open;
@@ -541,7 +545,7 @@ begin
   else if TagString = 'list' then
   begin
     i := DataModule1.FDTable3.FieldByName('info').AsInteger;
-    for k := 0 to DataModule1.FDTable3.FieldByName('tcnt').AsInteger do
+    for k := 0 to tcnt do
     begin
       if DataModule1.FDTable1.Eof = true then
         break;
@@ -576,8 +580,7 @@ begin
     ReplaceText := detail(TagString, TagParams.Values['id'])
   else if TagString = 'slide' then
   begin
-    j := DataModule1.FDTable3.FieldByName('tcnt').AsInteger;
-    for i := 1 to (DataModule1.FDTable1.RecordCount div j) + 1 do
+    for i := 1 to (DataModule1.FDTable1.RecordCount div tcnt) + 1 do
       ReplaceText := ReplaceText +
         '<div class="slide"><img src="/src?name=slide' + i.ToString +
         '.jpg" style=float:right;height:465px><#list></div>';
@@ -732,7 +735,7 @@ var
 begin
   s := Request.QueryFields.Values['type'];
   if s = 'js' then
-    Response.ContentType := 'text/javascript;charset=utf-8'
+    Response.ContentType := 'text/javascript'
   else if s = 'css' then
     Response.ContentType := 'text/css';
   Response.Content := detail(s, Request.QueryFields.Values['id']);
@@ -757,12 +760,28 @@ end;
 
 procedure TTWebModule1.TWebModule1imgAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+var
+  s: string;
+  res: TResourceStream;
 begin
   with DataModule1.FDTable5 do
   begin
-    Locate('name', Request.ContentFields.Values['name'], []);
+    s:= Request.ContentFields.Values['name'];
     Response.ContentType := 'image/jpeg';
-    Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead);
+    if Locate('name', s) = true then
+      Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
+    else
+      if s = 'sprites.png' then
+      begin
+        res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
+        try
+          Response.ContentStream:=res;
+        finally
+          res.Free;
+        end;
+      end
+      else
+        Response.ContentStream:=nil;
   end;
 end;
 
@@ -1018,6 +1037,27 @@ var
   i: Integer;
   a: Variant;
 begin
+  with DataModule1 do
+  begin
+    if FDTable1.Exists = false then
+      FDTable1.CreateTable;
+    if FDTable2.Exists = false then
+      FDTable2.CreateTable;
+    if FDTable3.Exists = false then
+      FDTable3.CreateTable;
+    if FDTable4.Exists = false then
+      FDTable4.CreateTable;
+    if FDTable5.Exists = false then
+      FDTable5.CreateTable;
+    FDTable1.Open;
+    FDTable2.Open;
+    FDTable3.Open;
+    FDTable4.Open;
+    FDTable5.Open;
+    FDTable1.Refresh;
+    FDTable3.Refresh;
+    FDTable5.Refresh;
+  end;
   if DataModule1.FDTable1.Bof and DataModule1.FDTable1.Eof then
   begin
     DataModule1.FDTable1.AppendRecord([0, 'info']);
@@ -1030,7 +1070,7 @@ begin
     DataModule1.FDTable3.AppendRecord
       (['\82Æ\82é\82Ë\81`\82Ç\8d\86',
       '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>',
-      false, a, 30, hash('admin'), 7]);
+      false, a, 30, hash('admin')]);
   end;
 end;