Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.04.2011, 17:36
Alex_Gordon Alex_Gordon вне форума
Прохожий
 
Регистрация: 21.02.2011
Сообщения: 19
Репутация: 10
По умолчанию Проверка FTP сервера

Подскажите пожалуйста, как реализовать проверку ftp сервера на его состояние? То есть, если он активен - то лэйбл показывает одно, если не активен - другое.
Ответить с цитированием
  #2  
Старый 15.04.2011, 17:44
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Если коннект к серверу не прошел - не активен. Или я неправильно понял?
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #3  
Старый 15.04.2011, 17:49
Alex_Gordon Alex_Gordon вне форума
Прохожий
 
Регистрация: 21.02.2011
Сообщения: 19
Репутация: 10
По умолчанию

Поняли вы правильно, но мне немного непонятен код. Использую инди.

Последний раз редактировалось Alex_Gordon, 15.04.2011 в 17:55.
Ответить с цитированием
  #4  
Старый 15.04.2011, 18:01
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Если произошла ошибка при подключении - анализировать что за ошибка.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #5  
Старый 15.04.2011, 18:22
Alex_Gordon Alex_Gordon вне форума
Прохожий
 
Регистрация: 21.02.2011
Сообщения: 19
Репутация: 10
По умолчанию

Можете помочь мне с кодом?
Ответить с цитированием
  #6  
Старый 15.04.2011, 18:55
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Код:
var
  ClientSocket1: TClientSocket;
begin
  ClientSocket1:=TClientSocket.Create(Self);
  ClientSocket1.ClientType:=ctBlocking;
  ClientSocket1.Port:=21;
  ClientSocket1.Host:='ftp.narod.ru';
  ClientSocket1.Open;
//  ClientSocket1.Socket.SendText('HELO');
end;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #7  
Старый 15.04.2011, 19:45
Assistant Assistant вне форума
Продвинутый
 
Регистрация: 20.02.2011
Адрес: там где правят идиоты
Сообщения: 603
Версия Delphi: 7
Репутация: выкл
По умолчанию

добавление к коду NumLock:
Код:
var
  ClientSocket1: TClientSocket;
begin
  ClientSocket1 := TClientSocket.Create(Self);
  ClientSocket1.ClientType := ctBlocking;
  ClientSocket1.Port := 21;
  ClientSocket1.Host := 'ftp.narod.ru';
  try
    ClientSocket1.Open;
    ShowMessage('доступен');
  finally
    ClientSocket1.Free;
  except
    ClientSocket1.Free;
    ShowMessage('поломат :o(');
  end;
end;

P.S.: в живую не проверял, но смысл должен быть понятен
__________________
взялся из неоткуда, ничего не прошу, помогаю просто так
ICQ: 593977748 - стучать в случае КРАЙНЕЙ необходимости, ну, или если вы со Ставрополя

Последний раз редактировалось Assistant, 15.04.2011 в 19:48.
Ответить с цитированием
  #8  
Старый 15.04.2011, 20:09
Alex_Gordon Alex_Gordon вне форума
Прохожий
 
Регистрация: 21.02.2011
Сообщения: 19
Репутация: 10
По умолчанию

А без ClientSocket реально?
Ответить с цитированием
  #9  
Старый 15.04.2011, 20:12
Assistant Assistant вне форума
Продвинутый
 
Регистрация: 20.02.2011
Адрес: там где правят идиоты
Сообщения: 603
Версия Delphi: 7
Репутация: выкл
По умолчанию

ага, реально, на WinSock, это WinAPI, советую погуглить, там много решений будет по работе с этим.

P.S.: ClientSocket по сути просто обвёртка для WinSock.
__________________
взялся из неоткуда, ничего не прошу, помогаю просто так
ICQ: 593977748 - стучать в случае КРАЙНЕЙ необходимости, ну, или если вы со Ставрополя

Последний раз редактировалось Assistant, 15.04.2011 в 20:19.
Ответить с цитированием
  #10  
Старый 15.04.2011, 20:36
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Код:
unit SimpleClientSocket;

interface

{$DEBUGINFO OFF}

uses
  WinSock,
  Windows,
  SysUtils,
  Classes;

type
  TSimpleClientSocket = class(TComponent)
  private
    FAddress: String;
    FHost: String;
    FPort: Integer;
    FTimeOutRead: Cardinal;
    FTimeOutWrite: Cardinal;
    FTimeOutConnect: Cardinal;
    FSocket: TSocket;
    FCriticalSection: TRTLCriticalSection;
    FEvent: THandle;
    function GetConnected: Boolean;
    procedure Lock;
    procedure Unlock;
  public
    property Connected: Boolean read GetConnected;
    property SocketHandle: TSocket read FSocket;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
{
    function ReceiveBuf(var Buf; Count: Integer): Integer;
    function SendBuf(var Buf; Count: Integer): Integer;
}
    function recv(var Buf; Count: Integer): Integer;
    function send(var Buf; Count: Integer): Integer;
    procedure Write(s: String);
    procedure Writeln(s: String);
    function Read: Char;
    function Readln: String;
  published
    property Address: String read FAddress write FAddress;
    property Host: String read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property TimeOutRead: Cardinal read FTimeOutRead write FTimeOutRead;
    property TimeOutWrite: Cardinal read FTimeOutWrite write FTimeOutWrite;
    property TimeOutConnect: Cardinal read FTimeOutConnect write FTimeOutConnect;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Internet', [TSimpleClientSocket]);
end;

constructor TSimpleClientSocket.Create(AOwner: TComponent);
var
  WSAData: TWSAData;
begin
  inherited Create(AOwner);
  if WSAStartup($0101, WSAData)<>0 then
    raise Exception.Create('WSAStartup(): '+SysErrorMessage(WSAGetLastError));
  FAddress:='';
  FHost:='';
  FPort:=0;
  FTimeOutRead:=60000;
  FTimeOutWrite:=60000;
  FTimeOutConnect:=60000;
  FSocket:=INVALID_SOCKET;
  InitializeCriticalSection(FCriticalSection);
  FEvent:=CreateEvent(nil, True, False, nil);
end;

destructor TSimpleClientSocket.Destroy;
begin
  Close;
  CloseHandle(FEvent);
  DeleteCriticalSection(FCriticalSection);
  if WSACleanup<>0 then
    raise Exception.Create('WSACleanup(): '+SysErrorMessage(WSAGetLastError));
  inherited Destroy;
end;

function TSimpleClientSocket.GetConnected: Boolean;
begin
  Result:=FSocket<>INVALID_SOCKET;
end;

procedure TSimpleClientSocket.Lock;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TSimpleClientSocket.Unlock;
begin
  LeaveCriticalSection(FCriticalSection);
end;

procedure TSimpleClientSocket.Open;
var
  FAddr: sockaddr_in;
  HostEnt: PHostEnt;
  InAddr: in_addr;
  arg: Integer;
  ErrorCode: Integer;
  FDSetW: TFDSet;
  FDSetE: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket<>INVALID_SOCKET then
    raise Exception.Create('Socket already open');
  FSocket:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('socket(): '+SysErrorMessage(WSAGetLastError));
  try
    FAddr.sin_family:=AF_INET;
    FAddr.sin_port:=htons(FPort);
    if FHost<>'' then
    begin
      FillChar(InAddr, SizeOf(InAddr), 0);
      HostEnt:=gethostbyname(PChar(FHost));
      if HostEnt<>nil then
      begin
        InAddr.S_un_b.s_b1:=HostEnt^.h_addr^[0];
        InAddr.S_un_b.s_b2:=HostEnt^.h_addr^[1];
        InAddr.S_un_b.s_b3:=HostEnt^.h_addr^[2];
        InAddr.S_un_b.s_b4:=HostEnt^.h_addr^[3];
        FAddr.sin_addr:=InAddr;
      end else raise Exception.Create('gethostbyname()');
    end else if FAddress<>'' then
      FAddr.sin_addr.S_addr:=inet_addr(PChar(FAddress))
    else raise Exception.Create('No address specified');
    arg:=1;
    ioctlsocket(FSocket, FIONBIO, arg);
    if connect(FSocket, FAddr, SizeOf(FAddr))<>0 then
    begin
      ErrorCode:=WSAGetLastError;
      if ErrorCode<>WSAEWOULDBLOCK then
        raise Exception.Create('connect(): '+SysErrorMessage(ErrorCode));
      FD_ZERO(FDSetW);
      FD_ZERO(FDSetE);
      FD_SET(FSocket, FDSetW);
      FD_SET(FSocket, FDSetE);
      TimeVal.tv_sec:=FTimeOutConnect div 1000;
      TimeVal.tv_usec:=(FTimeOutConnect mod 1000)*1000;
      select(0, nil, @FDSetW, @FDSetE, @TimeVal);
      if not FD_ISSET(FSocket, FDSetW) then
        raise Exception.Create('connect(): timeout');
    end;
    arg:=0;
    ioctlsocket(FSocket, FIONBIO, arg);
  except
    Close;
    raise;
  end;
end;

procedure TSimpleClientSocket.Close;
begin
  Lock;
  try
    if FSocket<>INVALID_SOCKET then
    begin
      if closesocket(FSocket)<>0 then
        raise Exception.Create('closesocket(): '+SysErrorMessage(WSAGetLastError));
      FSocket:=INVALID_SOCKET;
    end;
  finally
    Unlock;
  end;
end;
{
function TSimpleClientSocket.ReceiveBuf(var Buf; Count: Integer): Integer;
var
  Overlapped: TOverlapped;
  ErrorCode: Integer;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('recv(): invalid socket');
  FillChar(OVerlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent:=FEvent;
  if not ReadFile(FSocket, Buf, Count, DWORD(Result), @Overlapped) then
  begin
    if GetLastError<>ERROR_IO_PENDING then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('recv(): '+SysErrorMessage(ErrorCode));
    end;
    if WaitForSingleObject(FEvent, FTimeOutRead)<>WAIT_OBJECT_0 then
    begin
      Close;
      raise Exception.Create('recv(): timeout');
    end;
    if not GetOverlappedResult(FSocket, Overlapped, DWORD(Result), False) then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('recv(): '+SysErrorMessage(ErrorCode));
    end;
  end;
end;

function TSimpleClientSocket.SendBuf(var Buf; Count: Integer): Integer;
var
  Overlapped: TOverlapped;
  ErrorCode: Integer;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('send(): invalid socket');
  FillChar(OVerlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent:=FEvent;
  if not WriteFile(FSocket, Buf, Count, DWORD(Result), @Overlapped) then
  begin
    if GetLastError<>ERROR_IO_PENDING then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('send(): '+SysErrorMessage(ErrorCode));
    end;
    if WaitForSingleObject(FEvent, FTimeOutWrite)<>WAIT_OBJECT_0 then
    begin
      Close;
      raise Exception.Create('send(): timeout');
    end;
    if not GetOverlappedResult(FSocket, Overlapped, DWORD(Result), False) then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('send(): '+SysErrorMessage(ErrorCode));
    end;
  end;
end;
}
procedure TSimpleClientSocket.Write(s: String);
begin
  send(Pointer(s)^, Length(s));
end;

procedure TSimpleClientSocket.Writeln(s: String);
begin
  Write(s+#13#10);
end;

function TSimpleClientSocket.Read: Char;
begin
  Result:=#0;
  recv(Result, 1);
end;

function TSimpleClientSocket.Readln: String;
begin
  Result:='';
  while FSocket<>INVALID_SOCKET do
  begin
    Result:=Result+Read;
    if Length(Result)>=2 then
    begin
      if (Result[Length(Result)-1]=#13) and (Result[Length(Result)]=#10) then
      begin
        Result:=Copy(Result, 1, Length(Result)-2);
        Break;
      end;
    end;
    if Length(Result)>=1 then
    begin
      if Result[Length(Result)]=#10 then
      begin
        Result:=Copy(Result, 1, Length(Result)-1);
        Break;
      end;
    end;
  end;
end;

function TSimpleClientSocket.recv(var Buf; Count: Integer): Integer;
var
  ErrorCode: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('recv: invalid socket');
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  TimeVal.tv_sec:=FTimeOutRead div 1000;
  TimeVal.tv_usec:=(FTimeOutRead mod 1000)*1000;
  if select(0, @FDSet, nil, nil, @TimeVal)=SOCKET_ERROR then
    raise Exception.Create('recv: invalid socket');
  if not FD_ISSET(FSocket, FDSet) then
    raise Exception.Create('recv(): timeout');
  Result:=WinSock.recv(FSocket, Buf, Count, 0);
  if Result=0 then
  begin
    Close;
    raise Exception.Create('recv: closed');
  end; 
  if (Result=SOCKET_ERROR) then
  begin
    ErrorCode:=WSAGetLastError;
    Close;
    raise Exception.Create('recv: '+SysErrorMessage(ErrorCode));
  end;
end;

function TSimpleClientSocket.send(var Buf; Count: Integer): Integer;
var
  ErrorCode: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('send: invalid socket');
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  TimeVal.tv_sec:=FTimeOutWrite div 1000;
  TimeVal.tv_usec:=(FTimeOutWrite mod 1000)*1000;
  if select(0, nil, @FDSet, nil, @TimeVal)=SOCKET_ERROR then
    raise Exception.Create('send: invalid socket');
  if not FD_ISSET(FSocket, FDSet) then
    raise Exception.Create('send(): timeout');
  Result:=WinSock.send(FSocket, Buf, Count, 0);
  if Result=SOCKET_ERROR then
  begin
    ErrorCode:=WSAGetLastError;
    Close;
    raise Exception.Create('send: '+SysErrorMessage(ErrorCode));
  end;
end;

end.
сегодня вырезать лень, поэтому твой метод Open;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

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

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 10:53.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter