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

Delphi Sources



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

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.09.2010, 17:30
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию Переписать программу в юнит

Есть образец программки, делающей tracert. Я хочу получить то же самое, но без формы, т.е. чтобы была процедура с входными параметрами - хост, хопы и Tstrings какой-нибудь - и ее можно было запускать из других проектов, просто подключая этот юнит. Подскажите плз, как "превратить" эту программку в юнит.
Вложения
Тип файла: zip tracert.zip (13.3 Кбайт, 8 просмотров)
Ответить с цитированием
  #2  
Старый 15.09.2010, 19:16
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Вся работа собрана здесь: procedure TTraceThread.Execute;
фактически, тебе надо просто запускать этот поток и ждать, пока он закончит работу. Ну и вывод заместо Memo переписать в TStringList (тоже метот того же потока).
Ответить с цитированием
  #3  
Старый 15.09.2010, 20:49
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Но ведь мне надо к этой процедуре приделать входные параметры. А в проге они объявлены глобально... Мне кажется, что придется к каждой процедуре (Баттонклик наверно, ведь с него все начинается; собсно thread.execute; и TTraceThread.Log). Я пытался для начала только вывод переделать, чтобы передавались строки в произвольный TStrings, его к Логу приписал (Только в нем в мемо выводится), а после этого делфи стала ругаться на Synchronize(Log), пробовал писать типа так Synchronize(Log(Combobox1.items)); - все равно ругается...
Ответить с цитированием
  #4  
Старый 15.09.2010, 21:09
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ага, сделай переменную внутри класса и вывод лога будет писать в нее. Для Synchronize нужно, что бы метод был без параметров... сам с этим намучался... приходится делать через переменные (поля) класса потока. Кстати, если это будет переменная класса, и она не будет читаться/писаться во время работы потока, то можно Synchronize и не использовать.
Ответить с цитированием
  #5  
Старый 19.09.2010, 19:13
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Вроде получилось, за одним исключением - как понять, когда трассировка завершена? Т.е. я сделал некую процедуру, которую буду вызывать из основной программы: ей на вход подаются адрес хоста, число хопов и переменная, куда должен попасть результат трассировки.
Код:
 procedure tracerout(const adr:string;hop:integer; var otvet:string);
begin
otvet:='';
with TTraceThread.Create(False) do
  begin
    FreeOnTerminate := True;
    DestinationAddress := adr;
    IterationCount := hop;
    Resume;
  end;

{res - переменная, в которую Log заталкивает ответ}
{??? otvet:=res; ???}
end;
А конце, по идее, в "ответ" должен передаваться результат трассировки, который в этом самом res'e. Но - к тому моменту, как начинает выполняться присваивание, не всегда успевают пройти даже 2 трассировки, а если хопов 30? Как "задержать" программу (Не подвешивая ее, нужно, чтобы пользователь мог что-то делать, пока идет трассировка)? Пробовал "while pos('завершена',res)=0 do begin end", но этот цикл не дает потоку выполняться => бесконечный цикл...
Ответить с цитированием
  #6  
Старый 21.09.2010, 20:27
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Забил на это дело, код трасерта скопипастил в прогу, вроде в целом ничего получилось))) Но - почему не посылаются эхо-запросы?
Код:
Error := IcmpSendEcho(TraceHandle,
                          DestAddr.S_addr,
                          nil,
                          0,
                          @IP,
                          ECHO,
                          SizeOf(ICMP_ECHO),
                          5000);
Возвращает 0, мол "отказано в доступе"... Как исправить?
З.Ы. Наверно важно - я пишу не обычное приложение, а дллка-плагин для ИЕ.
Ответить с цитированием
  #7  
Старый 22.09.2010, 23:38
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Во первых, показывай весь код.
Возможно, просто что-то не инициализированно и поэтому не работает.
Ответить с цитированием
  #8  
Старый 23.09.2010, 09:40
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Да вроде все скопировал, ничего не упустил.
Код в аттаче, весь плагин. Открывать ProxyBand.dpr, смотреть на Button2.Click и далее, TTraceThread.Trace и др.
Вложения
Тип файла: rar Sorc.rar (29.2 Кбайт, 3 просмотров)
Ответить с цитированием
  #9  
Старый 26.09.2010, 19:51
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Короче:

Код:
unit TraceRt; 
interface 

// =========================================================================== 
// TRACEROUTE Class 
// Mike Heydon Dec 2003 
// 
// Method 
// Trace(IpAddress : string; ResultList : TStrings) 
//             Returns semi-colon delimited list of ip routes to target 
//             format .. IP ADDRESS; PING TIME MS; TIME TO LIVE; STATUS 
// 
// Properties 
//             IcmpTimeOut : integer (Default = 5000ms) 
//             IcmpMaxHops : integer (Default = 40) 
// =========================================================================== 

uses Forms, Windows, Classes, SysUtils, IdIcmpClient; 

type 
     TTraceRoute = class(TObject) 
     protected 
       procedure ProcessResponse(Status : TReplyStatus); 
       procedure AddRoute(AResponseTime : DWORD; 
                          AStatus: TReplyStatus; const AInfo: string ); 
     private 
       FIcmpTimeOut, 
       FIcmpMaxHops : integer; 
       FResults : TStringList; 
       FICMP : TIdIcmpClient; 
       FPingStart : cardinal; 
       FCurrentTTL : integer; 
       procedure PingTarget; 
     public 
       constructor Create; 
       procedure Trace(const AIpAddress : string; AResultList : TStrings); 
       property IcmpTimeOut : integer read FIcmpTimeOut write FIcmpTimeOut; 
       property IcmpMaxHops : integer read FIcmpMaxHops write FIcmpMaxHops; 
     end; 

// --------------------------------------------------------------------------- 
implementation 

// ======================================== 
// Create the class and set defaults 
// ======================================== 

constructor TTraceRoute.Create; 
begin 
  IcmpTimeOut := 5000; 
  IcmpMaxHops := 40; 
end; 


// ============================================= 
// Use Indy component to ping hops to target 
// ============================================= 

procedure TTraceRoute.PingTarget; 
var wOldMode : DWORD; 
begin 
  Application.ProcessMessages; 
  inc(FCurrentTTL); 

  if FCurrentTTL < FIcmpMaxHops then begin 
    FICMP.TTL  := FCurrentTTL; 
    FICMP.ReceiveTimeout := FIcmpTimeOut; 
    FPingStart := GetTickCount; 
    wOldMode := SetErrorMode(SEM_FAILCRITICALERRORS); 

    try 
      FICMP.Ping; 
      ProcessResponse(FICMP.ReplyStatus); 
    except 
      FResults.Add('0.0.0.0;0;0;ERROR'); 
    end; 

    SetErrorMode(wOldMode); 
  end 
  else 
    FResults.Add('0.0.0.0;0;0;MAX HOPS EXCEEDED'); 
end; 


// ============================================================ 
// Add the ping reply status data to the returned stringlist 
// ============================================================ 

procedure TTraceRoute.AddRoute(AResponseTime : DWORD; 
                               AStatus: TReplyStatus; 
                               const AInfo: string ); 
begin 
  FResults.Add(AStatus.FromIPAddress + ';' + 
               IntToStr(GetTickCount - AResponseTime) + ';' + 
               IntToStr(AStatus.TimeToLive) + ';' + AInfo); 
end; 


// ============================================================ 
// Process the ping reply status record and add to stringlist 
// ============================================================ 

procedure TTraceRoute.ProcessResponse(Status : TReplyStatus); 
begin 
  case Status.ReplyStatusType of 
    // Last Leg - Terminate Trace 
    rsECHO : AddRoute(FPingStart,Status,'OK'); 

    // More Hops to go - Continue Pinging 
    rsErrorTTLExceeded :  begin 
                            AddRoute(FPingStart,Status,'OK'); 
                            PingTarget; 
                          end; 

    // Error conditions - Terminate Trace 
    rsTimeOut : AddRoute(FPingStart,Status,'TIMEOUT'); 
    rsErrorUnreachable : AddRoute(FPingStart,Status,'UNREACHABLE'); 
    rsError : AddRoute(FPingStart,Status,'ERROR'); 
  end; 
end; 

// ====================================================== 
// Trace route to target IP address 
// Results returned in semi-colon delimited stringlist 
// IP; TIME MS; TIME TO LIVE; STATUS 
// ====================================================== 

procedure TTraceRoute.Trace(const AIpAddress : string; 
                            AResultList : TStrings); 
begin 
  FICMP := TIdIcmpClient.Create(nil); 
  FICMP.Host := AIpAddress; 
  FResults := TStringList(AResultList); 
  FResults.Clear; 
  FCurrentTTL := 0; 
  PingTarget; 
  FICMP.Free; 
end; 

{eof} 
end.

Google рулит!!!
Ответить с цитированием
  #10  
Старый 27.09.2010, 19:37
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Это я видел, сейчас еще раз проверил - "Access violation bla-bla-bla in Proxyband.dll"
Ответить с цитированием
  #11  
Старый 07.10.2010, 19:18
lega4 lega4 вне форума
Прохожий
 
Регистрация: 14.09.2010
Сообщения: 15
Репутация: 10
По умолчанию

Уфф, ну и жестоко все это было, но, оказывается, все просто))))
• У меня не получилось сделать вывод трасерта в переменную так, чтобы основное приложение могло узнать, когда считывать. Поэтому сделал вывод трасерта в произвольный файл - основная прога все равно не узнает, когда смотреть, но для моей цели это не критично. Да и, в конце концов, можно регулярно проверять папку на наличие файла.
• Не бейте меня сильно за, наверное, не лучшую реализацию вывода в файл
• Всегда меня просто добивает то, что люди юнит-то выложат, а вот пример использования - нет. И сиди, думай, как же его вызвать. Поэтому используется примерно так (Если добавлять tracert.pas к проекту)
Код:
with tracert.TTraceThread.Create(false) do
  begin
    FreeOnTerminate := True;
    FileName:='Здесь путь к файлу';
    DestinationAddress := 'Здесь айпи или хост, без протокола'; //Т.е. 'ya.ru' - верно, 'http://ya.ru' - нет.
    IterationCount := 6; //Здесь количество прыжков
    Resume;
  end;
Вложения
Тип файла: rar Tracert.rar (3.4 Кбайт, 4 просмотров)

Последний раз редактировалось lega4, 07.10.2010 в 19:22.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter