測試網路服務主機還在嗎 ? |
|
Mickey
版主 發表:77 回覆:1882 積分:1390 註冊:2002-12-11 發送簡訊給我 |
unit ServerTester;
interface uses Windows, Classes, SysUtils, ScktComp; type TTestDoneEvent = procedure (Sender:TObject; Host:string; Port:Integer; ServiceIsOn:boolean) of object; TSocketTester = class(TComponent) private SClient: TClientSocket; FWhenDone: TTestDoneEvent; procedure SocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure SocketConnect(Sender: TObject; Socket: TCustomWinSocket); protected public constructor Create(AOwner:TComponent; Host:string; Port:Integer; WhenDone: TTestDoneEvent); overload; destructor Destroy; override; end; procedure CheckService(AOwner:TComponent; Host:string; Port:Integer=80; CBWhenDone: TTestDoneEvent=nil); implementation procedure CheckService(AOwner:TComponent; Host:string; Port:Integer=80; CBWhenDone: TTestDoneEvent=nil); begin TSocketTester.Create(AOwner, Host, Port, CBWhenDone); end; constructor TSocketTester.Create(AOwner:TComponent; Host:string; Port:Integer; WhenDone: TTestDoneEvent); begin inherited Create(AOwner); FWhenDone := WhenDone; SClient := TClientSocket.Create(Self); SClient.OnError := SocketError; SClient.OnConnect := SocketConnect; SClient.Host := Host; SClient.Port := Port; SClient.Open; end; destructor TSocketTester.Destroy; begin if SClient.Active then SClient.Close; FreeAndNil(SClient); inherited; end; procedure TSocketTester.SocketConnect(Sender: TObject; Socket: TCustomWinSocket); begin if Assigned(FWhenDone) then FWhenDone(Owner, SClient.Host, SClient.Port, True); Free; end; procedure TSocketTester.SocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin if ErrorEvent = eeConnect then begin ErrorCode := 0; if Assigned(FWhenDone) then FWhenDone(Owner, SClient.Host, SClient.Port, False); Free; end; end; end. =================== Demo Unit : unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure TesterDone (Sender:TObject; Host:string; Port:Integer; ServiceIsOn:boolean); end; implementation {$R *.dfm} uses ServerTester; procedure TForm1.Button1Click(Sender: TObject); begin CheckService(Self, '192.168.2.253', 1433, TesterDone); end; procedure TForm1.TesterDone(Sender: TObject; Host: string; Port: Integer; ServiceIsOn: boolean); begin if ServiceIsOn then ShowMessage('On') else ShowMessage('Off'); end; 編輯記錄
Mickey 重新編輯於 2007-05-24 21:13:59, 註解 無‧
|
P.D.
版主 發表:603 回覆:4038 積分:3874 註冊:2006-10-31 發送簡訊給我 |
嗨,Mickey兄:
我按圖索驥試run了這支程式,發現它似乎是偵測指定的port是否開啟,如果這個port不存在或被防火牆攔下或未設定Virtual Server Settting(NAT),即使server是正常的,也都會回應 off的狀況,然後我進一步測試,因為我有一套程式在客戶那邊會有一個現象,就是透過TCP/IP遠端連上(使用XP遠端桌面,SERVER使用Termail Server模式),只要進入遠端桌面內的我的程式(使用InterBase/FireBird),一段時間沒有進行資訊往來,會被Server端的InterBae給驅離,但這個狀況同時在其他不同客戶的電腦卻不曾發生(不同程式系統,但相同的寫法),所以目前我是設定一個Timer定時去向主機開啟資料庫,告訴主機我還在,不要把我踢走。ok! 重點來了,我用您的程式去探測InterBae的Port3050,情況還是會發生,所以我猜程式的核心是探測此port是否可通,如果可以就回應,不知道是否有什麼辦法可以探測資料庫引擎的連線,因為畢竟定時開檔/關檔,一天下來還是會損耗不少的系統資源,不過話說回來,這支程式還是很好用,因為我之前是利用SocketServer/SocketClient方式來做雙方的探測行為,在Server端必須安裝SocketServer Serivce才能運作,謝謝! |
Mickey
版主 發表:77 回覆:1882 積分:1390 註冊:2002-12-11 發送簡訊給我 |
Hi ! P.D. 兄您好:
沒錯...這只是測試 Port 是否是通的...因為當時的目的只是... 抓出我們公司防火牆...所有通道...誰叫他們要檔 MSN... 立志當駭客...哈哈 您的需求...這東西恐怕無法達到...因為您是要以 Session / Connection 為基準. 至於如何解....只有想法: 建立一個新連線...去取得 server 的 sessions 清單資訊...看看"原來的" session 是否還在
編輯記錄
Mickey 重新編輯於 2007-05-29 10:54:00, 註解 無‧
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |