InternetOpen('XRAY_Test', INTERNET_OPEN_TYPE_PROXY, 'proxy:8080', nil, 0);
InternetOpen('XRAY_Test', INTERNET_OPEN_TYPE_PROXY, '123.45.6.7:8080', nil, 0);

InternetOpen('XRAY_Test', INTERNET_OPEN_TYPE_PROXY, 'proxy:8080', '<local>', 0);

var
  LhSession : HINTERNET;
  LTimeOut  : integer;
begin
  LhSession := InternetOpen( nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );

  if Assigned(LhSession) then begin
    //60秒をmsに変換
    LTimeOut := 60 * 1000;
    InternetSetOption(LhSession,
                      INTERNET_OPTION_RECEIVE_TIMEOUT,
                      @LTimeOut,
                      SizeOf(LTimeOut));

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    function  GMTToDateTime(ASysTime: TSystemTime): TDateTime;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  テスト用のURLをセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/index.htm';
end;

//=============================================================================
//  指定URLのヘッダ情報を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LURL         : String;
  LhSession    : HINTERNET;
  LhService    : HINTERNET;
  LlpvBuffer   : array[0..MAX_PATH-1] of Char;
  LdwSize      : DWORD;
  LReserved    : DWORD;
  LBufferValue : Integer;
begin
  LURL := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  LhSession := InternetOpen( nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );

  if Assigned(LhSession) then begin
    LhService := InternetOpenUrl(LhSession,
                                PChar(LURL),
                                nil,
                                0,
                                0,
                                0);
    if Assigned(LhService) then begin
      FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
      LdwSize    := SizeOf(LlpvBuffer);
      LReserved  := 0;
      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE,
                    @LlpvBuffer,
                    LdwSize,
                    LReserved);
      LBufferValue := StrToIntDef(LlpvBuffer, 0);

      if (LBufferValue < 200) or (LBufferValue >= 300) then begin
        Memo1.Lines.Add('StatusCode : ' + LlpvBuffer);
        Memo1.Lines.Add('該当するファイルがサーバにありません');
      end else begin
        FillChar(LlpvBuffer, MAX_PATH, #0);
        LdwSize   := SizeOf(LlpvBuffer);
        LReserved := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_RAW_HEADERS_CRLF,
                      @LlpvBuffer,
                      LdwSize,
                      LReserved);
        Memo1.Lines.Add(LlpvBuffer);
      end;
    end;
    InternetCloseHandle(LhService);
  end;
  InternetCloseHandle(LhSession);
end;

//=============================================================================
//  指定URLの更新日時とファイルサイズを取得
//  存在しないURLの場合を考えてHttpQueryInfoの結果(BOOL)で分岐が良
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LURL            : String;
  LhSession       : HINTERNET;
  LhService       : HINTERNET;
  LLastSystemDate : SYSTEMTIME;
  LLastDate       : TDateTime;
  LDateStr        : String;
  LFileSize       : Longint;
  LdwSize         : DWORD;
  LReserved       : DWORD;
  LlpvBuffer      : array[0..MAX_PATH-1] of Char;
  LBufferValue    : Integer;
  LContentType    : String;
begin
  LURL := Trim(Edit1.Text);

  Memo1.Lines.Clear;
  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );
  if Assigned( LhSession ) then begin
    LhService := InternetOpenUrl(LhSession,
                                 PChar(LURL),
                                 nil,
                                 0,
                                 INTERNET_FLAG_RELOAD or INTERNET_FLAG_RAW_DATA,
                                 0);

    if LhService <> nil then begin
      FillChar(LlpvBuffer, MAX_PATH, #0);
      LdwSize   := SizeOf(LlpvBuffer);
      LReserved := 0;
      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE,
                    @LlpvBuffer,
                    LdwSize,
                    LReserved);
      LBufferValue := StrToIntDef(LlpvBuffer, 0);

      if (LBufferValue < 200) or (LBufferValue >= 300) then begin
        Memo1.Lines.Add('StatusCode : ' + LlpvBuffer);
        Memo1.Lines.Add('該当するファイルがサーバにありません');
      end else begin
        FillChar(LlpvBuffer, MAX_PATH, #0);
        LdwSize   := SizeOf(LlpvBuffer);
        LReserved := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_CONTENT_TYPE,
                      @LlpvBuffer,
                      LdwSize,
                      LReserved);
        LContentType := LlpvBuffer;

        LdwSize   := SizeOf(LLastSystemDate);
        LReserved := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_LAST_MODIFIED or HTTP_QUERY_FLAG_SYSTEMTIME,
                      @LLastSystemDate,
                      LdwSize,
                      LReserved);
        LLastDate :=  GMTToDateTime(LLastSystemDate);

        LdwSize   := SizeOf(LFileSize);
        LReserved := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
                      @LFileSize,
                      LdwSize,
                      LReserved);

        LDateStr := FormatDateTime('最終更新日時 : yyyy年mm月dd日 hh時nn分', LLastDate);
        Memo1.Lines.Add('CONTENT TYPE : ' + LContentType);
        Memo1.Lines.Add(LDateStr);
        Memo1.Lines.Add('ファイルサイズ : '+ IntToStr(LFileSize) + ' バイト' );
      end;
    end;
    InternetCloseHandle(LhService);
  end;
  InternetCloseHandle(LhSession);
end;

//-----------------------------------------------------------------------------
//  GMT(グリニッジ標準時)をローカルの時刻にしてDelphiのTDateTimeに変換
//-----------------------------------------------------------------------------
function TForm1. GMTToDateTime(ASysTime: TSystemTime): TDateTime;
var
  TempTime  : TFileTime;
  LocalTime : TFileTime;
begin
  try
    //システム形式をFileTime形式に変換
    SystemTimeToFileTime(ASysTime, TempTime);
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(TempTime, LocalTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(LocalTime, ASysTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(ASysTime);
  except
    Result := 0;
  end;
end;

end.

      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
                    @LStatus,  //LStatusはInteger型
                    LdwSize,
                    LReserved);

      if (LStatus < 200) or (LStatus >= 300) then begin

  //Delphi XE7 のオンラインヘルプのウェブページ
  Edit1.Text := 'http://docwiki.embarcadero.com/RADStudio/XE7/ja/Main_Page';

        LStream := TStringStream.Create;
        try
          LStream.Encoding.UTF8;

          FillChar(LlpvBuffer, MAX_PATH, #0);
          LdwSize   := SizeOf(LlpvBuffer);
          LReserved := 0;
          HttpQueryInfo(LhService,
                        HTTP_QUERY_RAW_HEADERS_CRLF,
                        @LlpvBuffer,
                        LdwSize,
                        LReserved);
          LStream.Write(LlpvBuffer[0], LdwSize);
          LStream.Position := 0;
          Memo1.Lines.LoadFromStream(LStream);
        finally
          FreeAndNil(LStream);
        end;

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses WinInet, StrUtils, IOUtils;

{$R *.dfm}

//=============================================================================
//  ダウンロードの対象ファイルのURLをEdit1に設定
//  アドレスがhtml,aspx等を指定した場合は，テキストファイルとなる
//  この場合，画像などは保存されない
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/zip/003_StopWatch.zip';
end;

//=============================================================================
//  IntenetReadFileでファイルストリームにダウンロードする
//  リダイレクト機能の制御付き
//
//  LSourceURL : ダウンロードするファイルのURLアドレス
//  LSaveFile  : ダウンロード後のファイル名
//
//  UnixPathToDosPath関数にはusesにHTTPAppが必要
//  MatchTextの使用にはusesにStrUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream      : TFileStream;
  LSourceURL   : String;
  LSaveFile    : String;
  LResultFlag  : Boolean;
  hSession     : HINTERNET;
  LhService    : HINTERNET;
  LFileSize    : Longint;
  LdwBytesRead : DWORD;
  LReserved    : DWORD;
  LlpvBuffer   : array[0..1023] of Char;
  LDownloadURL : String;
  LIsNoFile    : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LSourceURL := Edit1.Text;

  LResultFlag  := False;
  LIsNoFile    := False;
  LDownloadURL := '';

  hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then begin
    //INTERNET_FLAG_NO_AUTO_REDIRECTはリダイレクト回避
    //WinInetはリダイレクトを自動でやってくれる
    //勝手にリダイレクトされてしまうと保存先のファイル名の設定ができない
    //そこで，リダイレクトを回避してステータスコードで判定して処理
    LhService := InternetOpenUrl(hSession,
                                 PChar(LSourceURL),
                                 nil,
                                 0,
                                 INTERNET_FLAG_NO_AUTO_REDIRECT or INTERNET_FLAG_RELOAD,
                                 0);
    if Assigned(LhService) then begin
      //HTTP_QUERY_STATUS_CODEでステータスコードを取得
      FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
      LdwBytesRead := SizeOf(LlpvBuffer);
      LReserved    := 0;
      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE,
                    @LlpvBuffer[0],
                    LdwBytesRead,
                    LReserved);

      if MatchText(LlpvBuffer, ['404', '407']) then begin
        LIsNoFile := True;
      end else
      if not MatchText(LlpvBuffer, ['200','203','301','302','303','307']) then begin
        LIsNoFile := True;
      end;

      //サーバにファイルが存在するなら処理続行
      if not LIsNoFile then begin
        //HTTP_QUERY_LOCATIONを指定してリダイレクト先を取得
        //ステータスコードが301等がリダイレクト
        FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
        LdwBytesRead := SizeOf(LlpvBuffer);
        LReserved    := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_LOCATION,
                      @LlpvBuffer[0],
                      LdwBytesRead,
                      LReserved);
        //リダイレクトではない場合              
        if String(LlpvBuffer) = '' then begin
          //リダイレクトではない場合(あるいはリダイレクトに失敗)
          LDownloadURL := LSourceURL;
        end else begin
          //リダイレクトされている場合              
          LDownloadURL := LlpvBuffer;
        end;

        //保存ファイル名はこのプロジェクトのフォルダでサーバ上と同名
        //ファイル名部分が取得できない場合は最後のディレクトリ名とする
        if TPath.GetFileName(LDownloadURL) = '' then begin
          LSaveFile := ExtractFilePath(ParamStr(0)) +
            TPath.GetFileName(TPath.GetDirectoryName(LDownloadURL)) + '.html';
        end else begin
          LSaveFile := ExtractFilePath(ParamStr(0)) +
            TPath.GetFileName(LDownloadURL);
        end;

        //対象のファイルがサーバに存在することが分かったので
        //今度はリダイレクトを有効にしてInternetOpenUrlを実行
        InternetCloseHandle(LhService);
        LhService := InternetOpenUrl(hSession,
                                    PChar(LSourceURL),
                                    nil,
                                    0,
                                    INTERNET_FLAG_RELOAD,
                                    0);

        //ファイルサイズを取得
        LFileSize    := 0;
        LdwBytesRead := SizeOf(LdwBytesRead);
        LReserved    := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
                      @LFileSize,
                      LdwBytesRead,
                      LReserved);

        try
          //保存するファイルを作成
          //TMemoryStreamに保存，ダウンロード終にディスクに保存する方法も考えられる
          LStream := TFileStream.Create(LSaveFile, fmCreate);
          //Loopにrepeatを用いた例
          try
            LdwBytesRead := SizeOf(LlpvBuffer);
            repeat
              LlpvBuffer := #0;
              if InternetReadFile(LhService,
                                  @LlpvBuffer,
                                  SizeOf(LlpvBuffer),
                                  LdwBytesRead) then begin
                LStream.WriteBuffer(LlpvBuffer, LdwBytesRead);
                LResultFlag := True;
              end else begin
                LResultFlag := False;
                break;
              end;
              Application.ProcessMessages;
              Sleep(1);
            until LdwBytesRead = 0;
          finally
            FreeAndNil(LStream);
          end;
        except
          //保存ファイルが作成できなかった場合
          //リダイレクト先が取得できなかった場合等
          LResultFlag := False;
        end;
      end;
    end;
    InternetCloseHandle(LhService);
  end;
  InternetCloseHandle(hSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ダウンロードが終了しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoFile then begin
      MessageDlg('該当するファイルがサーバにありません', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ダウンロードに失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TFileStreamEx = class(TFileStream)
  protected
    FOnRead: TNotifyEvent;
    FOnWrite: TNotifyEvent;
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    property OnRead: TNotifyEvent read FOnRead write FOnRead;
    property OnWrite: TNotifyEvent read FOnWrite write FOnWrite;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Panel1: TPanel;
    ProgressBar1 : TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    FileSize : Longint;
    procedure OnFileStreamWrite(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  WinInet, IOUtils;

{$R *.dfm}

{ TFileStreamEx }

//-----------------------------------------------------------------------------
//  拡張TFileStream
//  イベント処理機能を加えたReadメソッド
//-----------------------------------------------------------------------------
function TFileStreamEx.Read(var Buffer; Count: Integer): Longint;
begin
  Result := inherited Read(Buffer, Count);
  if Assigned(FOnRead) then FOnRead(Self);
end;

//-----------------------------------------------------------------------------
//  拡張TFileStream
//  イベント処理機能を加えたWriteメソッド
//-----------------------------------------------------------------------------
function TFileStreamEx.Write(const Buffer; Count: Integer): Longint;
begin
  Result := inherited Write( Buffer, Count);
  if Assigned(FOnWrite) then FOnWrite(Self);
end;

//=============================================================================
//  ダウンロードの対象ファイルのURLをEdit1に設定
//  アドレスがhtml,aspx等を指定した場合は，テキストファイルとなる
//  この場合には画像などは保存されない
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/ZipExe/plSetPrinter.zip';
end;

//=============================================================================
//  IntenetReadFileでファイルストリームにダウンロードする
//  TStreamの派生クラスを使用して進行状況をプログレスバーに表示
//
//  本サンプルはリダイレクトされているファイルは取得または保存できない
//  保存ファイル名を指定すれば，リダイレクトしたファイルも保存可能な場合がある
//
//  UnixPathToDosPath関数にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream      : TFileStreamEx;
  LSourceFile  : String;
  LSaveFile    : String;
  LResultFlag  : Boolean;
  LhSession    : HINTERNET;
  LhService    : HINTERNET;
  LdwBytesRead : DWORD;
  LlpvBuffer   : array[0..1023] of Char;
  LReserved    : DWORD;
  LBufferValue : Integer;
  LIsNoFile    : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LSourceFile := Edit1.Text;
  LResultFlag := False;
  LIsNoFile   := False;

  //保存ファイル名はこのプロジェクトのフォルダでサーバ上と同名
  //ファイル名部分が取得できない場合は最後のディレクトリ名とする
  if TPath.GetFileName(LSourceFile) = '' then begin
    LSaveFile := ExtractFilePath(ParamStr(0)) +
      TPath.GetFileName(TPath.GetDirectoryName(LSourceFile)) + '.html';
  end else begin
    LSaveFile := ExtractFilePath(ParamStr(0)) +
      TPath.GetFileName(LSourceFile);
  end;
  LSaveFile := 'AAAA.txt';

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(LhSession) then begin
    LhService := InternetOpenUrl(LhSession,
                                 PChar(LSourceFile),
                                 nil,
                                 0,
                                 INTERNET_FLAG_RELOAD,
                                 0);
    if Assigned(LhService) then begin
      FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
      LdwBytesRead := SizeOf(LlpvBuffer);
      LReserved    := 0;
      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE,
                    @LlpvBuffer,
                    LdwBytesRead,
                    LReserved);
      LBufferValue := StrToIntDef(LlpvBuffer, 0);

      if (LBufferValue < 200) or (LBufferValue >= 300) then begin
        LIsNoFile := True;
      end else begin
        LdwBytesRead := SizeOf(FileSize);
        LReserved    := 0;
        if HttpQueryInfo(LhService,
                         HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
                         @FileSize,
                         LdwBytesRead,
                         LReserved) then begin

          //Loopにrepeatを用いた例
          LStream := TFileStreamEx.Create(LSaveFile, fmCreate);
          //イベントハンドラをセット
          LStream.OnWrite := OnFileStreamWrite;
          try
            LdwBytesRead := SizeOf(LlpvBuffer);
            repeat
              LlpvBuffer := #0;
              if InternetReadFile(LhService,
                                  @LlpvBuffer,
                                  SizeOf(LlpvBuffer),
                                  LdwBytesRead) then begin
                LStream.WriteBuffer(LlpvBuffer, LdwBytesRead);
                LResultFlag := True;
              end else begin
                LResultFlag := False;
                break;
              end;
              Application.ProcessMessages;
              Sleep(1);
            until LdwBytesRead = 0;
          finally
            FreeAndNil(LStream);
          end;
        end;
      end;
      InternetCloseHandle(LhService);
    end;
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ダウンロードが終了しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoFile then begin
      MessageDlg('該当するファイルがサーバにありません', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ダウンロードに失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  拡張したTFileStreamのOnWriteイベント処理
//  プログレスバーの位置を更新
//  ファイルのサイズFileSizeはHttpQueryInfo関数で取得している
//-----------------------------------------------------------------------------
procedure TForm1.OnFileStreamWrite(Sender: TObject);
var
  LStream: TStream;
begin
  LStream := Sender as TStream;
  ProgressBar1.Position := Trunc(LStream.Position / FileSize * 100);
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1 : TLabeledEdit;
    LabeledEdit2 : TLabeledEdit;
    LabeledEdit3 : TLabeledEdit;
    LabeledEdit4 : TLabeledEdit;
    procedure Button1Click(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 WinInet, HTTPApp, IniFiles;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//
//  LabelEdit4.textはダウンロードするファイル
//  ex. mrxray.on.coocan.jp/homepage/Delphi/zip/003_StopWatch.zip
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'GetFileName', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName',  LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',      LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',    LabeledEdit3.Text);
      LIni.WriteString('Others',  'GetFileName', LabeledEdit4.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  FTPでファイルをダウンロードする(バイナリデータ)
//
//  LSourceFile : ダウンロードするサーバ上のファイル名
//                ホスト名+サーバ上のバス等で指定
//  LSaveFile   : ダウンロード後のファイル名(フルパス)
//
//  UnixPathToDosPath関数にはusesにHTTPAppが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LServerName : String;
  LUserID     : String;
  LPassWord   : String;
  LSourceFile : String;
  LSaveFile   : String;
  LResultFlag : Boolean;
  LhSession   : HINTERNET;
  LhConnect   : HINTERNET;
  LhFile      : HINTERNET;
  LFileData   : TWin32FindData;
  LIsNoFile   : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LServerName := LabeledEdit1.Text;
  LUserID     := LabeledEdit2.Text;
  LPassWord   := LabeledEdit3.Text;

  LSourceFile := LabeledEdit4.Text;

  //保存ファイル名はこのプロジェクトのフォルダでサーバ上と同名
  LSaveFile := ExtractFilePath(ParamStr(0))+
               ExtractFileName(UnixPathToDosPath(LSourceFile));

  LResultFlag := False;
  LIsNoFile   := False;

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect := InternetConnect(LhSession,
                                PChar(LServerName),
                                INTERNET_DEFAULT_FTP_PORT,
                                PChar(LUserID),
                                PChar(LPassWord),
                                INTERNET_SERVICE_FTP,
                                0,
                                0);
    //サーバ上のファイルの存在を確認                            
    if Assigned(LhConnect) then begin
      LhFile := FtpFindFirstFile(LhConnect,
                                 PChar(LSourceFile),
                                 LFileData,
                                 INTERNET_FLAG_RELOAD,
                                 0);
      if LhFile = nil then begin
        LIsNoFile := True;
      end else begin
        LResultFlag := FtpGetFile(LhConnect,
                                  PChar(LSourceFile),
                                  PChar(LSaveFile),
                                  False,
                                  FILE_ATTRIBUTE_NORMAL,
                                  FTP_TRANSFER_TYPE_BINARY,
                                  0);
        InternetCloseHandle(LhFile);
      end;
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ダウンロードが終了しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoFile then begin
      MessageDlg('該当ファイルが見つかりませんでした', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ダウンロードに失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    IniFileName  : String;
    function IsBinaryFile(AFilename: string): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  WinInet,
  IniFiles,
  UrlMon,
  StrUtils;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//
//  LabelEdit5.textはPUT(アップロード)先のサーバ上のディレクトリ名
//  ex. LabeledEdit5.Text := 'mrxray.on.coocan.jp/homepage/Delphi/';
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'SourceFile', '');
     LabeledEdit5.Text := LIni.ReadString('Others',  'PutDir', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',     LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',   LabeledEdit3.Text);
      LIni.WriteString('Others',  'SourceFile', LabeledEdit4.Text);
      LIni.WriteString('Others',  'PutDir',     LabeledEdit5.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  PUT(転送)するファイルを選択
//  テストなので1つだけとする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Options    := OpenDialog1.Options - [ofAllowMultiSelect];
  OpenDialog1.OptionsEx  := [ofExNoPlacesBar];
  OpenDialog1.InitialDir := ExtractFileDir(ParamStr(0));
  if OpenDialog1.Execute then begin
    LabeledEdit4.Text := OpenDialog1.FileName;
  end;
end;

//=============================================================================
//  FTPでファイルをアップロードする(ファイルの種別は自動判定)
//
//  LSourceFile  : アップロードするローカル上のファイル名(フルパス)
//  LUpLoadFile  : アップロード後のサーバ上のファイル名(フルパス)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LServerName    : String;
  LUserID        : String;
  LPassWord      : String;
  LSourceFile    : String;
  LUpLoadFile    : String;
  LResultFlag    : Boolean;
  LhSession      : HINTERNET;
  LhConnect      : HINTERNET;
  LdwFlag        : DWORD;
  LhFile         : HINTERNET;
  LFileData      : TWin32FindData;
  LIsNoDir       : Boolean;
  LPutDir        : String;
begin
  Screen.Cursor := crHourGlass;

  //デリミタがなければ追加
  //最後にデリミタがないと[LPutDir + PUT元ファイル]のファイルになってしまう1
  if LastDelimiter('/', LPutDir) < Length(LabeledEdit5.Text) then begin
    LabeledEdit5.Text := LabeledEdit5.Text + '/';
  end;
  LPutDir := LabeledEdit5.Text;

  LServerName := LabeledEdit1.Text;
  LUserID     := LabeledEdit2.Text;
  LPassWord   := LabeledEdit3.Text;
  LSourceFile := LabeledEdit4.Text;
  LUpLoadFile := LPutDir + ExtractFileName(LSourceFile);

  LResultFlag := False;
  LIsNoDir    := False;


  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect := InternetConnect(LhSession,
                                 PChar(LServerName),
                                 INTERNET_DEFAULT_FTP_PORT,
                                 PChar(LUserID),
                                 PChar(LPassWord),
                                 INTERNET_SERVICE_FTP,
                                 0,
                                 0);

    if Assigned(LhConnect) then begin
      //サーバ上のディレクトリの存在を確認
      LhFile := FtpFindFirstFile(LhConnect,
                                 PChar(LPutDir),
                                 LFileData,
                                 INTERNET_FLAG_RELOAD,
                                 0);
      if LhFile = nil then begin
        LIsNoDir := True;
      end else begin
        if IsBinaryFile(LSourceFile) then begin
          LdwFlag := FTP_TRANSFER_TYPE_BINARY;
        end else begin
          LdwFlag := FTP_TRANSFER_TYPE_ASCII;
        end;
          LResultFlag := FtpPutFile(LhConnect,
                                    PChar(LSourceFile),
                                    PChar(LUpLoadFile),
                                    LdwFlag,
                                    0);
        InternetCloseHandle(LhFile);
      end;
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('アップロードが終了しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoDir then begin
      MessageDlg('ディレクトリが存在しません', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('アップロードに失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  バイナリかテキストファイルかを自動判定(自動判別)する関数
//  ファイルのMIMEタイプで調べる
//  プレインテキストファイル以外は全てバイナリファイルとする
//
//  usesにUrlMon,が必要
//-----------------------------------------------------------------------------
function TForm1.IsBinaryFile(AFilename: string): Boolean;
const
  MAX_COUNT = 256;
var
  LStream    : TFileStream;
  LMimeType  : PWideChar;
  LBinReader : TBinaryReader;
  LBinArray  : TArray<Byte>;
  LReadSize  : Cardinal;
  LRet       : HRESULT;
begin
  Result := False;

  //ファイルストリームを生成
  LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  if LStream.Size > MAX_COUNT then begin
    LReadSize := MAX_COUNT;
  end else begin
    LReadSize := LStream.Size;
  end;

  //TBinaryReaderのインスタンス生成
  LBinReader := TBinaryReader.Create(LStream, TEncoding.Default, False);
  try
    //バイト型配列に格納
    LBinArray := LBinReader.ReadBytes(LReadSize);

    LMimeType := nil;
    LRet := FindMimeFromData(nil, nil, LBinArray, LReadSize, nil, 0, LMimeType, 0);
    if LRet = S_OK then begin
      if not StrUtils.ContainsText(LMimeType, 'text/') then begin
        Result := True;
      end;
    end;
  finally
    FreeAndNil(LBinReader);
    FreeAndNil(LStream);
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    procedure Button1Click(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 WinInet, IniFiles;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//
//  LabeledEdit4.TextはDELETE(削除)するサーバ上のファイル名
//  ex. 'mrxray.on.coocan.jp/homepage/Delphi/WinInetTest.txt';
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID',' ');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'DeleteFile', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',     LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',   LabeledEdit3.Text);
      LIni.WriteString('Others',  'DeleteFile', LabeledEdit4.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  FTPサーバ上のファイルを削除する
//  LDeleteFile : 削除するサーバ上のファイル(フルパス)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LhSession   : HINTERNET;
  LhConnect   : HINTERNET;
  LServerName : String;
  LUserID     : String;
  LPassWord   : String;
  LDeleteFile : String;
  LResultFlag : Boolean;
  LhFile      : HINTERNET;
  LFileData   : TWin32FindData;
  LIsNoFile   : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LServerName := LabeledEdit1.Text;
  LUserID     := LabeledEdit2.Text;
  LPassWord   := LabeledEdit3.Text;
  LDeleteFile := LabeledEdit4.Text;

  LResultFlag := False;
  LIsNoFile   := False;

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect:=InternetConnect(LhSession,
                               PChar(LServerName),
                               INTERNET_DEFAULT_FTP_PORT,
                               PChar(LUserID),
                               PChar(LPassWord),
                               INTERNET_SERVICE_FTP,
                               0,
                               0);
    if Assigned(LhConnect) then begin
      //サーバ上のファイルの存在を確認
      if Assigned(LhConnect) then begin
        LhFile := FtpFindFirstFile(LhConnect,
                                   PChar(LDeleteFile),
                                   LFileData,
                                   INTERNET_FLAG_RELOAD,
                                   0);
        if LhFile = nil then begin
          LIsNoFile := True;
        end else begin
          LResultFlag := FtpDeleteFile(LhConnect, PChar(LDeleteFile));
        end;
      end;
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ファイルを削除しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoFile then begin
      MessageDlg('該当ファイルが見つかりませんでした', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ファイルの削除に失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    procedure Button1Click(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 WinInet, IniFiles;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'OldFileName', '');
     LabeledEdit5.Text := LIni.ReadString('Others',  'NewFileName', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName',  LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',      LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',    LabeledEdit3.Text);
      LIni.WriteString('Others',  'OldFileName', LabeledEdit4.Text);
      LIni.WriteString('Others',  'NewFileName', LabeledEdit5.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  サーバ上のファイル名を変更
//  ディレクトリを変更すると移動になるので注意
//  その場合移動先のディレクトリの存在のチェックが必要
//
//  LOldFileName  : 変更前のファイルパス名
//  LNewFileName  : 変更後のファイルパス名
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LServerName  : String;
  LUserID      : String;
  LPassWord    : String;
  LOldFileName : String;
  LNewFileName : String;
  LResultFlag  : Boolean;
  LhSession    : HINTERNET;
  LhConnect    : HINTERNET;
  LhFile       : HINTERNET;
  LFileData    : TWin32FindData;
  LIsNoFile    : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LServerName  := LabeledEdit1.Text;
  LUserID      := LabeledEdit2.Text;
  LPassWord    := LabeledEdit3.Text;
  LOldFileName := LabeledEdit4.Text;
  LNewFileName := LabeledEdit5.Text;

  LResultFlag := False;
  LIsNoFile   := False;

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect := InternetConnect(LhSession,
                                 PChar(LServerName),
                                 INTERNET_DEFAULT_FTP_PORT,
                                 PChar(LUserID),
                                 PChar(LPassWord),
                                 INTERNET_SERVICE_FTP,
                                 0,
                                 0);
    if Assigned(LhConnect) then begin
      LhFile := FtpFindFirstFile(LhConnect,
                                 PChar(LOldFileName),
                                 LFileData,
                                 INTERNET_FLAG_RELOAD,
                                 0);
      if LhFile = nil then begin
        LIsNoFile := True;
      end else begin
        LResultFlag := FtpRenameFile(LhConnect,
                                     PChar(LOldFileName),
                                     PChar(LNewFileName));
        InternetCloseHandle(LhFile);
      end;
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ファイル名を変更しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoFile then begin
      MessageDlg('該当ファイルが見つかりませんでした', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ファイル名の変更に失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    procedure Button1Click(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 WinInet, IniFiles;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'ADirectory', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',     LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',   LabeledEdit3.Text);
      LIni.WriteString('Others',  'ADirectory', LabeledEdit4.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  FTPサーバ上にディレクトリを作成
//  階層を持つディレクトリは作成できない
//  上の階層から順番に作成する必要がある
//
//  LNewDirectory : 作成するディレクトリ名
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LServerName   : String;
  LUserID       : String;
  LPassWord     : String;
  LNewDirectory : String;
  LResultFlag   : Boolean;
  LhSession     : HINTERNET;
  LhConnect     : HINTERNET;
  LhFile        : HINTERNET;
  LFileData     : TWin32FindData;
  LIsDirectory  : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LServerName    := LabeledEdit1.Text;
  LUserID        := LabeledEdit2.Text;
  LPassWord      := LabeledEdit3.Text;
  LNewDirectory  := LabeledEdit4.Text;

  LResultFlag  := False;
  LIsDirectory := False;

  LhSession:=InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect:=InternetConnect(LhSession,
                               PChar(LServerName),
                               INTERNET_DEFAULT_FTP_PORT,
                               PChar(LUserID),
                               PChar(LPassWord),
                               INTERNET_SERVICE_FTP,
                               0,
                               0);
    if Assigned(LhConnect) then begin
      LhFile := FtpFindFirstFile(LhConnect,
                                 PChar(LNewDirectory),
                                 LFileData,
                                 INTERNET_FLAG_RELOAD,
                                 0);
      if LhFile <> nil then begin
        LIsDirectory := True;
      end else begin
        //FtpCreateDirectoryはディレクトリが既に存在していると失敗する
        LResultFlag := FtpCreateDirectory(LhConnect, PChar(LNewDirectory));
      end;
      InternetCloseHandle(LhFile);
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ディレクトリの作成が終了しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsDirectory then begin
      MessageDlg('該当ディレクトリは既に存在します', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ディレクトリの作成に失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    procedure Button1Click(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 WinInet, IniFiles;

{$R *.dfm}

//=============================================================================
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//
//  LabeledEdit4.Textは削除するディレクトリ名
//  ex. LabeledEdit4.Text := 'mrxray.on.coocan.jp/homepage/AAA';
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni : TInifile;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'ADirectory', '');
   end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',     LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',   LabeledEdit3.Text);
      LIni.WriteString('Others',  'ADirectory', LabeledEdit4.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  FTPサーバ上にディレクトリを作成
//  空でないディレクトリは削除できない
//
//  LDirectory : 削除するディレクトリ名
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LServerName   : String;
  LUserID       : String;
  LPassWord     : String;
  LDirectory    : String;
  LResultFlag   : Boolean;
  LhSession     : HINTERNET;
  LhConnect     : HINTERNET;
  LhFile        : HINTERNET;
  LFileData     : TWin32FindData;
  LIsNoDir      : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LServerName  := LabeledEdit1.Text;
  LUserID      := LabeledEdit2.Text;
  LPassWord    := LabeledEdit3.Text;
  LDirectory   := LabeledEdit4.Text;

  LResultFlag := False;
  LIsNoDir    := False;

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect := InternetConnect(LhSession,
                               PChar(LServerName),
                               INTERNET_DEFAULT_FTP_PORT,
                               PChar(LUserID),
                               PChar(LPassWord),
                               INTERNET_SERVICE_FTP,
                               0,
                               0);
    if Assigned(LhConnect) then begin
      LhFile := FtpFindFirstFile(LhConnect,
                                 PChar(LDirectory),
                                 LFileData,
                                 INTERNET_FLAG_RELOAD,
                                 0);
      if LhFile = nil then begin
        LIsNoDir := True;
      end else begin
        //該当するディレクトリが存在しないと失敗
        LResultFlag := FtpRemoveDirectory(LhConnect, PChar(LDirectory));
      end;
      InternetCloseHandle(LhFile);
    end;
    InternetCloseHandle(LhConnect);
  end;
  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LResultFlag then begin
    MessageDlg('ディレクトリを削除しました', mtInformation, [mbOK], 0);
  end else begin
    if LIsNoDir then begin
      MessageDlg('該当ディレクトリが見つかりませんでした', mtInformation, [mbOK], 0);
    end else begin
      MessageDlg('ディレクトリの削除に失敗しました', mtInformation, [mbOK], 0);
    end;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList, WinInet;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    Button1: TButton;
    StatusBar1: TStatusBar;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    IniFileName  : String;
    function GetFileList(hNet: HINTERNET; ADir: String): Integer;
    function DisplayFileInfo(FileData: TWin32FindData): Boolean;
    function GetFileExtIcon(FileName: String; Attrib: Cardinal): Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI, CommCtrl, IniFiles;

{$R *.dfm}

//=============================================================================
//  ファイル一覧表示用のListView1のカラムの設定
//  EditにFTP関係情報をセット
//  1つ上の階層からFTPInfo.iniを読み出してセット
//
//  LabeledEdit4.Textはファイルのリストを取得するディレクトリ名
//  ex. LabeledEdit4.Text := 'mrxray.on.coocan.jp/homepage/Halbow';
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LIni           : TInifile;
  LSHFileInfo    : TSHFileInfo ;
  LImgListHandle : THandle;
begin
  IniFileName := '..\FTPInfo.ini';
  LIni := TIniFile.Create(IniFileName);
  try
   if FileExists(IniFileName) then begin
     LabeledEdit1.Text := LIni.ReadString('FTPInfo', 'ServerName', '');
     LabeledEdit2.Text := LIni.ReadString('FTPInfo', 'UserID', '');
     LabeledEdit3.Text := LIni.ReadString('FTPInfo', 'PassWord', '');
     LabeledEdit4.Text := LIni.ReadString('Others',  'SearchDir', '');
   end;
  finally
    FreeAndNil(LIni);
  end;

  ListView1.ViewStyle:=vsReport;
  ListView1.Columns.Add;
  ListView1.Columns[0].Caption   := 'ファイル名';
  ListView1.Columns[0].Width     := 190;
  ListView1.Columns.Add;
  ListView1.Columns[1].Caption   := 'サイズ　';
  ListView1.Columns[1].Width     := 100;
  ListView1.Columns[1].Alignment := taRightJustify;
  ListView1.Columns.Add;
  ListView1.Columns[2].Caption   := '　更新日時';
  ListView1.Columns[2].Width     := 120;

  //システムのイメージリストのハンドルを取得
  LImgListHandle := SHGetFileInfo('',
                                  0,
                                  LSHFileInfo,
                                  SizeOf(LSHFileInfo),
                                  SHGFI_ICON or
                                  SHGFI_SMALLICON or
                                  SHGFI_SYSICONINDEX);
  ListView_SetImageList(ListView1.Handle, LImgListHandle, LVSIL_SMALL);
end;

//=============================================================================
//  設定をIniファイルに保存
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  LIni : TInifile;
begin
  LIni := TIniFile.Create(IniFileName);
  try
    try
      LIni.WriteString('FTPInfo', 'ServerName', LabeledEdit1.Text);
      LIni.WriteString('FTPInfo', 'UserID',     LabeledEdit2.Text);
      LIni.WriteString('FTPInfo', 'PassWord',   LabeledEdit3.Text);
      LIni.WriteString('Others',  'SearchDir',  LabeledEdit4.Text);
    except
    end;
  finally
    FreeAndNil(LIni);
  end;
end;

//=============================================================================
//  FTPサーバ内の指定ディレクトリ内のファイル一覧
//  ファイルのリスト作成はGetFileListで行う
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LServerName : String;
  LUserID     : String;
  LPassWord   : String;
  LhSession   : HINTERNET;
  LhConnect   : HINTERNET;
  LSearchDir  : String;
  LCount      : Integer;
begin
  Screen.Cursor := crHourGlass;

  LServerName  := LabeledEdit1.Text;
  LUserID      := LabeledEdit2.Text;
  LPassWord    := LabeledEdit3.Text;
  LSearchDir   := LabeledEdit4.Text;

  LCount := 0;
  StatusBar1.SimplePanel := True;
  StatusBar1.SimpleText  := '';
  ListView1.Items.Clear;
  ListView1.Update;

  LhSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if Assigned(LhSession) then begin
    //LServerName,LUserID,LPassWordのどれかが不正だと失敗する
    LhConnect := InternetConnect(LhSession,
                                 PChar(LServerName),
                                 INTERNET_DEFAULT_FTP_PORT,
                                 PChar(LUserID),
                                 PChar(LPassWord),
                                 INTERNET_SERVICE_FTP,
                                 0,
                                 0);
    if Assigned(LhConnect) then begin
      //ファイルのリスト作成
      LCount := GetFileList(LhConnect, LSearchDir);
    end;
    InternetCloseHandle(LhConnect);
  end;
  ListView1.Items.EndUpdate;

  InternetCloseHandle(LhSession);
  Screen.Cursor := crDefault;

  if LCount < 0 then begin
    StatusBar1.SimpleText := '該当ディレクトリが見つかりませんでした';
  end else begin
    StatusBar1.SimpleText := '　項目数 : ' + IntToStr(LCount);
  end;
  StatusBar1.Update;
end;

//-----------------------------------------------------------------------------
//  FTPサーバ内のディレクトリADir内のファイルの一覧を作成
//  FtpFindFirstFileとFtpFindNextFile関数を使用
//  個々のファイルの情報はDisplayFileInfoで実行
//  戻値は表示ファイル数
//-----------------------------------------------------------------------------
function TForm1.GetFileList(hNet: HINTERNET; ADir: String): Integer;
var
  LhFile    : HINTERNET;
  LFileData : TWin32FindData;
begin
  Result := -1;

  LhFile := FtpFindFirstFile(hNet,
                             PChar(ADir),
                             LFileData,
                             INTERNET_FLAG_RELOAD,
                             0);
  if Assigned(LhFile) then begin
    Result := 0;
    while True do begin
      //ListViewのItemにファイル情報を表示
      if DisplayFileInfo(LFileData) then inc(Result);
      if InternetFindNextFile(LhFile, @LFileData) = False then break;

      Application.ProcessMessages;
      Sleep(1);
    end;
  end else begin
    //該当ディレクトリが存在しない場合
  end;
  InternetCloseHandle(LhFile);
end;

//-----------------------------------------------------------------------------
//  ListViewにファイルの情報を表示
//-----------------------------------------------------------------------------
function TForm1.DisplayFileInfo(FileData: TWin32FindData): Boolean;
var
  LFileName : String;
  LSize     : Integer;
  LItem     : TListItem;
  LSysTime  : SYSTEMTIME;
  LDateTime : TDateTime;
begin
  LFileName := FileData.cFileName;
  Result := False;

  if not ((LFileName = '..') or (LFileName = '.')) then begin
    LItem := ListView1.Items.Add;
    //ファイル名
    LItem.Caption := LFileName;

    //ファイルサイズ
    if (FileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then begin
      LItem.SubItems.Add('');
    end else begin
      LSize := (FileData.nFileSizeLow div 1024) + 1;
      LItem.SubItems.Add(FormatFloat('###,##0 KB', LSize));
    end;

    //ファイルの日時をDelphiのTDateTime型に変換して表示
    FileTimeToSystemTime(FileData.ftLastWriteTime, LSysTime);
    LDateTime:=SystemTimeToDateTime(LSysTime);
    LItem.SubItems.Add(FormatDateTime(' yyyy/mm/dd hh:nn', LDateTime));

    //ファイルの拡張子に応じたアイコンを表示
    LItem.ImageIndex := GetFileExtIcon(LFileName, FileData.dwFileAttributes);
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//  ファイルの拡張子に関連付けしたシステムイメージアイコンのインデックスを取得
//  FileNameはファイルのフルパス(パス部分はなくても可)
//  取得するファイルの属性を引数のAttribに与える
//-----------------------------------------------------------------------------
function TForm1.GetFileExtIcon(FileName: String; Attrib: Cardinal): Integer;
var
  LSHFileInfo : TSHFileinfo;
begin
  SHGetFileInfo(PChar('*' + ExtractFileExt(Filename)),
                      Attrib,
                      LSHFileInfo,
                      SizeOf(TSHFileInfo),
                      SHGFI_USEFILEATTRIBUTES or
                      SHGFI_SYSICONINDEX or
                      SHGFI_SMALLICON);
  Result := LSHFileInfo.iIcon;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel2: TPanel;
    ProgressBar1: TProgressBar;
    Panel3: TPanel;
    LabeledEdit1: TLabeledEdit;
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FIsCancel : Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  WinInet, StrUtils, IOUtils;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  コールバック関数
//-----------------------------------------------------------------------------
procedure TestInternetCallback(hInet: HINTERNET; dwcontex, dwInternetStatus: DWORD;
  lpvStatusInformation: Pointer; dwStatusInformationLength: DWORD); stdcall;
begin
  case dwInternetStatus of
    INTERNET_STATUS_RESOLVING_NAME:
      Form1.Memo1.Lines.Add('IPアドレス取得中');
    INTERNET_STATUS_NAME_RESOLVED:
      Form1.Memo1.Lines.Add('IPアドレスの取得終了');
    INTERNET_STATUS_CONNECTING_TO_SERVER:
      Form1.Memo1.Lines.Add('サーバへ接続中');
    INTERNET_STATUS_CONNECTED_TO_SERVER:
      Form1.Memo1.Lines.Add('サーバへ接続完了');
    INTERNET_STATUS_SENDING_REQUEST:
      Form1.Memo1.Lines.Add('要求発行中');
    INTERNET_STATUS_REQUEST_SENT:
      Form1.Memo1.Lines.Add('要求発行終了');
    INTERNET_STATUS_RECEIVING_RESPONSE:
      Form1.Memo1.Lines.Add('サーバの応答待機中');
    INTERNET_STATUS_RESPONSE_RECEIVED:
      Form1.Memo1.Lines.Add('サーバの応答終了');
    INTERNET_STATUS_REDIRECT:
      Form1.Memo1.Lines.Add('自動リダイレクトによる要求の転送中');
    INTERNET_STATUS_CLOSING_CONNECTION:
      Form1.Memo1.Lines.Add('サーバから切断中');
    INTERNET_STATUS_CONNECTION_CLOSED:
      Form1.Memo1.Lines.Add('サーバから切断終了しました');
    INTERNET_STATUS_HANDLE_CREATED:
      Form1.Memo1.Lines.Add('新規ハンドルを作成');
    INTERNET_STATUS_HANDLE_CLOSING:
      Form1.Memo1.Lines.Add('ハンドルをクローズ');
    INTERNET_STATUS_REQUEST_COMPLETE:
      Form1.Memo1.Lines.Add('非同期操作が終了');
  end;
end;

//=============================================================================
//  ダウンロードファイル名をLabelEditに入力
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  LabeledEdit1.Text := 'http://mrxray.on.coocan.jp/Delphi/ZipExe/plSetPrinter.zip';
end;

//=============================================================================
//  HTTPサーバからファイルをダウンロード
//  コールバック関数を使用してダウンロードの進捗状況を表示
//
//  LSourceURL : ダウンロードするファイル名
//  LSaveFile  : ダウンロード後のファイル名
//
//  UnixPathToDosPath関数にはusesにHTTPAppが必要
//  MatchTextの使用にはusesにStrUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStream      : TFileStream;
  LSourceURL   : String;
  LSaveFile    : String;
  LResultFlag  : Boolean;
  hSession     : HINTERNET;
  LhService    : HINTERNET;
  LFileSize    : Longint;
  LDLFileSize  : Int64;
  LdwBytesRead : DWORD;
  LReserved    : DWORD;
  LlpvBuffer   : array[0..1023] of Char;
  LDownloadURL : String;
  LIsNoFile    : Boolean;
begin
  Screen.Cursor := crHourGlass;

  LSourceURL := LabeledEdit1.Text;

  LResultFlag  := False;
  LIsNoFile    := False;
  FIsCancel    := False;
  LDownloadURL := '';
  LDLFileSize  := 0;
  Memo1.Lines.Clear;

  hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then begin
    //INTERNET_FLAG_NO_AUTO_REDIRECTはリダイレクト回避
    //WinInetはリダイレクトを自動でやってくれる
    //勝手にリダイレクトされてしまうと保存先のファイル名の設定ができない
    //そこで，リダイレクトを回避してステータスコードで判定して処理
    LhService := InternetOpenUrl(hSession,
                                 PChar(LSourceURL),
                                 nil,
                                 0,
                                 INTERNET_FLAG_NO_AUTO_REDIRECT or INTERNET_FLAG_RELOAD,
                                 0);
    if Assigned(LhService) then begin
      //HTTP_QUERY_STATUS_CODEでステータスコードを取得
      FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
      LdwBytesRead := SizeOf(LlpvBuffer);
      LReserved    := 0;
      HttpQueryInfo(LhService,
                    HTTP_QUERY_STATUS_CODE,
                    @LlpvBuffer[0],
                    LdwBytesRead,
                    LReserved);

      if MatchText(LlpvBuffer, ['404', '407']) then begin
        LIsNoFile := True;
      end else
      if not MatchText(LlpvBuffer, ['200','203','301','302','303','307']) then begin
        LIsNoFile := True;
      end;

      //サーバにファイルが存在するなら処理続行
      if not LIsNoFile then begin
        //HTTP_QUERY_LOCATIONを指定してリダイレクト先を取得
        //ステータスコードが301等がリダイレクト
        FillChar(LlpvBuffer, SizeOf(LlpvBuffer), #0);
        LdwBytesRead := SizeOf(LlpvBuffer);
        LReserved    := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_LOCATION,
                      @LlpvBuffer[0],
                      LdwBytesRead,
                      LReserved);
        if String(LlpvBuffer) = '' then begin
          //リダイレクトではない場合(あるいはリダイレクトに失敗)
          LDownloadURL := LSourceURL;
        end else begin
          //リダイレクトされている場合
          LDownloadURL := LlpvBuffer;
        end;

        //保存ファイル名はこのプロジェクトのフォルダでサーバ上と同名
        //ファイル名部分が取得できない場合は最後のディレクトリ名とする
        if TPath.GetFileName(LDownloadURL) = '' then begin
          LSaveFile := ExtractFilePath(ParamStr(0)) +
            TPath.GetFileName(TPath.GetDirectoryName(LDownloadURL)) + '.html';
        end else begin
          LSaveFile := ExtractFilePath(ParamStr(0)) +
            TPath.GetFileName(LDownloadURL);
        end;

        //対象のファイルがサーバに存在することが分かったので
        //今度はリダイレクトを有効にしてInternetOpenUrlを実行
        InternetCloseHandle(LhService);
        //コールバック定義
        InternetSetStatusCallback(hSession, @TestInternetCallback);
        LhService := InternetOpenUrl(hSession,
                                     PChar(LSourceURL),
                                     nil,
                                     0,
                                     INTERNET_FLAG_RELOAD,
                                     Cardinal(@TestInternetCallback));
        //ファイルサイズを取得
        LFileSize    := 0;
        LdwBytesRead := SizeOf(LdwBytesRead);
        LReserved    := 0;
        HttpQueryInfo(LhService,
                      HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
                      @LFileSize,
                      LdwBytesRead,
                      LReserved);

        ProgressBar1.Min := 0;
        ProgressBar1.Max := LFileSize;

        try
          //保存するファイルを作成
          //TMemoryStreamに保存，ダウンロード終にディスクに保存する方法も考えられる
          LStream := TFileStream.Create(LSaveFile, fmCreate);
          //Loopにrepeatを用いた例
          try
            LdwBytesRead := SizeOf(LlpvBuffer);
            repeat
              LlpvBuffer := #0;
              if InternetReadFile(LhService,
                                  @LlpvBuffer,
                                  SizeOf(LlpvBuffer),
                                  LdwBytesRead) then begin
                LStream.WriteBuffer(LlpvBuffer, LdwBytesRead);

                LDLFileSize    := LDLFileSize + LdwBytesRead;
                Panel1.Caption := IntToStr(LDLFileSize) + ' バイト完了';
                ProgressBar1.Position := LDLFileSize;
                ProgressBar1.Update;
                Panel1.Update;
                LResultFlag := True;
              end else begin
                LResultFlag := False;
                break;
              end;
              if FIsCancel then break;
              Application.ProcessMessages;
              Sleep(1);
            until LdwBytesRead = 0;
          finally
            FreeAndNil(LStream);
          end;
        except
          //保存ファイルが作成できなかった場合
          //リダイレクト先が取得できなかった場合等
          LResultFlag := False;
        end;
      end;
    end;
    InternetCloseHandle(LhService);
  end;
  InternetCloseHandle(hSession);
  Screen.Cursor := crDefault;

  if FIsCancel then begin
    Panel1.Caption := 'ダウンロードを中止しました';
  end else
  if LResultFlag then begin
    Panel1.Caption := 'ダウンロードが終了しました';
  end else begin
    if LIsNoFile then begin
      Panel1.Caption := '該当するファイルがサーバにありません';
    end else begin
      Panel1.Caption := 'ダウンロードに失敗しました';
    end;
  end;
end;

//=============================================================================
//  キャンセルボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  FIsCancel := True;
end;

end.

procedure TForm1.OnReceived(Sender: TObject; const Stream: TStream);
var
  LFileStream   : TFileStream;
  LSaveFileName : String;
begin
  Stream.Seek(0, soBeginning);
  Memo1.Lines.LoadFromStream(Stream);

  LSaveFileName := ExtractFileName(UnixPathToDosPath(Edit1.Text));
  LFileStream   := TFileStream.Create(LSaveFileName, fmCreate);
  try
    LFileStream.CopyFrom(Stream, 0);
  finally
    FreeAndNil(LFileStream);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Items.Clear;
  Memo1.Lines.Clear;
  HTTPDown.GetUrl(Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/ZipExe/plSetPrinter.zip';

  HTTPDown := THTTPDownload.Create;

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses WinHttp_TLB, ActiveX, AxCtrls;

{$R *.dfm}

//=============================================================================
//  テスト用のURLをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := 'http://mrxray.on.coocan.jp/Delphi/zip/003_StopWatch.zip';
end;

//=============================================================================
//  WinHTTPを使用したファイルのダウンロード
//
//  IStreamの使用にはusesにActiveXが必要
//  TOleStreamの使用にはusesにAxCtrlsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LHttpRequest : IWinHttpRequest;
  LSourceURL   : String;
  LSaveFile    : String;
  LFileStream  : TFileStream;
  LHttpStream  : IStream;
  LOleStream   : TOleStream;
begin
  Screen.Cursor := crHourGlass;

  LSourceURL := Edit1.Text;
  LSaveFile  := ExtractFilePath(Application.ExeName) + '003_StopWatch.zip';

  LHttpRequest := CoWinHttpRequest.Create;
  try
    LHttpRequest.Open('GET', LSourceURL, False);
    LHttpRequest.Send(EmptyParam);
    //上のコードが成功すればLHttpRequest.Statusの値が200になっている

    LHttpStream := IUnknown(LHttpRequest.ResponseStream) as IStream;
    LOleStream  := TOleStream.Create(LHttpStream);
    try
      LFileStream := TFileStream.Create(LSaveFile, fmCreate);
      try
        LFileStream.CopyFrom(LOleStream, 0);
      finally
        FreeAndNil(LFileStream);
      end;
    finally
      FreeAndNil(LOleStream);
    end;
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
  Screen.Cursor := crDefault;
  LHttpRequest := nil;
end;

end.

procedure TWinHttpRequest.Open(const Method: WideString; const Url: WideString);
begin
  DefaultInterface.Open(Method, Url, EmptyParam);
end;

procedure TWinHttpRequest.Send(Body: OleVariant);
begin
  DefaultInterface.Send(Body);
end;