SQLite Hilfe zu SUM() ??

[delphilevi]

versuche doch mal das interface von Ben Hochstrasser
funzt mit den alten sqlite-versionen wunderbar.

du kannst deine query auch direkt über sqlite absetzen und ausschliessen,
daß sql-Syntax-Fehler die Ursache sind. (sqlite.exe runterladen und starten es oeffnet sich
ein dos-fenster Tabellen anlegen ein paar werte einfuegen abfrage absetzen und fertig)

Delphi-Quellcode:

unit SQLite;
{
simple class interface for SQLite. Hacked in by Ben Hochstrasser ([e-mail])
Thanks to Roger Reghin ([e-mail]) for his idea to ValueList. 

use it like this:

procedure TForm1.OnSQLBusy(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean);
procedure TForm1.OnSQLData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
procedure TForm1.OnSQLComplete(Sender: TObject);

procedure TForm1.Button1Click(Sender: TObject);
var
  MySQL: TSQLite;
  SQL: String;
begin
  MySQL := TSQLite.Create('test.db');
  MySQL.OnData := OnSQLData;
  MySQL.BusyTimeout := 1000;
  MySQL.OnBusy := OnSQLBusy;
  MySQL.OnQueryComplete := OnSQLComplete;
  SQL := 'CREATE TABLE Test(Name varchar(32), Vorname varchar(32));';
  MySQL.Query(sql, nil);
  SQL := 'INSERT INTO Test VALUES(''Hochstrasser'', ''Benedikt'');';
  if MySQL.IsComplete(sql) then
    MySQL.Query(sql, nil);
  SQL := 'SELECT * FROM Test;';
  MySQL.Query(sql, ListBox1.Items);
  MySQL.DatabaseDetails(Memo1.Lines);
  SQL := 'DROP TABLE Test;';
  MySQL.Query(sql, nil);
  MySQL.Free;
end;

You may also add this to your form if you would like to see the results in a ListView

Procedure TStringsToListView(LstIn: TStrings; LstOut: TListView);
var
  n: integer;
  lTmp: TStringList;
begin
  lTmp := TStringList.Create;
  lTmp.CommaText := LstIn.Strings[0];
  LstOut.Items.Clear;
  LstOut.Columns.Clear;
  for n := 0 to lTmp.Count - 1 do
    with LstOut.Columns.Add do
    begin
      Caption := lTmp.Strings[n];
      AutoSize := True;
      Width := -1;
    end;
  for n := 1 to LstIn.Count - 1 do
  begin
    lTmp.CommaText := LstIn.Strings[n];
    with LstOut.Items.Add do
    begin
      Caption := lTmp.Strings[0];
      lTmp.Delete(0);
      SubItems.Text := lTmp.Text;
    end;
  end;
  lTmp.Free;
end;

There is a similar function for a StringGrid:

Procedure TStringsToStringGrid(LstIn: TStrings; LstOut: TStringGrid);
var
  n: integer;
  i: integer;
  lTmp: TStringList;
begin
  if (LstIn <> nil) and (LstOut <> nil) then
  begin
    lTmp := TStringList.Create;
    lTmp.CommaText := LstIn.Strings[0];
    lstOut.ColCount := Ltmp.Count;
    lstout.RowCount := 1;
    lstout.FixedCols := 1;
    lstout.Rows[0] := ltmp;
    i := 1;
    for n := 1 to LstIn.Count - 1 do
    begin
      inc(i);
      lTmp.CommaText := LstIn.Strings[n];
      lstOut.RowCount := i;
      lstOut.Rows[i-1] := ltmp;
    end;
    lstOut.FixedRows := 1;
    lTmp.Free;
  end;
end;

Three utility functions have been added: Pas2SQLStr, SQL2PasStr, ValueList.

  Pas2SQLStr will convert a Pascal-Style String to an SQL-Style String
    Pas2SQLStr('my mother'''s car') -> "my mother''s car"
  SQL2PasStr will convert an SQL-Style string to a Pascal-Style String
    SQL2PasStr('"my mother''s car") -> 'my mother's car'
  ValueList will Convert ColumnNames, ColumnValues Strings to a Name-Value Pair StringList
    ValueList('ID,Name','1001,FooBar') > ID=1001,Name=Foobar

}

interface

uses Windows, Classes;

type
  TSQLiteExecCallback = function(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer of object; cdecl;
  TSQLiteBusyCallback = function(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer of object; cdecl;
  TOnData = Procedure(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String) of object;
  TOnBusy = Procedure(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean) of object;
  TOnQueryComplete = Procedure(Sender: TObject) of object;
  TSQLite = class(TObject)
  private
    fSQLite: Pointer;
    fMsg: String;
    fIsOpen: Boolean;
    fBusy: Boolean;
    fError: Integer;
    fVersion: String;
    fEncoding: String;
    fTable: TStrings;
    fLstName: TStringList;
    fLstVal: TStringList;
    fOnData: TOnData;
    fOnBusy: TOnBusy;
    fOnQueryComplete: TOnQueryComplete;
    fBusyTimeout: integer;
    fPMsg: PChar;
    fChangeCount: integer;
    procedure SetBusyTimeout(Timeout: integer);
  public
    constructor Create(DBFileName: String);
    destructor Destroy; override;
    function Query(Sql: String; Table: TStrings = nil): boolean;
    function ErrorMessage(ErrNo: Integer): string;
    function IsComplete(Sql: String): boolean;
    function LastInsertRow: integer;
    function Cancel: boolean;
    function DatabaseDetails(Table: TStrings): boolean;
    property LastErrorMessage: string read fMsg;
    property LastError: Integer read fError;
    property Version: String read fVersion;
    property Encoding: String read fEncoding;
    property OnData: TOnData read fOnData write fOnData;
    property OnBusy: TOnBusy read fOnBusy write fOnBusy;
    property OnQueryComplete: TOnQueryComplete read fOnQueryComplete write fOnQueryComplete;
    property BusyTimeout: Integer read fBusyTimeout write SetBusyTimeout;
    property ChangeCount: Integer read fChangeCount;
  end;
  function Pas2SQLStr(const PasString: string): string;
  function SQL2PasStr(const SQLString: string): string;
  function QuoteStr(const s: string; QuoteChar: Char = #39): string;
  function UnQuoteStr(const s: string; QuoteChar: Char = #39): string;
  procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);

implementation

const
  SQLITE_OK         =  0;   // Successful result
  SQLITE_ERROR      =  1;   // SQL error or missing database
  SQLITE_INTERNAL   =  2;   // An internal logic error in SQLite
  SQLITE_PERM       =  3;   // Access permission denied
  SQLITE_ABORT      =  4;   // Callback routine requested an abort
  SQLITE_BUSY       =  5;   // The database file is locked
  SQLITE_LOCKED     =  6;   // A table in the database is locked
  SQLITE_NOMEM      =  7;   // A malloc() failed
  SQLITE_READONLY   =  8;   // Attempt to write a readonly database
  SQLITE_INTERRUPT  =  9;   // Operation terminated by sqlite_interrupt()
  SQLITE_IOERR      = 10;   // Some kind of disk I/O error occurred
  SQLITE_CORRUPT    = 11;   // The database disk image is malformed
  SQLITE_NOTFOUND   = 12;   // (Internal Only) Table or record not found
  SQLITE_FULL       = 13;   // Insertion failed because database is full
  SQLITE_CANTOPEN   = 14;   // Unable to open the database file
  SQLITE_PROTOCOL   = 15;   // Database lock protocol error
  SQLITE_EMPTY      = 16;   // (Internal Only) Database table is empty
  SQLITE_SCHEMA     = 17;   // The database schema changed
  SQLITE_TOOBIG     = 18;   // Too much data for one row of a table
  SQLITE_CONSTRAINT = 19;   // Abort due to contraint violation
  SQLITE_MISMATCH   = 20;   // Data type mismatch
  SQLITEDLL: PChar  = 'sqlite.dll';
  DblQuote: Char    = '"';
  SngQuote: Char    = #39;
  Crlf: String      = #13#10;
  Tab: Char         = #9;

var
  SQLite_Open: function(dbname: PChar; mode: Integer; var ErrMsg: PChar): Pointer; cdecl;
  SQLite_Close: procedure(db: Pointer); cdecl;
  SQLite_Exec: function(db: Pointer; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl;
  SQLite_Version: function(): PChar; cdecl;
  SQLite_Encoding: function(): PChar; cdecl;
  SQLite_ErrorString: function(ErrNo: Integer): PChar; cdecl;
  SQLite_GetTable: function(db: Pointer; SQLStatement: PChar; var ResultPtr: Pointer; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl;
  SQLite_FreeTable: procedure(Table: PChar); cdecl;
  SQLite_FreeMem: procedure(P: PChar); cdecl;
  SQLite_Complete: function(P: PChar): boolean; cdecl;
  SQLite_LastInsertRow: function(db: Pointer): integer; cdecl;
  SQLite_Cancel: procedure(db: Pointer); cdecl;
  SQLite_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
  SQLite_BusyTimeout: procedure(db: Pointer; TimeOut: integer); cdecl;
  SQLite_Changes: function(db: Pointer): integer; cdecl;
  LibsLoaded: Boolean;
  DLLHandle: THandle;
  MsgNoError: String;

function QuoteStr(const s: string; QuoteChar: Char = #39): string;
begin
  Result := Concat(QuoteChar, s, QuoteChar);
end;

function UnQuoteStr(const s: string; QuoteChar: Char = #39): string;
begin
  Result := s;
  if length(Result) > 1 then
  begin
    if Result[1] = QuoteChar then
      Delete(Result, 1, 1);
    if Result[Length(Result)] = QuoteChar then
      Delete(Result, Length(Result), 1);
  end;
end;

function Pas2SQLStr(const PasString: string): string;
var
  n: integer;
begin
  Result := SQL2PasStr(PasString);
  n := Length(Result);
  while n > 0 do
  begin
    if Result[n] = SngQuote then
      Insert(SngQuote, Result, n);
    dec(n);
  end;
  Result := QuoteStr(Result);
end;

function SQL2PasStr(const SQLString: string): string;
const
  DblSngQuote: String = #39#39;
var
  p: integer;
begin
  Result := SQLString;
  p := pos(DblSngQuote, Result);
  while p > 0 do
  begin
    Delete(Result, p, 1);
    p := pos(DblSngQuote, Result);
  end;
  Result := UnQuoteStr(Result);
end;

procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
var
  n: integer;
  lstName, lstValue: TStringList;
begin
  if NameValuePairs <> nil then
  begin
    lstName := TStringList.Create;
    lstValue := TStringList.Create;
    lstName.CommaText := ColumnNames;
    lstValue.CommaText := ColumnValues;
    NameValuePairs.Clear;
    if lstName.Count = LstValue.Count then
      if lstName.Count > 0 then
        for n := 0 to lstName.Count - 1 do
          NameValuePairs.Append(Concat(lstName.Strings[n], '=', lstValue.Strings[n]));
    lstValue.Free;
    lstName.Free;
  end;
end;

function LoadLibs: Boolean;
begin
  Result := False;
  DLLHandle := LoadLibrary(SQLITEDLL);
  if DLLHandle <> 0 then
  begin
    @SQLite_Open := GetProcAddress(DLLHandle, 'sqlite_open');
    if not Assigned(@SQLite_Open) then exit;
    @SQLite_Close := GetProcAddress(DLLHandle, 'sqlite_close');
    if not Assigned(@SQLite_Close) then exit;
    @SQLite_Exec := GetProcAddress(DLLHandle, 'sqlite_exec');
    if not Assigned(@SQLite_Exec) then exit;
    @SQLite_Version := GetProcAddress(DLLHandle, 'sqlite_libversion');
    if not Assigned(@SQLite_Version) then exit;
    @SQLite_Encoding := GetProcAddress(DLLHandle, 'sqlite_libencoding');
    if not Assigned(@SQLite_Encoding) then exit;
    @SQLite_ErrorString := GetProcAddress(DLLHandle, 'sqlite_error_string');
    if not Assigned(@SQLite_ErrorString) then exit;
    @SQLite_GetTable := GetProcAddress(DLLHandle, 'sqlite_get_table');
    if not Assigned(@SQLite_GetTable) then exit;
    @SQLite_FreeTable := GetProcAddress(DLLHandle, 'sqlite_free_table');
    if not Assigned(@SQLite_FreeTable) then exit;
    @SQLite_FreeMem := GetProcAddress(DLLHandle, 'sqlite_freemem');
    if not Assigned(@SQLite_FreeMem) then exit;
    @SQLite_Complete := GetProcAddress(DLLHandle, 'sqlite_complete');
    if not Assigned(@SQLite_Complete) then exit;
    @SQLite_LastInsertRow := GetProcAddress(DLLHandle, 'sqlite_last_insert_rowid');
    if not Assigned(@SQLite_LastInsertRow) then exit;
    @SQLite_Cancel := GetProcAddress(DLLHandle, 'sqlite_interrupt');
    if not Assigned(@SQLite_Cancel) then exit;
    @SQLite_BusyTimeout := GetProcAddress(DLLHandle, 'sqlite_busy_timeout');
    if not Assigned(@SQLite_BusyTimeout) then exit;
    @SQLite_BusyHandler := GetProcAddress(DLLHandle, 'sqlite_busy_handler');
    if not Assigned(@SQLite_BusyHandler) then exit;
    @SQLite_Changes := GetProcAddress(DLLHandle, 'sqlite_changes');
    if not Assigned(@SQLite_Changes) then exit;
    Result := True;
  end;
end;

function SystemErrorMsg(ErrNo: Integer = -1): String;
var
  buf: PChar;
  size: Integer;
  MsgLen: Integer;
begin
  size := 256;
  GetMem(buf, size);
  If ErrNo = - 1 then
    ErrNo := GetLastError;
  MsgLen := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, buf, size, nil);
  if MsgLen = 0 then
    Result := 'ERROR'
  else
    Result := buf;
end;

function BusyCallback(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer; cdecl;
var
  sObjName: String;
  bCancel: Boolean;
begin
  Result := -1;
  with Sender as TSQLite do
  begin
    if Assigned(fOnBusy) then
    begin
      bCancel := False;
      sObjName := ObjectName;
      fOnBusy(Sender, sObjName, BusyCount, bCancel);
      if bCancel then
        Result := 0;
    end;
  end;
end;

function ExecCallback(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
var
  PVal, PName: ^PChar;
  n: integer;
  sVal, sName: String;
begin
  Result := 0;
  with Sender as TSQLite do
  begin
    if (Assigned(fOnData) or Assigned(fTable)) then
    begin
      fLstName.Clear;
      fLstVal.Clear;
      if Columns > 0 then
      begin
        PName := ColumnNames;
        PVal := ColumnValues;
        for n := 0 to Columns - 1 do
        begin
          fLstName.Append(PName^);
          fLstVal.Append(PVal^);
          inc(PName);
          inc(PVal);
        end;
      end;
      sVal := fLstVal.CommaText;
      sName := fLstName.CommaText;
      if Assigned(fOnData) then
        fOnData(Sender, Columns, sName, sVal);
      if Assigned(fTable) then
      begin
        if fTable.Count = 0 then
          fTable.Append(sName);
        fTable.Append(sVal);
      end;
    end;
  end;
end;

constructor TSQLite.Create(DBFileName: String);
var
  fPMsg: PChar;
begin
  inherited Create;
  fError := SQLITE_ERROR;
  fIsOpen := False;
  fLstName := TStringList.Create;
  fLstVal := TStringList.Create;
  fOnData := nil;
  fOnBusy := nil;
  fOnQueryComplete := nil;
  fChangeCount := 0;
  if LibsLoaded then
  begin
    fSQLite := SQLite_Open(PChar(DBFileName), 1, fPMsg);
    SQLite_FreeMem(fPMsg);
    if fSQLite <> nil then
    begin
      fVersion := SQLite_Version;
      fEncoding := SQLite_Encoding;
      fIsOpen := True;
      fError := SQLITE_OK;
    end;
  end;
  fMsg := ErrorMessage(fError);
end;

destructor TSQLite.Destroy;
begin
  if fIsOpen then
    SQLite_Close(fSQLite);
  fIsOpen := False;
  fLstName.Free;
  fLstVal.Free;
  fSQLite := nil;
  fOnData := nil;
  fOnBusy := nil;
  fOnQueryComplete := nil;
  fLstName := nil;
  fLstVal := nil;
  inherited Destroy;
end;

function TSQLite.Query(Sql: String; Table: TStrings = nil): boolean;
//var
//  fPMsg: PChar;
begin
  fError := SQLITE_ERROR;
  if fIsOpen then
  begin
    fPMsg := nil;
    fBusy := True;
    fTable := Table;
    if fTable <> nil then
      fTable.Clear;
    fError := SQLite_Exec(fSQLite, PChar(Sql), @ExecCallback, Self, fPMsg);
    SQLite_FreeMem(fPMsg);
    fChangeCount := SQLite_Changes(fSQLite);
    fTable := nil;
    fBusy := False;
    if Assigned(fOnQueryComplete) then
      fOnQueryComplete(Self);
  end;
  fMsg := ErrorMessage(fError);
  Result := (fError <> SQLITE_OK);
end;

function TSQLite.Cancel: boolean;
begin
  Result := False;
  if fBusy and fIsOpen then
  begin
    SQLite_Cancel(fSQLite);
    fBusy := false;
    Result := True;
  end;
end;

procedure TSQLite.SetBusyTimeout(Timeout: Integer);
begin
  fBusyTimeout := Timeout;
  if fIsOpen then
  begin
    SQLite_BusyTimeout(fSQLite, fBusyTimeout);
    if fBusyTimeout > 0 then
      SQLite_BusyHandler(fSQLite, @BusyCallback, Self)
    else
      SQLite_BusyHandler(fSQLite, nil, nil);
  end;
end;

function TSQLite.LastInsertRow: integer;
begin
  if fIsOpen then
    Result := SQLite_LastInsertRow(fSQLite)
  else
    Result := -1;
end;

function TSQLite.ErrorMessage(ErrNo: Integer): string;
begin
  if LibsLoaded then
  begin
    if ErrNo = 0 then
      Result := MsgNoError
    else
      Result := SQLite_ErrorString(ErrNo);
  end else
    MessageBox(GetActiveWindow(), 'Library "sqlite.dll" not found.', 'Error loading DLL', MB_OK or MB_ICONHAND or MB_SETFOREGROUND);
end;

function TSQLite.IsComplete(Sql: String): boolean;
begin
  Result := SQLite_Complete(PChar(Sql));
end;

function TSQLite.DatabaseDetails(Table: TStrings): boolean;
begin
  Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
end;

initialization
  LibsLoaded := LoadLibs;
  MsgNoError := SystemErrorMsg(0);

finalization
  if DLLHandle <> 0 then
    FreeLibrary(DLLHandle);

end.

[delphilevi]

noch was,

wie lang sind die kontonummern?
die gruppierung kann schiefgehen, wenn die Anzahl der Stellen 12 uebersteigt

daher lieber select sum(Betrag+0),'A' || KontoNr from Konto group by 'A' || KontoNr

[Gigant02]

@Orbmu2k

hmm nun läuft es

aber das kann ja auch nicht sinn der sache sein das immer so schreiben zumüssen

@delphilevi

ich muss mir das mla durchschaun was du mir da gepostet hast

lg, Gigant

[delphilevi]

der Fehler in der Gruppierung haengt mit der
innerhalb verwendeten Darstellung von integer zusammen (glaub ich )
Ist halt ein Bug und wahrscheinlich schwer zu fixen.

Ein anderer Workaround wäre die Kontonummer als varchar zu deklarieren, dann kann man sich das Casten der Werte beim Gruppieren sparen.

Dann ist aber Konto 12345 <> 012345