diff --git a/.github/workflows/lazarus.yaml b/.github/workflows/lazarus.yaml index 3460aa1e6..82bee9b6a 100644 --- a/.github/workflows/lazarus.yaml +++ b/.github/workflows/lazarus.yaml @@ -46,6 +46,21 @@ jobs: echo Building with Windows make build-win64 + - name: Verify PE flags (Windows) + if: ${{ matrix.operating-system == 'windows-latest' }} + shell: pwsh + run: | + & .\extra\peflags\peflags.exe .\out\win64\heidisql.exe --check --policy + $code = $LASTEXITCODE + Write-Host "peflags policy exit code: $code" + if (($code -band 1) -ne 0) { throw 'DYNAMICBASE not set' } + if (($code -band 4) -ne 0) { throw 'NXCOMPAT not set' } + if (($code -band 8) -ne 0) { throw 'HIGH_ENTROPY_VA not set on PE32+' } + if (($code -band 2) -ne 0) { + Write-Warning 'ASLR is not effective on the Lazarus Windows build due to missing/unusable relocation directory.' + } + exit 0 + - name: Upload binaries Windows if: ${{ matrix.operating-system == 'windows-latest' && matrix.lazarus-versions == 'stable' }} uses: actions/upload-artifact@v4 @@ -163,12 +178,18 @@ jobs: - name: Install FPM run: sudo gem install --no-document fpm + - name: Install rpm tooling for fpm + run: sudo apt-get update && sudo apt-get install -y rpm + - name: Create release archives (Linux GTK) run: make tar-gtk2 - name: Create debian package run: make deb-package + - name: Build rpm package + run: make rpm-package + - name: Create release archives (Linux QT5) run: make tar-qt5 diff --git a/Makefile b/Makefile index 9c0b75c38..f75285ed5 100644 --- a/Makefile +++ b/Makefile @@ -11,6 +11,7 @@ BINGTK := ./out/gtk2/heidisql BINQT5 := ./out/qt5/heidisql BINQT6 := ./out/qt6/heidisql BINMACOS := ./out/macos/heidisql +PEFLAGS := ./extra/peflags/peflags.exe # Make shell magic to get version from somewhere #VERSION := shell magic @@ -46,6 +47,8 @@ build-win64: lazbuild $(OPTS) $(LPI) @mkdir -p ./out/win64 @mv -v "$(BIN).exe" "$(BINWIN64)" + @"$(PEFLAGS)" "$(BINWIN64)" --set --all + @"$(PEFLAGS)" "$(BINWIN64)" --check run-win64: @echo "Not implemented yet." @@ -120,6 +123,38 @@ deb-package: ./deb/=/ rm control.txt +rpm-package: + @echo "=== Creating rpm package" + rm -vrf rpm + cp -R package-skeleton rpm + find rpm -iname ".gitkeep" -exec rm -v {} + + cp -vR extra/locale/*.mo rpm/usr/share/heidisql/locale + cp -v extra/ini/*.ini rpm/usr/share/heidisql + cp -v res/deb-package-icon.png rpm/usr/share/pixmaps/heidisql.png + cp -v $(BINQT6) rpm/usr/share/heidisql/heidisql + chmod +x rpm/usr/share/heidisql/heidisql + cp -v README.md LICENSE rpm/usr/share/doc/heidisql + mkdir -p dist + rm -vf dist/*.rpm + + fpm -s dir -t rpm -n heidisql -v $(VERSION) \ + -p dist \ + --verbose \ + --rpm-os linux \ + --description "HeidiSQL SQL client (Qt6)" \ + --url "https://www.heidisql.com" \ + --license "GPL-2.0-or-later" \ + --depends "libQt6Widgets.so.6" \ + --depends "libQt6Gui.so.6" \ + --depends "libQt6Core.so.6" \ + --depends "libQt6Pas.so.6" \ + --depends "libssl.so.3" \ + --depends "libmariadb.so.3" \ + --depends "libpq.so.5" \ + --depends "libsqlite3.so.0" \ + --depends "libsybdb.so.5" \ + ./rpm/=/ + tar-gtk2: @echo "=== Creating GTK2 archive" rm -vrf tar diff --git a/extra/dll/sqlite3.dll b/extra/dll/sqlite3.dll index 753630dd6..ae8492c56 100644 Binary files a/extra/dll/sqlite3.dll and b/extra/dll/sqlite3.dll differ diff --git a/extra/dll/sqlite3mc.dll b/extra/dll/sqlite3mc.dll index 3b11541a0..9affcfb99 100644 Binary files a/extra/dll/sqlite3mc.dll and b/extra/dll/sqlite3mc.dll differ diff --git a/extra/locale/heidisql.bg.mo b/extra/locale/heidisql.bg.mo index 20babcc14..3e1b83d79 100644 Binary files a/extra/locale/heidisql.bg.mo and b/extra/locale/heidisql.bg.mo differ diff --git a/extra/locale/heidisql.cs.mo b/extra/locale/heidisql.cs.mo index b2dcb0ded..556804073 100644 Binary files a/extra/locale/heidisql.cs.mo and b/extra/locale/heidisql.cs.mo differ diff --git a/extra/locale/heidisql.da.mo b/extra/locale/heidisql.da.mo index b298dcc55..7701e7078 100644 Binary files a/extra/locale/heidisql.da.mo and b/extra/locale/heidisql.da.mo differ diff --git a/extra/locale/heidisql.de.mo b/extra/locale/heidisql.de.mo index 70cf531c3..176a3bbac 100644 Binary files a/extra/locale/heidisql.de.mo and b/extra/locale/heidisql.de.mo differ diff --git a/extra/locale/heidisql.es.mo b/extra/locale/heidisql.es.mo index 32ff3e19b..1883d7f99 100644 Binary files a/extra/locale/heidisql.es.mo and b/extra/locale/heidisql.es.mo differ diff --git a/extra/locale/heidisql.fi.mo b/extra/locale/heidisql.fi.mo index 94b45022a..a699ea66a 100644 Binary files a/extra/locale/heidisql.fi.mo and b/extra/locale/heidisql.fi.mo differ diff --git a/extra/locale/heidisql.fr.mo b/extra/locale/heidisql.fr.mo index 097a69dd2..e722289cf 100644 Binary files a/extra/locale/heidisql.fr.mo and b/extra/locale/heidisql.fr.mo differ diff --git a/extra/locale/heidisql.hu.mo b/extra/locale/heidisql.hu.mo index cf40eec29..f2846f944 100644 Binary files a/extra/locale/heidisql.hu.mo and b/extra/locale/heidisql.hu.mo differ diff --git a/extra/locale/heidisql.id.mo b/extra/locale/heidisql.id.mo index 9140e950f..32c013a61 100644 Binary files a/extra/locale/heidisql.id.mo and b/extra/locale/heidisql.id.mo differ diff --git a/extra/locale/heidisql.it.mo b/extra/locale/heidisql.it.mo index d3accb2c0..2e2f4f655 100644 Binary files a/extra/locale/heidisql.it.mo and b/extra/locale/heidisql.it.mo differ diff --git a/extra/locale/heidisql.ja.mo b/extra/locale/heidisql.ja.mo index 65fb0215c..ea12ca62c 100644 Binary files a/extra/locale/heidisql.ja.mo and b/extra/locale/heidisql.ja.mo differ diff --git a/extra/locale/heidisql.ko.mo b/extra/locale/heidisql.ko.mo index 6e5bd08ca..c13979588 100644 Binary files a/extra/locale/heidisql.ko.mo and b/extra/locale/heidisql.ko.mo differ diff --git a/extra/locale/heidisql.nl.mo b/extra/locale/heidisql.nl.mo index e59e39433..11ae7275c 100644 Binary files a/extra/locale/heidisql.nl.mo and b/extra/locale/heidisql.nl.mo differ diff --git a/extra/locale/heidisql.no.mo b/extra/locale/heidisql.no.mo index f33660a06..e2e38a25e 100644 Binary files a/extra/locale/heidisql.no.mo and b/extra/locale/heidisql.no.mo differ diff --git a/extra/locale/heidisql.pl.mo b/extra/locale/heidisql.pl.mo index 227faa0b0..5d43932b0 100644 Binary files a/extra/locale/heidisql.pl.mo and b/extra/locale/heidisql.pl.mo differ diff --git a/extra/locale/heidisql.po b/extra/locale/heidisql.po index 1db89328b..274efe278 100644 --- a/extra/locale/heidisql.po +++ b/extra/locale/heidisql.po @@ -7,7 +7,7 @@ msgid "" msgstr "" "Project-Id-Version: HeidiSQL\n" "POT-Creation-Date: 2012-11-05 21:40\n" -"PO-Revision-Date: 2026-02-28 15:20+0100\n" +"PO-Revision-Date: 2026-06-03 17:02+0200\n" "Last-Translator: Ansgar Becker \n" "Language-Team: English (http://www.transifex.com/projects/p/heidisql/language/en/)\n" "Language: en\n" @@ -352,6 +352,9 @@ msgstr "Use Windows authentication" msgid "Enable cleartext authentication" msgstr "Enable cleartext authentication" +msgid "Force Unicode (disable on old servers only)" +msgstr "Force Unicode (disable on old servers only)" + #. connform..PageControlDetails..tabSettings..chkLocalTimeZone....Hint #: connections.dfm:406 msgid "Use your client time zone in date/time SQL functions, e.g. NOW(), for MySQL 4.1.3+" @@ -2605,6 +2608,9 @@ msgstr "Explore folder" msgid "Clear query history ..." msgstr "Clear query history ..." +msgid "Delete this query from history" +msgstr "Delete this query from history" + #. MainForm..popupQueryHelpers..menuQueryHelpersGenerateInsert..Caption #: main.dfm:9218 msgid "Generate %s ..." @@ -4928,6 +4934,9 @@ msgstr "Could not find node to focus." msgid "Could not load full row data." msgstr "Could not load full row data." +msgid "Column %s is defined as generated per \"%s\". You cannot edit its content." +msgstr "Column %s is defined as generated per \"%s\". You cannot edit its content." + #: main.pas:8462 msgid "Not available on %s" msgstr "Not available on %s" @@ -5436,8 +5445,8 @@ msgid "Unhandled privilege object: %s" msgstr "Unhandled privilege object: %s" #: usermanager.pas:1297 -msgid "Delete user %s@%s?" -msgstr "Delete user %s@%s?" +msgid "Delete user or role %s?" +msgstr "Delete user or role %s?" #. dbconnection.pas msgid "Yes" @@ -6443,9 +6452,6 @@ msgstr "Hide database pattern:" msgid "Backup file could not be deleted: %s" msgstr "Backup file could not be deleted: %s" -msgid "Your code is saved anyway, as auto-restoring is activated." -msgstr "Your code is saved anyway, as auto-restoring is activated." - #. Tab caption in preferences msgid "Files and tabs" msgstr "Files and tabs" @@ -6800,3 +6806,51 @@ msgstr "Reverse" msgid "Show reverse foreign keys" msgstr "Show reverse foreign keys" + +msgid "Login cancelled" +msgstr "Login cancelled" + +msgid "Folder in path does not exist: %s" +msgstr "Folder in path does not exist: %s" + +msgid "File does not yet exist, will be created now: %s" +msgstr "File does not yet exist, will be created now: %s" + +msgid "Create role" +msgstr "Create role" + +msgid "Role name" +msgstr "Role name" + +msgid "Roles" +msgstr "Roles" + +msgid "Assigned" +msgstr "Assigned" + +msgid "Yes, with admin option" +msgstr "Yes, with admin option" + +msgid "No password hash column available" +msgstr "No password hash column available" + +msgid "Default role:" +msgstr "Default role:" + +msgid "Plugin:" +msgstr "Plugin:" + +msgid "Foreign key table not found" +msgstr "Foreign key table not found" + +msgid "Copy formatted text" +msgstr "Copy formatted text" + +msgid "Copies selected text with formatting from current editor to clipboard" +msgstr "Copies selected text with formatting from current editor to clipboard" + +msgid "Edit value without foreign key lookup" +msgstr "Edit value without foreign key lookup" + +msgid "Only focused column (%s)" +msgstr "Only focused column (%s)" diff --git a/extra/locale/heidisql.pt.mo b/extra/locale/heidisql.pt.mo index 90845471f..95ab1ed6c 100644 Binary files a/extra/locale/heidisql.pt.mo and b/extra/locale/heidisql.pt.mo differ diff --git a/extra/locale/heidisql.pt_BR.mo b/extra/locale/heidisql.pt_BR.mo index 3d767a850..d3017d69e 100644 Binary files a/extra/locale/heidisql.pt_BR.mo and b/extra/locale/heidisql.pt_BR.mo differ diff --git a/extra/locale/heidisql.ro.mo b/extra/locale/heidisql.ro.mo index ba57656a9..a1aad45eb 100644 Binary files a/extra/locale/heidisql.ro.mo and b/extra/locale/heidisql.ro.mo differ diff --git a/extra/locale/heidisql.ru.mo b/extra/locale/heidisql.ru.mo index a8d4cf56b..f18537045 100644 Binary files a/extra/locale/heidisql.ru.mo and b/extra/locale/heidisql.ru.mo differ diff --git a/extra/locale/heidisql.sk.mo b/extra/locale/heidisql.sk.mo index c08838717..2f417ec00 100644 Binary files a/extra/locale/heidisql.sk.mo and b/extra/locale/heidisql.sk.mo differ diff --git a/extra/locale/heidisql.sv.mo b/extra/locale/heidisql.sv.mo index b8ac323ab..5ad1c7087 100644 Binary files a/extra/locale/heidisql.sv.mo and b/extra/locale/heidisql.sv.mo differ diff --git a/extra/locale/heidisql.ta.mo b/extra/locale/heidisql.ta.mo index 877c3e965..4c9e4f239 100644 Binary files a/extra/locale/heidisql.ta.mo and b/extra/locale/heidisql.ta.mo differ diff --git a/extra/locale/heidisql.tr.mo b/extra/locale/heidisql.tr.mo index 695d934b5..9fceb509c 100644 Binary files a/extra/locale/heidisql.tr.mo and b/extra/locale/heidisql.tr.mo differ diff --git a/extra/locale/heidisql.uk.mo b/extra/locale/heidisql.uk.mo index 960f2e49e..c1592c8c3 100644 Binary files a/extra/locale/heidisql.uk.mo and b/extra/locale/heidisql.uk.mo differ diff --git a/extra/locale/heidisql.vi.mo b/extra/locale/heidisql.vi.mo index 4540380d5..878d07fe7 100644 Binary files a/extra/locale/heidisql.vi.mo and b/extra/locale/heidisql.vi.mo differ diff --git a/extra/locale/heidisql.zh.mo b/extra/locale/heidisql.zh.mo index c7ee9bd65..784e04b68 100644 Binary files a/extra/locale/heidisql.zh.mo and b/extra/locale/heidisql.zh.mo differ diff --git a/extra/locale/heidisql.zh_CN.mo b/extra/locale/heidisql.zh_CN.mo index e4d8f5c4a..4aa79cb53 100644 Binary files a/extra/locale/heidisql.zh_CN.mo and b/extra/locale/heidisql.zh_CN.mo differ diff --git a/extra/locale/heidisql.zh_TW.mo b/extra/locale/heidisql.zh_TW.mo index 6f14148e8..16c769b17 100644 Binary files a/extra/locale/heidisql.zh_TW.mo and b/extra/locale/heidisql.zh_TW.mo differ diff --git a/extra/peflags/peflags.exe b/extra/peflags/peflags.exe new file mode 100644 index 000000000..1a694e687 Binary files /dev/null and b/extra/peflags/peflags.exe differ diff --git a/extra/peflags/peflags.lpi b/extra/peflags/peflags.lpi new file mode 100644 index 000000000..2941ad4b1 --- /dev/null +++ b/extra/peflags/peflags.lpi @@ -0,0 +1,57 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="peflags.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="peflags"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/extra/peflags/peflags.lpr b/extra/peflags/peflags.lpr new file mode 100644 index 000000000..72c80a03e --- /dev/null +++ b/extra/peflags/peflags.lpr @@ -0,0 +1,528 @@ +program peflags; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$APPTYPE CONSOLE} + +uses + SysUtils, Classes; + +const + IMAGE_DOS_SIGNATURE = $5A4D; + IMAGE_NT_SIGNATURE = $00004550; + IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10B; + IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20B; + + IMAGE_FILE_RELOCS_STRIPPED = $0001; + + IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA = $0020; + IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE = $0040; + IMAGE_DLLCHARACTERISTICS_NX_COMPAT = $0100; + +type + TImageDosHeader = packed record + e_magic: Word; + e_cblp: Word; + e_cp: Word; + e_crlc: Word; + e_cparhdr: Word; + e_minalloc: Word; + e_maxalloc: Word; + e_ss: Word; + e_sp: Word; + e_csum: Word; + e_ip: Word; + e_cs: Word; + e_lfarlc: Word; + e_ovno: Word; + e_res: array[0..3] of Word; + e_oemid: Word; + e_oeminfo: Word; + e_res2: array[0..9] of Word; + e_lfanew: LongInt; + end; + + TImageFileHeader = packed record + Machine: Word; + NumberOfSections: Word; + TimeDateStamp: Cardinal; + PointerToSymbolTable: Cardinal; + NumberOfSymbols: Cardinal; + SizeOfOptionalHeader: Word; + Characteristics: Word; + end; + + TImageSectionHeader = packed record + Name: array[0..7] of AnsiChar; + VirtualSize: Cardinal; + VirtualAddress: Cardinal; + SizeOfRawData: Cardinal; + PointerToRawData: Cardinal; + PointerToRelocations: Cardinal; + PointerToLinenumbers: Cardinal; + NumberOfRelocations: Word; + NumberOfLinenumbers: Word; + Characteristics: Cardinal; + end; + + TPEInfo = record + IsPE32Plus: Boolean; + NumberOfSections: Word; + FileCharacteristics: Word; + DllCharacteristics: Word; + ChecksumOffset: Int64; + DllCharacteristicsOffset: Int64; + RelocDirRVA: Cardinal; + RelocDirSize: Cardinal; + SectionTableOffset: Int64; + HasRelocSectionMapping: Boolean; + RelocSectionName: string; + RelocFileOffset: Cardinal; + end; + +function BoolToYesNo(B: Boolean): string; +begin + if B then + Result := 'yes' + else + Result := 'no'; +end; + +function HasFlag(Value, Flag: Word): Boolean; +begin + Result := (Value and Flag) <> 0; +end; + +procedure ReadBufferExact(Stream: TStream; var Buffer; Count: Longint); +begin + if Stream.Read(Buffer, Count) <> Count then + raise Exception.Create('Unexpected end of file'); +end; + +procedure WriteBufferExact(Stream: TStream; const Buffer; Count: Longint); +begin + if Stream.Write(Buffer, Count) <> Count then + raise Exception.Create('Write error'); +end; + +function TrimSectionName(const Name: array of AnsiChar): string; +var + I: Integer; + L: Integer; +begin + L := Length(Name); + while (L > 0) and (Name[L - 1] = #0) do + Dec(L); + SetLength(Result, L); + for I := 0 to L - 1 do + Result[I + 1] := Char(Name[I]); +end; + +function RVAToFileOffset(Stream: TStream; SectionTableOffset: Int64; NumberOfSections: Word; + RVA: Cardinal; out FileOffset: Cardinal; out SectionName: string): Boolean; +var + I: Integer; + SH: TImageSectionHeader; + SectSize: Cardinal; +begin + Result := False; + FileOffset := 0; + SectionName := ''; + + Stream.Position := SectionTableOffset; + for I := 0 to NumberOfSections - 1 do + begin + ReadBufferExact(Stream, SH, SizeOf(SH)); + + if SH.VirtualSize <> 0 then + SectSize := SH.VirtualSize + else + SectSize := SH.SizeOfRawData; + + if (RVA >= SH.VirtualAddress) and (RVA < SH.VirtualAddress + SectSize) then + begin + if SH.PointerToRawData = 0 then + Exit; + FileOffset := SH.PointerToRawData + (RVA - SH.VirtualAddress); + if FileOffset >= Cardinal(Stream.Size) then + Exit; + SectionName := TrimSectionName(SH.Name); + Result := True; + Exit; + end; + end; +end; + +function LoadPEInfo(Stream: TStream; out Info: TPEInfo): Boolean; +var + Dos: TImageDosHeader; + Sig: Cardinal; + FH: TImageFileHeader; + Magic: Word; + OptStart: Int64; +begin + Result := False; + FillChar(Info, SizeOf(Info), 0); + + Stream.Position := 0; + if Stream.Size < SizeOf(Dos) then + Exit; + + ReadBufferExact(Stream, Dos, SizeOf(Dos)); + if Dos.e_magic <> IMAGE_DOS_SIGNATURE then + Exit; + if Dos.e_lfanew < 0 then + Exit; + + Stream.Position := Dos.e_lfanew; + ReadBufferExact(Stream, Sig, SizeOf(Sig)); + if Sig <> IMAGE_NT_SIGNATURE then + Exit; + + ReadBufferExact(Stream, FH, SizeOf(FH)); + Info.NumberOfSections := FH.NumberOfSections; + Info.FileCharacteristics := FH.Characteristics; + + OptStart := Stream.Position; + ReadBufferExact(Stream, Magic, SizeOf(Magic)); + + case Magic of + IMAGE_NT_OPTIONAL_HDR32_MAGIC: + begin + Info.IsPE32Plus := False; + Info.ChecksumOffset := OptStart + 64; + Info.DllCharacteristicsOffset := OptStart + 70; + end; + IMAGE_NT_OPTIONAL_HDR64_MAGIC: + begin + Info.IsPE32Plus := True; + Info.ChecksumOffset := OptStart + 64; + Info.DllCharacteristicsOffset := OptStart + 70; + end; + else + Exit; + end; + + Stream.Position := Info.DllCharacteristicsOffset; + ReadBufferExact(Stream, Info.DllCharacteristics, SizeOf(Info.DllCharacteristics)); + + if Info.IsPE32Plus then + Stream.Position := OptStart + 176 + else + Stream.Position := OptStart + 160; + ReadBufferExact(Stream, Info.RelocDirRVA, SizeOf(Info.RelocDirRVA)); + ReadBufferExact(Stream, Info.RelocDirSize, SizeOf(Info.RelocDirSize)); + + Info.SectionTableOffset := OptStart + FH.SizeOfOptionalHeader; + + if (Info.RelocDirRVA <> 0) and (Info.RelocDirSize <> 0) then + Info.HasRelocSectionMapping := RVAToFileOffset(Stream, Info.SectionTableOffset, + Info.NumberOfSections, Info.RelocDirRVA, Info.RelocFileOffset, Info.RelocSectionName) + else + Info.HasRelocSectionMapping := False; + + Result := True; +end; + +function ComputePEChecksum(Stream: TStream; ChecksumOffset: Int64): Cardinal; +var + Buffer: array[0..8191] of Byte; + Sum: UInt64; + FilePos, I: Int64; + BytesRead: Integer; + W: Word; + B: Byte; +begin + Sum := 0; + FilePos := 0; + Stream.Position := 0; + + while True do + begin + BytesRead := Stream.Read(Buffer, SizeOf(Buffer)); + if BytesRead <= 0 then + Break; + + I := 0; + while I < BytesRead do + begin + if (FilePos + I = ChecksumOffset) or (FilePos + I = ChecksumOffset + 1) or + (FilePos + I = ChecksumOffset + 2) or (FilePos + I = ChecksumOffset + 3) then + begin + Inc(I); + Continue; + end; + + if I + 1 < BytesRead then + begin + W := 0; + if not ((FilePos + I >= ChecksumOffset) and (FilePos + I < ChecksumOffset + 4)) then + W := Buffer[I]; + if not ((FilePos + I + 1 >= ChecksumOffset) and (FilePos + I + 1 < ChecksumOffset + 4)) then + W := W or (Word(Buffer[I + 1]) shl 8); + Sum := Sum + W; + Sum := (Sum and $FFFF) + (Sum shr 16); + Inc(I, 2); + end + else + begin + B := Buffer[I]; + if (FilePos + I >= ChecksumOffset) and (FilePos + I < ChecksumOffset + 4) then + B := 0; + Sum := Sum + B; + Sum := (Sum and $FFFF) + (Sum shr 16); + Inc(I); + end; + end; + + Inc(FilePos, BytesRead); + end; + + Sum := (Sum and $FFFF) + (Sum shr 16); + Sum := Sum + (Sum shr 16); + Result := Cardinal((Sum and $FFFF) + UInt64(Stream.Size)); +end; + +procedure WriteChecksum(Stream: TStream; ChecksumOffset: Int64); +var + Checksum: Cardinal; +begin + Checksum := ComputePEChecksum(Stream, ChecksumOffset); + Stream.Position := ChecksumOffset; + WriteBufferExact(Stream, Checksum, SizeOf(Checksum)); +end; + +function ASLREffective(const Info: TPEInfo): Boolean; +begin + Result := HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE) and + ((Info.FileCharacteristics and IMAGE_FILE_RELOCS_STRIPPED) = 0) and + Info.HasRelocSectionMapping and + (Info.RelocDirSize <> 0); +end; + +function GetPolicyExitCode(const Info: TPEInfo): Integer; +begin + Result := 0; + if not HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE) then + Result := Result or 1; + if not ASLREffective(Info) then + Result := Result or 2; + if not HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_NX_COMPAT) then + Result := Result or 4; + if Info.IsPE32Plus and not HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA) then + Result := Result or 8; +end; + +procedure PrintPolicyExitCodeHelp; +begin + Writeln('Policy exit code bits:'); + Writeln(' 1 = DYNAMICBASE not set'); + Writeln(' 2 = ASLR not effective (missing/invalid relocations)'); + Writeln(' 4 = NXCOMPAT not set'); + Writeln(' 8 = HIGH_ENTROPY_VA not set on PE32+'); +end; + +procedure ShowUsage; +begin + Writeln('peflags - inspect/set/clear PE mitigation flags'); + Writeln(''); + Writeln('Usage:'); + Writeln(' peflags <file.exe|file.dll> --check'); + Writeln(' peflags <file.exe|file.dll> --check --policy'); + Writeln(' peflags <file.exe|file.dll> --set --all'); + Writeln(' peflags <file.exe|file.dll> --set --aslr --nx --high-entropy'); + Writeln(' peflags <file.exe|file.dll> --clear --all'); + Writeln(' peflags <file.exe|file.dll> --clear --high-entropy'); + Writeln(''); + Writeln('Flags:'); + Writeln(' --aslr DYNAMICBASE'); + Writeln(' --nx NXCOMPAT'); + Writeln(' --high-entropy HIGH_ENTROPY_VA (PE32+ only)'); + Writeln(' --all all three flags'); + Writeln(' --policy return CI exit code from --check'); + PrintPolicyExitCodeHelp; +end; + +procedure PrintInfo(const FileName: string; const Info: TPEInfo); +begin + Writeln('File: ', FileName); + if Info.IsPE32Plus then + Writeln('Format: PE32+ (64-bit)') + else + Writeln('Format: PE32 (32-bit)'); + + Writeln('ASLR (DYNAMICBASE): ', BoolToYesNo(HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE))); + Writeln('DEP (NXCOMPAT): ', BoolToYesNo(HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_NX_COMPAT))); + Writeln('HighEntropyVA: ', BoolToYesNo(HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA))); + Writeln('Relocs stripped: ', BoolToYesNo((Info.FileCharacteristics and IMAGE_FILE_RELOCS_STRIPPED) <> 0)); + Writeln('Reloc dir present: ', BoolToYesNo((Info.RelocDirRVA <> 0) and (Info.RelocDirSize <> 0))); + Writeln('Reloc dir mapped: ', BoolToYesNo(Info.HasRelocSectionMapping)); + if Info.HasRelocSectionMapping then + Writeln('Reloc section: ', Info.RelocSectionName, ' @ file offset ', IntToHex(Info.RelocFileOffset, 8)); + Writeln('ASLR effective: ', BoolToYesNo(ASLREffective(Info))); + + if HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE) and not ASLREffective(Info) then + Writeln('Warning: DYNAMICBASE is set, but relocation data does not look usable.'); + if HasFlag(Info.DllCharacteristics, IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA) and not Info.IsPE32Plus then + Writeln('Warning: HIGH_ENTROPY_VA on non-PE32+ image has no effect.'); +end; + +procedure ModifyFlags(const FileName: string; DoSet: Boolean; FlagASLR, FlagNX, FlagHighEntropy: Boolean); +var + FS: TFileStream; + Info: TPEInfo; + DllChars: Word; +begin + FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite); + try + if not LoadPEInfo(FS, Info) then + raise Exception.Create('Not a valid PE executable'); + + DllChars := Info.DllCharacteristics; + + if FlagASLR then + if DoSet then + DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE + else + DllChars := DllChars and not IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE; + + if FlagNX then + if DoSet then + DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_NX_COMPAT + else + DllChars := DllChars and not IMAGE_DLLCHARACTERISTICS_NX_COMPAT; + + if FlagHighEntropy then + begin + if Info.IsPE32Plus then + begin + if DoSet then + DllChars := DllChars or IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA + else + DllChars := DllChars and not IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA; + end + else if DoSet then + Writeln('Note: skipping HIGH_ENTROPY_VA for PE32 image.'); + end; + + if DllChars <> Info.DllCharacteristics then + begin + FS.Position := Info.DllCharacteristicsOffset; + WriteBufferExact(FS, DllChars, SizeOf(DllChars)); + WriteChecksum(FS, Info.ChecksumOffset); + if DoSet then + Writeln('Updated flags.') + else + Writeln('Cleared flags.'); + end + else + Writeln('No changes needed.'); + finally + FS.Free; + end; +end; + +var + FileName: string; + DoCheck, DoSet, DoClear, DoPolicy, FlagASLR, FlagNX, FlagHighEntropy, FlagAll: Boolean; + ExitCodeValue: Integer; + I: Integer; + S: string; + FS: TFileStream; + Info: TPEInfo; +begin + try + if ParamCount < 2 then + begin + ShowUsage; + Halt(1); + end; + + FileName := ParamStr(1); + DoCheck := False; + DoSet := False; + DoClear := False; + DoPolicy := False; + FlagASLR := False; + FlagNX := False; + FlagHighEntropy := False; + FlagAll := False; + ExitCodeValue := 0; + + for I := 2 to ParamCount do + begin + S := LowerCase(ParamStr(I)); + if S = '--check' then + DoCheck := True + else if S = '--set' then + DoSet := True + else if S = '--clear' then + DoClear := True + else if S = '--policy' then + DoPolicy := True + else if S = '--aslr' then + FlagASLR := True + else if S = '--nx' then + FlagNX := True + else if (S = '--high-entropy') or (S = '--highentropy') then + FlagHighEntropy := True + else if S = '--all' then + FlagAll := True + else if (S = '--help') or (S = '-h') or (S = '/?') then + begin + ShowUsage; + Halt(0); + end + else + raise Exception.Create('Unknown option: ' + ParamStr(I)); + end; + + if DoSet and DoClear then + raise Exception.Create('Use either --set or --clear, not both.'); + + if DoPolicy and not DoCheck and not DoSet and not DoClear then + DoCheck := True; + + if FlagAll then + begin + FlagASLR := True; + FlagNX := True; + FlagHighEntropy := True; + end; + + if DoSet or DoClear then + begin + if not (FlagASLR or FlagNX or FlagHighEntropy) then + raise Exception.Create('No flags selected. Use --aslr, --nx, --high-entropy or --all.'); + ModifyFlags(FileName, DoSet, FlagASLR, FlagNX, FlagHighEntropy); + end; + + if DoCheck or DoSet or DoClear then + begin + FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); + try + if not LoadPEInfo(FS, Info) then + raise Exception.Create('Not a valid PE executable'); + PrintInfo(FileName, Info); + if DoPolicy then + ExitCodeValue := GetPolicyExitCode(Info); + finally + FS.Free; + end; + end + else + ShowUsage; + + if DoPolicy then + Halt(ExitCodeValue); + except + on E: Exception do + begin + Writeln(StdErr, 'Error: ', E.Message); + Halt(1); + end; + end; +end. + diff --git a/heidisql.lpi b/heidisql.lpi index 7bfd3bff4..a02bd963a 100644 --- a/heidisql.lpi +++ b/heidisql.lpi @@ -25,7 +25,7 @@ <VersionInfo> <UseVersionInfo Value="True"/> <MajorVersionNr Value="12"/> - <MinorVersionNr Value="16"/> + <MinorVersionNr Value="18"/> <RevisionNr Value="1"/> <BuildNr Value="1"/> </VersionInfo> @@ -82,17 +82,11 @@ <OtherUnitFiles Value="source;source\metadarkstyle\src"/> <UnitOutputDirectory Value="bin\lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> - <Conditionals Value="// example for adding linker options on Mac OS X -//if TargetOS='darwin' then -// LinkerOptions := ' -framework OpenGL'; -if TargetOS='darwin' then - CustomOptions := '-WM10.15'; + <Conditionals Value="if TargetOS='darwin' then + CustomOptions := CustomOptions + ' -WM10.15'; -// example for adding a unit and include path on Windows -//if SrcOS='win' then begin -// UnitPath += ';win'; -// IncPath += ';win'; -//end;"/> +if TargetOS='win64' then + CustomOptions := CustomOptions + ' -WB -WR';"/> <CodeGeneration> <SmartLinkUnit Value="True"/> <Optimizations> @@ -474,17 +468,11 @@ if TargetOS='darwin' then <OtherUnitFiles Value="source;source\metadarkstyle\src"/> <UnitOutputDirectory Value="bin\lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> - <Conditionals Value="// example for adding linker options on Mac OS X -//if TargetOS='darwin' then -// LinkerOptions := ' -framework OpenGL'; -if TargetOS='darwin' then - CustomOptions := '-WM10.15'; + <Conditionals Value="if TargetOS='darwin' then + CustomOptions := CustomOptions + ' -WM10.15'; -// example for adding a unit and include path on Windows -//if SrcOS='win' then begin -// UnitPath += ';win'; -// IncPath += ';win'; -//end;"/> +if TargetOS='win64' then + CustomOptions := CustomOptions + ' -WB -WR';"/> <Linking> <Debugging> <DebugInfoType Value="dsDwarf3"/> diff --git a/source/apphelpers.pas b/source/apphelpers.pas index e2a728aaa..c97f390ff 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -74,12 +74,13 @@ TSQLBatch = class(TObjectList<TSQLSentence>) private FSQL: String; FQuotes: THashedStringList; + FEscape: Char; procedure SetSQL(Value: String); function GetSize: Integer; function GetSQLWithoutComments: String; overload; public constructor Create(NetTypeGroup: TNetTypeGroup); - destructor Destroy; overload; + destructor Destroy; override; class function GetSQLWithoutComments(FullSQL: String): String; overload; property Size: Integer read GetSize; property SQL: String read FSQL write SetSQL; @@ -185,7 +186,7 @@ TWinControlHelper = class helper for TWinControl asWrapLongLines, asCodeFolding, asDisplayBLOBsAsText, asSingleQueries, asMemoEditorWidth, asMemoEditorHeight, asMemoEditorMaximized, asMemoEditorWrap, asMemoEditorHighlighter, asMemoEditorAlwaysFormatCode, asDelimiter, asSQLHelpWindowLeft, asSQLHelpWindowTop, asSQLHelpWindowWidth, asSQLHelpWindowHeight, asSQLHelpPnlLeftWidth, asSQLHelpPnlRightTopHeight, asHost, - asUser, asPassword, asCleartextPluginEnabled, asWindowsAuth, asLoginPrompt, asPort, asLibrary, asAllProviders, + asUser, asPassword, asCleartextPluginEnabled, asForceUnicode, asWindowsAuth, asLoginPrompt, asPort, asLibrary, asAllProviders, asSSHtunnelActive, asPlinkExecutable, asSshExecutable, asSSHtunnelHost, asSSHtunnelHostPort, asSSHtunnelPort, asSSHtunnelUser, asSSHtunnelPassword, asSSHtunnelTimeout, asSSHtunnelPrivateKey, asSSLActive, asSSLKey, asSSLCert, asSSLCA, asSSLCipher, asSSLVerification, asSSLWarnUnused, asNetType, asCompressed, asLocalTimeZone, asQueryTimeout, asKeepAlive, @@ -194,7 +195,7 @@ TWinControlHelper = class helper for TWinControl asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLTransactions, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, - asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, + asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportFocusedColumnOnly, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, asGridExportSeparator, asGridExportEncloser, asGridExportTerminator, asGridExportNull, asGridExportClpColumnNames, asGridExportClpIncludeAutoInc, asGridExportClpRemoveLinebreaks, @@ -534,10 +535,10 @@ function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): Exit; if FromLeft then begin SetLength(Result, MaxLen); - Result[MaxLen] := '…'; + Result := Result + '…'; end else begin Result := Copy(Result, Length(Result)-MaxLen, Length(Result)); - Result := '…' + Result; + Result := '…' + Result; end; end; @@ -713,10 +714,13 @@ function EncodeURLParam(const Value: String): String; } procedure StreamWrite(S: TStream; Text: String = ''); var - utf8: AnsiString; + utf8: UTF8String; + L: Integer; begin utf8 := Utf8Encode(Text); - S.Write(utf8[1], Length(utf8)); + L := Length(utf8); + if L > 0 then + S.WriteBuffer(utf8[1], L); end; @@ -844,7 +848,7 @@ function MakeFloat(Str: String): Extended; function RoundCommercial(e: Extended): Int64; begin - // "Kaufmännisch runden" + // "Kaufmännisch runden" // In contrast to Delphi's Round() which rounds *.5 to the next even number Result := Trunc(e); if Frac(e) >= 0.5 then @@ -1475,12 +1479,8 @@ procedure FixVT(VT: TVirtualStringTree; IsResultGrid: Boolean=False); else MultiLineCount := 1; // Issue #2344: TBaseVirtualTree.UpdateVerticalRange crashes with ERangeError on ArchLinux - // due to FRangeY/Cardinal getting a negative value. - // Happening when DefaultNodeHeight is set and then with 0 nodes in data grid - // Once the form files are back at 96 PPI this should no longer crash. - {$IFNDEF LINUX} + // Fixed through form files back at 96 PPI VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount; - {$ENDIF} if MultiLineCount > 1 then begin VT.BeginUpdate; Node := VT.GetFirstInitialized; @@ -1503,6 +1503,7 @@ procedure FixVT(VT: TVirtualStringTree; IsResultGrid: Boolean=False); VT.ShowHint := True; if IsResultGrid then begin + VT.Colors.GridLineColor := clGray; // 50% black grid lines, should fit on both light and dark theme VT.HintMode := hmHint; // Show cell contents with linebreakds in datagrid and querygrid's if AppSettings.ReadBool(asIncrementalSearch) then begin // Apply case insensitive incremental search event @@ -1528,7 +1529,7 @@ function GetTextHeight(Font: TFont): Integer; Bmp := Graphics.TBitmap.Create; Bmp.Canvas.Font.Name := Font.Name; Bmp.Canvas.Font.Size := Font.Size; - Result := Bmp.Canvas.TextHeight('Äy'); + Result := Bmp.Canvas.TextHeight('Ă„y'); Bmp.Free; end; @@ -2366,7 +2367,7 @@ function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: end; if Title <> Dialog.Caption then Dialog.Title := Title; - if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) then + if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) and (MainForm.ActiveConnection.Parameters <> nil) then Dialog.Caption := MainForm.ActiveConnection.Parameters.SessionName + ': ' + Dialog.Caption; rx := TRegExpr.Create; rx.Expression := 'https?://[^\s"]+'; @@ -3219,19 +3220,21 @@ function TSQLSentence.GetSQLWithoutComments: String; constructor TSQLBatch.Create(NetTypeGroup: TNetTypeGroup); begin - inherited; + inherited Create; FQuotes := THashedStringList.Create; FQuotes.CaseSensitive := True; FQuotes.Sorted := True; FQuotes.Add('"'); FQuotes.Add(''''); + FEscape := '\'; case NetTypeGroup of ngMySQL: FQuotes.Add('`'); // MySQL/MariaDB only ngPgSQL: FQuotes.Add('$$'); // PostgreSQL only ($abc$ unsupported) + ngSQLite: FEscape := ''''; end; end; -destructor TSQLBatch.Destroy; overload; +destructor TSQLBatch.Destroy; begin FQuotes.Free; inherited; @@ -3318,7 +3321,7 @@ procedure TSQLBatch.SetSQL(Value: String); end; end; if not InEscape then - InEscape := c = '\' + InEscape := c = FEscape else InEscape := False; @@ -3366,13 +3369,11 @@ class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; Result := ''; InLineComment := False; InMultiLineComment := False; - Prev1 := #0; - Prev2 := #0; for i:=1 to Length(FullSQL) do begin Cur := FullSQL[i]; AddCur := True; - if i > 1 then Prev1 := FullSQL[i-1]; - if i > 2 then Prev2 := FullSQL[i-2]; + if i > 1 then Prev1 := FullSQL[i-1] else Prev1 := #0; + if i > 2 then Prev2 := FullSQL[i-2] else Prev2 := #0; if (Cur = '*') and (Prev1 = '/') then begin InMultiLineComment := True; @@ -3391,7 +3392,7 @@ class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; else if Cur = '#' then begin InLineComment := True; end - else if (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin + else if (not InLineComment) and (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin InLineComment := True; System.Delete(Result, Length(Result)-1, 2); // Delete comment chars end; @@ -3535,7 +3536,6 @@ constructor TAppSettings.Create; var rx: TRegExpr; i: Integer; - DefaultSnippetsDirectory: String; PortableLockFile: String; NewFileHandle: THandle; begin @@ -3637,6 +3637,7 @@ constructor TAppSettings.Create; InitSetting(asUser, 'User', 0, False, '', True); InitSetting(asPassword, 'Password', 0, False, '', True); InitSetting(asCleartextPluginEnabled, 'CleartextPluginEnabled', 0, False, '', True); + InitSetting(asForceUnicode, 'ForceUnicode', 0, True, '', True); InitSetting(asWindowsAuth, 'WindowsAuth', 0, False, '', True); InitSetting(asLoginPrompt, 'LoginPrompt', 0, False, '', True); InitSetting(asPort, 'Port', 0, False, '', True); @@ -3695,6 +3696,7 @@ constructor TAppSettings.Create; InitSetting(asGridExportSelection, 'GridExportSelection', 1); InitSetting(asGridExportColumnNames, 'GridExportColumnNames', 0, True); InitSetting(asGridExportIncludeAutoInc, 'GridExportAutoInc', 0, True); + InitSetting(asGridExportFocusedColumnOnly, 'GridExportFocusedColumnOnly', 0, False); InitSetting(asGridExportIncludeQuery, 'GridExportIncludeQuery', 0, False); InitSetting(asGridExportRemoveLinebreaks, 'GridExportRemoveLinebreaks', 0, False); InitSetting(asGridExportOpenFile, 'GridExportOpenFile', 0, False); @@ -3784,10 +3786,7 @@ constructor TAppSettings.Create; InitSetting(asDisplayReverseForeignKeys, 'DisplayReverseForeignKeys', 0, False); InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); - - // Default folder for snippets - DefaultSnippetsDirectory := DirnameUserDocuments + 'Snippets' + DirectorySeparator; - InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DefaultSnippetsDirectory); + InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DirnameUserDocuments + 'Snippets' + DirectorySeparator); InitSetting(asPromptSaveFileOnTabClose, 'PromptSaveFileOnTabClose', 0, True); // Restore tabs feature crashes often on old XP systems, see https://www.heidisql.com/forum.php?t=34044 InitSetting(asRestoreTabs, 'RestoreTabs', 0, True); diff --git a/source/connections.lfm b/source/connections.lfm index 06a4f186b..ae9ddcb7c 100644 --- a/source/connections.lfm +++ b/source/connections.lfm @@ -33,10 +33,10 @@ object connform: Tconnform Height = 455 Top = 10 Width = 521 - ActivePage = tabSettings + ActivePage = tabStart Align = alClient Images = MainForm.ImageListMain - TabIndex = 1 + TabIndex = 0 TabOrder = 1 OnChange = PageControlDetailsChange object tabStart: TTabSheet @@ -626,11 +626,11 @@ object connform: Tconnform Caption = 'Ping every X seconds:' end object lblBackgroundColor: TLabel - AnchorSideTop.Control = chkCleartextPluginEnabled + AnchorSideTop.Control = chkForceUnicode AnchorSideTop.Side = asrBottom Left = 3 Height = 15 - Top = 161 + Top = 185 Width = 97 BorderSpacing.Around = 5 Caption = 'Background color:' @@ -640,7 +640,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 3 Height = 15 - Top = 188 + Top = 212 Width = 119 BorderSpacing.Around = 5 Caption = 'Hide database pattern:' @@ -650,7 +650,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 3 Height = 15 - Top = 216 + Top = 240 Width = 97 BorderSpacing.Around = 5 Caption = 'Log queries to file:' @@ -748,11 +748,11 @@ object connform: Tconnform Value = 0 end object ColorBoxBackgroundColor: TColorBox - AnchorSideTop.Control = chkCleartextPluginEnabled + AnchorSideTop.Control = chkForceUnicode AnchorSideTop.Side = asrBottom Left = 194 Height = 22 - Top = 161 + Top = 185 Width = 314 NoneColorColor = clNone Selected = clNone @@ -770,7 +770,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 194 Height = 23 - Top = 188 + Top = 212 Width = 314 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 5 @@ -783,7 +783,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 194 Height = 19 - Top = 244 + Top = 268 Width = 314 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 5 @@ -796,7 +796,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 194 Height = 23 - Top = 216 + Top = 240 Width = 314 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 5 @@ -816,7 +816,7 @@ object connform: Tconnform AnchorSideTop.Side = asrBottom Left = 194 Height = 19 - Top = 268 + Top = 292 Width = 314 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 5 @@ -824,6 +824,19 @@ object connform: Tconnform TabOrder = 10 OnClick = Modification end + object chkForceUnicode: TCheckBox + AnchorSideTop.Control = chkCleartextPluginEnabled + AnchorSideTop.Side = asrBottom + Left = 194 + Height = 19 + Top = 161 + Width = 314 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 5 + Caption = 'Force Unicode (disable on old servers only)' + TabOrder = 11 + OnClick = Modification + end end object tabSSL: TTabSheet Caption = 'SSL' @@ -1115,27 +1128,32 @@ object connform: Tconnform item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] Position = 2 - Text = 'User' + Text = 'Port' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] Position = 3 + Text = 'User' + end + item + Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] + Position = 4 Text = 'Version' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 4 + Position = 5 Text = 'Last connect' end item Alignment = taRightJustify Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] - Position = 5 + Position = 6 Text = 'Counter' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 6 + Position = 7 Text = 'Comment' Width = 10 end> diff --git a/source/connections.pas b/source/connections.pas index d02177da2..51900302d 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -26,6 +26,7 @@ Tconnform = class(TExtForm) btnSave: TBitBtn; btnNew: TBitBtn; btnDelete: TBitBtn; + chkForceUnicode: TCheckBox; lblHelpPortable: TLabel; lblSshPassHint: TLabel; pnlBottom: TPanel; @@ -311,6 +312,7 @@ procedure Tconnform.FormCreate(Sender: TObject); editLogFilePath.Hint := FilenameHint; // Populate dropdown with supported SSH executables + {$IFDEF WINDOWS} ExeFiles := FindAllFiles(GetAppDir, '*.exe', False); for ExePath in ExeFiles do begin ExeFile := ExtractFileName(ExePath); @@ -320,6 +322,10 @@ procedure Tconnform.FormCreate(Sender: TObject); end; ExeFiles.Free; comboSSHExe.Items.Add('ssh.exe'); + {$ELSE} + // Linux and macOS go here, no executable shipped + comboSSHExe.Items.Add('ssh'); + {$ENDIF} // Translate combo items for i:=0 to comboSSLVerification.Items.Count-1 do begin @@ -490,6 +496,7 @@ procedure Tconnform.btnSaveClick(Sender: TObject); Sess.LoginPrompt := chkLoginPrompt.Checked; Sess.WindowsAuth := chkWindowsAuth.Checked; Sess.CleartextPluginEnabled := chkCleartextPluginEnabled.Checked; + Sess.ForceUnicode := chkForceUnicode.Checked; Sess.Port := spinPort.Value; Sess.NetType := SelectedNetType; Sess.Compressed := chkCompressed.Checked; @@ -719,6 +726,7 @@ function Tconnform.CurrentParams: TConnectionParameters; Result.LoginPrompt := chkLoginPrompt.Checked; Result.WindowsAuth := chkWindowsAuth.Checked; Result.CleartextPluginEnabled := chkCleartextPluginEnabled.Checked; + Result.ForceUnicode := chkForceUnicode.Checked; if spinPort.Enabled then Result.Port := spinPort.Value else @@ -807,14 +815,15 @@ procedure Tconnform.ListSessionsGetText(Sender: TBaseVirtualTree; CellText := CellText + ' *'; end; 1: CellText := Sess.Hostname; - 2: CellText := Sess.Username; - 3: CellText := Sess.ServerVersion; - 4: if Sess.LastConnect>0 then + 2: CellText := Sess.Port.ToString; + 3: CellText := Sess.Username; + 4: CellText := Sess.ServerVersion; + 5: if Sess.LastConnect>0 then CellText := DateTimeToStr(Sess.LastConnect) else CellText := ''; - 5: CellText := FormatNumber(Sess.Counter); - 6: CellText := Sess.Comment; + 6: CellText := FormatNumber(Sess.Counter); + 7: CellText := Sess.Comment; end; end; end; @@ -1034,6 +1043,7 @@ procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree; chkLoginPrompt.Checked := Sess.LoginPrompt; chkWindowsAuth.Checked := Sess.WindowsAuth; chkCleartextPluginEnabled.Checked := Sess.CleartextPluginEnabled; + chkForceUnicode.Checked := Sess.ForceUnicode; spinPort.Value := Sess.Port; chkCompressed.Checked := Sess.Compressed; spinQueryTimeout.Value := Sess.QueryTimeout; @@ -1321,7 +1331,7 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); Item.Caption := DB; Item.OnClick := MenuDatabasesClick; Item.AutoCheck := True; - Item.RadioItem := Params.NetTypeGroup = ngPgSQL; + Item.RadioItem := Params.IsAnyPostgreSQL; FPopupDatabases.Items.Add(Item); end; Databases.Free; @@ -1468,6 +1478,7 @@ procedure Tconnform.Modification(Sender: TObject); or (Sess.LoginPrompt <> chkLoginPrompt.Checked) or (Sess.WindowsAuth <> chkWindowsAuth.Checked) or (Sess.CleartextPluginEnabled <> chkCleartextPluginEnabled.Checked) + or (Sess.ForceUnicode <> chkForceUnicode.Checked) or (Sess.Port <> spinPort.Value) or (Sess.Compressed <> chkCompressed.Checked) or (Sess.QueryTimeout <> spinQueryTimeout.Value) @@ -1505,7 +1516,8 @@ procedure Tconnform.Modification(Sender: TObject); FSessionModified := FSessionModified or PasswordModified; if (Sender=editHost) or (Sender=editUsername) or (Sender=editPassword) or (Sender=comboNetType) or (Sender=chkWindowsAuth) or (Sender=spinPort) or - (Sender=chkCleartextPluginEnabled) then begin + (Sender=chkCleartextPluginEnabled) or (Sender=chkForceUnicode) + then begin // Be sure to use the modified connection params next time the user clicks the "Databases" pulldown FreeAndNil(FPopupDatabases); end; @@ -1623,6 +1635,14 @@ procedure Tconnform.ValidateControls; lblSSHLocalPort.Enabled := Params.SSHActive; spinSSHlocalport.Enabled := Params.SSHActive; // Advanced tab: + lblQueryTimeout.Enabled := True; + spinQueryTimeout.Enabled := lblQueryTimeout.Enabled; + chkLocalTimeZone.Enabled := Params.NetTypeGroup = ngMySQL; + chkFullTableStatus.Enabled := (Params.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]) and (Params.NetType <> ntMySQL_ProxySQLAdmin); + chkCleartextPluginEnabled.Enabled := Params.NetTypeGroup = ngMySQL; + chkForceUnicode.Enabled := Params.NetTypeGroup = ngMySQL; + editLogFilePath.Enabled := Params.LogFileDdl or Params.LogFileDml; + // SSL tab: chkWantSSL.Enabled := Params.NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel, ntMySQL_ProxySQLAdmin, ntMySQL_RDS, ntPgSQL_TCPIP, ntPgSQL_SSHtunnel]; lblSSLPrivateKey.Enabled := Params.WantSSL; editSSLPrivateKey.Enabled := Params.WantSSL; @@ -1634,12 +1654,6 @@ procedure Tconnform.ValidateControls; editSSLcipher.Enabled := Params.WantSSL; lblSSLVerification.Enabled := Params.WantSSL; comboSSLVerification.Enabled := Params.WantSSL; - lblQueryTimeout.Enabled := True; - spinQueryTimeout.Enabled := lblQueryTimeout.Enabled; - chkLocalTimeZone.Enabled := Params.NetTypeGroup = ngMySQL; - chkFullTableStatus.Enabled := (Params.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]) and (Params.NetType <> ntMySQL_ProxySQLAdmin); - chkCleartextPluginEnabled.Enabled := Params.NetTypeGroup = ngMySQL; - editLogFilePath.Enabled := Params.LogFileDdl or Params.LogFileDml; Params.Free; end; diff --git a/source/const.inc b/source/const.inc index aa72a55e3..b31cbbe06 100644 --- a/source/const.inc +++ b/source/const.inc @@ -49,6 +49,8 @@ const ICONINDEX_EVENT = 80; ICONINDEX_KEYWORD = 25; ICONINDEX_FOLDER = 174; + ICONINDEX_USER = 43; + ICONINDEX_ROLE = 95; // Size of byte units {Kibibyte} SIZE_KB = Int64(1024); @@ -99,9 +101,11 @@ const MsgUnhandledNetType: String = 'Unhandled connection type (%d)'; MsgUnhandledControl: String = 'Unhandled control in %s'; MsgDisconnect: String = 'Connection to %s closed at %s'; - TextInvalidColumn: String = '?'; + // This must be an empty string, otherwise TTableColumn's get GenerationExpression=XYZ on old servers + TextInvalidColumn: String = ''; FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db'; FILEEXT_SQLITEDB = 'sqlite3'; + FILEEXT_SNIPPET = '.sql'; PROPOSAL_ITEM_HEIGHT = 18; // Note the following should be in sync to what MySQL returns from SHOW WARNINGS SLogPrefixWarning = 'Warning'; diff --git a/source/copytable.pas b/source/copytable.pas index 898661c32..8194f4d8c 100644 --- a/source/copytable.pas +++ b/source/copytable.pas @@ -99,10 +99,11 @@ procedure TCopyTableForm.FormShow(Sender: TObject); Item: TMenuItem; Tree: TVirtualStringTree; begin - if Mainform.DBtree.Focused then - Tree := Mainform.DBtree + // On macOS the tree does not have Focused=True even when it is. See issue #2502 + if Mainform.ListTables.Focused then + Tree := Mainform.ListTables else - Tree := Mainform.ListTables; + Tree := Mainform.DBtree; Obj := Tree.GetNodeData(Tree.FocusedNode); FDBObj := Obj^; FConnection := FDBObj.Connection; @@ -419,7 +420,7 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); for Column in SelectedColumns do begin AutoIncGetsKey := False; AutoIncRemoved := False; - AutoIncName := Column.AutoIncName; + AutoIncName := FConnection.SqlProvider.GetSql(qAutoInc); if Column.DefaultType = cdtAutoInc then begin for Key in SelectedKeys do begin // Don't check index type, MySQL allows auto-increment columns on nearly all indexes diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 88fdccbbd..4182a4679 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -12,7 +12,7 @@ interface Classes, SysUtils, Generics.Collections, Generics.Defaults, DateUtils, Types, Math, Dialogs, Graphics, ExtCtrls, StrUtils, Controls, Forms, IniFiles, Variants, FileUtil, - RegExpr, process, Pipes, SQLDB, + RegExpr, process, Pipes, SQLDB, LConvEncoding, {$IFDEF HASMSSQL}MSSQLConn, SQLDBLib, DB, {$ENDIF} generic_types, lazaruscompat, dbstructures, dbstructures.mysql, dbstructures.mssql, dbstructures.postgresql, dbstructures.sqlite, dbstructures.interbase; @@ -64,7 +64,6 @@ TTableColumn = class(TPersistent) function CastAsText: String; property Status: TEditingStatus read FStatus write SetStatus; property Connection: TDBConnection read FConnection; - function AutoIncName: String; function FullDataType: String; end; PTableColumn = ^TTableColumn; @@ -72,6 +71,8 @@ TTableColumnList = class(TObjectList<TTableColumn>) public procedure Assign(Source: TTableColumnList); function FindByName(const Value: String): TTableColumn; + function HasInvisibleColumns: Boolean; + function QuoteIdents: String; end; TColumnCache = TDictionary<String,TTableColumnList>; @@ -91,7 +92,7 @@ TTableKey = class(TPersistent) Name, OldName: String; IndexType, OldIndexType, Algorithm, Comment: String; Columns, SubParts, Collations: TStringList; - Modified, Added: Boolean; + Modified, Added, Visible: Boolean; constructor Create(AOwner: TDBConnection); destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -188,7 +189,7 @@ TDBObject = class(TPersistent) NodeType, GroupType: TListNodeType; constructor Create(OwnerConnection: TDBConnection); - destructor Destroy; + destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure UnloadDetails; procedure Drop; @@ -300,7 +301,7 @@ TConnectionParameters = class(TObject) FIgnoreDatabasePattern: String; FPort, FSSHPort, FSSHLocalPort, FSSHTimeout, FCounter, FQueryTimeout, FKeepAlive, FSSLVerification: Integer; FSSHActive, FLoginPrompt, FCompressed, FLocalTimeZone, FFullTableStatus, - FWindowsAuth, FWantSSL, FIsFolder, FCleartextPluginEnabled: Boolean; + FWindowsAuth, FWantSSL, FIsFolder, FCleartextPluginEnabled, FForceUnicode: Boolean; FSessionColor: TColor; FLastConnect: TDateTime; FLogFileDdl: Boolean; @@ -366,6 +367,7 @@ TConnectionParameters = class(TObject) property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt; property WindowsAuth: Boolean read FWindowsAuth write FWindowsAuth; property CleartextPluginEnabled: Boolean read FCleartextPluginEnabled write FCleartextPluginEnabled; + property ForceUnicode: Boolean read FForceUnicode write FForceUnicode; property AllDatabasesStr: String read FAllDatabases write FAllDatabases; property AllDatabasesList: TStringList read GetAllDatabasesList; property LibraryOrProvider: String read FLibraryOrProvider write FLibraryOrProvider; @@ -412,12 +414,20 @@ TDBLogItem = class(TObject) TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; TDBDataTypeArray = Array of TDBDataType; - TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, - frShowCreateTrigger, frShowWarnings, - frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, - frShowTriggers, frShowEvents, frColumnDefaultParentheses, - frHelpKeyword, frEditVariables, frCreateView, frCreateProcedure, frCreateFunction, - frCreateTrigger, frCreateEvent, frInvisibleColumns, frCompressedColumns); + TFeatureOrRequirement = ( + frSrid, + frTemporalTypesFraction, + frIntegerDisplayWidth, + frColumnDefaultParentheses, + frEditVariables, + frCreateView, + frCreateProcedure, + frCreateFunction, + frCreateTrigger, + frCreateEvent, + frInvisibleColumns, + frCompressedColumns + ); TDBConnection = class(TComponent) private @@ -426,6 +436,7 @@ TDBConnection = class(TComponent) FServerUptime: Integer; FServerDateTimeOnStartup: String; FParameters: TConnectionParameters; + FOwnsParameters: Boolean; FSecureShellCmd: TSecureShellCmd; FDatabase: String; FAllDatabases: TStringList; @@ -473,6 +484,7 @@ TDBConnection = class(TComponent) FMaxRowsPerInsert: Int64; FCaseSensitivity: Integer; FSQLFunctions: TSQLFunctionList; + FNamedEnums: TStringList; procedure SetActive(Value: Boolean); virtual; abstract; procedure DoBeforeConnect; virtual; procedure StartSSHTunnel(var FinalHost: String; var FinalPort: Integer); @@ -509,7 +521,9 @@ TDBConnection = class(TComponent) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); virtual; + procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); overload; virtual; + procedure Query(QueryId: TQueryId); overload; + procedure Query(QueryId: TQueryId; const Args: array of const); overload; procedure Log(Category: TDBLogCategory; Msg: String); function EscapeString(Text: String; ProcessJokerChars: Boolean=False; DoQuote: Boolean=True): String; overload; function EscapeString(Text: String; Datatype: TDBDatatype): String; overload; @@ -552,6 +566,7 @@ TDBConnection = class(TComponent) function ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Int64): String; function LikeClauseTail: String; property Parameters: TConnectionParameters read FParameters write FParameters; + property OwnsParameters: Boolean read FOwnsParameters write FOwnsParameters; property ThreadId: Int64 read GetThreadId; property ConnectionUptime: Int64 read GetConnectionUptime; property ServerUptime: Int64 read GetServerUptime; @@ -565,6 +580,7 @@ TDBConnection = class(TComponent) property KeyCache: TKeyCache read FKeyCache; property ForeignKeyCache: TForeignKeyCache read FForeignKeyCache; property CheckConstraintCache: TCheckConstraintCache read FCheckConstraintCache; + property StringQuoteChar: Char read FStringQuoteChar; property QuoteChar: Char read FQuoteChar; property QuoteChars: String read FQuoteChars; function ServerVersionStr: String; @@ -606,6 +622,7 @@ TDBConnection = class(TComponent) function IsHex(Text: String): Boolean; function Has(Item: TFeatureOrRequirement): Boolean; property SqlProvider: TSqlProvider read FSqlProvider; + property NamedEnums: TStringList read FNamedEnums; published property Active: Boolean read FActive write SetActive default False; property Database: String read FDatabase write SetDatabase; @@ -1053,7 +1070,7 @@ class function TSecureShellCmd.SshpassPath: String; procedure TSecureShellCmd.Connect; var - SshCmd, SshCmdDisplay, DialogTitle: String; + SshCmd, SshCmdDisplay, DialogTitle, TargetHost: String; OutText, ErrorText, AllPipesText, UserInput: String; rx: TRegExpr; ExitCode: LongWord; @@ -1061,7 +1078,7 @@ procedure TSecureShellCmd.Connect; CheckIntervalMs: Integer; TimeStartedMs, WaitedMs, TimeOutMs: Int64; EnvSshpass: String; - EnvList, ProcOutput: TStringList; + ProcOutput: TStringList; begin // Check if local port is open PortChecks := 0; @@ -1075,38 +1092,43 @@ procedure TSecureShellCmd.Connect; // Build SSH command line // plink bob@domain.com -pw myPassw0rd1 -P 22 -i "keyfile.pem" -L 55555:localhost:3306 - SshCmd := FConnection.Parameters.SSHExe; - if FConnection.Parameters.SshIsPlink then - SshCmd := SshCmd + ' -ssh'; - SshCmd := SshCmd + ' '; + TargetHost := ''; if FConnection.Parameters.SSHUser.Trim <> '' then - SshCmd := SshCmd + FConnection.Parameters.SSHUser.Trim + '@'; + TargetHost := FConnection.Parameters.SSHUser.Trim + '@'; if FConnection.Parameters.SSHHost.Trim <> '' then - SshCmd := SshCmd + FConnection.Parameters.SSHHost.Trim + TargetHost := TargetHost + FConnection.Parameters.SSHHost.Trim else - SshCmd := SshCmd + FConnection.Parameters.Hostname; + TargetHost := TargetHost + FConnection.Parameters.Hostname; + + SshCmd := FConnection.Parameters.SSHExe; EnvSshpass := ''; - if FConnection.Parameters.SSHPassword <> '' then begin - if FConnection.Parameters.SshIsPlink then - SshCmd := SshCmd + ' -pw "' + StringReplace(FConnection.Parameters.SSHPassword, '"', '\"', [rfReplaceAll]) + '"' - else + if FConnection.Parameters.SshIsPlink then begin + SshCmd := SshCmd + ' -ssh ' + TargetHost; + if FConnection.Parameters.SSHPassword <> '' then + SshCmd := SshCmd + ' -pw "' + StringReplace(FConnection.Parameters.SSHPassword, '"', '\"', [rfReplaceAll]) + '"'; + if FConnection.Parameters.SSHPort > 0 then + SshCmd := SshCmd + ' -P ' + IntToStr(FConnection.Parameters.SSHPort); + if FConnection.Parameters.SSHPrivateKey <> '' then + SshCmd := SshCmd + ' -i "' + FConnection.Parameters.SSHPrivateKey + '"'; + SshCmd := SshCmd + ' -N -L ' + IntToStr(FConnection.Parameters.SSHLocalPort) + ':' + FConnection.Parameters.Hostname + ':' + IntToStr(FConnection.Parameters.Port); + end else begin + if FConnection.Parameters.SSHPassword <> '' then EnvSshpass := 'SSHPASS='+FConnection.Parameters.SSHPassword; + if FConnection.Parameters.SSHPort > 0 then + SshCmd := SshCmd + ' -p ' + IntToStr(FConnection.Parameters.SSHPort); + if FConnection.Parameters.SSHPrivateKey <> '' then + SshCmd := SshCmd + ' -i "' + FConnection.Parameters.SSHPrivateKey + '"'; + // OpenSSH options must be placed before the destination host. + SshCmd := SshCmd + ' -o StrictHostKeyChecking=no -o IgnoreUnknown=WarnWeakCrypto -o WarnWeakCrypto=no-pq-kex -o ExitOnForwardFailure=yes -o ServerAliveInterval=60 -o ServerAliveCountMax=3'; + SshCmd := SshCmd + ' -N -L ' + IntToStr(FConnection.Parameters.SSHLocalPort) + ':' + FConnection.Parameters.Hostname + ':' + IntToStr(FConnection.Parameters.Port) + ' ' + TargetHost; end; - if FConnection.Parameters.SSHPort > 0 then - SshCmd := SshCmd + IfThen(FConnection.Parameters.SshIsPlink, ' -P ', ' -p ') + IntToStr(FConnection.Parameters.SSHPort); - if FConnection.Parameters.SSHPrivateKey <> '' then - SshCmd := SshCmd + ' -i "' + FConnection.Parameters.SSHPrivateKey + '"'; - if not FConnection.Parameters.SshIsPlink then - SshCmd := SshCmd + ' -o StrictHostKeyChecking=no'; - SshCmd := SshCmd + ' -N -L ' + IntToStr(FConnection.Parameters.SSHLocalPort) + ':' + FConnection.Parameters.Hostname + ':' + IntToStr(FConnection.Parameters.Port); if not EnvSshpass.IsEmpty then begin SshCmd := SshpassPath + ' -e ' + SshCmd; - EnvList := TStringList.Create; + FProcess.Environment.Clear; for i := 0 to GetEnvironmentVariableCount - 1 do - EnvList.Add(GetEnvironmentString(i)); - EnvList.Add(EnvSshpass); - FProcess.Environment := EnvList; + FProcess.Environment.Add(GetEnvironmentString(i)); + FProcess.Environment.Add(EnvSshpass); end; rx := TRegExpr.Create; @@ -1272,6 +1294,7 @@ constructor TConnectionParameters.Create; FLoginPrompt := AppSettings.GetDefaultBool(asLoginPrompt); FWindowsAuth := AppSettings.GetDefaultBool(asWindowsAuth); FCleartextPluginEnabled := AppSettings.GetDefaultBool(asCleartextPluginEnabled); + FForceUnicode := AppSettings.GetDefaultBool(asForceUnicode); FUsername := DefaultUsername; FPassword := AppSettings.GetDefaultString(asPassword); FPort := DefaultPort; @@ -1346,6 +1369,7 @@ constructor TConnectionParameters.Create(SessionRegPath: String); FLoginPrompt := AppSettings.ReadBool(asLoginPrompt); FWindowsAuth := AppSettings.ReadBool(asWindowsAuth); FCleartextPluginEnabled := AppSettings.ReadBool(asCleartextPluginEnabled); + FForceUnicode := AppSettings.ReadBool(asForceUnicode); FPort := MakeInt(AppSettings.ReadString(asPort)); FCompressed := AppSettings.ReadBool(asCompressed); FAllDatabases := AppSettings.ReadString(asDatabases); @@ -1422,6 +1446,7 @@ procedure TConnectionParameters.SaveToRegistry; AppSettings.WriteString(asHost, FHostname); AppSettings.WriteBool(asWindowsAuth, FWindowsAuth); AppSettings.WriteBool(asCleartextPluginEnabled, FCleartextPluginEnabled); + AppSettings.WriteBool(asForceUnicode, FForceUnicode); AppSettings.WriteString(asUser, FUsername); AppSettings.WriteString(asPassword, encrypt(FPassword)); AppSettings.WriteBool(asLoginPrompt, FLoginPrompt); @@ -2017,6 +2042,7 @@ constructor TDBConnection.Create(AOwner: TComponent); begin inherited; FParameters := TConnectionParameters.Create; + FOwnsParameters := True; FRowsFound := 0; FRowsAffected := 0; FWarningCount := 0; @@ -2050,6 +2076,9 @@ constructor TDBConnection.Create(AOwner: TComponent); FStringQuoteChar := ''''; FCollationTable := nil; FCharsetTable := nil; + FQuoteChar := '"'; + FQuoteChars := '"[]'; + FNamedEnums := TStringList.Create; end; @@ -2074,8 +2103,6 @@ constructor TSqlSrvConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(MSSQLDatatypes)); for i:=0 to High(MSSQLDatatypes) do FDatatypes[i] := MSSQLDatatypes[i]; @@ -2090,7 +2117,6 @@ constructor TPgConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; FQuoteChars := '"'; SetLength(FDatatypes, Length(PostGreSQLDatatypes)); for i:=0 to High(PostGreSQLDatatypes) do @@ -2107,8 +2133,6 @@ constructor TSQLiteConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(SQLiteDatatypes)); for i:=0 to High(SQLiteDatatypes) do FDatatypes[i] := SQLiteDatatypes[i]; @@ -2122,8 +2146,6 @@ constructor TSQLiteConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(InterbaseDatatypes)); for i:=0 to High(InterbaseDatatypes) do FDatatypes[i] := InterbaseDatatypes[i]; @@ -2138,7 +2160,9 @@ destructor TDBConnection.Destroy; FKeepAliveTimer.Free; FFavorites.Free; FInformationSchemaObjects.Free; - FParameters.Free; + FNamedEnums.Free; + if FOwnsParameters then + FreeAndNil(FParameters); inherited; end; @@ -2202,6 +2226,8 @@ function TDBConnection.GetDatatypeByName(var DataType: String; DeleteFromSource: rx := TRegExpr.Create; rx.ModifierI := True; MatchLen := 0; + // Remove quotes around PG enums: "UserStatus" + DataType := DeQuoteIdent(DataType); for i:=0 to High(FDatatypes) do begin Types := FDatatypes[i].Name; if FDatatypes[i].Names <> '' then begin @@ -2254,27 +2280,18 @@ function TDBConnection.GetDatatypeByNativeType(NativeType: Integer; Identifier: i: Integer; rx: TRegExpr; TypeFound: Boolean; - TypeOid: String; begin Result := Default(TDBDatatype); rx := TRegExpr.Create; TypeFound := False; + for i:=0 to High(Datatypes) do begin - if Datatypes[i].NativeTypes = '?' then begin - // PG oid is set to be populated via '?' - Datatypes[i].NativeTypes := ''; - TypeOid := GetVar('SELECT oid FROM '+QuoteIdent('pg_type')+' WHERE '+QuoteIdent('typname')+' = '+EscapeString(Datatypes[i].Name.ToLower)); - if IsNumeric(TypeOid) then begin - Datatypes[i].NativeTypes := TypeOid; - Log(lcInfo, 'Found oid/NativeTypes of '+Datatypes[i].Name+' data type: '+Datatypes[i].NativeTypes); - end - else begin - Log(lcInfo, 'No support for '+Datatypes[i].Name+' data type on this server.'); - end; - end; - // Skip if native ids / oid's are (still) empty + // Skip if native ids / oid's are (yet) empty if Datatypes[i].NativeTypes.IsEmpty then Continue; + // Skip ? and e which have a special meaning + if Datatypes[i].NativeTypes.Length = 1 then + Continue; rx.Expression := '\b('+Datatypes[i].NativeTypes+')\b'; if rx.Exec(IntToStr(NativeType)) then begin Result := Datatypes[i]; @@ -2725,18 +2742,13 @@ procedure TSqlSrvConnection.SetActive(Value: Boolean); procedure TPgConnection.SetActive(Value: Boolean); var - dbname, ConnectionString, OptionValue, Error: String; + ConnectionString, OptionValue, Error: String; ConnectOptions: TStringList; FinalHost, ErrorHint: String; FinalPort, i: Integer; begin if Value then begin DoBeforeConnect; - // Simon Riggs: - // "You should connect as "postgres" database by default, with an option to change. Don't use template1" - dbname := FParameters.AllDatabasesStr; - if dbname = '' then - dbname := 'postgres'; // Prepare special stuff for SSH tunnel FinalHost := FParameters.Hostname; @@ -2752,9 +2764,10 @@ procedure TPgConnection.SetActive(Value: Boolean); .AddPair('port', IntToStr(FinalPort)) .AddPair('user', FParameters.Username) .AddPair('password', FParameters.Password) - .AddPair('dbname', dbname) .AddPair('application_name', APPNAME) .AddPair('sslmode', 'disable'); + if not FParameters.AllDatabasesStr.IsEmpty then + ConnectOptions.AddPair('dbname', FParameters.AllDatabasesStr); if FParameters.WantSSL then begin // Be aware .AddPair would add duplicates case FParameters.SSLVerification of @@ -2803,6 +2816,7 @@ procedure TPgConnection.SetActive(Value: Boolean); raise EDbError.Create(Error, LastErrorCode, ErrorHint); end; FActive := True; + CharacterSet := 'UTF8'; FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT VERSION()'); FConnectionStarted := GetTickCount64 div 1000; @@ -2846,6 +2860,7 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); ErrorHint: String; FileNames, EncryptionParams: TStringList; MainFile, DbAlias, Param, ParamName: String; + MainFileDir: String; i, SplitPos, ParamValue: Integer; CipherIndex, ConfigResult: Integer; ParamWasSet: Boolean; @@ -2856,8 +2871,12 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); if Value then begin // Fixes "out of memory" crash in sqlite3_open, see issue #1367 + MainFileDir := ExtractFilePath(MainFile); + MainFileDir := IncludeTrailingPathDelimiter(MainFileDir); + if not DirectoryExists(MainFileDir) then + raise EDbError.Create(f_('Folder in path does not exist: %s', [MainFile])); if not FileExists(MainFile) then - raise EDbError.Create(f_('File does not exist: %s', [MainFile])); + Log(lcInfo, f_('File does not yet exist, will be created now: %s', [MainFile])); DoBeforeConnect; @@ -3112,10 +3131,15 @@ procedure TDBConnection.DoBeforeConnect; Dialog.lblPrompt.Caption := f_('Login to %s:', [FParameters.Hostname]); Dialog.editUsername.Text := FParameters.Username; Dialog.editPassword.Text := FParameters.Password; - Dialog.ShowModal; - FParameters.Username := Dialog.editUsername.Text; - FParameters.Password := Dialog.editPassword.Text; - Dialog.Free; + if Dialog.ShowModal = mrOk then begin + FParameters.Username := Dialog.editUsername.Text; + FParameters.Password := Dialog.editPassword.Text; + Dialog.Free; + end + else begin + Dialog.Free; + raise EDbError.Create(_('Login cancelled')); + end; end; // Prepare connection @@ -3245,13 +3269,59 @@ procedure TDBConnection.EndSSHTunnel; procedure TDBConnection.DoAfterConnect; var + i: Integer; + TypeOid: String; + AllEnums: TDBQuery; + AllEnumsList: TStringList; SQLFunctionsFileOrder: String; MajorMinorVer, MajorVer: String; StartupScript: String; StartupBatch: TSQLBatch; SqlQuery: TSQLSentence; + Minutes, Hours: Integer; + Offset: String; begin FSqlProvider.ServerVersion := ServerVersionInt; + + for i:=0 to High(Datatypes) do begin + + if Datatypes[i].NativeTypes = '?' then begin + // PG oid is set to be populated via '?' + TypeOid := GetVar('SELECT oid FROM '+QuoteIdent('pg_type')+' WHERE '+QuoteIdent('typname')+' = '+EscapeString(Datatypes[i].Name.ToLower)); + if IsNumeric(TypeOid) then begin + Datatypes[i].NativeTypes := TypeOid; + Log(lcInfo, 'Found oid/NativeTypes of '+Datatypes[i].Name+' data type: '+Datatypes[i].NativeTypes); + end + else begin + Log(lcInfo, 'No support for '+Datatypes[i].Name+' data type on this server.'); + end; + end + + else if (Datatypes[i].NativeTypes = 'e') and FSqlProvider.Has(qGetEnumTypes) then begin + // PG ENUM types populated via 'e' + AllEnums := GetResults(FSqlProvider.GetSql(qGetEnumTypes)); + AllEnumsList := TStringList.Create; + while not AllEnums.Eof do begin + AllEnumsList.Add(AllEnums.Col('enum_name')); + AllEnumsList.Add(AllEnums.Col('enum_schema') + '.' + AllEnums.Col('enum_name')); + FNamedEnums.AddPair( + AllEnums.Col('enum_name'), + AllEnums.Col('enum_labels') + ); + FNamedEnums.AddPair( + AllEnums.Col('enum_schema') + '.' + AllEnums.Col('enum_name'), + AllEnums.Col('enum_labels') + ); + AllEnums.Next; + end; + AllEnums.Free; + Datatypes[i].Names := Implode('|', AllEnumsList); + AllEnumsList.Free; + end; + + end; + + AppSettings.SessionPath := FParameters.SessionPath; AppSettings.WriteString(asServerVersionFull, FServerVersionUntouched); FParameters.ServerVersion := FServerVersionUntouched; @@ -3284,6 +3354,19 @@ procedure TDBConnection.DoAfterConnect; SQLFunctionsFileOrder := ''; FSQLFunctions := TSQLFunctionList.Create(Self, SQLFunctionsFileOrder); + // Set timezone offset to UTC + if FSqlProvider.Has(qSetTimezone) and Parameters.LocalTimeZone then begin + Minutes := GetLocalTimeOffset; + Hours := Minutes div 60; + Minutes := Minutes mod 60; + if Hours < 0 then + Offset := '+' + else + Offset := '-'; + Offset := Offset + Format('%.2d:%.2d', [Abs(Hours), Abs(Minutes)]); + Query(qSetTimezone, [EscapeString(Offset)]); + end; + // Process startup script StartupScript := Trim(FParameters.StartupScriptFilename); if StartupScript <> '' then begin @@ -3306,25 +3389,11 @@ procedure TDBConnection.DoAfterConnect; procedure TMySQLConnection.DoAfterConnect; var - Minutes, Hours, i: Integer; - Offset: String; ObjNames: TStringList; + i: Integer; begin inherited; - // Set timezone offset to UTC - if Has(frTimezoneVar) and Parameters.LocalTimeZone then begin - Minutes := GetLocalTimeOffset; - Hours := Minutes div 60; - Minutes := Minutes mod 60; - if Hours < 0 then - Offset := '+' - else - Offset := '-'; - Offset := Offset + Format('%.2d:%.2d', [Abs(Hours), Abs(Minutes)]); - Query('SET time_zone='+EscapeString(Offset)); - end; - // Support microseconds in some temporal datatypes of MariaDB 5.3+ and MySQL 5.6 if Has(frTemporalTypesFraction) then begin for i:=Low(FDatatypes) to High(FDatatypes) do begin @@ -3531,6 +3600,17 @@ procedure TDBConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCate end; +procedure TDBConnection.Query(QueryId: TQueryId); +begin + Query(FSqlProvider.GetSql(QueryId)); +end; + +procedure TDBConnection.Query(QueryId: TQueryId; const Args: array of const); +begin + Query(FSqlProvider.GetSql(QueryId, Args)); +end; + + procedure TMySQLConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); var QueryStatus: Integer; @@ -3543,7 +3623,7 @@ procedure TMySQLConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogC if IsUnicode then NativeSQL := UTF8Encode(SQL) else - NativeSQL := AnsiString(SQL); + NativeSQL := UTF8ToCP1252(SQL); TimerStart := GetTickCount64; SetLength(FLastRawResults, 0); FStatementNum := 1; @@ -3656,7 +3736,7 @@ procedure TPGConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCate if IsUnicode then NativeSQL := UTF8Encode(SQL) else - NativeSQL := AnsiString(SQL); + NativeSQL := UTF8ToCP1252(SQL); TimerStart := GetTickCount64; SetLength(FLastRawResults, 0); @@ -4191,7 +4271,7 @@ procedure TDBConnection.PrefetchCreateCode(Objects: TDBObjectList); // SHOW CREATE TRIGGER was introduced in MySQL 5.1.21 // See #111 if Obj.NodeType = lntTrigger then - UseIt := UseIt and Has(frShowCreateTrigger); + UseIt := UseIt and FSqlProvider.Has(qShowCreateTrigger); if UseIt then Queries.Add('SHOW CREATE '+UpperCase(Obj.ObjType)+' '+QuoteIdent(Obj.Database)+'.'+QuoteIdent(Obj.Name)); end; @@ -4223,7 +4303,6 @@ procedure TDBConnection.PrefetchCreateCode(Objects: TDBObjectList); procedure TDBConnection.SetDatabase(Value: String); var s: String; - UseQuery: String; begin Log(lcDebug, 'SetDatabase('+Value+'), FDatabase: '+FDatabase); if Value <> FDatabase then begin @@ -4243,9 +4322,8 @@ procedure TDBConnection.SetDatabase(Value: String); s := s + ', ' + EscapeString('public'); end else s := QuoteIdent(Value); - UseQuery := FSqlProvider.GetSql(qUSEQuery); - if not UseQuery.IsEmpty then begin - Query(FSqlProvider.GetSql(qUSEQuery, [s]), False); + if FSqlProvider.Has(qUSEQuery) then begin + Query(qUSEQuery, [s]); end; FDatabase := DeQuoteIdent(Value); if Assigned(FOnDatabaseChanged) then @@ -4385,17 +4463,21 @@ procedure TMySQLConnection.SetCharacterSet(CharsetName: String); FStatementNum := 0; Log(lcInfo, 'Changing character set from '+CharacterSet+' to '+CharsetName); Return := FLib.mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName))); + // Return value never seems to be <> 0, not even on v3.23 servers, we check it anyway: if Return <> 0 then - raise EDbError.Create(LastErrorMsg) - else - FIsUnicode := CharsetName.StartsWith('utf', True); + raise EDbError.Create(LastErrorMsg); + // Check opt-out setting: if disabled, align the internal IsUnicode flag to the connection charset + if not FParameters.ForceUnicode then begin + FIsUnicode := CharacterSet.StartsWith('utf', True); + Log(lcInfo, 'ForceUnicode disabled in settings. Internal IsUnicode flag is now: ' + FIsUnicode.ToInteger.ToString) + end; end; procedure TPGConnection.SetCharacterSet(CharsetName: String); begin // See issue #22 - Query('SET CLIENT_ENCODING TO ' + EscapeString('UTF8')); + Query('SET CLIENT_ENCODING TO ' + EscapeString(CharsetName)); end; @@ -4610,8 +4692,8 @@ procedure TMySQLConnection.ShowWarnings; begin // Log warnings // SHOW WARNINGS is implemented as of MySQL 4.1.0 - if (WarningCount > 0) and Has(frShowWarnings) then begin - Warnings := GetResults('SHOW WARNINGS'); + if (WarningCount > 0) and FSqlProvider.Has(qShowWarnings) then begin + Warnings := GetResults(FSqlProvider.GetSql(qShowWarnings)); while not Warnings.Eof do begin Log(lcError, _(Warnings.Col('Level')) + ': ('+Warnings.Col('Code')+') ' + Warnings.Col('Message')); Warnings.Next; @@ -5664,7 +5746,7 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; else if ExecRegExpr('\bauto_increment\b', ExtraText.ToLowerInvariant) then begin // MySQL auto increment Col.DefaultType := cdtAutoInc; - Col.DefaultText := Col.AutoIncName; + Col.DefaultText := FSqlProvider.GetSql(qAutoInc); end else if DefText.ToLowerInvariant = 'null' then begin Col.DefaultType := cdtNull; @@ -5755,7 +5837,7 @@ function TMySQLConnection.GetTableColumns(Table: TDBObject): TTableColumnList; Col.OnUpdateType := cdtNothing; if ExecRegExpr('^auto_increment$', ExtraText.ToLowerInvariant) then begin Col.DefaultType := cdtAutoInc; - Col.DefaultText := Col.AutoIncName; + Col.DefaultText := FSqlProvider.GetSql(qAutoInc); end else if ColQuery.IsNull('Default') then begin Col.DefaultType := cdtNothing; end else if IsTextDefault(DefText, Col.DataType) then begin @@ -5976,7 +6058,7 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; end else begin - KeyQuery := GetResults('SHOW INDEXES FROM '+QuoteIdent(Table.Name)+' FROM '+QuoteIdent(Table.Database)); + KeyQuery := GetResults('SHOW KEYS FROM '+QuoteIdent(Table.Name)+' FROM '+QuoteIdent(Table.Database)); NewKey := nil; while not KeyQuery.Eof do begin if (not Assigned(NewKey)) or (NewKey.Name <> KeyQuery.Col('Key_name')) then begin @@ -6000,6 +6082,10 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; if ExecRegExpr('(BTREE|HASH)', KeyQuery.Col('Index_type')) then NewKey.Algorithm := KeyQuery.Col('Index_type'); NewKey.Comment := KeyQuery.Col('Index_comment', True); + if KeyQuery.ColumnExists('Visible') then // mysql 8 + NewKey.Visible := SameText(KeyQuery.Col('Visible'), 'yes') + else if KeyQuery.ColumnExists('Ignored') then // mariadb 10.6 + NewKey.Visible := SameText(KeyQuery.Col('Ignored'), 'NO'); end; if KeyQuery.ColumnExists('Expression') and (not KeyQuery.IsNull('Expression')) then begin // Functional key part: enclose expression within parentheses to distinguish them from columns (issue #1777) @@ -6225,14 +6311,17 @@ function TSqlSrvConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyLis ForeignQuery := GetResults('SELECT'+ ' f.name AS foreign_key_name,'+ ' COL_NAME(fc.parent_object_id, fc.parent_column_id) AS constraint_column_name,'+ - ' OBJECT_NAME (f.referenced_object_id) AS referenced_object,'+ + ' SCHEMA_NAME(ro.schema_id) AS referenced_schema,'+ + ' OBJECT_NAME(f.referenced_object_id) AS referenced_object,'+ ' COL_NAME(fc.referenced_object_id, fc.referenced_column_id) AS referenced_column_name,'+ ' update_referential_action_desc,'+ ' delete_referential_action_desc'+ ' FROM sys.foreign_keys AS f'+ ' INNER JOIN sys.foreign_key_columns AS fc'+ ' ON f.object_id = fc.constraint_object_id'+ - ' WHERE f.parent_object_id = OBJECT_ID('+EscapeString(Table.Name)+')' + ' INNER JOIN sys.objects AS ro'+ + ' ON ro.object_id = f.referenced_object_id'+ + ' WHERE f.parent_object_id = OBJECT_ID('+EscapeString(Table.QuotedDbAndTableName)+')' ); ForeignKey := nil; while not ForeignQuery.Eof do begin @@ -6241,7 +6330,8 @@ function TSqlSrvConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyLis Result.Add(ForeignKey); ForeignKey.KeyName := ForeignQuery.Col('foreign_key_name'); ForeignKey.OldKeyName := ForeignKey.KeyName; - ForeignKey.ReferenceTable := ForeignQuery.Col('referenced_object'); + ForeignKey.ReferenceTable := + ForeignQuery.Col('referenced_schema') + '.' + ForeignQuery.Col('referenced_object'); ForeignKey.OnUpdate := ForeignQuery.Col('update_referential_action_desc'); ForeignKey.OnDelete := ForeignQuery.Col('delete_referential_action_desc'); end; @@ -6495,19 +6585,11 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; ngMySQL: case Item of frSrid: Result := FParameters.IsMySQL(True) and (ServerVersionInt >= 80000); - frTimezoneVar: Result := ServerVersionInt >= 40103; frTemporalTypesFraction: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 50300)) or (FParameters.IsMySQL(True) and (ServerVersionInt >= 50604)); - frShowCreateTrigger: Result := ServerVersionInt >= 50121; - frShowWarnings: Result := ServerVersionInt >= 40100; frIntegerDisplayWidth: Result := (FParameters.IsMySQL(True) and (ServerVersionInt < 80017)) or (not FParameters.IsMySQL(True)); - frShowFunctionStatus: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50000); - frShowProcedureStatus: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50000); - frShowTriggers: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50010); - frShowEvents: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50100); frColumnDefaultParentheses: Result := FParameters.IsMySQL(True) and (ServerVersionInt >= 80013); - frHelpKeyword: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 40100); frEditVariables: Result := ServerVersionInt >= 40003; frCreateView: Result := ServerVersionInt >= 50001; frCreateProcedure: Result := ServerVersionInt >= 50003; @@ -6969,8 +7051,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Stored functions - if Has(frShowFunctionStatus) then try - Results := GetResults('SHOW FUNCTION STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); + if FSqlProvider.Has(qShowFunctionStatus) then try + Results := GetResults(FSqlProvider.GetSql(qShowFunctionStatus, [EscapeString(db)])); except on E:EDbError do; end; @@ -6990,8 +7072,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Stored procedures - if Has(frShowProcedureStatus) then try - Results := GetResults('SHOW PROCEDURE STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); + if FSqlProvider.Has(qShowProcedureStatus) then try + Results := GetResults(FSqlProvider.GetSql(qShowProcedureStatus, [EscapeString(db)])); except on E:EDbError do; end; @@ -7011,8 +7093,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Triggers - if Has(frShowTriggers) then try - Results := GetResults('SHOW TRIGGERS FROM '+QuoteIdent(db)); + if FSqlProvider.Has(qShowTriggers) then try + Results := GetResults(FSqlProvider.GetSql(qShowTriggers, [QuoteIdent(db)])); except on E:EDbError do; end; @@ -7031,9 +7113,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Events - if Has(frShowEvents) then try - Results := GetResults('SELECT *, EVENT_SCHEMA AS '+QuoteIdent('Db')+', EVENT_NAME AS '+QuoteIdent('Name')+ - ' FROM '+InfSch+'.'+QuoteIdent('EVENTS')+' WHERE '+QuoteIdent('EVENT_SCHEMA')+'='+EscapeString(db)) + if FSqlProvider.Has(qShowEvents) then try + Results := GetResults(FSqlProvider.GetSql(qShowEvents, [EscapeString(db)])); except on E:EDbError do begin try @@ -7459,7 +7540,7 @@ function TDBConnection.DecodeAPIString(a: AnsiString): String; if IsUnicode then Result := AnsiToUtf8(a) else - Result := String(a); + Result := CP1252ToUTF8(a); end; @@ -7582,7 +7663,7 @@ procedure TDBConnection.ParseViewStructure(CreateCode: String; DBObj: TDBObject; CheckOption := Trim(rx.Match[11]); SelectCode := rx.Match[9]; end else - raise Exception.CreateFmt(_('Regular expression did not match the VIEW code in %s: %s'), ['ParseViewStructure()', CRLF+CRLF+CreateCode]); + Log(lcError, f_('Regular expression did not match the VIEW code in %s: %s', ['ParseViewStructure()', CRLF+CRLF+CreateCode])); rx.Free; end; @@ -8846,8 +8927,8 @@ function TPGQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; SetString(AnsiStr, FConnection.Lib.PQgetvalue(FCurrentResults, FRecNoLocal, Column), FColumnLengths[Column]); if Datatype(Column).Category in [dtcBinary, dtcSpatial] then Result := String(AnsiStr) - else if Datatype(Column).Index = dbdtBool then - if AnsiStr='t' then Result := 'true' else Result := 'false' + else if (Datatype(Column).Index = dbdtBool) and (Length(AnsiStr) > 0) then + Result := IfThen(AnsiStr='t', 'true', 'false') else Result := Connection.DecodeAPIString(AnsiStr); end; @@ -8964,19 +9045,33 @@ function TDBQuery.ValueList(Column: Integer): TStringList; i: Integer; begin Result := TStringList.Create; - Result.QuoteChar := ''''; - Result.Delimiter := ','; ColAttr := ColAttributes(Column); if Assigned(ColAttr) then case ColAttr.DataType.Index of + dbdtEnum, dbdtSet: begin - Result.DelimitedText := ColAttr.LengthSet; - // Take care for escaped ENUM definitions, see issue #799 + // Lool up PostgreSQL enum labels in prefetched list + i := FConnection.NamedEnums.IndexOfName(ColAttr.LengthSet); + if i > -1 then begin + Result.Delimiter := '|'; + Result.DelimitedText := FConnection.NamedEnums.ValueFromIndex[i]; + end + else begin + // .. or in MySQL Length/Set + Result.QuoteChar := ''''; + Result.Delimiter := ','; + Result.DelimitedText := ColAttr.LengthSet; + end; + // In any case, take care for escaped ENUM definitions, see issue #799 for i:=0 to Result.Count-1 do begin Result[i] := FConnection.UnescapeString(Result[i]); end; end; - dbdtBool: + + dbdtBool: begin + Result.Delimiter := ','; Result.DelimitedText := 'true,false'; + end; + end; end; @@ -10422,6 +10517,7 @@ function TDBObject.AsStringMap: TStringMap; FMap.Add('QuotedDatabase', QuotedDatabase); FMap.Add('QuotedName', QuotedName); FMap.Add('QuotedDbAndTableName', QuotedDbAndTableName); + FMap.Add('ObjType', UpperCase(ObjType)); Result := FMap; end; @@ -10594,24 +10690,29 @@ function TTableColumn.SQLCode(OverrideCollation: String=''; Parts: TColumnParts= end; if InParts(cpType) then begin - case FConnection.Parameters.NetTypeGroup of - ngPgSQL: begin - if DefaultType = cdtAutoInc then - Result := Result + 'SERIAL' - else - Result := Result + DataType.Name; + + if FConnection.Parameters.IsAnyPostgreSQL and (DefaultType = cdtAutoInc) then begin + Result := Result + 'SERIAL'; + end + else begin + + if (DataType.Index = dbdtEnum) and (FConnection.NamedEnums.IndexOfName(LengthSet) > -1) then begin + Result := Result + LengthSet; + end + else begin + Result := Result + DataType.Name; + if (LengthSet <> '') and DataType.HasLength then + Result := Result + '(' + LengthSet + ')'; end; - else Result := Result + DataType.Name; + + if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then + Result := Result + ' UNSIGNED'; + if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then + Result := Result + ' ZEROFILL'; + if Compressed and FConnection.Parameters.IsMariaDB then + Result := Result + ' /*!100301 COMPRESSED*/'; end; - if (LengthSet <> '') and DataType.HasLength then - Result := Result + '(' + LengthSet + ')'; - if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then - Result := Result + ' UNSIGNED'; - if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then - Result := Result + ' ZEROFILL'; - if Compressed and FConnection.Parameters.IsMariaDB then - Result := Result + ' /*!100301 COMPRESSED*/'; Result := Result + ' '; // Add space after each part end; @@ -10637,7 +10738,7 @@ function TTableColumn.SQLCode(OverrideCollation: String=''; Parts: TColumnParts= cdtAutoInc: begin case FConnection.Parameters.NetTypeGroup of ngPgSQL:; - else Result := Result + AutoIncName; + else Result := Result + FConnection.SqlProvider.GetSql(qAutoInc); end; end; cdtExpression: begin @@ -10703,7 +10804,9 @@ procedure TTableColumn.ParseDatatype(Source: String); var InLiteral: Boolean; ParenthLeft, i: Integer; + OrgSource: String; begin + OrgSource := Source; DataType := Connection.GetDatatypeByName(Source, True); // Length / Set // Various datatypes, e.g. BLOBs, don't have any length property @@ -10722,6 +10825,11 @@ procedure TTableColumn.ParseDatatype(Source: String); LengthSet := ''; end else begin LengthSet := ''; + if DataType.Index = dbdtEnum then begin + // Assign PostgreSQL enum type to LengthSet, so we can provide it in table editor + // Some enum types are wrapped in double quotes + LengthSet := OrgSource.Trim([FConnection.QuoteChar]); + end; end; Unsigned := ExecRegExpr('\bunsigned\b', Source.ToLowerInvariant); ZeroFill := ExecRegExpr('\bzerofill\b', Source.ToLowerInvariant); @@ -10745,27 +10853,23 @@ function TTableColumn.CastAsText: String; Result := 'CAST('+Result+' AS NVARCHAR('+IntToStr(GRIDMAXDATA)+'))'; end; ngPgSQL: begin - if (DataType.Index in [dbdtUnknown, dbdtJson]) or (DataType.Category = dtcBinary) then + // Cast most datatypes, including VARCHAR and TEXT, which may have an [] array attribute + if not (DataType.Category in [dtcInteger, dtcReal]) then Result := Result + '::text'; end; end; end; -function TTableColumn.AutoIncName: String; -begin - case FConnection.Parameters.NetTypeGroup of - ngPgSQL: Result := 'SERIAL'; - else Result := 'AUTO_INCREMENT'; - end; -end; - - function TTableColumn.FullDataType: String; begin Result := DataType.Name; - if not LengthSet.IsEmpty then - Result := Result + '(' + LengthSet + ')'; + if not LengthSet.IsEmpty then begin + if (DataType.Index = dbdtEnum) and (FConnection.NamedEnums.IndexOfName(LengthSet) > -1) then + Result := LengthSet + else + Result := Result + '(' + LengthSet + ')'; + end; end; @@ -10794,6 +10898,31 @@ function TTableColumnList.FindByName(const Value: String): TTableColumn; end; end; +function TTableColumnList.HasInvisibleColumns: Boolean; +var + Col: TTableColumn; +begin + Result := False; + for Col in Self do begin + if Col.Invisible then begin + Result := True; + Break; + end; + end; +end; + +function TTableColumnList.QuoteIdents: String; +var + Col: TTableColumn; + QuotedNames: TStringList; +begin + QuotedNames := TStringList.Create; + for Col in Self do begin + QuotedNames.Add(Col.Connection.QuoteIdent(Col.Name)); + end; + Result := Implode(', ', QuotedNames); + QuotedNames.Free; +end; { *** TTableKey } @@ -10808,6 +10937,7 @@ constructor TTableKey.Create(AOwner: TDBConnection); Columns.OnChange := Modification; Subparts.OnChange := Modification; Collations.OnChange := Modification; + Visible := True; end; destructor TTableKey.Destroy; @@ -10830,6 +10960,7 @@ procedure TTableKey.Assign(Source: TPersistent); OldIndexType := s.OldIndexType; Algorithm := s.Algorithm; Comment := s.Comment; + Visible := s.Visible; Columns.Assign(s.Columns); SubParts.Assign(s.SubParts); Collations.Assign(s.Collations); @@ -10947,6 +11078,7 @@ function TTableKey.SQLCode(TableName: String=''): String; if not Comment.IsEmpty then Result := Result + ' COMMENT ' + FConnection.EscapeString(Comment); + end else begin // SQLite syntax: diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index 461f1f883..52ba541fa 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -186,7 +186,7 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; begin case AId of qDatabaseDrop: Result := 'DROP DATABASE %s'; - qEmptyTable: Result := 'TRUNCATE '; + qEmptyTable: Result := 'TRUNCATE %s'; qRenameTable: Result := 'RENAME TABLE %s TO %s'; qRenameView: Result := 'RENAME TABLE %s TO %s'; qCurrentUserHost: Result := IfThen( @@ -236,8 +236,9 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; ' RDB$CHARACTER_SET_ID'+ ' FROM RDB$COLLATIONS'; qGetCharsets: Result := 'SELECT RDB$CHARACTER_SET_NAME AS "Charset", RDB$CHARACTER_SET_NAME AS "Description" FROM RDB$CHARACTER_SETS'; + else Result := inherited; end; end; -end. \ No newline at end of file +end. diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 1851ebbf8..a94c55f7f 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -450,7 +450,6 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; 'xtype', 'type' ); - qEmptyTable: Result := 'DELETE FROM '; qRenameTable: Result := 'EXEC sp_rename %s, %s'; qRenameView: Result := 'EXEC sp_rename %s, %s'; qCurrentUserHost: Result := 'SELECT SYSTEM_USER'; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 5a0bcd62c..19df33a5c 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3244,10 +3244,13 @@ procedure TMySQLLib.AssignProcedures; { TMySqlProvider } function TMySqlProvider.GetSql(AId: TQueryId): string; +var + IsMariaDB: Boolean; begin + IsMariaDB := ServerVersion >= 100000; case AId of qDatabaseDrop: Result := 'DROP DATABASE %s'; - qEmptyTable: Result := 'TRUNCATE '; + qEmptyTable: Result := 'TRUNCATE %s'; qRenameTable: Result := 'RENAME TABLE %s TO %s'; qRenameView: Result := 'RENAME TABLE %s TO %s'; qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; @@ -3326,7 +3329,7 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ', ID AS `Id`'+ ', IS_DEFAULT AS `Default`'+ ', 0 AS `Sortlen`'+ - ' FROM information_schema.COLLATION_CHARACTER_SET_APPLICABILITY'+ + ' FROM INFORMATION_SCHEMA.COLLATION_CHARACTER_SET_APPLICABILITY'+ ' ORDER BY `Collation`', '' ); @@ -3346,6 +3349,85 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ' WHERE'+ ' REFERENCED_TABLE_SCHEMA = :EscapedDatabase AND'+ ' REFERENCED_TABLE_NAME = :EscapedName'; + qExplain: Result := IfThen( + (FServerVersion >= 80400) and (FServerVersion < 100000), // Not MariaDB + 'EXPLAIN FORMAT=TRADITIONAL %s', + 'EXPLAIN %s' + ); + qSetTimezone: Result := IfThen( + FServerVersion >= 40103, + 'SET time_zone=%s', + '' + ); + qShowFunctionStatus: Result := IfThen( + (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW FUNCTION STATUS WHERE Db = %s', + '' + ); + qShowProcedureStatus: Result := IfThen( + (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW PROCEDURE STATUS WHERE Db = %s', + '' + ); + qShowTriggers: Result := IfThen( + (FServerVersion >= 50010) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW TRIGGERS FROM %s', + '' + ); + qShowEvents: Result := IfThen( + (FServerVersion >= 50010) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SELECT *, EVENT_SCHEMA AS `Db`, EVENT_NAME AS `Name` FROM INFORMATION_SCHEMA.`EVENTS` WHERE EVENT_SCHEMA=%s', + '' + ); + qHelpKeyword: Result := IfThen( + (FServerVersion >= 40100) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'HELP %s', + '' + ); + qShowCreateTrigger: Result := IfThen( + FServerVersion >= 50121, + 'SHOW CREATE TRIGGER :QuotedDatabase.:QuotedName', + '' + ); + qShowWarnings: Result := IfThen( + FServerVersion >= 40100, + 'SHOW WARNINGS', + '' + ); + qDropUser: Result := IfThen( + FServerVersion < 40101, + 'DELETE FROM mysql.user WHERE User=%s AND Host=%s', + 'DROP USER %s@%s' + ); + qCreateRole: Result := 'CREATE ROLE %s'; + qDropRole: Result := 'DROP ROLE %s'; + qReloadPrivileges: Result := 'FLUSH PRIVILEGES'; + qGrantRole: Result := 'GRANT %s TO %s%s'; + qRevokeRole: Result := 'REVOKE %s FROM %s'; + qSetDefaultRole: Result := 'SET DEFAULT ROLE %s FOR %s'; + qIndexVisible: Result := IfThen( + FServerVersion >= 100600, // mariadb + 'NOT IGNORED', + IfThen( + FServerVersion >= 80000, // mysql + 'VISIBLE', + '' + ) + ); + qIndexInvisible: Result := IfThen( + FServerVersion >= 100600, // mariadb + 'IGNORED', + IfThen( + FServerVersion >= 80000, // mysql + 'INVISIBLE', + '' + ) + ); + qGetAuthPlugins: Result := IfThen( + (FServerVersion >= 50100) or IsMariaDB, // mysql 5.1+ and all mariadb versions + 'SELECT PLUGIN_NAME FROM INFORMATION_SCHEMA.PLUGINS WHERE PLUGIN_TYPE=''AUTHENTICATION'' AND PLUGIN_STATUS=''ACTIVE''', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 6a62375f8..7f18ba947 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -46,7 +46,11 @@ interface qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox, qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets, - qGetReverseForeignKeys); + qGetReverseForeignKeys, qExplain, qSetTimezone, + qShowFunctionStatus, qShowProcedureStatus, qShowTriggers, qShowEvents, qShowCreateTrigger, + qHelpKeyword, qShowWarnings, qGetEnumTypes, + qDropUser, qCreateRole, qDropRole, qReloadPrivileges, qGrantRole, qRevokeRole, qSetDefaultRole, + qAutoInc, qIndexVisible, qIndexInvisible, qGetAuthPlugins); TSqlProvider = class strict protected FNetType: TNetType; @@ -202,10 +206,12 @@ function TSqlProvider.GetSql(AId: TQueryId): string; begin // Basic default SQL snippets compatible to all or most servers case AId of + qEmptyTable: Result := 'DELETE FROM %s'; qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; qGetRowCountExact: Result := 'SELECT COUNT(*) FROM :QuotedDbAndTableName'; + qAutoInc: Result := 'AUTO_INCREMENT'; else Result := ''; end; end; diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index a01de8762..e0c45003b 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -46,7 +46,7 @@ TPostgreSQLProvider = class(TSqlProvider) const InvalidOid: POid = 0; var - PostgreSQLDatatypes: Array[0..38] of TDBDatatype = + PostgreSQLDatatypes: Array[0..39] of TDBDatatype = ( ( Index: dbdtUnknown; @@ -511,6 +511,19 @@ TPostgreSQLProvider = class(TSqlProvider) LoadPart: False; Category: dtcOther; ), + ( + Index: dbdtEnum; + NativeTypes: 'e'; + Name: 'ENUM'; + Names: ''; + Description: 'A list of quoted labels, each of which must be less than NAMEDATALEN bytes long (64 bytes in a standard PostgreSQL build)'; + HasLength: True; // Enables the Length/set field in table editor + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcOther; + ), ( Index: dbdtJson; NativeTypes: '114'; @@ -586,7 +599,6 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; begin case AId of qDatabaseDrop: Result := 'DROP SCHEMA %s'; - qEmptyTable: Result := 'DELETE FROM '; qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; qRenameView: Result := 'ALTER VIEW %s RENAME TO %s'; qCurrentUserHost: Result := 'SELECT CURRENT_USER'; @@ -716,6 +728,23 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; ' WHERE pg_class.relkind=''r'''+ ' AND pg_namespace.nspname=:EscapedDatabase'+ ' AND pg_class.relname=:EscapedName'; + qGetEnumTypes: Result := IfThen( + FServerVersion >= 90000, + 'SELECT ' + + ' n.nspname AS enum_schema, ' + + ' t.typname AS enum_name, ' + + ' string_agg(e.enumlabel, ''|'' ORDER BY e.enumsortorder) AS enum_labels ' + + 'FROM pg_type AS t ' + + 'JOIN pg_enum AS e ' + + ' ON t.oid = e.enumtypid ' + + 'JOIN pg_namespace AS n ' + + ' ON n.oid = t.typnamespace ' + + 'WHERE t.typtype = ''e'' ' + + 'GROUP BY n.nspname, t.typname ' + + 'ORDER BY UPPER(t.typname)', + '' // ServerVersion < 9 + ); + qAutoInc: Result := 'SERIAL'; else Result := inherited; end; end; diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index 13c6efc48..e5f1eb90b 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -401,7 +401,6 @@ function TSQLiteProvider.GetSql(AId: TQueryId): string; begin case AId of qDatabaseDrop: Result := 'DROP DATABASE %s'; - qEmptyTable: Result := 'DELETE FROM '; qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; qRenameView: Result := 'ALTER TABLE %s RENAME TO %s'; qCurrentUserHost: Result := ''; // unsupported diff --git a/source/exportgrid.lfm b/source/exportgrid.lfm index 445f83ada..1019297f8 100644 --- a/source/exportgrid.lfm +++ b/source/exportgrid.lfm @@ -219,12 +219,14 @@ object frmExportGrid: TfrmExportGrid Caption = 'NULL value:' end object chkIncludeColumnNames: TCheckBox + AnchorSideLeft.Control = grpOptions AnchorSideTop.Control = grpOptions - Left = 8 + Left = 5 Height = 19 - Top = 5 + Top = 3 Width = 139 - BorderSpacing.Around = 5 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 Caption = 'Include column names' Checked = True State = cbChecked @@ -243,7 +245,7 @@ object frmExportGrid: TfrmExportGrid MaxLength = 0 NumGlyphs = 1 PasswordChar = #0 - TabOrder = 5 + TabOrder = 6 Text = ';' OnButtonClick = editCSVRightButtonClick OnChange = editCSVChange @@ -263,7 +265,7 @@ object frmExportGrid: TfrmExportGrid MaxLength = 0 NumGlyphs = 1 PasswordChar = #0 - TabOrder = 6 + TabOrder = 7 OnButtonClick = editCSVRightButtonClick OnChange = editCSVChange end @@ -282,32 +284,36 @@ object frmExportGrid: TfrmExportGrid MaxLength = 0 NumGlyphs = 1 PasswordChar = #0 - TabOrder = 7 + TabOrder = 8 Text = '\r\n' OnButtonClick = editCSVRightButtonClick OnChange = editCSVChange end object chkIncludeAutoIncrement: TCheckBox + AnchorSideLeft.Control = grpOptions AnchorSideTop.Control = chkIncludeColumnNames AnchorSideTop.Side = asrBottom - Left = 8 + Left = 5 Height = 19 - Top = 29 + Top = 25 Width = 185 - BorderSpacing.Around = 5 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 Caption = 'Include auto increment column' TabOrder = 1 end object chkIncludeQuery: TCheckBox - AnchorSideTop.Control = chkIncludeAutoIncrement + AnchorSideLeft.Control = grpOptions + AnchorSideTop.Control = chkFocusedColumnOnly AnchorSideTop.Side = asrBottom - Left = 8 + Left = 5 Height = 19 - Top = 53 + Top = 69 Width = 114 - BorderSpacing.Around = 5 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 Caption = 'Include SQL query' - TabOrder = 2 + TabOrder = 3 end object editNull: TEditButton AnchorSideTop.Control = editTerminator @@ -324,31 +330,48 @@ object frmExportGrid: TfrmExportGrid MaxLength = 0 NumGlyphs = 1 PasswordChar = #0 - TabOrder = 8 + TabOrder = 9 OnButtonClick = editCSVRightButtonClick OnChange = editCSVChange end object chkRemoveLinebreaks: TCheckBox + AnchorSideLeft.Control = grpOptions AnchorSideTop.Control = chkIncludeQuery AnchorSideTop.Side = asrBottom - Left = 8 + Left = 5 Height = 19 - Top = 77 + Top = 91 Width = 195 - BorderSpacing.Around = 5 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 Caption = 'Remove linebreaks from contents' - TabOrder = 3 + TabOrder = 4 end object chkOpenFile: TCheckBox + AnchorSideLeft.Control = grpOptions AnchorSideTop.Control = chkRemoveLinebreaks AnchorSideTop.Side = asrBottom - Left = 8 + Left = 5 Height = 19 - Top = 101 + Top = 113 Width = 139 - BorderSpacing.Around = 5 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 Caption = 'Open file after creation' - TabOrder = 4 + TabOrder = 5 + end + object chkFocusedColumnOnly: TCheckBox + AnchorSideLeft.Control = grpOptions + AnchorSideTop.Control = chkIncludeAutoIncrement + AnchorSideTop.Side = asrBottom + Left = 5 + Height = 19 + Top = 47 + Width = 158 + BorderSpacing.Left = 5 + BorderSpacing.Top = 3 + Caption = 'Only focused column (%s)' + TabOrder = 2 end end object btnSetClipboardDefaults: TSpeedButton diff --git a/source/exportgrid.pas b/source/exportgrid.pas index 40ffc24aa..80f88f60a 100644 --- a/source/exportgrid.pas +++ b/source/exportgrid.pas @@ -35,6 +35,7 @@ interface TfrmExportGrid = class(TExtForm) btnOK: TButton; btnCancel: TButton; + chkFocusedColumnOnly: TCheckBox; grpSelection: TRadioGroup; grpOutput: TGroupBox; radioOutputCopyToClipboard: TRadioButton; @@ -190,6 +191,7 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); grpSelection.ItemIndex := 0; // Always use selected cells in copy mode chkIncludeColumnNames.Checked := AppSettings.ReadBool(asGridExportClpColumnNames); chkIncludeAutoIncrement.Checked := AppSettings.ReadBool(asGridExportClpIncludeAutoInc); + chkFocusedColumnOnly.Checked := False; chkIncludeQuery.Checked := False; // Always off in copy mode chkRemoveLinebreaks.Checked := AppSettings.ReadBool(asGridExportClpRemoveLinebreaks); chkOpenFile.Checked := False; // Always off in copy mode @@ -204,6 +206,7 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); grpSelection.ItemIndex := AppSettings.ReadInt(asGridExportSelection); chkIncludeColumnNames.Checked := AppSettings.ReadBool(asGridExportColumnNames); chkIncludeAutoIncrement.Checked := AppSettings.ReadBool(asGridExportIncludeAutoInc); + chkFocusedColumnOnly.Checked := AppSettings.ReadBool(asGridExportFocusedColumnOnly); chkIncludeQuery.Checked := AppSettings.ReadBool(asGridExportIncludeQuery); chkRemoveLinebreaks.Checked := AppSettings.ReadBool(asGridExportRemoveLinebreaks); chkOpenFile.Checked := AppSettings.ReadBool(asGridExportOpenFile); @@ -217,10 +220,17 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); procedure TfrmExportGrid.FormShow(Sender: TObject); +var + FocusedCol: String; begin // Show dialog. Expect "Grid" property to be set now by the caller. chkIncludeAutoIncrement.OnClick := CalcSize; + chkFocusedColumnOnly.OnClick := CalcSize; CalcSize(Sender); + // Show name of focused column + FocusedCol := IfThen(Grid.FocusedColumn > NoColumn, Grid.Header.Columns[Grid.FocusedColumn].Text, ''); + chkFocusedColumnOnly.Caption := f_('Only focused column (%s)', [FocusedCol]); + chkFocusedColumnOnly.Enabled := not FocusedCol.IsEmpty; end; @@ -237,6 +247,7 @@ procedure TfrmExportGrid.FormClose(Sender: TObject; var Action: TCloseAction); AppSettings.WriteInt(asGridExportSelection, grpSelection.ItemIndex); AppSettings.WriteBool(asGridExportColumnNames, chkIncludeColumnNames.Checked); AppSettings.WriteBool(asGridExportIncludeAutoInc, chkIncludeAutoIncrement.Checked); + AppSettings.WriteBool(asGridExportFocusedColumnOnly, chkFocusedColumnOnly.Checked); AppSettings.WriteBool(asGridExportIncludeQuery, chkIncludeQuery.Checked); AppSettings.WriteBool(asGridExportRemoveLinebreaks, chkRemoveLinebreaks.Checked); AppSettings.WriteBool(asGridExportOpenFile, chkOpenFile.Checked); @@ -466,11 +477,12 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); var GridData: TDBQuery; Node: PVirtualNode; - Col, ExcludeCol: TColumnIndex; + Col, ExcludeAutoIncCol, IncludeFocusedCol: TColumnIndex; ResultCol: Integer; RowNum: PInt64; SelectedSize, AllSize: Int64; CalculatedCount, SelectedCount, AllCount: Int64; + DoIncludeCol: Boolean; begin GridData := Mainform.GridResult(Grid); if not Assigned(GridData) then begin @@ -479,10 +491,13 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); end; AllSize := 0; SelectedSize := 0; - chkIncludeAutoIncrement.Enabled := GridData.AutoIncrementColumn > -1; - ExcludeCol := -1; + chkIncludeAutoIncrement.Enabled := (GridData.AutoIncrementColumn > -1) and (not chkFocusedColumnOnly.Checked); + ExcludeAutoIncCol := -1; if chkIncludeAutoIncrement.Enabled and (not chkIncludeAutoIncrement.Checked) then - ExcludeCol := GridData.AutoIncrementColumn; + ExcludeAutoIncCol := GridData.AutoIncrementColumn; + IncludeFocusedCol := -1; + if chkFocusedColumnOnly.Enabled and chkFocusedColumnOnly.Checked then + IncludeFocusedCol := Grid.FocusedColumn; Node := GetNextNode(Grid, nil, False); CalculatedCount := 0; @@ -500,7 +515,9 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin ResultCol := Col - 1; - if Col <> ExcludeCol then begin + DoIncludeCol := (Col <> ExcludeAutoIncCol) and + ((IncludeFocusedCol < 0) or (Col = IncludeFocusedCol)); + if DoIncludeCol then begin Inc(AllSize, GridData.ColumnLengths(ResultCol)); if vsSelected in Node.States then Inc(SelectedSize, GridData.ColumnLengths(ResultCol)); @@ -639,7 +656,7 @@ function TfrmExportGrid.FormatLatex(Text: String): String; procedure TfrmExportGrid.btnOKClick(Sender: TObject); var - Col, ExcludeCol: TColumnIndex; + Col, ExcludeAutoIncCol, IncludeFocusedCol: TColumnIndex; ResultCol: Integer; Header, Data, tmp, Encloser, Separator, Terminator, TableName, Filename: String; Node: PVirtualNode; @@ -654,6 +671,12 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Encoding: TEncoding; Bom: TBytes; CurrentExportFormat: TGridExportFormat; + + function DoIncludeCol: Boolean; + begin + Result := (Col <> ExcludeAutoIncCol) and + ((IncludeFocusedCol < 0) or (Col = IncludeFocusedCol)) + end; begin Filename := GetOutputFilename(editFilename.Text, MainForm.ActiveDbObj); @@ -682,9 +705,12 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); except TableName := _('UnknownTable'); end; - ExcludeCol := NoColumn; - if (not chkIncludeAutoIncrement.Checked) or (not chkIncludeAutoIncrement.Enabled) then - ExcludeCol := GridData.AutoIncrementColumn + 1; + ExcludeAutoIncCol := NoColumn; + if chkIncludeAutoIncrement.Enabled and (not chkIncludeAutoIncrement.Checked) then + ExcludeAutoIncCol := GridData.AutoIncrementColumn + 1; + IncludeFocusedCol := NoColumn; + if chkFocusedColumnOnly.Checked then + IncludeFocusedCol := Grid.FocusedColumn; // Calling (Get)ExportFormat is slow, so we store it in a local variable CurrentExportFormat := ExportFormat; @@ -724,15 +750,15 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); CodeIndent(2) + '<title>' + TableName + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '