FTPでのファイル送信にTClientSocketを使いたいんですけど、
Delphi6Personalには、それを使ったサンプルプログラムもなく、
どう使えばいいのか、いまいちわかりません。
せめて、リファレンスでもないでしょうか?
もしかしたら、レスが遅すぎたかもしれませんが…
TClientSocketを使わないと駄目ですか?
FTPでファイル送信するだけなら、APIを使うと簡単にできますが。
http://tokyo.cool.ne.jp/masapico/
ここの、関数別 Win32 サンプル集に、FtpPutFileというのがあります。
たまたまFTP送受信部分が必要になり、検索したら見つけました。
でも、サーバも用意しないとならないのなら使えませんね。
> もしかしたら、レスが遅すぎたかもしれませんが…
レスありがとうございます。遅くないです。まだ悩んでます^^;
>http://tokyo.cool.ne.jp/masapico/
>ここの、関数別 Win32 サンプル集に、FtpPutFileというのがあります。
ええ、そこは見てみました。WinInetのAPIを使うんですよね、
でも、そのAPIだと、転送状況がわからないようなので、こちらを使いたいんです。
(コールバック関数について詳しい説明のなされたサイトが見当たらなかったので、それを使えばできたのかもしれませんけど…)
同DLLのAPIの、InternetReadFileやWriteFileを使えば、転送状況用のイベントを発生させながらできるのではと思い、
HTTPをダウンロードするのと同じ要領でやってみましたけど、
ことごとく失敗してしまいました。
WinSockのAPIを使ってもできるのだと思いますけど、
それではTClientSocketを使ったほうが早そうなので…。
考え方が合っているかどうかはわかりませんが、FTPサーバからファイルを取得するプロシージャを作ってみました。
1000バイトごと読み込み、プロシージャに与えられたプロシージャを呼びながらファイルを読み込みます。
最初、ログインしてファイルのサイズを取得するため、最初のプログレスなどの処理が少し遅れます。
書き込みは作っていませんが、だいたい同じような方法でできます。
コールバック関数(InternetSetStatusCallback)は、接続・切断・要求発行、などの情報しか使えません。
ファイルのどこまで取得したかは、自分で管理する必要があるようです。
type
TFTPProgProc = procedure (FileName: String; Pos, Max: ULARGE_INTEGER) of object;
procedure GetFtpFile(ServerName, UserName, Password,
FileName: String; Stream: TMemoryStream; ProgProc: TFTPProgProc);
implementation
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
hInternet := InternetOpen(
'Delphi Application',
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 Exit;
Size.LowPart := fd.nFileSizeLow;
Size.HighPart := fd.nFileSizeHigh;
Position.QuadPart := 0;
InternetCloseHandle(hFind);
hFile := FtpOpenFile(
hFtpSession,
PChar(FileName),
GENERIC_READ,
FTP_TRANSFER_TYPE_ASCII,
0);
ProgProc(FileName, Position, Size);
Buf := GetMemory(ReadSize);
while true do
begin
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);
end;
ProgProc(FileName, Size, Size);
InternetCloseHandle(hFile);
InternetCloseHandle(hFtpSession);
InternetCloseHandle(hInternet);
end;
使い方を忘れてました。
GetFtpFile(
'サーバ名',
'ユーザ名',
'パスワード',
'ファイルのフルパス',
TMemoryStreamオブジェクト,
経過表示用プロシージャ);
です。
型チェック、プロシージャの存在チェックはしていません。
ありがとうございます。おかげでダウンロードできました♪
PCharですかぁ、わたしはarray of Byteでやってて失敗してたんですけど、Delphiらしいいい解決策ですね。
では、続いてアップロードのほうもやってみます。
InternetWriteFileですよね?
無事アップロードできたらまた書きますね。
さらにReadFileの前でInternetQueryDataAvilableを使ったら、
使用中の回線でできる限りの速度を出してくれるようですね。
うーん…。
いろいろやってみたのですけど、途中で応答がかえらなくなってしまいます。
var
hFile : HINTERNET;
Buffer : PChar;
request,abled,finished: Cardinal;
Cancel : Boolean;
begin
finished := 0;
Cancel := False;
// ファイルを開く
hFile := FtpOpenFile(hHost,PChar(RemoteFile),GENERIC_WRITE,
IfThen(AsciiMode,FTP_TRANSFER_TYPE_ASCII,FTP_TRANSFER_TYPE_BINARY),0);
try
repeat
InternetQueryDataAvailable(hFile,request,0,0);
Buffer := GetMemory(request);// バッファの準備
Stream.ReadBuffer(Buffer[0],request);// 書き込みの準備
// 書き込み
if not InternetWriteFile(hFile,Buffer,request + 1,abled) then
raise EWinInetError.Create('アップロード中にエラーが発生しました。');
Application.ProcessMessages;Sleep(0);
Inc(finished,abled);
if Assigned(mOnUploading) then OnUploading(Self,RemoteFile,Stream.Size,finished,abled,Cancel);
until (abled = 0) or Cancel;
finally
FreeMemory(Buffer);
InternetCloseHandle(hFile);
end;
end;
よければご教授お願いします。
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.
//-----------------------------------------------------------
ここの行で止まっていますね。
InternetQueryDataAvailable(hFile, request, 0, 0);
約3分後に帰ってきた requestの値は 0でした。
requestの値を1000に固定した以下のコードなら無事に送信完了します。
※ ただし request=abled の前提なので、値が違ってる場合の対処は省略。
....................
// ファイルを開く
hFile := FtpOpenFile(hFtpSession, PChar(RemotePath), GENERIC_WRITE,
FTP_TRANSFER_TYPE_BINARY, 0);
//InternetQueryDataAvailable(hFile, request, 0, 0);
request := 1000;
Stream := TFileStream.Create('C:\ftptest\test.lzh', fmOpenRead);
Buffer := GetMemory(request+1); // バッファの準備
try
repeat
request := Stream.Read(Buffer[0], request); // Streamから読込み
if request = 0 then break; //読み終わりなら送信完了
Buffer[request] := #0;
// 書き込み
if not InternetWriteFile(hFile, Buffer, request, abled) then begin
raise EWinInetError.Create('アップロード中にエラーが発生しました。');
end;
Application.ProcessMessages; Sleep(0);
Inc(finished, abled);
//経過表示
if Assigned(mOnUploading) then OnUploading(Self,RemoteFile,Stream.Size,finished,abled,Cancel);
until Cancel;
finally
FreeMemory(Buffer);
Stream.Free;
InternetCloseHandle(hFile);
InternetCloseHandle(hFtpSession);
InternetCloseHandle(hInternet);
end;
end;
カゴ:「おースゴイ、これなら kagochan.jpgふぁいるがチャント送れますね〜♪」
ツジ:「 じゃこの tujichan[2].jpgふぁいるも送っちゃおうっと♪ あれ?エラーになっちゃうよ。どして?」
カゴ:「ツジちゃんたら、ふぁいる名を間違ったんでしょ。だめネ〜」
ツジ:「え〜!カゴちゃんみたいなドジじゃないから、チャンと合ってるよ〜ほら♪」
カゴ:「おー、まじっスか。それじゃゲンインフメイですね〜」
裕子:「二人とも、ぱそこんの前で何ゴチャゴチャゆうとるん?」
ツジ:「だって、ナカザワさん、この tujichan[2].jpg が送れないです〜 kagochan.jpg は送れるのに〜」
カゴ:「やっぱ、日頃のオコナイがいい子だけ送れるってことでしょ♪」
裕子:「ンなことあるわけないやろ。サーバのファイル名に[]を付けたらアカンのや」
ツジ:「お〜♪ さすがナカザワさん。ドジのコウですね〜♪」
裕子:「それをゆうなら年の功や」
どうもありがとうございます。おかげで無事アップロードできました。
たまに原因不明で失敗してしまうんですけど…。
WinInetとファイアウォールの相性が悪かったのかなということで、
それ以外は正常なようです。
ところで、InternetWriteFileを回線のできる限りの速度で使うことはできないんでしょうか?
別に設定しておけば、可能でしょうけど…。
WinInetのAPIの範囲内ではできないんでしょうか?
ツイート | ![]() |