اشکال در تست کانکشن

[sam3610]

سلام
با توجه به راهنمایی های دوستان در پست های موجود در سایت من برای تست وصل بودن سیستم به شبکه قبل از اجرای برنامه این کد رو نوشتم اما بازم هنگام اجرای برنامه در حالتی که به شبکه وصل نیست برنامه ارور میده :


procedure Tfrm_begin.Timer1Timer(Sender: TObject);
begin
ProgressBar1.Position:=cnt;
Inc(cnt);
if (ProgressBar1.Position=ProgressBar1.Max) then
begin
Timer1.Enabled:=False;
try
ADOConnection1.Open;
except
i:=1;
end;
if not(i=1) then begin
Label2.Caption:='ok';
Label2.Font.Color:=clGreen;
i:=0;
end


else begin
Label2.Caption := 'CONNECTION FAILED!!!';
Label2.Font.Color:=clRed;
BitBtn1.Visible:=True;
end;


end else begin
Label2.Caption := 'TESTING CONNECTION...';
end;
if (i=0) then begin
ADOConnection1.Close;


//frm_begin.hide;
frm_login.show;
frm_login.Edit1.SetFocus;
end;
end;

[sam3610]

131329
این عکس خطایی هست که رخ میده

[hadisalahi2]

عکس باز نمیشه

[sam3610]

131361
عکس خطایی که رخ می دهد

[دلفــي]

مي توني از تابع زير استفاده كني
اگه خروجي تابع True باشه به پايگاه داده وصلي اگه False باشه نه


function isConnected(Connection1:TADOConnection):boolean;
begin
Result:=True;
with Connection1 do
begin
Close;
try
Open;
except
Result:=False;
end;
end;
end;




procedure TForm1.Button1Click(Sender: TObject);
begin
if isConnected(ADOConnection1) then
ShowMessage('ارتباط برقرار است') else
ShowMessage('ارتباط برقرار نيست');
end;