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, Vcl.Grids,
  17   Vcl.DBGrids,
  18   FireDAC.Phys.IB, FireDAC.Phys.IBDef, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
  19   Vcl.ComCtrls, Vcl.Buttons, FireDAC.Stan.StorageBin, FireDAC.Stan.StorageXML,
  20   Vcl.Imaging.jpeg;
  21
  22 type
  23   TForm1 = class(TForm)
  24     FDConnection1: TFDConnection;
  25     FDTable1: TFDTable;
  26     Button1: TButton;
  27     Button2: TButton;
  28     Button3: TButton;
  29     OpenPictureDialog1: TOpenPictureDialog;
  30     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
  31     DBGrid1: TDBGrid;
  32     Button4: TButton;
  33     FDQuery1: TFDQuery;
  34     Memo1: TMemo;
  35     CheckBox1: TCheckBox;
  36     Edit3: TEdit;
  37     Label2: TLabel;
  38     FDTable2: TFDTable;
  39     Edit4: TEdit;
  40     Button5: TButton;
  41     Edit5: TEdit;
  42     UpDown1: TUpDown;
  43     Edit6: TEdit;
  44     ComboBox1: TComboBox;
  45     Button6: TButton;
  46     Label3: TLabel;
  47     Bevel1: TBevel;
  48     ListBox1: TListBox;
  49     SpeedButton1: TSpeedButton;
  50     Edit2: TEdit;
  51     FDTable2title: TWideStringField;
  52     FDTable2title2: TWideStringField;
  53     FDTable2mente: TSmallintField;
  54     FDTable2info: TIntegerField;
  55     FDTable2count: TIntegerField;
  56     FDTable2password: TWideStringField;
  57     FDTable2ng: TWideStringField;
  58     FDTable3: TFDTable;
  59     FDTable3dbnum: TIntegerField;
  60     FDTable3database: TWideStringField;
  61     DataSource1: TDataSource;
  62     FDTable1id: TIntegerField;
  63     FDTable1name: TWideStringField;
  64     FDTable1source: TWideMemoField;
  65     Image1: TImage;
  66     Button7: TButton;
  67     Button8: TButton;
  68     OpenPictureDialog2: TOpenPictureDialog;
  69     procedure Button1Click(Sender: TObject);
  70     procedure Button4Click(Sender: TObject);
  71     procedure Button3Click(Sender: TObject);
  72     procedure FormCreate(Sender: TObject);
  73     procedure Button6Click(Sender: TObject);
  74     procedure Button5Click(Sender: TObject);
  75     procedure SpeedButton1Click(Sender: TObject);
  76     procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
  77       Shift: TShiftState);
  78     procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  79       State: TDragState; var Accept: Boolean);
  80     procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
  81     procedure ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
  82     procedure Button2Click(Sender: TObject);
  83     procedure Button7Click(Sender: TObject);
  84     procedure Button8Click(Sender: TObject);
  85   private
  86     { Private \90é\8c¾ }
  87     item: Integer;
  88     procedure combo;
  89     procedure list;
  90     procedure itemsCopy;
  91     procedure openPicture(mem: TStream; filename: string);
  92   public
  93     { Public \90é\8c¾ }
  94   end;
  95
  96 var
  97   Form1: TForm1;
  98
  99 implementation
 100
 101 uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
 102
 103 {$R *.dfm}
 104
 105 procedure TForm1.Button1Click(Sender: TObject);
 106 var
 107   i: Integer;
 108   s, s2: string;
 109   t: TMemoryStream;
 110 begin
 111   Button4Click(nil);
 112   if OpenPictureDialog1.Execute = true then
 113     with FDTable1 do
 114     begin
 115       t := TMemoryStream.Create;
 116       Image1.Picture.Graphic.SaveToStream(t);
 117       s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
 118       AppendRecord([1, 'BBS_bn.jpg', s]);
 119       t.Position := 0;
 120       Application.Icon.SaveToStream(t);
 121       s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
 122       AppendRecord([2, 'favicon64.ico', s]);
 123       t.Position := 0;
 124       i:=1;
 125       for s2 in OpenPictureDialog1.Files do
 126       begin
 127         openPicture(t, s2);
 128         s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
 129         AppendRecord([i+2, Format('slide%d.jpg', [i]), s]);
 130         inc(i);
 131       end;
 132       t.Free;
 133       Refresh;
 134     end;
 135 end;
 136
 137 procedure TForm1.Button2Click(Sender: TObject);
 138 begin
 139   if FDTable1.Exists = true then
 140     FDQuery1.ExecSQL('drop table images;');
 141   FDQuery1.ExecSQL;
 142 end;
 143
 144 procedure TForm1.Button3Click(Sender: TObject);
 145 var
 146   s: TMemoryStream;
 147   p: TBytes;
 148   j: TJpegImage;
 149   i: TIcon;
 150 begin
 151   if (FDTable1.Bof = true) or (FDTable1.Eof = true) then
 152     Exit;
 153   p := TNetEncoding.Base64.DecodeStringToBytes(FDTable1.FieldByName('source')
 154     .AsString);
 155   s := TMemoryStream.Create;
 156   s.WriteBuffer(p, Length(p));
 157   s.Position := 0;
 158   if ExtractFileExt(FDTable1.FieldByName('name').AsString) = '.ico' then
 159   begin
 160     i := TIcon.Create;
 161     i.LoadFromStream(s);
 162     Canvas.Draw(0, 0, i);
 163     i.Free;
 164   end
 165   else
 166   begin
 167     j := TJpegImage.Create;
 168     j.LoadFromStream(s);
 169     Canvas.Draw(0, 0, j);
 170     j.Free;
 171   end;
 172   s.Free;
 173 end;
 174
 175 procedure TForm1.Button4Click(Sender: TObject);
 176 begin
 177   with FDTable1 do
 178   begin
 179     while not((Bof = true) and (Eof = true)) do
 180       Delete;
 181     Refresh;
 182   end;
 183 end;
 184
 185 procedure TForm1.Button5Click(Sender: TObject);
 186 var
 187   i: Integer;
 188 begin
 189   Edit4.Text := '\82Æ\82é\82Ë\81`\82Ç\8d\86';
 190   Memo1.Lines.Text :=
 191     '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>';
 192   Edit3.Text := '\94n\8e,\88¢\95Û,\8e\80\82Ë,\8eE\82·';
 193   Edit6.Text := 'admin';
 194   ComboBox1.Text := 'info';
 195   UpDown1.Position := 30;
 196   CheckBox1.Checked := false;
 197   ListBox1.Items.Clear;
 198   ListBox1.Items.Add('info');
 199   ListBox1.Items.Add('master');
 200   for i := 1 to 10 do
 201     ListBox1.Items.Add('\8cf\8e¦\94Â' + i.ToString);
 202   list;
 203   itemsCopy;
 204 end;
 205
 206 procedure TForm1.Button6Click(Sender: TObject);
 207 var
 208   i: Integer;
 209   function hash(str: string): string;
 210   begin
 211     with TIdHashSHA1.Create do
 212     begin
 213       try
 214         result := HashStringAsHex(str);
 215       finally
 216         Free;
 217       end;
 218     end;
 219   end;
 220
 221 begin
 222   list;
 223   FDTable3.ApplyUpdates;
 224   FDTable3.CommitUpdates;
 225   with FDTable2 do
 226   begin
 227     Edit;
 228     if Edit6.Text <> '' then
 229       FieldByName('password').AsString := hash(hash(Edit6.Text));
 230     if CheckBox1.Checked = true then
 231       i := 1
 232     else
 233       i := 0;
 234     FieldByName('mente').AsInteger := i;
 235     if ComboBox1.Items.IndexOf(ComboBox1.Text) = -1 then
 236       ComboBox1.ItemIndex := 0;
 237     FieldByName('info').AsInteger := FDTable3.Lookup('database',
 238       ComboBox1.Text, 'dbnum');
 239     FieldByName('count').AsInteger := UpDown1.Position;
 240     Post;
 241     ApplyUpdates;
 242     CommitUpdates;
 243   end;
 244 end;
 245
 246 procedure TForm1.Button7Click(Sender: TObject);
 247 begin
 248   with OpenPictureDialog2 do
 249   begin
 250     FilterIndex := 0;
 251     if Execute = true then
 252       Image1.Picture.LoadFromFile(filename);
 253   end;
 254 end;
 255
 256 procedure TForm1.Button8Click(Sender: TObject);
 257 begin
 258   OpenPictureDialog2.FilterIndex := 7;
 259   if OpenPictureDialog2.Execute = true then
 260     Application.Icon.LoadFromFile(OpenPictureDialog2.filename);
 261 end;
 262
 263 procedure TForm1.combo;
 264 var
 265   i: Integer;
 266   s: string;
 267 begin
 268   ComboBox1.Items.Clear;
 269   with FDTable3 do
 270   begin
 271     First;
 272     while Eof = false do
 273     begin
 274       s := FieldByName('database').AsString;
 275       ComboBox1.Items.Add(s);
 276       Next;
 277     end;
 278     ComboBox1.Text := Lookup('dbnum', FDTable2.FieldByName('info').AsInteger,
 279       'database');
 280   end;
 281   ListBox1.Items.Text := ComboBox1.Items.Text;
 282   i := ComboBox1.Items.IndexOf('master');
 283   ComboBox1.Items.Delete(i);
 284 end;
 285
 286 procedure TForm1.FormCreate(Sender: TObject);
 287 begin
 288   FDQuery1.ExecSQL;
 289   FDTable1.Open;
 290   if FDTable2.Exists = false then
 291     FDTable2.CreateTable;
 292   FDTable2.Open;
 293   FDTable1.Refresh;
 294   FDTable2.Refresh;
 295   Edit4.Text := FDTable2.FieldByName('title').AsString;
 296   Memo1.Lines.Text := FDTable2.FieldByName('title2').AsString;
 297   Edit3.Text := FDTable2.FieldByName('ng').AsString;
 298   with FDTable3 do
 299   begin
 300     if Exists = false then
 301       CreateTable;
 302     Open;
 303     if (Bof = true) and (Eof = true) then
 304     begin
 305       list;
 306       ApplyUpdates;
 307       CommitUpdates;
 308     end;
 309     Refresh;
 310   end;
 311   combo;
 312   CheckBox1.Checked := FDTable2.FieldByName('mente').AsInteger = 1;
 313   UpDown1.Position := FDTable2.FieldByName('count').AsInteger;
 314 end;
 315
 316 procedure TForm1.itemsCopy;
 317 var
 318   i: Integer;
 319   s: string;
 320 begin
 321   ComboBox1.Items.Clear;
 322   for i := 0 to ListBox1.Items.Count - 1 do
 323   begin
 324     s := ListBox1.Items[i];
 325     if s <> 'master' then
 326       ComboBox1.Items.Add(s);
 327   end;
 328   if (ComboBox1.Items.IndexOf(ComboBox1.Text) = -1) and
 329     (ComboBox1.Items.Count > 0) then
 330     ComboBox1.ItemIndex := 0;
 331 end;
 332
 333 procedure TForm1.list;
 334 var
 335   i: Integer;
 336 begin
 337   with FDTable3 do
 338   begin
 339     First;
 340     while (Bof = false) or (Eof = false) do
 341       Delete;
 342     for i := 0 to ListBox1.Items.Count - 1 do
 343       AppendRecord([i, ListBox1.Items[i]]);
 344   end;
 345 end;
 346
 347 procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 348   State: TDragState; var Accept: Boolean);
 349 begin
 350   Accept := Source is TListBox;
 351 end;
 352
 353 procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
 354 var
 355   i: Integer;
 356 begin
 357   i := ListBox1.ItemAtPos(Point(X, Y), true);
 358   if ((X > 0) or (Y > 0)) and (i > -1) then
 359   begin
 360     ListBox1.Items.Move(item, i);
 361     itemsCopy;
 362   end;
 363 end;
 364
 365 procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
 366   Shift: TShiftState);
 367 var
 368   i: Integer;
 369 begin
 370   i := ListBox1.ItemIndex;
 371   if (Key = VK_DELETE) and (i > -1) and (ListBox1.Items[i] <> 'master') then
 372   begin
 373     ListBox1.Items.Delete(i);
 374     itemsCopy;
 375   end;
 376 end;
 377
 378 procedure TForm1.ListBox1StartDrag(Sender: TObject;
 379   var DragObject: TDragObject);
 380 begin
 381   item := ListBox1.ItemIndex;
 382 end;
 383
 384 procedure TForm1.openPicture(mem: TStream; filename: string);
 385 var
 386   jpg: TJpegImage;
 387   bmp: TBitmap;
 388 begin
 389   jpg := TJpegImage.Create;
 390   bmp := TBitmap.Create;
 391   try
 392     jpg.LoadFromFile(filename);
 393     bmp.Height := 465;
 394     bmp.Width := Trunc(465 * jpg.Width / jpg.Height);
 395     bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, 465), jpg);
 396     jpg.Assign(bmp);
 397     jpg.SaveToStream(mem);
 398     mem.Position := 0;
 399   finally
 400     jpg.Free;
 401     bmp.Free;
 402   end;
 403 end;
 404
 405 procedure TForm1.SpeedButton1Click(Sender: TObject);
 406 var
 407   s: string;
 408 begin
 409   s := Edit2.Text;
 410   if (s <> '') and (ListBox1.Items.IndexOf(s) = -1) then
 411   begin
 412     ListBox1.Items.Add(s);
 413     ComboBox1.Items.Add(s);
 414     Edit2.Text := '';
 415     ListBox1.ItemIndex := ListBox1.Items.Count - 1;
 416   end;
 417 end;
 418
 419 end.