unit Main;
// 30.10.2010 rozpis na dlouhy a kratky test ...

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin,  ExtCtrls, tp_testcable, RTM_Types, cxGraphics,
  cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
  TpTelnetObj, dxSkinsCore, dxSkinsDefaultPainters, cxLabel, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPServer;

type
  TForm1 = class(TForm)
    Button1: TButton;
    SavecfgButton: TButton;
    Button3: TButton;
    CyclicTestButton: TButton;
    Button5: TButton;
    SendLineMemo: TMemo;
    Memo2: TMemo;
    StatusMemo: TMemo;
    Label4: TLabel;
    Timer1: TTimer;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    testCounter: TSpinEdit;
    ParitaSpinEdit: TSpinEdit;
    MultiplexByty: TEdit;
    InittelByty: TEdit;
    AdresaSpinEdit: TSpinEdit;
    ProdlevaSpinEdit: TSpinEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Klinetesbutton: TButton;
    canbustestbutton: TButton;
    DelkaTestuRadioGroup: TRadioGroup;
    DoNotTestAnswersbyteCheckBox: TCheckBox;
    Edit1: TEdit;
    Edit2: TEdit;
    cxLabel1: TcxLabel;
    cxLabel2: TcxLabel;
    Edit3: TEdit;
    Button2: TButton;
    cxLabel3: TcxLabel;
    cxLabel4: TcxLabel;
    cxLabel5: TcxLabel;
    cxLabel6: TcxLabel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    cxLabel7: TcxLabel;
    cxLabel8: TcxLabel;
    cxLabel9: TcxLabel;
    cxLabel10: TcxLabel;
    cxLabel11: TcxLabel;
    cxLabel12: TcxLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure CyclicTestButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure SavecfgButtonClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure KlinetesbuttonClick(Sender: TObject);
    procedure canbustestbuttonClick(Sender: TObject);
    procedure DoNotTestAnswersbyteCheckBoxClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);


  private
    { Private declarations }
    procedure StartTesting;
    procedure Loadcfg(AFileName: string);
    procedure Savecfg(AFileName: string);
    function GetTelsToSend: ttelegrams;

  public
    { Public declarations }
    fFindPortIndex : byte;
  end;

var
  Form1: TForm1;
  UspesnePokusy  : integer;
  KousnutePokusy : integer;
  MPXTester,
  SVGCableTest   : TSVGCableTest;
  fUDPObj : TTelnetObjUDP;
  fbuffer : ttelegram;

implementation

{$R *.dfm}

uses inifiles;


procedure TForm1.Button2Click(Sender: TObject);
var
nazev_zarizeni_txt : string;  // text obsahujici hodnotu "SuperVAG_"
nazev_zarizeni_num : string;  // text obsahuje cislo adapteru
orig_zarizeni_num : string;     // cislo adapteru, ktery se overuje
  abuf : TTelegram;
  nazev_zarizeni : TTelegram;
  i : integer;
begin
  fUDPObj := nil;
  fUDPObj := TTelnetObjUDP.Create();  // vytvorim objekt s UDP paketama

  i := 0;
  orig_zarizeni_num := edit3.text;

  StatusMemo.Lines.Add('Zjistuji IP adresu adapteru...');

  if fUDPObj <> nil then      // objekt obsahujici zpravy prichazejici pres UDP broadcast
  begin
    repeat               // ceka dokud nedojdou data - NIKDY tady nepouzivat SLEEP jako hlavni smycku, nefunguje
      sleep(500);
      application.processmessages;
      i := i+1;
        if i>=7 then
          begin
            StatusMemo.Lines.Add('  Vyprsel timeout, IP adresa nenalezena');
            StatusMemo.Lines.Add('  Ukoncuji hledani');
            exit;
          end;

    until (fUDPObj.fAnswer.Size>0);

    if fUDPObj.fanswer.size > 0 then  // pokud je nejaka zprava v objektu
    begin
      if fUDPObj.fanswer.size=110 then     // delka paketu je 110B a je vzdy konstantni
      begin
        abuf.Assign(fUDPObj.fanswer);
        nazev_zarizeni  := abuf.copy(60,32).asstring;        // Nazev zarizeni _ pozice: 60B-91B, max velikost: 32B
        edit1.text := fUDPObj.fPeerIP;
        edit2.text := IntToStr(fUDPObj.fPeerPort);

        StatusMemo.Lines.Add('Adapter s cislem ' +(orig_zarizeni_num)+' ma tyto parametry:');
        StatusMemo.Lines.Add('   IP adresa: ' +fUDPObj.fPeerIP);
        StatusMemo.Lines.Add('   Port: ' +IntToStr(fUDPObj.fPeerPort));
        StatusMemo.Lines.Add('');

        fUDPObj.fanswer.empty;
        fUDPObj.fPeerIP := '';
        fUDPObj.fPeerPort := 0;
      end;
    end;
  end;


  fUDPObj.free;      // uvolnit

end;



function TForm1.GetTelsToSend : ttelegrams;
var i : integer;
    t : ttelegram;
begin
  result.Clear;
  for i:= 0 to SendLineMemo.lines.count-1 do
  begin
    t.convertfromdecstring( SendLineMemo.Lines[i]);
    result.Append(t);
  end;

end;

procedure TForm1.StartTesting;
var a:ttelegram;
begin
  UspesnePokusy  := 0;
  KousnutePokusy := 0;

  SVGCableTest.OpenData.ConvertFromBytes([ParitaSpinEdit.value, 177, 10, 164, 8, 126, 85, AdresaSpinEdit.value]);
  a.ConvertFromDecString(MultiplexByty.text);
  if a.size<>5  then
  begin
    showmessage('malo multiplex bytu');
    exit;
  end;
  SVGCableTest.OpenData.Insert( a, 1 );
  SVGCableTest.OpenData.Value[6] := 100; // TRUST
  SVGCableTest.Inittelegram.ConvertFromDecString( InittelByty.text );
  SVGCableTest.TimeBeforeInitTel := ProdlevaSpinEdit.value;
  SVGCableTest.TelsToSend.assign(GetTelsToSend);
  SVGCableTest.DoTest('192.168.2.199', 2000); // cislo portu
  timer1.Enabled := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.lines.clear;
  TestCounter.value    := 0; // pocita se do nuly ...
  SVGCableTest.begintime     := now;
  statusmemo.lines.add('start test ' + inttostr(testcounter.value +1));
  StartTesting  ;
end;

procedure TForm1.Savecfg(AFileName : string);
var f : tmeminifile;
    i : integer;
begin
  if pos('.ini',Afilename)= 0 then
    afilename := afilename + '.ini';
  f := TmemIniFile.Create( Afilename );
  f.WriteInteger ('Data', 'Parita', ParitaSpinEdit.value);
  f.WriteInteger ('Data', 'Adresa', AdresaSpinEdit.value);
  f.WriteString  ('Data', 'Multiplex', MultiplexByty.text);
  f.WriteString  ('Data', 'InitTel', InittelByty.text);
  f.WriteInteger ('Data', 'Prodleva', ProdlevaSpinEdit.value);
  for i := 0 to SendLineMemo.lines.count - 1 do
    f.WriteString  ('Data', 'TelsToSend'+inttostr(i), sendlinememo.lines[i]);
  f.UpdateFile;
  f.free;
end;

procedure TForm1.Loadcfg(AFileName : string);
var f : tmeminifile;
    i : integer;
begin
  if pos('.INI',UpperCase(Afilename))= 0 then
    afilename := afilename + '.ini';
  if not FileExists(afilename) then exit;
  f := TmemIniFile.Create( AFileName );
  ParitaSpinEdit.value   := f.ReadInteger ('Data', 'Parita', 3);
  AdresaSpinEdit.value   := f.ReadInteger ('Data', 'Adresa', 1);
  MultiplexByty.text     := f.ReadString  ('Data', 'Multiplex', '252 254 254 1 170');
  InittelByty.text       := f.ReadString  ('Data', 'InitTel', '8');
  ProdlevaSpinEdit.value := f.ReadInteger ('Data', 'Prodleva', 0);
  i := 0;
  SendLineMemo.clear;
  while f.ValueExists('Data', 'TelsToSend'+inttostr(i)) do
  begin
    sendlinememo.lines.add( f.ReadString  ('Data', 'TelsToSend'+inttostr(i), '' ) );
    inc(i);
  end;


  f.free;
end;

procedure TForm1.SavecfgButtonClick(Sender: TObject);
begin
  if SaveDialog1.execute  then
    Savecfg( SaveDialog1.FileName );
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.execute then
    Loadcfg(opendialog1.FileName);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  TestCounter.value := 0;
  statusmemo.lines.add('prijat prikaz preruseni ');
end;

procedure TForm1.canbustestbuttonClick(Sender: TObject);
begin
  Memo2.lines.clear;
  Loadcfg(ExtractFilePath( Application.ExeName )+ 'CANBUS.INI');
  if DelkaTestuRadioGroup.ItemIndex = 0
    then TestCounter.value    := 20 // pocita se do nuly ...
    else TestCounter.value    := 0; // pocita se do nuly ...
  SVGCableTest.begintime     := now;
  statusmemo.lines.add('start CANBUS test ' + inttostr(testcounter.value +1));
  StartTesting  ;
end;

procedure TForm1.KlinetesbuttonClick(Sender: TObject);
begin
  Memo2.lines.clear;
  Loadcfg( ExtractFilePath( Application.ExeName )+ 'KLINE.INI');
  if DelkaTestuRadioGroup.ItemIndex = 0
    then TestCounter.value    := 20 // pocita se do nuly ...
    else TestCounter.value    := 0; // pocita se do nuly ...
  SVGCableTest.begintime     := now;
  statusmemo.lines.add('start K-line test ' + inttostr(testcounter.value +1));
  StartTesting  ;
end;

procedure TForm1.DoNotTestAnswersbyteCheckBoxClick(Sender: TObject);
begin
  svgcabletest.DoNotTestBytesInAsnwer := DoNotTestAnswersbyteCheckBox.checked;
end;

procedure TForm1.CyclicTestButtonClick(Sender: TObject);
begin
  statusmemo.lines.add('start test ' + inttostr(testcounter.value +1));
  SVGCableTest.begintime     := now;
  StartTesting ;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if SVGCableTest.TestRuns then
  begin
    Button5Click(nil);
    Action := caNone;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  SVGCableTest := TSVGCableTest.Create(nil);
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var s:string;
begin
  if not SVGCableTest.TestRuns  then
  begin
    Timer1.enabled := false;
    if SVGCableTest.TestResult
      then UspesnePokusy  := UspesnePokusy  + 1
      else KousnutePokusy := KousnutePokusy + 1;
    form1.caption := inttostr(SVGCableTest.CableNum)
                     + ':' + inttostr(UspesnePokusy)
                     + '/' + inttostr(KousnutePokusy);

    spinedit1.value := UspesnePokusy;
    spinedit2.value := KousnutePokusy;

    if TestCounter.value > 0 then
    begin
      TestCounter.value := TestCounter.value - 1;
      Timer1.enabled := true;
 //     SVGCableTest.DoTest('192.168.2.199', 2000); // cislo portu
      SVGCableTest.DoTest(edit1.Text, StrToInt(edit2.Text)); // cislo portu
      // edit1 = IP adresa, edit2 = port

    end
    else begin
      statusmemo.lines.add('test ukoncen');
      s := ' ---- '; // misto pro poznamku ...
      SVGCableTest.SaveLogAndClear(s, UspesnePokusy, KousnutePokusy); 
      testcounter.value := 50000;
    end;
  end
end;



end.
