tool/Unit2.pas

   1 unit Unit2;
   2
   3 interface
   4
   5 uses
   6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
   7   System.Types, 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, Vcl.Buttons;
  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     ListBox1: TListBox;
  63     SpeedButton1: TSpeedButton;
  64     Edit2: TEdit;
  65     FDTable2title: TWideStringField;
  66     FDTable2title2: TWideStringField;
  67     FDTable2mente: TSmallintField;
  68     FDTable2info: TIntegerField;
  69     FDTable2count: TIntegerField;
  70     FDTable2password: TWideStringField;
  71     FDTable2ng: TWideStringField;
  72     FDTable3: TFDTable;
  73     FDTable3dbnum: TIntegerField;
  74     FDTable3database: TWideStringField;
  75     procedure Button1Click(Sender: TObject);
  76     procedure Button4Click(Sender: TObject);
  77     procedure Button3Click(Sender: TObject);
  78     procedure FormCreate(Sender: TObject);
  79     procedure Button6Click(Sender: TObject);
  80     procedure ComboBox1Select(Sender: TObject);
  81     procedure CheckBox1Click(Sender: TObject);
  82     procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  83     procedure Button5Click(Sender: TObject);
  84     procedure SpeedButton1Click(Sender: TObject);
  85     procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
  86       Shift: TShiftState);
  87     procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  88       State: TDragState; var Accept: Boolean);
  89     procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
  90     procedure ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
  91   private
  92     { Private \90é\8c¾ }
  93     item: Integer;
  94     procedure combo;
  95     procedure list;
  96     procedure itemsCopy;
  97   public
  98     { Public \90é\8c¾ }
  99   end;
 100
 101 var
 102   Form1: TForm1;
 103
 104 implementation
 105
 106 uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
 107
 108 {$R *.dfm}
 109
 110 procedure TForm1.Button1Click(Sender: TObject);
 111 var
 112   i: Integer;
 113   t: TStream;
 114 begin
 115   with FDTable1 do
 116   begin
 117     for i := 1 to 10 do
 118     begin
 119       t := TResourceStream.Create(HInstance, 'Resource_' + i.ToString,
 120         RT_RCDATA);
 121       AppendRecord([i, Format('slide%d.jpg', [i])]);
 122       Edit;
 123       FDTable1SOURCE.LoadFromStream(t);
 124       Post;
 125       t.Free;
 126     end;
 127     ApplyUpdates;
 128     CommitUpdates;
 129   end;
 130 end;
 131
 132 procedure TForm1.Button3Click(Sender: TObject);
 133 var
 134   s: TStream;
 135   j: TJpegImage;
 136 begin
 137   s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmRead);
 138   j := TJpegImage.Create;
 139   j.LoadFromStream(s);
 140   Canvas.Draw(0, 0, j);
 141   s.Free;
 142   j.Free;
 143 end;
 144
 145 procedure TForm1.Button4Click(Sender: TObject);
 146 begin
 147   with FDTable1 do
 148   begin
 149     repeat
 150       Delete;
 151     until (Bof = true) and (Eof = true);
 152     ApplyUpdates;
 153     Reconcile;
 154     CommitUpdates;
 155   end;
 156 end;
 157
 158 procedure TForm1.Button5Click(Sender: TObject);
 159 var
 160   i: Integer;
 161 begin
 162   Edit4.Text := '\82Æ\82é\82Ë\81`\82Ç\8d\86';
 163   Memo1.Lines.Text :=
 164     '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>';
 165   Edit3.Text := '\94n\8e,\88¢\95Û,\8e\80\82Ë,\8eE\82·';
 166   Edit6.Text := 'admin';
 167   ComboBox1.Text := 'info';
 168   ComboBox1Select(nil);
 169   UpDown1.Position := 30;
 170   UpDown1Click(nil, btNext);
 171   CheckBox1.Checked := false;
 172   CheckBox1Click(nil);
 173   ListBox1.Items.Clear;
 174   ListBox1.Items.Add('info');
 175   ListBox1.Items.Add('master');
 176   for i := 1 to 10 do
 177     ListBox1.Items.Add('\8cf\8e¦\94Â'+i.ToString);
 178   list;
 179   itemsCopy;
 180 end;
 181
 182 procedure TForm1.Button6Click(Sender: TObject);
 183   function hash(str: string): string;
 184   begin
 185     with TIdHashSHA1.Create do
 186     begin
 187       try
 188         result := HashStringAsHex(str);
 189       finally
 190         Free;
 191       end;
 192     end;
 193   end;
 194
 195 begin
 196   if Edit6.Text <> '' then
 197     FDTable2.FieldByName('password').AsString := hash(hash(Edit6.Text));
 198   if ComboBox1.Items.IndexOf(ComboBox1.Text) = -1 then
 199   begin
 200     ComboBox1.ItemIndex := 0;
 201     ComboBox1Select(nil);
 202   end;
 203   FDTable2.Post;
 204   list;
 205   FDTable2.ApplyUpdates;
 206   FDTable2.CommitUpdates;
 207   FDTable3.ApplyUpdates;
 208   FDTable3.CommitUpdates;
 209   FDTable2.Edit;
 210 end;
 211
 212 procedure TForm1.CheckBox1Click(Sender: TObject);
 213 var
 214   i: Integer;
 215 begin
 216   if CheckBox1.Checked = true then
 217     i := 1
 218   else
 219     i := 0;
 220   FDTable2.FieldByName('mente').AsInteger := i;
 221 end;
 222
 223 procedure TForm1.combo;
 224 var
 225   i: Integer;
 226   s: string;
 227 begin
 228   ComboBox1.Items.Clear;
 229   with FDTable3 do
 230   begin
 231     First;
 232     while Eof = false do
 233     begin
 234       s := FieldByName('database').AsString;
 235       ComboBox1.Items.Add(s);
 236       Next;
 237     end;
 238     ComboBox1.Text := Lookup('dbnum', FDTable2.FieldByName('info').AsInteger,
 239       'database');
 240   end;
 241   ListBox1.Items.Text := ComboBox1.Items.Text;
 242   i := ComboBox1.Items.IndexOf('master');
 243   ComboBox1.Items.Delete(i);
 244 end;
 245
 246 procedure TForm1.ComboBox1Select(Sender: TObject);
 247 begin
 248   FDTable2.FieldByName('info').AsInteger := FDTable3.Lookup('database',
 249     ComboBox1.Text, 'dbnum');
 250 end;
 251
 252 procedure TForm1.FormCreate(Sender: TObject);
 253 begin
 254   if FDTable1.Exists = false then
 255   begin
 256     FDTable1.Close;
 257     FDQuery1.ExecSQL;
 258     FDTable1.Open;
 259   end;
 260   if FDTable2.Exists = false then
 261     FDTable2.CreateTable;
 262   FDTable2.Open;
 263   FDTable1.Refresh;
 264   FDTable2.Refresh;
 265   if FDTable3.Exists = false then
 266     FDTable3.CreateTable;
 267   FDTable3.Open;
 268   with FDTable3 do
 269   if (Bof = true)and(Eof = true) then
 270   begin
 271     list;
 272     ApplyUpdates;
 273     CommitUpdates;
 274   end;
 275   FDTable3.Refresh;
 276   combo;
 277   CheckBox1.Checked := FDTable2.FieldByName('mente').AsInteger = 1;
 278   UpDown1.Position := FDTable2.FieldByName('count').AsInteger;
 279   FDTable2.Edit;
 280 end;
 281
 282 procedure TForm1.itemsCopy;
 283 var
 284   i: Integer;
 285   s: string;
 286 begin
 287   ComboBox1.Items.Clear;
 288   for i := 0 to ListBox1.Items.Count - 1 do
 289   begin
 290     s := ListBox1.Items[i];
 291     if s <> 'master' then
 292       ComboBox1.Items.Add(s);
 293   end;
 294   if (ComboBox1.Items.IndexOf(ComboBox1.Text) = -1) and
 295     (ComboBox1.Items.Count > 0) then
 296     ComboBox1.ItemIndex := 0;
 297 end;
 298
 299 procedure TForm1.list;
 300 var
 301   i: Integer;
 302 begin
 303   with FDTable3 do
 304   begin
 305     First;
 306     while (Bof = false) or (Eof = false) do
 307       Delete;
 308     for i := 0 to ListBox1.Items.Count - 1 do
 309       AppendRecord([i, ListBox1.Items[i]]);
 310   end;
 311 end;
 312
 313 procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 314   State: TDragState; var Accept: Boolean);
 315 begin
 316   Accept := Source is TListBox;
 317 end;
 318
 319 procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
 320 var
 321   i: Integer;
 322 begin
 323   i := ListBox1.ItemAtPos(Point(X, Y), true);
 324   if ((X > 0) or (Y > 0)) and (i > -1) then
 325   begin
 326     ListBox1.Items.Move(item, i);
 327     itemsCopy;
 328   end;
 329 end;
 330
 331 procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
 332   Shift: TShiftState);
 333 var
 334   i: Integer;
 335 begin
 336   i := ListBox1.ItemIndex;
 337   if (Key = VK_DELETE) and (i > -1) and (ListBox1.Items[i] <> 'master') then
 338   begin
 339     ListBox1.Items.Delete(i);
 340     itemsCopy;
 341   end;
 342 end;
 343
 344 procedure TForm1.ListBox1StartDrag(Sender: TObject;
 345   var DragObject: TDragObject);
 346 begin
 347   item := ListBox1.ItemIndex;
 348 end;
 349
 350 procedure TForm1.SpeedButton1Click(Sender: TObject);
 351 var
 352   s: string;
 353 begin
 354   s := Edit2.Text;
 355   if (s <> '') and (ListBox1.Items.IndexOf(s) = -1) then
 356   begin
 357     ListBox1.Items.Add(s);
 358     ComboBox1.Items.Add(s);
 359     Edit2.Text := '';
 360     ListBox1.ItemIndex := ListBox1.Items.Count - 1;
 361   end;
 362 end;
 363
 364 procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
 365 begin
 366   FDTable2.FieldByName('count').AsInteger := UpDown1.Position;
 367 end;
 368
 369 end.