On Wed, 25 Sep 1996 13:40:49 +0200, "Terje A. Bergesen"
Quote
<t.berge...@shell.no> wrote:
>After having tried the internet controls that come with Delphi 2.0
>and being disgusted at performance and documentation, I think I will
>go straight to wininet.dll.
>Has anybody out there had any experience programming with wininet.dll?
>Does anyone have pointers to things I ought to read before starting?
>Example code would be wonderful too :-)
You might want to start with a couple of fixes to wininet.pas.
The following is a corrected definition of some templates, based on
the wininet.h file in the inetsdk:
function InternetOpenA(lpszCallerName: PAnsiChar; dwAccessType: DWORD;
lpszServerName: PAnsiChar; lpszProxyBypass: PAnsiChar;
dwFlags: DWORD): HINTERNET; stdcall;
function InternetOpenW(lpszCallerName: PWideChar; dwAccessType: DWORD;
lpszServerName: PWideChar; lpszProxyBypass: PWideChar;
dwFlags: DWORD): HINTERNET; stdcall;
function InternetOpen(lpszCallerName: PChar; dwAccessType: DWORD;
lpszServerName: PChar; lpszProxyBypass: PChar;
dwFlags: DWORD): HINTERNET; stdcall;
The following are a couple of things you need if you'd like
InternetQueryOption and InternetSetOption to be usable:
function InternetQueryOptionA; external winetdll name
'InternetQueryOptionA';
function InternetQueryOptionW; external winetdll name
'InternetQueryOptionW';
function InternetQueryOption; external winetdll name
'InternetQueryOptionA';
function InternetSetOptionA; external winetdll name
'InternetSetOptionA';
function InternetSetOptionW; external winetdll name
'InternetSetOptionW';
function InternetSetOption; external winetdll name
'InternetSetOptionA';
Here's some initialization code -- apologies for it being a bit tacky
-- I just slapped it together to see if this stuff worked.
procedure initialize;
procedure setoption(const opname:string; op:dword; const
newval:dword);
var
oldval1,oldval2,dw:dword;
begin
dw := 4;
InternetQueryOption(hInet,op,addr(oldval1),dw);
InternetSetOption(hInet,op,addr(newval),dw);
InternetQueryOption(hInet,op,addr(oldval2),dw);
form1.ftprep(opname + ' set; was ' + inttostr(oldval1)
+ '; now ' + inttostr(oldval2));
end;
begin {initialize}
form1.FtpRep('(no ftp activity yet)');
version_last_checked := 0;
versioncheck_state := 0;
hInet := InternetOpen(nil,LOCAL_INTERNET_ACCESS,nil,nil,0);
if hInet = nil then
form1.displayit('InternetOpen failed; error = ' +
inttostr(getlasterror))
else
form1.displayit('InternetOpen successful');
setoption('Connect Timeout',INTERNET_OPTION_CONNECT_TIMEOUT,90000);
setoption('Connect Retries',INTERNET_OPTION_CONNECT_RETRIES,0);
setoption('Ctrl Recv
Timeout',INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT,90000);
setoption('Ctrl Send
Timeout',INTERNET_OPTION_CONTROL_SEND_TIMEOUT,90000);
setoption('Data Recv
Timeout',INTERNET_OPTION_DATA_RECEIVE_TIMEOUT,90000);
setoption('Data Send
Timeout',INTERNET_OPTION_DATA_SEND_TIMEOUT,90000);
form1.update;
suspend;
end;
And here's some connect/put/get code; for reference it's inside a
procedure that woke up, and found one or more files to be sent to the
destination. Again, apologies for the inelegance.
procedure getftpresponse;
begin
ftpresponsesize := 1000;
InternetGetLastResponseInfo(ftpresponsevalue,
ftpresponsestring,
ftpresponsesize);
form1.ftprep(ftpresponsestring);
end;
procedure main;
var
sending,
putresult,
renameresult,
getresult: boolean;
rslt:dword;
t:textfile;
s:string;
begin
fs_find_handle :=
windows.findfirstfile(pchar('DataToGo\*.*'),fs_find_data);
if fs_find_handle = INVALID_HANDLE_VALUE then exit;
while fs_find_data.dwfileattributes and file_attribute_directory =
file_attribute_directory do
if not windows.findnextfile(fs_find_handle, fs_find_data) then
exit;
form1.memo2.clear;
form1.ftprep('Connecting');
hFTP := InternetConnect(hInet,'tr_spi',21,'spitransfer','password',
INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);
if hFTP = nil then
begin
rslt := getlasterror;
getftpresponse;
form1.ftprep('Connection failed; lasterror = ' + inttostr(rslt));
exit;
end;
getftpresponse;
sending := true;
{ship files}
while sending do
begin
form1.ftprep('Shipafile: ' + fs_find_data.cFileName);
putresult := ftpputfile(hFTP,
pchar('DataToGo\' + fs_find_data.cFileName),
pchar(incomingdir + computername + tempfilesuffix),
FTP_TRANSFER_TYPE_BINARY + INTERNET_FLAG_DONT_CACHE,
0);
getftpresponse;
if putresult then
begin
form1.ftprep('putfile succeeded');
renameresult := ftprenamefile(hFTP,
pchar(incomingdir + computername + tempfilesuffix),
pchar(incomingdir + fs_find_data.cFileName));
if renameresult then
begin
form1.ftprep('rename succeeded');
if not form1.fsdiag1.checked then
deletefile('DataToGo\' + fs_find_data.cFileName);
end
else
form1.ftprep('rename failed');
end
else form1.ftprep('put failed');
sending := windows.findnextfile(fs_find_handle, fs_find_data);
end;
{receive and check version}
getresult := ftpgetfile(hFTP,
pchar(outgoingdir + '$version.txt'),
pchar('$version.txt'),
FALSE,
0,
FTP_TRANSFER_TYPE_ASCII + INTERNET_FLAG_DONT_CACHE,0);
if getresult then
begin
form1.ftprep('fileshipper_checkversion');
assignfile(t,'$version.txt');
reset(t);
readln(t,s);
closefile(t);
if s = myversion then
begin
version_last_checked := now;
InternetCloseHandle(hFTP);
exit;
end;
form1.displayit('Version changed: currently ' + myversion +
'; new version is ' + s);
end
else
form1.ftprep('getfile $version.txt failed');
InternetCloseHandle(hFTP);
end;
At least it all *seems* to work. Hope this helps someone.
