|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Переписать программу в юнит
Есть образец программки, делающей tracert. Я хочу получить то же самое, но без формы, т.е. чтобы была процедура с входными параметрами - хост, хопы и Tstrings какой-нибудь - и ее можно было запускать из других проектов, просто подключая этот юнит. Подскажите плз, как "превратить" эту программку в юнит.
|
#2
|
|||
|
|||
Вся работа собрана здесь: procedure TTraceThread.Execute;
фактически, тебе надо просто запускать этот поток и ждать, пока он закончит работу. Ну и вывод заместо Memo переписать в TStringList (тоже метот того же потока). |
#3
|
|||
|
|||
Но ведь мне надо к этой процедуре приделать входные параметры. А в проге они объявлены глобально... Мне кажется, что придется к каждой процедуре (Баттонклик наверно, ведь с него все начинается; собсно thread.execute; и TTraceThread.Log). Я пытался для начала только вывод переделать, чтобы передавались строки в произвольный TStrings, его к Логу приписал (Только в нем в мемо выводится), а после этого делфи стала ругаться на Synchronize(Log), пробовал писать типа так Synchronize(Log(Combobox1.items)); - все равно ругается...
|
#4
|
|||
|
|||
Ага, сделай переменную внутри класса и вывод лога будет писать в нее. Для Synchronize нужно, что бы метод был без параметров... сам с этим намучался... приходится делать через переменные (поля) класса потока. Кстати, если это будет переменная класса, и она не будет читаться/писаться во время работы потока, то можно Synchronize и не использовать.
|
#5
|
|||
|
|||
Вроде получилось, за одним исключением - как понять, когда трассировка завершена? Т.е. я сделал некую процедуру, которую буду вызывать из основной программы: ей на вход подаются адрес хоста, число хопов и переменная, куда должен попасть результат трассировки.
Код:
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; |
#6
|
|||
|
|||
Забил на это дело, код трасерта скопипастил в прогу, вроде в целом ничего получилось))) Но - почему не посылаются эхо-запросы?
Код:
Error := IcmpSendEcho(TraceHandle, DestAddr.S_addr, nil, 0, @IP, ECHO, SizeOf(ICMP_ECHO), 5000); З.Ы. Наверно важно - я пишу не обычное приложение, а дллка-плагин для ИЕ. |
#7
|
|||
|
|||
Во первых, показывай весь код.
Возможно, просто что-то не инициализированно и поэтому не работает. |
#8
|
|||
|
|||
Да вроде все скопировал, ничего не упустил.
Код в аттаче, весь плагин. Открывать ProxyBand.dpr, смотреть на Button2.Click и далее, TTraceThread.Trace и др. |
#9
|
|||
|
|||
Короче:
Код:
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
|
|||
|
|||
Это я видел, сейчас еще раз проверил - "Access violation bla-bla-bla in Proxyband.dll"
|
#11
|
|||
|
|||
Уфф, ну и жестоко все это было, но, оказывается, все просто))))
• У меня не получилось сделать вывод трасерта в переменную так, чтобы основное приложение могло узнать, когда считывать. Поэтому сделал вывод трасерта в произвольный файл - основная прога все равно не узнает, когда смотреть, но для моей цели это не критично. Да и, в конце концов, можно регулярно проверять папку на наличие файла. • Не бейте меня сильно за, наверное, не лучшую реализацию вывода в файл • Всегда меня просто добивает то, что люди юнит-то выложат, а вот пример использования - нет. И сиди, думай, как же его вызвать. Поэтому используется примерно так (Если добавлять tracert.pas к проекту) Код:
with tracert.TTraceThread.Create(false) do begin FreeOnTerminate := True; FileName:='Здесь путь к файлу'; DestinationAddress := 'Здесь айпи или хост, без протокола'; //Т.е. 'ya.ru' - верно, 'http://ya.ru' - нет. IterationCount := 6; //Здесь количество прыжков Resume; end; Последний раз редактировалось lega4, 07.10.2010 в 19:22. |