From 956fe6e9355ef6fdd911dc84cde3facd90ed7378 Mon Sep 17 00:00:00 2001 From: yamat0jp Date: Sat, 11 Jan 2020 18:01:42 +0900 Subject: [PATCH] =?utf8?q?SQL=E3=81=A7=E3=81=AF=E3=81=AA=E3=81=8F=E3=81=BB?= =?utf8?q?=E3=81=A8=E3=82=93=E3=81=A9=E3=82=92=E3=82=B3=E3=83=BC=E3=83=89?= =?utf8?q?=E3=81=A7=E8=A3=9C=E3=81=84=E3=81=BE=E3=81=97=E3=81=9F?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Unit1.dfm | 12 ++++++++-- Unit1.pas | 1 + WebModuleUnit1.dfm | 12 +++++++--- WebModuleUnit1.pas | 67 +++++++++++++++++++++++++++++++++++++----------------- 4 files changed, 66 insertions(+), 26 deletions(-) diff --git a/Unit1.dfm b/Unit1.dfm index f256f08..1d6f54b 100644 --- a/Unit1.dfm +++ b/Unit1.dfm @@ -1,6 +1,6 @@ object DataModule1: TDataModule1 OldCreateOrder = False - Height = 231 + Height = 279 Width = 302 object FDTable1: TFDTable IndexFieldNames = 'DBNUM' @@ -131,7 +131,7 @@ object DataModule1: TDataModule1 end object DataSource1: TDataSource DataSet = FDTable1 - Left = 64 + Left = 32 Top = 152 end object FDTable4: TFDTable @@ -187,4 +187,12 @@ object DataModule1: TDataModule1 Origin = 'SOURCE' end end + object FDQuery1: TFDQuery + Connection = FDConnection1 + SQL.Strings = ( + 'select dbnum,number,title from article' + ' where number = 1;') + Left = 136 + Top = 152 + end end diff --git a/Unit1.pas b/Unit1.pas index c5a101b..05ab3ba 100644 --- a/Unit1.pas +++ b/Unit1.pas @@ -47,6 +47,7 @@ type FDTable1DATABASE: TWideStringField; FDTable3password: TWideStringField; FDTable3ng: TWideStringField; + FDQuery1: TFDQuery; private { Private éŒ¾ } public diff --git a/WebModuleUnit1.dfm b/WebModuleUnit1.dfm index eb55759..9597a17 100644 --- a/WebModuleUnit1.dfm +++ b/WebModuleUnit1.dfm @@ -1911,12 +1911,18 @@ object WebModule1: TWebModule1 end object ti: TDataSetPageProducer HTMLDoc.Strings = ( - '

<#database>'#8595'

' - '
'#12479#12452#12488#12523': '#39'<#title> , '#35352#20107#25968': <#count> , '#26356#26032#26178#21051': <#date>

' + + '

><#database>' + + ''#8595'

' + '
'#12479#12452#12488#12523': <#title> ; '#35352#20107#25968': <#count> ; '#26356#26032#26178#21051': <#date>

' '') - DataSet = DataModule1.FDTable2 + DataSet = DataModule1.FDQuery1 OnHTMLTag = tiHTMLTag Left = 48 Top = 320 end + object FDQuery1: TFDQuery + Left = 200 + Top = 176 + end end diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas index b504179..5f388a7 100644 --- a/WebModuleUnit1.pas +++ b/WebModuleUnit1.pas @@ -4,7 +4,10 @@ interface uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd, Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions, - Data.DB, Web.DBXpressWeb, System.Types; + Data.DB, Web.DBXpressWeb, System.Types, FireDAC.Stan.Intf, + FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, + FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, + FireDAC.Comp.DataSet, FireDAC.Comp.Client; type TWebModule1 = class(TWebModule) @@ -33,6 +36,7 @@ type js5: TPageProducer; title: TPageProducer; ti: TDataSetPageProducer; + FDQuery1: TFDQuery; procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string); procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest; @@ -108,7 +112,7 @@ type ss: TStringList; tagstr: string; procedure pages(count: Integer; var page: Integer); - procedure strsCheck(var error: string; var list: TStringList); + procedure strsCheck(var Error: string; var list: TStringList); procedure setLastArticle; function isInfo: Boolean; function loginCheck: Boolean; @@ -558,7 +562,7 @@ begin DataModule1.FDTable2.Last; end; -procedure TWebModule1.strsCheck(var error: string; var list: TStringList); +procedure TWebModule1.strsCheck(var Error: string; var list: TStringList); var s: TStringList; i, j: Integer; @@ -579,16 +583,22 @@ begin s.Free; end; if x = true then - error := error + '

‹ÖŽ~Œê‹å‚ªŠÜ‚Ü‚ê‚Ä‚¢‚Ü‚·.'; + Error := Error + '

‹ÖŽ~Œê‹å‚ªŠÜ‚Ü‚ê‚Ä‚¢‚Ü‚·.'; end; procedure TWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string; TagParams: TStrings; var ReplaceText: string); begin if TagString = 'count' then - ReplaceText := DataModule1.FDTable2.FieldCount.ToString + ReplaceText := DataModule1.FDTable2.RecordCount.ToString else if TagString = 'database' then - ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString; + ReplaceText := DataModule1.FDTable1.FieldByName('database').AsString + else if TagString = 'date' then + with DataModule1.FDTable2 do + begin + Last; + ReplaceText := FieldByName('date').AsString; + end; end; procedure TWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag; @@ -599,15 +609,30 @@ begin else if TagString = 'js' then ReplaceText := detail(TagString, TagParams.Values['id']) else if TagString = 'main' then - with DataModule1.FDTable1 do + with DataModule1 do begin - First; - while Eof = false do + FDQuery1.Open; + FDTable1.First; + while FDQuery1.Eof = false do begin - setLastArticle; - ReplaceText := ReplaceText + ti.Content; - Next; + if FDTable1.FieldByName('dbnum').AsInteger = FDQuery1.FieldByName + ('dbnum').AsInteger then + begin + ReplaceText := ReplaceText + ti.Content; + FDQuery1.Next; + end + else if FDTable2.Eof = false then + begin + ti.DataSet := nil; + try + ReplaceText := ReplaceText + ti.Content; + finally + ti.DataSet := FDQuery1; + end; + end; + FDTable1.Next; end; + FDQuery1.Close; end; end; @@ -1038,7 +1063,7 @@ procedure TWebModule1.WebModule1registAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); var number, i: Integer; - title, na, raw, pass, kotoba, error: string; + title, na, raw, pass, kotoba, Error: string; comment: TStringList; function scan(Text: string): string; var @@ -1065,9 +1090,9 @@ var begin kotoba := Request.ContentFields.Values['aikotoba']; - error := ''; + Error := ''; if kotoba <> '‚°‚ñ‚«' then - error := error + '

‡Œ¾—t‚ª‚¿‚ª‚¢‚Ü‚·.'; + Error := Error + '

‡Œ¾—t‚ª‚¿‚ª‚¢‚Ü‚·.'; setLastArticle; number := DataModule1.FDTable2.FieldByName('number').AsInteger + 1; with Request.ContentFields do @@ -1088,7 +1113,7 @@ begin Value := na; Expires := Now + 14; end; - if error = '' then + if Error = '' then with Response.Cookies.Add do begin Name := 'aikotoba'; @@ -1098,16 +1123,16 @@ begin comment := TStringList.Create; try comment.Text := raw; - strsCheck(error, comment); + strsCheck(Error, comment); Request.ContentFields.Values['raw'] := raw; - if error <> '' then + if Error <> '' then Request.ContentFields.Values['preview'] := '

' + - error + '
' + Error + '' else if Request.ContentFields.Values['show'] = 'true' then begin - error := '

««ƒvƒŒƒrƒ…[««

' + + Error := '

««ƒvƒŒƒrƒ…[««

' + comment.Text; - Request.ContentFields.Values['preview'] := error; + Request.ContentFields.Values['preview'] := Error; Request.ContentFields.Values['show'] := 'false'; end else -- 2.11.0