串口编程,急求高手~~~~~分数不多了 还请高手赐教啊(100分)

  • 主题发起人 angelloi
  • 开始时间
呵呵,今天我们的项目终于做完了,客户也来看过了,要订我们2K多W的合同,
总工放了我们3天假呵呵,可以睡懒觉了
楼主我把以前写的一个定时监测UPS状态的单元贴上来,可以参考一下
unit UPSMonitorUnit;
{Just for SANTAK-MT series UPS by WGL 2004.2}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TUPSMonitor = class(TThread)
private
{ Private declarations }
UPSCom:string;
UCom:integer;
function GetUPSSignal(var RLSD_ON,CTS_ON,RING_ON:boolean):boolean;
function JudgeUPSState(RLSD_ON,CTS_ON,RING_ON:boolean):byte;
procedure PostUPSState(State:byte);
protected
procedure Execute;
override;
public
Constructor Create(CreateSuspended:Boolean;Com:string='COM12');
end;

implementation
uses
MainUnit,GlobalVarUnit;
{ UPSMonitor }
Constructor TUPSMonitor.Create(CreateSuspended:Boolean;Com:string='COM12');
begin
Try
inherited Create(CreateSuspended);
if Com<>'' then
UPSCom:=Com else
UPSCom:='COM12';
UCom:=strtoint(copy(UPSCom,4,length(UPSCom)-3));
FreeOnTerminate:=false;
except
end;
end;

procedure TUPSMonitor.Execute;
var
i,j:integer;
UPSState:byte;
RLSD_ON,CTS_ON,RING_ON,
RLSD_ON1,CTS_ON1,RING_ON1:boolean;
begin
While not Terminateddo
begin
if ComCriticalSection[UCom]<> nil then
ComCriticalSection[UCom].Enter else
exit;
try
if GetUPSSignal(RLSD_ON,CTS_ON,RING_ON) then
begin
sleep(10);
if GetUPSSignal(RLSD_ON1,CTS_ON1,RING_ON1) and
(RLSD_ON=RLSD_ON1) and
(CTS_ON=CTS_ON1) and
(RING_ON=RING_ON1) then
PostUPSState(JudgeUPSState(RLSD_ON,CTS_ON,RING_ON))
else
PostUPSState(0);
//error
end else
PostUPSState(0);
//error
finally
if ComCriticalSection[UCom]<> nil then
ComCriticalSection[UCom].Leave;
for i:=1 to 100do
//wait
if Terminated then
break else
sleep(150);
end;
end;
end;

Function TUPSMonitor.GetUPSSignal(var RLSD_ON,CTS_ON,RING_ON:boolean):boolean;
Var
lDCB: TDCB;
fHandle: THANDLE;
ModemStat:dWord;
label Error;
begin
Result:=true;
Try
fHandle:=CreateFile( Pchar(UPSCom), GENERIC_READ Or GENERIC_WRITE, 0, // open port
Nil, OPEN_EXISTING, 0, 0);
//FILE_FLAG_OVERLAPPED
If fHandle=INVALID_HANDLE_VALUE then
goto Error;
if not EscapeCommFunction( fHandle,CLRRTS)then
goto Error;
// Reset RTS
if EscapeCommFunction(fHandle,SETRTS) then
begin
sleep(20);
if GetCommModemStatus(fHandle, ModemStat) <> false then
begin
{Get the Modem Status}
if ModemStat and MS_CTS_ON <> 0 then
CTS_ON:=true else
CTS_ON:=false;
if ModemStat and MS_RING_ON <> 0 then
RING_ON:=true else
RING_ON:=false;
if ModemStat and MS_RLSD_ON <> 0 then
RLSD_ON:=true else
RLSD_ON:=false;
end else
goto Error;
end else
goto Error;
if not EscapeCommFunction(fHandle,CLRRTS)then
goto Error;
// Reset RTS
exit;
Error:
Result:=false;
finally
if CloseHandle(fHandle) then
fHandle:=0 else
Result:=false;
end;
end;

function TUPSMonitor.JudgeUPSState(RLSD_ON,CTS_ON,RING_ON:boolean):byte;
begin
{0:ERROR 1:Line Mode 2:Battery low 3:Battery Mode}
Result:=0;
if (RLSD_ON) and (CTS_ON) and (not RING_ON) then
begin
Result:=1;
exit;
end;

if (not RLSD_ON) and (not CTS_ON) and (RING_ON) then
begin
Result:=2;
exit;
end;

if (RLSD_ON) and (not CTS_ON) and (RING_ON) then
begin
Result:=3;
exit;
end;
end;

procedure TUPSMonitor.PostUPSState(State:byte);
begin
PostMessage(MainForm.handle,UM_UPSSTATE,State,0);
end;

end.
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
I
回复
0
查看
591
import
I
D
回复
0
查看
920
DelphiTeacher的专栏
D
顶部