moonrise
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Sleepwalker
Цитата:| ну. Ничего сказать не могу, надо брать проект и тестировать. А чего компонент idFTp не захотел взять? не проще будет? |
так фактически это весь "проект" 
только еще мемка есть в которой 2 тестовых фтп забито. могу на почту закинуть.
в idFTp не нашел возможность отключения блокирующего режима, да и не уверен я в корректности его захода
Добавлено:
попытался на idFTp
Код: unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdFTP, StdCtrls, ExtCtrls, IdAntiFreezeBase, IdAntiFreeze;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
IdFTP1: TIdFTP;
Timer1: TTimer;
Label1: TLabel;
Memo3: TMemo;
IdAntiFreeze1: TIdAntiFreeze;
procedure Button1Click(Sender: TObject);
procedure IdFTP1AfterClientLogin(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
T_me: integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
J: Integer;
begin
Memo1.Clear;
Memo3.Clear;
Memo3.Lines.Add('Start: ' + TimeToStr(Time));
T_me := 0;
Timer1.Enabled := True;
for J := 1 to 255 do // Iterate
begin
for I := 0 to memo2.Lines.Count - 1 do // Iterate
begin
with TidFTP.Create(self) do
begin
try
Name := 'FTP_' + IntToStr(J) + '_' + IntToStr(I);
Host := memo2.Lines[I]+IntToStr(J);
Port := 21;
username := 'anonymous';
password := 'FTP_bot';
OnAfterClientLogin := IdFTP1AfterClientLogin;
try
Memo1.Lines.Add(TimeToStr(Time) + ' : ' + Host + ' Try connected');
Connect(true, 150);
except
// Memo1.Lines.Add(TimeToStr(Time) + ' : ' + Host + ' Error');
end;
finally
Destroy;
end;
end
end; // for
end; // for
Timer1.Enabled := False;
Memo3.Lines.Add('Stop: ' + TimeToStr(Time));
Memo3.Lines.Add('Time (sec): ' + IntToStr(T_me));
end;
procedure TForm1.IdFTP1AfterClientLogin(Sender: TObject);
begin
Memo1.Lines.Add((Sender as TidFTP).Host + ': Anonym') ;
(Sender as TidFTP).Disconnect;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo2.Clear;
Memo2.Lines.Add('10.130.2.');
Memo2.Lines.Add('10.130.4.');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
T_me := T_me + 1;
end;
end. |
приложение упирается в первый неработающий фтп и подвисает 
Добавлено:
нашел 1 абзац
Цитата:| В компонентах Indy используются только блокирующие соединения. Любая операция сокета клиента может быть выполнена в потоке или (более простой вариант) с использованием специального вспомогательного компонента Indy (IdAntiFreeze). Использование блокирующих соединений для реализации протокола упрощает логику программы, так как нет необходимости проверять состояние каждого компьютера, как при неблокирующих соединениях. |
расстроился...
подвисание частично удалось избежать путем добавления TIdAntiFreeze. но надо через неблокирующий режим
Добавлено:
собственно победил делфю многопоточно скан ЗАПУСКАЕТСЯ секунды за 2 (на подсетку)
теперь только трабла есть.. там что бы нормально обрабатвало пришлось циклы делать.. а ключевое значение в них меняется в действии на ответ, а вот если ответа нету, то фигово он в бесконечный уходит
думаю как избежать
Код: procedure TForm1.Button1Click(Sender: TObject);
var
I, J: Integer;
begin
Log.Clear;
for I := 0 to 0{IPList.Lines.Count - 1} do // Iterate
begin
for J := 1 to 254 do // Iterate
begin
with TTcpClient.Create(self) do
begin
Tag :=0;
BlockMode := bmNonBlocking;
RemotePort := '21';
RemoteHost := IPList.Lines[I]+IntToStr(J);
OnReceive := TcpReceive;
Log.Lines.Add(RemoteHost + 'Try to connect...');
try
Active := True;
// if isOk =true then
begin
repeat Receiveln()
until Tag = 1;
Sendln('user anonymous');
Tag := 0;
repeat Receiveln();
until Tag = 1;
end;
except
Log.Lines.Add(RemoteHost + 'Error');
end;
end; // with
end; // for
end; // for |
end;
Код: procedure TForm1.TcpReceive(Sender: TObject; Buf: PAnsiChar;
var DataLen: Integer);
var
S: string;
begin
Log.Lines.Add((Sender as TTcpClient).RemoteHost + ' ' + copy(Buf,1,DataLen-2));
(Sender as TTcpClient).Tag := 1;
S := copy(Buf,4,1);
if S ='-' then (Sender as TTcpClient).Receiveln()
else
begin
case StrToInt(copy(Buf,1,3)) of //
220: begin
end;
230: begin
(Sender as TTcpClient).Disconnect;
(Sender as TTcpClient).Active := False;
Log.Lines.Add((Sender as TTcpClient).RemoteHost +' : Anonymous');
(Sender as TTcpClient).Destroy;
end;
331: begin
(Sender as TTcpClient).Sendln('pass FTP_BOT');
(Sender as TTcpClient).Tag := 0;
end;
500: begin
(Sender as TTcpClient).Disconnect;
(Sender as TTcpClient).Active := False;
Log.Lines.Add((Sender as TTcpClient).RemoteHost +' : Non anonymous');
(Sender as TTcpClient).Destroy;
end;
else
(Sender as TTcpClient).Disconnect;
(Sender as TTcpClient).Active := False;
Log.Lines.Add((Sender as TTcpClient).RemoteHost +' : Error');
(Sender as TTcpClient).Destroy;
end; // case
end;
end; |
может у кого какие соображения будут?
----------
Истина внимательно выслушивает спорящих... вздыхает и уходит. |
|
Всего записей: 1986 | Зарегистр. 19-09-2001 | Отправлено: 13:09 31-07-2005 | Исправлено: moonrise, 18:54 31-07-2005 |
|
