unit FProgMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, jpeg, Thales, Tasten, ComCtrls, Instrect,
  Thalmisc, FusesD;

type
  TProgMain = class(TForm)
    Timer1: TTimer;
    OpenDlg: TOpenDialog;
    Panel9: TPanel;
    Panel10: TPanel;
    StatusBar: TStatusBar;
    IniEditor: TIniEditor;
    ComSpin: TTextSpin;
    FileBox: TComboBox;
    SearchBtn: TBitBtn;
    NewBtn: TBitBtn;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    ComPortLabel: TLabel;
    SmartTimer: TSmartTimer;
    Bevel1: TBevel;
    DelBtn: TSpeedButton;
    HintsCheck: TCheckBox;
    PswdBtn: TSpeedButton;
    Image1: TImage;
    LEDD0: TLedCheck;
    LEDP0: TLedCheck;
    Gauge0: TGaugeGp;
    DnLdBtn0: TBitBtn;
    ProgBtn0: TSpeedButton;
    ProgStatus0: TLabel;
    ProjLabel0: TLabel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    TestBtn: TButton;
    Bevel5: TBevel;
    Label1: TLabel;
    ScanOpenBtn: TButton;
    ScanCloseBtn: TButton;
    ChainDownBtn: TButton;
    ChainUpBtn: TButton;
    VerifyBtnF: TSpeedButton;
    EraseBtn0: TSpeedButton;
    LdPackFileBtn: TSpeedButton;
    ProgEEpBtn: TSpeedButton;
    ProgFuseBtn: TSpeedButton;
    ProgLockBtn: TSpeedButton;
    VerifyBtnA: TSpeedButton;
    VerifyBtnE: TSpeedButton;
    ReadFuseBtn: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure NewBtnClick(Sender: TObject);
    procedure SearchBtnClick(Sender: TObject);
    procedure DownloadButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ProgFlashClick(Sender: TObject);
    procedure DnLdDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure DnLdDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure SmartTimerTimerEvent(Sender: TObject; BlinkHigh: Boolean);
    procedure DelBtnClick(Sender: TObject);
    procedure HintsCheckClick(Sender: TObject);
    procedure FileBoxDropDown(Sender: TObject);
    procedure PswdBtnClick(Sender: TObject);
    procedure TestBtnClick(Sender: TObject);
    procedure ScanCloseBtnClick(Sender: TObject);
    procedure ScanOpenBtnClick(Sender: TObject);
    procedure ChainDownBtnClick(Sender: TObject);
    procedure ChainUpBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure EraseBtn0Click(Sender: TObject);
    procedure VerifyBtnFClick(Sender: TObject);
    procedure LdPackFileBtnClick(Sender: TObject);
    procedure FileBoxClick(Sender: TObject);
    procedure ProgEEpBtnClick(Sender: TObject);
    procedure ProgFuseBtnClick(Sender: TObject);
    procedure ProgLockBtnClick(Sender: TObject);
    procedure VerifyBtnAClick(Sender: TObject);
    procedure VerifyBtnEClick(Sender: TObject);
    procedure ReadFuseBtnClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  ProgMain: TProgMain;


implementation


type
  tProgResult = (resNone, noProg, progFound, MemError, progBusy,
                 progIdle, progProtected, eraChip, eraEEp, eraFlash, prgEEp,
                 prgFlash, verifyEEp, verifyFlash, errPwrDown, errSignature,
                 errProtected, errNotEmpty, errVerify, progDone, dwnLoading,
                 dwnLoadErrP, dwnLoadErrE, dwnLoadErrF, dwnLoadErr, invFile,
                 invFName, FileExist, notFound, invPassword, limitExc, errProgType,
                 resOk, progNoJTAG, progNoSupply, errPwrSupply);


procedure AbortAll; stdcall; external 'ProgDLLN.dll'

procedure GetProgStatus(Channel: integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = resNone, limitExc, eraChip, prgEEp, prgFlash, progDone, errPwrDown,
//       errSignature, errProtected, errNotEmpty, errVerify

procedure GetPasswd(var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll'
// res = progBusy, resOk

procedure AddNewFile(FileName: PChar; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll'
// res = progBusy, invFile, invFName, invPassword, FileExist, resOk

procedure DeleteFile(FileName: PChar; var res : integer; resStr: PChar); stdcall;external 'ProgDLLN.dll';
// res = progBusy, invFName, notFound, errProtected, resOk

procedure GetFile(index : integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, notFound, resOk

procedure DownloadFile(ProjName: PChar; BurnCycles: Integer; Channel : Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, limitExc, errProgType, progProtected, dwnLoadErrP, dwnLoadErrF,
//       dwnLoadErrE, dwnLoadErr, noProg, resOk

procedure CheckProgrammer(Channel: integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, errProgType, progFound

procedure EraseProgrammer(Channel: integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk

procedure GetProjName(Channel : integer; var Age : integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, errProgType, resOk

procedure GetACCUstate(Channel: integer; var ACCU : integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, errProgType, resOk

procedure GetTargVolt(Channel: integer; var Volt : integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, errProgType, resOk

// "L", "F", "H", "E", "0", "1", "2", "3"
procedure GetFuses(Channel : integer; selfuse : char; var fuse : integer; var res : integer; resStr : PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, errProgType, MemError, resOk

procedure CheckDevice(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = resNone, progBusy, noProg, errProgType, errPwrDown, errSignature,
//       errNotEmpty, errProtected

procedure SetChannel(var Channel : integer; PortName: PChar; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progFound

procedure ProgDevice(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure ProgFlash(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure ProgEEprom(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure ProgFuses(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure ProgLockBits(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure EraseDevice(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure VerifyDevice(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure VerifyFlashOnly(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure VerifyEEpromOnly(Channel: Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk  rest of states must be done with "GetProgStatus"

procedure DownLoadBlockF(Block : Pointer; BlockSize, dest, Channel : Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure DownLoadBlockE(Block : Pointer; BlockSize, dest, Channel : Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure UpLoadBlockF(Block : Pointer; BlockSize, source, Channel : Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure UpLoadBlockE(Block : Pointer; BlockSize, source, Channel : Integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure ReadBackF(Block : Pointer; BlockSize, source, Channel : Integer; var res : integer; resStr : PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure ReadBackE(Block : Pointer; BlockSize, source, Channel : Integer; var res : integer; resStr : PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, dwnLoadErr, resOk

procedure EnterProgMode(Channel : Integer; var res : integer; resStr : PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, resOk

procedure ReleaseDevice(Channel : Integer; var res : integer; resStr : PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, progProtected, resOk


procedure JTAGBoundaryOpen(Channel: integer; CpuID, BoundaryLen, SupplyVolt, SupplyCurr : integer;
                          var res : integer; resStr: PChar); stdcall;  external 'ProgDLLN.dll';
// res = progBusy, noProg, progNoJTAG, progNoSupply, errPwrSupply, errSignature, resOk

procedure JTAGchainWrite(Channel : Integer; Block : Pointer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, , resOk

procedure JTAGchainRead(Channel : Integer; Block : Pointer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, , resOk

procedure JTAGBoundaryClose(Channel: integer; var res : integer; resStr: PChar); stdcall; external 'ProgDLLN.dll';
// res = progBusy, noProg, resOk


{$R *.DFM}

type
  tChState  = (cUnknown, cMemError, cIdle, cDownLd, cProg, cErase, cVerify);

var
  status    : tChState;
  ProjName0 : string;
  isEncr    : boolean;


  ScanDownBuffer : array[0..255] of byte;
  ScanUpBuffer   : array[0..255] of byte;


procedure TProgMain.FormCreate(Sender: TObject);
var res, idx  : integer;
    st        : string;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  isEncr:= true;
  ComSpin.position:= IniEditor.ReadInt('Setup', 'ComPort', 0);
  ShowHint:= IniEditor.ReadBool('Setup', 'ShowHint', false);
  HintsCheck.checked:= ShowHint;

  idx:= 0;
  repeat
    GetFile(idx, res, PstBuffer);
    st:= PstBuffer;
    if tProgResult(res) = resOk then begin
      FileBox.Items.Add(st);
      inc(idx);
    end;
  until tProgResult(res) <> resOk;
  try
    FileBox.Text:= FileBox.Items[0];
  except
  end;
  StatusBar.SimpleText:= 'ready';
end;

// res = resNone, limitExc, eraChip, prgEEp, prgFlash, progDone, errPwrDown,
//       errSignature, errProtected, errNotEmpty, errVerify
procedure TProgMain.Timer1Timer(Sender: TObject);
var st        : string;
    res       : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  if Status in[cProg, cErase, cVerify] then begin
    GetProgStatus(0, res, PstBuffer);
    st:= PstBuffer;
    if st <> '' then ProgStatus0.Caption := st;
    case tProgResult(res) of
      progDone     : begin
                       status:= cIdle;
                       Beep;
                     end;
      eraChip,
      prgEEp,
      prgFlash     : begin
                       Gauge0.Percent:= Gauge0.Percent+1;
                       if Gauge0.Percent > 100 then Gauge0.Percent:= 0;
                     end;
      limitExc,
      errPwrDown,
      errSignature,
      errProtected,
      errNotEmpty,
      errVerify    : begin
                       status:= cIdle;
                     end;
    end;
  end;
  if status = cIdle then begin
    Screen.Cursor:= crDefault;
    Timer1.Enabled := false;
  end;
end;

procedure TProgMain.SearchBtnClick(Sender: TObject);
var st        : string;
    PortName  : PChar;
    Age, ACCU,
    idx, res  : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  ScanOpenBtn.Enabled:= false;
  ScanCloseBtn.Enabled:= false;
  ChainDownBtn.Enabled:= false;
  ChainUpBtn.Enabled:= false;
  Screen.cursor:= crHourGlass;
  Timer1.enabled:= false;
  SearchBtn.enabled:= false;
  NewBtn.enabled:= false;
  ComPortLabel.Caption:= 'none';
  Status:= cUnknown;
  DnLdBtn0.enabled:= false;
  LdPackFileBtn.enabled:= false;
  ProgBtn0.enabled:= false;
  TestBtn.enabled:= false;
  ReadFuseBtn.enabled:= false;
  VerifyBtnF.enabled:= false;
  VerifyBtnE.enabled:= false;
  VerifyBtnA.enabled:= false;
  EraseBtn0.enabled:= false;
  ProgEEpBtn.enabled:= false;
  ProgLockBtn.enabled:= false;
  ProgFuseBtn.enabled:= false;
  ProgStatus0.caption:= '?';
  ProjLabel0.caption:= '';
  ProjName0:= '';
  Gauge0.Percent:= 0;
  StatusBar.SimpleText:= 'searching ICP';
  idx:= 0;
  PortName:= PChar(ComSpin.PosString);
  SetChannel(idx, PortName, res, PstBuffer);
  st:= PstBuffer;
  Beep;
  if tProgResult(res) = noProg then begin
    StatusBar.SimpleText:= 'no ICP found';
  end
  else if tProgResult(res) = progBusy then begin
    if MessageDlg('ICP is busy!'+#13+'Reset ICP?',
                   mtWarning, [ mbYes, mbNo],0) = mrYes then begin
      AbortAll;
      SetChannel(idx, PortName, res, PstBuffer);
      st:= PstBuffer;
    end;
  end;
  if (tProgResult(res) = progFound) then begin
    StatusBar.SimpleText:= 'Prog'+IntToStr(idx+1)+' at '+PortName+' found';
    ComPortLabel.Caption:= PortName;
    idx:= 0;
    CheckProgrammer(idx, res, PstBuffer);
    st:= PstBuffer;
    if tProgResult(res) = MemError then begin
      Beep;
      Status:= cMemError;
      DnLdBtn0.enabled:= true;
      LdPackFileBtn.enabled:= true;
      TestBtn.enabled:= false;
      ReadFuseBtn.enabled:= false;
      ProgBtn0.enabled:= false;
      VerifyBtnF.enabled:= false;
      VerifyBtnE.enabled:= false;
      VerifyBtnA.enabled:= false;
      EraseBtn0.enabled:= false;
      ProgEEpBtn.enabled:= false;
      ProgLockBtn.enabled:= false;
      ProgFuseBtn.enabled:= false;
      ProgStatus0.caption:= 'ICP found memory error';
      StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' found, but memory error';
    end
    else if tProgResult(res) = progFound then begin
      Beep;
      Status:= cIdle;
      DnLdBtn0.enabled:= true;
      LdPackFileBtn.enabled:= true;
      TestBtn.enabled:= true;
      ReadFuseBtn.enabled:= true;
      ProgBtn0.enabled:= true;
      VerifyBtnF.enabled:= true;
      VerifyBtnE.enabled:= true;
      VerifyBtnA.enabled:= true;
      EraseBtn0.enabled:= true;
      ProgEEpBtn.enabled:= true;
      ProgLockBtn.enabled:= true;
      ProgFuseBtn.enabled:= true;
      ProgStatus0.caption:= 'ICP found';
      GetProjName(idx, Age, res, PstBuffer);
      st:= PstBuffer;
      ProjName0:= st;
      ProjLabel0.caption:= st;
      StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' found';
      GetACCUstate(idx, ACCU, res, PstBuffer);
      st:= PstBuffer +'%';
      Gauge0.Percent:= ACCU;
      if st <> '' then;
      if ACCU <> 0 then;
      ScanOpenBtn.Enabled:= true;
    end
    else begin
      ProgStatus0.caption:= 'not found';
      ComPortLabel.Caption:= 'none';
      Status:= cUnknown;
      StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' not found';
    end;
  end
  else begin
    ComPortLabel.Caption:= 'none';
    StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' not found';
  end;
  Screen.cursor:= crDefault;
  SearchBtn.enabled:= true;
  NewBtn.enabled:= true;
  Beep;
end;

procedure TProgMain.NewBtnClick(Sender: TObject);
var fn, st    : string;
    res, idx  : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.enabled:= false;
  if OpenDlg.Execute then begin
    AddNewFile(PChar(OpenDlg.FileName), res, PstBuffer);
    fn:= PstBuffer;
    case tProgResult(res) of
      invFile  : StatusBar.SimpleText:= 'corrupted file';
      invFName : StatusBar.SimpleText:= 'invalid filename';
      FileExist: StatusBar.SimpleText:= 'file already exists';
      notFound : StatusBar.SimpleText:= 'file not found';
      invPassword : StatusBar.SimpleText:= 'Password failed';
    else
      fn:= ExtractFileName(ChangeFileExt(OpenDlg.FileName, ''));
      FileBox.Items.Clear;
      idx:= 0;
      repeat
        GetFile(idx, res, PstBuffer);
        st:= PstBuffer;
        if tProgResult(res) = resOk then begin
          FileBox.Items.Add(st);
          inc(idx);
        end;
      until tProgResult(res) <> resOk;
      FileBox.Text:= fn;
      StatusBar.SimpleText:= IntToStr(idx)+' projects found';
    end;
  end;
end;

procedure TProgMain.DownloadButtonClick(Sender: TObject);
var idx   : byte;
    res   : integer;
    st    : string;
    saveState : tChState;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := False;
  Screen.cursor:= crHourGlass;
  idx := 0;
  Gauge0.Percent:= 0;
  case Status of
    cMemError,
    cIdle    : begin
                 saveState:= Status;
                 Status:= cDownLd;
                 ProgStatus0.caption := 'downloading';
                 if isEncr then begin
                   st:= FileBox.Text;
                   st:= ChangeFileExt(st, '.encr');
                 end
                 else begin
                   st:= OpenDlg.FileName;
                 end;
                 try
                   DownloadFile(PChar(st), 1000, idx, res, PstBuffer);
                   st:= PstBuffer;
                 except
                 end;
                 ProgStatus0.caption := st;
                 // handle result
                 if tProgResult(res) = limitExc then begin
                   Status:= saveState;
                   ProgStatus0.caption:= st;
                   StatusBar.SimpleText:= 'ICP '+FileBox.Text+' cycle limit exceeded';
//                   Status[idx].ProjLabel0.caption:= '';
//                   Status[idx].ProjName0:= '';
                 end
                 else if tProgResult(res) in[invFile, invFName] then begin
                   Status:= saveState;
                   ProgStatus0.caption:= st;
                   StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' invalid file';
//                   Status[idx].ProjLabel0.caption:= '';
//                   Status[idx].ProjName0:= '';
                 end
                 else if tProgResult(res) in[MemError, dwnLoadErrP, dwnLoadErrE, dwnLoadErrF, dwnLoadErr] then begin
                   ProgStatus0.caption:= 'download error';
                   Status:= cMemError;
                   TestBtn.enabled:= false;
                   ReadFuseBtn.enabled:= false;
                   ProgBtn0.enabled:= false;
                   VerifyBtnF.enabled:= false;
                   VerifyBtnE.enabled:= false;
                   VerifyBtnA.enabled:= false;
                   EraseBtn0.enabled:= false;
                   ProgEEpBtn.enabled:= false;
                   ProgLockBtn.enabled:= false;
                   ProgFuseBtn.enabled:= false;
                   StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' download error';
                   ProjLabel0.caption:= '';
                   ProjName0:= '';
                 end
                 else begin
                   ProgStatus0.caption:= 'idle';
                   Status:= cIdle;
                   TestBtn.enabled:= true;
                   ReadFuseBtn.enabled:= true;
                   ProgBtn0.enabled:= true;
                   VerifyBtnF.enabled:= true;
                   VerifyBtnE.enabled:= true;
                   VerifyBtnA.enabled:= true;
                   EraseBtn0.enabled:= true;
                   ProgEEpBtn.enabled:= true;
                   ProgLockBtn.enabled:= true;
                   ProgFuseBtn.enabled:= true;
                   if isEncr then begin
                     ProjLabel0.caption:= FileBox.Text;
                     ProjName0:= FileBox.Text;
                   end
                   else begin
                     st:= ExtractFileName(OpenDlg.FileName);
                     st:= ChangeFileExt(st, '');
                     ProjLabel0.caption:= st;
                     ProjName0:= st;
                   end;
                   StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' download ok';
                 end;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
  end;
  Screen.cursor:= crDefault;
end;

procedure TProgMain.DnLdDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if source is TComboBox then begin
    Accept:= Status = cIdle;
  end;
end;

procedure TProgMain.DnLdDragDrop(Sender, Source: TObject; X, Y: Integer);
var st    : string;
begin
  Timer1.enabled:= false;
  if (Source is TComboBox) then begin
    st:= (Source as TComboBox).Text;
    if st <> '' then begin
      DownloadButtonClick(Sender);
    end
    else beep;
  end;
end;

procedure TProgMain.ProgFlashClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' programming';
                 ProgStatus0.caption:= 'programming';
                 Status:= cProg;
                 ProgDevice(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.ProgEEpBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  Gauge0.Percent:= 0;
  Timer1.Enabled := True;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' programming';
                 ProgStatus0.caption:= 'programming';
                 Status:= cProg;
                 ProgEEprom(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.ProgFuseBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' programming';
                 ProgStatus0.caption:= 'programming';
                 Status:= cProg;
                 ProgFuses(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
                 Screen.Cursor:= crDefault;
                 Status:= cIdle;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.ProgLockBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' programming';
                 ProgStatus0.caption:= 'programming';
                 Status:= cProg;
                 ProgLockBits(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
                 Screen.Cursor:= crDefault;
                 Status:= cIdle;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.EraseBtn0Click(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' erase chip';
                 ProgStatus0.caption:= 'erasing';
                 Status:= cErase;
                 EraseDevice(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.VerifyBtnFClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' verify Flash';
                 ProgStatus0.caption:= 'verifying';
                 Status:= cVerify;
                 VerifyFlashOnly(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.VerifyBtnEClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' verify EEprom';
                 ProgStatus0.caption:= 'verifying';
                 Status:= cVerify;
                 VerifyEEpromOnly(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.VerifyBtnAClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.Enabled := True;
  idx:= 0;
  Gauge0.Percent:= 0;
  case Status of
    cIdle    : begin
                 Screen.cursor:= crHourGlass;
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' verify chip';
                 ProgStatus0.caption:= 'verifying';
                 Status:= cVerify;
                 VerifyDevice(idx, res, PstBuffer);
                 ProgStatus0.caption:= PstBuffer;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.SmartTimerTimerEvent(Sender: TObject; BlinkHigh: Boolean);
begin
  case Status of
    cIdle    : begin
                 LedD0.checked:= BlinkHigh;
                 LedP0.checked:= not BlinkHigh;
               end;
    cVerify,
    cErase,
    cProg,
    cDownLd  : begin
                 LedD0.checked:= false;
                 LedP0.checked:= BlinkHigh;
               end;
    cUnknown : begin
                 LedD0.checked:= false;
                 LedP0.checked:= false;
               end;
    cMemError: begin
                 LedD0.checked:= BlinkHigh;
                 LedP0.checked:= BlinkHigh;
               end;
  end;
end;

procedure TProgMain.DelBtnClick(Sender: TObject);
var st        : string;
    res, idx  : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  Timer1.enabled:= false;
  if FileBox.Text = '' then begin
    Beep;
  end
  else begin
    try
      DeleteFile(PChar(FileBox.Text), res, PstBuffer);
      st:= PstBuffer;
    except
    end;
    // res = progBusy, invFName, notFound, errProtected, resOk
    if tProgResult(res) = resOk then begin
      FileBox.Items.Clear;
      idx:= 0;
      repeat
        GetFile(idx, res, PstBuffer);
        st:= PstBuffer;
        if tProgResult(res) = resOk then begin
          FileBox.Items.Add(st);
          inc(idx);
        end;
      until tProgResult(res) <> resOk;
      FileBox.Text:= '';
      StatusBar.SimpleText:= 'project deleted';
    end
    else begin
      StatusBar.SimpleText:= 'can not delete project';
      Beep;
    end;
  end;
end;

procedure TProgMain.HintsCheckClick(Sender: TObject);
begin
  ShowHint:= HintsCheck.checked;
end;

procedure TProgMain.FileBoxDropDown(Sender: TObject);
begin
  StatusBar.SimpleText:= IntToStr(FileBox.Items.count)+' projects found';
end;

procedure TProgMain.PswdBtnClick(Sender: TObject);
var res    : integer;
    st     : string;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  GetPasswd(res, PstBuffer);
  st:= PstBuffer;
  if tProgResult(res) = resOk then begin
    MessageDlg('This is the password for this machine:'+#13
              +'              '+st, mtInformation, [ mbOK],0);
  end
  else begin
    MessageDlg('ICP is busy!', mtError, [ mbOK],0);
  end;
end;

procedure TProgMain.ReadFuseBtnClick(Sender: TObject);
var res, fuse : integer;
    st        : string;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
    idx       : integer;
    ProgResult: tProgResult;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  Gauge0.Percent:= 0;
  CheckDevice(idx, res, PstBuffer);
  if tProgResult(res) in[progNoSupply, errPwrSupply, errSignature, errPwrDown] then begin
    MessageDlg('Fuses not readable!', mtError, [mbOK], 0);
    exit;
  end;
  case Status of
    cIdle    : begin
                 GetFuses(idx, 'L', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.LockLab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, 'F', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.FuseLowLab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, 'H', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.FuseHighLab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, 'E', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.FuseExtLab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, '0', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.OscCal0Lab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, '1', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.OscCal1Lab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, '2', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.OscCal2Lab.Caption:= ': $'+PstBuffer;

                 GetFuses(idx, '3', fuse, res, PstBuffer);
                 ProgResult:= tProgResult(res);
                 FusesDlg.OscCal3Lab.Caption:= ': $'+PstBuffer;

                 FusesDlg.ShowModal;
               end;
    cDownLd  : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cVerify,
    cErase,
    cProg    : begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' busy';
               end;
    cMemError: begin
                 StatusBar.SimpleText:= 'ICP '+IntToStr(idx+1)+' memory error';
               end;
  end;
end;

procedure TProgMain.TestBtnClick(Sender: TObject);
type
    tUpDnArr  =  array[0..255] of byte;
var UpArr     : tUpDnArr;
    DnArr     : tUpDnArr;
    res       : integer;
    st        : string;
    ok        : boolean;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  ok:= true;
  FillChar(DnArr, sizeOf(DnArr), 0);
  FillChar(UpArr, sizeOf(DnArr), 0);

{
  DnArr[0]:= $aa;
  DownLoadBlockF(@DnArr, 128, 1, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  UpLoadBlockF(@UpArr, 128, 1, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;
}
(*
  UpLoadBlockF(@DnArr, 256, 512, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
  end;

  DownLoadBlockF(@DnArr, 256, 512, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  UpLoadBlockF(@UpArr, 256, 512, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  if ok then begin
    for res:= 0 to 255 do begin
      if DnArr[res] <> UpArr[res] then begin
        StatusBar.SimpleText:= 'Flash compare error';
        exit;
      end;
    end;
  end;
*)
  ok:= true;
  // read back programmers memory
  UpLoadBlockE(@DnArr, 128, 0, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  ReadBackE(@UpArr, 128, 0, 0, res, PstBuffer);
  // read back chip memory
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  // compare both contents
  if ok then begin
    for res:= 0 to 127 do begin
      if DnArr[res] <> UpArr[res] then begin
        StatusBar.SimpleText:= 'EEprom compare error';
        exit;
      end;
    end;
  end;

  // change some bytes
  // and download into the programmers memory
  DnArr[0]:= $AA;
  DnArr[1]:= $BB;
  DnArr[2]:= $CC;
  DnArr[3]:= $DD;
  DownLoadBlockE(@DnArr, 2, 5, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  // reprogram the eeprom
  EnterProgMode(0, res, PstBuffer);
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;
  ProgEEpBtnClick(Sender);
  repeat
    Application.ProcessMessages;
  until Status = cIdle;

  // read back the programmings from the chip's eeprom
  ReadBackE(@UpArr, 128, 0, 0, res, PstBuffer);
  st:= PstBuffer;
  // res = progBusy, noProg, progProtected, dwnLoadErr, resOk
  if tProgResult(res) <> resOk then begin
    ok:= false;
    Beep;
    StatusBar.SimpleText:= st;
    exit;
  end;

  // compare the download with the chip eeprom
  if ok then begin
    for res:= 0 to 127 do begin
      if DnArr[res] <> UpArr[res] then begin
        StatusBar.SimpleText:= 'EEprom compare error';
        break;
      end;
    end;
  end;

  if ok then begin
    StatusBar.SimpleText:= 'Up/Download test ok!';
  end;
end;

//function JTAGBoundaryOpen(Channel: integer; CpuID, BoundaryLen, SupplyVolt, SupplyCurr : integer;
//                          var res : integer): PChar; stdcall;  external 'ProgDLLN.dll';
procedure TProgMain.ScanOpenBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    st     : string;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  JTAGBoundaryOpen(idx, $1E9403, 141, 500, 100, res, PstBuffer);
  st:= PstBuffer;
  ProgStatus0.caption:= st;
  if tProgResult(res) <> resOk then begin
    Beep;
    StatusBar.SimpleText:= st;
    ScanCloseBtn.Enabled:= false;
    ChainDownBtn.Enabled:= false;
    ChainUpBtn.Enabled:= false;
  end
  else begin
    StatusBar.SimpleText:= st;
    ScanCloseBtn.Enabled:= true;
    ChainDownBtn.Enabled:= true;
    ChainUpBtn.Enabled:= true;
  end;
end;

procedure TProgMain.ChainDownBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  JTAGchainWrite(idx, @ScanDownBuffer, res, PstBuffer);
  ProgStatus0.caption:= PstBuffer;
  StatusBar.SimpleText:= PstBuffer;
  Beep;
end;

procedure TProgMain.ChainUpBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  JTAGchainRead(idx, @ScanUpBuffer, res, PstBuffer);
  ProgStatus0.caption:= PstBuffer;
  StatusBar.SimpleText:= PstBuffer;
  Beep;
end;

procedure TProgMain.ScanCloseBtnClick(Sender: TObject);
var idx    : byte;
    res    : integer;
    stBuffer  : array[0..512] of char;
    PstBuffer : PChar;
begin
  PstBuffer:= @stBuffer;
  idx:= 0;
  JTAGBoundaryClose(idx, res, PstBuffer);
  ProgStatus0.caption:= PstBuffer;
  ScanOpenBtn.Enabled:= false;
  ScanCloseBtn.Enabled:= false;
  ChainDownBtn.Enabled:= false;
  ChainUpBtn.Enabled:= false;
  StatusBar.SimpleText:= PstBuffer;
end;

procedure TProgMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  AbortAll;
  Timer1.enabled:= false;
  IniEditor.WriteInt('Setup', 'ComPort', ComSpin.position);
  IniEditor.WriteBool('Setup', 'ShowHint', ShowHint);
  CanClose:= true;
end;

procedure TProgMain.LdPackFileBtnClick(Sender: TObject);
begin
  OpenDlg.FilterIndex:= 2;
  if OpenDlg.Execute then begin
    isEncr:= false;
    DownloadButtonClick(sender);
  end;
  OpenDlg.FilterIndex:= 1;
  isEncr:= true;
end;

procedure TProgMain.FileBoxClick(Sender: TObject);
begin
  isEncr:= true;
end;


initialization
finalization
end.



