doris-dbcreate-table
/
Unit3.pas

unit Unit3;

interface

{$I 'buildConfig.inc'}

uses
  YxdJson,
  System.Generics.Collections,
  System.JSON, UI.Dialog,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async,
  FireDAC.Phys, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.FMXUI.Wait,
  FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client,
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, UI.Standard,
  FMX.Controls.Presentation, FMX.StdCtrls, UI.Base, UI.Edit, FMX.ScrollBox,
  FMX.Memo, UI.Toast, UI.Async, UI.Utils, FMX.ListBox, FMX.Edit, FMX.ComboEdit,
  FMX.Memo.Types, UI.ListView, FMX.Menus;

type
  TConnItem = class
    Conn: TFDConnection;
    Rs: TFDQuery;
    Id: Integer;
    T, RowCount: Int64;
    SQL: string;
    Args: JSONArray;
    _Josn: JSONObject;
    Err: string;
    CurArgs: string;
    FLog: TStringBuilder;
    FLastColIndex: Integer;
    FLogName: string;
    FUseArgs: Boolean;
    ShowData: Boolean;
    ResultData: string;
    ReqV: Boolean;
    ReqNum: Integer;
    ReCount: Integer;
  public
    constructor Create();
    destructor Destroy; override;
    procedure InitLog(const Name: string; ExecCountArgs: Boolean);
    procedure AddLog(const Msg: string; ColIndex: Integer);
  end;

type
  TItemData = class
    Name: string;
    DB: string;
    SQL: string;
    Args: string;   // 参数
    Selected: Boolean;
  end;

  TForm3 = class;
  TListDataAdapter = class(TListAdapter<TItemData>)
  private
    FOwner: TForm3;
    procedure DoSelectChange(Sender: TObject);
    procedure DoDeleteItem(Sender: TObject);
  protected
    function GetItem(const Index: Integer): Pointer; override;
    function GetView(const Index: Integer; ConvertView: TViewBase; Parent: TViewGroup): TViewBase; override;
    function ItemDefaultHeight: Single; override;
  public
  end;

  TForm3 = class(TForm)
    ViewGroup1: TViewGroup;
    EditView4: TEditView;
    Button1: TButton;
    TextView5: TTextView;
    EditView3: TEditView;
    TextView4: TTextView;
    TextView3: TTextView;
    EditView1: TEditView;
    TextView2: TTextView;
    TextView1: TTextView;
    EditView5: TEditView;
    TextView6: TTextView;
    ViewGroup2: TViewGroup;
    ViewGroup3: TViewGroup;
    edtLog: TMemo;
    Splitter1: TSplitter;
    Button3: TButton;
    TextView7: TTextView;
    cbSvrName: TComboBox;
    Timer1: TTimer;
    View1: TView;
    ckSpace: TCheckBox;
    edtSpace: TEditView;
    TextView8: TTextView;
    EditView6: TEditView;
    EditView2: TComboEdit;
    cbConfig: TComboEdit;
    TextView9: TTextView;
    Button4: TButton;
    Button5: TButton;
    ViewGroup4: TViewGroup;
    Splitter2: TSplitter;
    listSQL: TListViewEx;
    LinearLayout1: TLinearLayout;
    ButtonView1: TButtonView;
    ButtonView2: TButtonView;
    edtTitle: TEditView;
    btnChange: TButtonView;
    btnAdd: TButtonView;
    AniIndicator1: TAniIndicator;
    LinearLayout2: TLinearLayout;
    edtParams: TMemo;
    Splitter3: TSplitter;
    LinearLayout3: TLinearLayout;
    TextView10: TTextView;
    ButtonView3: TButtonView;
    Button2: TButtonView;
    CheckBox1: TCheckBox;
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    btnCopyNew: TButtonView;
    View2: TView;
    View3: TView;
    tvTime: TTextView;
    btnExecView: TButtonView;
    edtSQL: TMemo;
    SaveDialog1: TSaveDialog;
    View4: TView;
    edtNew: TButtonView;
    edtSaveAs: TButtonView;
    edtOpen: TButtonView;
    OpenDialog1: TOpenDialog;
    ckReqV: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure View1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
    procedure listSQLItemClick(Sender: TObject; ItemIndex: Integer;
      const ItemView: TControl);
    procedure ButtonView1Click(Sender: TObject);
    procedure ButtonView2Click(Sender: TObject);
    procedure ButtonView3Click(Sender: TObject);
    procedure MenuItem7Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure MenuItem3Click(Sender: TObject);
    procedure MenuItem5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnCopyNewClick(Sender: TObject);
    procedure btnExecViewClick(Sender: TObject);
    procedure ViewGroup1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edtSaveAsClick(Sender: TObject);
    procedure edtNewClick(Sender: TObject);
    procedure edtOpenClick(Sender: TObject);
  private
    { Private declarations }
    T: Int64;
    Count, ReCount, ExecRef: Integer;
    ExecCountArgs: Boolean;
    Items: TArray<TConnItem>;
    Space: Integer;
    FConfig, FConnConfig: JSONObject;

    FAdapter: TListDataAdapter;
    FSQLItems: TList<TItemData>;
    FCurSQL: TItemData;
    FExecuteing, FWaitStop: Boolean;
    FFileName: string;
  public
    { Public declarations }
    procedure Toast(const msg: string);
    procedure InitConnection(var conn: TFDConnection; var rs: TFDQuery; const Host: string);
    procedure ExecTest();
    procedure UpdateCaption();
    function GetHostItems(): TArray<string>;
    function GetFirstHost(): string;
    procedure LoadConfig;
    procedure SaveConfig(UpdateForm: Boolean = False);
    procedure LoadSQLItems(const AFileName: string);
    procedure SaveSQLItems(const AFileName: string);
    procedure AddSQL(const Name, SQL, Args: string);
    procedure ChangeCurSQL(Index: Integer; CheckChange: Boolean = True);
    procedure DeleteCurSQL();
    procedure ExecuteSQL(const ACount, AReCount: Integer;
      const ASQL, AArgs: string; ShowData: Boolean = False);
    procedure RestBtnExec();
  end;

var
  Form3: TForm3;

implementation

{$R *.fmx}

uses
  Unit1, Unit5;

procedure TForm3.AddSQL(const Name, SQL, Args: string);
begin
  if not Assigned(FCurSQL) then begin
    FCurSQL := TItemData.Create;
    FCurSQL.Selected := True;
    FSQLItems.Add(FCurSQL);
  end;
  FCurSQL.Name := Name;
  FCurSQL.SQL := SQL;
  FCurSQL.Args := Args;
  if cbSvrName.Selected <> nil then begin
    FCurSQL.DB := cbSvrName.Selected.Text;
  end;
  if Assigned(FAdapter) then
    FAdapter.NotifyDataChanged;
end;

procedure TForm3.btnChangeClick(Sender: TObject);
begin
  AddSQL(edtTitle.Text, edtSQL.Text, edtParams.Text);
end;

procedure TForm3.btnCopyNewClick(Sender: TObject);
begin
  FCurSQL := nil;
  if Trim(edtTitle.Text) = '' then
    edtTitle.Text := '未命名[副本]'
  else
    edtTitle.Text := edtTitle.Text + '[副本]';
  btnChangeClick(btnChange);
end;

procedure TForm3.btnNewClick(Sender: TObject);
begin
  FCurSQL := nil;
  edtTitle.Text := '';
  edtSQL.Text := '';
  edtParams.Text := '';
end;

procedure TForm3.Button1Click(Sender: TObject);
var
  List: TStrings;
  Conn: TFDConnection;
  Rs: TFDQuery;
begin
  InitConnection(Conn, Rs, GetFirstHost);
  try
    try
      Conn.Open();
      if Conn.Connected then begin
        Toast('刷新成功');
        RS.Open('SHOW DATABASES;');
        List := TStringList.Create;
        try
          if RS.Active then begin
            RS.First;
            while not RS.Eof do begin
              List.Add(RS.FieldByName('Database').AsString);
              RS.Next;
            end;
          end;
          cbSvrName.Items.Clear;
          cbSvrName.Items.AddStrings(List);
        finally
          FreeAndNil(List);
        end;
      end;
    except on E: Exception do
      Toast(e.Message);
    end;
  finally
    FreeAndNil(Rs);
    FreeAndNil(Conn);
  end;
end;

procedure TForm3.Button2Click(Sender: TObject);
var
  I: Integer;
begin
  if Button2.Tag = 0 then begin
    Button2.Tag := 1;
    FWaitStop := False;
    ExecuteSQL(StrToIntDef(EditView5.Text, 1), StrToIntDef(EditView6.Text, 1), edtSQL.Text, edtParams.Text);
    if Button2.Tag = 1 then begin
      TViewBrush(Button2.Drawable.ItemDefault).Accessory.Accessory := TViewAccessoryType.Stop;
      Button2.Enabled := True;
      Button2.Hint := '停止执行';
    end;
  end else if Button2.Tag = 1 then begin
    FWaitStop := True;
    for I := 0 to High(Items) do begin
      try

      except
      end;
    end;
  end;
end;

procedure TForm3.Button3Click(Sender: TObject);
begin
  EditView1.Text := Form1.EditView1.Text;
  EditView2.Text := Form1.EditView2.Text;
  EditView3.Text := Form1.EditView3.Text;
  EditView4.Text := Form1.EditView4.Text;
end;

procedure TForm3.Button4Click(Sender: TObject);
var
  Item: JSONObject;
  Key: string;
begin
  Key := cbConfig.Text.Trim;
  if Key = '' then
    Exit;
  Item := FConnConfig.O[Key];
  if Item = nil then
    Item := FConnConfig.AddChildObject(Key);
  Item.S['Host'] := EditView1.Text.Trim;
  Item.S['Port'] := EditView2.Text.Trim;
  Item.S['User'] := EditView3.Text.Trim;
  Item.S['Pwd'] := EditView4.Text.Trim;
  SaveConfig;
  if cbConfig.Items.IndexOf(Key) < 0 then
    cbConfig.Items.Add(Key);
end;

procedure TForm3.Button5Click(Sender: TObject);
var
  Item: JSONObject;
begin
  if cbConfig.Text.Trim = '' then
    Exit;
  Item := FConnConfig.O[cbConfig.Text.Trim];
  if Item = nil then Exit;
  EditView1.Text := Item.S['Host'];
  EditView2.Text := Item.S['Port'];
  EditView3.Text := Item.S['User'];
  EditView4.Text := Item.S['Pwd'];
end;

procedure TForm3.ButtonView1Click(Sender: TObject);
begin
  btnChangeClick(btnChange);
  if (FFileName = '') and SaveDialog1.Execute then
    FFileName := SaveDialog1.FileName;
  Self.SaveSQLItems(FFileName);
  UpdateCaption();
end;

procedure TForm3.ButtonView2Click(Sender: TObject);
var
  I: Integer;
  Item: TItemData;
begin
  ButtonView2.Enabled := False;
  btnExecView.Enabled := False;
  btnAdd.Enabled := False;
  edtTitle.ReadOnly := True;
  edtSQL.ReadOnly := True;
  AniIndicator1.Enabled := True;
  AniIndicator1.Visible := True;
  try
    for I := 0 to FSQLItems.Count - 1 do begin
      Item := FSQLItems[I];
      if not Item.Selected then
        Continue;
      ChangeCurSQL(I);
      Sleep(10);
      FExecuteing := True;
      Button2Click(Button2);
      while FExecuteing do begin
        Sleep(60);
        Application.ProcessMessages;
      end;
    end;
  finally
    AniIndicator1.Enabled := False;
    AniIndicator1.Visible := False;
    ButtonView2.Enabled := True;
    btnAdd.Enabled := True;
    btnExecView.Enabled := True;
    edtTitle.ReadOnly := False;
    edtSQL.ReadOnly := False;
  end;
  Toast('所有脚本执行完成.');
end;

procedure TForm3.ButtonView3Click(Sender: TObject);
begin
  edtParams.Text := '['+sLineBreak+'"set @id=1;set @name=\''名称\'';",'+sLineBreak+'"set @id=2;"'+sLineBreak+']';
end;

procedure TForm3.btnExecViewClick(Sender: TObject);
begin
  ExecuteSQL(1, 1, edtSQL.Text, edtParams.Text, True);
end;

procedure TForm3.ChangeCurSQL(Index: Integer; CheckChange: Boolean);
var
  Item: TItemData;
  I: Integer;
begin
  Item := FSQLItems[Index];

  if CheckChange then begin
    if (FCurSQL <> nil) or ((edtTitle.Text <> '') or (edtSQL.Text <> '')) then begin
      AddSQL(edtTitle.Text, edtSQL.Text, edtParams.Text);
    end;
  end;

  edtTitle.Text := Item.Name;
  edtSQL.Text := Item.SQL;
  edtParams.Text := Item.Args;
  if Item.DB <> '' then begin
    I := cbSvrName.Items.IndexOf(Item.DB);
    if I >= 0 then
      cbSvrName.ItemIndex := I
    else begin
      cbSvrName.items.add(Item.DB);
      cbSvrName.ItemIndex := cbSvrName.Count - 1;
    end;
  end;
  if FCurSQL <> Item then begin
    FCurSQL := Item;
    if Assigned(FAdapter) then
      FAdapter.NotifyDataChanged;
  end;
end;

procedure TForm3.DeleteCurSQL();
var
  I: Integer;
begin
  if FCurSQL = nil then Exit;
  I := FSQLItems.IndexOf(FCurSQL);
  FSQLItems.Remove(FCurSQL);
  FAdapter.NotifyDataChanged;
  FCurSQL := nil;
  if FSQLItems.Count = 0 then begin
    if Assigned(FAdapter) then
      FAdapter.NotifyDataChanged;
    btnNewClick(btnAdd);
  end else if I >= FSQLItems.Count then
    ChangeCurSQL(FSQLItems.Count - 1, False)
  else
    ChangeCurSQL(I, False);
end;

procedure TForm3.edtNewClick(Sender: TObject);
begin
  FFileName := '';
  btnNewClick(Sender);
  UpdateCaption();
end;

procedure TForm3.edtOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    LoadSQLItems(OpenDialog1.FileName);
end;

procedure TForm3.edtSaveAsClick(Sender: TObject);
begin
  btnChangeClick(btnChange);
  if FFileName <> '' then
    SaveDialog1.FileName := FFileName;
  if SaveDialog1.Execute then
    FFileName := SaveDialog1.FileName
  else
    Exit;
  Self.SaveSQLItems(FFileName);
  UpdateCaption();
end;

procedure TForm3.ExecTest();
var
  I, Ref, Tag: Integer;
  Item: TConnItem;
begin
  Ref := Count;
  Inc(ExecRef);
  Dec(ReCount);
  Toast('开始执行...(' + IntToStr(ExecRef) + ')');
  T := CurrentTimeMillis();
  Timer1.Enabled := True;
  for I := 0 to Count - 1 do begin
    Item := Items[I];
    if ExecCountArgs and (Item.Args <> nil) then begin
      if Item.ReqV then begin
        Tag := (ExecRef - 1) div (Item.ReCount div Item.Args.Count) mod Item.Args.Count
      end else begin
        Tag := (ExecRef - 1) mod Item.Args.Count
      end;
    end else
      Tag := ExecRef - 1;
    TAsync
      .Create()
      .SetData(Pointer(Item))
      .SetTag(Tag)
      .SetExecute(procedure (Async: TAsync)
      var
        T: Int64;
        I, J: Integer;
        Item: TConnItem;
        Args: JSONArray;
        SB: TStringBuilder;
        Rs: TFDDataSet;
        S: string;
        V: Variant;
      begin
        Item := TConnItem(Async.Data);
        Item.CurArgs := '';
        Item.ResultData := '';
        if Space > 0 then
          Sleep(Space * Item.Id);
        T := CurrentTimeMillis();
        try
          if Item.Conn.Connected then begin
            Args := TConnItem(Async.Data).Args;
            S := '';
            if (Args <> nil) and (Async.Tag < Args.Count) then begin
              // 使用参数
              S := Trim(Args.Items[Integer(Async.Tag)].AsString);
              if S.Substring(S.Length - 1, 1) <> ';' then
                S := S + ';';
              Item.CurArgs := S;
              S := S + sLineBreak;
            end;
            S := S + TConnItem(Async.Data).SQL;
            try
              T := CurrentTimeMillis();
              Item.Rs.Open(S);
              if Item.Rs.Active then begin
                Item.RowCount := Item.Rs.RecordCount;
                Item.Rs.First;
                if Item.ShowData then begin
                  // 显示数据，生成一个 MarkDown 表格
                  SB := TStringBuilder.Create();
                  try
                    SB.Append(sLineBreak).Append(sLineBreak).Append(Item.FLogName);
                    SB.Append(' - 返回结果:');

                    while Item.Rs.Active do begin
                      Rs := Item.Rs;
                      SB.Append(sLineBreak).Append('`RowCount`: ').Append(Rs.RecordCount);
                      SB.Append(sLineBreak).Append('| ');
                      for I := 0 to Rs.Fields.Count - 1 do begin
                        SB.Append(Rs.Fields[I].FieldName).Append(' |');
                      end;
                      SB.Append(sLineBreak).Append('| ');
                      for I := 0 to Rs.Fields.Count - 1 do
                        SB.Append(' --- |');
                      while not Rs.Eof do begin
                        SB.Append(sLineBreak).Append('|');
                        for I := 0 to Rs.Fields.Count - 1 do begin
                          V := Rs.FieldValues[Rs.Fields[I].FieldName];
                          if VarIsNull(V) then
                            SB.Append(' ').Append('').Append(' |')
                          else begin
                            S := V;
                            SB.Append(' ').Append(S.Replace('|', '&#124;')).Append(' |');
                          end;
                        end;
                        Rs.Next;
                      end;
                      SB.Append(sLineBreak);
                      Item.Rs.NextRecordSet;
                    end;

                    Item.ResultData := SB.ToString;
                  finally
                    FreeAndNil(SB);
                  end;
                end;
              end else begin
                TConnItem(Async.Data).Err := '执行失败';
              end;
            except
              try
                T := CurrentTimeMillis();
                Item.RowCount := Item.Conn.ExecSQL(S, []);
                Item.ResultData := '无结果集返回';
              except
                raise
              end;
            end;
            TConnItem(Async.Data).T := CurrentTimeMillis() - T;
          end;
        except
          TConnItem(Async.Data).T := CurrentTimeMillis() - T;
          TConnItem(Async.Data).Err := Exception(ExceptObject).Message;
        end;
      end)
      .SetExecuteComplete(procedure (Async: TAsync)
        var
          item: TConnItem;
          I: Integer;
        begin
          item := TConnItem(Async.Data);
          if Item.ShowData and (Item.ResultData <> '') then
            Toast(Item.ResultData);
          if Item.Err <> '' then begin
            Item.AddLog(Format('%d (Err)', [Item.T]), Async.Tag);
            if Item.CurArgs <> '' then
              Toast(Format('ID: %d, Args: %s, Error: %s, Time: %d', [Item.Id, Item.CurArgs, Item.Err, Item.T]))
            else
              Toast(Format('ID: %d, Error: %s, Time: %d', [Item.Id, Item.Err, Item.T]));
          end else begin
            Item.AddLog(Format('%d', [Item.T]), Async.Tag);
            if Item.CurArgs <> '' then
              Toast(Format('ID: %d, OK. ( %d ms, RowCount: %d, Args: %s )', [Item.Id, Item.T, Item.RowCount, Item.CurArgs]))
            else
              Toast(Format('ID: %d, OK. ( %d ms, RowCount: %d )', [Item.Id, Item.T, Item.RowCount]));
          end;
          if ReCount <= 0 then begin
            for I := 0 to High(Items) do begin
              if Items[I] = Item then
                Items[I] := nil;
            end;
            Item.FLog.Append(sLineBreak);
            Toast(Item.FLog.ToString);
            Item.Free;
          end;
          Dec(Ref);
          if Ref <= 0 then begin
            tvTime.Text := '';
            if ReCount > 0 then begin
              Button2.Enabled := False;
              btnExecView.Enabled := False;
              Sleep(100);
              Item.Err := '';
              if not FWaitStop then
                ExecTest();
            end else begin
              Toast('Execute Finish.');
              RestBtnExec();
              btnExecView.Enabled := True;
              Timer1.Enabled := False;
              FExecuteing := False;
            end;
          end;

          if FWaitStop then begin
            Toast('已停止执行脚本');
            for I := 0 to High(Items) do begin
              FreeAndNil(Item);
            end;
          end;
      end)
      .Execute;
  end;
end;

procedure TForm3.ExecuteSQL(const ACount, AReCount: Integer; const ASQL, AArgs: string; ShowData: Boolean);
var
  I, J, H: Integer;
  Item: TConnItem;
  SQL, Database: string;
  Hosts: TArray<string>;
  Args: JSONArray;
  JSON: JSONObject;
begin
  if cbSvrName.Selected = nil then begin
    Toast('请选择数据库');
    FExecuteing := False;
    Exit;
  end;
  Hosts := GetHostItems;
  if (Length(Hosts) = 0) or (Hosts[0].Trim = '') then begin
    Toast('请配置服务器连接信息');
    FExecuteing := False;
    Exit;
  end;
  Button2.Enabled := False;
  btnExecView.Enabled := False;
  try
    Toast('建立连接...');
    Space := 0;
    Count := ACount;
    ReCount := AReCount;
    ExecCountArgs := False;
    ExecRef := 0;
    H := 0;
    SQL := ASQL;
    Args := nil;
    JSON := nil;
    if Trim(StringReplace(AArgs, sLineBreak, '', [rfReplaceAll])) <> '' then begin
      JSON := JSONObject.Create;
      try
        JSON.Parse('{"args":' + AArgs + '}');
        Args := JSON.A['args'];
        if Assigned(Args) and CheckBox1.IsChecked then begin
          ReCount := ReCount * Args.Count;
          ExecCountArgs := True;
        end;
      except
        FreeAndNil(JSON);
      end;
    end;
    Database := cbSvrName.Selected.Text;
    if (ckSpace.IsChecked) and (edtSpace.Text <> '') then
      Space := StrToIntDef(edtSpace.Text, 0);
    SetLength(Items, Count);
    for I := 0 to Count - 1 do
      Items[i] := nil;
    for I := 0 to Count - 1 do begin
      Item := TConnItem.Create;
      Items[I] := Item;
      InitConnection(Item.conn, Item.rs, Hosts[H]);
      Item.Conn.Params.Database := Database;
      Item.SQL := SQL;
      Item.Id := I;
      Item.T := 0;
      Item.RowCount := 0;
      Item.Err := '';
      if (I = 0) then Item._Josn := Json;
      Item.Args := Args;
      Item.ShowData := ShowData;
      Item.ReqV := ckReqV.IsChecked;
//      if ckReqNum.IsChecked then
//        Item.ReqNum := StrToIntDef(edtReqNum.Text, 0)
//      else
//        Item.ReqNum := 0;
      Item.ReCount := ReCount;
      Item.InitLog(edtTitle.Text.Trim(), ExecCountArgs);
      Inc(H);
      if H > High(Hosts) then
        H := 0;
      try
        Item.Conn.Open();
      except
        try
          for J := 0 to Count - 1 do begin
            FreeAndNil(Items[J]);
            Items[J] := nil;
          end;
        except
        end;
        raise;
      end;
      Application.ProcessMessages;
    end;

    ExecTest();
  except
    Toast(Exception(ExceptObject).Message);
    Timer1.Enabled := False;
    RestBtnExec();
    btnExecView.Enabled := True;
    tvTime.Text := '';
    FExecuteing := False;
  end;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveConfig(True);
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  {$IFDEF SQLTool}
  Button3.Visible := False;
  {$ENDIF}

  FConfig := JSONObject.Create;
  LoadConfig();

  FSQLItems := TList<TItemData>.Create();

  FAdapter := TListDataAdapter.Create(FSQLItems);
  FAdapter.FOwner := Self;
  listSQL.Adapter := FAdapter;
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FSQLItems);
end;

procedure TForm3.FormShow(Sender: TObject);
begin
  if FFileName = '' then
    FFileName := SaveDialog1.FileName;
  LoadSQLItems(FFileName);
end;

function TForm3.GetFirstHost: string;
var
  Items: TArray<string>;
begin
  Items := GetHostItems();
  if Length(Items) = 0 then
    Result := ''
  else
    Result := Items[0].Trim;
end;

function TForm3.GetHostItems: TArray<string>;
var
  S: TStrings;
begin
  S := TStringList.Create;
  try
    S.Delimiter := ',';
    S.DelimitedText := EditView1.Text.Trim;
    Result := S.ToStringArray;
  finally
    S.Free;
  end;
end;

procedure TForm3.InitConnection(var conn: TFDConnection; var rs: TFDQuery; const Host: string);
begin
  conn := TFDConnection.Create(Self);
  conn.Params.Add('DriverID=MySQL');
  conn.Params.Add('LoginTimeout=60');
  conn.Params.Add('CharacterSet=gbk');
  conn.LoginPrompt := False;
  conn.FetchOptions.AutoClose := False;

  TFDPhysMySQLConnectionDefParams(conn.Params).Server := Host;
  TFDPhysMySQLConnectionDefParams(conn.Params).Port := StrToIntDef(EditView2.Text, 3306);
  conn.Params.UserName := EditView3.Text.Trim;
  conn.Params.Password := EditView4.Text;

  rs := TFDQuery.Create(Self);
  rs.AutoCalcFields := False;
  rs.Connection := conn;
  rs.FetchOptions.AssignedValues := [evMode, evItems, evDetailOptimize];
  rs.FetchOptions.Mode := fmAll;
  rs.FetchOptions.Items := [fiBlobs, fiDetails];
  rs.FormatOptions.StrsTrim2Len := True;
  rs.FetchOptions.DetailOptimize := False;
  rs.ResourceOptions.AssignedValues := [rvParamExpand];
  rs.ResourceOptions.ParamExpand := False;
  rs.UpdateOptions.AssignedValues := [uvEDelete, uvEInsert, uvEUpdate];
  rs.UpdateOptions.EnableDelete := False;
  rs.UpdateOptions.EnableInsert := False;
  rs.UpdateOptions.EnableUpdate := False;
end;

procedure TForm3.listSQLItemClick(Sender: TObject; ItemIndex: Integer;
  const ItemView: TControl);
begin
  ChangeCurSQL(ItemIndex);
end;

procedure TForm3.LoadConfig;
var
  S: TStrings;
  I: Integer;
  Item, JSON: JSONObject;
begin
  if not Assigned(FConfig) then begin
    FConfig := JSONObject.Create;
  end;
  try
    S := TStringList.Create;
    try
      S.LoadFromFile('config.test.json');
      FConfig.Parse(S.Text);
      Json := FConfig;
      if Json.Exist('form') then begin
        Item := Json.O['form'];
        EditView1.Text := Item.S['e1'];
        EditView2.Text := Item.S['e2'];
        EditView3.Text := Item.S['e3'];
        EditView4.Text := Item.S['e4'];
        FFileName := Item.S['file'];
        Json := Json.O['conn'];
        if not Assigned(Json) then
          Json := FConfig.AddChildObject('conn');
        FConnConfig := Json;
      end else begin
        FreeAndNil(FConfig);
        FConfig := JSONObject.Create;
        FConfig.AddChildObject('form');
        FConnConfig := FConfig.AddChildObject('conn');
        FConnConfig.Parse(S.Text);
        Json := FConnConfig;
      end;
      for I := 0 to Json.Count - 1 do begin
        if JSON.Items[i].FType = JSONDataType.jdtObject then begin
          cbConfig.Items.Add(Json.Items[I].FName);
        end;

//        if Json.Pairs[I].JsonValue is TJSONObject then begin
//          cbConfig.Items.Add(Json.Get(I).JsonString.Value);
//        end;
      end;
    finally
      S.Free;
    end;
  except on E: Exception do
    begin
      FConfig.AddChildObject('form');
      FConnConfig := FConfig.AddChildObject('conn');
    end;
  end;
end;

procedure TForm3.LoadSQLItems(const AFileName: string);
var
  S: TStrings;
  I, J: Integer;
  Json, Item: JSONObject;
  Items: JSONArray;
  V: TItemData;
begin
  Json := JSONObject.Create;
  try
    S := TStringList.Create;
    try
      S.LoadFromFile(AFileName);
      Json.Parse(S.Text);
      Items := Json.A['items'];
      FSQLItems.Clear;
      for I := 0 to Items.Count - 1 do begin
        if Items[I].FType = JSONDataType.jdtObject then begin
          Item := Items[I].AsJsonObject;
          V := TItemData.Create;
          V.Name := Item.S['name'];
          V.SQL := Item.S['sql'];
          V.Selected := Item.B['sel'];
          V.DB := Item.S['db'];
          V.Args := Item.S['args'];
          FSQLItems.Add(V);
        end;
      end;

      J := Json.I['index'];
      if (J >= 0) and (J < FSQLItems.Count) then begin
        FCurSQL := FSQLItems[J];
        ChangeCurSQL(J, False);
      end;
    finally
      S.Free;
      if Assigned(FAdapter) then
        FAdapter.NotifyDataChanged;
    end;
  except on E: Exception do
  end;
  Json.Free;
  FFileName := AFileName;
  UpdateCaption();
end;

procedure TForm3.MenuItem1Click(Sender: TObject);
var
  I: Integer;
begin
  if FCurSQL = nil then Exit;
  I := FSQLItems.IndexOf(FCurSQL);
  if I <= 0 then Exit;
  FSQLItems.Move(I, 0);
  if Assigned(FAdapter) then
    FAdapter.NotifyDataChanged;
end;

procedure TForm3.MenuItem2Click(Sender: TObject);
var
  I: Integer;
begin
  if FCurSQL = nil then Exit;
  I := FSQLItems.IndexOf(FCurSQL);
  if (I < 0) or (I >= FSQLItems.Count - 1) then Exit;
  FSQLItems.Move(I, FSQLItems.Count - 1);
  if Assigned(FAdapter) then
    FAdapter.NotifyDataChanged;
end;

procedure TForm3.MenuItem3Click(Sender: TObject);
var
  I: Integer;
begin
  if FCurSQL = nil then Exit;
  I := FSQLItems.IndexOf(FCurSQL);
  if I <= 0 then Exit;
  FSQLItems.Move(I, I - 1);
  if Assigned(FAdapter) then
    FAdapter.NotifyDataChanged;
end;

procedure TForm3.MenuItem5Click(Sender: TObject);
var
  I: Integer;
begin
  if FCurSQL = nil then Exit;
  I := FSQLItems.IndexOf(FCurSQL);
  if (I < 0) or (I >= FSQLItems.Count - 1) then Exit;
  FSQLItems.Move(I, I + 1);
  if Assigned(FAdapter) then
    FAdapter.NotifyDataChanged;
end;

procedure TForm3.MenuItem7Click(Sender: TObject);
begin
  DeleteCurSQL();
end;

procedure TForm3.RestBtnExec;
begin
  if Button2.Tag = 1 then begin
    TViewBrush(Button2.Drawable.ItemDefault).Accessory.Accessory := TViewAccessoryType.ArrowRight;
    Button2.Tag := 0;
    Button2.Enabled := True;
    Button2.Hint := '执行SQL脚本';
  end else begin
    Button2.Tag := 0;
    Button2.Enabled := True;
  end;
end;

procedure TForm3.SaveConfig(UpdateForm: Boolean);
var
  S: TStrings;
  V: JSONObject;
begin
  S := TStringList.Create;
  try
    if UpdateForm then begin
      V := FConfig.O['form'];
      V.S['e1'] := EditView1.Text;
      V.S['e2'] := EditView2.Text;
      V.S['e3'] := EditView3.Text;
      V.S['e4'] := EditView4.Text;
      V.S['file'] := FFileName;
    end;
    S.Text := FConfig.ToString();
    S.SaveToFile('config.test.json');
  finally
    S.Free;
  end;
end;

procedure TForm3.SaveSQLItems(const AFileName: string);
var
  S: TStrings;
  Json, Item: JSONObject;
  V: TItemData;
  Items: JSONArray;
  I: Integer;
begin
  S := TStringList.Create;
  Json := JsonObject.Create;
  try
    if FCurSQL <> nil then begin
      Json.I['index'] := FSQLItems.IndexOf(FCurSQL)
    end else begin
      Json.I['index'] := -1;
    end;
    Items := Json.AddChildArray('items');
    for I := 0 to FSQLItems.Count - 1 do begin
      V := FSQLItems[I];
      Item := Items.AddChildObject();
      Item.S['name'] := V.Name;
      Item.S['db'] := V.DB;
      Item.B['sel'] := V.Selected;
      Item.S['sql'] := V.SQL;
      Item.S['args'] := V.Args;
    end;
    S.Text := Json.ToString();
    S.SaveToFile(AFileName);
  finally
    S.Free;
    Json.Free;
  end;
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
  tvTime.Text := Format('%d ms', [CurrentTimeMillis() - T])
end;

procedure TForm3.Toast(const msg: string);
begin
  edtLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:mm:ss.zzz', Now()), msg]));
end;

procedure TForm3.UpdateCaption;
var
  S: string;
begin
  if FFileName = '' then
    S := '未保存'
  else
    S := FFileName;
  Caption := Format('MySQL 性能测试工具 - %s', [S]);
end;

procedure TForm3.View1Click(Sender: TObject);
begin
  edtLog.Lines.Clear;
end;

procedure TForm3.ViewGroup1Click(Sender: TObject);
begin

end;

{ TConnItem }

procedure TConnItem.AddLog(const Msg: string; ColIndex: Integer);
var
  I: Integer;
  S: string;
begin
  if FUseArgs then begin
    // 有参数
    if ReqV then begin
      I := FLastColIndex;
      if (I <> ColIndex) then begin
        FLastColIndex := -1;
        I := -1;
      end;
      FLastColIndex := ColIndex;
      if I < 0 then begin
        S := Trim(Args.Items[ColIndex].AsString).Replace('|', '&#124;');
        FLog.Append(sLineBreak).Append('| ').Append(S).Append(' |');
      end;
      FLog.Append(' ').Append(Msg.Trim()).Append(' |');
    end else begin
      I := FLastColIndex;
      if ColIndex <= FLastColIndex then begin
        FLastColIndex := -1;
        I := FLastColIndex;
      end;
      FLastColIndex := ColIndex;
      if I < 0 then begin
        FLog.Append(sLineBreak).Append('| ');
      end;
      FLog.Append(' ').Append(Msg.Trim()).Append(' |');
    end
  end else begin
    // 无参数
    FLog.Append(sLineBreak).Append('| ').Append(ColIndex + 1).Append(' | ').Append(Msg.Trim()).Append(' |');
  end;
end;

constructor TConnItem.Create;
begin
  FLog := TStringBuilder.Create();
end;

destructor TConnItem.Destroy;
begin
  if (Rs <> nil) and Rs.Active then
    Rs.Close;
  if (Conn <> nil) and (Conn.Connected) then
    Conn.Close;
  FreeAndNil(Rs);
  FreeAndNil(Conn);
  FreeAndNil(_Josn);
  Args := nil;
  FreeAndNil(FLog);
  inherited;
end;


procedure TConnItem.InitLog(const Name: string; ExecCountArgs: Boolean);
var
  I, J: Integer;
  S: string;
begin
  FLog.Clear;
  FLog.Append(sLineBreak).Append(sLineBreak).Append(Name)
    .Append(' - 用时汇总日志').Append(sLineBreak).Append('| ');
  FLogName := Name.Replace('|', '&#124;');
  FUseArgs := (Args <> nil) and (Args.Count > 0) and ExecCountArgs;
  if FUseArgs then begin
    if ReqV then begin
      // 竖排参数
      FLog.Append(' 参数 | ');
      J := ReCount div Args.Count;
      for I := 0 to J - 1 do
        FLog.Append(' 用时').Append(I + 1).Append(' |');
      FLog.Append(sLineBreak).Append('| --- |');
      for I := 0 to J - 1 do
        FLog.Append(' --- |');
    end else begin
      // 横排参数
      for I := 0 to Args.Count - 1 do begin
        S := Trim(Args.Items[I].AsString).Replace('|', '&#124;');
        if S.Substring(0, 4).ToLower = 'set ' then
          S := S.Substring(4);
        FLog.Append(S).Append(' | ')
      end;
      FLog.Append(sLineBreak).Append('| ');
      for I := 0 to Args.Count - 1 do
        FLog.Append(' --- |');
    end;
  end else begin
    FLog.Append(' 序号 | 用时(ms) |').Append(sLineBreak);
    FLog.Append('| --- | --- |');
  end;
  FLastColIndex := -1;
end;

{ TListDataAdapter }

procedure TListDataAdapter.DoDeleteItem(Sender: TObject);
var
  V: TItemData;
begin
  V := Items[TControl(Sender).Tag];
  if (V = FOwner.FCurSQL) then begin
    TASync.Create().SetExecuteComplete(procedure (Async: TAsync) begin
      FOwner.DeleteCurSQL();
    end).Execute;
  end else begin
    FOwner.FSQLItems.Remove(V);
    TASync.Create().SetExecuteComplete(procedure (Async: TAsync) begin
      FOwner.FAdapter.NotifyDataChanged;
    end).Execute;
  end;
end;

procedure TListDataAdapter.DoSelectChange(Sender: TObject);
var
  V: TItemData;
begin
  V := Items[TControl(Sender).Tag];
  V.Selected := TCheckBox(Sender).IsChecked;
end;

function TListDataAdapter.GetItem(const Index: Integer): Pointer;
begin
  Result := Items[Index];
end;

function TListDataAdapter.GetView(const Index: Integer; ConvertView: TViewBase;
  Parent: TViewGroup): TViewBase;
var
  Item: TItemData;
  View: TFrame5;
begin
  Item := Items[Index];
  if (ConvertView = nil) or (ConvertView.ClassName <> TFrame5.ClassName) then begin
    View := TFrame5.Create(Parent);
    View.Parent := Parent;
    View.Width := Parent.Width;
    View.Height := ItemDefaultHeight;
    View.CanFocus := False;
  end else
    View := TFrame5(ConvertView);
  View.Tag := Index;

  View.cbName.Tag := Index;
  View.cbName.Text := '';
  View.cbName.OnChange := DoSelectChange;
  View.cbName.IsChecked := Item.Selected;

  View.tvTitle.Tag := Index;
  View.tvTitle.Text := Item.Name;
  if Item = FOwner.FCurSQL then begin
    View.tvTitle.TextSettings.Color.Default := TAlphaColorRec.Slateblue;
    View.LinearLayout4.Checked := True;
  end else begin
    View.tvTitle.TextSettings.Color.Default := TAlphaColorRec.Black;
    View.LinearLayout4.Checked := False;
  end;

  View.btnDelete.Tag := Index;
  View.btnDelete.TagObject := View;
  View.btnDelete.OnClick := DoDeleteItem;

  View.LinearLayout4.PopupMenu := FOwner.listSQL.PopupMenu;

  Result := TViewBase(View);
end;

function TListDataAdapter.ItemDefaultHeight: Single;
begin
  Result := 40;
end;

end.