Arsip: Thread utk Ping ke Banyak IP
more 11 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 11 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 11 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 11 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 11 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 3 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 3 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 4 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 11 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 11 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 11 years ago
Random Topic
- Tanya : Cara buat shortcut keyboard untuk button di delphi
by venomz in Tip n Trik Pemrograman more 15 years ago - besar volume+tunjukkan nilai secara program?
by Fransisca_cicilia in Hal umum tentang Pascal Indonesia more 16 years ago - Ngetest validitas email address.
by bosenjadiprogrammer in Network, Files, I/O & System more 17 years ago - Starteam di BDS2K6
by Akuna-Matata in Hal umum tentang Pascal Indonesia more 17 years ago - Bikin Library buat perintah dasar aplikasi berbasis DB
by silueack in Enginering more 18 years ago - Lomba Hack-Shareware Aplikasi Delphi (spontanitas)
by LuriDarmawan in Hal umum tentang Pascal Indonesia more 18 years ago - buat cd interaktif atau pembelajaran pake delphi
by kepew in Hal umum tentang Pascal Indonesia more 13 years ago - Penggunaan Virtual Tree View
by eena in Form Enhancement & Graphical Controls more 17 years ago - crop image
by wiqk in Tip n Trik Pemrograman more 15 years ago - Pemrogramman Delphi Untuk Net
by Eddy_SG in Network, Files, I/O & System more 17 years ago