recethr.~pas

delphi6.0电子寻更源程序,用来计算保安有无查抄

unit Recethr;         

interface
uses
  Windows,SysUtils, Classes,stdctrls,forms,Async32,comctrls,GVAS,dialogs,db;
type
  TCommPen = class(TThread)
  private
    FOwner:Thandle;
    FPort:Integer;
    FComm:TComm;
    FStbRst:TStatusBar;
    FUpdateItem:Integer;
    Fstring:array [0..2] of String;
    procedure UpdateStatusBar;
  protected
    procedure Execute; override;

    function  OpenComm(port1:integer):integer;
    function  SendCommData(const buf;len :integer):integer;
    function  ReadCommData(var buf;len :integer;elapse :integer):integer;
    function  SendFrame(f1:frametype):integer;
    function  ReceFrame(var f1:frametype):integer;
    function  CheckCrc(f1:frametype):integer;
    function  CalcCrc(var f1:frametype):integer;
    function  WakeupPen:integer;
    function  TestPenLed:integer;
    function  TestPenBell:integer;
    function  ReadPenClock(var ye,mo,da,ho,mi,se:byte):integer;
    function  WritePenClock(ye,mo,da,ho,mi,se:integer):integer;
    function  Read24c01(add,len:integer;var buff:array of byte):integer;
    function  Write24c01(add,len:integer;const  buff:array of byte):integer;
    function  Read24c256(add,len:Cardinal;var  buff:array of byte):integer;
    function  Write24C256(add,len:integer;const buff:array of byte):integer;
    function  DoComm:integer ;virtual;abstract;
    function  PostComm:integer;virtual;abstract;


//    procedure DoCommunication;
//    procedure Terminate;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar);
  end;

  TSetPenMode = class(TCommPen)
  private
    fMODE:byte;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1:byte);
  end;

  TWritePenClock = class(TCommPen)
  private
    FDATE:TDATETIME;
    FTime:tdatetime;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
   constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1,f2:tdatetime);
  end;

  TWritePenCode = class(TCommPen)
  private
    fcode:byte;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1:byte);
  end;

  Tsetpenmod = class(TCommPen)
  private
    fchmodel:boolean;
  protected
    function DoComm:integer;override;
    function PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1:boolean);
  end;

  TTestPen  =class(TCommPen)
  private
    FTestMode:byte;
    fdatepointer:strpointer;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1:byte;fdatep:strpointer);
  end;

  TInitPen = class(TCommPen)
  private
    fcount:word;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;F1:word);
  end;

  TReadPenData = class(TCommPen)
  private
    FPenCode:byte;
    FPnDB:INTEGER;  //DATA BEGIN ADDRESS
    FPnDE:integer;  //DATA END ADDRESS
    FPnDL:integer;  //DATA LENGTH
    FPe2buff:Pe2buff;
//    function  SaveData:integer;
  protected
    function  DoComm:integer ;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar;f1:pe2buff);
  end;



  TClearPenData = class(TCommPen)
  private
  protected
    function  DoComm:integer;override;
    function  PostComm:integer;override;
  public
    constructor create(owner:THANDLE;Com1:Integer;FStB:TStatusBar);
  end;

  TSaveThr=class(TThread)
  private
    FOwner:Thandle;
    FPe2buff:Pe2buff;
    fdcnt:integer;
    fpcode:byte;
  protected
    procedure Execute; override;
  public
    //lastrecord: TBookmark;
    constructor create(owner:THANDLE;f1:byte;f2:integer;f3:pe2buff);
  end;

  TSaveThr1=class(TThread)
  private
    FOwner:Thandle;
    FPe2buff:Pe2buff;
    fdcnt:integer;
    fpcode:byte;
  protected
    procedure Execute; override;
  public
    constructor create(owner:THANDLE;f1:byte;f2:integer;f3:pe2buff);
  end;

implementation

{ Important: Methods and properties of objects in VCL can only be used in a
  method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure ReceThr.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ ReceThr }
uses  ReceFormm,datamodal,settest,menu;
procedure TCommPen.UpdateStatusBar;
begin
  FStbRst.panels[FUpdateItem].text:=Fstring[FUpdateItem];
end;

constructor TCommPen.create(owner:thandle;Com1:Integer;FStB:TStatusBar);
begin
  fowner:=owner;
  FStbRst := FStb;
  FPort:=com1;
  FreeOnTerminate := True;
  inherited Create(False);
end;

constructor TSetPenMode.create(owner:thandle;Com1:Integer;FStB:TStatusBar;f1:byte);
begin
  fmode:=f1;
  inherited Create(OWNER,com1,fstb);
end;


procedure TCommPen.Execute;
begin
  { Place thread code here }
  if OpenComm(Fport)=-1 then
  begin
    postmessage(fowner,WM_MESSAGE1,Msg_Comm,Msg_Comm_InitFale);
    exit;
  end;
  postmessage(fowner,WM_MESSAGE1,Msg_Comm,Msg_Comm_InitSuccess);
  docomm;
//  postcomm;
  Fcomm.Close;
end;

function  TCommPen.OpenComm(port1:integer):integer;
begin
  try
    Fcomm:=TCOMM.Create(nil);
    if (port1>=1) and (port1<=4) then
        FComm.DeviceName:='COM'+IntToStr(port1)
    else begin
      result:=-1;
      exit;
    end;
    Fcomm.MonitorEvents:=[];
    case combaud of 
    0:
    begin
    FComm.BaudRate:=cbr2400;// cbr9600;  ;
    end;
    1:
    begin
    FComm.BaudRate:=cbr19200;// cbr9600;  ;
    end;
    end;
    FComm.CharsTimeOut:=0;
    FComm.Databits:=da8;
    FComm.FlowControl:=fcNone;
    FComm.OptionS:=[];
    FComm.Parity:=paNone;
    FComm.ReadBufSize:=4096;
    FComm.Stopbits:=sb10;
    FComm.WriteBufSize:=2048;
    FComm.Open;
    if fcomm.Handle=INVALID_HANDLE_VALUE  then
      result:=-1
    else
      result:=1;
  except
      result:=-1;
    end;

end;

function TCommPen.SendCommData(CONST buf;len :integer):integer;
{var
  i1:integer;
  p1:array [0..255] of Byte;}
begin
  FCOMM.WRITE(BUF,LEN);
//  i1:=ReadCommData(p1,len,len*20);
  result:=LEN;//i1;
end;

function TCommPen.ReadCommData(var buf;len :integer;elapse:integer):integer;
var
  i1:integer;
  time1,time2:TDateTime;
begin
  time1:=time;
  while FCOMM.InQueCount< len  do
  begin
    time2:=time;
    sleep(1);
    if (86400000*(time2-time1))>elapse then begin result:=-1;exit;end;
  end;
  i1:=FCOMM.Read(buf,len);
  result:=i1;
end;

function TCommPen.CheckCrc(f1:frametype):integer;//校验
var
  ch1:byte;
  i:integer;
begin
  ch1:=f1.crc;
  for i:=0 to f1.len-1 do
  ch1:=ch1-f1.buff[i];
  ch1:=ch1-f1.add;
  ch1:=ch1-f1.Command;
  ch1:=ch1-f1.len;
  if ch1=0 then
    result:=1
  else
    result:=0;
end;

function  TCommPen.CalcCrc(var f1:FrameType):integer;
var
  ch1:byte;
  i:integer;
begin
  ch1:=f1.add+f1.command+f1.len;
  for i:=0 to f1.len-1 do
  ch1:=ch1+f1.buff[i];
  f1.crc:=ch1;
  result:=ch1;
end;

function  TCommPen.SendFrame(f1:FrameType):integer;
var
  i:integer;  //   ,i1
  s1:array [1..30] of byte;// ,S2
begin
  s1[1]:=f1.add;
  s1[2]:=f1.command;
  s1[3]:=f1.len;
  for i:=0 to f1.len-1 do
    s1[4+i]:=f1.buff[i];
  s1[4+f1.len]:=f1.crc;

  FCOMM.WRITE(s1,4+f1.len);

  i:=(4+f1.len);//*13;
//  i1:=ReadCommData(s2,4+f1.len,i);
  result:=I;//i1;

end;

function  TCommPen.ReceFrame(var f1:FrameType):Integer;
var
  i1,i2,I3:integer;
  s1:array [1..20] of byte;
begin
  i1:=0;
  while true do
  begin
    i2:=ReadCommData(s1,1,70);    /////
    if (i2=1) and (s1[1]=byte($eb)) then  begin f1.add:=s1[1];break;  end;
    inc(i1);
    if i1>0 then begin result:=-1;exit;end;  /////
  end;
  i1:=0;
  while true do
  begin
    i2:=ReadCommData(s1,1,70); //////
    if i2=1 then begin  f1.command:=s1[1];break;end;
    inc(i1);
    if i1>0 then begin result:=-2;exit;end;//////
  end;
  i1:=0;
  while true do
  begin
    i2:=ReadCommData(s1,1,70); //////
    if i2=1 then begin f1.len:=s1[1];break;end;
    inc(i1);
    if i1>0 then begin result:=-3;exit;end;//////
  end;
  i1:=0;
  if f1.len>10 then begin result:=-3;exit;end;
  while true do
  begin
    i2:=ReadCommData(s1,f1.len,f1.len*4);
    if i2=f1.len  then
    begin
      for i3:=0 to f1.len-1 do f1.buff[i3]:=s1[i3+1];
      break;
    end;
    inc(i1);
    if i1>1 then begin result:=-4;exit;end;/////
  end;
  i1:=0;
  while true  do
  begin
    i2:=ReadCommData(s1,1,10);
    if i2=1 then  begin f1.crc:=s1[1];break;end;
    inc(i1);
    if i1>1 then begin result:=-5;exit;end;/////
  end;
  if CheckCRC(f1)=0 then  begin result:=-6;exit;end;
  result:=1;
end;

function  TCommPen.WakeupPen:integer;
var
  i1,i2,i3:integer;
  s1:array  [1..20] of byte;
begin
  if mainform.stopflag=true then
  begin
    // settestform.stopflag:=false;
     result:=-1;
     exit;
  end;
  Postmessage(Fowner,WM_MESSAGE1,Msg_Pen,Msg_Pen_Detecting);
  i3:=0;
  while i3<100 do
  begin
     s1[1]:=byte($0);
     i1:=SendCommData(s1,1);
     if i1<>1 then
     begin
        postmessage(fowner,WM_MESSAGE1,Msg_Pen,Msg_Comm_DeviceErr);
        result:=-1;
        exit;
     end;
     i3:=i3+1;
   end;
  i1:=0;
  while true  do
  begin
    i2:=ReadCommData(s1,1,300);
    if (i2=1) and (s1[1]=byte($aa)) then break;
    inc(i1);
    if i1>2 then
    begin
      postmessage(fowner,WM_MESSAGE1,Msg_Pen,Msg_Pen_absent);
      result:=-2;exit;
    end;
  end;
  s1[1]:=byte($aa);
  i2:=sendcommdata(s1,1);
  if i2<>1 then
  begin
    postmessage(fowner,WM_MESSAGE1,Msg_Pen,Msg_Pen_absent);
    result:=-3;exit;