xycom.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;

    DJ2Day, DJPrd: Byte;

    // 测量值
    // VAL(459.5), TIME(2004-08-03 12:59)
    Val  : string; //Double;
    Stat : Char;
    MsrTime: string; // TDateTime;
  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, iBCnt: Integer;
    MI: TMI;
    PreiB, PreEQ: string;
    
    ToiBTime: string;

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

    Index: Integer;     // 索引：测点，
    Turns: Integer;     // 班次

    fHzFont: TextFile;

    str: string;

    { Private declarations }
    Procedure SetComm(ComPort: Byte=1);
    procedure Send2Device(outB: OleVariant);
    Procedure SetTime;
    procedure SendaMI;
    procedure SetiBs;
    procedure SendaiB;
    procedure SendaFont;
    procedure SetaSelI;

    function ProcMsrRcd(): Boolean;
    function ProciBRcd(): Boolean;

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

    procedure SetSelIs;

    procedure ResetDev;
  end;

var
  djCom: TDjCom;

implementation

{$R *.dfm}

uses DateUtils, Math, Global, xyMath;

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

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

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

  { iB 标志测量区域, 即存在: 在新iB后, 不会出现以前的iB编号. }
  sliB:= TStringList.Create;
  //sliB.Sorted:= False; 
  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;
          SetiBs();
        end;
      end;

    ciB:
      begin
        Index := Index + 1;
        if Index < iBCnt then
          SendaiB()
        else begin
          CloseFile(fiB);   // close mi.dat file
          foiB:= False;
          MessageDlg('点检任务下载完成！', mtInformation, [mbOK], 0);
        end;
      end;

    cTransData0:
      begin
        // 岗位编号,测量时间,上传时间
        EC:= '';
        for j:=1 to 6 do
            if Buf[j]>0 then EC := EC + slFontTbl.Strings[Buf[j]];

        str:= EC + ' ' + DateTimeToStr(Now);
        Writeln(fData, str);
        // cTransData
        Turns := 1;
        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
              str:= MakeStr([MI.No,MI.Val,MI.Stat,MI.MsrTime]);
              Writeln(fData, str);
            end;
          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
          if Turns<maxTURNS then begin
            Turns := Turns +1;
            outBuf[0] := $80 or cTransData;
            Comm1.Output := outBuf;
          end else begin
            CloseFile(fData);
            foData:= False;
            //MessageDlg('完成数据传输。', mtInformation, [mbOK], 0);
            //frmMain.Save2DB1Execute(Nil);
            GetiBData();
          end;
        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;

    cTransiB_D:
      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 ProciBRcd then
              // 2 iBD.dat
              Writeln(fiBData, ToiBTime);
          finally
          end;
        end;
        end;
        // 继续传输
        if Buf[1]=8 then begin	// b.7=1时则为最后1帧
          outBuf[0] := cTransiB_D;
          Comm1.Output := outBuf;
        end else begin
          CloseFile(fiBData);
          foiBData:= 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;

    cSetSelI:
      begin
        CloseFile(fiB);   // close mi.dat file
        foiB:= False;
        MessageDlg('完成选项设置。', mtInformation, [mbOK], 0);
      end;

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

        SendaFont();
      end else begin
        CloseFile(fiB);   // close mi.dat file
        foiB:= False;
        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 := Trunc((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;
      end;
    2:
      begin
        aVal[0] := (v[2] and $F0) shr 4;
        aVal[1] := v[2] and $F;
        aVal[3] := (v[3] and $F0) shr 4;
        aVal[4] := v[3] and $F;
      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 := Chr(aVal[0])+ Chr(aVal[1])+ Chr(aVal[2])+ Chr(aVal[3])+ Chr(aVal[4]);
    MI.Stat:= 'N';
  end else begin
    MI.Val := IntToStr(v[3]);
    MI.Stat:= 'S';
  end;
  // "2002-12-31 14:56"
  MI.MsrTime:= IntToStr(year) +'-' + IntToHex(mon,2)+ '-'+ IntToHex(day,2)+ ' '+ IntToHex(v[5],2)+ ':'+ IntToHex(v[4],2)+ ':0';//+ IntToHex(v[3],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, cTransiB_D:
    Comm1.RThreshold := 66;	  // 8x8 +2

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

  else  // cMI, ciB, SelIs, ResetDev etc.
    Comm1.RThreshold := 2;
  end;

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

  cGetData
    if FLAG = 0 then
      Comm1.RThreshold = 1 + 2            ' 命令字,记录数字...
    else
      i = szMsrRcd * RcdNum
      ReDim rcvArr(i - 1)

      Comm1.RThreshold = 1 + i
      Timer.Interval = Comm1.RThreshold * 5
    end;}

  Comm1.Output := outB;
end;

procedure TDjCom.SendaFont;
var
  i: Integer;
begin
  for i:=0 to 31 do
    outBuf[2+i]:= StrToInt('$'+slEqp.Strings[i]);

  Comm1.Output := outBuf;
end;

procedure TDjCom.SendaMI;
var
  i,j,c,k,t: Integer;

  Wstr: WideString;
  ps : PChar;
  chr: Char;
  pWs: PWideChar;
  wc : WideChar;

  substr: array[0..1] of Char;
  lidxEqp,lidxiB: Integer;

  v: array[0..89] of Byte;
  strA: TStrArray;
begin
  // 准备 MI 数据
  // MsrI File
  Readln(fMsrI, str);
  strA:= ReadFromStr(str,',');

  // if High(strA)= 13 then begin
  //ItemSequ No Name2 EqpNo EqpName CFG MsrType MsrChl DefaultV LowW LowA UpW UpA iB
  MI.No  := StrToInt(strA[1]);
  MI.Name:= strA[2];
  MI.EqpNo:= strA[3];
  MI.EqpName:= strA[4];

  MI.CFG    := StrToInt(strA[5]);
  MI.MsrType:= StrToInt(strA[6]);
  MI.ValType:= StrToInt(strA[7]);

  MI.DefaultV:= Trunc(StrToFloat(strA[8]));

  MI.LowW:= 4-StrToInt(strA[9]);
  MI.LowA:= StrToInt(strA[10]);
  MI.UpW:= StrToInt(strA[11]);
  MI.UpA:= StrToInt(strA[12]);
  MI.iB:= strA[13];
  MI.DJ2Day:= StrToInt(strA[14]);
  MI.DJPrd := StrToInt(strA[15]);

  MI.DefaultV := StrToInt('$'+ IntToStr(MI.DefaultV));
  MI.LowA := StrToInt('$'+ IntToStr(MI.LowA));
  MI.UpA := StrToInt('$'+ IntToStr(MI.UpA));

  // 准备编码Frame
  // MI_No
  v[0] := (MI.No and $FF00) shr 8;
  v[1] := MI.No and $FF;