> I wouldn't rely on that. InternetQueryData tells you exactly what is
> available, so your code should be able to adjust itself for that.
>
> > InternetWriteFile seems to work correctly but nothing goes to the
> > site and it does not give any errors so I'm not sure what to do to
> > fix that. Wsftp uses the same site/user/password and it seems to
> > work with no problems. Maybe some of the parameters to InternetOpen
> > or Internet connect are somehow forcing me into a readonly position.
When I woke up this morning I immediately checked the web site using
wsftp and the putfile was working.. The file was named the contents of
the test upload file. I made the stupid mistake of passing the source
string to fptOpenFile instead of the RemoteFileName. Embarassing.
Anyway, it's all working the way I wanted now. I'm not sure about the
query data function. It is certainly simpler code without it and it
definitely works. I suspect if I tried using a buffer larger than 8k it
would fail. In case anybody is interested, here is the completed
working version. If I have further problems with it, I'll look into
using the querydata function. I still don't know how it would work for
putfile.
Best Regards & thanks for your help, Remy.
(*###################################################################
uftp.pas - uses wininet ftp access to download/upload files to
web site.
intended usage example:
ftp := tFtpAccess.create(SiteName,userName,Password);
if ( not assigned(ftp) ) or (not ftp.connected) then
raise exception.create('Unable to connect to FTP site');
try
if not ftp.setdir(WebFolder) then
raise exception.create('Unable to select ftp folder,
'+WebFolder)
else
begin
ftp.onprogress := myProgressProc;
filedata := ftp.Getfile(Thefile);
if length(FileData = 0 then
raise exception('Failed to read file: '+TheFile)
else
begin
// update information in the file
// or use it to do something else
if not ftp.Putfile(FileData, TheFile) then
raise exception.create('Unable to save file to ftp folder');
end;
end;
finally
ftp.free;
end;
#####################################################################*)
unit uftp;
interface
uses
windows, wininet, sysutils, classes;
type
tFtpAccess = class(tObject)
const
BlockSize = 1024;
type
tProgressProc =
procedure(afile: string; Done, Total: cardinal; var abort:
boolean) of object;
private
fSession: hINTERNET;
fConnect: hInternet;
fOnProgress: tProgressProc;
fConnected: boolean;
fSiteName: string;
fUsername: string;
fPassword: string;
public
constructor create(SiteName,UserName,Password: string);
destructor Destroy; override;
function GetDir: string;
function SetDir(WebDir: string): boolean;
function GetFile(WebName: string): string;
function PutFile(Source, RemoteName: string): boolean;
function FileSize(WebName: string): integer;
function DeleteFile(WebName: string): boolean;
property connected: boolean read fConnected;
property onProgress: tProgressProc read fOnProgress write
fOnProgress;
end;
implementation
//####################### tFtpAccess ##############################
constructor tFtpAccess.create(SiteName, UserName, Password: string);
var
appName: string;
begin
fSiteName := SiteName;
fUsername := UserName;
fPassword := Password;
appName := extractFileName(paramstr(0));
fSession := InternetOpen(
pchar(appName),
INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
if assigned(fSession) then
fConnect := InternetConnect(
fsession,
pchar(fSiteName),
INTERNET_DEFAULT_FTP_PORT,
pchar(fUserName),
pchar(fPassword),
INTERNET_SERVICE_FTP,
INTERNET_FLAG_PASSIVE,
0);
fConnected := assigned(fSession) and assigned(fConnect);
end { Create };
destructor tFtpAccess.Destroy;
begin
if fConnected then
InternetCloseHandle(fConnect);
if assigned(fSession) then
InternetCloseHandle(fSession);
inherited;
end { Destroy };
function tFtpAccess.GetDir: string;
var
buffer: array[0..MAX_PATH] of char;
bfsize: cardinal;
begin
result := '';
if fConnected then
begin
fillchar(buffer,MAX_PATH,0);
bfSize := MAX_PATH;
if ftpGetCurrentDirectory(fConnect,buffer,bfSize) then
result := buffer;
end;
end { GetDir };
function tFtpAccess.SetDir(WebDir: string): boolean;
begin
result := fConnected and
FtpSetCurrentDirectory(fConnect,pchar(WebDir));
end { SetDir };
function tFtpAccess.DeleteFile(WebName: string): boolean;
begin
result := fConnected and
FtpDeleteFile(fConnect,pchar(Webname));
end { DeleteFile };
//======================================================
// FileSize - Returns -1 if file doesn't exist
// max file size here is maxint
//------------------------------------------------------
function tFtpAccess.FileSize(WebName: string): integer;
var
f: hINTERNET;
begin
result := -1;
if fConnected then
begin
f := ftpOpenfile(fConnect,Pchar(WebName),
GENERIC_READ,
FTP_TRANSFER_TYPE_BINARY,
0);
if assigned(f) then
try
result := ftpGetFileSize(f,nil);
finally
InternetClosehandle(f);
end;
end;
end { FileSize };
function tFtpAccess.GetFile(WebName: string): string;
var
f: HInternet;
size: integer;
ndx: integer;
amtRead: cardinal;
abort: boolean;
avail: cardinal;
ok: boolean;
toRead: cardinal;
begin
abort := false;
result := '';
if fConnected then
begin
f := ftpOpenfile(fConnect, pchar(WebName),
GENERIC_READ,
FTP_TRANSFER_TYPE_BINARY,
0);
if assigned(f) then
try
size := ftpGetFileSize(f,nil);
setlength(result,size);
fillchar(result[1],size,0);
ndx := 1;
avail := size;
repeat
toRead := Avail;
if toread > Blocksize then
toRead := BlockSize;
amtRead := 0;
if InternetReadFile(f,@result[ndx],toRead,AmtRead) then
begin
dec(avail,AmtRead);
inc(ndx,AmtRead);
if assigned(fOnProgress) then
fOnProgress(WebName,ndx,size,abort);
end;
until (avail = 0) or (ndx >= size);
finally
InternetCloseHandle(f);
end;
end;
end { GetFile };
function tFtpAccess.PutFile(Source, RemoteName: string): boolean;
var
f: HInternet;
size: integer;
ndx: integer;
ToWrite: cardinal;
Written: cardinal;
abort: boolean;
begin
abort := false;
result := false;
if fConnected and (length(Source) > 0) then
begin
f := ftpOpenfile(fConnect, pchar(RemoteName),
GENERIC_WRITE,
FTP_TRANSFER_TYPE_BINARY,
0);
if assigned(f) then
try
size := length(source);
ndx := 1;
repeat
toWrite := Size - ndx + 1;
if toWrite > Blocksize then
toWrite := blocksize;
written := 0;
if InternetWriteFile(f,@source[ndx],toWrite,Written) then
begin
inc(ndx,Written);
if assigned(fOnProgress) then
fOnProgress(RemoteName,ndx,size,abort);
end;
until (Written < Blocksize) or (ndx > size);
result := true;
finally
InternetCloseHandle(f);
end;
end;
end { PutFile };
end.
