wbtaunit1.pas

System will automatically delete the directory of debug and release, so please do not put files on t

  except
  end;
end;

function TForm1.ByteHex(a : byte):string;         { make form a byte a two char }
var
   n1     : byte;
   n2     : byte;
   Hexstr : string[16];
   s      : string;
begin
   s      := '';
   n2     := (a shr 4)+1;                   { add 1 for correction, pos 0 }
   n1     := (a and $0F)+1;                 { string length.              }
   Hexstr := '0123456789ABCDEF';
    s := s + '$';
    s := s + (Copy(Hexstr,n2,1));
    s := s + (Copy(Hexstr,n1,1));
    ByteHex := s;
end;

{ added WB 01.07.98, to make it possible to add ESC, CR and LF in macro }
Procedure TForm1.SendMacro(M : integer);
var S ,
   S1 ,
 Sout : String;
    I : Integer;
   Ch : Char;
begin
  case M of
    0 : S := Alt0;
    1 : S := Alt1;
    2 : S := Alt2;
    3 : S := Alt3;
    4 : S := Alt4;
    5 : S := Alt5;
    6 : S := Alt6;
    7 : S := Alt7;
    8 : S := Alt8;
    9 : S := Alt9;
  end;
  Sout := ' ';
  I := 1;
  While I <= Length(S) do begin
    Ch := S[I];
    Case Ch of
     'E' : Begin
             S1 := Copy(S,I+1,2);
             IF S1 = 'SC' then begin
                Sout := Sout + CHR(27); { put escape }
                I := I + 2;
              end else Sout := Sout + Ch;
           end;
     'C' : Begin
             S1 := Copy(S,I+1,1);
             IF S1 = 'R' then begin
                Sout := Sout + CR;  { put CR }
                INC(I);
              end else Sout := Sout + Ch;
            end;
     'L' : Begin
             S1 := Copy(S,I+1,1);
             IF S1 = 'F' then begin
                Sout := Sout + LF;  { put LF }
                INC(I);
              end else Sout := Sout + Ch;
            end;
    else { case }
       Sout := Sout + Ch;
    end;
    INC(I);
  end;
  ComTerminal1.WriteStr(CR+LF);
  ComTerminal1.WriteStr(Sout);
  Comport1.WriteStr(Sout);  // send the macro string
  sleep(100);
end;

procedure TForm1.WriteScreen(S : string);
begin
  ComTerminal1.WriteStr(S);
  If LogOn then AddTextToFile(LogFile,S,false);
   If Comterminal1.Visible = True then
     Comterminal1.SetFocus;
end;


FUNCTION TForm1.CleanStr(s:string):string;
var i,j:integer;
    so : string;
begin
 so := '';
 for i := 1 to length(s) do
  begin
    j :=ORD(s[i]);
    IF (j>31) AND (j<123) THEN so := so+chr(j);
//  IF (J = 13) OR (J = 10) then  so := so+chr(j)
  end;
 result  := so;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  AddTextToFile('error.log',' ',True);
  AddTextToFile('error.log','WBTA Startup : ' + DateToStr(Date) + ' ' +  TimeToStr(Time),True);
//ShowWindow(Application.Handle, SW_HIDE);
  AddTextToFile('error.log','form create start',true);
  LogOn := False; // log file off
  CommandRepeat := False;
  ComTerminal1.LocalEcho := True; // start with ON
  ComTerminal1.WrapLines := True;
  ComTerminal1.Emulation := teNone;
  INIFilename := ExtractFilePath (Application.ExeName) + 'WBTA_32.INI';
  IniFile := TIniFile.Create(INIFileName);
  ContrType := StrToInt(IniFile.ReadString  ('MainSection',  'Control Type ','4'));
  IniFile.Free;
  IDXNum := 100;  { no indexer selected  }
  AddTextToFile('error.log','form create end',true);
end;

procedure TForm1.FormShow(Sender: TObject);
var I     : integer;
    S : String[50];
begin
AddTextToFile('error.log','form show start',true);
  Clearscreen2Click(Sender);
  Sleep(100);
  EnumComPorts(ComStrL);
  S := 'COM Ports: ';
  for I := 0 to ComStrL.Count -1 do begin
     S  := S + ComStrL[I] + ' ';
  end;
  StatusBar1.Panels[2].Text := S;

  Progname := ' WBTA    '; // easy to change
  PutContrSpec;
  Form1.SpeedButton3.Hint :=  'Log file = '+ LogFile;
AddTextToFile('error.log','form show end',true);
end;


procedure TForm1.SetCom1Click(Sender: TObject);
begin
  Timer1.Enabled := False; // stop timer !!!!!!

  if ComPort1.Connected then
     ComPort1.Close
  else
     ComPort1.Open;
  ComPort1.ShowSetupDialog;
  if ComPort1.Connected then
     ComPort1.Close
  else
     ComPort1.Open;

  StatusBar1.Panels[0].Text := ' '+ Comport1.Port + ' ' +
     BaudRateToStr(ComPort1.BaudRate) + ' ' +
     DataBitsToStr(ComPort1.DataBits) + ' ' +
     ParityToStr(ComPort1.Parity.Bits) + ' ' +
     StopBitsToStr(ComPort1.StopBits);

 // procedure BaudRateToStr(BaudRate: TBaudRate): String;

  Baudrate := StrToInt(BaudRateToStr(ComPort1.BaudRate));
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  If Application.MessageBox('You want really stop this program ?',
     'Stop this program', mb_systemmodal+mb_iconquestion+mb_okcancel
     +mb_defbutton1) = 1 then
  begin
    Doorgaan := False;
    Sleep(50);
//  ComPort1.ClearBuffer(True, True);
    Comport1.Close;
    Close;
  end;
end;

procedure TForm1.CAASCA11Click(Sender: TObject);
begin
  ContrType := 1;
  PutContrSpec;
end;

procedure TForm1.CAASCA21Click(Sender: TObject);
begin
  ContrType := 2;
  PutContrSpec;
end;

procedure TForm1.DRSC1Click(Sender: TObject);
begin
  ContrType := 3;
  PutContrSpec;
end;

procedure TForm1.SS2000I1Click(Sender: TObject);
begin
  ContrType := 4;
  PutContrSpec;
  TermReceive;
end;

procedure TForm1.PIEPI1Click(Sender: TObject);
begin
  ContrType := 5;
  PutContrSpec;
  TermReceive;
end;

procedure TForm1.TDC1Click(Sender: TObject);
begin
  ContrType := 6;
  PutContrSpec;
  TermReceive;
end;

procedure TForm1.WarpDrive1Click(Sender: TObject);
begin
  ContrType := 7;
  PutContrSpec;
  TermReceive;
end;

procedure TForm1.HEXMode1Click(Sender: TObject);
begin
  HEXMode := NOT HEXMode;
  Hexmode1.Checked := HEXMode;
end;

procedure TForm1.Terminal1Click(Sender: TObject);
begin
  Comterminal1.ShowSetupDialog;
  if Comterminal1.Emulation = teNone
        then Emulation := 0;
  if Comterminal1.Emulation = teVT100orANSI then Emulation := 1;
  if Comterminal1.Emulation = teVT52        then Emulation := 2;
  if Comterminal1.Emulation = teVT100orANSI then Emulation := 3;
end;

procedure TForm1.Clearscreen2Click(Sender: TObject);
begin
  Comterminal1.ClearScreen;
  Comterminal1.MoveCaret(1,Comterminal1.Rows);
end;

procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = CR  then begin
     with ComboBox1 do
       if (Text <> '') and (items.IndexOf(Text) < 0) then
          Items.Add(Text);
 //      ComboBox1.ItemIndex := 0;
       key := #0;
  end;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if ((Combobox1.DroppedDown = True) and ( Key = VK_DELETE)) then begin
      Combobox1.Items.Delete(Combobox1.ItemIndex);
      IF ComboBox1.DroppedDown THEN ComboBox1.DroppedDown := False;
      IF NOT ComboBox1.DroppedDown THEN ComboBox1.DroppedDown:=True;
   end;
end;

procedure TForm1.ClearAll1Click(Sender: TObject);
begin
  ComboBox1.Items.Clear;
  ComboBox1.Text := 'Command buffer';
end;

procedure TForm1.UpdateCombo(S : String);
begin
  If ComboBox1.Items.IndexOf(S) = -1 then begin
     Combobox1.Items.Insert(0,S);
     ComboBox1.ItemIndex := 0;
     If ComboBox1.Items.Count > 16 then
     ComboBox1.Items.Delete(17);
  end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  If LOgOn then AddTextToFile(LogFile,Key,false);
  If ComboBox1.Focused then exit; // to type text in the combobox
  If StringGrid1.Focused then exit;
  Case ContrType of  // SS2000I, (E)PI
     4,5 : begin
              KeyOut:= Key;
                 case KeyOut of
                    #$0D :  begin
                              WriteScreen(CR+LF); { added linefeed WB 1/2/1995 }
                              Comport1.WriteStr(Key);
                              NewRep := True;
                              if UpperCase(StrOut) = 'ERR' then begin
                                 EPI_IO_Form.GetEpiError; //GetEpiError;
                                 StrOut := '';
                              end else begin
                                 UpdateCombo(StrOut);
                              end;
                            end;
                 else  begin
                    CommandRepeat := False;
                    Timer1.Enabled := False; // stop autorepeat
                    Comport1.WriteStr(Key);  // SendChar(keyout);  { to RS232 }
                    if Comterminal1.LocalEcho then
                       ComTerminal1.WriteStr(Key);
                    If NewRep = True then StrOut := '';
                    NewRep := False;
                    If KeyOut in [#32..#34,#37..#41,#43..#127] then
                       StrOut := StrOut + KeyOut;
                    If KeyOut = #8 then
                       Delete(StrOut,length(StrOut),1);
                  end;
                end; {case }
           end;
     6,7 : begin  // TDC , WarpDrives
              KeyOut := Key;
              case KeyOut of
                #$0D :  begin
                           WriteScreen(CR+LF);  // WriteLN ;  { added linefeed WB 1/2/1995 }
                           Comport1.WriteStr(Key);  // SendChar(KeyOut);
                           NewRep := True;
                           UpdateCombo(StrOut);
                           if UpperCase(StrOut) = 'ERR' then begin
                              WarpIOForm.GetCCError(CCerror);
                              StrOut := '';
                           end;
                        end;
                else  begin
                   CommandRepeat := False;
                   Timer1.Enabled := False; // stop autorepeat
                   Comport1.WriteStr(Key);  // SendChar(keyout);  { to RS232 }
                   if Comterminal1.LocalEcho then
                      ComTerminal1.WriteStr(Key);
                   If NewRep = True then StrOut := '';
                   NewRep := False;
                   If KeyOut in [#32..#34,#37..#41,#43..#127] then
                      StrOut := StrOut + KeyOut;
                   If KeyOut = #8 then
                       Delete(StrOut,length(StrOut),1);
//                       Edit2.Text := StrOut;       // for test
                end;
              end; {case }
           end;  // TDC , WarpDrives
    end; // case contrtype
    Key := #0;
end;


Procedure TForm1.TermReceive;
var Str : string;
      I : Integer;
     Ch : char;
Begin
  Doorgaan := True;
  ContrOld := ContrType;
  While (Doorgaan = True) AND (ContrType = ContrOld) do begin
    NumberOfBytes := Comport1.InputCount;
    ComPort1.ReadStr(Str, NumberOfBytes);        // ByteEin := inbyte(newbyte);
    IF NumberOfBytes > 0 then Begin
       IF HexMode = True Then begin
          For I := 1 to length(Str) do begin
             Ch := Str[I];
             If CH < #31 then begin  // smaller then space
                WriteScreen(' <'+ByteHex(Ord(Ch))+'>');