sdpgsql.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

  SQueryPgIndexNamesFmt =
  	'select '''' as '+CAT_NAME_FIELD+', usename as '+SCH_NAME_FIELD+
        ', so.relname as '+TBL_NAME_FIELD+', si.relname as '+IDX_NAME_FIELD+
        ', attname as '+IDX_COL_NAME_FIELD+', attnum as '+IDX_COL_POS_FIELD+
        ', CASE WHEN indisunique THEN 2 ELSE 1 END + CASE WHEN indisprimary THEN 4 ELSE 0 END as '+IDX_TYPE_FIELD+
	', '''' as '+IDX_SORT_FIELD+', '''' as '+IDX_FILTER_FIELD+
        ' from pg_index, pg_class so, pg_class si, pg_shadow, pg_attribute '+
        'where indrelid = so.oid and so.relowner = usesysid and attrelid = so.oid and'+
        '  indexrelid = si.oid and UPPER(so.relname) like UPPER(''%s'') %s '+
        'order by usename, so.relname, si.relname, attnum';
  SQueryPgIndexNamesWhereFmt =
  	' (si.oid = %d and pg_attribute.attnum in (%s)) ';
  SQueryPgIndexNames1Fmt =
	'select si.oid, indkey, si.relname from pg_index, pg_class st, pg_class si'+
	' where indrelid = st.oid and indexrelid = si.oid and UPPER(st.relname) = UPPER(''%s'')';
var
  sStmt, sKeys: string;
  cmd: TISqlCommand;
  i, nId: Integer;
begin
  sStmt := '';
  case ASchemaType of
    stTables,
    stSysTables:
      begin
        if AObjectName <> '' then
          sStmt := Format(' and UPPER(relname) like UPPER(''%s'')', [AObjectName]);
        sStmt := Format(SQueryPgTableNamesFmt, [sStmt]);
      end;
    stColumns:
      sStmt := Format(SQueryPgTableFieldNamesFmt, [AObjectName] );
    stProcedures:
      begin
        if AObjectName <> '' then
          sStmt := Format(' and UPPER(proname) like UPPER(''%s'')', [AObjectName]);
        sStmt := Format(SQueryPgStoredProcNamesFmt, [sStmt]);
      end;
    stIndexes:
      begin
        sStmt := Format(SQueryPgIndexNames1Fmt, [AObjectName]);
        cmd := CreateSqlCommand;
        try
          cmd.Prepare( sStmt );
          cmd.Execute;
          sStmt := '';
          while cmd.FetchNextRow do begin
            cmd.GetFieldAsInt32(1, nId);
            cmd.GetFieldAsString(2, sKeys);
            for i:=1 to Length(sKeys) do
              if sKeys[i] = ' ' then
                sKeys[i] := ',';
            if sStmt <> '' then
              sStmt := sStmt + ' or ';
            sStmt := sStmt + Format(SQueryPgIndexNamesWhereFmt, [nId, sKeys]);
          end;
          if sStmt <> '' then
            sStmt := ' and ('+sStmt+') ';
        finally
          cmd.Free;
        end;

        sStmt := Format(SQueryPgIndexNamesFmt, [AObjectName, sStmt]);
      end;
  end;

  cmd := CreateSqlCommand;
  try
    cmd.ExecDirect( sStmt );
  except
    cmd.Free;
    raise;
  end;

  Result := cmd;
end;

{ TIPgCommand }

constructor TIPgCommand.Create(ASqlDatabase: TISqlDatabase);
begin
  inherited Create(ASqlDatabase);

  FStmt		:= '';
  FBindStmt	:= '';
  FRowsAffected := -1;

  FRecCount	:= 0;
  FCurrRec	:= -1;

  FHandle 	:= nil;
end;

destructor TIPgCommand.Destroy;
begin
  Disconnect(False);

  inherited;
end;

procedure TIPgCommand.Check(pgres: PPGresult);
begin
  SqlDatabase.CheckRes( pgres );
end;

function TIPgCommand.GetHandle: PSDCursor;
begin
  Result := FHandle;
end;

function TIPgCommand.GetSqlDatabase: TIPgDatabase;
begin
  Result := (inherited SqlDatabase) as TIPgDatabase;
end;

procedure TIPgCommand.Disconnect(Force: Boolean);
begin
  // nothing
end;

procedure TIPgCommand.DoPrepare(Value: string);
begin
  if CommandType = ctStoredProc then
    DatabaseError(SNoCapability);

  FStmt		:= Value;
  FBindStmt	:= '';
end;

procedure TIPgCommand.DoExecDirect(Value: string);
var
  bResultSet: Boolean;
begin
  if CommandType = ctStoredProc then
    DatabaseError(SNoCapability);

  FStmt		:= Value;
  FBindStmt	:= '';

  bResultSet := InternalQExecute;

  	// if field descriptions were not initialized before Execute (for InternalInitFieldDefs)
  if bResultSet and (FieldDescs.Count = 0) then
    InitFieldDescs;

  SetNativeCommand(FBindStmt);
end;

procedure TIPgCommand.DoExecute;
var
  bResultSet: Boolean;
begin
  if CommandType = ctStoredProc then
    DatabaseError(SNoCapability);

  bResultSet := IsOpened;
  if not bResultSet then
    bResultSet := InternalQExecute;

  	// if field descriptions were not initialized before Execute (for InternalInitFieldDefs)
  if bResultSet and (FieldDescs.Count = 0) then begin
    InitFieldDescs;
    AllocFieldsBuffer;
    SetFieldsBuffer;
  end;

  SetNativeCommand(FBindStmt);
end;

// return True, if successful completion of a command returning data (such as a SELECT or SHOW).
function TIPgCommand.InternalQExecute: Boolean;
var
  szCmd, szRowsAffected: TSDCharPtr;
  st: Integer;
begin
  Result := False;
  FRowsAffected := -1;
	// set parameter's values
  InternalQBindParams;
{$IFDEF SD_CLR}
  szCmd := Marshal.StringToHGlobalAnsi( FBindStmt );
{$ELSE}
  szCmd := TSDCharPtr( FBindStmt );
{$ENDIF}
  try
    FHandle := PQexec( SqlDatabase.PgConnPtr, szCmd );
    Check( FHandle );
  finally
{$IFDEF SD_CLR}
    if Assigned( szCmd ) then
      Marshal.FreeHGlobal( szCmd );
{$ENDIF}
  end;

  st := PQresultStatus( FHandle );
	// if a command does not return data: INSERT, UPDATE
  if st = PGRES_COMMAND_OK then begin
    szRowsAffected := PQcmdTuples( FHandle );
    FRowsAffected  := StrToIntDef( HelperPtrToString( szRowsAffected ), 0 );
  end else if st = PGRES_TUPLES_OK then begin
        // return the number of rows in the query result
    FRecCount := PQntuples( FHandle );
    FCurrRec  := -1;
    Result := True;
  end;
end;

function TIPgCommand.GetIsOpened: Boolean;
begin
        // if successful completion of a command returning data (such as a SELECT or SHOW).
  Result := Assigned( FHandle ) and (PQresultStatus(FHandle) = PGRES_TUPLES_OK);
end;

function TIPgCommand.GetRowsAffected: Integer;
begin
  Result := FRowsAffected;
end;

function TIPgCommand.ResultSetExists: Boolean;
begin
  Result := True;
end;

procedure TIPgCommand.BindParamsBuffer;
begin
  // nothing
end;

procedure TIPgCommand.SetFieldsBuffer;
begin
  // nothing
end;

procedure TIPgCommand.InitParamList;
begin
  DatabaseError(SNoCapability);
end;

procedure TIPgCommand.GetOutputParams;
begin
  DatabaseError(SNoCapability);
end;


{ Convert TDateTime to string for SQL statement }
function TIPgCommand.CnvtDateTime2SqlString(Value: TDateTime): string;
  { Format date in ISO format 'yyyy-mm-dd' }
  function FormatSqlDate(Value: TDateTime): string;
  var
    Year, Month, Day: Word;
  begin
    DecodeDate(Value, Year, Month, Day);
    Result := Format('%.4d-%.2d-%.2d', [Year, Month, Day]);
  end;
  { Format time in ISO format 'hh:nn:ss' }
  function FormatSqlTime(Value: TDateTime): string;
  var
    Hour, Min, Sec, MSec: Word;
  begin
    DecodeTime(Value, Hour, Min, Sec, MSec);
    Result := Format('%.2d:%.2d:%.2d', [Hour, Min, Sec]);
  end;

begin
  if Trunc(Value) <> 0 then
    Result := FormatSqlDate(Value)
  else
    Result := '1899-12-30';

  if Frac(Value) <> 0 then begin
    if Result <> '' then
      Result := Result + ' ';
    Result := Result + FormatSqlTime(Value);
  end;
  Result := '''' + Result + '''';
end;

{ Convert float value to string with '.' delimiter }
function TIPgCommand.CnvtFloat2SqlString(Value: Double): string;
var
  i: Integer;
begin
  Result := FloatToStr(Value);
  if DecimalSeparator <> '.' then begin
    i := Pos(DecimalSeparator,Result);
    if i <> 0 then Result[i] := '.';
  end;
end;

{ Characters are converted as (tested with PostgreSQL 7.1)
  <'>  -> <\'>
  <$0> -> <\\000>
  <\>  -> <\\\\> 	 - it's probably this (and previous) character is converted twice
  <X>  -> <X>            - printable characters
  <X>  -> <\nnn> (octal) - non-printable characters
}