[lega4]

Есть образец программки, делающей tracert. Я хочу получить то же самое, но без формы, т.е. чтобы была процедура с входными параметрами - хост, хопы и Tstrings какой-нибудь - и ее можно было запускать из других проектов, просто подключая этот юнит. Подскажите плз, как "превратить" эту программку в юнит.

[lmikle]

Вся работа собрана здесь: procedure TTraceThread.Execute;
фактически, тебе надо просто запускать этот поток и ждать, пока он закончит работу. Ну и вывод заместо Memo переписать в TStringList (тоже метот того же потока).

[lega4]

Но ведь мне надо к этой процедуре приделать входные параметры. А в проге они объявлены глобально... Мне кажется, что придется к каждой процедуре (Баттонклик наверно, ведь с него все начинается; собсно thread.execute; и TTraceThread.Log). Я пытался для начала только вывод переделать, чтобы передавались строки в произвольный TStrings, его к Логу приписал (Только в нем в мемо выводится), а после этого делфи стала ругаться на Synchronize(Log), пробовал писать типа так Synchronize(Log(Combobox1.items)); - все равно ругается...

[lmikle]

Ага, сделай переменную внутри класса и вывод лога будет писать в нее. Для Synchronize нужно, что бы метод был без параметров... сам с этим намучался... приходится делать через переменные (поля) класса потока. Кстати, если это будет переменная класса, и она не будет читаться/писаться во время работы потока, то можно Synchronize и не использовать.

[lega4]

Вроде получилось, за одним исключением - как понять, когда трассировка завершена? Т.е. я сделал некую процедуру, которую буду вызывать из основной программы: ей на вход подаются адрес хоста, число хопов и переменная, куда должен попасть результат трассировки.

Код:

 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", но этот цикл не дает потоку выполняться => бесконечный цикл...

[lega4]

Забил на это дело, код трасерта скопипастил в прогу, вроде в целом ничего получилось))) Но - почему не посылаются эхо-запросы?

Код:

Error := IcmpSendEcho(TraceHandle,
                          DestAddr.S_addr,
                          nil,
                          0,
                          @IP,
                          ECHO,
                          SizeOf(ICMP_ECHO),
                          5000);

Возвращает 0, мол "отказано в доступе"... Как исправить?
З.Ы. Наверно важно - я пишу не обычное приложение, а дллка-плагин для ИЕ.

[lmikle]

Во первых, показывай весь код.
Возможно, просто что-то не инициализированно и поэтому не работает.

[lega4]

Да вроде все скопировал, ничего не упустил.
Код в аттаче, весь плагин. Открывать ProxyBand.dpr, смотреть на Button2.Click и далее, TTraceThread.Trace и др.

[lmikle]

Короче:

Код:

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 рулит!!!

[lega4]

Это я видел, сейчас еще раз проверил - "Access violation bla-bla-bla in Proxyband.dll"

[lega4]

Уфф, ну и жестоко все это было, но, оказывается, все просто))))
• У меня не получилось сделать вывод трасерта в переменную так, чтобы основное приложение могло узнать, когда считывать. Поэтому сделал вывод трасерта в произвольный файл - основная прога все равно не узнает, когда смотреть, но для моей цели это не критично. Да и, в конце концов, можно регулярно проверять папку на наличие файла.
• Не бейте меня сильно за, наверное, не лучшую реализацию вывода в файл
• Всегда меня просто добивает то, что люди юнит-то выложат, а вот пример использования - нет. И сиди, думай, как же его вызвать. Поэтому используется примерно так (Если добавлять tracert.pas к проекту)

Код:

with tracert.TTraceThread.Create(false) do
  begin
    FreeOnTerminate := True;
    FileName:='Здесь путь к файлу';
    DestinationAddress := 'Здесь айпи или хост, без протокола'; //Т.е. 'ya.ru' - верно, 'http://ya.ru' - нет.
    IterationCount := 6; //Здесь количество прыжков
    Resume;
  end;