udiagbuf.pas

西门子Prodave6.0 的Delphi 版本, 需要安装 Prodave60软件,支持以太网通讯

unit uDiagBuf;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,uGlobdata,PubFuns,Prodave60, XPMenu, StdCtrls, ComCtrls, RzListVw;

type
  TFrmDiagBuf = class(TForm)
    Button1: TButton;
    Button2: TButton;
    XPMenu1: TXPMenu;
    RzListView1: TRzListView;
    Label1: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
    Procedure UpdateDiagBuf;
    Procedure DiagBufReaderror(var message: TMessage); message CM_COMMSG;
  end;

var
  FrmDiagBuf: TFrmDiagBuf;
  DiagBuf:Array[1..8191] of DIAG_BUFFER_TYPE;
  ReadBufLen:Integer;

implementation
{$R *.dfm}
Function STDateTimeToSystemTime(Const S7Tim:TTIMESTAMP;Var Syear:String;Var STime:String):TdateTime;
  var
     mYear   :word;
     mMonth  :word;
     mDay    :word;
     mHour   :word;
     mMinute :word;
     mSecond :word;
     mMillSec:word;
     mWeek   :word;
  begin
      mYear  :=2000+(S7Tim.Timestamp[1] div 16)*10 +S7Tim.Timestamp[1] mod 16;
      mMonth :=(S7Tim.Timestamp[2] div 16)*10 +S7Tim.Timestamp[2] mod 16;
      mDay   :=(S7Tim.Timestamp[3] div 16)*10 +S7Tim.Timestamp[3] mod 16;
      mHour  :=(S7Tim.Timestamp[4] div 16)*10 +S7Tim.Timestamp[4] mod 16;
      mMinute:=(S7Tim.Timestamp[5] div 16)*10 +S7Tim.Timestamp[5] mod 16;
      mSecond:=(S7Tim.Timestamp[6] div 16)*10 +S7Tim.Timestamp[6] mod 16;
      Syear:=Format('200%s-%s-%s',
                  [IntToStr(S7Tim.Timestamp[1]),IntToStr(S7Tim.Timestamp[2]),
                   IntToHex(S7Tim.Timestamp[3],2)]);
      STime:=Format('%s:%s:%s',
                  [IntToHex(S7Tim.Timestamp[4],2),IntToHex(S7Tim.Timestamp[5],2),
                   IntToHex(S7Tim.Timestamp[6],2)]); 
//      Result:=EncodeTime(mHour,mMinute,mSecond,0);      
  end;

Procedure TFrmDiagBuf.UpdateDiagBuf;
var
  Item:Tlistitem;
  i,j:integer;
  DispNO:Integer;
  EventID:Word;
  EventInfo:Array[1..10] of byte;
  EventTim:array[1..8] of byte;
  DateTemp:TDatetime;
  YearStr,TimeStr,EventStr:String;
begin
       DispNo:=ReadBufLen ;
   try
        RzListView1.Items.BeginUpdate;
        RzListView1.Items.Clear;
        for i := 1 to DispNO div 20 do begin
                EventStr:='';
                EventID:=DiagBuf[i].EventID;
                DateTemp:=STDateTimeToSystemTime(DiagBuf[i].Timestamp,YearStr,TimeStr);

                for j :=1 to 10 do
                     EventStr:=EventStr+ IntTohex(DiagBuf[i].EventInfo[j],2);
                     
                Item:=RzListView1.Items.Add;
                Item.Caption:=IntTostr(i);
                Item.SubItems.Add('$'+ IntToHex(Swap(EventID),4));
                Item.SubItems.Add(YearStr);
                Item.SubItems.Add(TimeStr);
                Item.SubItems.Add(EventStr);
            end;
    finally
        RzListView1.Items.EndUpdate;
    end;
end;
Procedure TFrmDiagBuf.DiagBufReaderror(var message: TMessage);
var
   Msg:TMessage;
   Wp:integer;
begin
     Msg:=message;
     Wp:=msg.WParam;
     if Wp=DiagBufERR then begin
       if (Msg.LParam<>0)  then
             Messagebox(AppHWD.Handle,Pchar(GetErrorMessage_ex6(Msg.LParam)),
                        Pchar('错误代码 :0x'+ IntToHex(msg.LParam,4)), MB_OK)
          else
           UpdateDiagBuf;
     end;
end;

procedure TFrmDiagBuf.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     Action:=caFree;
end;

procedure TFrmDiagBuf.Button1Click(Sender: TObject);
var
    ConFlag:word;
    BufferLen:Integer;
begin
   BufferLen:=Sizeof(DiagBuf);
   ConFlag:=read_diag_buf_ex6(BufferLen,@DiagBuf,@ReadBufLen);
   PostMessage(AppHWD.Handle, CM_COMMSG, DiagBufERR, ConFlag);
end;

procedure TFrmDiagBuf.Button2Click(Sender: TObject);
begin
    close;
end;

end.