tool/Unit2.pas

   1 unit Unit2;
   2
   3 interface
   4
   5 uses
   6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
   7   System.Classes, Vcl.Graphics,
   8   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
   9   FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  10   FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL,
  11   FireDAC.Phys.MySQLDef, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
  12   FireDAC.DApt, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls, Data.DB,
  13   FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.Rtti,
  14   System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.EngExt,
  15   Vcl.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope,
  16   FireDAC.VCLUI.Wait, FireDAC.Comp.UI, Vcl.DBCtrls, Jpeg, Vcl.Grids,
  17   Vcl.DBGrids,
  18   FireDAC.Phys.IB, FireDAC.Phys.IBDef, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
  19   Vcl.ComCtrls;
  20
  21 type
  22   TForm1 = class(TForm)
  23     FDConnection1: TFDConnection;
  24     FDTable1: TFDTable;
  25     Button1: TButton;
  26     Button2: TButton;
  27     Button3: TButton;
  28     Edit1: TEdit;
  29     Label1: TLabel;
  30     OpenPictureDialog1: TOpenPictureDialog;
  31     BindSourceDB1: TBindSourceDB;
  32     BindingsList1: TBindingsList;
  33     LinkPropertyToFieldCaption: TLinkPropertyToField;
  34     LinkControlToField2: TLinkControlToField;
  35     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
  36     DBNavigator1: TDBNavigator;
  37     DataSource1: TDataSource;
  38     DBGrid1: TDBGrid;
  39     FDTable1ID: TIntegerField;
  40     FDTable1NAME: TWideStringField;
  41     FDTable1SOURCE: TBlobField;
  42     Button4: TButton;
  43     FDQuery1: TFDQuery;
  44     Memo1: TMemo;
  45     CheckBox1: TCheckBox;
  46     Edit3: TEdit;
  47     Label2: TLabel;
  48     FDTable2: TFDTable;
  49     BindSourceDB2: TBindSourceDB;
  50     LinkControlToField1: TLinkControlToField;
  51     Edit4: TEdit;
  52     LinkControlToField5: TLinkControlToField;
  53     Button5: TButton;
  54     Edit5: TEdit;
  55     UpDown1: TUpDown;
  56     Edit6: TEdit;
  57     LinkControlToField4: TLinkControlToField;
  58     ComboBox1: TComboBox;
  59     Button6: TButton;
  60     Label3: TLabel;
  61     Bevel1: TBevel;
  62     procedure Button1Click(Sender: TObject);
  63     procedure Button4Click(Sender: TObject);
  64     procedure Button3Click(Sender: TObject);
  65     procedure FormCreate(Sender: TObject);
  66     procedure Button6Click(Sender: TObject);
  67     procedure ComboBox1Select(Sender: TObject);
  68     procedure CheckBox1Click(Sender: TObject);
  69     procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  70     procedure Button5Click(Sender: TObject);
  71   private
  72     { Private \90é\8c¾ }
  73   public
  74     { Public \90é\8c¾ }
  75   end;
  76
  77 var
  78   Form1: TForm1;
  79
  80 implementation
  81
  82 uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
  83
  84 {$R *.dfm}
  85
  86 procedure TForm1.Button1Click(Sender: TObject);
  87 var
  88   i: Integer;
  89   t: TStream;
  90 begin
  91   with FDTable1 do
  92   begin
  93     for i := 1 to 10 do
  94     begin
  95       t := TResourceStream.Create(HInstance, 'Resource_' + i.ToString,
  96         RT_RCDATA);
  97       AppendRecord([i, Format('slide%d.jpg', [i])]);
  98       Edit;
  99       FDTable1SOURCE.LoadFromStream(t);
 100       Post;
 101       t.Free;
 102     end;
 103     ApplyUpdates;
 104     CommitUpdates;
 105   end;
 106 end;
 107
 108 procedure TForm1.Button3Click(Sender: TObject);
 109 var
 110   s: TStream;
 111   j: TJpegImage;
 112 begin
 113   s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmRead);
 114   j := TJpegImage.Create;
 115   j.LoadFromStream(s);
 116   Canvas.Draw(0, 0, j);
 117   s.Free;
 118   j.Free;
 119 end;
 120
 121 procedure TForm1.Button4Click(Sender: TObject);
 122 begin
 123   with FDTable1 do
 124   begin
 125     repeat
 126       Delete;
 127     until (Bof = true) and (Eof = true);
 128     ApplyUpdates;
 129     Reconcile;
 130     CommitUpdates;
 131   end;
 132 end;
 133
 134 procedure TForm1.Button5Click(Sender: TObject);
 135 begin
 136   Edit4.Text := '\82Æ\82é\82Ë\81`\82Ç\8d\86';
 137   Memo1.Lines.Text :=
 138     '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>';
 139   Edit3.Text := '\94n\8e,\88¢\95Û,\8e\80\82Ë,\8eE\82·';
 140   Edit6.Text := 'admin';
 141   ComboBox1.Text := 'info';
 142   UpDown1.Position := 30;
 143   UpDown1Click(nil, btNext);
 144   CheckBox1.Checked := false;
 145   CheckBox1Click(nil);
 146   FDTable2.Post;
 147   FDTable2.Edit;
 148 end;
 149
 150 procedure TForm1.Button6Click(Sender: TObject);
 151   function hash(str: string): string;
 152   begin
 153     with TIdHashSHA1.Create do
 154     begin
 155       try
 156         result := HashStringAsHex(str);
 157       finally
 158         Free;
 159       end;
 160     end;
 161   end;
 162
 163 begin
 164   if Edit6.Text <> '' then
 165     FDTable2.FieldByName('password').AsString := hash(hash(Edit6.Text));
 166   FDTable2.Post;
 167   FDTable2.Edit;
 168 end;
 169
 170 procedure TForm1.CheckBox1Click(Sender: TObject);
 171 var
 172   i: Integer;
 173 begin
 174   if CheckBox1.Checked = true then
 175     i := 1
 176   else
 177     i := 0;
 178   FDTable2.FieldByName('mente').AsInteger := i;
 179 end;
 180
 181 procedure TForm1.ComboBox1Select(Sender: TObject);
 182 begin
 183   FDQuery1.Open('select * from dbname');
 184   FDTable2.FieldByName('info').AsInteger := FDQuery1.Lookup('database',
 185     ComboBox1.Text, 'dbnum');
 186   FDQuery1.Close;
 187 end;
 188
 189 procedure TForm1.FormCreate(Sender: TObject);
 190 var
 191   s: string;
 192 begin
 193   if FDTable1.Exists = false then
 194   begin
 195     FDTable1.Close;
 196     FDQuery1.ExecSQL;
 197     FDTable1.Open;
 198   end;
 199   FDTable1.Refresh;
 200   FDTable2.Refresh;
 201   ComboBox1.Items.Clear;
 202   with FDQuery1 do
 203   begin
 204     Open('select * from dbname;');
 205     while Eof = false do
 206     begin
 207       s := FieldByName('database').AsString;
 208       if s <> 'master' then
 209         ComboBox1.Items.Add(s);
 210       Next;
 211     end;
 212     ComboBox1.Text := Lookup('dbnum', FDTable2.FieldByName('info').AsInteger,
 213       'database');
 214     Close;
 215   end;
 216   CheckBox1.Checked := FDTable2.FieldByName('mente').AsInteger = 1;
 217   UpDown1.Position := FDTable2.FieldByName('count').AsInteger;
 218   FDTable2.Edit;
 219 end;
 220
 221 procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
 222 begin
 223   FDTable2.FieldByName('count').AsInteger := UpDown1.Position;
 224 end;
 225
 226 end.