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,
18 FireDAC.Phys.IB, FireDAC.Phys.IBDef, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
19 Vcl.ComCtrls, Vcl.Buttons, FireDAC.Stan.StorageBin, FireDAC.Stan.StorageXML,
24 FDConnection1: TFDConnection;
29 OpenPictureDialog1: TOpenPictureDialog;
30 FDGUIxWaitCursor1: TFDGUIxWaitCursor;
49 SpeedButton1: TSpeedButton;
51 FDTable2title: TWideStringField;
52 FDTable2title2: TWideStringField;
53 FDTable2mente: TSmallintField;
54 FDTable2info: TIntegerField;
55 FDTable2count: TIntegerField;
56 FDTable2password: TWideStringField;
57 FDTable2ng: TWideStringField;
59 FDTable3dbnum: TIntegerField;
60 FDTable3database: TWideStringField;
61 DataSource1: TDataSource;
62 FDTable1id: TIntegerField;
63 FDTable1name: TWideStringField;
64 FDTable1source: TWideMemoField;
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;
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);
91 procedure openPicture(mem: TStream; filename: string);
101 uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
105 procedure TForm1.Button1Click(Sender: TObject);
112 if OpenPictureDialog1.Execute = true then
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]);
120 Application.Icon.SaveToStream(t);
121 s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
122 AppendRecord([2, 'favion64.ico', s]);
125 for s2 in OpenPictureDialog1.Files do
128 s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
129 AppendRecord([i+2, Format('slide%d.jpg', [i]), s]);
137 procedure TForm1.Button2Click(Sender: TObject);
139 if FDTable1.Exists = true then
140 FDQuery1.ExecSQL('drop table images;');
144 procedure TForm1.Button3Click(Sender: TObject);
151 if (FDTable1.Bof = true) or (FDTable1.Eof = true) then
153 p := TNetEncoding.Base64.DecodeStringToBytes(FDTable1.FieldByName('source')
155 s := TMemoryStream.Create;
156 s.WriteBuffer(p, Length(p));
158 if ExtractFileExt(FDTable1.FieldByName('name').AsString) = '.ico' then
162 Canvas.Draw(0, 0, i);
167 j := TJpegImage.Create;
169 Canvas.Draw(0, 0, j);
175 procedure TForm1.Button4Click(Sender: TObject);
179 while not((Bof = true) and (Eof = true)) do
185 procedure TForm1.Button5Click(Sender: TObject);
189 Edit4.Text := '
\82Æ
\82é
\82Ë
\81`
\82Ç
\8d\86';
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');
201 ListBox1.Items.Add('
\8cf
\8e¦
\94Â' + i.ToString);
206 procedure TForm1.Button6Click(Sender: TObject);
209 function hash(str: string): string;
211 with TIdHashSHA1.Create do
214 result := HashStringAsHex(str);
223 FDTable3.ApplyUpdates;
224 FDTable3.CommitUpdates;
228 if Edit6.Text <> '' then
229 FieldByName('password').AsString := hash(hash(Edit6.Text));
230 if CheckBox1.Checked = true then
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;
246 procedure TForm1.Button7Click(Sender: TObject);
248 with OpenPictureDialog2 do
251 if Execute = true then
252 Image1.Picture.LoadFromFile(filename);
256 procedure TForm1.Button8Click(Sender: TObject);
258 OpenPictureDialog2.FilterIndex := 7;
259 if OpenPictureDialog2.Execute = true then
260 Application.Icon.LoadFromFile(OpenPictureDialog2.filename);
263 procedure TForm1.combo;
268 ComboBox1.Items.Clear;
274 s := FieldByName('database').AsString;
275 ComboBox1.Items.Add(s);
278 ComboBox1.Text := Lookup('dbnum', FDTable2.FieldByName('info').AsInteger,
281 ListBox1.Items.Text := ComboBox1.Items.Text;
282 i := ComboBox1.Items.IndexOf('master');
283 ComboBox1.Items.Delete(i);
286 procedure TForm1.FormCreate(Sender: TObject);
290 if FDTable2.Exists = false then
291 FDTable2.CreateTable;
295 Edit4.Text := FDTable2.FieldByName('title').AsString;
296 Memo1.Lines.Text := FDTable2.FieldByName('title2').AsString;
297 Edit3.Text := FDTable2.FieldByName('ng').AsString;
300 if Exists = false then
303 if (Bof = true) and (Eof = true) then
312 CheckBox1.Checked := FDTable2.FieldByName('mente').AsInteger = 1;
313 UpDown1.Position := FDTable2.FieldByName('count').AsInteger;
316 procedure TForm1.itemsCopy;
321 ComboBox1.Items.Clear;
322 for i := 0 to ListBox1.Items.Count - 1 do
324 s := ListBox1.Items[i];
325 if s <> 'master' then
326 ComboBox1.Items.Add(s);
328 if (ComboBox1.Items.IndexOf(ComboBox1.Text) = -1) and
329 (ComboBox1.Items.Count > 0) then
330 ComboBox1.ItemIndex := 0;
333 procedure TForm1.list;
340 while (Bof = false) or (Eof = false) do
342 for i := 0 to ListBox1.Items.Count - 1 do
343 AppendRecord([i, ListBox1.Items[i]]);
347 procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
348 State: TDragState; var Accept: Boolean);
350 Accept := Source is TListBox;
353 procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
357 i := ListBox1.ItemAtPos(Point(X, Y), true);
358 if ((X > 0) or (Y > 0)) and (i > -1) then
360 ListBox1.Items.Move(item, i);
365 procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
370 i := ListBox1.ItemIndex;
371 if (Key = VK_DELETE) and (i > -1) and (ListBox1.Items[i] <> 'master') then
373 ListBox1.Items.Delete(i);
378 procedure TForm1.ListBox1StartDrag(Sender: TObject;
379 var DragObject: TDragObject);
381 item := ListBox1.ItemIndex;
384 procedure TForm1.openPicture(mem: TStream; filename: string);
389 jpg := TJpegImage.Create;
390 bmp := TBitmap.Create;
392 jpg.LoadFromFile(filename);
394 bmp.Width := Trunc(465 * jpg.Width / jpg.Height);
395 bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, 465), jpg);
397 jpg.SaveToStream(mem);
405 procedure TForm1.SpeedButton1Click(Sender: TObject);
410 if (s <> '') and (ListBox1.Items.IndexOf(s) = -1) then
412 ListBox1.Items.Add(s);
413 ComboBox1.Items.Add(s);
415 ListBox1.ItemIndex := ListBox1.Items.Count - 1;