Arsip: Thread utk Ping ke Banyak IP

more 10 years ago
rudisbg
Dear all master, saya pingin bikin aplikasi kayak multiping (www.nessoft.com/multiping)
dengan menggunakan TPing.
tapi saya masih minim pengalaman dalam menggunakan Thread.
bisa tolong dibantu ?
saya udh bikin spt ini, tp masih sering error "The exception unknown software exception (0x0eedfade) occured in the application at location 0x7c81eb33)"
Ini Thread yg saya bikin :
unit uThread;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, ping,
stdctrls,ExtCtrls,MPLayer;
type
TPingThread = class(TThread)
private
fPing : TPing;
{ Private declarations }
procedure fPingDNSLookupDone(Sender: TObject; Error: Word);
procedure fPingEchoReply(Sender,icmp: TObject; Error: Integer);
protected
procedure Execute; override;
public
MemoKu: TMemo;
PanelKu : TPanel;
Addr,PingResult : String;
waktuku, errCount : integer;
{ Public declarations }
constructor Create(Memo: TMemo; Almt: String; intval: integer; panel: TPanel);
end;
implementation
uses uPing;
constructor TPingThread.Create(Memo: TMemo; Almt: String; intval: integer; panel: TPanel);
begin
inherited Create(True);
memoKu :=Memo;
Addr :=Almt;
waktuku :=intval;
panelKu :=Panel;
errCount :=0;
end;
procedure TPingThread.Execute;
begin
fPing :=TPing.Create (nil);
fPing.OnDnsLookupDone :=fPingDNSLookupDone;
fPing.Size :=32;
fPing.DnsLookup(Addr);
while not Terminated do
begin
// panelKu.caption :=fPing.HostIP;//Addr;
fPing.Ping;
end;
end;
procedure TPingThread.fPingDNSLookupDone(Sender: TObject; Error: Word);
begin
if error<>0 then
begin
PingResult := 'Unknown host '''+addr+'''';
// terminate;exit;
end;
with sender as TPing do
begin
Address :=DNSResult;
onEchoReply :=fPingEchoReply;
// ping; terminate;
end;
end;
procedure TPingThread.fPingEchoReply(Sender,icmp: TObject; Error: Integer);
begin
with sender as TPing do
if Error = 0 then
begin
PanelKu.Color :=$003640F1;
PanelKu.Font.Color :=$0037E3EC;
inc(errCount);
if (errCount mod 10)=0 then
begin
PingResult:='Critical Error ('+HostIP+') : '+Errorstring;
// Form1.BunyikanAlarm(sender,2);
form1.CatatError('['+formatdatetime('DD-MM-YYYY HH:MM:SS',now)+'] '+PingResult,2);
end else
begin
PingResult:='Cannot ping host ('+HostIP+') : '+Errorstring;
// Form1.BunyikanAlarm(1);
form1.CatatError('['+formatdatetime('DD-MM-YYYY HH:MM:SS',now)+'] '+PingResult,1);
end;
MemoKu.Lines.Add(PingResult);
sleep(waktuku); ping;
end
else
begin
PingResult :='Received '+inttostr(Reply.datasize)+' bytes from '+HostIP+ ' ('+HostName+
') in '+inttostr(Reply.RTT)+' msecs';
PanelKu.Font.Color :=$00FBFBFB;
if Reply.RTT < 200 then PanelKu.Color :=$0051E83C else
if Reply.RTT < 500 then PanelKu.Color :=$0041F1ED else
PanelKu.Color :=$003D99F5;
errCount :=0;
MemoKu.Lines.Add(PingResult);
sleep(waktuku); ping;
end;
Terminate;
end;
end.
dan untuk memanggilnya dari Form1
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add(edit1.text);
inc(jlhIP);
(findcomponent('Panel'+inttostr(jlhIP)) as TPanel).caption :=edit1.text;
with TPingThread.Create(Memo2,edit1.Text,waktu.value*1000,TPanel(findcomponent('Panel'+inttostr(jlhIP)))) do
begin
FreeOnTerminate :=true;
Resume;
end;
end;
Kalo saya perhatikan sih, jika banyak IP yg Timed Out yg bikin cepet error itu muncul.
Trus saya juga gak tau giman cara terminate Thread-nya utk masing-2 IP.
Mohon pencerahannya..... trims
more 10 years ago
rudisbg
Ini procedure catatError (Apa mungkin ini penyebabnya ya? karena saya bikin di Form1 ?)
procedure TForm1.CatatError(pesan: string; jenis: integer);
begin
with richEdit1 do
begin
if jenis=1 then
begin
//bigger text
SelAttributes.Style := [];
SelAttributes.Color := clBlack;
Lines.Add(pesan);
end else
begin
//bigger text
SelAttributes.Style := [fsBold];
SelAttributes.Color := clRed;
// SelText :=pesan+chr(13);
Lines.Add(pesan);
end
end;

more 10 years ago
mat_koder
secara umum , jika masing2 thread di-design mengakses komponen VCL yang sama , maka anda harus pakai Synchronize() method atau gunakan locking mechanism seperti misalnya TRTLCriticalSection.
Coba anda test aplikasi anda dengan satu remote IP dulu dan lihat apakah OK (termasuk bilamana ada error misalkan network terputus / timeout atau error2 lain) baru kmudian test dengan 2 , 3 dst

more 10 years ago
rudisbg
utk VCL-nya udah bisa diatasi, trus utk proses Terminate masing-masing Thread-nya gimana ya? soalnya kalo aplikasi saya tutup, banyak Error yg mungkin disebabkan krn Thread-nya belom di Terminate.

more 10 years ago
rudisbg
alhamdulillah udh nemu triknya. jadinya kubuat variabel global IsKeluar: Boolean
pd form1.onClose
begin
IsKeluar :=True;
Timer1.Enabled :=true;
action :=caNone;
end;
dan pd Timer1.OnTimer
begin
dec(countdown);
pnlKeluar.Caption :='Menutup Aplikasi dalam '+inttostr(countdown)+' Detik';
if countdown=0 then Application.Terminate;
end;
kemudian di procedure TPingThread.fPingEchoReply pada perintah Ping dirubah menjadi :
if not IsKeluar then
ping;
Karena di perintah Ping ini yg membuat Thread terus Looping,
shg ketika perintah ping tidak dijalankan, thread akan 'idle'
dan countdown selama 10 detik utk memberi waktu semua
Thread untuk berakhir scr otomatis
btw.... thanks all for u'r attention.
bravo delphi indonesia
more ...
- Pages:
- 1
reply |
Report Obsolete
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 2 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 3 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 10 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 10 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 10 years ago
Random Topic
- membuat nomor urut di query ms access
by jajang in Hal umum tentang Pascal Indonesia more 12 years ago - Convert Report ke file PDF
by m3llo in Tip n Trik Pemrograman more 15 years ago - penjumlahan tanggal
by hafiezd in Bedah Kasus more 13 years ago - Seputar koneksi ADO dengan MsSQL
by bagussb in MsSQL more 15 years ago - auto_increment
by irmains in MySQL more 13 years ago - Export data ke ExcelChart
by derry.othman in Hal umum tentang Pascal Indonesia more 15 years ago - crop image
by wiqk in Tip n Trik Pemrograman more 14 years ago - tanya penggunaan datetimepicker
by misdie in MsSQL more 14 years ago - Capture onClik pada Scroll bar Vertical
by coolmib in Form Enhancement & Graphical Controls more 16 years ago - StringGrid yang enak...
by n3o_cybertech in Lain-lain more 15 years ago