各位前輩:

小弟,有個問題想請各位前輩能夠幫忙...

小弟目前在網咖公司工作要寫一支程式監控另一支程式是否正常運作,

如下:

程式A : 專門接收櫃檯電腦傳送來的訊息

程式B : 負責監控 A程式是否仍正常運作.


這兩支都是放在同一台電腦...程式B只要監控A程式即可...

我一開始利用UDP方式...

將程式B發送訊息給程式A,再藉由程式A回應給程式B,藉由回應來探知程式A是否已掛掉需重新執行~

但我覺得,這不是一個好的方法...也希望藉由各位前輩能提供我更好的作法~

我知道有可以用 SendMessage或PostMessage發送訊息...但我不知道該如何使用這方面的技巧,也請各位前輩能夠給與範例或指導!!

我目前是使用Delphi 5實作,沒有更高階的版本...所以請各位大大能夠以Delphi 5 編譯讓我方便開啟研究~~感謝!!!

請寫一個範例出來好嗎...

不要來要程式碼...

------
聰明的人，喜歡猜心；雖然每次都猜對了，卻失去了自己的心
傻氣的人，喜歡給心；雖然每次都被笑了，卻得到了別人的心

板主:

您好,您誤會我的意事了...

我們的程式有點機密性...不適合將我的程試完整po出來...

我希望

1. 各位版大能多提其它解決方式?(除了udp方式...因為我已經實作出來,希望有其它方式達到同樣的結果???)

2. 想請教各位前輩,SendMessage及PostMessage如何使用?(若有簡單範例是最好...)

所以...我並不是來要程式碼...請別誤會~

我先post我利用UDP實作的方法好了~~(程式B部份可po,程式A就無法PO了...但接收可以想像一下)


MainForm部份
======================================= type
TForm1 = class(TForm)
cCheckNetCoffee: TNMUDP;
Panel1: TPanel;
Panel2: TPanel;
Button1: TButton;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Shape1: TShape;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ProgressBar1: TProgressBar;
Label5: TLabel;
CoolTrayIcon1: TCoolTrayIcon;
Shape2: TShape;
Shape3: TShape;
procedure cCheckNetCoffeeDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
isOK : smallint; //1:表正確 2:非本機訊息 3:沒接收到
end;
function ReadStrRegedit(SName:String):String;
var
Form1: TForm1;
ListWay :String = '\Software\xx科技\xx網咖櫃檯管理';
implementation
uses unitTread;
{$R *.DFM}
function ReadStrRegedit(SName:String):String;
var
SysReg :Tregistry;
begin
SysReg := TRegistry.Create;
try
SysReg.RootKey := HKEY_LOCAL_MACHINE;
If SysReg.OpenKey(ListWay,True) Then
If SysReg.ValueExists(SName) Then
Result := SysReg.ReadString(SName)
else Result := '';
finally
SysReg.Free;
end;
end;
procedure TForm1.cCheckNetCoffeeDataReceived(Sender: TComponent;NumberBytes: Integer; FromIP: String; Port: Integer);
var
SDStream : TMemoryStream;
MyStream : TMemoryStream;
NetMessage : string; //原始訊息
cLocal,cPCNum : String;
TmpStr : String;
PCName : String;
begin
try
SDStream := TMemoryStream.Create;
except
;
end;
PCName := Trim(ReadStrRegedit('PCName'));

try
try
cCheckNetCoffee.ReadStream(SDStream);
SetLength(NetMessage,NumberBytes);
SDStream.Read(NetMessage[1],NumberBytes);
except
on e:exception do
begin
isOK := 3; //發生例外當做沒收到重新執行單機程式
end;
end;
finally
SDStream.Free;
end;
cLocal := copy(NetMessage,1,4);
if cLocal = 'xxx' then
begin
cPCNum := copy(NetMessage,5,3);
if cPCNum = PCName then
begin
isOK := 1;
end
else
begin
isOK := 2;
end;
end
else
begin
isOK := 2;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
RunViewProgram : TCheckNetCoffee;
begin
CoolTrayIcon1.StartMinimized := True;
isOK := 3;
RunViewProgram := TCheckNetCoffee.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CoolTrayIcon1.HideMainForm;
end;
end.


執行緒部份
===========================================
type
TCheckNetCoffee = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
Constructor Create;
end; procedure LogRec(LogPath,LogFile,Mess:String);
function SureDirExists(mDir:String):Boolean;
implementation
uses MainForm;
Constructor TCheckNetCoffee.Create;
begin
inherited Create(False);
FreeOnTerminate := True;
end;
procedure TCheckNetCoffee.Execute;
var
SDStream : TMemoryStream;
MyStream : TMemoryStream;
NetMessage : string; //原始訊息
cLocal,cPCNum : String;
TmpStr : String;
Status_Basic : Integer;
PCBroadcast : String;
PCName : String;
iCnt : Integer;
HW,handle : HWND;
begin
//*********顯式監控狀態*************
Form1.Label5.Caption := '執行緒啟動';
Application.ProcessMessages;
Sleep(1000);
Form1.Shape1.Brush.Color := clSilver;
Form1.Shape1.Pen.Color := clSilver;
Form1.Shape2.Brush.Color := clYellow;
Form1.Shape2.Pen.Color := clYellow;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 10;
//***********************************
iCnt := 0;
Status_Basic := StrToInt(Trim(ReadStrRegedit('Status_Basic')));
PCBroadcast := Trim(ReadStrRegedit('PCBroadcast'));
PCName := Trim(ReadStrRegedit('PCName'));
Form1.cCheckNetCoffee.ReportLevel := Status_Basic;
Form1.cCheckNetCoffee.RemoteHost := '127.0.0.1';//PCBroadcast;
Form1.cCheckNetCoffee.RemotePort := 777;
while not Terminated do
begin
inc(iCnt);
//*********顯式監控狀態*************
Form1.Label5.Caption := '第' IntToStr(iCnt) '次發送訊息至受控端.';
Application.ProcessMessages;
Sleep(1000);
Form1.Shape1.Brush.Color := clSilver;
Form1.Shape1.Pen.Color := clSilver;
Form1.Shape2.Brush.Color := clYellow;
Form1.Shape2.Pen.Color := clYellow;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 20;
//***********************************
TmpStr := '';
TmpStr := 'Netc' PCName;
try
MyStream := TMemoryStream.Create;
except
end;
try
try
MyStream.Write(TmpStr[1], Length(TmpStr));
Form1.cCheckNetCoffee.SendStream(MyStream);
except
end;
finally
MyStream.Free;
Application.ProcessMessages;
end;
//*********顯式監控狀態*************
Form1.Label5.Caption := '等待受控端回應...';
Application.ProcessMessages;
Sleep(1000);
Form1.Shape1.Brush.Color := clSilver;
Form1.Shape1.Pen.Color := clSilver;
Form1.Shape2.Brush.Color := clYellow;
Form1.Shape2.Pen.Color := clYellow;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 30;
//***********************************
sleep(3000); //傳送udp封包出去後隨即等5秒避免傳送出去還沒回來就漏掉封包
if Form1.isOK = 1 then
begin
//*********顯式監控狀態*************
Form1.Label5.Caption := '受控端仍正常運作.';
Application.ProcessMessages;
Form1.ProgressBar1.Position:= 100;
Sleep(1000);
Form1.Shape1.Brush.Color := clBlue;
Form1.Shape1.Pen.Color := clBlue;
Form1.Shape2.Brush.Color := clSilver;
Form1.Shape2.Pen.Color := clSilver;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 0;
//***********************************
sleep(10000); //若有接收到就停留5分鐘 (1秒 = 1000) , (60秒 = 60*1000) (五分鐘=300秒=300*1000=300000)
Form1.isOK := 3;//將狀態再設為3
iCnt := 0;
end
else if Form1.isOK = 3 then //沒接收到咖啡端回應
begin
if iCnt = 5 then
begin
{$ifdef is98}
HW := FindWindow(nil,'ProjectNetCoffee2');
if HW > 0 then
begin
SendMessage(HW, WM_Close, 0, 0);
if not FileExists('C:\NetCoffee\ProjectNetCoffee2.exe') then
begin
CopyFile('\\shadow\sys2\NetCoffee\ProjectNetCoffee2.exe','C:\NetCoffee\ProjectNetCoffee2.exe',False);
sleep(7000);
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee2.exe'), nil, nil, sw_shownormal);
end
else
begin
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee3.exe'), nil, nil, sw_shownormal);
end;
iCnt := 0;
end
else
begin
if not FileExists('C:\NetCoffee\ProjectNetCoffee2.exe') then
begin
CopyFile('\\shadow\sys2\NetCoffee\ProjectNetCoffee2.exe','C:\NetCoffee\ProjectNetCoffee2.exe',False);
sleep(7000);
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee2.exe'), nil, nil, sw_shownormal);
end
else
begin
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee2.exe'), nil, nil, sw_shownormal);
end;
iCnt := 0;
end;
{$else}
HW := FindWindow(nil,'ProjectNetCoffee2');
if HW > 0 then
begin
SendMessage(HW, WM_Close, 0, 0); //關閉指令
if not FileExists('C:\NetCoffee\ProjectNetCoffee3.exe') then
begin
//*********顯式監控狀態*************
Form1.Label5.Caption := '關閉受控端.下載最新受控程式並執行';
Application.ProcessMessages;
Form1.Shape1.Brush.Color := clSilver;
Form1.Shape1.Pen.Color := clSilver;
Form1.Shape2.Brush.Color := clSilver;
Form1.Shape2.Pen.Color := clSilver;
Form1.Shape3.Brush.Color := clRed;
Form1.Shape3.Pen.Color := clRed;
Form1.ProgressBar1.Position:= 40;
//***********************************
CopyFile('\\shadow\sys2\NetCoffee\ProjectNetCoffee3.exe','C:\NetCoffee\ProjectNetCoffee3.exe',False);
sleep(7000);
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee3.exe'), nil, nil, sw_shownormal);
end
else
begin
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee3.exe'), nil, nil, sw_shownormal);
end;
iCnt := 0;
//*********顯式監控狀態*************
Form1.Label5.Caption := '啟動完畢';
Application.ProcessMessages;
Form1.ProgressBar1.Position:= 100;
Sleep(1000);
Form1.Shape1.Brush.Color := clBlue;
Form1.Shape1.Pen.Color := clBlue;
Form1.Shape2.Brush.Color := clSilver;
Form1.Shape2.Pen.Color := clSilver;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 0;
//***********************************
end
else
begin
if not FileExists('C:\NetCoffee\ProjectNetCoffee3.exe') then
begin
//*********顯式監控狀態*************
Form1.Label5.Caption := '下載最新受控程式並執行';
Application.ProcessMessages;
Form1.Shape1.Brush.Color := clSilver;
Form1.Shape1.Pen.Color := clSilver;
Form1.Shape2.Brush.Color := clSilver;
Form1.Shape2.Pen.Color := clSilver;
Form1.Shape3.Brush.Color := clRed;
Form1.Shape3.Pen.Color := clRed;
Form1.ProgressBar1.Position:= 40;
//***********************************
CopyFile('\\shadow\sys2\NetCoffee\ProjectNetCoffee3.exe','C:\NetCoffee\ProjectNetCoffee3.exe',False);
sleep(7000);
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee3.exe'), nil, nil, sw_shownormal);
end
else
begin
ShellExecute(handle, 'open', pchar('C:\NetCoffee\ProjectNetCoffee3.exe'), nil, nil, sw_shownormal);
end;
iCnt := 0;
//*********顯式監控狀態*************
Form1.Label5.Caption := '啟動完畢';
Application.ProcessMessages;
Form1.ProgressBar1.Position:= 100;
Sleep(1000);
Form1.Shape1.Brush.Color := clBlue;
Form1.Shape1.Pen.Color := clBlue;
Form1.Shape2.Brush.Color := clSilver;
Form1.Shape2.Pen.Color := clSilver;
Form1.Shape3.Brush.Color := clSilver;
Form1.Shape3.Pen.Color := clSilver;
Form1.ProgressBar1.Position:= 0;
//***********************************
end;
{$endif}
end;//if iCnt=5 ...end
end;//else...end
end;//While...end
end;

function SureDirExists(mDir:String):Boolean;
begin
Result:=False;
try
if ExtractFilePath(mDir)=mDir then mDir:=Copy(mDir,1,Length(mDir)-1);
Result:=DirectoryExists(mDir);
if not Result then
begin
if not SureDirExists(ExtractFilePath(mDir)) then exit;
Result:=CreateDirectory(PCHAR(mDir),nil);
end;
except exit;
end;
end;
procedure LogRec(LogPath,LogFile,Mess:String);
var mDT:TDateTime; mLog:TextFile;
begin
if LogPath='' then exit;
try
if ExtractFilePath(LogPath)<>LogPath then LogPath:=LogPath '\';
if not SureDirExists(LogPath) then exit;
mDT:=Now();
LogFile:=LogPath FormatDateTime('yMMdd',mDT) '.' LogFile '.txt';
AssignFile(mLog,LogFile);
if FileExists(LogFile) then Append(mLog) else Rewrite(mLog);
try WriteLn(mLog,'[' FormatDateTime('hh:nn:ss',mDT) '] ' Mess #13#10);
finally CloseFile(mLog);
end;
except exit;
end;
end;
end.

1.我是要你 PO SENDMESSAGE 的範例, 意思是要你自己先寫過一次, 我不是要你 PO 你公司的程式碼

2.本站有很多有關 SENDMESSAGE 之類的文章, 你應該好好的利用才是...

------
聰明的人，喜歡猜心；雖然每次都猜對了，卻失去了自己的心
傻氣的人，喜歡給心；雖然每次都被笑了，卻得到了別人的心

如果你的兩支程式都是跑在同一台計算機上的話，使用Windows Message機制來通信，比用UDP網絡通信協議要好。如版主所言，這裡有許多PostMessage與SendMessage方法的帖子，你可以先搜索一下。最好是先讀一下Delphi有關Windows Message機制的相關文章或書籍。比較簡單。

這裡給你推薦一套組件，專用於兩個App通信的：
InterAppComm
Two components, a sender and a receiver, which can communicate between separate applications on the same machine. The communication occurs conveniently through the use of events. Demos included.
http://subsimple.com/delphi.asp
http://subsimple.com/download/InterAppComm.zip

------
------------------------
博采眾家之長,奉獻綿薄之力
------------------------

很感謝大家解答...我大致知道如何解決我的問題了!!!感激不盡...

請結案, 謝謝

===================引 用 AsureNick 文 章===================

很感謝大家解答...我大致知道如何解決我的問題了!!!感激不盡...

------
聰明的人，喜歡猜心；雖然每次都猜對了，卻失去了自己的心
傻氣的人，喜歡給心；雖然每次都被笑了，卻得到了別人的心