xycom1.pas

设备巡检操作系统 本程序是专门为某电厂开发的设备巡检系统

unit xyCom;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MSCommLib_TLB;

type
  // MsrItem
  TMI = record
    // 编号信息
    No   : Integer;  // 测点编号
    Name : string;
    EqpNo: string;
    EqpName: string;

    CFG   : Byte;     // b7~4: Up/Low control , b0~b3: MsrChl
    MsrType, ValType: Byte;
    DefaultV,LowW,LowA,UpW,UpA  : Integer;

    iB    : string;   // iBAddr
    Memo  : string;

    ItemSequ: Integer;

    DJPlan: Integer;  // EX. DJMonDay, DJWDay : Byte; // 点检时间

    // 测量值
    // VAL(459.5), TIME(2004-08-03 12:59)
    Val    : Double;
    Stat  : Char;
    MsrTime: TDateTime;
    MsrDate: TDate;
  end;

  TDjCom = class(TForm)
    Comm1: TMSComm;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Comm1Comm(Sender: TObject);

  private
    slFontTbl, slEqp{slFont}, sliB, sl2AddF: TStringList;
    slEqp_i, sliB_i: TStrings;

    inBuf, outBuf: OleVariant;
    Buf: Variant;
    v: Array[0..7] of Byte;
    dt: TDateTime;

    PostNo: string;
    MICnt : Integer;
    MI: TMI;

    vMI: Array [0..1023] of Byte;
    idxEqp:Integer;    // EqpName地址
    idxiB: Integer;    // iB地址
    idxMI: Integer;    // 测点名地址

    index: Integer;       // 索引：测点，

    fHzFont: TextFile;

    str: string;

    { Private declarations }
    Procedure SetComm;
    procedure Send2Device(outB: OleVariant);
    Procedure SetTime;

    procedure SendaMI;
    procedure SendaFont;

    function ProcMsrRcd(): Boolean;

  public
    { Public declarations }
    procedure SetFonts;
    procedure SetMIs;
    procedure GetData;
    procedure Setup(cfg :Byte);

  end;

var
  DjCom: TDjCom;

implementation

{$R *.dfm}

uses DateUtils, Math, Global, xyMath, UnMain;

procedure TDjCom.FormCreate(Sender: TObject);
begin
  // 设置COM口
  SetComm;

  // 字库
  slFontTbl := TStringList.Create;
  slFontTbl.LoadFromFile(cFontIdxFile);
  sl2AddF := TStringList.Create;
  sl2AddF.LoadFromFile(cFont2File);

  slEqp := TStringList.Create;
  slEqp_i:= TStringList.Create;

  sliB:= TStringList.Create;
  sliB_i:= TStringList.Create;

  cYear := YearOf(Date);
end;

procedure TDjCom.FormDestroy(Sender: TObject);
begin
  If Comm1.PortOpen Then
    Comm1.PortOpen := False;     // 打开串口

  slFontTbl.Free;
  sl2AddF.SaveToFile(cFont2File);
  sl2AddF.Free; 

  slEqp.Free;
  slEqp_i.Free;

  sliB.Free;
  sliB_i.Free;
end;

procedure TDjCom.Comm1Comm(Sender: TObject);
var
  i,j,c,k: Integer;
begin
  if Comm1.CommEvent = comEvSend then
    MessageDlg(IntToStr(Comm1.InputMode), mtInformation, [mbOK], 0)
  else if Comm1.CommEvent = comEvReceive then
  begin
    inBuf := Comm1.Input;
    Buf := inBuf;
    dCmd:= Buf[0];
    case dCmd of
    cInitDJ:
        SendaMI;
    cMI:
      begin
        Index := Index + 1;
        if Index < MICnt then
        begin
          SendaMI;
        end else begin
          CloseFile(fMsrI);   // close mi.dat file
          foMsrI:= False;
          MessageDlg('点检任务下载完成！', mtInformation, [mbOK], 0);
        end;
      end;

    cTransCurM:
      //实时工作模式下
      begin
        // 10B: MINum, Val, Time
        v[0]:= 0;
        v[1]:= 0;
        for i:=0 to 5 do
          v[i+2]:= Buf[i+1];
        ProcMsrRcd;      // 处理获得的测量记录
      end;

    cTransData0:
      begin
        // 岗位编号,测量时间,上传时间
        str:= '';
        for j:=1 to 6 do
            str := str + slFontTbl.Strings[Buf[j]];
        str:= str + ' ' + DateTimeToStr(Now);
        Writeln(fData, str);
        // cTransData
        hCmd := $80 or cTransData;       // b7=1 则第一次数据请求
        outBuf := VarArrayCreate([0,1], varByte);
        outBuf[0] := hCmd;
        outBuf[1] := 0;
        Send2Device(outBuf);
      end;
    cTransData:
      begin
        c := Buf[1] and $0F;  // 本次传送的记录数
        if c > 0 then begin
                        //  : TtNum, TtNum x 10B, 其中TtNum最大为8(81B)
        for i:=0 to c-1 do
        begin
          k := i*8 +2;
          for j:=0 to 7 do
            v[j] := Buf[k+j];

          try
            if ProcMsrRcd then begin
              // 2 msr.dat
              if (MI.Stat<>'S') then
                str:= MakeStr([MI.No,MI.Val,DateTimeToStr(MI.MsrTime)])
              else
                str:= MakeStr([MI.No,MI.Stat,DateTimeToStr(MI.MsrTime)]);
              Writeln(fData, str);                
            end;  // end try if                 ＝
            finally
            end;

          end; // end of for i

        // 继续传输
        if Buf[1]=8 then begin	// b.7=1时则为最后1帧
          outBuf[0] := cTransData;
          Comm1.Output := outBuf;
        end else begin
          CloseFile(fData);
          foData:= False;
          MessageDlg('完成数据传输。', mtInformation, [mbOK], 0);
          if not Main_Frm.collback then
            Application.MessageBox('写入数据库失败!','错误',MB_OK+MB_ICONERROR);
          //frmMain.Save2DB1Execute(nil);
        end;
        end; // end if c>0
      end;

    cTransFonts:
      if not EoF(fHzFont) then
      begin
        // send next a font
        Index := Index +1;
        ReadLn(fHzFont, str);
        slEqp.Clear;
        slEqp.CommaText := str;

        outBuf[0] := cTransFonts;
        SendaFont;
      end else begin
        CloseFile(fHzFont);
        MessageDlg('完成写字库（共写' + IntToStr(Index+1) + '字)。', mtInformation, [mbOK], 0);
      end;
    cSetup:
      begin
        MessageDlg('完成仪器设置。', mtInformation, [mbOK], 0);
      end;
    else
      MessageDlg('不能识别的通信协议(' + IntToStr(dCmd) + ')！', mtError, [mbOK], 0);
    end;
  end;
end;

function TDjCom.ProcMsrRcd: Boolean;
var
  i: Integer;
  aVal: array[0..4]of Byte;
  Dot: Byte;
  year: Integer;
  mon,day: Byte;
begin
  ProcMsrRcd := False;

  // MI_NoH/L| MsrValH| MsrValL| Min| Hour| Day(0~5)&Year(6)&fLANG| Month(b0~4)&Dot(b5~7)8字节(见 ZipMsrRec )
  MI.No := v[0]*256 + v[1];

  year := Floor(cYear/2)*2 or ((v[6] and $40) shr 7);
  mon := (v[7] and $F8) shr 3;
  day := v[6] and $3F;
  Dot := v[7] and $07;
  if day=0 then  Exit;       	// Day : 1~31

  if ((v[6] and $80)=0) then begin
    // 测量值
    case Dot of               // 小数点
    0,4:
      begin
        aVal[0] := (v[2] and $F0) shr 4;
        aVal[1] := v[2] and $F;
        aVal[2] := (v[3] and $F0) shr 4;
        aVal[3] := v[3] and $F;
        Dot := 4;
      end;
    1:
      begin
        aVal[0] := (v[2] and $F0) shr 4;
        aVal[2] := v[2] and $F;
        aVal[3] := (v[3] and $F0) shr 4;
        aVal[4] := v[3] and $F + 48;
      end;
    2:
      begin
        aVal[0] := (v[2] and $F0) shr 4;
        aVal[1] := v[2] and $F +48;
        aVal[3] := (v[3] and $F0) shr 4;
        aVal[4] := v[3] and $F +48;
      end;
    3:
      begin
        aVal[0] := (v[2] and $F0) shr 4;
        aVal[1] := v[2] and $F;
        aVal[2] := (v[3] and $F0) shr 4;
        aVal[4] := v[3] and $F;
      end;
    else
      MessageDlg('无效的测量数据(Dot='+ IntToStr(Dot)+ ')!',mtError,[mbOK],0);
      Exit;
    end;

    for i:=0 to 4 do
      aVal[i] := aVal[i] + 48;
    aVal[Dot] := 46;             // 小数点

    MI.Val := StrToFloat(Chr(aVal[0])+ Chr(aVal[1])+ Chr(aVal[2])+ Chr(aVal[3])+ Chr(aVal[4]));
    MI.Stat := 'N';
  end else
    MI.Stat := 'S';

  // "2002-12-31 14:56"
  MI.MsrTime:= StrToDateTime(IntToStr(year) +'-' + IntToHex(mon,2)+ '-'+ IntToHex(day,2)+ ' '+ IntToHex(v[5],2)+ ':'+ IntToHex(v[4],2)+ ':0');//+ IntToHex(v[3],2));
  MI.MsrDate:= StrToDate(IntToStr(year) +'-' + IntToHex(mon,2)+ '-'+ IntToHex(day,2));

  ProcMsrRcd:= True;
end;

procedure TDjCom.Send2Device(outB: OleVariant);
var lhCmd: Byte;
begin
  lhCmd := hCmd and $0F;
  case lhCmd of
  cTransData0:
    Comm1.RThreshold := 7;	  // 6 +1

  cTransData:
    Comm1.RThreshold := 66;	  // 8x8 +2

  cTransCurM:
    Comm1.RThreshold := 10;	  // 8 +2

  else
    Comm1.RThreshold := 2;
  end;

  {cGetCurMsr
    ReDim rcvArr(szMsrRcd - 1)
    Comm1.RThreshold = 1 + szMsrRcd ' 第1个字节为消息类型

  cGetData
    if FLAG = 0 then