Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年11月20日] [更新 2019年05月05日]　Delphi サンプルプログラム集
775_TIdHTTP を使用して指定 URL にデータを送る
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro + Indy 10.5.7
775_Indy_HTTPSendData.zip　[4,430 KB]　2019年05月05日版 (EXE 同梱)






TIdHTTP を使用して指定 URL にデータを送る


Delphi 附属の Indy コンポーネントである，TIdHTTP を使用して，指定 URL (サーバ上のプログラム) にデータを送るテストプログラムです．これには Post または Get メソッドを使用します．これらのメソッドは次のようになっています．そこで具体的な簡単な実験をしてみました．
  • [GET] 特定の URL をリクエストして結果を得る
    ブラウザの URL 欄に入力するのと同じ
  • [POST] 特定の URL へデータを送る
    サーバの別プログラムやスクリプトなどがデータを処理
以下のテストプログラムのコードではエンコードとデコードの処理をしていますが，Delphi と Indy のバージョンによっては不要なこともあります．また，ネット上のファイル類の操作に共通に言えることですが，URL の文字コードページによっても，あるいは，php，perl 等のコードでは，サーバー側でエンコードやデコードの処理を行っている場合もあります．


[備考]
サンプルコード中に以下のような，URL の文字列の自動エンコードの指定がありますが，Indy のバージョンによっては正常に機能しない場合があります．
    IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions - [hoForceEncodeParams];
その場合はこのコードを削除するか，- を + にして自動エンコードの指定にしてみてください．+ にするとこのコードない場合と同じです．
本ページのテストで使用している php ファイルのコードページは Shift-JIS です．コードページが Shift-JIS の場合は，URL の文字列の自動エンコードを有効にしても，明示的にエンコードとデコードの処理が必要なようです．




01_当サイトの testpost.php にデータを送る


当サイト上のサーバの，testpost.php という URL に対してデータを送ります．
この URL では PHP のPOST 関数でデータを受取って処理します．つまり，Post のデータしか受け付けないようなっています．

TIdHTTP コンポの Post メソッドでは，指定 URL にデータを送る際，引数でその URL (サーバ内のプログラム) が受取る変数に値をセットします．したがって，受取る側の変数名が不明だと送れませんが，ここではテストですのでわかっているものとしています．受取るサーバ側のコードは以下のようになっています．
このようなサーバ側のプログラムでは，Post でも Get でデータを送っても受取るようにしている場合もあります．


リスト1
testpost.php の全コード
name と hoby という変数から POST でその値を受取るようにしている 

  <?php
$name = $_POST["name"];
$hoby = $_POST["hoby"];
if ( $name == "" ) {
            print "[　　] 様から次のデータを受取りました．\r\n";
            }
            else {
            print "[ ".$name." ] 様から次のデータを受取りました．\r\n";
            } 
if ( $hoby == "" ) {
            print "趣味 :  \r\n";
            }
            else {
            print " 趣味 : ".$hoby."\r\n";
            }
?>


図1
設計時画面
図2
Post メソッドで送った場合
  • サーバ側から処理した内容が返ってくる
図3
Get メソッドで送った場合
  • 送ったが，サーバ側のプログラムでは受取れなかった

リスト2
IdHTTP で当サイトの testpost.php にデータを送る 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit1: TLabeledEdit;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    IniFileName : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IniFiles, HTTPApp;

{$R *.dfm}

//=============================================================================
//  Editに関係情報をセット
//  1つ上の階層からPostGet.iniを読み出してセット
//  このIniファイルの読出しと書込みはテストには直接関係ない
//  他のテストプログラムと共通の値を利用するためのもの
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AIni : TInifile;
begin
  IniFileName := '..\PostGet.ini';
  AIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := AIni.ReadString('PostGet', 'Name', '');
     LabeledEdit2.Text := AIni.ReadString('PostGet', 'Hoby', '');
   end;
  finally
    FreeAndNil(AIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  AIni : TInifile;
begin
  AIni := TIniFile.Create(IniFileName);
  try
    try
      AIni.WriteString('PostGet', 'Name', LabeledEdit1.Text);
      AIni.WriteString('PostGet', 'Hoby', LabeledEdit2.Text);
    except
    end;
  finally
    FreeAndNil(AIni);
  end;

  if IdHTTP1.Connected then IdHTTP1.Disconnect;
end;

//=============================================================================
//  PostメソッドでPostURLにデータを送る
//  Postメソッドではデータを引数で渡す
//  ここのPostURLで指定しているURLではPostでデータを受取るようになっている
//
//  HTTPEncodeの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL    : String;
  PostStream : TStringList;
  ResStream  : TStringStream;
begin
  Memo1.Clear;

  PostURL    := 'http://mrxray.on.coocan.jp/Others/testpost.php';
  PostStream := TStringList.Create;
  ResStream  := TStringStream.Create('');

  //自動でエンコードしないようにする
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions - [hoForceEncodeParams];

  //名前
  PostStream.Add('name=' + HTTPEncode(LabeledEdit1.Text));

  //趣味
  PostStream.Add('hoby=' + HTTPEncode(LabeledEdit2.Text));

  Screen.Cursor := crHourGlass;
  try
    try
      IdHTTP1.Post(PostURL, PostStream, ResStream);
    except
      //エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    //サーバからのデータを表示
    Memo1.Lines.Add(HTTPDecode(ResStream.DataString));

    Screen.Cursor := crDefault;
    FreeAndNil(PostStream);
    FreeAndNil(ResStream);
  end;
end;

//=============================================================================
//  GetメソッドでPostURLにデータを送る
//  GetメソッドではURL文字列にデータを&で連結して渡す
//  ここのPostURLで指定しているURLではPostだけでデータを受取るようになっている
//
//  HTTPEncodeの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  PostURL   : String;
  ResStream : TStringStream;
begin
  Memo1.Clear;

  //テスト用のURL
  PostURL := 'http://mrxray.on.coocan.jp/Others/testpost.php';

  //自動でエンコードしないようにする
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions - [hoForceEncodeParams];

  //値をURLで引渡す意味の?を最初に付加
  PostURL := PostURL + '?';

  //名前
  PostURL := PostURL + '&name=' + HTTPEncode(LabeledEdit1.Text);

  //趣味
  PostURL := PostURL + '&hoby=' + HTTPEncode(LabeledEdit2.Text);

  ResStream := TStringStream.Create('');
  Screen.Cursor := crHourGlass;
  try
    try
      //投稿
      IdHTTP1.Get(PostURL,ResStream);
    except
      //エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    //サーバからのデータを表示
    Memo1.Lines.Add(HTTPDecode(ResStream.DataString));

    Screen.Cursor := crDefault;
    FreeAndNil(ResStream);
  end;
end;

end.


上のテストで使用した php ファイルのコードページは Shift-jis です．
サーバの同じディレクトリに BOM なしで，コードページが UTF-8 の php のファイルがあります．それでテストした結果が下図です．文字化けしています．


図4
BOM なしの UTF-8 の php のファイルの場合
  • php ファイル内の文字列が文字化けしている

文字化けしないでデータを受信するには，データを受け取る際にコードページを指定します．UTF-8 のデータを受信するので UTF-8 を指定します．以下のサンプルコードではデータを受信するストリームで指定しています．


図5
BOM なしの UTF-8 の php のファイルの場合
  • UTF-8 として受信した場合

リスト3
IdHTTP で当サイトの testpost.php にデータを送る．BOM なしの UTF-8 の php のファイルの場合		 
//=============================================================================
//  PostメソッドでPostURLにデータを送る
//  Postメソッドではデータを引数で渡す
//  ここのPostURLで指定しているURLではPostでデータを受取るようになっている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL    : String;
  PostStream : TStringList;
  ResStream  : TStringStream;
begin
  Memo1.Clear;
  // testpost_UTF8N.php は BOM なし
  PostURL    := 'http://mrxray.on.coocan.jp/Others/testpost_UTF8N.php';
  PostStream := TStringList.Create;
  // コードページの指定をして TStringStream のインスタンスを生成
  ResStream  := TStringStream.Create('', TEncoding.UTF8);

  // UTF-8 の時は自動エンコードの指定は有効
  // このコートがない場合は自動エンコード指定と同じ
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions + [hoForceEncodeParams];

  // 名前
  PostStream.Add('name=' + LabeledEdit1.Text);

  // 趣味
  PostStream.Add('hoby=' + LabeledEdit2.Text);

  Screen.Cursor := crHourGlass;
  try
    try
      IdHTTP1.Post(PostURL, PostStream, ResStream);
    except
      // エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    // サーバからのデータを表示
    Memo1.Lines.Add(ResStream.DataString);

    Screen.Cursor := crDefault;
    FreeAndNil(PostStream);
    FreeAndNil(ResStream);
  end;
end;


サーバの同じディレクトリに BOM 付きの UTF-8 の php のファイルがあります．それでテストした結果が下図です．受信ータの先頭に ? の文字があります．これは，該当する文字がない場合の UTF-8 の「デフォルトの文字」です．


図6
BOM 付きの UTF-8 の php のファイルの場合
  • 受信データの先頭に ? の文字がある

データを受信した後，データの先頭から BOM のデータだけを削除すれば，BOM なしの，コードページが UTF-8 のデータとして扱えます．その例です．


図7
BOM 付きの UTF-8 の php のファイルの場合
  • 受信データから BOM を削除した結果
  • 受信データの先頭に ? の文字はない

リスト4
IdHTTP で当サイトの testpost.php にデータを送る．BOM 付き UTF-8 のデータの処理例		 
//=============================================================================
//  PostメソッドでPostURLにデータを送る
//  Postメソッドではデータを引数で渡す
//  ここのPostURLで指定しているURLではPostでデータを受取るようになっている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL    : String;
  PostStream : TStringList;
  ResStream  : TStringStream;
  DataStream : TStringStream;
begin
  Memo1.Clear;

  // testpost_UTF8.php は BOM 付き
  PostURL    := 'http://mrxray.on.coocan.jp/Others/testpost_UTF8.php';
  PostStream := TStringList.Create;
  // コードページの指定をして TStringStream のインスタンスを生成
  ResStream  := TStringStream.Create('', TEncoding.UTF8);
  DataStream := TStringStream.Create('', TEncoding.UTF8);

  // UTF-8 の時は自動エンコードの指定が使用可能
  // このコートがない場合は自動エンコード指定と同じ
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions + [hoForceEncodeParams];

  // 名前
  PostStream.Add('name=' + LabeledEdit1.Text);

  // 趣味
  PostStream.Add('hoby=' + LabeledEdit2.Text);

  Screen.Cursor := crHourGlass;
  try
    try
      IdHTTP1.Post(PostURL, PostStream, ResStream);

      // BOM を取り除く
      if (ResStream.Bytes[0] = $EF)
          and (ResStream.Bytes[1] = $BB)
          and (ResStream.Bytes[2] = $BF) then begin
        DataStream.Size := ResStream.Size - 3;
        Move(ResStream.Bytes[3], DataStream.Bytes[0], ResStream.Size - 3);
      end;
    except
      // エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    // サーバからのデータを表示
    Memo1.Lines.Add(DataStream.DataString);

    Screen.Cursor := crDefault;
    FreeAndNil(PostStream);
    FreeAndNil(ResStream);
    FreeAndNil(DataStream);
  end;
end;



02_当サイトの testget.php にデータを送る


当サイトのサーバ上の，testget.php というURLに対してデータを送ります．この URL では PHP の GET 関数でデータを受取って処理します．つまり，Get のデータしか受け付けないようなっています． TIdHTTP コンポの Get メソッドでは，URL 文字列の後にサーバのプログラムが受取る変数とその値を加えた URL 文字列にして実行します．したがって，受取る側の変数名が不明だと送れませんが，ここではテストですのでわかっているものとします．
受取るサーバ側のコードは以下のようになっています．サーバによっては，Post でも Get でデータを送っても受取るようにしている場合もあります．


[備考]
テストで使用している送信先のサーバのファイルのコードページは Shift-jis です．異なるコードページのファイルを扱う場合はコードページ関係の指定，あるいは設定が必要です．
前項の記事を参考にしてください．


リスト5
testget.php の全コード
name と hoby という変数から GET でその値を受取るようにしている 
<?php
$name = $_GET["name"];
$hoby = $_GET["hoby"];
if ( $name == "" ) {
            print "[　　] 様から次のデータを受取りました．\r\n";
            }
            else {
            print "[ ".$name." ] 様から次のデータを受取りました．\r\n";
            }
if ( $hoby == "" ) {
            print "趣味 : \r\n";
            }
            else {
            print " 趣味 : ".$hoby."\r\n";
            } 
?>


図8
設計時画面
図9
Post メソッドで送った場合
  • 送れたが，サーバ側では値を受取れなかったので名前も趣味も空白
図10
Get メソッドで送った場合
  • サーバ側が受取った結果を表示

リスト6
IdHTTP で当サイトの testget.php にデータを送る 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit1: TLabeledEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    IniFileName : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IniFiles, HTTPApp;

{$R *.dfm}

//=============================================================================
//  Editに関係情報をセット
//  1つ上の階層からPostGet.iniを読み出してセット
//  このIniファイルの読出しと書込みはテストには直接関係ない
//  他のテストプログラムと共通の値を利用するためのもの
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AIni : TInifile;
begin
  IniFileName := '..\PostGet.ini';
  AIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := AIni.ReadString('PostGet', 'Name', '');
     LabeledEdit2.Text := AIni.ReadString('PostGet', 'Hoby', '');
   end;
  finally
    FreeAndNil(AIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  AIni : TInifile;
begin
  AIni := TIniFile.Create(IniFileName);
  try
    try
      AIni.WriteString('PostGet', 'Name', LabeledEdit1.Text);
      AIni.WriteString('PostGet', 'Hoby', LabeledEdit2.Text);
    except
    end;
  finally
    FreeAndNil(AIni);
  end;

  if IdHTTP1.Connected then IdHTTP1.Disconnect;
end;

//=============================================================================
//  PostメソッドでPostURLにデータを送る
//  Postメソッドではデータを引数で渡す
//  ここのPostURLで指定しているURLではGetだけでデータを受取るようになっている
//
//  HTTPEncodeの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL    : String;
  PostStream : TStringList;
  ResStream  : TStringStream;
begin
  Memo1.Clear;

  PostURL    := 'http://mrxray.on.coocan.jp/Others/testget.php';
  PostStream := TStringList.Create;
  ResStream  := TStringStream.Create('');

  //自動でエンコードしないようにする
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions - [hoForceEncodeParams];

  //名前
  PostStream.Add('name=' + HTTPEncode(LabeledEdit1.Text));

  //趣味
  PostStream.Add('hoby=' + HTTPEncode(LabeledEdit2.Text));

  Screen.Cursor := crHourGlass;
  try
    try
      IdHTTP1.Post(PostURL, PostStream, ResStream);
    except
      //エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    //サーバからのデータを表示
    Memo1.Lines.Add(HTTPDecode(ResStream.DataString));

    Screen.Cursor := crDefault;
    FreeAndNil(PostStream);
    FreeAndNil(ResStream);
  end;
end;

//=============================================================================
//  GetメソッドでPostURLにデータを送る
//  GetメソッドではURL文字列にデータを&で連結して渡す
//  ここのPostURLで指定しているURLではGetだけでデータを受取るようになっている
//
//  HTTPEncodeの使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  PostURL   : String;
  ResStream : TStringStream;
begin
  Memo1.Clear;

  //テスト用のURL
  PostURL := 'http://mrxray.on.coocan.jp/Others/testget.php';
  //値をURLで引渡す意味の?を最初に付加
  PostURL := PostURL+'?';

  //自動でエンコードしないようにする
  IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions - [hoForceEncodeParams];

  //名前
  PostURL := PostURL + '&name=' + HTTPEncode(LabeledEdit1.Text);

  //趣味
  PostURL := PostURL + '&hoby=' + HTTPEncode(LabeledEdit2.Text);

  ResStream := TStringStream.Create('');
  Screen.Cursor := crHourGlass;
  try
    try
      //投稿
      IdHTTP1.Get(PostURL, ResStream);
    except
      //エラー内容はIdHTTP1.ResponseTextで受取る
    end;
  finally
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    //サーバからのデータを表示
    Memo1.Lines.Add(HTTPDecode(ResStream.DataString));

    Screen.Cursor := crDefault;
    FreeAndNil(ResStream);
  end;
end;

end.



03_CGI テスト掲示板に投稿


前の 2 つのテストでは，サーバが受取る変数名は本来不明ですが，掲示板等は入力フォームがあり，掲示板の URL のソースで使用する変数名を確認できる場合があります．これを利用して，当サイトに用意してあるテスト用の掲示板に投稿するテストプログラムです．ただし，同じ名前と同じ内容で連続投稿はできません．続けてテストする場合は，名前または発言内容を変更してください．

この掲示板は GET で変数の値を受取る仕組みになっています．form タグの中の action の値が実行する URL です．掲示板と同じアドレスとなっていますが，URL文字列の後に，'?mode=regist' を加えて呼出すとサーバ内の Perl 言語で書いたプログラムを実行します．変数を設定するには，先頭に '&' を付けて '=' で定義します．
この変数の内容をサーバ上のプログラムが STDIN (標準入力) 経由で受け取り，その変数の値によって処理を実行します．

この掲示板の操作は比較的簡単な方ですが，サーバ上のプログラムにデータを送ったり設定するのは，もっと複雑な場合もあります．例えば，ある URL のリダイレクト先(指定URLに関係する別の URL) からデータを受取り，更にそのデータを別の URL に送るという動作が必要なこともあります．現実的な問題としてはケース・バイ・ケース，試行錯誤が必要なのかも知れません．

テスト用の掲示板には，スパム対策用に「投稿キー」の設定ができますが，この機能を無効にしています．したがって，スパムの書き込みがあると思いますが，気にせずテストしてください．あくまでもテスト用ですので．


リスト7
ブラウザの [表示] [ソース] で表示されるform (入力フォームの意味) タグの部分
Delphi 側では，それぞれの input type の name 属性に値をセットする
method="post" を Delphi で実行するわけではないことに注意 
<form action="./delphitest.cgi" method="post">
<input type="hidden" name="mode" value="regist">
<table cellpadding="1" cellspacing="1">
<tr>
  <td nowrap><b>おなまえ</b></td>
  <td><input type="text" name="name" size="28" value=""></td>
</tr>
<tr>
  <td nowrap><b>Ｅメール</b></td>
  <td><input type="text" name="email" size="28" value=""></td>
</tr>
<tr>
  <td nowrap><b>タイトル</b></td>
  <td>
    <input type="text" name="sub" size="36" value="">
    <input type="submit" value="送信する"><input type="reset" value="リセット">
  </td>
</tr>
<tr>
  <td colspan="2" nowrap>
    <b>メッセージ</b><br>
    <textarea name="comment" cols="56" rows="7"></textarea>
  </td>
</tr>
<tr>
  <td nowrap><b>参照先</b></td>
  <td><input type="text" name="url" size="50" value="http://"></td>
</tr>
<tr>
  <td nowrap><b>削除キー</b></td>
  <td>
   <input type="password" name="pwd" size="8" maxlength="8" value="">
  <small>(英数字で8文字以内)</small>
  </td>
</tr>
<tr>
  <td></td>
  <td><input type="checkbox" name="cook" value="on" checked>
  <small>クッキー情報保存</small>
  </td>
</tr>
</table>
</form>


図11
設計時画面
図12
実行画面
  • [発言編集] でエディタを起動して文章入力後，保存
  • [送信] ボタンクリック
  • 名前が入力されていないので，サーバのプログラムからメッセージが届いた
図13
実行画面
  • 名前を入力して [送信]．発言終了
  • [掲示板] クリックでテスト用掲示板を表示して発言を確認
  • [おなまえ] 等を変更しないと連続投稿は不可

リスト8
当サイトのテスト掲示板に投稿 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    IdHTTP1: TIdHTTP;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    IniFileName : String;
    BBSUrl : String;
    function DeleteTag(Src: String): String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IniFiles, HTTPApp, ShellAPI;

{$R *.dfm}

//=============================================================================
//  Editに関係情報をセット
//  1つ上の階層からPostGet.iniを読み出してセット
//  このIniファイルの読出しと書込みはテストには直接関係ない
//  他のテストプログラムと共通の値を利用するためのもの
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AIni : TInifile;
begin
  IniFileName := '..\PostGet.ini';
  AIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := AIni.ReadString('PostGet', 'Name',      '');
     LabeledEdit2.Text := AIni.ReadString('PostGet', 'Title',     '');
     LabeledEdit3.Text := AIni.ReadString('PostGet', 'DeleteKey', '');
   end;
  finally
    FreeAndNil(AIni);
  end;

  //掲示板のURL文字列
  BBSUrl := 'http://mrxray.on.coocan.jp/Delphi/Others/aska/delphitest.cgi';
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  AIni : TInifile;
begin
  AIni := TIniFile.Create(IniFileName);
  try
    try
      AIni.WriteString('PostGet', 'Name',      LabeledEdit1.Text);
      AIni.WriteString('PostGet', 'Title',     LabeledEdit2.Text);
      AIni.WriteString('PostGet', 'DeleteKey', LabeledEdit3.Text);
    except
    end;
  finally
    FreeAndNil(AIni);
  end;

  if IdHTTP1.Connected then IdHTTP1.Disconnect;
end;

//=============================================================================
//  IdHTTPのGetメソッドでPostURLで指定するアドレスの掲示板に投稿
//  つまり掲示板の外部から投稿
//  掲示板(だけではないが)によっては，ブラウザで表示している入力欄からしか入力
//  できない設定の場合もある
//  GetメソッドではURL文字列にデータを&で連結して渡す
//
//  投稿したら
//  http://mrxray.on.coocan.jp/Delphi/Others/aska/delphitest.cgi
//  を開いて確認．もし既に表示している場合はは[ブラウザ]の[更新]で表示を更新す
//  ると発言内容が表示される
//
//  テスト用の掲示板は，以下の制限がある
//  1. メッセージのサイズは2kBまでだが，エンコードしているので実際には漢字1文字
//     は6バイトを使用することになる
//     (エンコードするとブラウザのアドレスバーで見る%を含んだ文字となる)
//  2. 連続投稿はできない
//  3. 本文にURLリンク文字列を書くとエラーとなる
//
//  HTTPEncode関数の使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL   : String;
  ResStream : TStringStream;
  ResList   : TStringList;
  i         : Integer;
begin
  Memo1.Clear;
  ResStream := TStringStream.Create('');
  ResList   := TStringList.Create;

  //テスト掲示板の投稿用URL
  //このテスト掲示板では掲示板そのものと投稿URLは同じ
  PostURL := BBSUrl;

  //[送信]の設定
  //この掲示板はmodeにregistを送ると[送信]となる
  //URL文字列で値を引渡す意味の?を最初に付加
  PostURL := PostURL + '?mode=regist';

  //おなまえ
  PostURL := PostURL + '&name=' + HTTPEncode(LabeledEdit1.Text);

  //タイトル
  PostURL := PostURL + '&sub=' + HTTPEncode(LabeledEdit2.Text);

  //削除キー
  PostURL := PostURL + '&pwd=' + LabeledEdit3.Text;

  //メッセージ(投稿本文)をファイルから読出す
  ResList.LoadFromFile('Mes.txt');
  //URL決定
  PostURL := PostURL + '&comment=' + HTTPEncode(ResList.Text);

  Screen.Cursor := crHourGlass;
  try
    try
      //投稿
      IdHTTP1.Get(PostURL, ResStream);
    except
    end;
  finally
    //発言に成功すれば[HTTP/1.1 302 Moved Temporarily]
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    //サーバからの取得データのうち，掲示板内部の発言ミスをメモに表示
    Memo1.Lines.Add('');
    ResList.Clear;
    ResList.Text := ResStream.DataString;

    for i := 0 to ResList.Count - 1 do begin
      if Pos('ERROR',ResList[i]) > 0 then begin
        Memo1.Lines.Add(DeleteTag(ResList[i]));
        Memo1.Lines.Add(DeleteTag(ResList[i+1]));
      end;
    end;
    Screen.Cursor := crDefault;
    FreeAndNil(ResStream);
    FreeAndNil(ResList);
  end;
end;

//=============================================================================
//  投稿内容の編集
//  テキストを既存のエディタで開く
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', 'Mes.txt', nil, nil, SW_SHOW);
end;

//=============================================================================
//  掲示板を表示
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  ShellExecute(Handle, 'open', PChar(BBSUrl), nil, nil, SW_SHOW);
  Screen.Cursor := crDefault;
end;

//=============================================================================
//  HTMLからタグ文字を削除
//  テスト掲示板の本サンプルのみの専用
//=============================================================================
function TForm1.DeleteTag(Src: String): String;
begin
  Result := StringReplace(Src,   '<h3>',                   '', [rfReplaceAll]);
  Result := StringReplace(Result,'</h3>',                  '', [rfReplaceAll]);
  Result := StringReplace(Result,'<font color="#dd0000">', '', [rfReplaceAll]);
  Result := StringReplace(Result,'<br>',                   '', [rfReplaceAll]);
  Result := StringReplace(Result,'</font>',                '', [rfReplaceAll]);
end;

end.


Indy のより新しいバージョンでは，上のサンプルを実行して掲示板に投稿すると文字化けすることがあります．その場合は以下のコードで試してみてください．

リスト9
Delphi 10.2(UP3) + Indy 10.6.2.5366 で動作確認したコード
URL のパラメータの文字列のエンコードを TIdURI.ParamsEncode で行う方法		 
//=============================================================================
//  IdHTTPのGetメソッドでPostURLで指定するアドレスの掲示板に投稿
//  つまり掲示板の外部から投稿
//  掲示板(だけではないが)によっては，ブラウザで表示している入力欄からしか入力
//  できない設定の場合もある
//  GetメソッドではURL文字列にデータを&で連結して渡す
//
//  投稿したら
//  http://mrxray.on.coocan.jp/Delphi/Others/aska/delphitest.cgi
//  を開いて確認．もし既に表示している場合はは[ブラウザ]の[更新]で表示を更新す
//  ると発言内容が表示される
//
//  テスト用の掲示板は，以下の制限がある
//  1. メッセージのサイズは2kBまでだが，エンコードしているので実際には漢字1文字
//     は6バイトを使用することになる
//     (エンコードするとブラウザのアドレスバーで見る%を含んだ文字となる)
//  2. 連続投稿はできない
//  3. 本文にURLリンク文字列を書くとエラーとなる
//
//  IndyTextEncoding_OSDefault の使用には uses に IdGlobal が必要　
//  ParamsEncode の使用には uses に IdURI が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  PostURL   : String;
  ResStream : TStringStream;
  ResList   : TStringList;
  i         : Integer;
begin
  Memo1.Clear;

  ResStream := TStringStream.Create('');
  ResList   := TStringList.Create;

  // テスト掲示板の投稿用URL
  // このテスト掲示板では掲示板そのものと投稿URLは同じ
  PostURL := BBSUrl;

  // [送信]の設定
  // この掲示板はmodeにregistを送ると[送信]となる
  // URL文字列で値を引渡す意味の?を最初に付加
  PostURL := PostURL + '?mode=regist';

  // おなまえ
  // 実際の入力値はエンコードする
  PostURL := PostURL + '&name='
           + TIdURI.ParamsEncode(LabeledEdit1.Text, IndyTextEncoding_OSDefault);

  // タイトル
  // 実際の入力値はエンコードする
  PostURL := PostURL + '&sub='
           + TIdURI.ParamsEncode(LabeledEdit2.Text, IndyTextEncoding_OSDefault);

  // 削除キー
  // 実際の入力値はエンコードする
  PostURL := PostURL + '&pwd='
           + TIdURI.ParamsEncode(LabeledEdit3.Text, IndyTextEncoding_OSDefault);

  // メッセージ(投稿本文)をファイルから読出す
  // 実際の入力値はエンコードする
  ResList.LoadFromFile('Mes.txt');
  //URL決定
  PostURL := PostURL + '&comment='
           + TIdURI.ParamsEncode(ResList.Text, IndyTextEncoding_OSDefault);

  Screen.Cursor := crHourGlass;
  try
    try
      //投稿
      IdHTTP1.Get(PostURL, ResStream);
    except
    end;
  finally
    //発言に成功すれば[HTTP/1.1 302 Moved Temporarily]
    Memo1.Lines.Add(IdHTTP1.ResponseText);
    // サーバからの取得データのうち，掲示板内部の発言ミスをメモに表示
    Memo1.Lines.Add('');
    ResList.Clear;
    ResList.Text := ResStream.DataString;

    for i := 0 to ResList.Count - 1 do begin
      if Pos('ERROR',ResList[i]) > 0 then begin
        Memo1.Lines.Add(DeleteTag(ResList[i]));
        Memo1.Lines.Add(DeleteTag(ResList[i+1]));
      end;
    end;
    Screen.Cursor := crDefault;
    FreeAndNil(ResStream);
    FreeAndNil(ResList);
  end;
end;



04_ファイルをアップロード


「データを送る」と言っても，ここまでのサンプルはテキスト，つまり文字列でした．
次は，ファイルを送信，サーバにアップロードしてみます．
しかし，当サイトのサーバにあまりファイルを送られても困るので，このサンプルは，読者が利用可能なサーバでテストしてください．

実際にファイルがアップロードされるかを確認するには，例えば，以下のような PHP のコードを書いたファイルをサーバの任意のディレクトリに置いておきます．このコードは，この記事を書くために実際に筆者が使用したものです．このコードは，

  • 送られてきたファイルを，この PHP ファイルがあるディレクトリ内の [data] といディレクトリ内に保存する (ディレクトリはあらかじめ作成しておく)
  • ファイルサイズの制限を 1 MB 以下とする
  • アップロードされたファイルのパーミッション (アクセス制限) を 644 に変更する
という操作を行います．ファイル名は upload_http.php としました．
実際のアプリでは，ユーザ認証やアクセスログ等の処理も必要となるでしょう．本ページは PHP のサンプルの記事ではありません．必要であれば各自で調べてください．


[備考]
サーバーの，アップロードしたファイルを保存するディレクトリの属性 (パーミッション) は，対象のユーザが書き込み可能にしておく必要があります．本サンプルでは [data] です．


図14
upload_http.php をサーバの任意の場所に置く
  • 保存用のディレクトリを作成しておく
  • 今回は data という名前にした

リスト10
送られてきたファイルを処理する PHP のコード		 
  <?php
  $upload_dir  = './data';
  $upload_name =  $_FILES["upfile"]["name"];
  $maxfilesize =  1024000;

  if (is_uploaded_file($_FILES["upfile"]["tmp_name"])) {
    if($_FILES["upfile"]['size'] <= $maxfilesize) { 
      if (move_uploaded_file($_FILES["upfile"]["tmp_name"], 
                             $upload_dir.'/'.$upload_name)) {
          chmod("$upload_dir/$upload_name", 0644);
          echo $upload_name. " をアップロードしました";
      } else {
        echo "ファイルのアップロードに失敗しました";
      }      
    } else {
      echo "ファイルのサイズが制限を超えています"; 
    }  
  } else {
    echo "ファイルが選択されていません";        
  }
?>


TIdHTTP の Post メソッドで，サーバに置いた PHP ファイルの URL へファイルを送ります．
送るファイルは，TIdMultiPartFormDataStream の AddFile でセットします．

第 1 引数はデータの識別子です．PHP の $_FILES["upfile"] の 引数と同じ値である upfile とします．第 2 引数にアップロードするファイル名を指定します．第 3 引数は MIME タイプですが，空白文字にすると，AddFile メソッドのソースコードを見る限りでは，拡張子から自動で判定するようになっているようです．

添付の PHP のコードは，EUC-JP で書いて保存しています．そこで，以下のコードでは TEncoding で文字コードの変換を行っています．


図15
設計時画面
図16
実行画面
  • [Button1] でファイルを選択
  • TEST.jpg というファイルをアップロード

リスト11
ファイルのアップロードテスト用サンプル		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IdMultipartFormData, IdGlobal;

{$R *.dfm}

//=============================================================================
//  ファイルのアップロード
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AUrl       : String;
  DataPath   : String;
  DataStream : TIdMultiPartFormDataStream;
  ResStream  : TMemoryStream;
  ENC        : TEncoding;
begin
  if not OpenDialog1.Execute then exit;

  Memo1.Clear;
  //アップロードするファイル
  DataPath   := OpenDialog1.FileName;
  //アップロードしたファイルを処理するPHPの絶対パス
  AUrl       := 'http://mrxray.on.coocan.jp/Others/UploadDir/upload_http.php';
  DataStream := TIdMultiPartFormDataStream.Create;
  ResStream  := TMemoryStream.Create;

  try
    //アップロードするファイルとMIMEタイプの指定
    DataStream.AddFile('upfile', DataPath, '');
    //アップロード
    IdHTTP1.Post(AUrl, DataStream, ResStream);

    ResStream.Position := 0;
    //文字のエンコード
    ENC := TEncoding.GetEncoding(20932);
    //サーバから受け取った文字列を表示
    Memo1.Lines.Add('');
    Memo1.Lines.Add(IdGlobal.ReadStringFromStream(ResStream, -1, ENC));
  finally
    FreeAndNil(DataStream);
    FreeAndNil(ResStream);
  end;
end;

//=============================================================================
//  IdHTTP1のOnStatusイベント
//  接続状態等の文字列をMemo1に表示
//=============================================================================
procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  Memo1.Lines.Append(AStatusText);
end;

end.