Issue #1482: first attempt of a code conversion to Lazarus/FPC, with a small bunch of 5 units (out of 50), and most code commented out

.gitignore

@@ -0,0 +1,30 @@
+# Lazarus compiler-generated binaries (safe to delete)
+*.exe
+#*.dll
+#*.so
+*.dylib
+*.lrs
+*.res
+*.compiled
+*.dbg
+*.ppu
+*.o
+*.or
+*.a
+
+# Lazarus autogenerated files (duplicated info)
+*.rst
+*.rsj
+*.lrt
+
+# Lazarus local files (user-specific info)
+*.lps
+
+# Lazarus backups and unit output folders.
+# These can be changed by user in Lazarus/project options.
+backup/
+*.bak
+lib/
+
+# Application bundle for Mac OS
+*.app/

heidisql.lpi

@@ -0,0 +1,121 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="heidisql"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <UseVersionInfo Value="True"/>
+      <MajorVersionNr Value="12"/>
+      <MinorVersionNr Value="10"/>
+    </VersionInfo>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="laz.virtualtreeview_package"/>
+      </Item>
+      <Item>
+        <PackageName Value="SynEditDsgn"/>
+      </Item>
+      <Item>
+        <PackageName Value="SynEdit"/>
+      </Item>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="heidisql.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="source/main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="MainForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+      <Unit>
+        <Filename Value="source/apphelpers.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="source/dbconnection.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="source/dbstructures.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="source/dbstructures.mysql.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="out\heidisql"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="source"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <SyntaxMode Value="Delphi"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <IgnoredMessages idx3177="True" idx3175="True"/>
+      </CompilerMessages>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

heidisql.lpr

@@ -0,0 +1,74 @@
+program heidisql;
+
+{$mode delphi}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  SysUtils,
+  Forms, main,
+  { you can add units after this }
+  apphelpers,
+  dbconnection,
+  //gnugettext
+  dbstructures,
+  dbstructures.mysql
+  ;
+
+{$R *.res}
+{.$R resources.rc}
+
+begin
+  PostponedLogItems := TDBLogItems.Create(True);
+  //Application.MainFormOnTaskBar := True;
+
+  // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS
+  // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator
+  DefaultFormatSettings.DateSeparator := '-';
+  DefaultFormatSettings.TimeSeparator := ':';
+  DefaultFormatSettings.ShortDateFormat := 'yyyy/mm/dd';
+  DefaultFormatSettings.LongTimeFormat := 'hh:nn:ss';
+
+  //AppSettings := TAppSettings.Create;
+  //SecondInstMsgId := RegisterWindowMessage(APPNAME);
+  if false then begin // (not AppSettings.ReadBool(asAllowMultipleInstances)) and CheckForSecondInstance then begin
+    //AppSettings.Free;
+    Application.Terminate;
+  end else begin
+
+    {AppLanguage := AppSettings.ReadString(asAppLanguage);
+    // SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language:
+    SysLanguage := gnugettext.DefaultInstance.GetCurrentLocaleName;
+    gnugettext.UseLanguage(AppLanguage);
+    // First time translation via dxgettext.
+    // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken.
+    gnugettext.TP_GlobalIgnoreClass(TFont);
+
+    // Enable padding in customized tooltips
+    HintWindowClass := TExtHintWindow;}
+
+    RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+    Application.Initialize;
+    //Application.UpdateFormatSettings := False;
+
+    // Try to set style name. If that fails, the user gets an error message box - reset it to default when that happened
+    {WantedStyle := AppSettings.ReadString(asTheme);
+    TStyleManager.TrySetStyle(WantedStyle);
+    if TStyleManager.ActiveStyle.Name <> WantedStyle then begin
+      AppSettings.WriteString(asTheme, TStyleManager.ActiveStyle.Name);
+    end;}
+    Application.CreateForm(TMainForm, MainForm);
+    MainForm.AfterFormCreate;
+    //Application.OnDeactivate := MainForm.ApplicationDeActivate;
+    //Application.OnShowHint := MainForm.ApplicationShowHint;
+    //Application.MainFormOnTaskBar := True;
+    Application.Run;
+  end;
+end.
+

source/const.inc

@@ -0,0 +1,106 @@
+// Common constants
+const
+
+  // Line breaks
+  // TODO: use sLineBreak instead
+  CRLF = #13#10;
+  LB_UNIX = #10;
+  LB_MAC = #13;
+  LB_WIDE = WideChar($2027);
+
+  // Placeholder text for NULL values
+  TEXT_NULL = '(NULL)';
+
+  // General things
+  APPNAME = 'HeidiSQL';
+  APPDOMAIN = 'https://www.heidisql.com/';
+  REGKEY_SESSIONS = 'Servers';
+  REGKEY_QUERYHISTORY = 'QueryHistory';
+  REGKEY_RECENTFILTERS = 'RecentFilters';
+  // Some unique char, used to separate e.g. selected columns in registry
+  DELIM = '|';
+  CHR10REPLACEMENT = '<}}}>';
+  CHR13REPLACEMENT = '<{{{>';
+  LINEDELIMITER = '<|||>';
+
+  COLORSHIFT_NULLFIELDS = 70; // Brightness adjustment to add to normal field colors for NULL values
+  COLORSHIFT_SORTCOLUMNS = 12; // Brightness adjustment to add to sorted column backgrounds
+
+  // Various iconindexes
+  ICONINDEX_PRIMARYKEY = 25;
+  ICONINDEX_FIELD = 42;
+  ICONINDEX_INDEXKEY = 23;
+  ICONINDEX_UNIQUEKEY = 24;
+  ICONINDEX_FULLTEXTKEY = 22;
+  ICONINDEX_SPATIALKEY = 126;
+  ICONINDEX_FOREIGNKEY = 136;
+  ICONINDEX_SERVER = 36;
+  ICONINDEX_DB = 5;
+  ICONINDEX_HIGHLIGHTMARKER = 157;
+  ICONINDEX_TABLE = 14;
+  ICONINDEX_VIEW = 81;
+  ICONINDEX_STOREDPROCEDURE = 119;
+  ICONINDEX_STOREDFUNCTION = 35;
+  ICONINDEX_TRIGGER = 137;
+  ICONINDEX_FUNCTION = 13;
+  ICONINDEX_EVENT = 80;
+  ICONINDEX_KEYWORD = 25;
+
+  // Size of byte units
+  {Kibibyte} SIZE_KB = Int64(1024);
+  {Mebibyte} SIZE_MB = Int64(1048576);
+  {Gibibyte} SIZE_GB = Int64(1073741824);
+  {Tebibyte} SIZE_TB = Int64(1099511627776);
+  {Pebibyte} SIZE_PB = Int64(1125899906842624);
+  {Exbibyte} SIZE_EB = Int64(1152921504606846976);
+
+  // Size of byte units for formatting purposes
+  {Kibibyte} FSIZE_KB = Int64(1000);
+  {Mebibyte} FSIZE_MB = Int64(1024000);
+  {Gibibyte} FSIZE_GB = Int64(1048576000);
+  {Tebibyte} FSIZE_TB = Int64(1073741824000);
+  {Pebibyte} FSIZE_PB = Int64(1099511627776000);
+  {Exbibyte} FSIZE_EB = Int64(1125899906842624000);
+
+  // Abbreviations of byte unit names
+  {Bytes} NAME_BYTES = ' B';
+  {Kibibyte} NAME_KB = ' KiB';
+  {Mebibyte} NAME_MB = ' MiB';
+  {Gibibyte} NAME_GB = ' GiB';
+  {Tebibyte} NAME_TB = ' TiB';
+  {Pebibyte} NAME_PB = ' PiB';
+  {Exbibyte} NAME_EB = ' EiB';
+
+  // Data grid: How many bytes to fetch from data fields that are potentially large.
+  GRIDMAXDATA: Int64 = 256;
+
+  BACKUP_MAXFILESIZE = 10 * SIZE_MB;
+  BACKUP_FILEPATTERN: String = 'query-tab-%s.sql';
+
+  VTREE_NOTLOADED = 0;
+  VTREE_NOTLOADED_PURGECACHE = 1;
+  VTREE_LOADED = 2;
+
+  // Modification indicator for TControl.Tag
+  MODIFIEDFLAG = 10;
+
+  SUnhandledNodeIndex = 'Unhandled tree node index';
+  MSG_NOGRIDEDITING = 'Selected columns don''t contain a sufficient set of key columns to allow editing. Please select primary or unique key columns, or just all columns.';
+  SIdle = 'Idle.';
+  SUnsupported = 'Unsupported by this server';
+  SUnsupportedSettingsDatatype = 'Unsupported datatype for setting "%s"';
+  SNotImplemented = 'Method not implemented for this connection type';
+  MsgSQLError: String = 'SQL Error (%d): %s';
+  MsgSQLErrorMultiStatements: String = 'SQL Error (%d) in statement #%d: %s';
+  MsgUnhandledNetType: String = 'Unhandled connection type (%d)';
+  MsgUnhandledControl: String = 'Unhandled control in %s';
+  MsgDisconnect: String = 'Connection to %s closed at %s';
+  MsgInvalidColumn: String = 'Column #%d not available. Query returned %d columns and %d rows.';
+  FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db';
+  FILEEXT_SQLITEDB = 'sqlite3';
+  PROPOSAL_ITEM_HEIGHT = 18;
+  // Note the following should be in sync to what MySQL returns from SHOW WARNINGS
+  SLogPrefixWarning = 'Warning';
+  SLogPrefixNote = 'Note';
+  SLogPrefixInfo = 'Info';
+

source/dbconnection.pas

@@ -0,0 +1,37 @@
+unit dbconnection;
+
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections, Generics.Defaults;
+
+type
+  TDBConnection = class;
+
+  { TDBConnection }
+
+  TDBLogCategory = (lcInfo, lcSQL, lcUserFiredSQL, lcError, lcDebug, lcScript);
+  TDBLogItem = class(TObject)
+    public
+      Category: TDBLogCategory;
+      LineText: String;
+      Connection: TDBConnection;
+  end;
+  TDBLogItems = TObjectList<TDBLogItem>;
+  TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object;
+  TDBEvent = procedure(Connection: TDBConnection; Database: String) of object;
+
+  TDBConnection = class(TComponent)
+    private
+      FActive: Boolean;
+    public
+  end;
+  TDBConnectionList = TObjectList<TDBConnection>;
+
+
+implementation
+
+end.
+

source/dbstructures.pas

@@ -0,0 +1,218 @@
+unit dbstructures;
+
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Graphics;
+
+
+type
+
+  // Column types
+  TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial,
+    dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney,
+    dbdtDate, dbdtTime, dbdtYear, dbdtDatetime, dbdtDatetime2, dbdtDatetimeOffset, dbdtSmalldatetime, dbdtTimestamp, dbdtInterval,
+    dbdtChar, dbdtNchar, dbdtVarchar, dbdtNvarchar, dbdtTinytext, dbdtText, dbdtCiText, dbdtNtext, dbdtMediumtext, dbdtLongtext,
+    dbdtJson, dbdtJsonB, dbdtCidr, dbdtInet, dbdtMacaddr,
+    dbdtBinary, dbdtVarbinary, dbdtTinyblob, dbdtBlob, dbdtMediumblob, dbdtLongblob, dbdtVector, dbdtImage,
+    dbdtEnum, dbdtSet, dbdtBit, dbdtVarBit, dbdtBool, dbdtRegClass, dbdtRegProc, dbdtUnknown,
+    dbdtCursor, dbdtSqlvariant, dbdtTable, dbdtUniqueidentifier, dbdtInet4, dbdtInet6, dbdtHierarchyid, dbdtXML,
+    dbdtPoint, dbdtLinestring, dbdtLineSegment, dbdtPolygon, dbdtGeometry, dbdtBox, dbdtPath, dbdtCircle, dbdtMultipoint, dbdtMultilinestring, dbdtMultipolygon, dbdtGeometrycollection
+    );
+
+  // Column type categorization
+  TDBDatatypeCategoryIndex = (dtcInteger, dtcReal, dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther);
+
+  // Column type structure
+  TDBDatatype = record
+    Index:           TDBDatatypeIndex;
+    NativeType:      Integer; // MySQL column type constant (e.g. 1 = TINYINT). See include/mysql.h.pp.
+    NativeTypes:     String;  // Same as above, but for multiple ids (e.g. PostgreSQL oids). Prefer over NativeType. See GetDatatypeByNativeType.
+    Name:            String;
+    Names:           String;
+    Description:     String;
+    HasLength:       Boolean; // Can have Length- or Set-attribute?
+    RequiresLength:  Boolean; // Must have a Length- or Set-attribute?
+    MaxSize:         Int64;
+    DefaultSize:     Int64;   // TEXT and BLOB allow custom length, but we want to leave the default max length away from ALTER TABLE's
+    HasBinary:       Boolean; // Can be binary?
+    HasDefault:      Boolean; // Can have a default value?
+    LoadPart:        Boolean; // Select per SUBSTR() or LEFT()
+    DefLengthSet:    String;  // Should be set for types which require a length/set
+    Format:          String;  // Used for date/time values when displaying and generating queries
+    ValueMustMatch:  String;
+    Category:        TDBDatatypeCategoryIndex;
+    MinVersion:      Integer;
+  end;
+
+  // Column type category structure
+  TDBDatatypeCategory = record
+    Index:           TDBDatatypeCategoryIndex;
+    Name:            String;
+    Color:           TColor;
+    NullColor:       TColor;
+  end;
+
+  // Server variables
+  TVarScope = (vsGlobal, vsSession, vsBoth);
+  TServerVariable = record
+    Name: String;
+    IsDynamic: Boolean;
+    VarScope: TVarScope;
+    EnumValues: String;
+  end;
+
+  // Custom exception class for any connection or database related error
+  EDbError = class(Exception)
+    private
+      FErrorCode: Cardinal;
+      FHint: String;
+    public
+      property ErrorCode: Cardinal read FErrorCode;
+      property Hint: String read FHint;
+      constructor Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String='');
+  end;
+
+  // DLL loading
+  TDbLib = class(TObject)
+    const
+      LIB_PROC_ERROR: Cardinal = 1000;
+    private
+      FHandle: TLibHandle;
+    protected
+      FDllFile: String;
+      procedure AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True);
+      procedure AssignProcedures; virtual; abstract;
+    public
+      property Handle: TLibHandle read FHandle;
+      property DllFile: String read FDllFile;
+      constructor Create(DllFile_, DefaultDll: String); virtual;
+      destructor Destroy; override;
+  end;
+
+
+var
+
+  // Column type categories
+  DatatypeCategories: array[TDBDatatypeCategoryIndex] of TDBDatatypeCategory = (
+    (
+      Index:           dtcInteger;
+      Name:            'Integer'
+    ),
+    (
+      Index:           dtcReal;
+      Name:            'Real'
+    ),
+    (
+      Index:           dtcText;
+      Name:            'Text'
+    ),
+    (
+      Index:           dtcBinary;
+      Name:            'Binary'
+    ),
+    (
+      Index:           dtcTemporal;
+      Name:            'Temporal (time)'
+    ),
+    (
+      Index:           dtcSpatial;
+      Name:            'Spatial (geometry)'
+    ),
+    (
+      Index:           dtcOther;
+      Name:            'Other'
+    )
+  );
+
+
+
+implementation
+
+uses apphelpers;
+
+
+
+{ EDbError }
+
+constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String='');
+begin
+  FErrorCode := ErrorCode_;
+  FHint := Hint_;
+  inherited Create(Msg);
+end;
+
+
+
+{ TDbLib }
+
+constructor TDbLib.Create(DllFile_, DefaultDll: String);
+var
+  msg, ErrorHint: String;
+begin
+  // Load DLL as is (with or without path)
+  inherited Create;
+  FDllFile := DllFile_;
+  if not FileExists(FDllFile) then begin
+    msg := f_('File does not exist: %s', [FDllFile]) +
+      sLineBreak + sLineBreak +
+      f_('Please launch %s from the directory where you have installed it. Or just reinstall %s.', [APPNAME, APPNAME]
+      );
+    Raise EdbError.Create(msg);
+  end;
+
+  FHandle := LoadLibrary(FDllFile);
+  if FHandle = NilHandle then begin
+    msg := f_('Library %s could not be loaded. Please select a different one.',
+      [ExtractFileName(FDllFile)]
+      );
+    if GetLastOSError <> 0 then begin
+      msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]);
+    end;
+    if (DefaultDll <> '') and (ExtractFileName(FDllFile) <> DefaultDll) then begin
+      ErrorHint := f_('You could try the default library %s in your session settings. (Current: %s)',
+        [DefaultDll, ExtractFileName(FDllFile)]
+        );
+    end else begin
+      ErrorHint := '';
+    end;
+    Raise EDbError.Create(msg, GetLastOSError, ErrorHint);
+  end;
+
+  // Dll was loaded, now initialize required procedures
+  AssignProcedures;
+end;
+
+
+destructor TDbLib.Destroy;
+begin
+  if FHandle <> 0 then begin
+    FreeLibrary(FHandle);
+    FHandle := 0;
+  end;
+  inherited;
+end;
+
+
+procedure TDbLib.AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True);
+var
+  msg: String;
+begin
+  // Map library procedure to internal procedure
+  Proc := GetProcAddress(FHandle, Name);
+  if Proc = nil then begin
+    if Mandantory then begin
+      msg := f_('Library error in %s: Could not find procedure address for "%s"',
+        [ExtractFileName(FDllFile), Name]
+        );
+      if GetLastOSError <> 0 then
+        msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]);
+      Raise EDbError.Create(msg, LIB_PROC_ERROR);
+    end;
+  end;
+end;
+
+
+end.