procedure StatusCallback(hInet: HINTERNET; Context, Status: DWORD; pInformation: Pointer; InfoLength: DWORD);
stdcall;
// Rückgabewerte der FTP-Aktionen
var
s :
string;
begin
case Status
of
// INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' + IntToStr(Integer(pInformation^)) + ' Byte';
// INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' + IntToStr(Integer(pInformation^)) + ' Byte';
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_load_firmware.lb_status.caption := s;
frm_load_firmware.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_load_firmware.LB_ftp_content.items.clear;
SetCursor(LoadCursor(0, IDC_WAIT));
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.List;
if (iIndySubDirLevel > 0)
then frm_load_firmware.LB_ftp_content.items.Insert(0, '
<DIR> ..');
end
else
begin
// WinInetFunktionen
frm_load_firmware.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_load_firmware.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_load_firmware.LB_ftp_content.items.add(fillString(sSaveBuffer, 24, true) + fillString(sSaveSize, 16, false));
end;
until not InternetFindNextFile(hFile, @finddata);
InternetCloseHandle(hFile);
end;
end;
SetCursor(LoadCursor(0, IDC_ARROW));
frm_load_firmware.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_load_firmware.lb_status.caption := '
aktuelles Verzeichnis ermitteln...';
Application.ProcessMessages;
lenDir := MAX_PATH;
FTPGetCurrentDirectory(hFTPSession, szDir, lenDir);
frm_load_firmware.lb_status.caption := '
aktuelles Verzeichnis anzeigen ... ';
lstrcat(szBuffer, szDir);
frm_load_firmware.ed_akt_ftp_dir.text := szDir;
Application.ProcessMessages;
GetDir;
end;
function Connect(szHost, szUser, szPW: pchar):boolean;
var bKrit1, bKrit2 : boolean;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Verbinden mit :' +
string(szhost));
SetCursor(LoadCursor(0, IDC_WAIT));
Application.ProcessMessages;
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// Zugangsdaten für alternativen FTP Client
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.host :=
string(szHost);
frm_load_firmware.NMFTP1.UserID :=
string(szUser);
frm_load_firmware.NMFTP1.password :=
string(szPW);
frm_load_firmware.NMFTP1.Connect;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then
begin
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.List;
bFtpConnectValid := true;
result := true;
end
else
begin
bFtpConnectValid := false;
result := false;
end;
end
else
begin
hIntSession := InternetOpen('
FTP-CLIENT', INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil, 0);
if hIntSession =
nil then
begin
frm_load_firmware.lb_status.caption := '
Internet-Session konnte nicht geöffnet werden';
result := false;
exit;
end
else
begin
InternetSetStatusCallback(hIntSession, @StatusCallback);
frm_load_firmware.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_load_firmware.lb_status.caption := '
FTP-Session konnte nicht geöffnet werden';
InternetCloseHandle(hIntSession);
result := false;
exit;
end
else
begin
frm_load_firmware.lb_status.caption := '
FTP-Session erfolgreich angelegt';
frm_load_firmware.lb_status.caption := '
aktuelles Verzeichnis anzeigen ...';
Application.ProcessMessages;
GetCurDir;
// Application.ProcessMessages;
// GetDir;
bKrit2 := true;
end;
if ((bKrit1 = true)
and (bKrit2 = true))
then result := true
else result := false;
end;
SetCursor(LoadCursor(0, IDC_ARROW));
end;
function ChangeDir(szDir : pchar) : boolean;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Verzeichniswechsel nach : ' +
string(szdir));
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
if (
string(szDir) = '
..')
then iIndySubDirLevel := iIndySubDirLevel - 1
else iIndySubDirLevel := iIndySubDirLevel + 1;
frm_load_firmware.NMFTP1.ChangeDir(
string(szDir));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
if (iIndySubDirLevel > 0)
then frm_load_firmware.LB_ftp_content.items.Insert(0, '
<DIR> ..');
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPSetCurrentDirectory(hFTPSession, szDir)
then
begin
frm_load_firmware.lb_status.caption := '
Verzeichnisinhalt ermitteln...';
Application.ProcessMessages;
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
GetCurDir;
result := true;
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis konnte nicht gewechselt werden';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
end;
function getFileSize(sFileName :
string) : integer;
// Ermittelt die Dateigröße in Byte der übergebenen Datei
// Wenn die Datei nicht erreichbar ist dann ist die Rückgabe 0
var
fs: TFileStream;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Dateigröße holen');
if FileExists(sFileName)
then
begin
try
fs := TFileStream.Create(sFileName, fmOpenRead
or fmShareDenyWrite);
Application.ProcessMessages;
result := fs.Size;
frm_load_firmware.MemoProtokoll.lines.add(inttostr(fs.Size) + '
Bytes');
fs.Free;
except
result :=0;
end;
end
else
begin
result := 0;
end;
end;
function UpLoad(pMyHomeFile, pMyRemoteFile : pchar) : boolean;
var iFileSize : integer;
begin
frm_load_firmware.MemoProtokoll.lines.add('
DateiUebertragung von: ' +
string(pMyRemotefile));
SetCursor(LoadCursor(0, IDC_WAIT));
iUpLoadedFileSize := 0;
iFileSize := getFileSize (
string(pMyHomeFile));
if (iFileSize > 0)
then
begin
frm_load_firmware.GaugeProgress.MaxValue := iFileSize;
frm_load_firmware.GaugeProgress.Progress := 0;
frm_load_firmware.GaugeProgress.Visible := true;
end;
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.Upload(
string(pMyHomeFile),
string(pMyRemoteFile));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPPutFile(hFTPSession, pMyHomeFile, pMyRemoteFile, FTP_TRANSFER_TYPE_BINARY, 1)
then
begin
frm_load_firmware.lb_status.caption := '
Datei erfolgreich hochgeladen';
result := true;
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Datei-Upload fehlgeschlagen';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
frm_load_firmware.lb_status.caption := '
Verzeichnisinhalt ermitteln...';
Application.ProcessMessages;
// GetDir;
frm_load_firmware.GaugeProgress.Visible := false;
SetCursor(LoadCursor(0, IDC_ARROW));
end;
function DelFile(szBuffer : pchar) : boolean;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Datei löschen: ' +
string(szBuffer));
frm_load_firmware.lb_status.caption := '
Datei wird gelöscht ...';
Application.ProcessMessages;
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.Delete(
string(szBuffer));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPDeleteFile(hFTPSession, szBuffer)
then
begin
frm_load_firmware.lb_status.caption := '
Datei gelöscht';
result := true;
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Datei konnte nicht gelöscht werden';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
// GetDir;
end;
function RenameFile(szOldName, szNewName : pchar) : boolean;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Datei umbenennen.');
frm_load_firmware.MemoProtokoll.lines.add('
Von: ' +
string(szOldName) + '
in: ' +
string(szNewName));
frm_load_firmware.lb_status.caption := '
Datei umbenennen ...';
Application.ProcessMessages;
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.Rename(
string(szOldName),
string(szNewName));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPRenameFile(hFTPSEssion, szOldName, szNewName)
then
begin
frm_load_firmware.lb_status.caption := '
Datei umbenannt';
result := true;
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Datei konnte nicht umbenannt werden';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
// GetDir;
end;
function DelDir(szBuffer : pchar) : boolean;
begin
frm_load_firmware.MemoProtokoll.lines.add('
Verzeichnis loeschen: ' +
string(szBuffer));
frm_load_firmware.lb_status.caption := '
Verzeichnis wird gelöscht ...';
Application.ProcessMessages;
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.RemoveDir(
string(szBuffer));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPRemoveDirectory(hFTPSession, szBuffer)
then
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis gelöscht';
result := true;
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis konnte nicht gelöscht werden';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
// GetDir;
end;
function MakeDir(szNewDir : pchar) : boolean;
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis anlegen ... ' ;
Application.ProcessMessages;
frm_load_firmware.MemoProtokoll.lines.add('
Verzeichnis anlegen: ' +
string(szNewdir));
if (frm_load_firmware.cb_use_different_ftp_on_dual_core.checked = true)
then
begin
// alternative Funktionen
iAktionsNummer := iAktionsNummer + 1;
sAktionsStatus := '
wait';
frm_load_firmware.NMFTP1.MakeDirectory(
string(szNewDir));
frm_load_firmware.LB_ftp_content.items.clear;
frm_load_firmware.NMFTP1.list;
// Auf Rückgabe warten
while (sAktionsStatus = '
wait')
do
begin
sleep(10);
Application.processMessages;
end;
// Rückgabewert setzen
if (sAktionsStatus = '
true')
then result := true
else result := false;
end
else
begin
// WinInetFunktionen
if FTPCreateDirectory(hFTPSEssion, szNewDir)
then
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis angelegt';
frm_load_firmware.MemoProtokoll.lines.add('
.. erfolgreich');
// GetDir;
result := true;
Application.ProcessMessages;
end
else
begin
frm_load_firmware.lb_status.caption := '
Verzeichnis konnte nicht angelegt werden';
result := false;
frm_load_firmware.MemoProtokoll.lines.add('
.. nicht erfolgreich');
Application.ProcessMessages;
end;
end;
end;
Antwort
4. Nov 2007, 19:33
Zitat von Time2Play:
" (Henning Richter)
Zitat
Linear-Darstellung
