Registriert seit: 27. Mai 2005
Ort: Baden
315 Beiträge
Delphi 2007 Enterprise
|
Re: FTP upload ohne INDY ! Kann mir jemand das erklären ?
20. Okt 2006, 13:47
hey!
ich habe den code einwenig umgeändert damit man auch in das homeverzeichnis uploaden kann und man kann angeben ob man subfolders uploaden will
Delphi-Quellcode:
function UploadFolder(lpszServer, lpszUsername, lpszPassword, lpszLocalDirectory, lpszRemoteDirectory: String; UploadSubFolders: Boolean = True; 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 (szLastDirectory <> '') then
begin
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;
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 UploadSubFolders then
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;
end;
until not (FindNextFile(hFindFile, lpFindFileData));
Windows.FindClose(hFindFile);
if (szLastDirectory <> '') then
begin
// cd ..
if not FtpSetCurrentDirectory(hConnect, '..') then
begin
MessageBox(HWND_DESKTOP, PChar(Format(sErrorDirectorySet, ['..'])), 'Error', MB_ICONERROR);
Exit;
end;
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;
Hier ist die erklärung:
Delphi-Quellcode:
function UploadFolder(
lpszServer, // Server Adresse, z.b. xyz.meineseite.de
lpszUsername, // Username ..
lpszPassword, // Password ..
lpszLocalDirectory, // Lokaler Ordner, also der der raufgeladen werden soll
lpszRemoteDirectory: String; // Ordner der auf den server, z.B '' ist das Homeverzeichnis, der Ordner muss nicht existieren auf den Server (es wird zuerst versucht ihn zu erstellen)
UploadSubFolders: Boolean = True; // Angeben ob man will das Unterordner raufgeladen werden auf den Server
wPort: Word = 21) // Port vom Server
: Boolean;
Ich habe die funktion getestet auf funpic.de, und es scheint perfekt zu funktionieren, hast du rechte um Ordner zu erstellen oder so? Falls nicht, versuch mit lpszRemoteDirectory = ''.
|