TClientSocketのリファレンスは？ (ID：1563)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

InternetQueryDataAvailableは、「指定したファイルの読み込み済みのバイト数」を返す関数のようです。
書き込みには使えないみたいですね。

こんなユニットを作ってみました。
# 一応、ファイルダウンロード/アップロードはテストしました。HTMLファイルだけですが

使用方法は、
GetFtpFile(サーバ名, ユーザID, パスワード, ファイルパス, ファイルの内容のTMemoryStream, コールバックプロシージャ);
GetFtpFile('ftp://ユーザID:パスワード@サーバ名/ファイルパス', ファイルの内容のTMemoryStream, コールバックプロシージャ);

PutFtpFile(サーバ名, ユーザID, パスワード, ファイルパス, ファイルの内容のTMemoryStream, コールバックプロシージャ);
PutFtpFile('ftp://ユーザID:パスワード@サーバ名/ファイルパス', ファイルの内容のTMemoryStream, コールバックプロシージャ);

です。

//-----------------------------------------------------------
unit FtpUtils;

interface
uses
  Forms, Windows, Messages, SysUtils, Classes, wininet, ComCtrls;

type
  TFTPProgProc = procedure (FileName: String; Pos, Max: ULARGE_INTEGER; IsPut: Boolean) of object;

procedure GetFtpFile(ServerName, UserName, Password,
  FileName: String; Stream: TMemoryStream; ProgProc: TFTPProgProc); overload;
procedure GetFtpFile(URL: String; Stream: TMemoryStream; ProgProc: TFTPProgProc); overload;
procedure PutFtpFile(ServerName, UserName, Password,
  FileName: String; Stream: TMemoryStream; ProgProc: TFTPProgProc); overload;
procedure PutFtpFile(URL: String; Stream: TMemoryStream; ProgProc: TFTPProgProc); overload;

implementation

uses Controls;

procedure GetFtpFile(ServerName, UserName, Password,
  FileName: String; Stream: TMemoryStream; ProgProc: TFTPProgProc);
const
		ReadSize = 1000;
var
	hInternet: WinInet.HINTERNET;
	hFtpSession: WinInet.HINTERNET;
	hFind: WinInet.HINTERNET;
	hFile: WinInet.HINTERNET;
	fd: WIN32_FIND_DATA;
  Size, Position: ULARGE_INTEGER;
  bResult: BOOL;
  Buf: PChar;
  RSize: DWORD;
begin
  Screen.Cursor := crHourGlass;

hInternet := InternetOpen(
		PChar(Application.Title),
		INTERNET_OPEN_TYPE_DIRECT,
		nil,
		nil,
		0);

hFtpSession := InternetConnect(
		hInternet,
		PChar(ServerName),
		INTERNET_DEFAULT_FTP_PORT,
		PChar(UserName),
		PChar(Password),
		INTERNET_SERVICE_FTP,
		0,
		0);

hFind := FtpFindFirstFile(hFtpSession, PChar(FileName), fd, 0, 0);
  if hFind = nil then
  begin
    Screen.Cursor := crDefault;
	  InternetCloseHandle(hFtpSession);
	  InternetCloseHandle(hInternet);

Exit;
  end;

Size.LowPart := fd.nFileSizeLow;
  Size.HighPart := fd.nFileSizeHigh;
  Position.QuadPart := 0;

InternetCloseHandle(hFind);

hFile := FtpOpenFile(
		hFtpSession,
		PChar(FileName),
		GENERIC_READ,
		FTP_TRANSFER_TYPE_BINARY,
		0);

if @ProgProc <> nil then ProgProc(FileName, Position, Size, False);
  Buf := GetMemory(ReadSize);
	while true do
  begin
    Application.ProcessMessages;
		bResult := InternetReadFile(
			hFile,
			Buf,
			ReadSize,
			RSize);

if(bResult And (RSize = 0)) then break;

Stream.WriteBuffer(buf[0], RSize);

Position.QuadPart := Position.QuadPart + RSize;
    ProgProc(FileName, Position, Size, False);
  end;
  FreeMemory(Buf);
  ProgProc(FileName, Size, Size, False);

Screen.Cursor := crDefault;

InternetCloseHandle(hFile);
	InternetCloseHandle(hFtpSession);
	InternetCloseHandle(hInternet);
end;
procedure GetFtpFile(URL: String; Stream: TMemoryStream; ProgProc: TFTPProgProc);
var
  i: integer;
  ServerName, UserName, Password, FileName: String;
begin
  i := 6; // ftp://の次の文字
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos('@', URL);
  UserName := Copy(URL, 1, i - 1);
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos(':', URL);
  Password := Copy(URL, 1, i - 1);
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos('/', URL);
  ServerName := Copy(URL, 1, i - 1);
  FileName := Copy(URL, i + 1, Length(URL));
  GetFtpFile(ServerName, UserName, Password, FileName, Stream, ProgProc);
end;

procedure PutFtpFile(ServerName, UserName, Password,
  FileName: String; Stream: TMemoryStream; ProgProc: TFTPProgProc);
const
		ReadSize = 1000;
var
	hInternet: WinInet.HINTERNET;
	hFtpSession: WinInet.HINTERNET;
	hFile: WinInet.HINTERNET;
  Size, Position: ULARGE_INTEGER;
  bResult: BOOL;
  Buf: PChar;
  RSize: DWORD;
begin

Screen.Cursor := crHourGlass;

Stream.Seek(0, soFromBeginning);

Size.LowPart := Stream.Size;
  Size.HighPart := 0;
  Position.QuadPart := 0;

hInternet := InternetOpen(
		PChar(Application.Title),
		INTERNET_OPEN_TYPE_DIRECT,
		nil,
		nil,
		0);

hFtpSession := InternetConnect(
		hInternet,
		PChar(ServerName),
		INTERNET_DEFAULT_FTP_PORT,
		PChar(UserName),
		PChar(Password),
		INTERNET_SERVICE_FTP,
		0,
		0);

hFile := FtpOpenFile(
		hFtpSession,
		PChar(FileName),
		GENERIC_WRITE,
		FTP_TRANSFER_TYPE_BINARY,
		0);

ProgProc(FileName, Position, Size, True);
  Buf := GetMemory(ReadSize);
  RSize := Stream.Size;
  if Stream.Size > ReadSize then RSize := ReadSize;
	while true do
  begin
    Application.ProcessMessages;
    Stream.ReadBuffer(Buf[0], RSize);
		bResult := InternetWriteFile(
			hFile,
			Buf,
			RSize,
			RSize);

Position.QuadPart := Position.QuadPart + RSize;
    ProgProc(FileName, Position, Size, True);

RSize := Stream.Size - Stream.Position;
    if RSize > ReadSize then RSize := ReadSize;

if(bResult And (RSize = 0)) then break;

end;
  FreeMemory(Buf);
  ProgProc(FileName, Size, Size, True);

Screen.Cursor := crDefault;

InternetCloseHandle(hFile);
	InternetCloseHandle(hFtpSession);
	InternetCloseHandle(hInternet);
end;

procedure PutFtpFile(URL: String; Stream: TMemoryStream; ProgProc: TFTPProgProc);
var
  i: integer;
  ServerName, UserName, Password, FileName: String;
begin
  i := 6; // ftp://の次の文字
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos('@', URL);
  UserName := Copy(URL, 1, i - 1);
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos(':', URL);
  Password := Copy(URL, 1, i - 1);
  URL := Copy(URL, i + 1, Length(URL));
  i := Pos('/', URL);
  ServerName := Copy(URL, 1, i - 1);
  FileName := Copy(URL, i + 1, Length(URL));
  PutFtpFile(ServerName, UserName, Password, FileName, Stream, ProgProc);
end;
end.
//-----------------------------------------------------------

←解決時は質問者本人がここをチェックしてください。

戻る