dftestfm.pas

倉庫下線條碼源碼

unit DFTestFm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, DoorForbidImplBody, ParamListIntfBody,
  DFTypeImplBody, DFOutParaImplBody, DB, ADODB, Buttons, SQueryButton,
  ExtCtrls, ReportDBGrid, ComCtrls, MessageUnit, Sockets;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button20: TButton;
    Timer1: TTimer;
    Button21: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button21Click(Sender: TObject);
  private
    { Private declarations }
    ff: TWG_DoorForbid_TCP;
    rstest: TWG_DoorForbid_RS;
    procedure MySleep(nmin: Cardinal);
  protected
    procedure WMTHREADPROGRESSED(var msg: TMessage); message WM_THREAD_PROGRESS;  
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses EDC_Dlls;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  inPar: TParamListImpl;
  tpj: TTCP_IP_ParamObj;
begin
  Self.AlphaBlendValue := 0;
  Self.AlphaBlend := True;
  rstest := TWG_DoorForbid_RS.Create;

  ff := TWG_DoorForbid_TCP.Create;
  inPar := TParamListImpl.Create;
  tpj := TTCP_IP_ParamObj.Create;
  tpj.SetObjectName('TCPIPParamObject');
  tpj.FWorkModle := True;
  tpj.FLocalClientType := ctNonBlocking;
  tpj.FLocalServerPort := 10001;
  tpj.FLocalServiceType := stNonBlocking;
  tpj.FRemotServerAddr := '192.168.1.166';
  tpj.FRemotServerName := '';
  tpj.FRemotServerPort := 10001;
  tpj.FTheadChacheSize := 15;
  inPar.AddObjParam(tpj);
  ff.SetTCPIPParam(inPar);
  if tpj <> nil then
    FreeAndNil(tpj);
  if inPar <> nil then
    FreeAndNil(inPar);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ff <> nil then
    FreeAndNil(ff);
  if rstest <> nil then
    FreeAndNil(rstest);  
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  aa: Integer;
begin
  aa := ff.ConnectToServer;
  if aa = 1 then
    Self.Caption := 'Connected'
  else if aa = -8 then
    Self.Caption := 'Connected timeout'
  else
    Self.Caption := 'not connect';  
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ff.Disconnect > 0 then
    Self.Caption := 'Disconnected'
  else
    Self.Caption := 'Error Disconnected';  
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  stp1: string;
  parin,outParam: TParamListImpl;
  wgStatus: TWG_DeviceStatus;
  itp1: Integer;
begin
  wgStatus := TWG_DeviceStatus.Create;
  wgStatus.SetObjectName('DeviceStatus');
  outParam := TParamListImpl.Create;
  outParam.AddObjParam(wgStatus);
  parin := TParamListImpl.Create;
  parin.AddStringParam('1','Position');
  itp1 := ff.ReadDeviceStatus(30009,parin,outParam);
  if itp1 = -8 then
    stp1 := 'command timeout'
  else
  if itp1 = -7 then
    stp1 := 'command not excute'
  else
    stp1 := DateTimeToStr(wgStatus.FCurrentTime)+'  '+IntToStr(wgStatus.FCurrentWeek)+#$D#$A
      +IntToStr(wgStatus.FDataCount)+'  '+IntToStr(wgStatus.FRightCount)+'  '+wgStatus.FCardSerial;
  ShowMessage(stp1);
  if outParam <> nil then
    FreeAndNil(outParam);
  if wgStatus <> nil then
    FreeAndNil(wgStatus);
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  inP,OutP: TParamListImpl;
begin
  inP := TParamListImpl.Create;
  OutP := TParamListImpl.Create;
  inP.AddStringParam(IntToStr(Self.Handle),'msgHandle');
  if ff.ReadDeviceData(32052,0,inP,OutP) = -8 then
    ShowMessage('Receive Data timeout');
  Memo1.Lines.Clear;
  Memo1.Lines.Text := OutP.GetStringParamText;
  if inP <> nil then
    FreeAndNil(inP);
  if outP <> nil then
    FreeAndNil(OutP);
end;

procedure TForm1.WMTHREADPROGRESSED(var msg: TMessage);
begin
  if msg.WParam = 0 then
  begin
    ProgressBar1.Max := msg.LParam;
  end else
  if msg.WParam = 1 then
  begin
    ProgressBar1.Position := msg.LParam; 
  end else
  if msg.WParam = 3 then
  begin
    ProgressBar1.Position := 0;
    if msg.LParam = 0 then
      ShowMessage('receive finished')
    else
    if msg.LParam = 1 then
      ShowMessage('receive data time out');  
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  dtBuff: array[0..10] of TConvertInfo;
  i,iCount,j: integer;
  stp1,stMac: string;
  dd: PConvertSetting;
begin
  Memo1.Lines.Clear;
  New(dd);
  FindConverter(dtBuff,10,False,10000);
  Sleep(50);
  iCount := FindConverter(dtBuff,10,False,10000);
  for i := 0 to iCount-1 do
  begin
    stp1 := 'con'+IntToStr(i)+' type '+IntToStr(dtBuff[i].devType);
    Memo1.Lines.Add(stp1);
    stp1 := 'con'+IntToStr(i)+' Peer Ip '+dtBuff[i].strIP;
    Memo1.Lines.Add(stp1);
    stp1 := 'con'+IntToStr(i)+' MacAddress '+dtBuff[i].strMAC;
    stMac := dtBuff[i].strMAC;
    Memo1.Lines.Add(stp1);
    if GetConvSetting(PChar(stMac),dd,False,10000) then
    begin
      stp1 := 'con'+IntToStr(i)+' staticIP '+IntToStr(dd.netSetting.bStaticIP);
      Memo1.Lines.Add(stp1);
      stp1 := 'con'+IntToStr(i)+' IPAddress '+dd.netSetting.ipAddr;
      Memo1.Lines.Add(stp1);
      stp1 := 'con'+IntToStr(i)+' Dns '+dd.netSetting.ipDns;
      Memo1.Lines.Add(stp1);
      stp1 := 'con'+IntToStr(i)+' Gateway '+dd.netSetting.ipGateway;
      Memo1.Lines.Add(stp1);
      stp1 := 'con'+IntToStr(i)+' Mask '+dd.netSetting.ipMask;
      Memo1.Lines.Add(stp1);
      for j := 1 to 8 do
      begin
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' baudRate '+IntToStr(dd.comSetting[j].baudrate);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' checkmode '+IntToStr(dd.comSetting[j].checkmode);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' databit '+IntToStr(dd.comSetting[j].databit);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' flowmode '+IntToStr(dd.comSetting[j].flowmode);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' minsendbyte '+IntToStr(dd.comSetting[j].minsendbyte);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' minsendtime '+IntToStr(dd.comSetting[j].minsendtime);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' com'+IntToStr(j)+' stopbit '+IntToStr(dd.comSetting[j].stopbit);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' socket'+IntToStr(j)+' bUseOcx '+IntToStr(dd.sockSetting[j].bUseOcx);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' socket'+IntToStr(j)+' iMode '+IntToStr(dd.sockSetting[j].iMode);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' socket'+IntToStr(j)+' port '+IntToStr(dd.sockSetting[j].port);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' socket'+IntToStr(j)+' ServerPort '+IntToStr(dd.sockSetting[j].ServerPort);
        Memo1.Lines.Add(stp1);
        stp1 := 'con'+IntToStr(i)+' socket'+IntToStr(j)+' ServerIP '+dd.sockSetting[j].ipServer;
        Memo1.Lines.Add(stp1);
      end;
    end else
      Memo1.Lines.Add('GetConvSetting Failur');
  end;
  Dispose(dd);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  inPar,outPar: TParamListImpl;
  stp1: string;
  tpObj: TObject;
  ddd: TDF_SearchConvert;
  i: integer;
begin
  inPar := TParamListImpl.Create;
  outPar := TParamListImpl.Create;
  ff.SearchDevice(inPar,outPar);
  Memo1.Lines.Clear;
  for i := 0 to outPar.GetObjParamCount-1 do
  begin
    tpObj := outPar.GetObjParam(i);
    if (tpObj <> nil) and (tpObj is TDF_SearchConvert) then
    begin
      ddd := (tpObj as TDF_SearchConvert);
      stp1 := 'MAC Address: '+ddd.FstrMAC+'    IP Address: '+ddd.FstrIPAddr
        +'    Port: '+IntToStr(ddd.FarSockSetting[1].port)
        +'    Type: '+IntToStr(ddd.FDeviceType);
      Memo1.Lines.Add(stp1);  
    end;  
  end;
  if inPar <> nil then
    FreeAndNil(inPar);
  if outPar <> nil then
    FreeAndNil(outPar);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  inP,OutP: TParamListImpl;
  dd: TwarningDataObj;
  ii: integer;
begin
  inP := TParamListImpl.Create;
  OutP := TParamListImpl.Create;
  dd := TwarningDataObj.Create;
  dd.SetObjectName('WarningParamObject');
  dd.FCoerceOpenWarning := False;
  dd.FCoerceWarning := False;
  dd.FLongWarning := False;
  inP.AddObjParam(dd);
  ii := ff.SetWarningRecord(31004,inP,OutP);
  if ii = -8 then
    ShowMessage('Set Warning Record timeout');
  Memo1.Lines.Clear;
  Memo1.Lines.Add('Set Warning Record timeout Result :  '+IntToStr(ii));
  if inP <> nil then
    FreeAndNil(inP);
  if outP <> nil then
    FreeAndNil(OutP);
  if dd <> nil then
    FreeAndNil(dd);  
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  rightParam: TParamListImpl;
  nRes: integer;
begin
//