procedure StatusCallback(hInet: HINTERNET; Context, Status: DWORD; pInformation: Pointer; InfoLength: DWORD);
stdcall;
// Rückgabewerte der FTP-Aktionen
var s :
string;
begin
s := '
';
case Status
of
INTERNET_STATUS_REQUEST_SENT:
begin
iUpLoadedFileSize := iUpLoadedFileSize + Integer(pInformation^);
s := '
Bisher wurden ' + formatIntValue(iUpLoadedFileSize) + '
Byte übertragen.';
end;
INTERNET_STATUS_RESPONSE_RECEIVED:
begin
iDownLoadedFileSize := iDownLoadedFileSize + Integer(pInformation^);
s := '
Bisher wurden ' + IntToStr(iDownLoadedFileSize) + '
Byte empfangen.';
end;
end;
if (s <> '
')
then
begin
frm_transfer_confWareInfo.lb_status.caption := s;
frm_transfer_confWareInfo.GaugeProgress.Progress := iUpLoadedFileSize;
Application.ProcessMessages;
end;
end;
procedure GetDir;
var
szBuffer:
array[0..1024]
of Char;
sSaveBuffer, sSaveSize :
string;
finddata: TWin32FindData;
hFile : HINTERNET;
begin
frm_transfer_confWareInfo.LB_ftp_content.items.clear;
SetCursor(LoadCursor(0, IDC_WAIT));
// WinInetFunktionen
frm_transfer_confWareInfo.LB_ftp_content.items.add('
[..]');
lstrcpy(szBuffer, finddata.cFilename);
// Verzeichnisse
hFile := FTPFindFirstFile(hFTPSession, '
*.*', finddata, 0, 0);
if (hFile <>
nil)
then
begin
repeat
if (finddata.dwFileAttributes
and not FILE_ATTRIBUTE_DIRECTORY = 0)
then
begin
lstrcpy(szBuffer, finddata.cFilename);
frm_transfer_confWareInfo.LB_ftp_content.items.add('
[' +
string(szBuffer) + '
]');
end;
until not InternetFindNextFile(hFile, @finddata);
InternetCloseHandle(hFile);
end;
// Dateien
hFile := FTPFindFirstFile(hFTPSession, '
*.*', finddata, 0, 0);
if (hFile <>
nil)
then
begin
repeat
if (finddata.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY = 0)
then
begin
lstrcpy(szBuffer, finddata.cFilename);
sSaveBuffer :=
string(szBuffer);
sSaveSize := formatIntValue(finddata.nFileSizeLow);
frm_transfer_confWareInfo.LB_ftp_content.items.add(fillString(sSaveBuffer, 24, true) + fillString(sSaveSize, 16, false));
end;
until not InternetFindNextFile(hFile, @finddata);
InternetCloseHandle(hFile);
end;
SetCursor(LoadCursor(0, IDC_ARROW));
frm_transfer_confWareInfo.MemoProtokoll.lines.add('
Hole Verzeichnisinhalt');
end;
procedure GetCurDir;
const LEN_CUR_DIR = 23;
// Length('aktuelles Verzeichnis: ')
var szBuffer, szDir:
array[0..MAX_PATH - 1 + LEN_CUR_DIR]
of Char;
lenDir: DWORD;
begin
frm_transfer_confWareInfo.lb_status.caption := '
aktuelles Verzeichnis ermitteln...';
Application.ProcessMessages;
lenDir := MAX_PATH;
FTPGetCurrentDirectory(hFTPSession, szDir, lenDir);
frm_transfer_confWareInfo.lb_status.caption := '
aktuelles Verzeichnis anzeigen ... ';
lstrcat(szBuffer, szDir);
frm_transfer_confWareInfo.MemoProtokoll.lines.add('
Aktuelles FTP-Verzeichnis:');
frm_transfer_confWareInfo.MemoProtokoll.lines.add(szDir);
Application.ProcessMessages;
GetDir;
end;
function Connect(szHost, szUser, szPW: pchar):boolean;
var bKrit1, bKrit2 : boolean;
begin
frm_transfer_confWareInfo.MemoProtokoll.lines.add('
Verbinden mit :' +
string(szhost));
SetCursor(LoadCursor(0, IDC_WAIT));
Application.ProcessMessages;
hIntSession := InternetOpen('
FTP-CLIENT', INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil, 0);
if (hIntSession =
nil)
then
begin
frm_transfer_confWareInfo.lb_status.caption := '
Internet-Session konnte nicht geöffnet werden';
result := false;
exit;
end
else
begin
InternetSetStatusCallback(hIntSession, @StatusCallback);
frm_transfer_confWareInfo.lb_status.caption := '
Internet-Session erfolgreich angelegt';
bKrit1 := true;
end;
hFTPSession := InternetConnect(hIntSession, szHost, INTERNET_DEFAULT_FTP_PORT, szUser, szPW, INTERNET_SERVICE_FTP, 0, 0);
if (hFTPSession =
nil)
then
begin
frm_transfer_confWareInfo.lb_status.caption := '
FTP-Session konnte nicht geöffnet werden';
InternetCloseHandle(hIntSession);
result := false;
exit;
end
else
begin
frm_transfer_confWareInfo.lb_status.caption := '
FTP-Session erfolgreich angelegt';
frm_transfer_confWareInfo.lb_status.caption := '
aktuelles Verzeichnis anzeigen ...';
Application.ProcessMessages;
GetCurDir;
bKrit2 := true;
end;
if ((bKrit1 = true)
and (bKrit2 = true))
then result := true
else result := false;
SetCursor(LoadCursor(0, IDC_ARROW));
end;