ucontection.pas

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

unit Ucontection;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMenu,PubFuns, Prodave60,UGlobdata, Grids, RzGrids,
  ComCtrls, RzListVw, RzPrgres, ExtCtrls, RzPanel, Menus;
 type
  TCONThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute;override;
  Public
    Procedure  ConnectionPLC (Const AConNr,AConTyp:Integer;AAddr,ASlot,ARack,
                     AConTypStr:String;AAppHWD:Tform);
end;

type
  TFrmContection = class(TForm)
    GroupBox1: TGroupBox;
    XPMenu1: TXPMenu;
    Label1: TLabel;
    ComboBoxCon: TComboBox;
    Label2: TLabel;
    SelConType: TComboBox;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    EDITAddr: TEdit;
    Label4: TLabel;
    EditSlot: TEdit;
    Label5: TLabel;
    EditRack: TEdit;
    ButtonCon: TButton;
    Button1: TButton;
    RzListView1: TRzListView;
    LoadConStatusBar: TRzStatusBar;
    LoadConBar: TRzProgressBar;
    LoadConTimer: TTimer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure SelConTypeChange(Sender: TObject);
    procedure ButtonConClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure LoadConTimerTimer(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
    Procedure ADDListView(aConNr:Integer;aConTypStr,aAddr,aRack,aSlot,aCpu:string);
    Procedure UpdateLisrView;
  public
    { Public declarations }
    Procedure Connecterror(var message: TMessage); message CM_COMMSG;
  end;

var
  FrmContection: TFrmContection ;
  ConThread:TCONThread;
  Contyp:integer=0;
  Addr,Slot,Rack:string;
  ConTypStr:String;
  ConCount:integer;
implementation
  Uses uUnload, UMain;
{$R *.dfm}
Procedure TFrmContection.UpdateLisrView;
  var
     Item:TlistItem;
     i:integer;
begin
      RzListView1.Items.BeginUpdate;
      RzListView1.Items.Clear;
      ConCount:=0;
   try
     for i:= 0 to 63 do  begin
        if LoadCon[i].Connr=true then begin
           Item:=RzListView1.Items.Add;
           Item.Caption:=IntToStr(LoadCon[i].ConNo);
           Item.SubItems.Add(LoadCon[i].ConTyp);
           Item.SubItems.Add(LoadCon[i].Addr);
           Item.SubItems.Add(LoadCon[i].Rack);
           Item.SubItems.Add(LoadCon[i].Slot);
           Item.SubItems.Add(LoadCon[i].CpuTyp);
           ConCount:=ConCount+1;
        end;
     end;
    finally
       RzListView1.Items.EndUpdate;
       PopupMenu1.Items[0].Enabled:=(RzListView1.Items.Count<>0);
    end;
end;
Procedure TFrmContection.AddListView(aConNr:Integer;aConTypStr,aAddr,aRack,aSlot,aCpu:string);
var
 Item:TlistItem;
begin

   try
          LoadCon[Connr].ConNo:=aConNr;
          LoadCon[Connr].ConTyp:=aConTypStr;
          LoadCon[Connr].Addr:=aAddr;
          LoadCon[Connr].Rack:=aRack;
          LoadCon[Connr].Slot:=aSlot;
          LoadCon[Connr].CpuTyp:=aCpu;
          
          RzListView1.Items.BeginUpdate; 
          Item:=RzListView1.Items.Add;
          Item.Caption:=IntToStr(aConNr);
          Item.SubItems.Add(aConTypStr);
          Item.SubItems.Add(aAddr);
          Item.SubItems.Add(aRack);
          Item.SubItems.Add(aSlot);
          Item.SubItems.Add(aCpu);
   finally;
       RzListView1.Items.EndUpdate;
   end;

end;

Procedure TFrmContection.Connecterror(var message: TMessage);
var
   Msg:TMessage;
   Wp,ConFlag:integer;
   PLCINFO:PAS_INFO_TYPE;
   BufferLEN,DataLen:Integer;
   CpuType:string;
begin
     Msg:=message;
     Wp:=msg.WParam;
     if (Wp=ConError) then begin
            LoadConBar.Percent:=0;
            LoadConTimer.Enabled:=false;
        if msg.LParam<>0 then  begin
              Messagebox(Handle,Pchar(GetErrorMessage_ex6(msg.LParam)),
                         Pchar('错误代码 :0x'+ IntToHex(msg.LParam,4)),MB_OK);
        end;
        if msg.LParam=0 then begin
            LoadCon[ConNr].Connr:=true;
            LoadConBar.Percent:=100;
            LoadConTimer.Enabled:=false;
           try
              New(PLCINFO);
              DataLen:=0;
              BufferLen:=36;
              CpuType:='';
              ConFlag:=as_info_ex6(BufferLen,PLCINFO,@DataLen);
              if ( ConFlag=0) or (ConFlag=28801) then
                   CpuType:=TrimLeft(PLCINFO.mlfb)
                   else
                    Messagebox(Handle,Pchar(GetErrorMessage_ex6(ConFlag)),
                         Pchar('错误代码 :0x'+ IntToHex(ConFlag,4)),MB_OK); 
           finally
              Dispose(PLCINFO);
           end;
            AddListView(ConNr,ConTypStr,Addr,Rack,Slot,CpuType);
            UpdateLisrView;
            {Messagebox(handle,Pchar('连接成功: ' + ConTypStr +' 地址:'+ Addr),
                   Pchar('提示信息.'),MB_OK); }
            //SendMessage(Handle,WM_CLOSE,0,0);
        end ;
     end;
     ButtonCon.Enabled:=true;
end;


Procedure TCONThread.ConnectionPLC(Const AConNr,AConTyp:Integer;AAddr,ASlot,
                              ARack,AConTypStr:String;AAppHWD:Tform);
var
  AccessPoint:Pchar;
  TabLen:Smallint;
  pConTab:PCON_TABLE_TYPE;
  ConFlag:integer;
  IpAddr:IPMacByte;
  Changeok:boolean;
   PLCINFO:PAS_INFO_TYPE;
   BufferLEN,DataLen:Integer; 
begin
    if AConTyp=2 then begin
     IpAddr:=StrIPMacToByte(AAddr,Changeok);
       if not Changeok then begin
         Messagebox(AAppHWD.handle,Pchar('地址输入错误,请确认!'), Pchar('错误提示'), MB_OK);
         exit;
       end;
     end;

     if AConTyp=1 then begin
        IpAddr[1]:=StrTointrange(Trim( AAddr),2,127);
     end;
 try
   AccessPoint:=Getmemory(SizeoF('S7ONLINE')+10);
   Strcopy(AccessPoint,'S7ONLINE');
   new(pConTab);
   pConTab.Adr.Adresse[1]:=IpAddr[1];
   pConTab.Adr.Adresse[2]:=IpAddr[2];
   pConTab.Adr.Adresse[3]:=IpAddr[3];
   pConTab.Adr.Adresse[4]:=IpAddr[4];
   pConTab.Adr.Adresse[5]:=0;
   pConTab.Adr.Adresse[6]:=0;
   pConTab.AdrType:=AContyp;
   pConTab.SlotNr:=StrToInt(Trim(ASlot));
   pConTab.RackNr:=StrToInt(Trim(ARack));;
   TabLen:=9;
   ConFlag:=LoadConnection_ex6(AConNr,Accesspoint,Tablen,Pcontab);
   PostMessage(Apphwd.Handle, CM_COMMSG, ConError, ConFlag);

 finally
   Dispose(pConTab);
   Freememory(AccessPoint);
 end;
end;
procedure TCONThread.Execute;
begin
   Freeonterminate:=true;
   ConnectionPLC(ConNr,ConTyp,Addr,Slot,Rack,ConTypStr,AppHWD);
end;
//------------------------------------------------------------
procedure TFrmContection.FormCreate(Sender: TObject);
var
i:integer;
begin
   for i:=0 to 63 do begin
      ComboBoxCon.Items.Add(IntToStr(i));
   end;
   ComboBoxCon.Text:=ComboBoxCon.Items.Strings[0];
   SelConType.Items.Add('MPI 连接');
   SelConType.Items.Add('IP  连接');
   SelConType.Items.Add('MAC 连接');
   SelConType.Text :=SelConType.Items.Strings[0];
   ComboBoxCon.ItemIndex:=0;
   SelConType.ItemIndex:=0;
   Contyp:=SelConType.ItemIndex + 1;
   UpdateLisrView;
end;

procedure TFrmContection.SelConTypeChange(Sender: TObject);
begin
    Contyp:=SelConType.ItemIndex +1;
    ConNr:=ComboBoxCon.ItemIndex;
    case  Contyp of
        1: begin
             EditAddr.Width:=25;
             EditAddr.MaxLength:=3;
           end;
        2,3:begin
               EditAddr.Width:=100;
               EditAddr.MaxLength:=15;
            end;
    end;
end;
procedure TFrmContection.ButtonConClick(Sender: TObject);

begin
   ConNr:=ComboBoxCon.ItemIndex;
   Addr:=EditAddr.Text;
   Slot:=EditSlot.text;
   Rack:=EditRack.Text;
   ButtonCon.Enabled:=false;
   ConTypStr:=SelConType.Items.Strings[SelConType.ItemIndex];
   LoadConBar.Percent:=0;
   LoadConTimer.Enabled:=true;
   ConThread:=TCONThread.Create(false);
end;
procedure TFrmContection.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Action:=cafree;
end;

procedure TFrmContection.Button1Click(Sender: TObject);
begin
   close;
end;

procedure TFrmContection.LoadConTimerTimer(Sender: TObject);
begin
     LoadConBar.Percent:=LoadConBar.Percent+1;
end;

procedure TFrmContection.N1Click(Sender: TObject);
  var
     SelNo,i :integer;
     ConFlag:integer;
begin
    SelNo:=RzListView1.SelCount;
   if  RzListView1.SelCount <> 0 then  begin
       SelNo := RzListView1.ItemIndex;
       CurConNumber:=StrToInt(RzListView1.Items.Item[SelNo].Caption);
   end;
      ConFlag:=SetActiveConnection_ex6(CurConNumber);
      if ConFlag<>0 then  begin
           Messagebox(AppHWD.handle,Pchar(GetErrorMessage_ex6(ConFlag)),
                   Pchar('错误代码 :0x'+ IntToHex(ConFlag,4)),
                   MB_OK);
      end
      else begin
          PostMessage(PmainForm.Handle, CM_COMMSG, ConActiveOK, CurConNumber);
      end;

end;
end.