0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@a23(あずま しげなり)

Delphi13 から Supabase に接続してみた (サンプルコード)

0
Posted at

この記事は　『 2026/10/03　Supabase & PostgreSQL & Frontend 勉強会　』を開催予定の補助記事となります。

#　はじめに
　Windows11 デスクトップアプリ
Delphi13 VCL NetHTTPClient で　接続　JSONで　CRUDする　サンプルコードを公開します
NetHTTPClient を使用なので、Delphi 13 Community Edition　でも動作すると思います(未確認ですが)

#　今回使用するテーブル定義

CREATE TABLE tbl_t2
(
    /* =========================================================
     * 数値型
     * ========================================================= */
    fld_a  bigserial PRIMARY KEY,     -- serial8 / bigint + sequence
    fld_b  bigint,                    -- int8
    fld_h  numeric(18, 4),            -- decimal(18,4)
    /* =========================================================
     * 文字列型
     * ========================================================= */
    fld_p  text,
    /* =========================================================
     * 日付・時刻型
     * ========================================================= */
    fld_r  date,
    fld_v  timestamp(6) with time zone,
   /* --------------------------------------------------------
     * PostgreSQL 固有型
     * -------------------------------------------------------- */
    fld_ap uuid DEFAULT gen_random_uuid() NOT NULL,

    created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
    updated_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP
    
);

#　Delphi13 VCL のコード supabase_VCL_001_Unit.pas

//------------------------------------------------------------------------------
//TMS_Delphi_Supabase_PostgreSQL_基礎
//VCL JSON　CRUD
//------------------------------------------------------------------------------
//2026/09/17
//------------------------------------------------------------------------------

unit supabase_VCL_001_Unit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.Mask, Vcl.Buttons, Vcl.Grids, System.Net.URLClient,
  System.Net.HttpClient, System.Net.HttpClientComponent, Vcl.Samples.Spin,
  Vcl.NumberBox;


type
  TForm_Main = class(TForm)
    Panel_1: TPanel;
    StatusBar1: TStatusBar;
    LabeledEdit_supabase_url: TLabeledEdit;
    LabeledEdit_apikey: TLabeledEdit;
    LabeledEdit_Authorization: TLabeledEdit;
    SpeedButton_set: TSpeedButton;
    NetHTTPClient1: TNetHTTPClient;
    Label1: TLabel;
    Panel_2: TPanel;
    SpeedButton2: TSpeedButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label_created_at: TLabel;
    Label_updated_at: TLabel;
    Edit_fld_a: TEdit;
    DateTimePicker_fld_r: TDateTimePicker;
    DateTimePicker_fld_v: TDateTimePicker;
    NumberBox_fld_h: TNumberBox;
    Edit_fld_p: TEdit;
    SpinEdit_fld_b: TSpinEdit;
    Panel_21: TPanel;
    Label8: TLabel;
    SpinEdit_fld_a: TSpinEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    StringGrid1: TStringGrid;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton_setClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
      Rect: TRect; State: TGridDrawState);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form_Main: TForm_Main;

implementation

{$R *.dfm}

uses System.JSON, System.DateUtils;

procedure TForm_Main.FormCreate(Sender: TObject);
begin
  Panel_1.Visible:=false;
end;

procedure TForm_Main.FormShow(Sender: TObject);
begin
  SpeedButton_setClick(Self);

  NumberBox_fld_h.Mode := nbmFloat;
  NumberBox_fld_h.Decimal := 4;
  NumberBox_fld_h.DisplayFormat := '0.0000';

  SpeedButton2Click(Self);  //全検索
end;
//------------------------------------------------------------------------------

procedure TForm_Main.SpeedButton_setClick(Sender: TObject);
begin
  //supabaseの接続設定

  LabeledEdit_supabase_url.Text:='https://xxx';
  //<API KEY><anon><public>< Key (Legacy)>
  LabeledEdit_apikey.Text:='xxx';
  //<API KEY><service_role> <<secrat>>
  LabeledEdit_Authorization.Text:='Bearer '+'xxx7;
end;
//------------------------------------------------------------------------------

procedure TForm_Main.StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
  Rect: TRect; State: TGridDrawState);
var
  S: string;
begin
//    1列目だけ文字色を Maroon にする

  with StringGrid1.Canvas do
  begin
    // 背景色
    if gdSelected in State then
      Brush.Color := clHighlight
    else
      Brush.Color := StringGrid1.Color;

    FillRect(Rect);

    // 文字色
    if gdSelected in State then
      Font.Color := clHighlightText
    else if ACol = 1 then
      Font.Color := clMaroon
    else
      Font.Color := StringGrid1.Font.Color;

    S := StringGrid1.Cells[ACol, ARow];

    // 文字を描画
    TextOut(
      Rect.Left + 2,
      Rect.Top + 2,
      S
    );
  end;
end;
//------------------------------------------------------------------------------

procedure TForm_Main.BitBtn1Click(Sender: TObject);
// 登録 INSERT
var
  HttpClient: THttpClient;
  Response: IHTTPResponse;
  JsonObj: TJSONObject;
  JsonStream: TStringStream;
  w_supabase_url: string;
begin
  // 桁数チェック
  if SpinEdit_fld_b.Value >= 1 then
  begin
    BitBtn1.Enabled := False;

    HttpClient := THttpClient.Create;
    try
      //--------------------------------------------------------------------------
      // Supabase API 認証
      //--------------------------------------------------------------------------
      HttpClient.CustomHeaders['apikey'] :=
        LabeledEdit_apikey.Text;

      HttpClient.CustomHeaders['Authorization'] :=
        LabeledEdit_Authorization.Text;

      HttpClient.CustomHeaders['Prefer'] :=
        'return=minimal';

      //--------------------------------------------------------------------------
      // Supabase REST API URL
      //
      // 例：
      // https://xxxx.supabase.co/rest/v1/tbl_t2
      //--------------------------------------------------------------------------
      w_supabase_url :=
        LabeledEdit_supabase_url.Text;

      //--------------------------------------------------------------------------
      // INSERTするJSONを作成
      //
      // {
      //   "fld_b": 123,
      //   "fld_h": 12.34,
      //   "fld_p": "ABC",
      //   "fld_r": "2026-09-09",
      //   "fld_v": "2026-09-09"
      // }
      //--------------------------------------------------------------------------
      JsonObj := TJSONObject.Create;
      try
        // LargeInt
        JsonObj.AddPair(
          'fld_b',
          TJSONNumber.Create(SpinEdit_fld_b.Value)
        );

        // NumberBox → 数値
        JsonObj.AddPair(
          'fld_h',
          TJSONNumber.Create(NumberBox_fld_h.Value)
        );

        // 文字列
        JsonObj.AddPair(
          'fld_p',
          Edit_fld_p.Text
        );

        // 日付
        JsonObj.AddPair(
          'fld_r',
          FormatDateTime('yyyy-mm-dd', DateTimePicker_fld_r.Date)
        );

        // 日付
        JsonObj.AddPair(
          'fld_v',
          FormatDateTime('yyyy-mm-dd', DateTimePicker_fld_v.Date)
        );

        //--------------------------------------------------------------------------
        // JSONをPOST
        //--------------------------------------------------------------------------
        JsonStream := TStringStream.Create(
          JsonObj.ToJSON,
          TEncoding.UTF8
        );
        try
          JsonStream.Position := 0;

          HttpClient.ContentType := 'application/json';

          Response := HttpClient.Post(
            w_supabase_url,
            JsonStream
          );

        finally
          JsonStream.Free;
        end;

      finally
        JsonObj.Free;
      end;

      //--------------------------------------------------------------------------
      // 結果判定
      //--------------------------------------------------------------------------
      if (Response.StatusCode = 200) or
         (Response.StatusCode = 201) or
         (Response.StatusCode = 204) then
      begin
        ShowMessage('登録しました！');
      end
      else
      begin
        ShowMessage(
          '登録エラー' + sLineBreak +
          'StatusCode : ' + IntToStr(Response.StatusCode) +
          sLineBreak +
          'StatusText : ' + Response.StatusText +
          sLineBreak +
          Response.ContentAsString
        );
      end;

    except
      on E: Exception do
      begin
        ShowMessage(
          '登録エラー' + sLineBreak +
          E.Message
        );
      end;
    end;

    BitBtn1.Enabled := True;
    SpinEdit_fld_b.SetFocus;
    SpeedButton2Click(Self);
  end
  else
    SpinEdit_fld_b.SetFocus;
end;
//------------------------------------------------------------------------------

procedure TForm_Main.BitBtn2Click(Sender: TObject); //検索
var
  HttpClient: THttpClient;
  Response: IHTTPResponse;
  JsonArray: TJSONArray;
  JsonObj: TJSONObject;
  w_supabase_url: string;
  fld_a_Value: string;
begin
  // １件検索

  HttpClient := THttpClient.Create;
  try
    //--------------------------------------------------------------------------
    // Supabase API 認証
    //--------------------------------------------------------------------------
    HttpClient.CustomHeaders['apikey'] :=
      LabeledEdit_apikey.Text;

    HttpClient.CustomHeaders['Authorization'] :=
      LabeledEdit_Authorization.Text;

    //--------------------------------------------------------------------------
    // fld_a の値を取得
    //--------------------------------------------------------------------------
    fld_a_Value := IntToStr(SpinEdit_fld_a.Value);

    //--------------------------------------------------------------------------
    // Supabase REST API
    //
    // FireDAC:
    //   WHERE fld_a=:fld_a
    //
    // Supabase:
    //   ?fld_a=eq.123
    //
    // limit=1 で1件だけ取得
    //--------------------------------------------------------------------------
    w_supabase_url :=
      LabeledEdit_supabase_url.Text +
      '?fld_a=eq.' + fld_a_Value +
      '&limit=100';

    //--------------------------------------------------------------------------
    // GET
    //--------------------------------------------------------------------------
    Response := HttpClient.Get(w_supabase_url);

    //--------------------------------------------------------------------------
    // 正常終了
    //--------------------------------------------------------------------------
    if Response.StatusCode = 200 then
    begin
      JsonArray :=
        TJSONObject.ParseJSONValue(
          Response.ContentAsString
        ) as TJSONArray;

      try
        //--------------------------------------------------------------------------
        // 該当データあり
        //--------------------------------------------------------------------------
        if Assigned(JsonArray) and (JsonArray.Count > 0) then
        begin
          JsonObj := JsonArray.Items[0] as TJSONObject;

          // fld_a
          Edit_fld_a.Text :=
            JsonObj.GetValue<string>('fld_a');

          // fld_b
          SpinEdit_fld_b.Value :=
            JsonObj.GetValue<Int64>('fld_b');

          // fld_h
          NumberBox_fld_h.Decimal := 4;
          NumberBox_fld_h.DisplayFormat := '0.0000';
          NumberBox_fld_h.Value :=
            JsonObj.GetValue<Double>('fld_h');

          // fld_p
          Edit_fld_p.Text :=
            JsonObj.GetValue<string>('fld_p');

          // fld_r
          DateTimePicker_fld_r.Date :=
            ISO8601ToDate(
              JsonObj.GetValue<string>('fld_r')
            );

          // fld_v
          DateTimePicker_fld_v.Date :=
            ISO8601ToDate(
              JsonObj.GetValue<string>('fld_v')
            );

          // created_at
          Label_created_at.Caption :=
            DateTimeToStr(
              ISO8601ToDate(
                JsonObj.GetValue<string>('created_at')
              )
            );

          // updated_at
          Label_updated_at.Caption :=
            DateTimeToStr(
              ISO8601ToDate(
                JsonObj.GetValue<string>('updated_at')
              )
            );
        end
        else
        begin
          ShowMessage(
            '該当するデータがありません。'
          );
        end;

      finally
        JsonArray.Free;
      end;
    end
    else
    begin
      ShowMessage(
        '検索エラー' + sLineBreak +
        'StatusCode : ' + IntToStr(Response.StatusCode) +
        sLineBreak +
        'StatusText : ' + Response.StatusText +
        sLineBreak +
        Response.ContentAsString
      );
    end;

  except
    on E: Exception do
    begin
      ShowMessage(
        '検索エラー' + sLineBreak +
        E.Message
      );
    end;
  end;

  HttpClient.Free;
end;

procedure TForm_Main.BitBtn3Click(Sender: TObject);
// 訂正 UPDATE
var
  HttpClient: THttpClient;
  Response: IHTTPResponse;
  JsonObj: TJSONObject;
  JsonStream: TStringStream;
  w_supabase_url: string;
  fld_a_Value: string;
begin
  //--------------------------------------------------------------------------
  // fld_b のチェック
  //--------------------------------------------------------------------------
  if SpinEdit_fld_b.Value >= 1 then
  begin
    BitBtn3.Enabled := False;

    HttpClient := THttpClient.Create;
    try
      //--------------------------------------------------------------------------
      // Supabase API 認証
      //--------------------------------------------------------------------------
      HttpClient.CustomHeaders['apikey'] :=
        LabeledEdit_apikey.Text;

      HttpClient.CustomHeaders['Authorization'] :=
        LabeledEdit_Authorization.Text;

      //--------------------------------------------------------------------------
      // 更新対象 fld_a
      //--------------------------------------------------------------------------
      fld_a_Value :=
        IntToStr(SpinEdit_fld_a.Value);

      //--------------------------------------------------------------------------
      // UPDATEするJSONを作成
      //
      // {
      //   "fld_b": 123,
      //   "fld_h": 12.3400,
      //   "fld_p": "ABC",
      //   "fld_r": "2026-09-09",
      //   "fld_v": "2026-09-10"
      // }
      //--------------------------------------------------------------------------
      JsonObj := TJSONObject.Create;
      try
        // fld_b
        JsonObj.AddPair(
          'fld_b',
          TJSONNumber.Create(SpinEdit_fld_b.Value)
        );

        // fld_h
        JsonObj.AddPair(
          'fld_h',
          TJSONNumber.Create(NumberBox_fld_h.Value)
        );

        // fld_p
        JsonObj.AddPair(
          'fld_p',
          Edit_fld_p.Text
        );

        // fld_r
        JsonObj.AddPair(
          'fld_r',
          FormatDateTime(
            'yyyy-mm-dd',
            DateTimePicker_fld_r.Date
          )
        );

        // fld_v
        JsonObj.AddPair(
          'fld_v',
          FormatDateTime(
            'yyyy-mm-dd',
            DateTimePicker_fld_v.Date
          )
        );

        //--------------------------------------------------------------------------
        // 更新対象URL
        //
        // FireDAC:
        //   WHERE fld_a = :fld_a
        //
        // Supabase:
        //   ?fld_a=eq.123
        //--------------------------------------------------------------------------
        w_supabase_url :=
          LabeledEdit_supabase_url.Text +
          '?fld_a=eq.' + fld_a_Value;

        //--------------------------------------------------------------------------
        // JSONを送信
        //--------------------------------------------------------------------------
        JsonStream := TStringStream.Create(
          JsonObj.ToJSON,
          TEncoding.UTF8
        );
        try
          JsonStream.Position := 0;

          HttpClient.ContentType :=
            'application/json';

          //--------------------------------------------------------------------------
          // PATCH = UPDATE
          //--------------------------------------------------------------------------
          Response :=
            HttpClient.Patch(
              w_supabase_url,
              JsonStream
            );

        finally
          JsonStream.Free;
        end;

      finally
        JsonObj.Free;
      end;

      //--------------------------------------------------------------------------
      // 結果判定
      //--------------------------------------------------------------------------
      if (Response.StatusCode = 200) or
         (Response.StatusCode = 204) then
      begin
        ShowMessage(
          IntToStr(SpinEdit_fld_a.Value) +
          #13#10 +
          '　を修正しました！'
        );
      end
      else
      begin
        ShowMessage(
          '更新エラー' + sLineBreak +
          'StatusCode : ' +
          IntToStr(Response.StatusCode) +
          sLineBreak +
          'StatusText : ' +
          Response.StatusText +
          sLineBreak +
          Response.ContentAsString
        );
      end;

    except
      on E: Exception do
      begin
        ShowMessage(
          '更新エラー' + sLineBreak +
          E.Message
        );
      end;
    end;

    HttpClient.Free;

    BitBtn3.Enabled := True;
    SpinEdit_fld_b.SetFocus;
    SpeedButton2Click(Self);
  end
  else
    SpinEdit_fld_b.SetFocus;
end;
//------------------------------------------------------------------------------

procedure TForm_Main.BitBtn4Click(Sender: TObject);
var
  HttpClient: THttpClient;
  Response: IHTTPResponse;
  w_supabase_url: string;
  fld_a_Value: string;
begin
  //--------------------------------------------------------------------------
  // 削除確認
  //--------------------------------------------------------------------------
  if MessageDlg(
       SpinEdit_fld_a.Text + '　' + #13#10 +
       '　を削除しますか?',
       mtWarning,
       [mbYes, mbNo],
       0
     ) = mrYes then
  begin
    BitBtn4.Enabled := False;

    HttpClient := THttpClient.Create;
    try
      //--------------------------------------------------------------------------
      // Supabase API 認証
      //--------------------------------------------------------------------------
      HttpClient.CustomHeaders['apikey'] :=
        LabeledEdit_apikey.Text;

      HttpClient.CustomHeaders['Authorization'] :=
        LabeledEdit_Authorization.Text;

      //--------------------------------------------------------------------------
      // 削除対象 fld_a
      //--------------------------------------------------------------------------
      fld_a_Value :=
        IntToStr(SpinEdit_fld_a.Value);

      //--------------------------------------------------------------------------
      // DELETE URL
      //
      // FireDAC:
      //   DELETE FROM tbl_t2
      //   WHERE fld_a = :fld_a
      //
      // Supabase:
      //   DELETE /rest/v1/tbl_t2?fld_a=eq.123
      //--------------------------------------------------------------------------
      w_supabase_url :=
        LabeledEdit_supabase_url.Text +
        '?fld_a=eq.' + fld_a_Value;

      //--------------------------------------------------------------------------
      // DELETE実行
      //--------------------------------------------------------------------------
      Response :=
        HttpClient.Delete(w_supabase_url);

      //--------------------------------------------------------------------------
      // 結果判定
      //--------------------------------------------------------------------------
      if (Response.StatusCode = 200) or
         (Response.StatusCode = 204) then
      begin
        ShowMessage(
          IntToStr(SpinEdit_fld_a.Value) +
          '　を削除しました！'
        );

        //--------------------------------------------------------------------------
        // 全検索
        //--------------------------------------------------------------------------
        SpeedButton2Click(Self);
      end
      else
      begin
        ShowMessage(
          '削除エラー' + sLineBreak +
          'StatusCode : ' +
          IntToStr(Response.StatusCode) +
          sLineBreak +
          'StatusText : ' +
          Response.StatusText +
          sLineBreak +
          Response.ContentAsString
        );
      end;

    except
      on E: Exception do
      begin
        ShowMessage(
          '削除エラー' + sLineBreak +
          E.Message
        );
      end;
    end;

    HttpClient.Free;

    BitBtn4.Enabled := True;
    SpinEdit_fld_b.SetFocus;
    SpeedButton2Click(Self);
  end
  else
    SpinEdit_fld_b.SetFocus;
end;
//------------------------------------------------------------------------------

procedure TForm_Main.SpeedButton2Click(Sender: TObject);
var
  HttpClient: THttpClient;
  Response: IHTTPResponse;
  JsonArray: TJSONArray;
  JsonValue: TJSONValue;
  i: Integer;
  Row: Integer;
  JsonObj: TJSONObject;
  w_supabase_url:string;
begin
  //全検索
  HttpClient := THttpClient.Create;
  try
    HttpClient.CustomHeaders['apikey'] := LabeledEdit_apikey.Text;  // <API KEY><anon><public>< Key (Legacy)>
    HttpClient.CustomHeaders['Authorization'] := LabeledEdit_Authorization.Text;    //'Bearer あなたのanonキー';  <API KEY><service_role> <<secrat>>
    w_supabase_url:=LabeledEdit_supabase_url.text+'?order=fld_a.asc&limit=100';
    Response := HttpClient.Get(w_supabase_url);


    if Response.StatusCode = 200 then
    begin
      JsonArray := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONArray;
      if Assigned(JsonArray) then
      begin
        StringGrid1.RowCount := JsonArray.Count + 1; // ヘッダー行 + データ行

        // 例としてカラム名は固定
        StringGrid1.Cells[1, 0] := 'fld_a';
        StringGrid1.Cells[2, 0] := 'flc_b';
        StringGrid1.Cells[3, 0] := 'fld_h';
        StringGrid1.Cells[4, 0] := 'fld_p';
        StringGrid1.Cells[5, 0] := 'fld_r';
        StringGrid1.Cells[6, 0] := 'fld_v';
        StringGrid1.Cells[7, 0] := 'fld_ap';

        for i := 0 to JsonArray.Count - 1 do
        begin
          JsonObj := JsonArray.Items[i] as TJSONObject;
          Row := i + 1;
          StringGrid1.Cells[0, Row] := IntToStr(i+1);
          StringGrid1.Cells[1, Row] := JsonObj.GetValue('fld_a').Value;
          StringGrid1.Cells[2, Row] := JsonObj.GetValue('fld_b').Value;
          StringGrid1.Cells[3, Row] := JsonObj.GetValue('fld_h').Value;
          StringGrid1.Cells[4, Row] := JsonObj.GetValue('fld_p').Value;
          StringGrid1.Cells[5, Row] := JsonObj.GetValue('fld_r').Value;
          StringGrid1.Cells[6, Row] := JsonObj.GetValue('fld_v').Value;
          StringGrid1.Cells[7, Row] := JsonObj.GetValue('fld_ap').Value;
        end;
      end;
    end
    else
      ShowMessage('通信エラー: ' + Response.StatusText);
  finally
    HttpClient.Free;
  end;
end;

end.

#　このサンプルは、supabase　の　設定は　空白としていますので、ご自身で、supabase　を使用して、お試しください

#　実行して、接続成功後、データと投入すると、こんな感じです
01_supabase_VCL_json.png

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?