Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2015年02月24日] [更新 2015年02月24日]　Delphi サンプルプログラム集
756_URL からディレクトリ名を取得
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Indy 10 (Ver 10.5.7)
756_URL_Directory.zip　[2,773 KB]　2015年02月24日版 (EXE 同梱)






URL からディレクトリ名を取得


ウェブページのファイル名を示す URL から，ディレクトリ名を取得するサンプルです．

ローカルディスクのパス名であれば，ExtractFileDir 関数，あるいは ExtractFilePath 関数でディレクトリ名を取得することができます．URL のファイル名からは，それらの関数を使用してもディレクトリ名は正しく取得できません．

ローカルディスクのパス名では，パスの区切り文字として，バックスラッシュ (\) を使用します．バックスラッシュは，日本語フォント環境では円記号 (¥) となります．一方，URL のパス区切り文字はスラッシュ (/) です．ExtractFileDir あるいは ExtractFilePath 関数は，スラッシュをパスの区切り文字として認識してくれないようです．

実際に，下に示すコードでそのことを確認してみました．取得できたのはプロトコルに相当する文字列だけとなっています．



[備考]
本ページのサンプルでは，結果の表示に Courier New フォントを使用しています．そのため，ローカルなディスクのパス名の区切り文字がバックスラッシュで表示されています．



図1
ExtractFileDir 関数を使用して，URL のディレクトリ名を取得

リスト1
ExtractFileDir 関数では URL のディレクトリ名は取得できない		 
procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlPath : String;
begin
  LUrlPath := 'http://mrxray.on.coocan.jp/Delphi/plSamples/949_ParseHTML.htm';
  LUrlPath := ExtractFileDir(LUrlPath);
  MessageBox(Handle, PChar(LUrlPath), '結果', MB_OK);
end;



01_TPath の GetDirectoryName 関数を使用


Delphi 2010 ではディレクトリとファイル関係の便利な関数が追加されています．
これらは主に IOUtils ユニットにあります．その中の TPath の GetDirectoryName 関数を使用したサンプルです．GetDirectoryName 関数を使用すると URL のディレクトリだけでなく，ローカルのディクスのパス名からもディレクトリ名を取得することができます．

サンプルでは，指定した URL のディレクトリを順番に上の階層まで取得して表示します．取得したディレクトリ名が空文字になったら終了としています．



図2
実行結果
  • 順番に，上の階層のディレクトリを取得していった結果
図3
ローカルなディスクのパス名の場合
  • 英文フォントなので，パスの区切り文字がバックスラッシュになっている

リスト2
TPath の GetDirectoryName 関数を使用して，URL のディレクトリ名を取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IOUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/plSamples/949_ParseHTML.htm';
end;

//=============================================================================
//  URLの文字列から1つ上のディレクトリを順番に取得して表示
//  ローカルなファイルシステムのディレクトリでも使用可能
//
//  GetDirectoryName等の使用にはusesにIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlPath : String;
  i        : Integer;
begin
  LUrlPath := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  for i := 0 to 6 do begin
    LUrlPath := TPath.GetDirectoryName(LUrlPath);

    if LUrlPath = '' then begin
      Memo1.Lines.Add('Empty');
      Break;
    end else begin
      Memo1.Lines.Add(LUrlPath);
    end;
  end;
end;

end.



02_TPath の関数類で，ファイル名の名前部分や拡張子だけを取得


TPath には，GetDirectoryName 関数以外にも，ディレクトリを除いたファイルのみ，拡張子だけを取得する等の関数が用意されています．
本サンプルのコードでは，ディレクトリ名を除いたファイル名の名前部分，拡張子，ディレクトリと拡張子を除いたファイル名の名前部分，そして，ディレクトリ名を取得します．


TPath を使用しないで，拡張子だけや，拡張子を除いたファイル名等を取得する関数類については以下のオンラインヘルプの記事を参考にしてください．


図4
実行結果

リスト3
TPath の関数類を使用して，ファイル名の名前部分や拡張子だけを取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IOUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/plSamples/949_ParseHTML.htm';
end;

//=============================================================================
//  TPathの関数類のテスト
//  URLの文字列からパス名やファイル名等を取得して表示
//  ローカルなファイルシステムのディレクトリでも使用可能
//
//  GetDirectoryName等の使用にはusesにIOUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlPath : String;
begin
  LUrlPath := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  Memo1.Lines.Add(TPath.GetFileName(LUrlPath));
  Memo1.Lines.Add(TPath.GetExtension(LUrlPath));
  Memo1.Lines.Add(TPath.GetFileNameWithoutExtension(LUrlPath));
  Memo1.Lines.Add(TPath.GetDirectoryName(LUrlPath));
end;

end.



03_HTTPApp の関数類を使用


ExtractFileDir 関数では URL のディレクトリが正しく取得できないと述べましたが，パスの区切り文字を円記号，あるいはバックスラッシュに変換すれば可能です．変換して，ディレクトリ名を取得したら，パスの区切り文字を元に戻します．
この方法を使用したのが本サンプルです．HTTPApp ユニットにある関数類を使用しています．

本サンプルは，指定した URL のディレクトリを順番に上の階層まで取得して表示します．プロトコルの文字列までが取得できています．



図5
実行結果

リスト4
HTTPApp ユニットにある関数類を使用してディレクトリ名を取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses HTTPApp;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/plSamples/949_ParseHTML.htm';
end;

//=============================================================================
//  HTTPAppユニットの関数類を使用したテスト
//  URLの文字列からパス名やファイル名等を取得して表示
//  ローカルなファイルシステムのディレクトリでも使用可能
//
//  UnixPathToDosPath等の使用にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlPath : String;
  LUrlDir  : String;
  i        : Integer;
begin
  LUrlPath := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  for i := 0 to 5 do begin
    LUrlDir  := HTTPApp.UnixPathToDosPath(LUrlPath);
    LUrlPath := HTTPApp.DosPathToUnixPath(ExtractFileDir(LUrlDir));
    Memo1.Lines.Add(LUrlPath);
  end;
end;

end.



04_TIdURI を使用したホスト名等の取得


上のサンプルでは，URL のホスト名の上の階層まで取得してしまっています．そこで，本サンプルではホスト名までの階層を取得したら，それ以上のディレクトリ取得をしないようにしてみました．ホスト名の取得に，Indy の TIdURI クラスを使用しています．

上のサンプルのコードを使用してもいいのですが，ここでは，パスの区切り文字を自前で処理することにしました．文字列の最後にあるパス区切り文字であるデリミタまでの文字列を取得します．もし，文字列の最後がデリミタであった場合は，そのデリミタを削除してから取得します．
このサンプルコードは，ローカルなファイル名には使用できません．



図6
実行結果

リスト5
TIdURI を使用して，ディレクトリの取得をホスト名までとする例 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses IdURI, StrUtils;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  URLパス名から1つ上のディレクトリ名を取得する関数
//  ホスト名より上は取得しないで空文字を返す
//
//  usesにIdURIとStrUtilsが必要
//-----------------------------------------------------------------------------
function ExtractURLPathDir(AUrl: String; AddDelimter: Boolean=True): String;
const
  LDelimt = '/';
var
  LIdURL    : TIdURI;
  LProtHost : String;
  LUrlPath  : String;
  LPos      : Integer;
begin
  Result := '';

  LIdURL := TIdURI.Create(AUrl);
  try
    LProtHost := LIdURL.Protocol + '://' + LIdURL.Host;
    LUrlPath  := LIdURL.Path + LIdURL.Document;

    if (Length(LProtHost) + 1) < Length(AUrl) then begin
      if StrUtils.RightStr(LUrlPath, 1) = LDelimt then begin
        LUrlPath := Copy(LUrlPath, 1, Length(LUrlPath) - 1);
      end;
      LPos := LastDelimiter(LDelimt, LUrlPath);

      if AddDelimter then begin
        Result := LProtHost + Copy(LUrlPath, 1, LPos);
      end else begin
        Result := LProtHost + Copy(LUrlPath, 1, LPos - 1);
      end;
    end;
  finally
    FreeAndNil(LIdURL);
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/plSamples/949_ParseHTML.htm';
end;

//=============================================================================
//  URLから1つ上のディレクトリを順番に取得して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlPath : String;
begin
  LUrlPath := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  while True do begin
    LUrlPath := ExtractURLPathDir(LUrlPath);
    if LUrlPath = '' then break;
    Memo1.Lines.Add(LUrlPath);
  end;
end;

end.