TTWebModule1の書き直しをした

認証はhash(hash())の2重使用に変えた

diff --git a/Project3.dpr b/Project3.dpr
index ea79b61..8f71544 100644 (file)
--- a/Project3.dpr
+++ b/Project3.dpr
@@ -10,7 +10,7 @@ uses
   Web.WebReq,
   IdHTTPWebBrokerBridge,
   FormUnit1 in 'FormUnit1.pas' {Form1},
-  WebModuleUnit1 in 'WebModuleUnit1.pas' {TWebModule1: TWebModule},
+  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
   Unit1 in 'Unit1.pas' {DataModule1: TDataModule};
 
 {$R *.res}

diff --git a/Project3.dproj b/Project3.dproj
index 4691a89..24db392 100644 (file)
--- a/Project3.dproj
+++ b/Project3.dproj
@@ -94,7 +94,7 @@
             <FormType>dfm</FormType>
         </DCCReference>
         <DCCReference Include="WebModuleUnit1.pas">
-            <Form>TWebModule1</Form>
+            <Form>WebModule1</Form>
             <FormType>dfm</FormType>
             <DesignClass>TWebModule</DesignClass>
         </DCCReference>
@@ -129,7 +129,7 @@
                 </Source>
             </Delphi.Personality>
             <Deployment>
-                <DeployFile LocalName="Win32\Release\Project3.exe" Configuration="Release" Class="ProjectOutput">
+                <DeployFile LocalName="Win32\Debug\Project3.exe" Configuration="Debug" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>Project3.exe</RemoteName>
                         <Overwrite>true</Overwrite>
@@ -141,7 +141,7 @@
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="Win32\Debug\Project3.exe" Configuration="Debug" Class="ProjectOutput">
+                <DeployFile LocalName="Win32\Release\Project3.exe" Configuration="Release" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>Project3.exe</RemoteName>
                         <Overwrite>true</Overwrite>

diff --git a/Project4.dpr b/Project4.dpr
index 174c8bd..045cf2b 100644 (file)
--- a/Project4.dpr
+++ b/Project4.dpr
@@ -8,7 +8,7 @@ uses
   Web.WebBroker,
   CGIApp,
   Unit1 in 'Unit1.pas' {DataModule1: TDataModule},
-  WebModuleUnit1 in 'WebModuleUnit1.pas' {TWebModule1: TWebModule};
+  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule};
 
 {$R *.res}
 

diff --git a/Project4.dproj b/Project4.dproj
index 0ba27fc..9834d86 100644 (file)
--- a/Project4.dproj
+++ b/Project4.dproj
@@ -95,7 +95,7 @@
             <DesignClass>TDataModule</DesignClass>
         </DCCReference>
         <DCCReference Include="WebModuleUnit1.pas">
-            <Form>TWebModule1</Form>
+            <Form>WebModule1</Form>
             <FormType>dfm</FormType>
             <DesignClass>TWebModule</DesignClass>
         </DCCReference>

diff --git a/Unit1.dfm b/Unit1.dfm
index e1c1bb2..dd900f9 100644 (file)
--- a/Unit1.dfm
+++ b/Unit1.dfm
@@ -115,11 +115,9 @@ object DataModule1: TDataModule1
       FieldName = 'COUNT'
       Origin = 'COUNT'
     end
-    object FDTable3PASSWORD: TWideStringField
-      FieldName = 'PASSWORD'
-      Origin = 'PASSWORD'
-      Required = True
-      Size = 80
+    object FDTable3password: TWideStringField
+      FieldName = 'password'
+      Size = 100
     end
   end
   object FDGUIxWaitCursor1: TFDGUIxWaitCursor

diff --git a/Unit1.pas b/Unit1.pas
index 4747fbe..e0aa29c 100644 (file)
--- a/Unit1.pas
+++ b/Unit1.pas
@@ -39,7 +39,6 @@ type
     FDTable3INFO: TIntegerField;
     FDTable3COUNT: TIntegerField;
     FDTable4ID: TIntegerField;
-    FDTable3PASSWORD: TWideStringField;
     FDTable2PASS: TWideStringField;
     FDTable5: TFDTable;
     FDTable5ID: TIntegerField;
@@ -47,6 +46,7 @@ type
     FDTable5SOURCE: TBlobField;
     FDTable1DATABASE: TWideStringField;
     FDQuery1: TFDQuery;
+    FDTable3password: TWideStringField;
   private
     { Private \90é\8c¾ }
   public

diff --git a/WebModuleUnit1.dfm b/WebModuleUnit1.dfm
index c93c102..86908fe 100644 (file)
--- a/WebModuleUnit1.dfm
+++ b/WebModuleUnit1.dfm
@@ -6,102 +6,101 @@ object WebModule1: TWebModule1
       MethodType = mtGet
       Name = 'top'
       PathInfo = '/'
-      OnAction = TWebModule1topAction
+      OnAction = WebModule1topAction
     end
     item
       MethodType = mtGet
       Name = 'indexpage'
       PathInfo = '/index'
-      OnAction = TWebModule1indexpageAction
+      OnAction = WebModule1indexpageAction
     end
     item
       MethodType = mtPost
       Name = 'regist'
       PathInfo = '/regist'
-      OnAction = TWebModule1registAction
+      OnAction = WebModule1registAction
     end
     item
       MethodType = mtGet
       Name = 'admin'
       PathInfo = '/admin'
-      OnAction = TWebModule1adminAction
+      OnAction = WebModule1adminAction
     end
     item
       Name = 'search'
       PathInfo = '/search'
-      OnAction = TWebModule1searchAction
+      OnAction = WebModule1searchAction
     end
     item
       Name = 'help'
       PathInfo = '/help'
-      OnAction = TWebModule1helpAction
+      OnAction = WebModule1helpAction
     end
     item
       Name = 'master'
       PathInfo = '/master'
-      OnAction = TWebModule1masterAction
+      OnAction = WebModule1masterAction
     end
     item
       Name = 'alert'
       PathInfo = '/alert'
-      OnAction = TWebModule1alertAction
+      OnAction = WebModule1alertAction
     end
     item
       MethodType = mtPost
       Name = 'usrdel'
       PathInfo = '/userdel'
-      OnAction = TWebModule1deleteAction
     end
     item
       Name = 'jump'
       PathInfo = '/jump'
-      OnAction = TWebModule1jumpAction
+      OnAction = WebModule1jumpAction
     end
     item
       MethodType = mtGet
       Name = 'link'
       PathInfo = '/link'
-      OnAction = TWebModule1linkAction
+      OnAction = WebModule1linkAction
     end
     item
       MethodType = mtPost
       Name = 'admdel'
       PathInfo = '/admindel'
-      OnAction = TWebModule1admdelAction
+      OnAction = WebModule1admdelAction
     end
     item
       Name = 'login'
       PathInfo = '/login'
-      OnAction = TWebModule1loginAction
+      OnAction = WebModule1loginAction
     end
     item
       MethodType = mtPost
       Name = 'adminset'
       PathInfo = '/adminset'
-      OnAction = TWebModule1adminsetAction
+      OnAction = WebModule1adminsetAction
     end
     item
       MethodType = mtGet
       Name = 'logout'
       PathInfo = '/logout'
-      OnAction = TWebModule1logoutAction
+      OnAction = WebModule1logoutAction
     end
     item
       MethodType = mtGet
       Name = 'img'
       PathInfo = '/src'
-      OnAction = TWebModule1imgAction
+      OnAction = WebModule1imgAction
     end
     item
       MethodType = mtGet
       Name = 'file'
       PathInfo = '/file'
-      OnAction = TWebModule1fileAction
+      OnAction = WebModule1fileAction
     end
     item
       Name = 'title'
       PathInfo = '/title'
-      OnAction = TWebModule1titleAction
+      OnAction = WebModule1titleAction
     end>
   Height = 385
   Width = 436

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index b500b88..7b86976 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -35,22 +35,22 @@ type
     ti: TDataSetPageProducer;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1registAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1registAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure WebModuleCreate(Sender: TObject);
-    procedure TWebModule1adminAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1adminAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1topAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1topAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure itemsHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure topHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1searchAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1searchAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1helpAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1helpAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure searchHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
@@ -60,42 +60,42 @@ type
       const TagString: string; TagParams: TStrings; var ReplaceText: string);
     procedure footerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1alertAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1alertAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1masterAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1masterAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure mailHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure alertHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1deleteAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1deleteAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1jumpAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1jumpAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1linkAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1linkAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure headerHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure adminFormatCell(Sender: TObject; CellRow, CellColumn: Integer;
       var BgColor: THTMLBgColor; var Align: THTMLAlign; var VAlign: THTMLVAlign;
       var CustomAttrs, CellData: string);
-    procedure TWebModule1admdelAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1admdelAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1loginAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1loginAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1adminsetAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure adheadHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1logoutAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1logoutAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1imgAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1imgAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
-    procedure TWebModule1fileAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1fileAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
-    procedure TWebModule1titleAction(Sender: TObject; Request: TWebRequest;
+    procedure WebModule1titleAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
     procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
@@ -587,7 +587,7 @@ begin
   end;
 end;
 
-procedure TWebModule1.TWebModule1admdelAction(Sender: TObject;
+procedure TWebModule1.WebModule1admdelAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   i, j, k, m: Integer;
@@ -609,10 +609,10 @@ begin
       DataModule1.FDTable2.Delete;
     end;
   end;
-  TWebModule1adminAction(nil, Request, Response, Handled);
+  WebModule1adminAction(nil, Request, Response, Handled);
 end;
 
-procedure TWebModule1.TWebModule1adminAction(Sender: TObject;
+procedure TWebModule1.WebModule1adminAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
@@ -650,12 +650,12 @@ begin
   Response.Content := admin.Content;
 end;
 
-procedure TWebModule1.TWebModule1adminsetAction(Sender: TObject;
+procedure TWebModule1.WebModule1adminsetAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
 begin
-  s := Request.ContentFields.Values['pass'];
+  s := hash(Request.ContentFields.Values['pass']);
   with DataModule1.FDTable3 do
   begin
     Edit;
@@ -672,10 +672,10 @@ begin
     Secure := true;
   end;
   Request.CookieFields.Values['user'] := s;
-  TWebModule1adminAction(nil, Request, Response, Handled);
+  WebModule1adminAction(nil, Request, Response, Handled);
 end;
 
-procedure TWebModule1.TWebModule1alertAction(Sender: TObject;
+procedure TWebModule1.WebModule1alertAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   num1, num2, i, dbnum: Integer;
@@ -701,7 +701,7 @@ begin
     end;
 end;
 
-procedure TWebModule1.TWebModule1deleteAction(Sender: TObject;
+procedure TWebModule1.WebModule1deleteAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   num: Integer;
@@ -722,13 +722,13 @@ begin
       FieldByName('raw').AsString := '';
       FieldByName('date').AsDateTime := Now;
       Post;
-      TWebModule1jumpAction(nil, Request, Response, Handled);
+      WebModule1jumpAction(nil, Request, Response, Handled);
     end
     else
-      TWebModule1indexpageAction(nil, Request, Response, Handled);
+      WebModule1indexpageAction(nil, Request, Response, Handled);
 end;
 
-procedure TWebModule1.TWebModule1fileAction(Sender: TObject;
+procedure TWebModule1.WebModule1fileAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
@@ -741,7 +741,7 @@ begin
   Response.Content := detail(s, Request.QueryFields.Values['id']);
 end;
 
-procedure TWebModule1.TWebModule1helpAction(Sender: TObject;
+procedure TWebModule1.WebModule1helpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   i, j: Integer;
@@ -758,31 +758,30 @@ begin
   Response.Content := help.Content;
 end;
 
-procedure TWebModule1.TWebModule1imgAction(Sender: TObject;
-  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+procedure TWebModule1.WebModule1imgAction(Sender: TObject; Request: TWebRequest;
+  Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
   res: TResourceStream;
 begin
   with DataModule1.FDTable5 do
   begin
-    s:= Request.ContentFields.Values['name'];
+    s := Request.ContentFields.Values['name'];
     Response.ContentType := 'image/jpeg';
     if Locate('name', s) = true then
       Response.ContentStream := CreateBlobStream(FieldByName('source'), bmRead)
+    else if s = 'sprites.png' then
+    begin
+      Response.ContentType := 'image/png';
+      res := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
+      Response.ContentStream := res;
+    end
     else
-      if s = 'sprites.png' then
-      begin
-        Response.ContentType:='image/png';
-        res:=TResourceStream.Create(HInstance,'PngImage_1',RT_RCDATA);
-        Response.ContentStream:=res;
-      end
-      else
-        Response.ContentStream:=nil;
+      Response.ContentStream := nil;
   end;
 end;
 
-procedure TWebModule1.TWebModule1indexpageAction(Sender: TObject;
+procedure TWebModule1.WebModule1indexpageAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   int: Integer;
@@ -801,7 +800,7 @@ begin
     Response.Content := index.Content;
 end;
 
-procedure TWebModule1.TWebModule1jumpAction(Sender: TObject;
+procedure TWebModule1.WebModule1jumpAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   DB, s: string;
@@ -817,7 +816,7 @@ begin
   Response.SendRedirect(Format('/index?db=%s&num=%d#%s', [DB, page, s]));
 end;
 
-procedure TWebModule1.TWebModule1linkAction(Sender: TObject;
+procedure TWebModule1.WebModule1linkAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   num: Integer;
@@ -834,7 +833,7 @@ begin
   end;
 end;
 
-procedure TWebModule1.TWebModule1loginAction(Sender: TObject;
+procedure TWebModule1.WebModule1loginAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   i: Integer;
@@ -848,16 +847,16 @@ begin
   with Response.Cookies.Add do
   begin
     Name := 'user';
-    Value := Request.ContentFields.Values['password'];
+    Value := hash(Request.ContentFields.Values['password']);
     Expires := Now + 14;
     Secure := true;
   end;
   i := DataModule1.FDTable1.Lookup('database',
     Request.ContentFields.Values['record'], 'dbnum');
-  Response.SendRedirect('/admin?db=' + i.ToString);
+  Response.SendResponse;
 end;
 
-procedure TWebModule1.TWebModule1logoutAction(Sender: TObject;
+procedure TWebModule1.WebModule1logoutAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   with Response.Cookies.Add do
@@ -865,10 +864,10 @@ begin
     Name := 'user';
     Expires := Now - 1;
   end;
-  TWebModule1indexpageAction(nil, Request, Response, Handled);
+  WebModule1indexpageAction(nil, Request, Response, Handled);
 end;
 
-procedure TWebModule1.TWebModule1masterAction(Sender: TObject;
+procedure TWebModule1.WebModule1masterAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   s: string;
@@ -904,7 +903,7 @@ begin
   Response.Content := master.Content;
 end;
 
-procedure TWebModule1.TWebModule1registAction(Sender: TObject;
+procedure TWebModule1.WebModule1registAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
   number, i: Integer;
@@ -1003,25 +1002,25 @@ begin
   finally
     comment.Free;
   end;
-  TWebModule1indexpageAction(nil, Request, Response, Handled);
+  WebModule1indexpageAction(nil, Request, Response, Handled);
 end;
 
-procedure TWebModule1.TWebModule1searchAction(Sender: TObject;
+procedure TWebModule1.WebModule1searchAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   Response.Content := search.Content;
 end;
 
-procedure TWebModule1.TWebModule1titleAction(Sender: TObject;
+procedure TWebModule1.WebModule1titleAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   Response.Content := title.Content;
 end;
 
-procedure TWebModule1.TWebModule1topAction(Sender: TObject;
-  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+procedure TWebModule1.WebModule1topAction(Sender: TObject; Request: TWebRequest;
+  Response: TWebResponse; var Handled: Boolean);
 begin
   Response.ContentType := 'text/html;charset=utf-8';
   DataModule1.FDTable1.First;
@@ -1067,7 +1066,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')]);
+      false, a, 30, hash(hash('admin'))]);
   end;
 end;
 

diff --git a/tool/Unit1.fmx b/tool/Unit1.fmx
index 77f18f6..0baee71 100644 (file)
--- a/tool/Unit1.fmx
+++ b/tool/Unit1.fmx
@@ -271,8 +271,8 @@ object Form2: TForm2
           000000000000000000000000000000000000000000000000000000005C0D9B9A
           0001796AD0B50000000049454E44AE426082}
       end>
-    Position.X = 120.000000000000000000
-    Position.Y = 32.000000000000000000
+    Position.X = 40.000000000000000000
+    Position.Y = 72.000000000000000000
     Size.Width = 265.000000000000000000
     Size.Height = 233.000000000000000000
     Size.PlatformDefault = False
@@ -281,26 +281,26 @@ object Form2: TForm2
     Touch.InteractiveGestures = [LongTap, DoubleTap]
     TabOrder = 5
     ReadOnly = True
-    Position.X = 160.000000000000000000
-    Position.Y = 304.000000000000000000
+    Position.X = 56.000000000000000000
+    Position.Y = 328.000000000000000000
     Size.Width = 164.000000000000000000
     Size.Height = 32.000000000000000000
     Size.PlatformDefault = False
   end
   object NavigatorBindSourceDB12: TBindNavigator
-    Position.X = 160.000000000000000000
-    Position.Y = 392.000000000000000000
-    Size.Width = 216.000000000000000000
+    Position.X = 40.000000000000000000
+    Position.Y = 384.000000000000000000
+    Size.Width = 208.000000000000000000
     Size.Height = 25.000000000000000000
     Size.PlatformDefault = False
     TabOrder = 12
     DataSource = BindSourceDB1
-    VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbEdit, nbPost, nbCancel, nbRefresh]
+    VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
     xRadius = 4.000000000000000000
     yRadius = 4.000000000000000000
   end
   object Button1: TButton
-    Position.X = 432.000000000000000000
+    Position.X = 368.000000000000000000
     Position.Y = 136.000000000000000000
     TabOrder = 23
     Text = #38283#12367
@@ -309,20 +309,28 @@ object Form2: TForm2
   object Label1: TLabel
     Position.X = 64.000000000000000000
     Position.Y = 48.000000000000000000
+    Text = 'Label1'
   end
   object OpenDialog1: TOpenDialog
     DefaultExt = 'jpg'
     Filter = #30011#20687'(jpeg)|*.jpg;*.jpeg'
-    Left = 496
-    Top = 312
+    Left = 472
+    Top = 320
   end
   object Button2: TButton
-    Position.X = 432.000000000000000000
-    Position.Y = 176.000000000000000000
+    Position.X = 472.000000000000000000
+    Position.Y = 136.000000000000000000
     TabOrder = 38
     Text = #21021#26399#21270
     OnClick = Button2Click
   end
+  object Button3: TButton
+    Position.X = 368.000000000000000000
+    Position.Y = 176.000000000000000000
+    TabOrder = 55
+    Text = #21462#12426#28040#12375
+    OnClick = Button3Click
+  end
   object FDTable1: TFDTable
     IndexFieldNames = 'id'
     Connection = FDConnection1

diff --git a/tool/Unit1.pas b/tool/Unit1.pas
index e237471..3916de1 100644 (file)
--- a/tool/Unit1.pas
+++ b/tool/Unit1.pas
@@ -36,9 +36,11 @@ type
     FDQuery1: TFDQuery;
     Button2: TButton;
     FDBatchMove1: TFDBatchMove;
+    Button3: TButton;
     procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure Button2Click(Sender: TObject);
+    procedure Button3Click(Sender: TObject);
   private
     { private \90é\8c¾ }
     procedure streamToField(stream, field: TStream);
@@ -134,4 +136,11 @@ begin
   end;
 end;
 
+procedure TForm2.Button3Click(Sender: TObject);
+begin
+  FDTable1.Edit;
+  FDTable1.FieldByName('source').Assign(nil);
+  FDTable1.Post;
+end;
+
 end.

diff --git a/tool/dbtool.dproj b/tool/dbtool.dproj
index c3a9e60..63a60d9 100644 (file)
--- a/tool/dbtool.dproj
+++ b/tool/dbtool.dproj
@@ -5,7 +5,7 @@
         <FrameworkType>FMX</FrameworkType>
         <MainSource>dbtool.dpr</MainSource>
         <Base>True</Base>
-        <Config Condition="'$(Config)'==''">Release</Config>
+        <Config Condition="'$(Config)'==''">Debug</Config>
         <Platform Condition="'$(Platform)'==''">Win32</Platform>
         <TargetedPlatforms>1</TargetedPlatforms>
         <AppType>Application</AppType>
@@ -150,75 +150,75 @@
                 </Source>
             </Delphi.Personality>
             <Deployment>
-                <DeployFile LocalName="2019-03\IMG_0757.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="Win32\Debug\dbtool.exe" Configuration="Debug" Class="ProjectOutput">
                     <Platform Name="Win32">
-                        <RemoteDir>.\</RemoteDir>
+                        <RemoteName>dbtool.exe</RemoteName>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0761.JPG" Configuration="Debug" Class="ProjectFile">
-                    <Platform Name="Win32">
-                        <RemoteDir>.\</RemoteDir>
+                <DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
+                    <Platform Name="OSX32">
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0756.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0753.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0760.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0757.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0754.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0755.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0759.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0752.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="Win32\Debug\dbtool.exe" Configuration="Debug" Class="ProjectOutput">
+                <DeployFile LocalName="2019-03\IMG_0761.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
-                        <RemoteName>dbtool.exe</RemoteName>
+                        <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
-                    <Platform Name="OSX32">
-                        <Overwrite>true</Overwrite>
-                    </Platform>
-                    <Platform Name="iOSSimulator">
+                <DeployFile LocalName="2019-03\IMG_0756.JPG" Configuration="Debug" Class="ProjectFile">
+                    <Platform Name="Win32">
+                        <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0753.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0758.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0755.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0760.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0752.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0759.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="2019-03\IMG_0758.JPG" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="2019-03\IMG_0754.JPG" Configuration="Debug" Class="ProjectFile">
                     <Platform Name="Win32">
                         <RemoteDir>.\</RemoteDir>
                         <Overwrite>true</Overwrite>