Registriert seit: 27. Mai 2005
Ort: Baden
315 Beiträge
Delphi 2007 Enterprise
|
Re: FTP upload ohne INDY ! Kann mir jemand das erklären ?
18. Okt 2006, 17:19
hey
ich hab diese funktion grad für dich gemacht, ist nicht ganz fertig, ich ändere es später wieder wenn ich wieder komme (falls ich fehler finde), ich muss jetzt wieder los
Edit:
Code geändert und getestet, alles funktioniert wunderbar
Delphi-Quellcode:
function UploadFolder(lpszServer, lpszUsername, lpszPassword, lpszLocalDirectory, lpszRemoteDirectory: String; wPort: Word = 21): Boolean;
const
sErrorDirectoryUpload = 'Das Verzeichnis "%s" konnte nicht auf den Server geladen werden!';
sErrorDirectoryCreate = 'Das Verzeichnis "%s" konnte nicht auf dem Server erstellt werden!';
sErrorDirectorySet = 'Es konnte nicht in das Verzeichnis "%s" gewechselt werden!';
sErrorFileCreate = 'Datei "%s%s" konnte nicht erstellt werden!';
var
hOpen, hConnect: HINTERNET;
function UploadDirectory(lpszPath, lpszRemote: String): Boolean;
var
lpFindFileData: TWIN32FindData;
hFindFile: THandle;
szLastDirectory: String;
begin
Result := False;
lpszPath := IncludeTrailingPathDelimiter(lpszPath);
// wir brauchen hier den Namen vom letzten Verzeichnis, also den den wir gerade durchsuchen, um dann FtpSetCurrentDIrectory
// aufzurufen.
lpszRemote := ExcludeTrailingPathDelimiter(lpszRemote);
if LastDelimiter('\', lpszRemote) > 0 then
szLastDirectory := Copy(lpszRemote, LastDelimiter('\', lpszRemote) +1, Length(lpszRemote))
else
if LastDelimiter('/', lpszRemote) > 0 then
szLastDirectory := Copy(lpszRemote, LastDelimiter('/', lpszRemote) +1, Length(lpszRemote))
else
szLastDirectory := lpszRemote;
lpszRemote := IncludeTrailingPathDelimiter(lpszRemote);
if not FtpCreateDirectory(hConnect, PChar(szLastDirectory)) then
begin
// Verzeichnis konnte nicht erstellt werden, versuche noch in das Verzeichnis zu wechseln
if not FtpSetCurrentDirectory(hConnect, PChar(szLastDirectory)) then
begin
MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectoryCreate, [szLastDirectory])), 'Error', MB_ICONERROR);
Exit;
end;
end else
begin
// Verzeichnis setzen, in dem wir Arbeiten
if not FtpSetCurrentDirectory(hConnect, PChar(szLastDirectory)) then
begin
MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, [szLastDirectory])), 'Error', MB_ICONERROR);
Exit;
end;
end;
// Prüfen ob das Verzeichnis auf dem lokalen PC existiert.
if DirectoryExists(lpszPath) then
begin
hFindFile := FindFirstFile(PChar(lpszPath + '*.*'), lpFindFileData);
if (hFindFile <> INVALID_HANDLE_VALUE) then
begin
repeat
if ((String(lpFindFileData.cFileName) = '.') or (String(lpFindFileData.cFileName) = '..')) then
continue;
// Dateien vom Verzeichnis uploaden ...
if (lpFindFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0) then
begin
if not FtpPutFile(hConnect,
PChar(Format('%s%s', [lpszPath, lpFindFileData.cFileName])),
PChar(Format('%s', [lpFindFileData.cFileName])), FTP_TRANSFER_TYPE_UNKNOWN, 0) then
begin
// Datei konnte nicht erstellt werden!
MessageBox(HWND_DESKTOP, PChar(Format(sErrorFileCreate, [lpszRemote, lpFindFileData.cFileName])), 'Error', MB_ICONERROR);
Windows.FindClose(hFindFile);
Exit;
end;
end else
// Ein Verzeichnis wurde gefunden also in das Verzeichnis wechseln und dort die Dateien suchen und die dann uploaden ..
begin
if not UploadDirectory(Format('%s%s', [lpszPath, lpFindFileData.cFileName]),
Format('%s%s', [lpszRemote, lpFindFileData.cFileName])) then
begin
MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectoryUpload, [lpszPath])), 'Error', MB_ICONERROR);
Exit;
end;
end;
until not (FindNextFile(hFindFile, lpFindFileData));
Windows.FindClose(hFindFile);
// cd ..
if not FtpSetCurrentDirectory(hConnect, '..') then
begin
MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, ['..'])), 'Error', MB_ICONERROR);
Exit;
end;
Result := True;
end;
end;
end;
begin
Result := False;
hOpen := InternetOpen('MyAgent', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
if (hOpen <> nil) then
begin
hConnect := InternetConnect(hOpen, PChar(lpszServer), wPort, PChar(lpszUsername), PChar(lpszPassword),
INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
if (hConnect <> nil) then
begin
Result := UploadDirectory(lpszLocalDirectory, lpszRemoteDirectory);
InternetCloseHandle(hConnect);
InternetCloseHandle(hOpen);
end;
end;
end;
Beispiel aufruf:
Delphi-Quellcode:
if UploadFolder('meinserver.de', 'admin', 'r00t', 'c:\tmp', 'etc') then
showmessage('Verzeichnis wurde auf den server geuppt!');
|