unit helpers;


// -------------------------------------
// Functions-library
// -------------------------------------


interface

uses
  Classes, SysUtils, Graphics, GraphUtil, ClipBrd, Dialogs, Forms, Controls, ComCtrls, ShellApi, CheckLst,
  Windows, Contnrs, ShlObj, ActiveX, VirtualTrees, SynRegExpr, Messages,
  Registry, SynEditHighlighter, DateUtils, Generics.Collections, StrUtils, AnsiStrings, TlHelp32, Types,
  mysql_connection, mysql_structures;

type

  // Define a record which can hold everything we need for one row / node in a VirtualStringTree
  TVTreeData = record
    Captions: TStringList;
    ImageIndex: Integer;
    NodeType: TListNodeType;
  end;
  PVTreedata = ^TVTreeData;

  // Standardize the list with node-data-records to be able to
  // use this type as variables in functions/procedures (fx VT.OnFreeNode)
  TVTreeDataArray = Array of TVTreeData;
  PVTreeDataArray = ^TVTreeDataArray;

  TFileCharset = (fcsAnsi, fcsUnicode, fcsUnicodeSwapped, fcsUtf8);

  // Structures for result grids, mapped from a TMySQLQuery to some handy VirtualTree structure
  TGridCell = record
    Text: String;
    NewText: String; // Used to create UPDATE clauses with needed columns
    IsNull: Boolean;
    NewIsNull: Boolean;
    Modified: Boolean;
  end;
  PGridCell = ^TGridCell;
  TGridColumn = record
    Name: String;
    Datatype: TDatatypeIndex; // @see mysql_structures.pas
    DatatypeCat: TDatatypeCategoryIndex;
    MaxLength: Cardinal;
    IsPriPart: Boolean;
    ValueList: TStringList;
  end;
  PGridColumn = ^TGridColumn;
  TGridColumns = Array of TGridColumn;
  // Delphi reminder, from Rudy Velthuis (usenet):
  // Records and arrays are passed as pointers, but in the preamble of the
  // called function the pointed-to data is copied onto the stack.  So either
  // use "const x: TBlah" to pass by reference, or create a pointer type.
  // Objects are passed as pointers.
  // (Orthogonal to this, when specifying "var", a pointer (possibly to a pointer)
  // is passed, allowing the called function to alter the caller's reference.)
  PGridColumns = ^TGridColumns;
  TGridRowState = (grsDefault, grsDeleted, grsModified, grsInserted);
  TGridRow = packed record
    Cells: Array of TGridCell;
    State: TGridRowState;
    HasFullData: Boolean;
  end;
  PGridRow = ^TGridRow;
  TGridRows = Array of TGridRow;
  TGridResult = class(TObject)
    Rows: TGridRows;
    Columns: TGridColumns;
  end;

  TOrderCol = class(TObject)
    ColumnName: String;
    SortDirection: Byte;
  end;
  TOrderColArray = Array of TOrderCol;

  TLineBreaks = (lbsNone, lbsWindows, lbsUnix, lbsMac, lbsWide, lbsMixed);

  TMyKey = record
    Name     : String;
    _type    : String;
    Columns  : TStringList;
    SubParts : TStringList;
  end;

  // General purpose editing status flag
  TEditingStatus = (esUntouched, esModified, esDeleted, esAddedUntouched, esAddedModified, esAddedDeleted);

  TColumnDefaultType = (cdtNothing, cdtText, cdtTextUpdateTS, cdtNull, cdtNullUpdateTS, cdtCurTS, cdtCurTSUpdateTS, cdtAutoInc);

  // Column object, many of them in a TObjectList
  TTableColumn = class(TObject)
    Name, OldName: String;
    DataType: TDatatype;
    LengthSet: String;
    Unsigned, AllowNull: Boolean;
    DefaultType: TColumnDefaultType;
    DefaultText: String;
    Comment, Collation: String;
    FStatus: TEditingStatus;
    constructor Create;
    destructor Destroy; override;
    private
      procedure SetStatus(Value: TEditingStatus);
    public
      property Status: TEditingStatus read FStatus write SetStatus;
  end;
  PTableColumn = ^TTableColumn;
  TTableColumnList = TObjectList<TTableColumn>;

  TTableKey = class(TObject)
    Name, OldName: String;
    IndexType, Algorithm: String;
    Columns, SubParts: TStringList;
    Modified, Added: Boolean;
    constructor Create;
    destructor Destroy; override;
    procedure Modification(Sender: TObject);
  end;
  TTableKeyList = TObjectList<TTableKey>;

  // Helper object to manage foreign keys in a TObjectList
  TForeignKey = class(TObject)
    KeyName, ReferenceTable, OnUpdate, OnDelete: String;
    Columns, ForeignColumns: TStringList;
    Modified, Added, KeyNameWasCustomized: Boolean;
    constructor Create;
    destructor Destroy; override;
  end;
  TForeignKeyList = TObjectList<TForeignKey>;

  TDBObjectEditor = class(TFrame)
    private
      FModified: Boolean;
      procedure SetModified(Value: Boolean);
    protected
      FEditObjectName: String;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure Init(ObjectName: String=''; ObjectType: TListNodeType=lntNone); virtual;
      function DeInit: TModalResult;
      property Modified: Boolean read FModified write SetModified;
      function ApplyModifications: TModalResult; virtual; abstract;
  end;

  TWndProc = function (hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  PGripInfo = ^TGripInfo;
  TGripInfo = record
    OldWndProc: TWndProc;
    Enabled: boolean;
    GripRect: TRect;
  end;


{$I const.inc}

  function implodestr(seperator: String; a: TStrings) :String;
  function Explode(Separator, Text: String) :TStringList;
  procedure ExplodeQuotedList(Text: String; var List: TStringList);
  procedure ensureValidIdentifier(name: String);
  function getEnumValues(str: String): String;
  function IsWhitespace(const c: Char): Boolean;
  function IsLetter(const c: Char): Boolean;
  function IsNumber(const c: Char): Boolean;
  function parsesql(sql: String) : TStringList;
  function sstr(str: String; len: Integer) : String;
  function encrypt(str: String): String;
  function decrypt(str: String): String;
  function htmlentities(str: String): String;
  procedure GridToHtml(Grid: TVirtualStringTree; Title: String; S: TStream);
  procedure GridToCsv(Grid: TVirtualStringTree; Separator, Encloser, Terminator: String; S: TStream);
  procedure GridToXml(Grid: TVirtualStringTree; root: String; S: TStream);
  procedure GridToSql(Grid: TVirtualStringTree; Tablename: String; S: TStream);
  function esc2ascii(str: String): String;
  function Max(A, B: Integer): Integer; assembler;
  function Min(A, B: Integer): Integer; assembler;
  function urlencode(url: String): String;
  procedure StreamWrite(S: TStream; Text: String = '');
  function fixSQL( sql: String; sql_version: Integer = SQL_VERSION_ANSI; cli_workarounds: Boolean = false ): String;
  procedure ToggleCheckListBox(list: TCheckListBox; state: Boolean); Overload;
  procedure ToggleCheckListBox(list: TCheckListBox; state: Boolean; list_toggle: TStringList); Overload;
  function _GetFileSize(filename: String): Int64;
  function Mince(PathToMince: String; InSpace: Integer): String;
  function MakeInt( Str: String ) : Int64;
  function MakeFloat( Str: String ): Extended;
  function CleanupNumber(Str: String): String;
  function esc(Text: String; ProcessJokerChars: Boolean=false): String;
  function ScanNulChar(Text: String): Boolean;
  function ScanLineBreaks(Text: String): TLineBreaks;
  function RemoveNulChars(Text: String): String;
  procedure debug(txt: String);
  function fixNewlines(txt: String): String;
  function GetShellFolder(CSIDL: integer): string;
  function getFilesFromDir( dir: String; pattern: String = '*.*'; hideExt: Boolean = false ): TStringList;
  function goodfilename( str: String ): String;
  function FormatNumber( str: String; Thousands: Boolean=True): String; Overload;
  function UnformatNumber(Val: String): String;
  function FormatNumber( int: Int64; Thousands: Boolean=True): String; Overload;
  function FormatNumber( flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload;
  procedure setLocales;
  procedure ShellExec(cmd: String; path: String=''; params: String='');
  function getFirstWord( text: String ): String;
  function LastPos(needle: Char; haystack: String): Integer;
  function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload;
  function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload;
  function FormatTimeNumber( Seconds: Cardinal ): String;
  function GetVTCaptions( VT: TVirtualStringTree; OnlySelected: Boolean = False; Column: Integer = 0; OnlyNodeTypes: TListNodeTypes = [lntNone] ): TStringList;
  procedure SetVTSelection( VT: TVirtualStringTree; Selected: TStringList );
  function GetTempDir: String;
  procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean);
  procedure SaveUnicodeFile(Filename: String; Text: String);
  procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
  function GetFileCharset(Stream: TFileStream): TFileCharset;
  function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): String;
  function ReadTextfile(Filename: String): String;
  function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString;
  procedure StreamToClipboard(Text, HTML: TStream; CreateHTMLHeader: Boolean);
  function WideHexToBin(text: String): AnsiString;
  function BinToWideHex(bin: AnsiString): String;
  procedure CheckHex(text: String; errorMessage: string);
  procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1);
  function GetTextHeight(Font: TFont): Integer;
  function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor;
  function ComposeOrderClause(Cols: TOrderColArray): String;
  procedure OpenRegistry(Session: String = '');
  function GetRegValue( valueName: String; defaultValue: Integer; Session: String = '' ) : Integer; Overload;
  function GetRegValue( valueName: String; defaultValue: Boolean; Session: String = '' ) : Boolean; Overload;
  function GetRegValue( valueName: String; defaultValue: String; Session: String = '' ) : String; Overload;
  procedure DeInitializeVTNodes(Sender: TBaseVirtualTree);
  procedure EnableProgressBar(MaxValue: Integer);
  function CompareNumbers(List: TStringList; Index1, Index2: Integer): Integer;
  function ListIndexByRegExpr(List: TStrings; Expression: String): Integer;
  procedure SelectNode(VT: TVirtualStringTree; idx: Cardinal; ParentNode: PVirtualNode=nil); overload;
  procedure SelectNode(VT: TVirtualStringTree; Node: PVirtualNode); overload;
  function DateBackFriendlyCaption(d: TDateTime): String;
  procedure InheritFont(AFont: TFont);
  function GetLightness(AColor: TColor): Byte;
  procedure ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
  procedure ParseViewStructure(ViewName: String; Columns: TTableColumnList);
  function ReformatSQL(SQL: String): String;
  function ParamBlobToStr(lpData: Pointer): TStringlist;
  function ParamStrToBlob(out cbData: DWORD): Pointer;
  function CheckForSecondInstance: Boolean;
  function GetParentFormOrFrame(Comp: TWinControl): TWinControl;
  function GetIndexIcon(IndexType: String): Integer;
  function KeyPressed(Code: Integer): Boolean;
  function GeneratePassword(Len: Integer): String;
  procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean);
  procedure HandlePortableSettings(StartupMode: Boolean);
  function LoadConnectionParams(Session: String): TConnectionParameters;

var
  MainReg: TRegistry;
  RegPath: String = '\Software\' + APPNAME + '\';
  PortableMode: Boolean = False;
  MutexHandle: THandle = 0;
  dbgCounter: Integer = 0;
  DecimalSeparatorSystemdefault: Char;


implementation

uses main, uVistaFuncs, table_editor, view, routine_editor, trigger_editor;



function WideHexToBin(text: String): AnsiString;
var
  buf: AnsiString;
begin
  buf := AnsiString(text);
  SetLength(Result, Length(text) div 2);
  HexToBin(PAnsiChar(buf), @Result[1], Length(Result));
end;

function BinToWideHex(bin: AnsiString): String;
var
  buf: AnsiString;
begin
  SetLength(buf, Length(bin) * 2);
  BinToHex(@bin[1], PAnsiChar(buf), Length(bin));
  Result := String(buf);
end;

procedure CheckHex(text: String; errorMessage: string);
const
  allowed: string = '0123456789abcdefABCDEF';
var
  i: Cardinal;
begin
  for i := 1 to Length(text) do begin
    if Pos(text[i], allowed) < 1 then begin
      raise Exception.Create(errorMessage);
    end;
  end;
end;


{***
  Convert a TStringList to a string using a separator-string

  @todo Look at each caller to see if escaping is necessary.
  @param string Separator
  @param a TStringList Containing strings
  @return string
}
function implodestr(seperator: String; a: TStrings) :String;
var
  i : Integer;
begin
  Result := '';
  for i:=0 to a.Count-1 do
  begin
    Result := Result + a[i];
    if i < a.Count-1 then
      Result := Result + seperator;
  end;
end;



function Explode(Separator, Text: String): TStringList;
var
  i: Integer;
  Item: String;
begin
  // Explode a string by separator into a TStringList
  Result := TStringList.Create;
  while true do begin
    i := Pos(Separator, Text);
    if i = 0 then begin
      // Last or only segment: Add to list if it's the last. Add also if it's not empty and list is empty.
      // Do not add if list is empty and text is also empty.
      if (Result.Count > 0) or (Text <> '') then
        Result.Add(Text);
      break;
    end;
    Item := Trim(Copy(Text, 1, i-1));
    Result.Add(Item);
    Delete(Text, 1, i-1+Length(Separator));
  end;
end;



{***
  Check for valid identifier (table-/db-/column-name) ?

  @param string Identifier
  @return boolean Name is valid?
  @note rosenfield, 2007-02-01:
    Those certain characters are standard filesystem wildcards * ?,
    pipe redirection characters | < >, standard path separators / \,
    Windows mount point identifiers :, DBMS security / container separator
    characters . and so on.  In other words, characters that may or may
    not be allowed by MySQL and the underlying filesystem, but which are
    really, really, really stupid to use in a table name, since you'll
    get into trouble once trying to use the table/db in a query or move it
    to a different filesystem, or what not.
  @note ansgarbecker, 2007-02-01:
    Since mysql 5.1.6 those problematic characters are encoded in
    a hexadecimal manner if they apply to a file (table) or folder (database)
    But after testing that by renaming a table to a name with a dot
    I still get an error, so we currently should be careful also on a 5.1.6+
  @see http://dev.mysql.com/doc/refman/5.1/en/identifier-mapping.html
}
procedure ensureValidIdentifier( name: String );
var
  i                                     : Integer;
  invalidChars, invalidCharsShown       : String;
  isToolong, hasInvalidChars   : Boolean;
  msgStr                                : String;
begin
  isToolong := false;
  hasInvalidChars := false;

  // Check length
  if (length(name) < 1) or (length(name) > 64) then
    isToolong := true;

  // Check for invalid chars
  invalidChars := '\/:*?"<>|.';
  for i:=1 to length(name) do
  begin
    if (pos( name[i], invalidChars ) > 0 ) then
    begin
      hasInvalidChars := true;
      break;
    end;
  end;

  // Raise exception which explains what's wrong
  if isTooLong or hasInvalidChars then
  begin
    if hasInvalidChars then
    begin
      // Add space between chars for better readability
      invalidCharsShown := '';
      for i:=1 to length(invalidChars) do
      begin
        invalidCharsShown := invalidCharsShown + invalidChars[i] + ' ';
      end;
      msgStr := 'The name "%s" contains some invalid characters.'+
        CRLF+CRLF + 'An identifier must not contain the following characters:'+CRLF+invalidCharsShown;
    end
    else if isToolong then
    begin
      msgStr := 'The name "%s" has '+IntToStr(Length(name))
        +' characters and exceeds the maximum length of 64 characters.';
    end;

    Raise Exception.CreateFmt(msgStr, [name]);
  end;


end;



{***
  Get values from an enum- or set-typed column definition

  @param string Type definition, fx: enum('Y','N')
  @return string Content of brackets
}
function getEnumValues(str: String): String;
var
  p1,p2        : Integer;
begin
  p1 := pos('(', str);
  Result := '';
  // Only return something if opening bracket was found, otherwise empty string
  if p1 > 0 then
  begin
    for p2:=Length(str) downto 0 do
      if str[p2] = ')' then break;
    result := copy (str, p1+1, p2-p1-1);
  end;
end;



{***
  Add a non-empty value to a Stringlist

  @param TStringList
  @param string to add
  @param string to enclose added string in (use %s)
  @return void
}
procedure addResult(list: TStringList; s: String; enclose: String = '');
begin
  s := trim(s);
  if length(s) > 0 then begin
    if enclose <> '' then s := Format(enclose, [s]);
    list.Add(s);
  end;
  // Avoid memory leak
  s := '';
end;



{***
  Return true if given character represents whitespace.
  Limitations: only recognizes ANSI whitespace.
  Eligible for inlining, hope the compiler does this automatically.
}
function IsWhitespace(const c: Char): Boolean;
begin
  Result := (c = #9) or (c = #10) or (c = #13) or (c = #32);
end;


function IsLetter(const c: Char): Boolean;
var
  o: Integer;
begin
  o := Ord(c);
  Result := ((o >= 65) and (o <= 90)) or ((o >= 97) and (o <= 122)) or (o = 95);
end;


{***
  Return true if given character represents a number.
  Limitations: only recognizes ANSI numerals.
  Eligible for inlining, hope the compiler does this automatically.
}
function IsNumber(const c: Char): Boolean;
var
  b: word;
begin
  b := ord(c);
  Result := (b >= 48) and (b <= 57);
end;



{***
  Scan backwards, returning true if SQL matches the given string case sensitively.
  Limitations: in case insensitive mode, input must be ANSI and lower case (for speed).
  Eligible for inlining, hope the compiler does this automatically.
}
function scanReverse(const haystack: String; hayIndex: integer; const needle: String; needleEnd: integer; insensitive: boolean): boolean;
var
  b: word;
  c: Char;
begin
  while (hayIndex > 0) and (needleEnd > 0) do begin
    // Lowercase ANSI A-Z if requested.
    if insensitive then begin
      b := Ord(haystack[hayIndex]);
      if (b > 64) and (b < 91) then b := b - 65 + 97;
      c := Char(b);
    end else c := haystack[hayIndex];
    if c <> needle[needleEnd] then begin
      result := false;
      exit;
    end;
    needleEnd := needleEnd - 1;
    hayIndex := hayIndex - 1;
  end;
  result := needleEnd = 0;
end;



{***
  Tokenize sql-script and return a TStringList with sql-statements

  @param String (possibly large) bunch of SQL-statements, separated by semicolon
  @param String SQL start delimiter
  @return TStringList Separated statements
}
function parsesql(sql: String) : TStringList;
var
  i, j, start, len                  : Integer;
  tmp                               : String;
  instring, backslash, incomment    : Boolean;
  inconditional, condterminated     : Boolean;
  inbigcomment, indelimiter         : Boolean;
  delimiter_length                  : Integer;
  encloser, secchar, thdchar        : Char;
  conditional                       : String;
begin
  result := TStringList.Create;
  sql := trim(sql);
  instring := false;
  start := 1;
  len := length(sql);
  backslash := false;
  incomment := false;
  inbigcomment := false;
  inconditional := false;
  condterminated := false;
  indelimiter := false;
  encloser := ' ';
  conditional := '';

  i := 0;
  while i < len do begin
    i := i + 1;

    // Helpers for multi-character tests, avoids testing for string length.
    secchar := '+';
    thdchar := '+';
    if i < length(sql) then secchar := sql[i + 1];
    if i + 1 < length(sql) then thdchar := sql[i + 2];

    // Turn comments into whitespace.
    if (sql[i] = '#') and (not instring) and (not inbigcomment) then begin
      incomment := true;
    end;
    if (sql[i] + secchar = '--') and (not instring) and (not inbigcomment) then begin
      incomment := true;
      sql[i] := ' ';
      if start = i then start := start + 1;
      i := i + 1;
    end;
    if (sql[i] + secchar = '/*') and (not (thdchar = '!')) and (not instring) and (not incomment) then begin
      inbigcomment := true;
      incomment := true;
      sql[i] := ' ';
      if start = i then start := start + 1;
      i := i + 1;
    end;
    if incomment and (not inbigcomment) and CharInSet(sql[i], [#13, #10]) then begin
      incomment := false;
    end;
    if inbigcomment and (sql[i] + secchar = '*/') then begin
      inbigcomment := false;
      incomment := false;
      sql[i] := ' ';
      if start = i then start := start + 1;
      i := i + 1;
      sql[i] := ' ';
    end;
    if incomment or inbigcomment then begin
      sql[i] := ' ';
    end;

    // Skip whitespace immediately if at start of sentence.
    if (start = i) and IsWhitespace(sql[i]) then begin
      start := start + 1;
      if i < len then continue;
    end;

    // Avoid parsing stuff inside string literals.
    if CharInSet(sql[i], ['''', '"', '`']) and (not (backslash and instring)) and (not incomment) and (not indelimiter) then begin
      if instring and (sql[i] = encloser) then begin
        if secchar = encloser then
          i := i + 1                            // encoded encloser-char
        else
          instring := not instring              // string closed
      end
      else if not instring then begin           // string is following
        instring := true;
        encloser := sql[i];                     // remember enclosing-character
      end;
      if i < len then continue;
    end;

    if (instring and (sql[i] = '\')) or backslash then
      backslash := not backslash;

    // Allow a DELIMITER command in middle of SQL, like the MySQL CLI does.
    if (not instring) and (not incomment) and (not inconditional) and (not indelimiter) and (start + 8 = i) and scanReverse(sql, i, 'delimiter', 9, true) then begin
      // The allowed DELIMITER format is:
      //   <delimiter> <whitespace(s)> <character(s)> <whitespace(s)> <newline>
      if IsWhitespace(secchar) then begin
        indelimiter := true;
        i := i + 1;
        if i < len then continue;
      end;
    end;

    if indelimiter then begin
      if CharInSet(sql[i], [#13, #10]) or (i = len) then begin
        if (i = len) then j := 1 else j := 0;
        try
          Mainform.Delimiter := copy(sql, start + 10, i + j - (start + 10));
        except on E:Exception do if Mainform.actQueryStopOnErrors.Checked then
          raise Exception.Create(E.Message);
        end;
        indelimiter := false;
        start := i + 1;
      end;
      if i < len then continue;
    end;

    // Handle conditional comments.
    if (not instring) and (not incomment) and (sql[i] + secchar + thdchar = '/*!') then begin
      inconditional := true;
      condterminated := false;
      tmp := '';
      conditional := '';
      i := i + 2;
      if i < len then continue;
    end;

    if inconditional and (conditional = '') then begin
      if not IsNumber(sql[i]) then begin
        conditional := tmp;
        // note:
        // we do not trim the start of the SQL inside conditional
        // comments like we do on non-commented sql.
        if i < len then continue;
      end else tmp := tmp + sql[i];
    end;

    if inconditional and (not instring) and (not incomment) and (sql[i] + secchar = '*/') then begin
      inconditional := false;
      if condterminated then begin
        // at least one statement was terminated inside the conditional.
        // if the conditional had no more contents after that statement,
        // clear the end marker.  otherwise, add a new start marker.
        if trim(copy(sql, start, i - start)) = '' then begin
          sql[i] := ' ';
          i := i + 1;
          sql[i] := ' ';
          start := i + 1;
        end else begin
          tmp := '/*!' + conditional + ' ';
          move(tmp[1], sql[start - length(tmp)], length(tmp));
          start := start - length(tmp);
        end;
        condterminated := false;
      end else begin
        if start = i then start := start + 1;
        i := i + 1;
      end;
      if i < len then continue;
    end;

    // Add sql sentence.
    delimiter_length := Length(Mainform.Delimiter);
    if ((not instring) and (scanReverse(sql, i, Mainform.Delimiter, delimiter_length, false)) or (i = len)) then begin
      if (i < len) then j := delimiter_length else begin
        // end of string, add sql sentence but only remove delimiter if it's there
        if scanReverse(sql, i, Mainform.Delimiter, delimiter_length, false) then j := delimiter_length else j := 0;
      end;
      if inconditional then begin
        addResult(result, copy(sql, start, i - start - j + 1), '%s */');
        condterminated := true;
      end else begin
        addResult(result, copy(sql, start, i - start - j + 1));
      end;
      start := i + 1;
    end;
  end;

  // Avoid memory leak
  sql := '';
end;



{***
  Shorten string to length len and append 3 dots

  @param string String to shorten
  @param integer Wished Length of string
  @return string
}
function sstr(str: String; len: Integer) : String;
begin
  if length(str) > len then
  begin
    str := copy(str, 0, len-1);
    str := str + '…';
  end;
  result := str;
end;



{***
  Password-encryption, used to store session-passwords in registry

  @param string Text to encrypt
  @return string Encrypted Text
}
function encrypt(str: String) : String;
var
  i, salt, nr : integer;
  h : String;
begin
  randomize();
  result := '';
  salt := random(9) + 1;
  for i:=1 to length(str) do begin
    nr := ord(str[i])+salt;
    if nr > 255 then
      nr := nr - 255;
    h := inttohex(nr,0);
    if length(h) = 1 then
      h := '0' + h;
    result := result + h;
  end;
  result := result + inttostr(salt);
end;



{***
  Password-decryption, used to restore session-passwords from registry

  @param string Text to decrypt
  @return string Decrypted Text
}
function decrypt(str: String) : String;
var
  j, salt, nr : integer;
begin
  result := '';
  if str = '' then exit;
  j := 1;
  salt := StrToIntDef(str[length(str)],0);
  result := '';
  while j < length(str)-1 do begin
    nr := StrToInt('$' + str[j] + str[j+1]) - salt;
    if nr < 0 then
      nr := nr + 255;
    result := result + chr(nr);
    inc(j, 2);
  end;
end;



{***
  Convert HTML-characters to their corresponding entities

  @param string Text used for search+replace
  @return string Text with entities
}
function htmlentities(str: String) : String;
begin
  result := StringReplace(str, '&', '&amp;', [rfReplaceAll]);
  result := StringReplace(result, '<', '&lt;', [rfReplaceAll]);
  result := StringReplace(result, '>', '&gt;', [rfReplaceAll]);
end;


procedure ExportStatusMsg(Node: PVirtualNode; RootNodeCount: Cardinal; StreamSize: Int64);
begin
  Mainform.ShowStatusMsg('Exporting row '+FormatNumber(Node.Index+1)+' of '+FormatNumber(RootNodeCount)+
    ' ('+IntToStr(Trunc((Node.Index+1) / RootNodeCount *100))+'%, '+FormatByteNumber(StreamSize)+')'
    );
  Mainform.ProgressBarStatus.Position := Node.Index+1;
end;


{***
  Converts a Grid to a HTML-Table.
  @param Grid Object which holds data to export
  @param string Text used in <title>
}
procedure GridToHtml(Grid: TVirtualStringTree; Title: String; S: TStream);
var
  i, MaxSize: Integer;
  tmp, Data, Generator: String;
  Node: PVirtualNode;
  GridData: TGridResult;
  SelectionOnly: Boolean;
  NodeCount: Cardinal;
begin
  // Only process selected nodes for "Copy as ..." actions
  SelectionOnly := S is TMemoryStream;

  Mainform.DataGridEnsureFullRows(Grid, SelectionOnly);
  GridData := Mainform.GridResult(Grid);

  MaxSize := GetRegValue(REGNAME_COPYMAXSIZE, DEFAULT_COPYMAXSIZE) * SIZE_MB;

  if SelectionOnly then
    NodeCount := Grid.SelectedCount
  else
    NodeCount := Grid.RootNodeCount;
  EnableProgressBar(NodeCount);
  Generator := APPNAME+' '+Mainform.AppVersion;
  tmp :=
    '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ' + CRLF +
    '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF + CRLF +
    '<html>' + CRLF +
    '  <head>' + CRLF +
    '    <title>' + Title + '</title>' + CRLF +
    '    <meta name="GENERATOR" content="'+ Generator + '">' + CRLF +
    '    <style type="text/css">' + CRLF +
    '      thead tr {background-color: ActiveCaption; color: CaptionText;}' + CRLF +
    '      th, td {vertical-align: top; font-family: "'+Grid.Font.Name+'"; font-size: '+IntToStr(Grid.Font.Size)+'pt; padding: '+IntToStr(Grid.TextMargin-1)+'px; }' + CRLF +
    '      table, td {border: 1px solid silver;}' + CRLF +
    '      table {border-collapse: collapse;}' + CRLF;
  for i:=0 to Length(GridData.Columns) - 1 do begin
    // Skip hidden key columns.
    if not (coVisible in Grid.Header.Columns[i].Options) then
      Continue;
    // Adjust preferred width of columns.
    tmp := tmp +
     '      thead .col' + IntToStr(i) + ' {width: ' + IntToStr(Grid.Header.Columns[i].Width) + 'px;}' + CRLF;
    // Right-justify all cells to match the grid on screen.
    if Grid.Header.Columns[i].Alignment = taRightJustify then
      tmp := tmp +
        '      .col' + IntToStr(i) + ' {text-align: right;}' + CRLF;
  end;
  // Note for above:
  // Indentation seems to be a mess.  I think we should stick to putting long lines on one line,
  // and just let the editor figure out how to break it if it doesn't fit on screen.  That way
  // the editor can break, indent, and put a visual marker in the gutter to denote the wrap.

  tmp := tmp +
    '    </style>' + CRLF +
    '  </head>' + CRLF + CRLF +
    '  <body>' + CRLF + CRLF +
    '    <table caption="' + Title + ' (' + inttostr(NodeCount) + ' rows)">' + CRLF +
    '      <thead>' + CRLF +
    '        <tr>' + CRLF;
  for i:=0 to Length(GridData.Columns) - 1 do begin
    // Skip hidden key columns.
    if not (coVisible in Grid.Header.Columns[i].Options) then
      Continue;
    // Add header item.
    Data := GridData.Columns[i].Name;
    tmp := tmp + '          <th class="col' + IntToStr(i) + '">' + Data + '</th>' + CRLF;
  end;
  tmp := tmp +
    '        </tr>' + CRLF +
    '      </thead>' + CRLF +
    '      <tbody>' + CRLF;
  StreamWrite(S, tmp);

  Grid.Visible := false;
  if SelectionOnly then Node := Grid.GetFirstSelected else Node := Grid.GetFirst;
  while Assigned(Node) do begin
    // Update status once in a while.
    if (Node.Index+1) mod 100 = 0 then
      ExportStatusMsg(Node, NodeCount, S.Size);
    tmp := '        <tr>' + CRLF;
    for i:=0 to Length(GridData.Columns) - 1 do begin
      // Skip hidden key columns
      if not (coVisible in Grid.Header.Columns[i].Options) then
        Continue;
      Data := Grid.Text[Node, i];
      // Handle nulls.
      if GridData.Rows[Node.Index].Cells[i].IsNull then Data := TEXT_NULL;
      // Unformat numeric values
      if (GridData.Columns[i].DatatypeCat in [dtcInteger, dtcReal]) and (not Mainform.prefExportLocaleNumbers) then
        Data := UnformatNumber(Data);
      // Escape HTML control characters in data.
      Data := htmlentities(Data);
      tmp := tmp + '          <td class="col' + IntToStr(i) + '">' + Data + '</td>' + CRLF;
    end;
    tmp := tmp + '        </tr>' + CRLF;
    StreamWrite(S, tmp);
    if SelectionOnly then Node := Grid.GetNextSelected(Node) else Node := Grid.GetNext(Node);
    if (MaxSize > 0) and Assigned(Node) and (S is TMemoryStream) and (S.Size >= MaxSize) then begin
      MessageDlg(
        Format(MSG_COPYMAXSIZE, [FormatByteNumber(MaxSize), FormatNumber(Node.Index), FormatNumber(NodeCount)]),
        mtWarning, [mbOK], 0);
      break;
    end;
  end;
  // footer:
  tmp :=
    '      </tbody>' + CRLF +
    '    </table>' + CRLF + CRLF +
    '    <p>' + CRLF +
    '      <em>generated ' + DateToStr(now) + ' ' + TimeToStr(now) +
    '      by <a href="'+APPDOMAIN+'">' + Generator + '</a></em>' + CRLF +
    '    </p>' + CRLF + CRLF +
    '  </body>' + CRLF +
    '</html>' + CRLF;
  StreamWrite(S, tmp);
  Grid.Visible := true;
  Mainform.ProgressBarStatus.Visible := False;
  Mainform.ShowStatusMsg(STATUS_MSG_READY);
end;



{***
  Converts grid contents to CSV-values.
  @param Grid Object which holds data to export
  @param string Field-separator
  @param string Field-encloser
  @param string Line-terminator
}
procedure GridToCsv(Grid: TVirtualStringTree; Separator, Encloser, Terminator: String; S: TStream);
var
  i, MaxSize: Integer;
  tmp, Data: String;
  Node: PVirtualNode;
  GridData: TGridResult;
  SelectionOnly: Boolean;
  NodeCount: Cardinal;
begin
  // Only process selected nodes for "Copy as ..." actions
  SelectionOnly := S is TMemoryStream;

  Mainform.DataGridEnsureFullRows(Grid, SelectionOnly);
  GridData := Mainform.GridResult(Grid);

  separator := esc2ascii(separator);
  encloser := esc2ascii(encloser);
  terminator := esc2ascii(terminator);
  MaxSize := GetRegValue(REGNAME_COPYMAXSIZE, DEFAULT_COPYMAXSIZE) * SIZE_MB;

  if SelectionOnly then
    NodeCount := Grid.SelectedCount
  else
    NodeCount := Grid.RootNodeCount;
  EnableProgressBar(NodeCount);

  tmp := '';
  // Columns
  for i:=0 to Grid.Header.Columns.Count-1 do begin
    // Skip hidden key columns
    if not (coVisible in Grid.Header.Columns[i].Options) then
      Continue;
    Data := GridData.Columns[i].Name;
    // Alter column name in header if data is not raw.
    if (GridData.Columns[i].DatatypeCat = dtcBinary) and (not Mainform.actBlobAsText.Checked) then
      Data := 'HEX(' + Data + ')';
    // Add header item.
    if tmp <> '' then tmp := tmp + Separator;
    tmp := tmp + Encloser + Data + Encloser;
  end;
  tmp := tmp + Terminator;
  StreamWrite(S, tmp);

  Grid.Visible := false;

  // Data:
  if SelectionOnly then Node := Grid.GetFirstSelected else Node := Grid.GetFirst;
  while Assigned(Node) do begin
    if (Node.Index+1) mod 100 = 0 then
      ExportStatusMsg(Node, NodeCount, S.Size);
    tmp := '';
    for i:=0 to Grid.Header.Columns.Count-1 do begin
      // Skip hidden key columns
      if not (coVisible in Grid.Header.Columns[i].Options) then
        Continue;
      Data := Grid.Text[Node, i];
      // Remove 0x.
      if (GridData.Columns[i].DatatypeCat = dtcBinary) and (not Mainform.actBlobAsText.Checked) then
        Delete(Data, 1, 2);
      // Unformat numeric values
      if (GridData.Columns[i].DatatypeCat in [dtcInteger, dtcReal]) and (not Mainform.prefExportLocaleNumbers) then
        Data := UnformatNumber(Data);
      // Escape encloser characters inside data per de-facto CSV.
      Data := StringReplace(Data, Encloser, Encloser + Encloser, [rfReplaceAll]);
      // Special handling for NULL (MySQL-ism, not de-facto CSV: unquote value)
      if GridData.Rows[Node.Index].Cells[i].IsNull then Data := 'NULL'
      else Data := Encloser + Data + Encloser;
      // Add cell.
      if tmp <> '' then tmp := tmp + Separator;
      tmp := tmp + Data;
    end;
    tmp := tmp + Terminator;
    StreamWrite(S, tmp);
    if SelectionOnly then Node := Grid.GetNextSelected(Node) else Node := Grid.GetNext(Node);
    if (MaxSize > 0) and Assigned(Node) and (S is TMemoryStream) and (S.Size >= MaxSize) then begin
      MessageDlg(
        Format(MSG_COPYMAXSIZE, [FormatByteNumber(MaxSize), FormatNumber(Node.Index), FormatNumber(NodeCount)]),
        mtWarning, [mbOK], 0);
      break;
    end;
  end;
  Grid.Visible := true;
  Mainform.ProgressBarStatus.Visible := False;
  Mainform.ShowStatusMsg(STATUS_MSG_READY);
end;



{***
  Converts grid contents to XML.
  @param Grid Object which holds data to export
  @param string Text used as root-element
}
procedure GridToXml(Grid: TVirtualStringTree; root: String; S: TStream);
var
  i, MaxSize: Integer;
  tmp, Data: String;
  Node: PVirtualNode;
  GridData: TGridResult;
  SelectionOnly: Boolean;
  NodeCount: Cardinal;
begin
  // Only process selected nodes for "Copy as ..." actions
  SelectionOnly := S is TMemoryStream;

  Mainform.DataGridEnsureFullRows(Grid, SelectionOnly);
  GridData := Mainform.GridResult(Grid);

  MaxSize := GetRegValue(REGNAME_COPYMAXSIZE, DEFAULT_COPYMAXSIZE) * SIZE_MB;

  if SelectionOnly then
    NodeCount := Grid.SelectedCount
  else
    NodeCount := Grid.RootNodeCount;
  EnableProgressBar(NodeCount);
  tmp := '<?xml version="1.0"?>' + CRLF + CRLF +
      '<table name="'+root+'">' + CRLF;
  StreamWrite(S, tmp);

  // Avoid reloading discarded data before the end.
  Grid.Visible := false;
  if SelectionOnly then Node := Grid.GetFirstSelected else Node := Grid.GetFirst;
  while Assigned(Node) do begin
    if (Node.Index+1) mod 100 = 0 then
     ExportStatusMsg(Node, NodeCount, S.Size);
    tmp := #9'<row>' + CRLF;
    for i:=0 to Grid.Header.Columns.Count-1 do begin
      // Skip hidden key columns
      if not (coVisible in Grid.Header.Columns[i].Options) then
        Continue;
      // Print cell start tag.
      tmp := tmp + #9#9'<' + Grid.Header.Columns[i].Text;
      if GridData.Rows[Node.Index].Cells[i].IsNull then tmp := tmp + ' isnull="true" />' + CRLF
      else begin
        if (GridData.Columns[i].DatatypeCat = dtcBinary) and (not Mainform.actBlobAsText.Checked) then
          tmp := tmp + ' format="hex"';
        tmp := tmp + '>';
        Data := Grid.Text[Node, i];
        // Remove 0x.
        if (GridData.Columns[i].DatatypeCat = dtcBinary) and (not Mainform.actBlobAsText.Checked) then
          Delete(Data, 1, 2);
        // Unformat numeric values
        if (GridData.Columns[i].DatatypeCat in [dtcInteger, dtcReal]) and (not Mainform.prefExportLocaleNumbers) then
          Data := UnformatNumber(Data);
        // Escape XML control characters in data.
        Data := htmlentities(Data);
        // Add data and cell end tag.
        tmp := tmp + Data + '</' + Grid.Header.Columns[i].Text + '>' + CRLF;
      end;
    end;
    tmp := tmp + #9'</row>' + CRLF;
    StreamWrite(S, tmp);
    if SelectionOnly then Node := Grid.GetNextSelected(Node) else Node := Grid.GetNext(Node);
    if (MaxSize > 0) and Assigned(Node) and (S is TMemoryStream) and (S.Size >= MaxSize) then begin
      MessageDlg(
        Format(MSG_COPYMAXSIZE, [FormatByteNumber(MaxSize), FormatNumber(Node.Index), FormatNumber(NodeCount)]),
        mtWarning, [mbOK], 0);
      break;
    end;
  end;
  // footer:
  tmp := '</table>' + CRLF;
  StreamWrite(S, tmp);
  Grid.Visible := true;
  Mainform.ProgressBarStatus.Visible := False;
  Mainform.ShowStatusMsg(STATUS_MSG_READY);
end;


{***
  Converts grid contents to XML.
  @param Grid Object which holds data to export
  @param string Text used as tablename in INSERTs
}
procedure GridToSql(Grid: TVirtualStringTree; Tablename: String; S: TStream);
var
  i, MaxSize: Integer;
  tmp, Data: String;
  Node: PVirtualNode;
  GridData: TGridResult;
  SelectionOnly: Boolean;
  NodeCount: Cardinal;
begin
  // Only process selected nodes for "Copy as ..." actions
  SelectionOnly := S is TMemoryStream;

  Mainform.DataGridEnsureFullRows(Grid, SelectionOnly);
  GridData := Mainform.GridResult(Grid);

  MaxSize := GetRegValue(REGNAME_COPYMAXSIZE, DEFAULT_COPYMAXSIZE) * SIZE_MB;

  if SelectionOnly then
    NodeCount := Grid.SelectedCount
  else
    NodeCount := Grid.RootNodeCount;
  EnableProgressBar(NodeCount);
  // Avoid reloading discarded data before the end.
  Grid.Visible := false;
  if SelectionOnly then Node := Grid.GetFirstSelected else Node := Grid.GetFirst;
  while Assigned(Node) do begin
    if (Node.Index+1) mod 100 = 0 then
     ExportStatusMsg(Node, NodeCount, S.Size);
    tmp := 'INSERT INTO '+Mainform.Mask(Tablename)+' (';
    for i:=0 to Grid.Header.Columns.Count-1 do begin
      // Skip hidden key columns
      if not (coVisible in Grid.Header.Columns[i].Options) then
        Continue;
      tmp := tmp + Mainform.mask(Grid.Header.Columns[i].Text)+', ';
    end;
    Delete(tmp, Length(tmp)-1, 2);
    tmp := tmp + ') VALUES (';
    for i:=0 to Grid.Header.Columns.Count-1 do begin
      // Skip hidden key columns
      if not (coVisible in Grid.Header.Columns[i].Options) then
        Continue;
      if GridData.Rows[Node.Index].Cells[i].IsNull then
        tmp := tmp + 'NULL'
      else begin             
        Data := Grid.Text[Node, i];
        // Remove 0x.
        if (GridData.Columns[i].DatatypeCat = dtcBinary) and (not Mainform.actBlobAsText.Checked) then
          Delete(Data, 1, 2);
        // Unformat numeric values
        if GridData.Columns[i].DatatypeCat in [dtcInteger, dtcReal] then
          tmp := tmp + UnformatNumber(Data)
        else
          tmp := tmp + esc(Data);
      end;
      tmp := tmp + ', ';
    end;
    Delete(tmp, Length(tmp)-1, 2);
    tmp := tmp + ');' + CRLF;
    StreamWrite(S, tmp);
    if SelectionOnly then Node := Grid.GetNextSelected(Node) else Node := Grid.GetNext(Node);
    if (MaxSize > 0) and Assigned(Node) and (S is TMemoryStream) and (S.Size >= MaxSize) then begin
      MessageDlg(
        Format(MSG_COPYMAXSIZE, [FormatByteNumber(MaxSize), FormatNumber(Node.Index), FormatNumber(NodeCount)]),
        mtWarning, [mbOK], 0);
      break;
    end;
  end;
  // footer:
  tmp := CRLF;
  StreamWrite(S, tmp);
  Grid.Visible := true;
  Mainform.ProgressBarStatus.Visible := False;
  Mainform.ShowStatusMsg(STATUS_MSG_READY);
end;



{***
  Return ASCII-Values from MySQL-Escape-Sequences

  @param string Text to analyze
  @return string Converted text
}
function esc2ascii(str: String): String;
begin
  str := stringreplace(str, '\r', #13, [rfReplaceAll]);
  str := stringreplace(str, '\n', #10, [rfReplaceAll]);
  str := stringreplace(str, '\t', #9, [rfReplaceAll]);
  result := str;
end;



{***
  Get higher value of two integers

  @param integer Number 1 to compare
  @param integer Number 2 to compare
  @return integer Higher value
}
function Max(A, B: Integer): Integer; assembler;
asm
  CMP EAX,EDX
  JG  @Exit
  MOV EAX,EDX
@Exit:
end;



{***
  Get lower value of two integers

  @param integer Number 1 to compare
  @param integer Number 2 to compare
  @return integer Lower value of both parameters
}
function Min(A, B: Integer): Integer; assembler;
asm
  CMP EAX,EDX
  JL  @Exit
  MOV EAX,EDX
@Exit:
end;


{***
  Encode spaces (and more to come) in URLs

  @param string URL to encode
  @return string
}
function urlencode(url: String): String;
begin
  result := stringreplace(url, ' ', '+', [rfReplaceAll]);
end;


{**
  Write some UTF8 text to a file- or memorystream
}
procedure StreamWrite(S: TStream; Text: String = '');
var
  utf8: AnsiString;
begin
  utf8 := Utf8Encode(Text);
  S.Write(utf8[1], Length(utf8));
end;



{***
  Make SQL statement compatible with either ANSI SQL or MySQL
  @note Works around MySQL placement of semicolon in conditional
        statements, which is not compatible with standard SQL (making
        the whole point of conditional statements slightly moot?).
        The broken format is unfortunately the only format that the
        mysql cli will eat, according to one user...

        btnExportClick() could be rewritten to better handle this sort
        of thing, but for now / with the current code, this is the easiest
        way of accomplishing the desired effect.
  @param string SQL statement
  @param integer MySQL-version or SQL_VERSION_ANSI
  @return string SQL
}
function fixSQL( sql: String; sql_version: Integer = SQL_VERSION_ANSI; cli_workarounds: Boolean = false ): String;
var
  rx : TRegExpr;
begin
  result := sql;

  // For mysqldump and mysql.exe CLI compatibility
  if cli_workarounds then
  begin
    result := StringReplace(result, ';*/', '*/;', [rfReplaceAll]);
  end;

  // Detect if SQL is a CREATE TABLE statement
  if copy( result, 1, 12 ) = 'CREATE TABLE' then
  begin
    rx := TRegExpr.Create;
    // Greedy: take as many chars as I can get
    rx.ModifierG := True;
    // Case insensitive
    rx.ModifierI := True;

    if sql_version < 40100 then begin
      // Strip charset definition
      // see issue #1685835
      rx.Expression := '\s+(DEFAULT\s+)?(CHARSET|CHARACTER SET)=\w+';
      result := rx.Replace(result, '', false);
      // Strip collation part
      rx.Expression := '\s+COLLATE=\w+';
      result := rx.Replace(result, '', false);
    end;

    if sql_version = SQL_VERSION_ANSI then begin
      // Switch quoting char
      result := StringReplace(result, '`', '"', [rfReplaceAll]);
      // Strip ENGINE|TYPE
      rx.Expression := '\s+(ENGINE|TYPE)=\w+';
      result := rx.Replace(result, '', false);
    end;

    // Turn ENGINE to TYPE
    if sql_version < 40102 then
      result := StringReplace(result, 'ENGINE=', 'TYPE=', [rfReplaceAll])
    else
      result := StringReplace(result, 'TYPE=', 'ENGINE=', [rfReplaceAll]);

    // Mask USING {BTREE,HASH,RTREE} from older servers.
    rx.Expression := '\s(USING\s+\w+)';
    result := rx.Replace(result, ' /*!50100 $1 */', True);

    rx.Free;
  end;

end;


{***
  Check/Uncheck all items in a CheckListBox

  @param TCheckListBox List with checkable items
  @param boolean Check them?
  @return void
}
procedure ToggleCheckListBox(list: TCheckListBox; state: Boolean);
var
  i : Integer;
begin
  // select all/none
  for i:=0 to list.Items.Count-1 do
    list.checked[i] := state;
end;


{***
  Check/Uncheck items in a CheckListBox which come in a second list

  @param TCheckListBox List with checkable items
  @param boolean Check them?
  @param TStringList Second list with items to change
  @return void
}
procedure ToggleCheckListBox(list: TCheckListBox; state: Boolean; list_toggle: TStringList);
var
  i : Integer;
begin
  for i:=0 to list.Items.Count-1 do begin
    if list_toggle.IndexOf(list.Items[i]) > -1 then
      list.Checked[i] := state
    else
      list.Checked[i] := not state;
  end;
end;



{***
  Get filesize of a given file

  @param string Filename
  @return int64 Size in bytes
}
function _GetFileSize(filename: String): Int64;
var
  i64: record
    LoDWord: LongWord;
    HiDWord: LongWord;
  end;
  stream : TFileStream;
begin
  Stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
  try
    i64.LoDWord := GetFileSize(Stream.Handle, @i64.HiDWord);
  finally
    Stream.Free;
  end;
  if (i64.LoDWord = MAXDWORD) and (GetLastError <> 0) then
    Result := 0
  else
    Result := PInt64(@i64)^;
end;



{***
  Change "C:\Program Files\Delphi\DDrop\TargetDemo\main.pas"
  to:    "C:\Program Files\..\main.pas"

  @param string File/Directory
  @param integer Shorten name to this maximum amount of chars
  @return string
}
function Mince(PathToMince: String; InSpace: Integer): String;
Var
  sl: TStringList;
  sHelp, sFile: String;
  iPos: Integer;

Begin
  sHelp := PathToMince;
  iPos := Pos('\', sHelp);
  If iPos = 0 Then
  Begin
    Result := PathToMince;
  End
  Else
  Begin
    sl := TStringList.Create;
    // Decode string
    While iPos <> 0 Do
    Begin
      sl.Add(Copy(sHelp, 1, (iPos - 1)));
      sHelp := Copy(sHelp, (iPos + 1), Length(sHelp));
      iPos := Pos('\', sHelp);
    End;
    If sHelp <> '' Then
    Begin
      sl.Add(sHelp);
    End;
    // Encode string
    sFile := sl[sl.Count - 1];
    sl.Delete(sl.Count - 1);
    Result := '';
    While (Length(Result + sFile) < InSpace) And (sl.Count <> 0) Do
    Begin
      Result := Result + sl[0] + '\';
      sl.Delete(0);
    End;
    If sl.Count = 0 Then
    Begin
      Result := Result + sFile;
    End
    Else
    Begin
      Result := Result + '..\' + sFile;
    End;
    sl.Free;
  End;
End;



{***
  Convert a string-number to an integer-number

  @param string String-number
  @return int64
}
function MakeInt( Str: String ) : Int64;
begin
  // Result has to be of integer type
  Result := Trunc( MakeFloat( Str ) );
end;


function CleanupNumber(Str: String): String;
var
  i: Integer;
  HasDecimalSep: Boolean;
begin
  // Ensure the passed string contains a valid number, which is convertable by StrToFloat afterwards
  // Return it as string again, as there are callers which need to handle unsigned bigint's somehow -
  // there is no unsigned 64 bit integer type in Delphi.
  Result := '';
  HasDecimalSep := False;
  for i:=1 to Length(Str) do begin
    if CharInSet(Str[i], ['0'..'9', DecimalSeparator]) or ((Str[i] = '-') and (Result='')) then
    begin
      // Avoid confusion and AV in StrToFloat()
      if (ThousandSeparator = DecimalSeparator) and (Str[i] = DecimalSeparator) then
        continue;
      // Ensure only 1 decimalseparator is left
      if (Str[i] = DecimalSeparator) and HasDecimalSep then
        continue;
      if Str[i] = DecimalSeparator then
        HasDecimalSep := True;
      Result := Result + Str[i];
    end;
  end;
  if (Result = '') or (Result = '-') then
    Result := '0';
end;


{***
  Convert a string-number to an floatingpoint-number

  @param String text representation of a number
  @return Extended
}
function MakeFloat( Str: String ): Extended;
var
  p_kb, p_mb, p_gb, p_tb, p_pb : Integer;
begin
  // Convert result to a floating point value to ensure
  // we don't discard decimal digits for the next step
  Result := StrToFloat(CleanupNumber(Str));

  // Detect if the string was previously formatted by FormatByteNumber
  // and convert it back by multiplying it with its byte unit
  p_kb := Pos(NAME_KB, Str);
  p_mb := Pos(NAME_MB, Str);
  p_gb := Pos(NAME_GB, Str);
  p_tb := Pos(NAME_TB, Str);
  p_pb := Pos(NAME_PB, Str);

  if (p_kb > 0) and (p_kb = Length(Str)-Length(NAME_KB)+1) then
    Result := Result * SIZE_KB
  else if (p_mb > 0) and (p_mb = Length(Str)-Length(NAME_MB)+1) then
    Result := Result * SIZE_MB
  else if (p_gb > 0) and (p_gb = Length(Str)-Length(NAME_GB)+1) then
    Result := Result * SIZE_GB
  else if (p_tb > 0) and (p_tb = Length(Str)-Length(NAME_TB)+1) then
    Result := Result * SIZE_TB
  else if (p_pb > 0) and (p_pb = Length(Str)-Length(NAME_PB)+1) then
    Result := Result * SIZE_PB;
end;


function esc(Text: String; ProcessJokerChars: Boolean=false): String;
begin
  Result := Mainform.Connection.EscapeString(Text, ProcessJokerChars);
end;


{***
  Detect NUL character in a text.
  Useful because fx SynEdit cuts of all text after it encounters a NUL.
}
function ScanNulChar(Text: String): boolean;
var
  i: integer;
begin
  result := false;
  for i:=1 to length(Text) do
  begin
    if Text[i] = #0 then
    begin
      result := true;
      exit;
    end;
  end;
end;



{***
  SynEdit removes all newlines and semi-randomly decides a
  new newline format to use for any text edited.
  See also: Delphi's incomplete implementation of TTextLineBreakStyle in System.pas

  @param string Text to test
  @return TLineBreaks
}
function ScanLineBreaks(Text: String): TLineBreaks;
var
  i: integer;
  c: Char;
  procedure SetResult(Style: TLineBreaks);
  begin
    // Note: Prefer "(foo <> a) and (foo <> b)" over "not (foo in [a, b])" in excessive loops
    // for performance reasons - there is or was a Delphi bug leaving those inline SETs in memory
    // after usage. Unfortunately can't remember which bug id it was and if it still exists.
    if (Result <> lbsNone) and (Result <> Style) then
      Result := lbsMixed
    else
      Result := Style;
  end;
begin
  Result := lbsNone;
  if length(Text) = 0 then exit;
  i := 1;
  repeat
    c := Text[i];
    if c = #13 then begin
      if (i < length(Text)) and (Text[i+1] = #10) then begin
        Inc(i);
        SetResult(lbsWindows);
      end else
        SetResult(lbsMac);
    end else if c = LB_UNIX then
      SetResult(lbsUnix)
    else if c = LB_WIDE then
      SetResult(lbsWide);
    i := i + 1;
    // No need to do more checks after detecting mixed style
    if Result = lbsMixed then
      break;
  until i > length(Text);
end;



{***
  Mangle input text so that SynEdit can load it.

  @param string Text to test
  @return Boolean
}
function RemoveNulChars(Text: String): String;
var
  i: integer;
  c: Char;
begin
  SetLength(Result, Length(Text));
  if Length(Text) = 0 then Exit;
  i := 1;
  repeat
    c := Text[i];
    if c = #0 then Result[i] := #32
    else Result[i] := c;
    i := i + 1;
  until i > length(Text);
end;



{***
  Use DebugView from SysInternals or Delphi's Event Log to view.

  @param string Text to ouput
  @return void
}
procedure debug(txt: String);
begin
  if length(txt) = 0 then txt := '(debug: blank output?)';
  // Todo: not thread safe.
  dbgCounter := dbgCounter + 1;
  txt := Format(APPNAME+': %d %s', [dbgCounter, txt]);
  OutputDebugString(PChar(txt));
end;



{***
  Unify CR's and LF's to CRLF

  @param string Text to fix
  @return string
}
function fixNewlines(txt: String): String;
begin
  txt := StringReplace(txt, CRLF, #10, [rfReplaceAll]);
  txt := StringReplace(txt, #13, #10, [rfReplaceAll]);
  txt := StringReplace(txt, #10, CRLF, [rfReplaceAll]);
  result := txt;
end;



{***
  Get the path of a Windows(r)-shellfolder, specified by an integer or a constant

  @param integer Number or constant
  @return string Path
}
function GetShellFolder(CSIDL: integer): string;
var
  pidl                   : PItemIdList;
  FolderPath             : string;
  SystemFolder           : Integer;
  Malloc                 : IMalloc;
begin
  Malloc := nil;
  FolderPath := '';
  SHGetMalloc(Malloc);
  if Malloc = nil then
  begin
    Result := FolderPath;
    Exit;
  end;
  try
    SystemFolder := CSIDL;
    if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then
    begin
      SetLength(FolderPath, max_path);
      if SHGetPathFromIDList(pidl, PChar(FolderPath)) then
      begin
        SetLength(FolderPath, length(PChar(FolderPath)));
      end;
    end;
    Result := FolderPath;
  finally
    Malloc.Free(pidl);
  end;
end;



{***
  Return all files in a given directory into a TStringList

  @param string Folderpath
  @param string Filepattern to filter files, defaults to all files (*.*)
  @return TStringList Filenames
}
function getFilesFromDir( dir: String; pattern: String = '*.*'; hideExt: Boolean = false ): TStringList;
var
  sr : TSearchRec;
  s : String;
begin
  result := TStringList.Create;
  if dir[length(dir)] <> '\' then
    dir := dir + '\';
  if FindFirst( dir + pattern, $3F, sr ) = 0 then
  begin
    repeat
      if (sr.Attr and faAnyFile) > 0 then begin
        s := sr.Name;
        if hideExt and (Pos('.', s) > 0) then begin
          SetLength(s, Pos('.', s) - 1);
        end;
        result.Add( s );
      end;
    until FindNext( sr ) <> 0;
    // FindClose( sr );
  end;
end;



{***
  Remove special characters from a filename

  @param string Filename
  @return string
}
function goodfilename( str: String ): String;
var
  c : Char;
begin
  result := str;
  for c in ['\', '/', ':', '*', '?', '"', '<', '>', '|'] do
    result := StringReplace( result, c, '_', [rfReplaceAll] );
end;



{**
  Unformat a formatted integer or float. Used for CSV export and composing WHERE clauses for grid editing.
}
function UnformatNumber(Val: String): String;
begin
  Result := Val;
  if ThousandSeparator <> DecimalSeparator then
    Result := StringReplace(Result, ThousandSeparator, '', [rfReplaceAll]);
  Result := StringReplace(Result, DecimalSeparator, '.', [rfReplaceAll]);
end;


{***
  Return a formatted integer or float from a string
  @param string Text containing a number
  @return string
}
function FormatNumber(str: String; Thousands: Boolean=True): String; Overload;
var
  i, p, Left: Integer;
begin
  Result := StringReplace(str, '.', DecimalSeparator, [rfReplaceAll]);
  if Thousands then begin
    // Do not add thousand separators to zerofilled numbers
    if ((Length(Result) >= 1) and (Result[1] = '0'))
      or ((Length(Result) >= 2) and (Result[1] = '-') and (Result[2] = '0'))
    then
      Exit;
    p := Pos(DecimalSeparator, Result);
    if p = 0 then p := Length(Result)+1;
    Left := 2;
    if (Length(Result) >= 1) and (Result[1] = '-') then
      Left := 3;
    if p > 0 then for i:=p-1 downto Left do begin
      if (p-i) mod 3 = 0 then
        Insert(ThousandSeparator, Result, i);
    end;
  end;
end;



{***
  Return a formatted number from an integer

  @param int64 Number to format
  @return string
}
function FormatNumber(int: Int64; Thousands: Boolean=True): String; Overload;
begin
  result := FormatNumber(IntToStr(int), Thousands);
end;



{***
  Return a formatted number from a float
  This function is called by two overloaded functions

  @param double Number to format
  @param integer Number of decimals
  @return string
}
function FormatNumber(flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload;
begin
  Result := Format('%10.'+IntToStr(decimals)+'f', [flt]);
  Result := Trim(Result);
  Result := FormatNumber(Result, Thousands);
end;



{***
  Set global variables containing the standard local format for date and time
  values. Standard means the MySQL-standard format, which is YYYY-MM-DD HH:MM:SS

  @note Be aware that Delphi internally converts the slashes in ShortDateFormat
        to the DateSeparator
}
procedure setLocales;
begin
  DateSeparator := '-';
  TimeSeparator := ':';
  ShortDateFormat := 'yyyy/mm/dd';
  LongTimeFormat := 'hh:nn:ss';
  if DecimalSeparatorSystemdefault = '' then
    DecimalSeparatorSystemdefault := DecimalSeparator;
  DecimalSeparator := DecimalSeparatorSystemdefault;
end;



{***
  Open URL or execute system command

  @param string Command or URL to execute
  @param string Working directory, only usefull is first param is a system command
}
procedure ShellExec(cmd: String; path: String=''; params: String='');
begin
  ShellExecute(0, 'open', PChar(cmd), PChar(params), PChar(path), SW_SHOWNORMAL);
end;



{***
  Returns first word of a given text
  @param string Given text
  @return string First word-boundary
}
function getFirstWord( text: String ): String;
var
  i : Integer;
  wordChars, wordCharsFirst : TSysCharSet;
begin
  result := '';
  text := trim( text );
  // First char in word must not be numerical. Fixes queries like
  // /*!40000 SHOW ENGINES */ to be recognized as "result"-queries
  // while not breaking getFirstWord in situations where the second
  // or later char can be a number (fx the collation in createdatabase).
  wordChars := ['a'..'z', 'A'..'Z', '0'..'9', '_', '-'];
  wordCharsFirst := wordChars - ['0'..'9'];
  i := 1;

  // Find beginning of the first word, ignoring non-alphanumeric chars at the very start
  // @see bug #1692828
  while i < Length(text) do
  begin
    if CharInSet(text[i], wordCharsFirst) then
    begin
      // Found beginning of word!
      break;
    end;
    if i = Length(text)-1 then
    begin
      // Give up in the very last loop, reset counter
      // and break. We can't find the start of a word
      i := 1;
      break;
    end;
    inc(i);
  end;

  // Add chars as long as they're alpha-numeric
  while i <= Length(text) do
  begin
    if ((result = '') and CharInSet(text[i], wordCharsFirst)) or CharInSet(text[i], wordChars) then
    begin
      result := result + text[i];
    end
    else
    begin
      // Stop here because we found a non-alphanumeric char.
      // This applies to all different whitespaces, brackets, commas etc.
      break;
    end;
    inc(i);
  end;
end;


{**
  Get last position of substr in str
  @param string Substring
  @param string Text
  @return Integer Last position
}
function LastPos(needle: Char; haystack: String): Integer;
var
  reverse: String;
  i, len, w: Integer;
begin
  // Reverse string.
  len := Length(haystack);
  SetLength(reverse, len);
  for i := 1 to len do reverse[i] := haystack[len - i + 1];
  // Look for needle.
  Result := 0;
  w := Pos(needle, reverse);
  if w > 0 then Result := len - w + 1;
end;


{**
  Format a filesize to automatically use the best fitting expression
  16 100 000 Bytes -> 16,1 MB
  4 500 Bytes -> 4,5 KB
  @param Int64 Number of Bytes
  @param Byte Decimals to display when bytes is bigger than 1M
}
function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload;
begin
  if Bytes >= SIZE_PB then
    Result := FormatNumber( Bytes / SIZE_PB, Decimals ) + NAME_PB
  else if Bytes >= SIZE_TB then
    Result := FormatNumber( Bytes / SIZE_TB, Decimals ) + NAME_TB
  else if Bytes >= SIZE_GB then
    Result := FormatNumber( Bytes / SIZE_GB, Decimals ) + NAME_GB
  else if Bytes >= SIZE_MB then
    Result := FormatNumber( Bytes / SIZE_MB, Decimals ) + NAME_MB
  else if Bytes >= SIZE_KB then
    Result := FormatNumber( Bytes / SIZE_KB, Decimals ) + NAME_KB
  else
    Result := FormatNumber( Bytes ) + NAME_BYTES
end;


{**
  An overloaded function of the previous one which can
  take a string as input
}
function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload;
begin
  Result := FormatByteNumber( MakeInt(Bytes), Decimals );
end;


{**
  Format a number of seconds to a human readable time format
  @param Cardinal Number of seconds
  @result String 12:34:56
}
function FormatTimeNumber( Seconds: Cardinal ): String;
var
  d, h, m, s : Integer;
begin
  s := Seconds;
  d := s div (60*60*24);
  s := s mod (60*60*24);
  h := s div (60*60);
  s := s mod (60*60);
  m := s div 60;
  s := s mod 60;
  if d > 0 then
    Result := Format('%d days, %.2d:%.2d:%.2d', [d, h, m, s])
  else
    Result := Format('%.2d:%.2d:%.2d', [h, m, s]);
end;


{**
  Return a TStringList with captions from all selected nodes in a VirtualTree
  Especially helpful when toMultiSelect is True
}
function GetVTCaptions( VT: TVirtualStringTree; OnlySelected: Boolean = False; Column: Integer = 0; OnlyNodeTypes: TListNodeTypes = [lntNone] ): TStringList;
var
  Node: PVirtualNode;
  NodeData: PVTreeData;
begin
  Result := TStringList.Create;
  if OnlySelected then Node := VT.GetFirstSelected
  else Node := VT.GetFirst;
  while Assigned(Node) do begin
    if OnlyNodeTypes = [lntNone] then // Add all nodes, regardless of their types
      Result.Add( VT.Text[Node, Column] )
    else begin
      NodeData := VT.GetNodeData(Node);
      if (NodeData.NodeType in OnlyNodeTypes) then // Node in loop is of specified type
        Result.Add(NodeData.Captions[Column]);
    end;
    if OnlySelected then Node := VT.GetNextSelected(Node)
    else Node := VT.GetNext(Node);
  end;
end;


{**
  The opposite of GetVTCaptions in "OnlySelected"-Mode:
  Set selected nodes in a VirtualTree
}
procedure SetVTSelection( VT: TVirtualStringTree; Selected: TStringList );
var
  Node: PVirtualNode;
  NodeData: PVTreeData;
  IsSel, FoundFocus: Boolean;
begin
  Node := VT.GetFirst;
  FoundFocus := False;
  while Assigned(Node) do begin
    NodeData := VT.GetNodeData(Node);
    IsSel := Selected.IndexOf(NodeData.Captions[0]) > -1;
    VT.Selected[Node] := IsSel;
    if IsSel and not FoundFocus then begin
      VT.FocusedNode := Node;
      FoundFocus := True;
    end;
    if IsSel and not (toMultiSelect in VT.TreeOptions.SelectionOptions) then
      break;
    Node := VT.GetNext(Node);
  end;
end;


function GetTempDir: String;
var
  TempPath: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, PChar(@TempPath));
  Result := StrPas(TempPath);
end;


{
  Code taken from SizeGripHWND.pas:
  Copyright (C) 2005, 2006 Volker Siebert <flocke@vssd.de>
  Alle Rechte vorbehalten.

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.
}
function SizeGripWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  Info: PGripInfo;
  dc: HDC;
  pt: TPoint;

  // Invalidate the current grip rectangle
  procedure InvalidateGrip;
  begin
    with Info^ do
      if (GripRect.Right > GripRect.Left) and
         (GripRect.Bottom > GripRect.Top) then
        InvalidateRect(hWnd, @GripRect, true);
  end;

  // Update (and invalidate) the current grip rectangle
  procedure UpdateGrip;
  begin
    with Info^ do
    begin
      GetClientRect(hWnd, GripRect);
      GripRect.Left := GripRect.Right - GetSystemMetrics(SM_CXHSCROLL);
      GripRect.Top := GripRect.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    end;

    InvalidateGrip;
  end;

  function CallOld: LRESULT;
  begin
    Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
  end;

begin
  Info := PGripInfo(GetProp(hWnd, SizeGripProp));
  if Info = nil then
    Result := DefWindowProc(hWnd, Msg, wParam, lParam)
  else if not Info^.Enabled then
    Result := CallOld
  else
  begin
    case Msg of
      WM_NCDESTROY: begin
        Result := CallOld;

        SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@Info^.OldWndProc));
        RemoveProp(hWnd, SizeGripProp);
        Dispose(Info);
      end;

      WM_PAINT: begin
        Result := CallOld;
        if wParam = 0 then
        begin
          dc := GetDC(hWnd);
          DrawFrameControl(dc, Info^.GripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
          ReleaseDC(hWnd, dc);
        end;
      end;

      WM_NCHITTEST: begin
        pt.x := TSmallPoint(lParam).x;
        pt.y := TSmallPoint(lParam).y;
        ScreenToClient(hWnd, pt);
        if PtInRect(Info^.GripRect, pt) then
          Result := HTBOTTOMRIGHT
        else
          Result := CallOld;
      end;

      WM_SIZE: begin
        InvalidateGrip;
        Result := CallOld;
        UpdateGrip;
      end;

      else
        Result := CallOld;
    end;
  end;
end;

{ Note that SetWindowSizeGrip(..., false) does not really remove the hook -
  it just sets "Enabled" to false. The hook plus all data is removed when
  the window is destroyed.
}
procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean);
var
  Info: PGripInfo;
begin
  Info := PGripInfo(GetProp(hWnd, SizeGripProp));
  if (Info = nil) and Enable then
  begin
    New(Info);
    FillChar(Info^, SizeOf(TGripInfo), 0);

    with Info^ do
    begin
      Info^.OldWndProc := TWndProc(Pointer(GetWindowLong(hWnd, GWL_WNDPROC)));

      GetClientRect(hWnd, GripRect);
      GripRect.Left := GripRect.Right - GetSystemMetrics(SM_CXHSCROLL);
      GripRect.Top := GripRect.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    end;

    SetProp(hWnd, SizeGripProp, Cardinal(Info));
    SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@SizeGripWndProc));
  end;

  if (Info <> nil) then
    if Enable <> Info^.Enabled then
      with Info^ do
      begin
        Enabled := Enable;
        if (GripRect.Right > GripRect.Left) and
           (GripRect.Bottom > GripRect.Top) then
          InvalidateRect(hWnd, @GripRect, true);
      end;
end;


{**
  Save a textfile with unicode
}
procedure SaveUnicodeFile(Filename: String; Text: String);
var
  f: TFileStream;
begin
  f := TFileStream.Create(Filename, fmCreate or fmOpenWrite);
  StreamWrite(f, Text);
  f.Free;
end;


{**
  Open a textfile unicode safe and return a stream + its charset
}
procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
  Stream.Position := 0;
  FileCharset := GetFileCharset(Stream);
end;


{**
  Detect a file's character set which can be
  UTF-16 BE with BOM
  UTF-16 LE with BOM
  UTF-8 with or without BOM
  ANSI
  @see http://en.wikipedia.org/wiki/Byte_Order_Mark
}
function GetFileCharset(Stream: TFileStream): TFileCharset;
var
  ByteOrderMark: Char;
  BytesRead: Integer;
  Utf8Test: array[0..2] of AnsiChar;
  Buffer: array of Byte;
  BufferSize, i, FoundUTF8Strings: Integer;
const
  UNICODE_BOM = Char($FEFF);
  UNICODE_BOM_SWAPPED = Char($FFFE);
  UTF8_BOM = AnsiString(#$EF#$BB#$BF);
  MinimumCountOfUTF8Strings = 1;
  MaxBufferSize = $4000;

  // 3 trailing bytes are the maximum in valid UTF-8 streams,
  // so a count of 4 trailing bytes is enough to detect invalid UTF-8 streams
  function CountOfTrailingBytes: Integer;
  begin
    Result := 0;
    inc(i);
    while (i < BufferSize) and (Result < 4) do begin
      if Buffer[i] in [$80..$BF] then
        inc(Result)
      else
        Break;
      inc(i);
    end;
  end;
begin
  // Byte Order Mark
  ByteOrderMark := #0;
  if (Stream.Size - Stream.Position) >= SizeOf(ByteOrderMark) then begin
    BytesRead := Stream.Read(ByteOrderMark, SizeOf(ByteOrderMark));
    if (ByteOrderMark <> UNICODE_BOM) and (ByteOrderMark <> UNICODE_BOM_SWAPPED) then begin
      ByteOrderMark := #0;
      Stream.Seek(-BytesRead, soFromCurrent);
      if (Stream.Size - Stream.Position) >= Length(Utf8Test) * SizeOf(AnsiChar) then begin
        BytesRead := Stream.Read(Utf8Test[0], Length(Utf8Test) * SizeOf(AnsiChar));
        if Utf8Test <> UTF8_BOM then
          Stream.Seek(-BytesRead, soFromCurrent);
      end;
    end;
  end;
  // Test Byte Order Mark
  if ByteOrderMark = UNICODE_BOM then
    Result := fcsUnicode
  else if ByteOrderMark = UNICODE_BOM_SWAPPED then
    Result := fcsUnicodeSwapped
  else if Utf8Test = UTF8_BOM then
    Result := fcsUtf8
  else begin
    { @note Taken from SynUnicode.pas }
    { If no BOM was found, check for leading/trailing byte sequences,
      which are uncommon in usual non UTF-8 encoded text.

      NOTE: There is no 100% save way to detect UTF-8 streams. The bigger
            MinimumCountOfUTF8Strings, the lower is the probability of
            a false positive. On the other hand, a big MinimumCountOfUTF8Strings
            makes it unlikely to detect files with only little usage of non
            US-ASCII chars, like usual in European languages. }

    // if no special characteristics are found it is not UTF-8
    Result := fcsAnsi;

    // if Stream is nil, let Delphi raise the exception, by accessing Stream,
    // to signal an invalid result

    // start analysis at actual Stream.Position
    BufferSize := Min(MaxBufferSize, Stream.Size - Stream.Position);

    if BufferSize > 0 then begin
      SetLength(Buffer, BufferSize);
      Stream.ReadBuffer(Buffer[0], BufferSize);
      Stream.Seek(-BufferSize, soFromCurrent);

      FoundUTF8Strings := 0;
      i := 0;
      while i < BufferSize do begin
        if FoundUTF8Strings = MinimumCountOfUTF8Strings then begin
          Result := fcsUtf8;
          Break;
        end;
        case Buffer[i] of
          $00..$7F: // skip US-ASCII characters as they could belong to various charsets
            ;
          $C2..$DF:
            if CountOfTrailingBytes = 1 then
              inc(FoundUTF8Strings)
            else
              Break;
          $E0:
            begin
              inc(i);
              if (i < BufferSize) and (Buffer[i] in [$A0..$BF]) and (CountOfTrailingBytes = 1) then
                inc(FoundUTF8Strings)
              else
                Break;
            end;
          $E1..$EC, $EE..$EF:
            if CountOfTrailingBytes = 2 then
              inc(FoundUTF8Strings)
            else
              Break;
          $ED:
            begin
              inc(i);
              if (i < BufferSize) and (Buffer[i] in [$80..$9F]) and (CountOfTrailingBytes = 1) then
                inc(FoundUTF8Strings)
              else
                Break;
            end;
          $F0:
            begin
              inc(i);
              if (i < BufferSize) and (Buffer[i] in [$90..$BF]) and (CountOfTrailingBytes = 2) then
                inc(FoundUTF8Strings)
              else
                Break;
            end;
          $F1..$F3:
            if CountOfTrailingBytes = 3 then
              inc(FoundUTF8Strings)
            else
              Break;
          $F4:
            begin
              inc(i);
              if (i < BufferSize) and (Buffer[i] in [$80..$8F]) and (CountOfTrailingBytes = 2) then
                inc(FoundUTF8Strings)
              else
                Break;
            end;
          $C0, $C1, $F5..$FF: // invalid UTF-8 bytes
            Break;
          $80..$BF: // trailing bytes are consumed when handling leading bytes,
                     // any occurence of "orphaned" trailing bytes is invalid UTF-8
            Break;
        end;
        inc(i);
      end;
    end;
  end;
end;

{**
  Read a chunk out of a textfile unicode safe by passing a stream and its charset
}
function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): String;
var
  SA: AnsiString;
  P: PWord;
  DataLeft: Int64;
begin
  DataLeft := Stream.Size - Stream.Position;
  if (ChunkSize = 0) or (ChunkSize > DataLeft) then
    ChunkSize := DataLeft;
  if (FileCharset in [fcsUnicode, fcsUnicodeSwapped]) then begin
    // BOM indicates Unicode text stream
    if ChunkSize < SizeOf(Char) then
      Result := ''
    else begin
      SetLength(Result, ChunkSize div SizeOf(Char));
      Stream.Read(PChar(Result)^, ChunkSize);
      if FileCharset = fcsUnicodeSwapped then begin
        P := PWord(PChar(Result));
        While (P^ <> 0) do begin
          P^ := MakeWord(HiByte(P^), LoByte(P^));
          Inc(P);
        end;
      end;
    end;
  end else if FileCharset = fcsUtf8 then begin
    // BOM indicates UTF-8 text stream
    SetLength(SA, ChunkSize div SizeOf(AnsiChar));
    Stream.Read(PAnsiChar(SA)^, ChunkSize);
    Result := UTF8ToString(SA);
  end else begin
    // without byte order mark it is assumed that we are loading ANSI text
    SetLength(SA, ChunkSize div SizeOf(AnsiChar));
    Stream.Read(PAnsiChar(SA)^, ChunkSize);
    Result := String(SA);
  end;
end;

{**
  Read a unicode or ansi file into memory
}
function ReadTextfile(Filename: String): String;
var
  Stream: TFileStream;
  FileCharset: TFileCharset;
begin
  OpenTextfile(Filename, Stream, FileCharset);
  Result := ReadTextfileChunk(Stream, FileCharset);
  Stream.Free;
end;

function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString;
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
  Stream.Position := 0;
  if (MaxBytes < 1) or (MaxBytes > Stream.Size) then MaxBytes := Stream.Size;
  SetLength(Result, MaxBytes);
  Stream.Read(PAnsiChar(Result)^, Length(Result));
  Stream.Free;
end;


procedure StreamToClipboard(Text, HTML: TStream; CreateHTMLHeader: Boolean);
var
  TextContent, HTMLContent: AnsiString;
  GlobalMem: HGLOBAL;
  lp: PChar;
  ClpLen: Integer;
  CF_HTML: Word;
begin
  // Copy unicode text to clipboard
  if Assigned(Text) then begin
    SetLength(TextContent, Text.Size);
    Text.Position := 0;
    Text.Read(PAnsiChar(TextContent)^, Text.Size);
    Clipboard.AsText := Utf8ToString(TextContent);
    SetString(TextContent, nil, 0);
  end;

  if Assigned(HTML) then begin
    // If wanted, add a HTML portion, so formatted text can be pasted in WYSIWYG
    // editors (mostly MS applications).
    // Note that the content is UTF8 encoded ANSI. Using unicode variables results in raw
    // text pasted in editors. TODO: Find out why and optimize redundant code away by a loop.
    OpenClipBoard(0);
    CF_HTML := RegisterClipboardFormat('HTML Format');
    SetLength(HTMLContent, HTML.Size);
    HTML.Position := 0;
    HTML.Read(PAnsiChar(HTMLContent)^, HTML.Size);
    if CreateHTMLHeader then begin
      HTMLContent := 'Version:0.9' + CRLF +
        'StartHTML:-1' + CRLF +
        'EndHTML:-1' + CRLF +
        'StartFragment:000081' + CRLF +
        'EndFragment:°°°°°°' + CRLF +
        HTMLContent + CRLF;
      HTMLContent := AnsiStrings.StringReplace(
        HTMLContent, '°°°°°°',
        AnsiStrings.Format('%.6d', [Length(HTMLContent)]),
        []);
    end;
    ClpLen := Length(HTMLContent) + 1;
    GlobalMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, ClpLen);
    lp := GlobalLock(GlobalMem);
    Move(PAnsiChar(HTMLContent)^, lp[0], ClpLen);
    SetString(HTMLContent, nil, 0);
    GlobalUnlock(GlobalMem);
    SetClipboardData(CF_HTML, GlobalMem);
    CloseClipboard;
  end;
end;


procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1);
var
  SingleLineHeight: Integer;
  Node: PVirtualNode;
begin
  // Resize hardcoded node height to work with different DPI settings
  VT.BeginUpdate;
  SingleLineHeight := GetTextHeight(VT.Font);
  VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount + 6;
  // The header needs slightly more height than the normal nodes
  VT.Header.Height := Trunc(SingleLineHeight * 1.5);
  // Apply new height to multi line grid nodes
  Node := VT.GetFirstInitialized;
  while Assigned(Node) do begin
    VT.NodeHeight[Node] := VT.DefaultNodeHeight;
    VT.MultiLine[Node] := MultiLineCount > 1;
    Node := VT.GetNextInitialized(Node);
  end;
  VT.EndUpdate;
  // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista
  if (toUseExplorerTheme in VT.TreeOptions.PaintOptions) and IsWindowsVista then
    VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toHotTrack]
  else
    VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions - [toHotTrack];
  VT.OnGetHint := MainForm.vstGetHint;
  VT.OnScroll := MainForm.vstScroll;
  VT.ShowHint := True;
  VT.HintMode := hmToolTip;
  // Apply case insensitive incremental search event
  if VT.IncrementalSearch <> isNone then
    VT.OnIncrementalSearch := Mainform.vstIncrementalSearch;
end;


function GetTextHeight(Font: TFont): Integer;
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  // Code taken from StdCtrls.TCustomEdit.AdjustHeight
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;
end;


function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor;
var
  Lightness: Byte;
begin
  // If base color is bright, make bg color darker (grey), and vice versa, so that
  // colors work with high contrast mode for accessibility
  Lightness := GetLightness(Col);
  if (Lightness < 128) and (Shift < 0) then
    Shift := Abs(Shift)
  else if (Lightness > 128) and (Shift > 0) then
    Shift := 0 - Abs(Shift);
  Result := ColorAdjustLuma(Col, Shift, true);
end;


{**
  Concat all sort options to a ORDER clause
}
function ComposeOrderClause(Cols: TOrderColArray): String;
var
  i : Integer;
  sort : String;
begin
  result := '';
  for i := 0 to Length(Cols) - 1 do
  begin
    if result <> '' then
      result := result + ', ';
    if Cols[i].SortDirection = ORDER_ASC then
      sort := TXT_ASC
    else
      sort := TXT_DESC;
    result := result + Mainform.Mask( Cols[i].ColumnName ) + ' ' + sort;
  end;
end;


{**
  Init main registry object and open desired key
  Outsoureced from GetRegValue() to avoid redundant code
  in these 3 overloaded methods.
}
procedure OpenRegistry(Session: String = '');
var
  folder : String;
begin
  if MainReg = nil then begin
    MainReg := TRegistry.Create;
    HandlePortableSettings(True);
  end;
  folder := RegPath;
  if Session <> '' then
    folder := folder + REGKEY_SESSIONS + Session;
  if MainReg.CurrentPath <> folder then
    MainReg.OpenKey(folder, true);
end;


{**
  Read a numeric preference value from registry
}
function GetRegValue( valueName: String; defaultValue: Integer; Session: String = '' ) : Integer;
begin
  result := defaultValue;
  OpenRegistry(Session);
  if MainReg.ValueExists( valueName ) then
    result := MainReg.ReadInteger( valueName );
end;


{***
  Read a boolean preference value from registry
  @param string Name of the value
  @param boolean Default-value to return if valueName was not found
  @param string Subkey of RegPath where to search for the value
}
function GetRegValue( valueName: String; defaultValue: Boolean; Session: String = '' ) : Boolean;
begin
  result := defaultValue;
  OpenRegistry(Session);
  if MainReg.ValueExists( valueName ) then
    result := MainReg.ReadBool( valueName );
end;



{***
  Read a text preference value from registry
}
function GetRegValue( valueName: String; defaultValue: String; Session: String = '' ) : String;
begin
  result := defaultValue;
  OpenRegistry(Session);
  if MainReg.ValueExists( valueName ) then
    result := MainReg.ReadString( valueName );
end;


procedure DeInitializeVTNodes(Sender: TBaseVirtualTree);
var
  Node: PVirtualNode;
begin
  // Forces a VirtualTree to (re-)initialize its nodes.
  // I wonder why this is not implemented in VirtualTree.
  Node := Sender.GetFirstInitialized;
  while Assigned(Node) do begin
    Node.States := Node.States - [vsInitialized];
    Node := Sender.GetNextInitialized(Node);
  end;
end;


procedure EnableProgressBar(MaxValue: Integer);
begin
  Mainform.ProgressBarStatus.Visible := True;
  Mainform.ProgressBarStatus.Max := MaxValue;
  Mainform.ProgressBarStatus.Position := 0;
end;


function CompareNumbers(List: TStringList; Index1, Index2: Integer): Integer;
var
  Number1, Number2 : Extended;
begin
  // Custom sort method for TStringLists
  Number1 := MakeFloat( List[Index1] );
  Number2 := MakeFloat( List[Index2] );
  if Number1 > Number2 then
    Result := 1
  else if Number1 = Number2 then
    Result := 0
  else
    Result := -1;
end;


function ListIndexByRegExpr(List: TStrings; Expression: String): Integer;
var
  rx: TRegExpr;
  i: Integer;
begin
  // Find item in stringlist by passing a regular expression
  rx := TRegExpr.Create;
  rx.Expression := Expression;
  rx.ModifierI := True;
  Result := -1;
  for i := 0 to List.Count - 1 do begin
    if rx.Exec(List[i]) then begin
      Result := i;
      break;
    end;
  end;
  FreeAndNil(rx);
end;


procedure SelectNode(VT: TVirtualStringTree; idx: Cardinal; ParentNode: PVirtualNode=nil); overload;
var
  Node: PVirtualNode;
begin
  // Helper to focus and highlight a node by its index
  if Assigned(ParentNode) then
    Node := VT.GetFirstChild(ParentNode)
  else
    Node := VT.GetFirst;
  while Assigned(Node) do begin
    if Node.Index = idx then begin
      SelectNode(VT, Node);
      break;
    end;
    Node := VT.GetNextSibling(Node);
  end;
end;


procedure SelectNode(VT: TVirtualStringTree; Node: PVirtualNode); overload;
begin
  VT.ClearSelection;
  VT.FocusedNode := Node;
  VT.Selected[Node] := True;
  VT.ScrollIntoView(Node, False);
end;


function DateBackFriendlyCaption(d: TDateTime): String;
var
  MonthsAgo, DaysAgo, HoursAgo, MinutesAgo: Int64;
begin
  MonthsAgo := MonthsBetween(Now, d);
  DaysAgo := DaysBetween(Now, d);
  HoursAgo := HoursBetween(Now, d);
  MinutesAgo := MinutesBetween(Now, d);
  if MonthsAgo = 1 then Result := FormatNumber(MonthsAgo)+' month ago'
  else if MonthsAgo > 1 then Result := FormatNumber(MonthsAgo)+' months ago'
  else if DaysAgo = 1 then Result := FormatNumber(DaysAgo)+' day ago'
  else if DaysAgo > 1 then Result := FormatNumber(DaysAgo)+' days ago'
  else if HoursAgo = 1 then Result := FormatNumber(HoursAgo)+' hour ago'
  else if HoursAgo > 1 then Result := FormatNumber(HoursAgo)+' hours ago'
  else if MinutesAgo = 1 then Result := FormatNumber(MinutesAgo)+' minute ago'
  else if MinutesAgo > 0 then Result := FormatNumber(MinutesAgo)+' minutes ago'
  else Result := 'less than a minute ago';
end;


procedure ExplodeQuotedList(Text: String; var List: TStringList);
var
  i: Integer;
  Quote: Char;
  Opened, Closed: Boolean;
  Item: String;
begin
  Text := Trim(Text);
  if Length(Text) > 0 then
    Quote := Text[1]
  else
    Quote := '`';
  Opened := False;
  Closed := True;
  Item := '';
  for i:=1 to Length(Text) do begin
    if Text[i] = Quote then begin
      Opened := not Opened;
      Closed := not Closed;
      if Closed then begin
        List.Add(Item);
        Item := '';
      end;
      Continue;
    end;
    if Opened and (not Closed) then
      Item := Item + Text[i];
  end;
end;


procedure InheritFont(AFont: TFont);
begin
  AFont.Name := Mainform.Font.Name;
  AFont.Size := Mainform.Font.Size;
end;


function GetLightness(AColor: TColor): Byte;
var
  R, G, B: Byte;
  MaxValue, MinValue: Double;
  Lightness: Double;
begin
  R := GetRValue(ColorToRGB(AColor));
  G := GetGValue(ColorToRGB(AColor));
  B := GetBValue(ColorToRGB(AColor));
  MaxValue := Max(Max(R,G),B);
  MinValue := Min(Min(R,G),B);
  Lightness := (((MaxValue + MinValue) * 240) + 255 ) / 510;
  Result := Round(Lightness);
end;


procedure ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
var
  ColSpec: String;
  rx, rxCol: TRegExpr;
  i: Integer;
  InLiteral: Boolean;
  Col: TTableColumn;
  Key: TTableKey;
  ForeignKey: TForeignKey;
begin
  if Assigned(Columns) then Columns.Clear;
  if Assigned(Keys) then Keys.Clear;
  if Assigned(ForeignKeys) then ForeignKeys.Clear;
  if CreateTable = '' then
    Exit;
  rx := TRegExpr.Create;
  rx.ModifierS := False;
  rx.ModifierM := True;
  rx.Expression := '^\s+[`"]([^`"]+)[`"]\s(\w+)';
  rxCol := TRegExpr.Create;
  rxCol.ModifierI := True;
  if rx.Exec(CreateTable) then while true do begin
    if not Assigned(Columns) then
      break;
    ColSpec := '';
    for i:=rx.MatchPos[2]+rx.MatchLen[2] to Length(CreateTable) do begin
      if CharInSet(CreateTable[i], [#13, #10]) then
        break;
      ColSpec := ColSpec + CreateTable[i];
    end;

    // Strip trailing comma
    if (ColSpec <> '') and (ColSpec[Length(ColSpec)] = ',') then
      Delete(ColSpec, Length(ColSpec), 1);

    Col := TTableColumn.Create;
    Columns.Add(Col);
    Col.Name := rx.Match[1];
    Col.OldName := Col.Name;
    Col.Status := esUntouched;

    // Datatype
    Col.DataType := GetDatatypeByName(UpperCase(rx.Match[2]));

    // Length / Set
    // Various datatypes, e.g. BLOBs, don't have any length property
    InLiteral := False;
    if (ColSpec <> '') and (ColSpec[1] = '(') then begin
      for i:=2 to Length(ColSpec) do begin
        if (ColSpec[i] = ')') and (not InLiteral) then
          break;
        if ColSpec[i] = '''' then
          InLiteral := not InLiteral;
      end;
      Col.LengthSet := Copy(ColSpec, 2, i-2);
      Delete(ColSpec, 1, i);
    end;
    ColSpec := Trim(ColSpec);

    // Unsigned
    if UpperCase(Copy(ColSpec, 1, 8)) = 'UNSIGNED' then begin
      Col.Unsigned := True;
      Delete(ColSpec, 1, 9);
    end else
      Col.Unsigned := False;

    // Collation
    rxCol.Expression := '^(CHARACTER SET \w+\s+)?COLLATE (\w+)\b';
    if rxCol.Exec(ColSpec) then begin
      Col.Collation := rxCol.Match[2];
      Delete(ColSpec, 1, rxCol.MatchLen[0]+1);
    end;

    // Allow NULL
    if UpperCase(Copy(ColSpec, 1, 8)) = 'NOT NULL' then begin
      Col.AllowNull := False;
      Delete(ColSpec, 1, 9);
    end else begin
      Col.AllowNull := True;
      // Sporadically there is a "NULL" found at this position.
      if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then
        Delete(ColSpec, 1, 5);
    end;

    // Default value
    Col.DefaultType := cdtNothing;
    Col.DefaultText := '';
    if UpperCase(Copy(ColSpec, 1, 14)) = 'AUTO_INCREMENT' then begin
      Col.DefaultType := cdtAutoInc;
      Col.DefaultText := 'AUTO_INCREMENT';
      Delete(ColSpec, 1, 15);
    end else if UpperCase(Copy(ColSpec, 1, 8)) = 'DEFAULT ' then begin
      Delete(ColSpec, 1, 8);
      if UpperCase(Copy(ColSpec, 1, 4)) = 'NULL' then begin
        Col.DefaultType := cdtNull;
        Col.DefaultText := 'NULL';
        Delete(ColSpec, 1, 5);
      end else if UpperCase(Copy(ColSpec, 1, 17)) = 'CURRENT_TIMESTAMP' then begin
        Col.DefaultType := cdtCurTS;
        Col.DefaultText := 'CURRENT_TIMESTAMP';
        Delete(ColSpec, 1, 18);
      end else if ColSpec[1] = '''' then begin
        InLiteral := True;
        for i:=2 to Length(ColSpec) do begin
          if ColSpec[i] = '''' then
            InLiteral := not InLiteral
          else if not InLiteral then
            break;
        end;
        Col.DefaultType := cdtText;
        Col.DefaultText := Copy(ColSpec, 2, i-3);
        // A single quote gets escaped by single quote - remove the escape char - escaping is done in Save action afterwards
        Col.DefaultText := StringReplace(Col.DefaultText, '''''', '''', [rfReplaceAll]);
        Delete(ColSpec, 1, i);
      end;
    end;
    if UpperCase(Copy(ColSpec, 1, 27)) = 'ON UPDATE CURRENT_TIMESTAMP' then begin
      // Adjust default type
      case Col.DefaultType of
        cdtText: Col.DefaultType := cdtTextUpdateTS;
        cdtNull: Col.DefaultType := cdtNullUpdateTS;
        cdtCurTS: Col.DefaultType := cdtCurTSUpdateTS;
      end;
      Delete(ColSpec, 1, 28);
    end;

    // Comment
    if UpperCase(Copy(ColSpec, 1, 9)) = 'COMMENT ''' then begin
      InLiteral := True;
      for i:=10 to Length(ColSpec) do begin
        if ColSpec[i] = '''' then
          InLiteral := not InLiteral
        else if not InLiteral then
          break;
      end;
      Col.Comment := Copy(ColSpec, 10, i-11);
      Col.Comment := StringReplace(Col.Comment, '''''', '''', [rfReplaceAll]);
      Delete(ColSpec, 1, i);
    end;

    if not rx.ExecNext then
      break;
  end;

  // Detect keys
  // PRIMARY KEY (`id`), UNIQUE KEY `id` (`id`), KEY `id_2` (`id`) USING BTREE,
  // KEY `Text` (`Text`(100)), FULLTEXT KEY `Email` (`Email`,`Text`)
  rx.Expression := '^\s+((\w+)\s+)?KEY\s+([`"]?([^`"]+)[`"]?\s+)?\((.+)\)(\s+USING\s+(\w+))?,?$';
  if rx.Exec(CreateTable) then while true do begin
    if not Assigned(Keys) then
      break;
    Key := TTableKey.Create;
    Keys.Add(Key);
    Key.Name := rx.Match[4];
    if Key.Name = '' then Key.Name := rx.Match[2]; // PRIMARY
    Key.OldName := Key.Name;
    Key.IndexType := rx.Match[2];
    Key.Algorithm := rx.Match[7];
    if Key.IndexType = '' then Key.IndexType := 'KEY'; // KEY
    Key.Columns := Explode(',', rx.Match[5]);
    for i:=0 to Key.Columns.Count-1 do begin
      rxCol.Expression := '^[`"]?([^`"]+)[`"]?(\((\d+)\))?$';
      if rxCol.Exec(Key.Columns[i]) then begin
        Key.Columns[i] := rxCol.Match[1];
        Key.SubParts.Add(rxCol.Match[3]);
      end;
    end;
    if not rx.ExecNext then
      break;
  end;

  // Detect foreign keys
  // CONSTRAINT `FK1` FOREIGN KEY (`which`) REFERENCES `fk1` (`id`) ON DELETE SET NULL ON UPDATE CASCADE
  rx.Expression := '\s+CONSTRAINT\s+[`"]([^`"]+)[`"]\sFOREIGN KEY\s+\(([^\)]+)\)\s+REFERENCES\s+[`"]([^\(]+)[`"]\s\(([^\)]+)\)(\s+ON DELETE (RESTRICT|CASCADE|SET NULL|NO ACTION))?(\s+ON UPDATE (RESTRICT|CASCADE|SET NULL|NO ACTION))?';
  if rx.Exec(CreateTable) then while true do begin
    if not Assigned(ForeignKeys) then
      break;
    ForeignKey := TForeignKey.Create;
    ForeignKeys.Add(ForeignKey);
    ForeignKey.KeyName := rx.Match[1];
    ForeignKey.KeyNameWasCustomized := True;
    ForeignKey.ReferenceTable := StringReplace(rx.Match[3], '`', '', [rfReplaceAll]);
    ForeignKey.ReferenceTable := StringReplace(ForeignKey.ReferenceTable, '"', '', [rfReplaceAll]);
    ExplodeQuotedList(rx.Match[2], ForeignKey.Columns);
    ExplodeQuotedList(rx.Match[4], ForeignKey.ForeignColumns);
    if rx.Match[6] <> '' then
      ForeignKey.OnDelete := rx.Match[6];
    if rx.Match[8] <> '' then
      ForeignKey.OnUpdate := rx.Match[8];
    if not rx.ExecNext then
      break;
  end;

  FreeAndNil(rxCol);
  FreeAndNil(rx);
end;


procedure ParseViewStructure(ViewName: String; Columns: TTableColumnList);
var
  rx: TRegExpr;
  Col: TTableColumn;
  Results: TMySQLQuery;
begin
  // Views reveal their columns only with a SHOW COLUMNS query.
  // No keys available in views - SHOW KEYS always returns an empty result
  Columns.Clear;
  rx := TRegExpr.Create;
  rx.Expression := '^(\w+)(\((.+)\))?';
  Results := Mainform.Connection.GetResults('SHOW COLUMNS FROM '+Mainform.mask(ViewName));
  while not Results.Eof do begin
    Col := TTableColumn.Create;
    Columns.Add(Col);
    Col.Name := Results.Col('Field');
    Col.AllowNull := Results.Col('Null') = 'YES';
    if rx.Exec(Results.Col('Type')) then begin
      Col.DataType := GetDatatypeByName(rx.Match[1]);
      Col.LengthSet := rx.Match[2];
    end;
    Results.Next;
  end;
  rx.Free;
end;


function ReformatSQL(SQL: String): String;
var
  AllKeywords, ImportantKeywords: TStringList;
  i, Run, KeywordMaxLen: Integer;
  IsEsc, IsQuote, InComment, InBigComment, InString, InKeyword, InIdent, LastWasComment: Boolean;
  c, p: Char;
  Keyword, PreviousKeyword, TestPair: String;
begin
  // Known SQL keywords, get converted to UPPERCASE
  AllKeywords := TStringList.Create;
  AllKeywords.Text := MySQLKeywords.Text;
  for i:=Low(MySQLFunctions) to High(MySQLFunctions) do begin
    // Leave out operator functions like ">>", and the "X()" function so hex values don't get touched
    if (MySQLFunctions[i].Declaration <> '') and (MySQLFunctions[i].Name <> 'X') then
      AllKeywords.Add(MySQLFunctions[i].Name);
  end;
  for i:=Low(Datatypes) to High(Datatypes) do
    AllKeywords.Add(Datatypes[i].Name);
  KeywordMaxLen := 0;
  for i:=0 to AllKeywords.Count-1 do
    KeywordMaxLen := Max(KeywordMaxLen, Length(AllKeywords[i]));

  // A subset of the above list, each of them will get a linebreak left to it
  ImportantKeywords := Explode(',', 'SELECT,FROM,LEFT,RIGHT,STRAIGHT,NATURAL,INNER,JOIN,WHERE,GROUP,ORDER,HAVING,LIMIT,CREATE,DROP,UPDATE,INSERT,REPLACE,TRUNCATE,DELETE');

  IsEsc := False;
  InComment := False;
  InBigComment := False;
  LastWasComment := False;
  InString := False;
  InIdent := False;
  Run := 1;
  Result := '';
  SQL := SQL + ' ';
  SetLength(Result, Length(SQL)*2);
  Keyword := '';
  PreviousKeyword := '';
  for i:=1 to Length(SQL) do begin
    c := SQL[i]; // Current char
    if i > 1 then p := SQL[i-1] else p := #0; // Previous char

    // Detection logic - where are we?
    if c = '\' then IsEsc := not IsEsc
    else IsEsc := False;
    IsQuote := (c = '''') or (c = '"');
    if SQL[i] = '`' then InIdent := not InIdent;
    if (not IsEsc) and IsQuote then InString := not InString;
    if (c = '#') or ((c = '-') and (p = '-')) then InComment := True;
    if ((c = #10) or (c = #13)) and InComment then begin
      LastWasComment := True;
      InComment := False;
    end;
    if (c = '*') and (p = '/') and (not InComment) and (not InString) then InBigComment := True;
    if (c = '/') and (p = '*') and (not InComment) and (not InString) then InBigComment := False;
    InKeyword := (not InComment) and (not InBigComment) and (not InString) and (not InIdent) and IsLetter(c);

    // Creation of returning text
    if InKeyword then begin
      Keyword := Keyword + c;
    end else begin
      if Keyword <> '' then begin
        if AllKeywords.IndexOf(KeyWord) > -1 then begin
          while (Run > 1) and IsWhitespace(Result[Run-1]) do
            Dec(Run);
          Keyword := UpperCase(Keyword);
          if Run > 1 then begin
            // SELECT, WHERE, JOIN etc. get a new line, but don't separate LEFT JOIN with linebreaks
            if LastWasComment or ((ImportantKeywords.IndexOf(Keyword) > -1) and (ImportantKeywords.IndexOf(PreviousKeyword) = -1)) then
              Keyword := CRLF + Keyword
            else if (Result[Run-1] <> '(') then
              Keyword := ' ' + Keyword;
          end;
          LastWasComment := False;
        end;
        PreviousKeyword := Trim(Keyword);
        Insert(Keyword, Result, Run);
        Inc(Run, Length(Keyword));
        Keyword := '';
      end;
      if (not InComment) and (not InBigComment) and (not InString) and (not InIdent) then begin
        TestPair := Result[Run-1] + c;
        if (TestPair = '  ') or (TestPair = '( ') then begin
          c := Result[Run-1];
          Dec(Run);
        end;
        if (TestPair = ' )') or (TestPair = ' ,') then
          Dec(Run);
      end;
      Result[Run] := c;
      Inc(Run);
    end;

  end;

  // Cut overlength
  SetLength(Result, Run-2);
end;



{ *** TTableColumn }

constructor TTableColumn.Create;
begin
  inherited Create;
end;

destructor TTableColumn.Destroy;
begin
  inherited Destroy;
end;

procedure TTableColumn.SetStatus(Value: TEditingStatus);
begin
  // Set editing flag and enable "Save" button
  if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esModified) then
    Value := esAddedModified
  else if (FStatus in [esAddedUntouched, esAddedModified]) and (Value = esDeleted) then
    Value := esAddedDeleted;
  FStatus := Value;
  if Value <> esUntouched then
    Mainform.TableEditor.Modification(Self);
end;



{ *** TTableKey }

constructor TTableKey.Create;
begin
  inherited Create;
  Columns := TStringList.Create;
  SubParts := TStringList.Create;
  Columns.OnChange := Modification;
  Subparts.OnChange := Modification;
end;

destructor TTableKey.Destroy;
begin
  FreeAndNil(Columns);
  FreeAndNil(SubParts);
  inherited Destroy;
end;

procedure TTableKey.Modification(Sender: TObject);
begin
  if not Added then
    Modified := True;
end;


{ *** TForeignKey }

constructor TForeignKey.Create;
begin
  inherited Create;
  Columns := TStringList.Create;
  ForeignColumns := TStringList.Create;
end;

destructor TForeignKey.Destroy;
begin
  FreeAndNil(Columns);
  FreeAndNil(ForeignColumns);
  inherited Destroy;
end;


{ *** TDBObjectEditor }

constructor TDBObjectEditor.Create(AOwner: TComponent);
begin
  inherited;
  // Do not set alClient via DFM! In conjunction with ExplicitXXX properties that
  // repeatedly breaks the GUI layout when you reload the project
  Align := alClient;
  InheritFont(Font);
end;

destructor TDBObjectEditor.Destroy;
begin
  inherited;
end;

procedure TDBObjectEditor.SetModified(Value: Boolean);
begin
  FModified := Value;
end;

procedure TDBObjectEditor.Init(ObjectName: String=''; ObjectType: TListNodeType=lntNone);
begin
  Mainform.ShowStatusMsg('Initializing editor ...');
  FEditObjectName := ObjectName;
  Mainform.SetEditorTabCaption(Self, FEditObjectName);
  Screen.Cursor := crHourglass;
  MainForm.SetupSynEditors;
end;

function TDBObjectEditor.DeInit: TModalResult;
var
  Msg, ObjType: String;
begin
  // Ask for saving modifications
  Result := mrOk;
  if Modified then begin
    if Self is TfrmTableEditor then ObjType := 'table'
    else if Self is TfrmView then ObjType := 'view'
    else if Self is TfrmRoutineEditor then ObjType := 'routine'
    else if Self is TfrmTriggerEditor then ObjType := 'trigger'
    else ObjType := '<Unknown Type - should never appear>';
    if FEditObjectName <> '' then
      Msg := 'Save modified '+ObjType+' "'+FEditObjectName+'"?'
    else
      Msg := 'Save new '+ObjType+'?';
    Result := MessageDlg(Msg, mtConfirmation, [mbYes, mbNo, mbCancel], 0);
    case Result of
      mrYes: Result := ApplyModifications;
      mrNo: Modified := False;
    end;
  end;
end;



// Following code taken from OneInst.pas, http://assarbad.net/de/stuff/!import/nico.old/
// Slightly modified to better integrate that into our code, comments translated from german.

// Fetch and separate command line parameters into strings
function ParamBlobToStr(lpData: Pointer): TStringlist;
var
  pStr: PChar;
begin
  Result := TStringlist.Create;
  pStr := lpData;
  while pStr[0] <> #0 do
  begin
    Result.Add(string(pStr));
    pStr := @pStr[lstrlen(pStr) + 1];
  end;
end;

// Pack current command line parameters
function ParamStrToBlob(out cbData: DWORD): Pointer;
var
  Loop: Integer;
  pStr: PChar;
begin
  for Loop := 1 to ParamCount do
    cbData := cbData + DWORD(Length(ParamStr(Loop))*2 + 1);
  cbData := cbData + 2; // include appending #0#0
  Result := GetMemory(cbData);
  ZeroMemory(Result, cbData);
  pStr := Result;
  for Loop := 1 to ParamCount do
  begin
    debug(ParamStr(Loop));
    lstrcpy(pStr, PChar(ParamStr(Loop)));
    pStr := @pStr[lstrlen(pStr) + 1];
  end;
end;

procedure HandleSecondInstance;
var
  Run: DWORD;
  Now: DWORD;
  Msg: TMsg;
  Wnd: HWND;
  Dat: TCopyDataStruct;
begin
  // MessageBox(0, 'already running', nil, MB_ICONINFORMATION);
  // Send a message to all main windows (HWND_BROADCAST) with the identical,
  // previously registered message id. We should only get reply from 0 or 1
  // instances.
  // (Broadcast should only be called with registered message ids!)

  SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0);

  // Waiting for reply by first instance. For those of you which didn't knew:
  // Threads have message queues too ;o)
  Wnd := 0;
  Run := GetTickCount;
  while True do
  begin
    if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then
    begin
      GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId);
      if Msg.message = SecondInstMsgId then
      begin
        Wnd := Msg.wParam;
        Break;
      end;
    end;
    Now := GetTickCount;
    if Now < Run then
      Run := Now;  // Avoid overflow, each 48 days.
    if Now - Run > 5000 then
      Break;
  end;

  if (Wnd <> 0) and IsWindow(Wnd) then
  begin
    // As a reply we got a handle to which we now send current parameters
    Dat.dwData := SecondInstMsgId;
    Dat.lpData := ParamStrToBlob(Dat.cbData);
    SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat));
    FreeMemory(Dat.lpData);

    // Bring first instance to front
    if not IsWindowVisible(Wnd) then
      ShowWindow(Wnd, SW_RESTORE);
    BringWindowToTop(Wnd);
    SetForegroundWindow(Wnd);
  end;
end;

function CheckForSecondInstance: Boolean;
var
  Loop: Integer;
  MutexName: PChar;
begin
  // Try to create a system wide named kernel object (mutex). And check if that
  // already exists.
  // The name of such a mutex must not be longer than MAX_PATH (260) chars and
  // can contain all chars but not '\'

  Result := False;
  MutexName := PChar(APPNAME);
  for Loop := lstrlen(MutexName) to MAX_PATH - 1 do
  begin
    MutexHandle := CreateMutex(nil, False, MutexName);
    if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then
      // Looks like there is already a mutex using this name
      // Try to solve that by appending an underscore
      lstrcat(MutexName, '_')
    else
      // At least no naming conflict
      Break;
  end;

  case GetLastError of
    0: begin
        // We created the mutex, so this is the first instance
      end;
    ERROR_ALREADY_EXISTS:
      begin
        // There is already one instance
        try
          HandleSecondInstance;
        finally
          // Terminating is done in .dpr file, before Application.Initialize
          Result := True;
        end;
      end;
  else
    // No clue why we should get here. Oh, maybe Microsoft has changed rules, again.
    // However, we return false and let the application start
  end;
end;


function GetParentFormOrFrame(Comp: TWinControl): TWinControl;
begin
  Result := Comp;
  while True do begin
    Result := Result.Parent;
    // On a windows shutdown, GetParentForm() seems sporadically unable to find the owner form
    // In that case we would cause an exception when accessing it. Emergency break in that case.
    // See issue #1462
    if (not Assigned(Result)) or (Result is TCustomForm) or (Result is TFrame) then
      break;
  end;
end;


function GetIndexIcon(IndexType: String): Integer;
begin
  // Detect key icon index for specified index
  if IndexType = PKEY then Result := ICONINDEX_PRIMARYKEY
  else if IndexType = KEY then Result := ICONINDEX_INDEXKEY
  else if IndexType = UKEY then Result := ICONINDEX_UNIQUEKEY
  else if IndexType = FKEY then Result := ICONINDEX_FULLTEXTKEY
  else if IndexType = SKEY then Result := ICONINDEX_SPATIALKEY
  else Result := -1;
end;


function KeyPressed(Code: Integer): Boolean;
var
  State: TKeyboardState;
begin
  // Checks whether a key is pressed, defined by virtual key code
  GetKeyboardState(State);
  Result := (State[Code] and 128) <> 0;
end;


function GeneratePassword(Len: Integer): String;
var
  i: Integer;
  CharTable: String;
const
  Consos = 'bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ';
  Vocals = 'aeiouAEIOU';
begin
  // Create a random, mnemonic password
  SetLength(Result, Len);
  for i:=1 to Len do begin
    if i mod 2 = 0 then
      CharTable := Vocals
    else
      CharTable := Consos;
    Result[i] := CharTable[Random(Length(CharTable)-1)+1];
  end;
end;


procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean);
begin
  // Avoid AVs in OnDestroy events
  if not Assigned(VT) then
    Exit;
  VT.Tag := RefreshTag;
  if ImmediateRepaint then
    VT.Repaint
  else
    VT.Invalidate;
end;


procedure HandlePortableSettings(StartupMode: Boolean);
var
  Content, FileName, Name, Value, KeyPath: String;
  Lines, Segments, AllKeys: TStringList;
  i: Integer;
  DataType: TRegDataType;
  Proc: TProcessEntry32;
  ProcRuns: Boolean;
  SnapShot: THandle;
  rx: TRegExpr;
const
  Chr10Replacement = '<}}}>';
  Chr13Replacement = '<{{{>';
  Delimiter = '<|||>';

  procedure ReadKeyToContent(Path: String);
  var
    Names: TStringList;
    i: Integer;
    SubPath: String;
  begin
    MainReg.OpenKeyReadOnly(Path);
    SubPath := Copy(Path, Length(RegPath)+1, MaxInt);
    Names := TStringList.Create;
    MainReg.GetValueNames(Names);
    for i:=0 to Names.Count-1 do begin
      DataType := MainReg.GetDataType(Names[i]);
      Content := Content +
        SubPath + Names[i] + Delimiter +
        IntToStr(Integer(DataType)) + Delimiter;
      case DataType of
        rdString: begin
          Value := MainReg.ReadString(Names[i]);
          Value := StringReplace(Value, #13, Chr13Replacement, [rfReplaceAll]);
          Value := StringReplace(Value, #10, Chr10Replacement, [rfReplaceAll]);
        end;
        rdInteger:
          Value := IntToStr(MainReg.ReadInteger(Names[i]));
        rdBinary, rdUnknown, rdExpandString:
          MessageDlg(Names[i]+' has an unsupported data type.', mtError, [mbOK], 0);
      end;
      Content := Content + Value + CRLF;
    end;
    Names.Clear;
    MainReg.GetKeyNames(Names);
    for i:=0 to Names.Count-1 do
      ReadKeyToContent(Path + Names[i] + '\');
    Names.Free;
  end;
begin
  // Export registry keys and values into textfile, for portable reasons
  FileName := ExtractFilePath(ParamStr(0)) + 'portable_settings.txt';
  if not FileExists(FileName) then
    Exit;

  // Open the right key
  if StartupMode then begin
    RegPath := '\Software\' + APPNAME + ' Portable '+IntToStr(GetCurrentProcessId)+'\';
    PortableMode := True;
  end else begin
    // Do not work like a portable on exit, if at application start we didn't either
    if not PortableMode then
      Exit;
  end;

  Screen.Cursor := crHourGlass;
  try
    if StartupMode then begin
      Content := ReadTextfile(FileName);
      Lines := Explode(CRLF, Content);
      for i:=0 to Lines.Count-1 do begin
        // Each line has 3 segments: reg path | data type | value
        Segments := Explode(Delimiter, Lines[i]);
        KeyPath := RegPath + ExtractFilePath(Segments[0]);
        Name := ExtractFileName(Segments[0]);
        DataType := TRegDataType(StrToInt(Segments[1]));
        MainReg.OpenKey(KeyPath, True);
        if MainReg.ValueExists(Name) then
          Continue; // Don't touch value if already there
        Value := '';
        if Segments.Count >= 3 then
          Value := Segments[2];
        case DataType of
          rdString: begin
            Value := StringReplace(Value, Chr13Replacement, #13, [rfReplaceAll]);
            Value := StringReplace(Value, Chr10Replacement, #10, [rfReplaceAll]);
            MainReg.WriteString(Name, Value);
          end;
          rdInteger:
            MainReg.WriteInteger(Name, MakeInt(Value));
          rdBinary, rdUnknown, rdExpandString:
            MessageDlg(Name+' has an unsupported data type.', mtError, [mbOK], 0);
        end;
        Segments.Free;
      end;
      Lines.Free;
    end else begin
      // Application closes: Recursively read values in keys and their subkeys into textfile
      ReadKeyToContent(RegPath);
      SaveUnicodeFile(FileName, Content);
      MainReg.CloseKey;
      MainReg.DeleteKey(RegPath);

      // Remove dead keys from instances which didn't close clean, e.g. because of an AV
      SnapShot := CreateToolhelp32Snapshot(TH32CS_SnapProcess, 0);
      Proc.dwSize := Sizeof(Proc);
      MainReg.OpenKeyReadOnly('\Software\');
      AllKeys := TStringList.Create;
      MainReg.GetKeyNames(AllKeys);
      rx := TRegExpr.Create;
      rx.Expression := '^' + QuoteRegExprMetaChars(APPNAME) + ' Portable (\d+)$';
      for i:=0 to AllKeys.Count-1 do begin
        if not rx.Exec(AllKeys[i]) then
          Continue;
        ProcRuns := False;
        if Process32First(SnapShot, Proc) then while True do begin
          ProcRuns := rx.Match[1] = IntToStr(Proc.th32ProcessID);
          if ProcRuns or (not Process32Next(SnapShot, Proc)) then
            break;
        end;
        if not ProcRuns then
          MainReg.DeleteKey(AllKeys[i]);
      end;
      MainReg.CloseKey;
      CloseHandle(SnapShot);
      AllKeys.Free;
      rx.Free;
    end;
  except
    On E:Exception do
      MessageDlg(E.Message, mtError, [mbOK], 0);
  end;
  Screen.Cursor := crDefault;

end;


function LoadConnectionParams(Session: String): TConnectionParameters;
begin
  if not Mainreg.KeyExists(REGPATH + REGKEY_SESSIONS + Session) then
    raise Exception.Create('Error: Session "'+Session+'" not found in registry.')
  else begin
    Result := TConnectionParameters.Create;
    Result.NetType := TNetType(GetRegValue(REGNAME_NETTYPE, Integer(ntTCPIP), Session));
    Result.Hostname := GetRegValue(REGNAME_HOST, '', Session);
    Result.Username := GetRegValue(REGNAME_USER, '', Session);
    Result.Password := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session));
    Result.Port := StrToIntDef(GetRegValue(REGNAME_PORT, '', Session), DEFAULT_PORT);
    Result.SSHHost := GetRegValue(REGNAME_SSHHOST, '', Session);
    Result.SSHPort := GetRegValue(REGNAME_SSHPORT, DEFAULT_SSHPORT, Session);
    Result.SSHUser := GetRegValue(REGNAME_SSHUSER, '', Session);
    Result.SSHPassword := decrypt(GetRegValue(REGNAME_SSHPASSWORD, '', Session));
    Result.SSHPrivateKey := GetRegValue(REGNAME_SSHKEY, '', Session);
    Result.SSHLocalPort := GetRegValue(REGNAME_SSHLOCALPORT, 0, Session);
    Result.SSHPlinkExe := GetRegValue(REGNAME_PLINKEXE, '');
    Result.SSLPrivateKey := GetRegValue(REGNAME_SSL_KEY, '', Session);
    Result.SSLCertificate := GetRegValue(REGNAME_SSL_CERT, '', Session);
    Result.SSLCACertificate := GetRegValue(REGNAME_SSL_CA, '', Session);
    Result.StartupScriptFilename := GetRegValue(REGNAME_STARTUPSCRIPT, '', Session);
    if GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session) then
      Result.Options := Result.Options + [opCompress]
    else
      Result.Options := Result.Options - [opCompress];
  end;
end;


end.