Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 21.08.2007, 11:46   #1
Gambler
Игрок
Форумчанин
 
Аватар для Gambler
 
Регистрация: 29.10.2006
Сообщений: 367
Репутация: 99
По умолчанию Минимальное приложение для загрузки файла на FTP

Привет всем! Не буду много писать, так как до конца все равно не дочитаете :-) Сразу вопрос: как залить файл на FTP. НО, есть одно но, приложение должно быть очень маленьким! Я делал через idFTP получается громоздко. Без формы и сторонних библиотек - где то 170 кб. Это много. Если у кого есть исходник - киньте пожалуйста. Заранее благодарен!
__________________
Жизнь всегда игра. Но смерть - не всегда поражение.

#define true (Math.random()>0.5) //Удачной отладки
Gambler вне форума   Ответить с цитированием
Старый 21.08.2007, 13:04   #2
Квэнди
Профессионал
 
Аватар для Квэнди
 
Регистрация: 13.12.2006
Адрес: Москва
Сообщений: 3,859
Репутация: 1192

icq: 637233
По умолчанию

Это пример загрузки с FTP:
Код:

uses 
  WinInet, ComCtrls; 

function FtpDownloadFile(strHost, strUser, strPwd: string; 
  Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean; 

  function FmtFileSize(Size: Integer): string; 
  begin 
    if Size >= $F4240 then 
      Result := Format('%.2f', [Size / $F4240]) + ' Mb' 
    else 
    if Size < 1000 then 
      Result := IntToStr(Size) + ' bytes' 
    else 
      Result := Format('%.2f', [Size / 1000]) + ' Kb'; 
  end; 

const 
  READ_BUFFERSIZE = 4096;  // or 256, 512, ... 
var 
  hNet, hFTP, hFile: HINTERNET; 
  buffer: array[0..READ_BUFFERSIZE - 1] of Char; 
  bufsize, dwBytesRead, fileSize: DWORD; 
  sRec: TWin32FindData; 
  strStatus: string; 
  LocalFile: file; 
  bSuccess: Boolean; 
begin 
  Result := False; 

  { Open an internet session } 
  hNet := InternetOpen('Program_Name', // Agent 
                        INTERNET_OPEN_TYPE_PRECONFIG, // AccessType 
                        nil,  // ProxyName 
                        nil, // ProxyBypass 
                        0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE 

  { 
    Agent contains the name of the application or 
    entity calling the Internet functions 
  } 


  { See if connection handle is valid } 
  if hNet = nil then 
  begin 
    ShowMessage('Unable to get access to WinInet.Dll'); 
    Exit; 
  end; 

  { Connect to the FTP Server } 
  hFTP := InternetConnect(hNet, // Handle from InternetOpen 
                          PChar(strHost), // FTP server 
                          port, // (INTERNET_DEFAULT_FTP_PORT), 
                          PChar(StrUser), // username 
                          PChar(strPwd),  // password 
                          INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher? 
                          0, // flag: 0 or INTERNET_FLAG_PASSIVE 
                          0);// User defined number for callback 

  if hFTP = nil then 
  begin 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Host "%s" is not available',[strHost])); 
    Exit; 
  end; 

  { Change directory } 
  bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir)); 

  if not bSuccess then 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Cannot set directory to %s.',[ftpDir])); 
    Exit; 
  end; 

  { Read size of file } 
  if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then 
  begin 
    fileSize := sRec.nFileSizeLow; 
    // fileLastWritetime := sRec.lastWriteTime 
  end else 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Cannot find file ',[ftpFile])); 
    Exit; 
  end; 

  { Open the file } 
  hFile := FtpOpenFile(hFTP, // Handle to the ftp session 
                       PChar(ftpFile), // filename 
                       GENERIC_READ, // dwAccess 
                       FTP_TRANSFER_TYPE_BINARY, // dwFlags 
                       0); // This is the context used for callbacks. 

  if hFile = nil then 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    Exit; 
  end; 

  { Create a new local file } 
  AssignFile(LocalFile, TargetFile); 
  {$i-} 
  Rewrite(LocalFile, 1); 
  {$i+} 

  if IOResult <> 0 then 
  begin 
    InternetCloseHandle(hFile); 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    Exit; 
  end; 

  dwBytesRead := 0; 
  bufsize := READ_BUFFERSIZE; 

  while (bufsize > 0) do 
  begin 
    Application.ProcessMessages; 

    if not InternetReadFile(hFile, 
                            @buffer, // address of a buffer that receives the data 
                            READ_BUFFERSIZE, // number of bytes to read from the file 
                            bufsize) then Break; // receives the actual number of bytes read 

    if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then 
      BlockWrite(LocalFile, buffer, bufsize); 
    dwBytesRead := dwBytesRead + bufsize; 

    { Show Progress } 
    ProgressBar.Position := Round(dwBytesRead * 100 / fileSize); 
    Form1.Label1.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]); 
  end; 

  CloseFile(LocalFile); 

  InternetCloseHandle(hFile); 
  InternetCloseHandle(hFTP); 
  InternetCloseHandle(hNet); 
  Result := True;

__________________
ICQ не для вопросов, а для предложений. Для вопросов используйте форум
IRC канал клуба программистов|Мои статьи
Квэнди вне форума   Ответить с цитированием
Старый 21.08.2007, 18:23   #3
Gambler
Игрок
Форумчанин
 
Аватар для Gambler
 
Регистрация: 29.10.2006
Сообщений: 367
Репутация: 99
По умолчанию

Спасибо конечно, тоже нужная вещь, но мне то надо наоборот, загрузка с компа на сервер.
__________________
Жизнь всегда игра. Но смерть - не всегда поражение.

#define true (Math.random()>0.5) //Удачной отладки
Gambler вне форума   Ответить с цитированием
Старый 21.08.2007, 18:43   #4
Квэнди
Профессионал
 
Аватар для Квэнди
 
Регистрация: 13.12.2006
Адрес: Москва
Сообщений: 3,859
Репутация: 1192

icq: 637233
По умолчанию

Логично, а нажать F1 не пробовали ?
FtpPutFile
Stores a file on the FTP server.

BOOL FtpPutFile(
HINTERNET hConnect,
LPCTSTR lpszLocalFile,
LPCTSTR lpszNewRemoteFile,
DWORD dwFlags,
DWORD_PTR dwContext
);

Parameters
hConnect
[in] Handle to an FTP session.
lpszLocalFile
[in] Pointer to a null-terminated string that contains the name of the file to be sent from the local system.
lpszNewRemoteFile
[in] Pointer to a null-terminated string that contains the name of the file to be created on the remote system.
dwFlags
[in] Conditions under which the transfers occur. The application should select one transfer type and any of the flags that control how the caching of the file will be controlled.
The transfer type can be any one of the following values.

Value Meaning
FTP_TRANSFER_TYPE_ASCII Transfers the file using FTP's ASCII (Type A) transfer method. Control and formatting information is converted to local equivalents.
FTP_TRANSFER_TYPE_BINARY Transfers the file using FTP's Image (Type I) transfer method. The file is transferred exactly as it exists with no changes. This is the default transfer method.
FTP_TRANSFER_TYPE_UNKNOWN Defaults to FTP_TRANSFER_TYPE_BINARY.
INTERNET_FLAG_TRANSFER_ASCII Transfers the file as ASCII.
INTERNET_FLAG_TRANSFER_BINARY Transfers the file as binary.


The following values are used to control the caching of the file. The application can use one or more of the following values.


Value Meaning
INTERNET_FLAG_HYPERLINK Forces a reload if there was no Expires time and no LastModified time returned from the server when determining whether to reload the item from the network.
INTERNET_FLAG_NEED_FILE Causes a temporary file to be created if the file cannot be cached.
INTERNET_FLAG_RELOAD Forces a download of the requested file, object, or directory listing from the origin server, not from the cache.
INTERNET_FLAG_RESYNCHRONIZE Reloads HTTP resources if the resource has been modified since the last time it was downloaded. All FTP and Gopher resources are reloaded.

dwContext
[in] Pointer to a variable that contains the application-defined value that associates this search with any application data. This parameter is used only if the application has already called InternetSetStatusCallback to set up a status callback.
Return Values
Returns TRUE if successful, or FALSE otherwise. To get a specific error message, call GetLastError.
Remarks
FtpPutFile is a high-level routine that handles all the bookkeeping and overhead associated with reading a file locally and storing it on an FTP server. An application that needs to send file data only, or that requires close control over the file transfer, should use the FtpOpenFile and InternetWriteFile functions.

If the dwFlags parameter specifies FILE_TRANSFER_TYPE_ASCII, translation of the file data converts control and formatting characters to local equivalents.

Both lpszNewRemoteFile and lpszLocalFile can be either partially or fully qualified file names relative to the current directory.

Requirements
Client: Included in Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0, Windows Me, Windows 98, and Windows 95.
Server: Included in Windows Server 2003, Windows 2000 Server, and Windows NT Server 4.0.
Version: Requires Internet Explorer 3.0 or later.
Header: Declared in Wininet.h.
Library: Use Wininet.lib.
__________________
ICQ не для вопросов, а для предложений. Для вопросов используйте форум
IRC канал клуба программистов|Мои статьи
Квэнди вне форума   Ответить с цитированием
Старый 21.08.2007, 19:32   #5
Gambler
Игрок
Форумчанин
 
Аватар для Gambler
 
Регистрация: 29.10.2006
Сообщений: 367
Репутация: 99
По умолчанию

Спасибо. Но у меня нет клавиши F1 на телефоне. Я сейчас отдыхаю на море, и все приходится писать исключительно на листочке. Так что не обижайся. ;-)
__________________
Жизнь всегда игра. Но смерть - не всегда поражение.

#define true (Math.random()>0.5) //Удачной отладки
Gambler вне форума   Ответить с цитированием
Старый 21.08.2007, 19:36   #6
Квэнди
Профессионал
 
Аватар для Квэнди
 
Регистрация: 13.12.2006
Адрес: Москва
Сообщений: 3,859
Репутация: 1192

icq: 637233
По умолчанию

Мда, мсьё знает толк в извращениях (с) =)
__________________
ICQ не для вопросов, а для предложений. Для вопросов используйте форум
IRC канал клуба программистов|Мои статьи
Квэнди вне форума   Ответить с цитированием
Старый 29.01.2008, 23:58   #7
FAiver
Форумчанин
 
Аватар для FAiver
 
Регистрация: 13.07.2007
Сообщений: 60
Репутация: 30
По умолчанию

короче вот ещё вариант не мой но зато маленький....
Код:

//*Simple Uploader coded by LEE_ROY*//

program out;
     
{..$apptype console}
uses
  windows,
  wininet;

var
 conn_param,inet_open : hinternet;

procedure upload(filename:pchar; ftpfilename:pchar);
const
port=21;
begin
 inet_open := internetopen('iexplore',INTERNET_OPEN_TYPE_DIRECT,nil,nil,0);
//Настройки коннекта( фтп, логин, пасс)
 conn_param := internetconnect(inet_open,'ftp.site.ru',port,'login','pass',INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);
sleep(100);
 ftpputfile(conn_param,filename,ftpfilename,FTP_TRANSFER_TYPE_UNKNOWN,0);
 internetclosehandle(conn_param);
 internetclosehandle(inet_open) ;
END;

begin
//Путь к файлу для загрузки, имя файла на фтп..
upload('C:\file.zip','/pub/file.zip');
if True then
exit;
end.

после сжатия UPX получается 2кб

а вот у меня вопрос!
Как мне проверить правильность логина, пароля?

Последний раз редактировалось FAiver; 30.01.2008 в 00:09.
FAiver вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
WebBrowser1 завершение загрузки Черничный Компоненты Delphi 10 26.08.2008 01:32
Приложение грузится до загрузки windows Gromover Win Api 6 07.04.2008 19:35
Три квадратных уравнения. Найти минимальное значение среди действительных корней этих уравнений. Паскаль. GE076 Помощь студентам 2 17.12.2007 21:41
отслеживание загрузки программы ГОСЕАН Общие вопросы Delphi 4 13.12.2007 19:04
как запустить приложение из к примеру текст файла!!! Volkogriz Общие вопросы Delphi 12 12.10.2007 12:27


04:21.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru