unit UnitPavel;

interface
uses
  Windows, SysUtils, UsbMain, ComPort, Graphics, HexUtils, StrUtils, Forms, UnitMisc, IniFiles, FbusMain, classes;

function UserCodeReset(): Boolean;
function PrdCodeRead(): Boolean;
function PrdCodewrite(): Boolean;
function ResetLifeTimerUSB(): string;
function ReadLTF(): integer;
function GetCodeUSB(): string;
function ReadLocks(): Boolean;
function OldBB5UReset(): Boolean; // сброс для старых бб5
function Getdrives(): string;
function CRT308backup(): string;
function getdrives40(): string;
function USBADCread(): string;
function S40formmat(drive: string): string;
function S40pref(): string;
function S60format(drive: string): string;
function NCKsend(nck: string): string;
function clearUCodedata(mode: integer): string;
procedure ProductCodeRead();
procedure ProductCodeWrite();
procedure ResetUcode();
function GettingASK(): string;
function gettrouble(testid: string; testresult: string): string;
function checkini(): string;
function startFS(): boolean;
function startFS40(): boolean;
function CheckLockInfo(s: string): boolean;
function checklock(instr: string): boolean;
function testitemst(testn: string): string;
function scandrive(): string;
function S40formatUni(drive: string): string;
function checkSD(): string;
function RestoreUserData(): string;
function getcntsize(flven: dWord): Integer;
function downgradeprep(): Boolean;
function calcsize(size: Integer): string;
function s40drvscan(): Boolean; // S40v2 algo (1gb storage)
function s40getsizeuni(path: string): Integer;
function s40extractuni(F: TMemoryStream; fullpath: string; len: dword; info: integer): Boolean;
function S60extractuni(F: TMemoryStream; fullpath: string; len: dword; info: integer): Boolean;
function getsizeS60Uni(path: string): Integer;
function USBS60SecReadData(M: TMemoryStream; Gen: Integer; FType: Integer): Boolean; // Попытка универсального чтения особо важной инфы)
function APErunUni(): string;
function startFS60uni(): Boolean;
function s60WriteFuni(M: TMemoryStream; Path: string; info: integer): Boolean;
function s60deletefuni(path: string): Boolean;
function S40checklbl(): string;
function changerigts(level: word; path: string): Boolean;
function repairusercert(): Boolean;
procedure ScanDir(StartDir: string; Mask: string; List: TStrings);
function S40repairUserData(typ: Integer): Boolean;
function s40delfileuni(path: string): Boolean;
function S40ClearDir(typ: Integer): Boolean;
function S40WriteUni(InFile: TMemoryStream; filewithpath: string; info: integer): boolean;
function S60repairUserData(typ: Integer): Boolean;
function S60ClearDir(typ: Integer): Boolean;
function BB5ScanHeader(core: string): integer;
function savepwds40(): Boolean;
procedure FindIt(const aDir: string; aLog: TStrings; typ: Integer);
function savecalasText(M: TMemoryStream; FileToSave: string): Boolean;
function CheckFiles(s: string): Boolean;
function checkSWver(): boolean;
function getEcode(b: string): string;
function resetLTnew(): Boolean;
procedure StuffFlashReset();
function CheckCamSW(): Boolean;
function CheckFulFile(core: string): Boolean;
function checkflfiles(): Boolean;
function readset(tp: string; rec: string): boolean;
function getmodel(data: string): string;
function InfineonResetCode(): Boolean;
function dct4codereset(): Boolean;
procedure grabrpl(mode: integer);
function CheckMaemoFile(core: string): Boolean;
function FetchData(s: string): string;
function s40builddir(dir: string): Boolean;
function CreateSimLockRpl(SimlockKey: widestring; SimlockData: WideString): boolean;
function readUIDstep1(): Boolean;
function My_Close_USB_Device(): Boolean;
function BackupKey(key: string): WideString;
function signstring(data: widestring): widestring;
function chksl(): integer;
function writeWDRM_PD(datastream: widestring): Boolean;
function InitServiceMode(): Boolean;
function ChkgetCamSW(num: Integer): string;
function ChkgetCamHW(num: Integer): string;
function UploadCamSW(uplsw: string; camnum: Integer): Boolean;
function S40ChkgetCamSW(num: Integer): string;
function S40ChkgetCamHW(num: Integer): string;
function S40UploadCamSW(uplsw: string; camnum: Integer): Boolean;
function ParseCamConf(conf: string): Boolean;
function ParseInfineon(core: string; mode: Integer; outData: TmemoryStream): Boolean;
function getFwinfo(infcore: string): string;
function GetEraseBlk(erblock: TmemoryStream; ErWrite: TStringList): integer;
function getid(): integer;
function dostop(dta: string): Boolean;
function uploadtunesx(): Boolean;
function ROOTcheck(): Boolean;
function KillTask(ExeFileName: string): Integer;
function EBLcomandStartRead(cmd: word; data: dword): Boolean;
function EBLcomandRead(cmd: word; data: word): Boolean;
function MyImageWriter(Vimage: TmemoryStream): boolean;
function delay(second: integer): Boolean;

//infineon via COMPORT
function mywritecom(ftlen: integer): boolean;
function myreadcom(ftlen: integer): boolean;
function ComBootInfineon(): Boolean; // Boot First (GETCPUID, INIT)
function ComBootingInf(): Boolean; //Loading PSI, EBL
function ComInfineonEnd(): Boolean;
function ComsendCert(infcore: string): Boolean;
function ComInfineonErase(infcore: string; curreg: string): Boolean;
function ComInfineonWrite(infcore: string; mode: Integer; dlen: string): Boolean;
function comcheckready(): Boolean;
function comgetchksuminf(): Boolean;
function comFlashInfineonFile(FlasHfile: string): Boolean;

implementation
uses UnitAndrey, tlhelp32, D2XXUnit, Dialogs, FBoots, Sha1, FlashBoots, ecodes, Unit1, boots, TntClasses, UnitE1, UnitUFS;

function mywritecom(ftlen: integer): boolean;
begin
  result := WriteCom(@Ft_out_buffer[0], ftlen);
end;

function myreadcom(ftlen: integer): boolean;
begin
  result := readcom(@Ft_in_buffer[0], ftlen);
end;

function savecalasText(M: TMemoryStream; FileToSave: string): Boolean;
var
  CalStr: TstringList;
  len: DWORD;
begin
  CalStr := TstringList.Create;
  M.Seek(8, soFromBeginning);
  form1.pb1.Progress := 0;
  Form1.pb1.MaxValue := M.Size;
  while M.Position < M.Size do begin
    M.Read(Buf[0], 4);
    DwordSwap(@Buf[0]);
    Len := dword((@Buf[0])^);
    M.Read(Buf[0], Len - 4);
    S40NewCalEx;
    Calstr.Add(Utf8Decode(CalRec.Num + ' ' + CalRec.Typ + ' ' + CalRec.Date1.Day + '.' + CalRec.Date1.Month + '.' + CalRec.Date1.Year + ' ' + CalRec.Note));
    form1.pb1.Progress := M.Position;
  end;
  CalStr.SaveToFile(FileToSave);
  CalStr.Free;
  Form1.pb1.Progress := 0;
end;


function savepwds40(): Boolean;
var
  MMC: SYSTEM.text;
  Filename: string;
  i, i2: Integer;
begin
  try
    i2 := PmGetRecCou(302);
    if i2 > 0 then begin

      if not DirectoryExists('Backup')
        then begin
        mkdir('Backup');
      end;
      if Pos('?', PHname) > 0 then PHname := Form1.RightFileName(PHname);
      FileName := getcurrentdir + '\' + 'Backup' + '\' + PHname + '_DFL_MMC_password_record.pm';
      System.Assign(MMC, FileName);
      System.Rewrite(MMC);
      System.WriteLn(MMC, '[302]');
      if i2 = 1 then System.Writeln(MMC, '0=' + PmReadRecord(302, 0))
      else for i := 0 to i2 - 1 do System.Writeln(MMC, inttostr(i) + '=' + PmReadRecord(302, i));
      System.Close(MMC);
      result := True;
    end
    else Result := False;
  except
    Result := False;
  end;
end;

procedure ResetUcode();
begin
  PhInfoRecord.CRR := UsbResetUcode;
end;

function GettingASK(): string;
var
  buf: string;
begin
  if ConMode = 0 then Result := UsbreadASK else Result := FbusReadask;
end;

procedure ProductCodeWrite();
begin
  PhInfoRecord.PrdCok := UsbWritePRdcode;
end;

procedure ProductCodeRead();
begin
  if ConMode = 0 then PhInfoRecord.ProductCode := UsbReadProductCode else PhInfoRecord.ProductCode := FbusReadProductCode;
end;

procedure StuffFlashReset();
begin
  Form1.chkPPMe.Enabled := True;
  Form1.chkMCUen.Enabled := True;
  Form1.chkPPM1e.Enabled := True;
  Form1.chkCNTe.Enabled := True;
  Form1.chkAPEe.Enabled := True;
  Form1.chkcnt3.Enabled := True;
  Form1.Pb1.progress := 0;
  Form1.Pb1.MaxValue := 0;
  Application.ProcessMessages;
  Form1.statusbar.Panels[0].Text := '';
  Form1.pb1.ForeColor := clNavy;
  Form1.pbsm1.ForeColor := clNavy;
  Form1.pb1.MaxValue := 100;
  Form1.pb1.progress := 0;
  Form1.statusbar.Panels[1].Text := '';
  Form1.TimConChk.Interval := 2000;
  Form1.TimConChk.Enabled := true;
  Form1.DisconnectFill;
  Form1.Setready;
end;

function UserCodeReset(): Boolean;
var
  a: string;
begin
  a := UsbResetUcode;
  if Pos('Ok', a) > 0 then
    Result := True
  else result := False;
end;

function clearUCodedata(mode: integer): string;
var
  a, b, c: string;
begin
  if mode = 1 then begin
    a := PmWriteRecord(308, 6, '00');
    b := PmWriteRecord(308, 7, '00');
    c := PmWriteRecord(308, 8, '00');
    result := 'Clear data : ' + a;
  end;

  if mode = 2 then begin
  //[95]0=00[118]0=00
    a := PmWriteRecord(95, 0, '00');
    b := PmWriteRecord(118, 0, '00');
    result := 'Clear data : ' + a;
  end;
end;

function OldBB5UReset(): Boolean;
var
  a: string;
begin
  a := PmWriteRecord(35, 0, '31323334350000000000');
  form1._msg('Resetting data: ' + a);
  if Pos('Ok', a) > 0 then result := True else result := False;
end;

function PrdCodeRead(): Boolean;
begin
  ProductCodeRead;
  Result := True;
end;

function PrdCodewrite(): Boolean;
begin
  PhInfoClear;
  ProductCodeWrite;
  Result := True;
end;


function ResetLifeTimerUSB(): string;
begin
  Result := UsbResetLifeTimer;
end;


function ReadLTF(): integer;
var
  a, b, c, d, e: string;
  f: Integer;
  d1, d2, d3: string;
  i1, i2, i3: Integer;
  dta: string;
begin
  ltdata := 0;
  result := 0;
  try
    if ConMode = 1 then FbusSendSynk;
    d1 := ''; i1 := 0;
    d2 := ''; i2 := 0;
    d3 := ''; i3 := 0;
    a := ''; b := ''; c := ''; d := ''; e := '';

   //Collect info about records
    d1 := PmReadRecord(88, 0);
    i1 := Length(d1);

    if i1 = 72 then //v1
    begin
      a := Copy(d1, 64, 10);
      b := Copy(a, 8, 2);
      c := Copy(a, 6, 2);
      d := Copy(a, 4, 2);
      e := Copy(a, 2, 2);
      a := '';
      a := b + c + d + e;
      a := Trim(a);
      ltdata := hextoint(a);
     //form1._msg(IntToStr(f));
      result := 1;
      exit;
    end;

    d2 := PmReadRecord(374, 0);
    i2 := Length(d2);

    if i2 = 8 then //v2
    begin
      b := Copy(d2, 7, 2);
      c := Copy(d2, 5, 2);
      d := Copy(d2, 3, 2);
      e := Copy(d2, 1, 2);
      a := '';
      a := b + c + d + e;
      a := Trim(a);
      ltdata := hextoint(a);
      result := 2;
      exit;
    end;

    d3 := PmReadRecord(382, 1);
    i3 := Length(d3);

    if i3 = 8 then //v3
    begin
      b := Copy(d2, 7, 2);
      c := Copy(d2, 5, 2);
      d := Copy(d2, 3, 2);
      e := Copy(d2, 1, 2);
      a := '';
      a := e + d + c + b;
      a := Trim(a);
      ltdata := hextoint(a);
      result := 3;
      exit;
    end;

    if (i1 <> 72) and (i2 <> 8) and (i3 <> 8) then Exit;

  except
    result := 4;
  end;
end;

function GetCodeUSB(): string;
var
  a, b: string;
begin
  //get for old models
  if Generation = '01' then
  begin
    a := '';
    if ConMode = 1 then FbusSendSynk;
    a := PmReadRecord(35, 0);
    if (a <> '') or (a <> 'Error') then
    begin
      b := trim(hex2chr(a));
      if b <> '' then begin
        if (Crypted = '11') or (Crypted = '10') then result := getEcode(b) else Result := b;
        Exit;
      end
      else
        Result := 'not set';
      Exit;
    end
    else Result := 'not set';
    Exit;
  end;
   //if  (crypted<>'10') and (crypted<>'11') then begin
   ///Get new, if NOT old
  if ConMode = 1 then FbusSendSynk;
  a := PmReadRecord(308, 5);
  if (Length(a) = 20) and (a <> '00000000000000000000') then begin
    b := trim(hex2chr(a));
    if b <> '' then
    begin
      if (Crypted = '11') or (Crypted = '10') then result := getEcode(b) else Result := b;
    end;
  end
  else
  begin
    if a = 'Error' then Result := 'Error! Crypted user code!' else Result := 'not set';
  end;
  // end
  // else begin Result:='Error! Crypted user code!'; Exit; end;

end;

function getEcode(b: string): string;
var
  code: Integer;
  check: string;
begin
  if conmode = 0 then begin
    check := PmReadRecord(308, 1);
    if (check <> '') and (check <> 'Error') then begin
      if pos('DEAD1100', check) <> 0 then begin result := 'Crypted and protected :('; exit; end;
    end;
  end;
  code := StrToInt(b);
  result := GetCode(code);
end;


function SmartAlgoFSinitialize(): boolean; //стартует ФС, берет списко дисков
var
  a: string;
begin
  a := SmartAlgoFsinit;
  if a = '43FF' then result := True;
  if a = 'FFFF' then result := False;
end;



function ReadLocks(): Boolean;
var
  ini: TIniFile;
  inf, Provider, ProviderFile, rResult: string;
begin
  inf := getproviderstring;

  if inf = '' then begin
    form1._msg('Error when reading Provider info! :(');
    Result := False;
    Exit;
  end
  else
    if Midstr(inf, 115, 26) = 'FF FF FF FF FF FF FF FF' then
    begin
      form1._msg('SP Data Corrupted.... :(');
    end else begin
      Provider := Trim(inf);
      Delete(Provider, 1, 114);
      Delete(Provider, 27, 2808);
      Delete(Provider, 3, 1);
      Delete(Provider, 5, 1);
      Delete(Provider, 7, 1);
      Delete(Provider, 9, 1);
      Delete(Provider, 11, 1);
      Delete(Provider, 13, 1);
      Delete(Provider, 15, 1);
      Delete(Provider, 17, 3);
      form1._msg('Conf :                    ' + Provider);
      Delete(Provider, 9, 8);
      ProviderFile := (ExtractFilePath(Application.ExeName) + 'Providers.ini');
      ini := TIniFile.Create(ProviderFile);
      try
        rResult := ini.ReadString('Providers', Provider, 'Unknown Provider');

        form1._msg('Provider :               ' + rResult);

      finally
        ini.Free;
      end;

    end;
  Result := True;

end;

{function DetectGeneration():string;
var
  a:string;
  b:string;
begin
  a:=PhInfoRecord.Name;
  if a<>'' then begin
  case a of
  'Nokia 5800':b:='N/A';
  'Nokia N78':b:='N/A';
  'Nokia N97':b:='N/A';
  'Nokia 6680':b:='Old';
  'Nokia 6630':b:='Old';
  'Nokia 6681':b:='Old';
  'Nokia N70':b:='Old';
  'Nokia N72':b:='Old';
  'Nokia N82':b:='N/A';
  'Nokia N79':b:='N/A';
  'Nokia E75':b:='N/A';
  'Nokia N85':b:='N/A';
  'Nokia N96':b:='N/A';
  'Nokia N86':b:='N/A';
  'Nokia e65':b:='Normal';
  'Nokia e50':b:='Normal';
  else b:='X';
  end;
  Result:=b;
  end
  else begin
    Result:='Error';
    end;

    end; }

function getdrives(): string;
var
  inraw: string;
  outraw: string;
  c, d, e, s, z, y: string;
begin
  inraw := '';
  outraw := '';
  if ConMode = 0 then inraw := scandrives else inraw := fbusscandrives;

  if pos('43FF', inraw) > 0 then begin
    c := 'C';
    outraw := outraw + c;
  end;
  if pos('44FF', inraw) > 0 then begin
    d := 'D';
    outraw := outraw + d;
  end;
  {if pos('45FF', inraw)>0 then begin
  e:='E';
  outraw:=outraw+e;
  end; }
  if pos('53FF', inraw) > 0 then begin
    s := 'S';
    outraw := outraw + s;
  end;
  if pos('59FF', inraw) > 0 then begin
    y := 'Y';
    outraw := outraw + y;
  end;
 { if pos('5AFF', inraw)>0 then   begin
  z:='Z';
  outraw:=outraw+z;
  end; }

  Result := outraw;

end;

function getdrives40(): string;
var
  inraw: string;
  outraw: string;
  c, e, s: string;
begin
  inraw := '';
  outraw := '';
  inraw := scandriveS40;
  if pos('43', inraw) > 0 then begin
    c := 'C';
    outraw := outraw + c;
  end
  else outraw := outraw;
 { if pos('45', inraw)>0 then  begin
  e:='E';
  outraw:=outraw+e;
  end
  else outraw:=outraw; }
  if pos('53', inraw) > 0 then begin
    s := 'S';
    outraw := outraw + s;
  end
  else outraw := outraw;
  Result := outraw;
end;

function CRT308backup(): string;
var
  CRT308: SYSTEm.Text;
  a, s: string;
  FileName: string;
  i, i2: Integer;
  len: DWORD;
  curimei: string;
begin
  curimei := '';
  try
    s := '';
    i2 := 0;
    a := PmReadRecord(308, 1);
    if a <> '' then begin
      if not DirectoryExists('Backup\Cert\')
        then begin
        mkdir('Backup\Cert\');
      end;
      curimei := Form1.RightFileName(Phinforecord.IMEIPlain);
      FileName := getcurrentdir + '\' + 'Backup\Cert\' + curimei + '_rpl.pm';
      if FileExists(FileName) then FileName := getcurrentdir + '\' + 'Backup\Cert\' + curimei + '_rpl_2nd' + '.pm';

      System.Assign(CRT308, FileName);
      System.Rewrite(CRT308);
      Application.ProcessMessages;
      i2 := PmGetRecCou(4);
      if i2 > 0 then begin
        System.WriteLn(CRT308, '[4]');
        i := 0;
        while i2 <> 0 do begin
          Len := PmGetRecLen(4, i);
          if Len < $F0000000 then begin
            s := PmReadRecordWithOutCheck(4, i, Len);
            System.WriteLn(CRT308, IntToStr(i) + '=' + s);
            i2 := i2 - 1;
            Application.ProcessMessages;
          end;
          i := i + 1;
        end;
      end;
      i2 := PmGetRecCou(120);
      if i2 > 0 then begin
        System.WriteLn(CRT308, '[120]');
        i := 0;
        while i2 <> 0 do begin
          Len := PmGetRecLen(120, i);
          if Len < $F0000000 then begin
            s := PmReadRecordWithOutCheck(120, i, Len);
            System.WriteLn(CRT308, IntToStr(i) + '=' + s);
            i2 := i2 - 1;
            Application.ProcessMessages;
          end;
          i := i + 1;
        end;
      end;
      Application.ProcessMessages;
      System.WriteLn(CRT308, '[308]');
      System.Write(CRT308, '1=' + a);
      System.Close(CRT308);
      Result := 'CRT308 Backup Created... :)';
    end
    else
      Result := 'Error, when try do backup CRT308 :(';
  except
    Result := 'Error, when try do backup CRT308 :(';
    Application.ProcessMessages;
  end;
end;



function USBADCread(): string;
var
  a, b, c, d: string;
  f: string;
begin

  a := UsbReadBatvalue;
  form1._msg('Bat. voltage: ' + a + ' mV');
  b := currenteat;
  form1._msg('Currency: ' + b + ' mA');
  if Pos('-', b) > 0 then begin
    c := USBRawCharge;
    form1._msg('Charge: ' + c);
  end;
  form1._msg('Temp: ' + GetTemp);
end;

{function FbusADCread():string;
var
  a,b,c,d:string;
  f:string;
  begin
a:= FbusReadBatvalue;
f:='Bat. volgate: '+a+' mV;  ';
b:= fbuscurrenteat;
f:=f+'Currency: '+b+' mV;  ';
if Pos('-',b)>0 then begin
  c:=fbusRawCharge;
  f:=f+'Charge: '+c+'; ';
  end;
  d:=' Temp: '+GetTemp;
  f:=f+d;
 Result:=f;
end;    }


function S40formmat(drive: string): string;
var
  a: string;
begin
  a := formats40(drive);
  if Pos('00 79', a) > 0 then begin
    result := 'OK';
  end
  else begin
    result := 'Error!';
  end;
end;


function S40pref(): string;
begin
  if ConMode = 0 then PhInfoRecord.PhType := preformats40 else
  begin
    ReadPhoneInfo;
    if (PhInfoRecord.PhType = '') or (PhInfoRecord.PhType = 'Error') then PhInfoRecord.PhType := getmodel(PhInfoRecord.MCUSW);
    if PhInfoRecord.PhType = '' then PhInfoRecord.PhType := fpreformats40;
  end;
  Result := PhInfoRecord.PhType;
end;


function NCKsend(NCK: string): string;
var
  bf, str: string;
  i, i2: Integer;
begin
  i := 1;
  i2 := 1;
  bf := nck;
  while i < 16 do
  begin
    nckmasc[12 + i2] := $30 + StrtoInt(bf[i]);
    inc(i);
    i2 := i2 + 2;
  end;
  str := sendNCK;
  form1._msg('Result: ' + str);
end;

function S60format(drive: string): string;
var
  a, b: string;
  drv: Byte;
begin
  if drive = 'C' then drv := $43;
  if drive = 'D' then drv := $44;
  if drive = 'S' then drv := $53;
  if drive = 'Y' then drv := $59;
  if drive = 'E' then drv := $45;
  if drive = '' then begin
    result := 'Error!';
    Exit;
  end;
  if ConMode = 0 then begin
    b := formats601st(drv);
    if b = 'OK' then begin
      S60formatcycle[11] := drv;
      a := formatS60cycle;
      if a = 'OK' then result := 'OK'
      else result := 'Error!';
    end
    else result := 'Error!';
  end
  else begin
    s60f1st(drv);
    b := fbs60cyclef(drv);
    Result := b;
  end;
end;

function precheck(): string;
begin
  if ConMode = 0 then result := check3stage;
end;

function checkini(): string;
var
  InFile: TIniFile;
begin
  generation := ''; crypted := ''; datapos := '';
  InFile := TIniFile.Create(ExtractFileDir(Application.ExeName) + '\settings.ini');
  if RM = 'Error' then begin result := ''; Exit; end;
  if RM = '' then begin result := ''; Exit; end;
  if RM <> '' then begin
    typeinf := InFile.ReadString('Model', RM, '');
    if typeinf <> '' then begin
      generation := Copy(typeinf, 1, 2);
      crypted := Copy(typeinf, 5, 2);
      datapos := Copy(typeinf, 3, 2);
    end
    else
    begin
      typeinf := InFile.ReadString('WD2', RM, '');
      if typeinf <> '' then begin
        generation := Copy(typeinf, 1, 2);
        crypted := Copy(typeinf, 5, 2);
        datapos := Copy(typeinf, 3, 2);
      end;
    end;
     //form1._msg('Gen: '+generation+' Cryp: '+crypted+' Data: '+datapos);

  end else typeinf := '';
  Result := TypeInf;
end;

function gettrouble(testid: string; testresult: string): string;
var
  iniTrouble: TMemIniFile;
  a, b: string;
begin
  Application.Processmessages;
 // Form1._msg(testresult);
  if testresult = 'PASSED' then begin
    result := 'That is OK!';
    Exit;
  end;

  if testresult = 'NOT TESTED' then begin
    result := 'Test not done in that mode...';
    Exit;
  end;
  if testresult = 'NOT RUN' then begin
    result := 'Test skipped, no need testing...';
    Exit;
  end;
  if testresult = 'NOT EXECUTED' then begin
    result := 'Test not done in that mode...';
    Exit;
  end;
  if testresult = '->ERROR' then begin
    IniTrouble := TMemIniFile.Create(ExtractFileDir(Application.ExeName) + '\selftest.ini');
    if IniTrouble.SectionExists(testid) then begin
      result := iniTrouble.ReadString(testid, 'main', 'No reference');
    end
    else begin
      result := 'No reference yet :(';
    end;
    iniTrouble.Free;
    Exit;
  end;

  if testresult = 'UNKNOW' then begin
    IniTrouble := TMemIniFile.Create(ExtractFileDir(Application.ExeName) + '\selftest.ini');
    if IniTrouble.SectionExists(testid) then begin
      result := iniTrouble.ReadString(testid, 'main', 'No reference');
    end
    else begin
      result := 'No reference yet :(';
    end;
    iniTrouble.Free;
    Exit;
  end;

  if testresult = 'MINOR' then begin
    IniTrouble := TMemIniFile.Create(ExtractFileDir(Application.ExeName) + '\selftest.ini');
    if IniTrouble.SectionExists(testid) then begin
      result := iniTrouble.ReadString(testid, 'main', 'No reference');
    end
    else begin
      result := 'No reference yet :(';
    end;
    iniTrouble.Free;
  end;

end;

function startFS(): boolean;
var
  s: string;
begin
  result := False;
  s := initialiseFS;
  if Pos('43FF', s) > 0 then result := True else result := false;
end;

function startFS40(): boolean;
var
  s: string;
begin
  result := False;
  s := initialiseFS;
  if Pos('53FF', s) > 0 then result := True else result := false;
end;

function startFS60uni(): Boolean;
var
  a: string;
begin
  if conmode = 0 then result := startFS else
  begin
    fbussendsynk;
    a := fbusgetdrives60;
    if Pos('C', a) > 0 then result := True else result := False;
  end;
end;

function CheckLockInfo(s: string): boolean;
var
  i: integer;
  sLog, sField, sLockInfo, stxt: string;
begin
  sLog := '';
  sField := s;
  Result := False;
  for i := 1 to (length(s) div 40) do begin
    sLog := leftstr(sField, 40);
    if rightstr(slog, 2) = '03' then sLockInfo := 'Open' else sLockInfo := 'Close';
    stxt := stxt + ' Lock' + intTostr(i) + ':' + sLockInfo;
    sField := Rightstr(sField, Length(sField) - 40);
  end;
  if pos('Close', stxt) > 0 then Result := True;
  form1._msg(stxt);
end;

function checklock(instr: string): boolean;
var
  SPConf, SPProv: string;
  blkcount: integer;
  fbuscnt_A, keycnt_A, fbuscnt, keycnt: string;
  Providerfile: string;
  iniprov: Tinifile;
  rResult: string;
  i: Integer;
  ProviderNet: string;
  LockFieldCount: integer;
  blkData, blkSize: string;
  blkArray: array[0..50] of string;
  blkFieldArray: array[0..50] of string;
  prevLockInfo: boolean;
  Lockstat: string;
label
  PutLockStat;
begin
  spconf := '';
  spprov := '';
  result := False;
  blkcount := 0;
  rResult := '';

  if Length(instr) < 32 then begin
    form1._msg('Unable to read Lock table... :(');
    result := False;
    exit;
  end
  else begin
    SpConf := Copy(instr, 1, 16);
    spprov := Copy(instr, 17, 16);
    blkcount := hextoint(Copy(instr, 37, 2));
    form1._msg('Conf key     : ' + spconf);
    form1._msg('Provider key : ' + spprov);
    ProviderFile := ExtractFilePath(Application.ExeName) + 'Providers.ini';
    iniprov := TIniFile.Create(ProviderFile);
    ProviderNet := copy(instr, 17, 8);
    try
      rResult := iniprov.ReadString('Providers', ProviderNet, 'Unknown Provider');
      form1._msg('Provider    : ' + rResult);
    finally
      iniprov.Free;
    end;

    rResult := Midstr(instr, 33, 16);
    KeyCnt_A := IntTostr(hexToInt(midstr(rResult, 8, 1)));
    fbusCnt_A := IntTostr(hexToInt(Midstr(rResult, 7, 1)));
    KeyCnt := IntTostr(hexToInt(midstr(rResult, 8, 1)));
    fbusCnt := IntTostr(hexToInt(Midstr(rResult, 7, 1)));

    form1._msg('Counters   : Key ' + keycnt + '  [3] , Fbus ' + fbuscnt + '  [10]');
    form1._msg('Blocks      : ' + inttostr(blkcount));
    if blkcount <> 0 then begin
      rResult := '';
      rResult := trim(Midstr(instr, 49, Length(instr) - 48));
      blkData := '';
      blkSize := '';
      form1._msg('');
      form1._msg('LOCK STATUS :');
      form1._msg('=============================');
      for i := 0 to blkCount - 1 do blkArray[i] := Midstr(rResult, (i * 16) - 16 + 1, 16);

      blkData := Midstr(rResult, (blkcount * 16) + 1, length(rResult) - (blkcount * 16)); //start of lock information

      prevLockInfo := True;
      for i := 0 to blkcount - 1 do begin
        application.ProcessMessages;
        form1._msg('BLK : ' + intTostr(i + 1));
        LockFieldCount := hextoint(Midstr(blkArray[i], 9, 2));
        blkFieldArray[i] := Midstr(blkData, 1, LockFieldCount * 40);
        if CheckLockInfo(blkFieldArray[i]) then prevLockInfo := False;
        blkData := Rightstr(blkData, Length(blkData) - LockFieldCount * 40);
      end;


      PutLockStat:
      if prevLockInfo = true then LockStat := 'All Open'
      else LockStat := 'Closed';
      form1._msg('=============================');
      form1._msg('LOCKS :  ' + LockStat);
      form1._msg('=============================');
    end
    else begin
      form1._msg('=============================');
      form1._msg('LOCKS :  Damaged! ');
      form1._msg('=============================');
    end;
  end;
end;

function S40WriteCalendar(gen: string): Boolean;
begin

end;

function testitemst(testn: string): string;
begin
  if ConMode = 0 then result := newSelftestitem(testn) else result := FSelftestitem(testn);
end;

function scandrive(): string;
begin
  if not Smart then begin
    if ConMode = 0 then result := getdrives40 else result := fbusgetdrives40;
  end
  else begin
    if ConMode = 0 then Result := Getdrives else Result := fbusgetdrives60;
  end;
end;

function S40formatUni(drive: string): string;
begin
  if ConMode = 0 then result := S40formmat(drive) else result := s40frmtdrv(drive);
end;

function checkSD(): string;
var
  s: string;
begin
  try
    if ConMode = 1 then FbusSendSynk;
    s := PmReadRecord(308, 1);
    if (s = '') or (s = 'Error') and (Length(s) < 6000) then
    begin
      if ConMode = 1 then FbusSendSynk;
      Application.ProcessMessages;
      s := PmReadRecord(308, 1);
      if (s = '') or (s = 'Error') and (Length(s) < 6000) then
      begin
    //form1._msg('Read security zone failed! Analyze breaked :( Try restart phone');
        result := 'read data error';
        exit;
      end;
    end;
    if Pos('AB0FBD96AF2AC271D26264AFDEAD0300', s) > 0 then result := 'SD Data is Ok' else result := 'SDData Damaged!!!!! :(';
  except
    result := 'read data error';
  end;
end;

function RestoreUserData(): string;
begin

end;

function getcntsize(flven: dWord): Integer;
var
  s: string;
  i: Integer;
begin
  case flven of
    $220800EC: i := 128;
    $22FE00EC: i := 64;
    $220C00EC: i := 128;
    $002F0001: i := 128;
    $307E0001: i := 128;
    $2D7E0001: i := 128;
    $317E0001: i := 128;
    $88740089: i := 128;
    $881C0020: i := 128;
    $89820089: i := 128;
    $89810089: i := 128;
    $00300098: i := 128;
    $00000000: i := 128;
    $00410001: i := 128;
    //$004000EC:i:=128;
    $003000EC: i := 128;
    //$00000000:i:=;
    //$0020:i:=64;
    //$0001:i:=128;
    //$0098:i:=128;
  else i := 64;
  end;
  Result := i;
end;

function s40drvscan(): Boolean;
var
  s: string;
begin
  s := '';
  if conmode = 0 then result := gets40drv else begin
    s := fbusgetdrives40;
    if Pos('S', s) > 0 then result := True else result := False;
  end;

end;

function downgradeprep(): Boolean;
var
  s, s1, s2, superstring, res, st: string;
  i: integer;
begin
  res := '';
  st := '';
  form1._msg('DownGr: Prepare phone for downgrade...');
  st := PmReadRecord(308, 0);
  if PmWriteRecord(308, 0, st) <> 'Ok' then begin
    form1._msg('-> Failed to prepare > protected data > break!');
    form1._msg('-> Downgrade not possible for that phone... :(');
    Result := False;
    Exit;
  end;

  s := PmReadRecord(308, 1);

 //check for data
  if Pos('AB0FBD96AF2AC271D26264AFDEAD0600', s) > 0 then begin
   //+27
    i := Pos('AB0FBD96AF2AC271D26264AFDEAD0600', s);
    i := i + 31;
    form1._msg('DownGr: Prepare Started.... Psec : ' + inttostr(i));
    s1 := Copy(s, 1, i);
    s2 := Copy(s, i + 33, (length(s) - i + 32));
    superstring := s1 + '00000000000000000000000000000000' + s2;
    res := PmwriteRecord(308, 1, superstring);
    form1._msg('-> Prepare status : ' + res);
    if res <> 'Ok' then begin
      Form1._msg('-> Wrong answer! Breaking procedure, downgrade may be not possible');
      result := false;
      exit;
    end else Form1._msg('DownGr: Phone ready!');
  //form1._msg(superstring);
    result := True;
  end
  else begin
    form1._msg('-> Error while prepare! SWcheck/DWNG zone damaged!');
    result := False;
    exit;
  end;

end;

function calcsize(size: Integer): string;
begin
  if size = 0 then Exit;

  if size < 1024 then begin
    form1._msg('Total Readed : ' + inttostr(size) + ' byte(s)');
    Exit;
  end;
  if size < 1048576 then begin
    form1._msg('Total Readed : ' + inttostr(size div 1024) + ' Kbyte(s)');
    Exit;
  end;
  if size > 1048576 then begin
    form1._msg('Total Readed : ' + inttostr(size div 1048576) + ' Mbyte(s)');
    Exit;
  end;
end;

function APErunUni(): string;
begin
  if ConMode = 0 then Result := APEtestrun else result := fbusaperun;
end;

function s40getsizeuni(path: string): Integer;
begin
  if conmode = 0 then result := GetFileSizeS40(path) else result := FbusGetS40FSize(path);
end;

function s40extractuni(F: TMemoryStream; fullpath: string; len: dword; info: integer): Boolean;
begin
  if conmode = 0 then result := extractfileS40(F, fullpath, Len, info) else result := fbusgetfileS40(F, fullpath, Len, info);
end;

function getsizeS60Uni(path: string): Integer;
begin
  if ConMode = 0 then Result := GetFileSizeS60(path) else Result := FbusGetfileSize(path);
end;

function S60extractuni(F: TMemoryStream; fullpath: string; len: dword; info: integer): Boolean;
begin
  if ConMode = 0 then result := extractfileS60(F, fullpath, len, info) else result := FbusGetfiles60n(F, fullpath, len, info);
end;

function s60WriteFuni(M: TMemoryStream; Path: string; info: integer): Boolean;
begin
  if ConMode = 0 then result := USbWriteFileS60(M, Path, info) else result := FbusWriteFileS60(M, Path, info);

end;

function s60deletefuni(path: string): Boolean;
begin
  if ConMode = 0 then result := S60deletefile(path) else result := fbusdeletefiles60(path);
end;

function USBS60SecReadData(M: TMemoryStream; Gen: Integer; FType: Integer): Boolean;
//                                      |Gen:Symbian||FType:1-PB,2-cal,3-PWD|
var
  b: DWORD;
begin
  Result := False;
 // if ScanProcess then begin result:=false; exit; end;
  case Gen of
    1: begin // old Bb5 ( 8.x Symbian )
        Form1._msg('Detected: [Symbian OS 8.X] Phone!');
        Form1._msg(AperunUni);
        case Ftype of
          1: begin
              b := getsizeS60Uni('C:\System\Data\Contacts.cdb');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\System\Data\Contacts.cdb', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('PhoneBook not found at all :(');
                Result := False;
                Exit;
              end;

            end;
          2: begin
              b := getsizeS60Uni('C:\System\Data\Calendar');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\System\Data\Calendar', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Calendar not found at all :(');
                Result := False;
                Exit;
              end;

            end;
          3: begin
              b := getsizeS60Uni('C:\System\mmcstore');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\System\mmcstore', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Password Base not found at all :(');
                Result := False;
                Exit;
              end;

            end;
        end;

      end;
    10: begin // BB5 normal ( 9.1-9.2 Symbian )
        Form1._msg('Detected: [Symbian OS 9.1/9.2] Phone!');
        Form1._msg(AperunUni);
        case Ftype of
          1: begin // PhoneBook ExtRaction
              b := getsizeS60Uni('C:\Private\100012a5\DBS_100065FF_Contacts.cdb');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\Private\100012a5\DBS_100065FF_Contacts.cdb', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('PhoneBook not found at all :(');
                Result := False;
                Exit;
              end;
            end;
          2: begin // Reading Calendar
              b := getsizeS60Uni('C:\Private\10003a5b\Calendar');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\Private\10003a5b\Calendar', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Calendar not found at all :(');
                Result := False;
                Exit;
              end;

            end;
          3: begin // Reading Password Base
              b := getsizeS60Uni('C:\sys\data\mmcstore');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\sys\data\mmcstore', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Password Base not found at all :(');
                Result := False;
                Exit;
              end;
            end;
        end;

      end;
    11: begin // BB5 new (9.X Symbian )
        Form1._msg('Detected: [Symbian OS 9.3/9.4] Phone!');
        Form1._msg('Warning! Many [9.3] and [9.4] phones not supported now :(');
        Form1._msg(AperunUni);
        case Ftype of
          1: begin
              b := getsizeS60Uni('C:\Private\10003a73\Contacts.cdb');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\Private\10003a73\Contacts.cdb', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('PhoneBook not found at all :(');
                Result := False;
                Exit;
              end;

            end;
          2: begin
              b := getsizeS60Uni('C:\Private\10003a5b\Calendar');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\Private\10003a5b\Calendar', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Calendar not found at all :(');
                Result := False;
                Exit;
              end;

            end;
          3: begin
              b := getsizeS60Uni('C:\sys\data\mmcstore');
              if b > 0 then begin
                Form1._msg('Found!');
                if not S60extractuni(M, 'C:\sys\data\mmcstore', b, 1) then begin
                  Form1._msg('Error during read...');
                  Form1._msg('');
                  Result := False;
                  Exit;
                end
                else begin
                  Result := True;
                  Exit;
                end;

              end
              else begin
                Form1._msg('Password Base not found at all :(');
                Result := False;
                Exit;
              end;

            end;
        end;

      end;
  end;

end;

function S40checklbl(): string;
var
  path, fpath, tpath, s: string;
  i: integer;
  FL: TStrings;
begin
  if not s40drvscan then path := Utf8Encode('c:\predefgallery\') else path := Utf8Encode('c:\');
  FL := TStringList.Create;
  Form1.GetS40FileList(FL, path);
  s := '';
  for i := 0 to FL.Count - 1 do begin
      //_msg(FL.strings[i]);
    if Pos('User Content Package', FL.strings[i]) > 0 then
    begin
       //Form1._msg('Found data!');
      s := FL.strings[i];
        //Form1._msg(s);
    end;
  end;
  FL.Free;
  result := s;
end;

function changerigts(level: word; path: string): Boolean;
begin
  if conmode = 0 then result := usbs40chr(level, path) else result := fbuschngrigths40(level, path);
end;

function s40delfileuni(path: string): Boolean;
begin
  if conmode = 0 then result := USBS40DeleteFile(path) else result := FbusDelFileS40(path);
end;

function S40WriteUni(InFile: TMemoryStream; filewithpath: string; info: integer): boolean;
begin
  if conmode = 0 then result := USBFSwriteS40Uni(InFile, filewithpath, info) else result := FbusWriteFileS40(InFile, filewithpath, info);
end;

function repairusercert(): Boolean;
var
  Fl: TStringList;
  path, filecert: string;
  i, i2: Integer;
begin
  Form1._msg('Checking User Certificates...');
  FL := TStringList.Create;
  i2 := 0;
  if not s40drvscan then path := Utf8Encode('c:\predefhiddenfolder\certificates\auth\') else path := Utf8Encode('s:\predefhiddenfolder\certificates\auth\');
  Form1.GetS40FileList(FL, path);
  if Fl.Count = 0 then
  begin
    Sleep(200);
    path := Utf8Encode('c:\predefhiddenfolder\certificates\auth\');
    Form1.GetS40FileList(FL, path);
  end;
 //Form1._msg('Check done, processing data...');
  Form1._msg('Total - ' + IntToStr(FL.Count) + ' certs');
  if Fl.count > 0 then begin
    Form1._msg('Data exist, skip certificate repair...');
    result := True;
    exit;
  end
  else begin
    Form1._msg('Uploading certificates...');
    FL := TStringList.Create;
    ScanDir(ExtractFileDir(Application.ExeName) + '\phdata\cert', '', Fl);
 // Form1._msg('Will write '+inttostr(FL.count)+' certs...');
    Form1.pb1.maxvalue := Fl.Count;
    for i := 0 to FL.count - 1 do
    begin
      filecert := FL.Strings[i];
      if pos('ext_info.sys', filecert) > 0 then
      begin
        s40delfileuni(path + 'ext_info.sys');
      end;
      M := TmemoryStream.Create;
      M.LoadFromFile(filecert);
      if not S40WriteUni(M, path + extractfilename(filecert), 2) then
      begin
        if s40builddir(path)
          then
        begin
          Application.ProcessMessages;
          if ConMode = 1 then Sleep(500);
          Application.ProcessMessages;
          if ConMode = 1 then FbusSendSynk;
          if ConMode = 1 then Sleep(500);
          Application.ProcessMessages;
          if ConMode = 1 then Sleep(500);
          Application.ProcessMessages;
          if not S40WriteUni(M, path + extractfilename(filecert), 2) then
            form1._msg('Error write : ' + extractfilename(filecert))
          else i2 := i2 + 1;
        end
        else
        begin
          FL.Free;
          form1._msg('Write user cert failed - not need for that phone');
           // form1._msg('User certificate repair done!');
          Form1.pb1.progress := 0;
          Form1.pb1.maxvalue := 100;
        end;
        Application.ProcessMessages;
      end
      else
      begin
        i2 := i2 + 1;
       //form1._msg('Write '+extractfilename(filecert) +'...Ok!');
        Application.ProcessMessages;
      end;
      M.Free;
      Form1.pb1.progress := Form1.pb1.progress + 1;
      Application.ProcessMessages;
    end;
    FL.Free;
    form1._msg('Writen ' + inttostr(i2) + ' certs!');
 // form1._msg('User certificate repair done!');
    Form1.pb1.progress := 0;
    Form1.pb1.maxvalue := 100;
  end;
end;

procedure ScanDir(StartDir: string; Mask: string; List: TStrings);
var
  SearchRec: TSearchRec;
begin
  if Mask = '' then
    Mask := '*.*';
  if StartDir[Length(StartDir)] <> '\' then
    StartDir := StartDir + '\';
  if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
  begin
    repeat Application.ProcessMessages;
      if (SearchRec.Attr and faDirectory) <> faDirectory then begin
        List.Add(StartDir + SearchRec.Name);
      end
      else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
      begin
        List.Add(StartDir + SearchRec.Name + '\');
        ScanDir(StartDir + SearchRec.Name + '\', Mask, List);
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

function S40repairUserData(typ: Integer): Boolean;
var
  Fl: TStringList;
  path, filet: string;
  i, i2: Integer;
begin
  result := false;
  FL := TStringList.Create;
  case Typ of
 { 0: begin  //income messages;
     if not s40drvscan then  path:=Utf8Encode('c:\predefmessages\predefinbox\') else  path:=Utf8Encode('s:\predefmessages\1\');
     end;
  1:  begin  //out messages;
     if not s40drvscan then  path:=Utf8Encode('c:\predefmessages\3\') else  path:=Utf8Encode('s:\predefmessages\3\');
     end;}
    0: begin //photos;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefphotos\') else path := Utf8Encode('c:\Photos\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 0);
      end;
    1: begin //records;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefrecordings\') else path := Utf8Encode('c:\Recordings\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 1);
      end;
    2: begin //video;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefvideos\') else path := Utf8Encode('c:\Videos\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 2);
      end;
    3: begin //music;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefmusic\') else path := Utf8Encode('c:\Music\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 3);
      end;
  end;
  Form1.pb1.maxvalue := Fl.Count;
  i2 := 0;
  if Fl.count = 0 then Exit;
  Form1._msg('Now will write ' + inttostr(FL.count) + ' files...');
  for i := 0 to FL.count - 1 do
  begin
    try
      filet := FL.Strings[i];
      M := TmemoryStream.Create;
      M.LoadFromFile(filet);
      if not S40Writeuni(M, Utf8Encode(path + extractfilename(filet)), 2) then
      begin
        form1._msg('Error write : ' + extractfilename(filet));
        form1._msg('Already exist...');
        Application.ProcessMessages;
      end
      else begin
        i2 := i2 + 1;
       //form1._msg('Write '+extractfilename(filet) +'...Ok!');
        Application.ProcessMessages;
      end;
      M.Free;
    except
      form1._msg('Error open file : ' + extractfilename(filet));
      form1._msg('Skip...');
    end;
    Form1.pb1.progress := Form1.pb1.progress + 1;
    Application.ProcessMessages;
  end;
  FL.Free;
  form1._msg(inttostr(i2) + ' files write Ok!');
  form1._msg('UserData write done!');
  Form1.pb1.progress := 0;
  Form1.pb1.maxvalue := 100;
  result := True;
end;

function S40ClearDir(typ: Integer): Boolean;
var
  Fl: TStringList;
  path, filet, fpath: string;
  i, i2: Integer;
begin
  result := false;
  FL := TStringList.Create;
  i2 := 0;
  case Typ of
 { 0: begin  //income messages;
     if not s40drvscan then  path:=Utf8Encode('c:\predefmessages\predefinbox\') else  path:=Utf8Encode('s:\predefmessages\1\');
     end;
  1:  begin  //out messages;
     if not s40drvscan then  path:=Utf8Encode('c:\predefmessages\3\') else  path:=Utf8Encode('s:\predefmessages\3\');
     end;}
    0: begin //photos;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefphotos\') else path := Utf8Encode('c:\Photos\');
      end;
    1: begin //records;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefrecordings\') else path := Utf8Encode('c:\Recordings\');
      end;
    2: begin //video;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefvideos\') else path := Utf8Encode('c:\Videos\');
      end;
    3: begin //music;
        if not s40drvscan then path := Utf8Encode('c:\predefgallery\predefmusic\') else path := Utf8Encode('c:\Music\');
      end;
  end;
  Form1.GetS40FileList(FL, path);
  Form1._msg('Check done, processing data...');
  if Fl.count = 0 then begin
    form1._msg('Nothing to delete...');
    Exit;
  end;
  Form1._msg('Total - ' + IntToStr(FL.Count) + ' files to delete...');
  Form1._msg('Deleting data...');
  Form1.pb1.maxvalue := Fl.Count;
  for i := 0 to FL.Count - 1 do begin
    fpath := FL.Strings[i];
    if not s40delfileuni(fpath) then begin
      changerigts($0020, fpath);
      sleep(100);
      if not s40delfileuni(fpath) then begin
        Form1._msg('Error while delete file, skip...');
        Application.ProcessMessages;
      end else i2 := i2 + 1;
      Application.ProcessMessages;
    end
    else i2 := i2 + 1;
    Application.ProcessMessages;
    Form1.pb1.Progress := form1.pb1.progress + 1;
  end;
  form1._msg(inttostr(i2) + ' files Deleted Ok!');
  Form1.pb1.progress := 0;
  Form1.pb1.maxvalue := 100;
  result := True;
end;

function S60repairUserData(typ: Integer): Boolean;
var
  Fl: TStringList;
  path, filet: string;
  i, i2: Integer;
begin
  result := False;
  path := '';
  FL := TStringList.Create;
   //ScanDir(ExtractFileDir(Application.ExeName)+'\phdata\ToPhone','',Fl);
  case Typ of
    0: begin //photos;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Images\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 0);
      end;
    1: begin //records;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Sounds\Digital');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 1);
      end;
    2: begin //video;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Videos\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 2);
      end;
    3: begin //music;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Sounds\');
        FindIt(ExtractFileDir(Application.ExeName) + '\' + form1.statusbar.Panels[2].Text, Fl, 3);
      end;
  end;
  Form1.pb1.maxvalue := Fl.Count;
  i2 := 0;
  if Fl.count = 0 then Exit;
  Form1._msg('Now will write ' + inttostr(FL.count) + ' files...');
  for i := 0 to FL.count - 1 do
  begin
    try
      filet := FL.Strings[i];
      M := TmemoryStream.Create;
      M.LoadFromFile(filet);
      if not s60WriteFuni(M, Utf8Encode(path + extractfilename(filet)), 2) then
      begin
        form1._msg('Error write : ' + extractfilename(filet));
        form1._msg('Skip...');
        Application.ProcessMessages;
      end
      else begin
        i2 := i2 + 1;
       //form1._msg('Write '+extractfilename(filet) +'...Ok!');
        Application.ProcessMessages;
      end;
      M.Free;
    except
      form1._msg('Error open file : ' + extractfilename(filet));
      form1._msg('Skip...');
    end;
    Form1.pb1.progress := Form1.pb1.progress + 1;
    Application.ProcessMessages;
  end;
  FL.Free;
  form1._msg(inttostr(i2) + ' files write Ok!');
  form1._msg('UserData write done!');
  Form1.pb1.progress := 0;
  Form1.pb1.maxvalue := 100;
  result := True;
end;


function S60ClearDir(typ: Integer): Boolean;
var
  Fl: TStringList;
  path, filet, fpath: string;
  i, i2: Integer;
begin
  result := false;
  path := '';
  FL := TStringList.Create;
  i2 := 0;
  case Typ of
    0: begin //photos;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Images\');
      end;
    1: begin //records;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Sounds\Digital');
      end;
    2: begin //video;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Videos\');
      end;
    3: begin //music;
        if generation = '01' then path := Utf8Encode('C:\Nokia\') else path := Utf8Encode('C:\Data\Sounds\');
      end;
  end;
  Form1.GetS60FileList(FL, path);
  Form1._msg('Check done, processing data...');
  if Fl.count = 0 then begin
    form1._msg('Nothing to delete...');
    Exit;
  end;
  Form1._msg('Total - ' + IntToStr(FL.Count) + ' files to delete...');
  Form1._msg('Deleting data...');
  Form1.pb1.maxvalue := Fl.Count;
  for i := 0 to FL.Count - 1 do begin
    fpath := FL.Strings[i];
    if not s60deletefuni(fpath)
      then begin
      Form1._msg('Error while delete file, skip...');
      Application.ProcessMessages;
    end else i2 := i2 + 1;
    Application.ProcessMessages;
    Form1.pb1.Progress := form1.pb1.progress + 1;
  end;
  form1._msg(inttostr(i2) + ' files Deleted Ok!');
  Form1.pb1.progress := 0;
  Form1.pb1.maxvalue := 100;
  result := True;
end;


function BB5ScanHeader(core: string): integer;
var
  fs: TfileStream;
  data: string;
  hdrlen, seemcount,
    CurrSeemLen, i: Integer;
  currseem: Byte;
  a: string;
  streamlen: TMemoryStream;
  loaderlen: DWORD;
  algo: integer;
  dead, SmartFA,
    partition, omap: Boolean;
  F0b, F2b: Boolean;
begin
  algo := 0;
  dead := False;
  SmartFa := False;
  F0b := false;
  F2b := false;
  partition := false;
  csbyte1 := $00;
  csbyte2 := $00;
  csbyte3 := $00;
  csbyte4 := $00;
  fs := TFileStream.Create(core, fmOpenRead);
  fs.Read(buf[0], 1);
  if buf[0] <> $B2 then //Заголовок / идентификатор
  begin
    if Buf[0] = $91 then
    begin
      result := $A;
      fs.Free;
      Exit;
    end;
    Form1.lst1.items.add('File damaged or Unknow format... :(');
    fs.Free;
    exit;
  end;
  fs.ReadBuffer(buf[0], 4); //Длина Flash-header'a
  HdrLen := HexToInt(IntToHex(buf[0], 2) + IntToHex(buf[1], 2) + IntToHex(buf[2], 2) + IntToHex(buf[3], 2));
     //form1._msg('HeaderLen: '+inttostr(HdrLen));
  fs.ReadBuffer(buf[0], 4); //Кол-во блоков в Flash-заголовке
  SeemCount := HexToInt(IntToHex(buf[0], 2) + IntToHex(buf[1], 2) + IntToHex(buf[2], 2) + IntToHex(buf[3], 2));
     //form1._msg('BlockCount: '+inttostr(SeemCount));
  Application.ProcessMessages;
  while (fs.Position < HdrLen) do
  begin
    fs.ReadBuffer(CurrSeem, 1);
    case CurrSeem of //Перебор всех блоков, поиск блока со структурой RAW-loader'а

      $E6:
        begin
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.ReadBuffer(csbyte1, 1);
          fs.ReadBuffer(csbyte2, 1);
          fs.ReadBuffer(csbyte3, 1);
          fs.ReadBuffer(buf[0], CurrSeemLen - 3);
        end;
      $C2:
        begin
          a := '';
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.ReadBuffer(buf[0], CurrSeemLen);
                   //Form1._msg('Check Algo: BB5 Headerfound!');
          a := hex2chr(buftohexstr(@Buf[0], CurrSeemLen));
                  // Form1._msg('TYPE: '+ Trim(a));
          if Trim(a) <> 'BB5' then
          begin
            Form1._msg('Unknow type! [' + trim(a) + ']');
            result := 0;
            fs.Free;
            Exit;
          end;
          Application.ProcessMessages;

        end; //End of Block C2
      $C3: begin
          a := '';
          data := '';
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.ReadBuffer(buf[0], currseemlen);
                   //fs.Seek(fs.Position-1, sofromBeginning);
                   //Form1._msg('Check Algo: BB5 DataTypeFound!');
          data := '';
          for i := 0 to CurrSeemLen - 1 do data := data + byte2str((buf[i]));
          a := Trim(hex2chr(data));
                 // Form1._msg('ALGO: '+a);
          if a = 'BB5 ALGORITHM' then algo := 1;
          if a = 'XSR 1.5' then algo := 2;
          if a = 'XSR 1.6' then algo := 3;
        end; //End of Block C3
      $E4:
        begin
               //Form1._msg('SEEM: E4');
          fs.ReadBuffer(buf[0], 2);
          CurrSeemLen := (buf[0] * $100) + buf[1];
          fs.Seek(CurrSeemLen, sofromCurrent);
        end;
      $E5:
        begin
               //Form1._msg('SEEM: E5');
          fs.ReadBuffer(buf[0], 2);
          CurrSeemLen := (buf[0] * $100) + buf[1];
          fs.Seek(CurrSeemLen, sofromCurrent);
        end;
      $EA:
        begin
               //Form1._msg('SEEM: EA');
          fs.ReadBuffer(buf[0], 2);
          CurrSeemLen := (buf[0] * $100) + buf[1];
          fs.Seek(CurrSeemLen, sofromCurrent);
        end;
      $EE:
        begin
               //Form1._msg('SEEM: EE');
          fs.ReadBuffer(buf[0], 2);
          CurrSeemLen := (buf[0] * $100) + buf[1];
          fs.Seek(CurrSeemLen, sofromCurrent);
          partition := True;
          Application.ProcessMessages;
        end;
      $F2: begin
             //  form1._msg('F2 found=)');
          F2b := true;
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.Seek(CurrSeemLen, sofromcurrent);
          Application.ProcessMessages;
        end;

      $F0: begin
              // form1._msg('F0 found=)');
          F0b := True;
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.Seek(CurrSeemLen, sofromcurrent);
          Application.ProcessMessages;
        end;
      $F3:
        begin
              // Form1._msg('SEEM: F3');
          fs.ReadBuffer(buf[0], 2);
          CurrSeemLen := (buf[0] * $100) + buf[1];
              // Form1._msg('Dead mode support : True');
          dead := True;
          fs.Seek(CurrSeemLen, sofromCurrent);
        end;
      $FA: begin
              //Form1._msg('SEEM: FA');
          streamlen := TmemoryStream.Create;
          streamlen.CopyFrom(fs, $E); // создавал поток, потому что иначе пока не умею
          streamlen.Seek(1, sofromBeginning); // пропускаем один байт
          streamlen.ReadBuffer(loaderlen, 4); // читаем длину - это длина всего адресного пространства блока FA, которое занимает апдейт апп, сразу после блока длины.
          dwordswap(@loaderlen); // разворачиваем
              //form1._msg('SEEM: FA:LEN: '+ inttostr(loaderlen));
          fs.seek(loaderlen - 9, sofromcurrent); // меняем позицию - после идут старые добрые С8
          Application.ProcessMessages;
          streamlen.Free;
        end;
      $E8:
        begin
          a := '';
          data := '';
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.ReadBuffer(buf[0], currseemlen);
          for i := 0 to CurrSeemLen do data := data + byte2str((buf[i]));
          a := Trim(hex2chr(data));
          omap := true;
                //Form1._msg('OMAP ASIC : '+a);
          if Pos('OMAP1710', a) > 0 then algo := 4 else
            if Pos('OMAP2420', a) > 0 then algo := 6 else
              if Pos('OMAP1610', a) > 0 then algo := 8 else
                if pos('N8815', a) > 0 then algo := 9 else algo := 0;
        end;
      $C8:
        begin
              // Form1._msg('SEEM: C8');
          fs.ReadBuffer(buf[0], 1);
          CurrSeemLen := buf[0];
          fs.seek(currseemlen, sofromcurrent);
        end;
    else
      begin
        fs.ReadBuffer(buf[0], 1);
        CurrSeemLen := buf[0];
        fs.Seek(CurrSeemLen, sofromcurrent);
      end;
    end;
  end;
  Fs.free;
  case algo of
    1: begin //bb5 algorithm
        if F0b = True then result := 1 else result := 3;
      end;
    2: begin //xsr1.5
        if (loaderlen > $100000) and (partition = True) and (omap = false) then result := 2
        else if (dead = true) and (partition = false) and (F0b = True) then result := 1 else result := 5;
      end;
    3: begin //xsr1.6
        if (loaderlen > $100000) and (partition = True) then result := 2 else result := 5;
      end;
    4: result := 4;
    5: result := 5;
    6: result := 6;
    0: result := 0;
    8: result := 8;
    9: result := 9;
  end;
end;

procedure FindIt(const aDir: string; aLog: TStrings; typ: Integer);
const
  N = 5;
  ArrExt: array[1..N] of string = (
    '.JPEG',
    '.JPG',
    '.BMP',
    '.GIF',
    '.PNG'
    );
  Atrext1: array[1..N] of string = (
    '.3GP',
    '.AVI',
    '.MPEG',
    '.MP4', //.mp4
    '.3GPP'
    );
  Atrext2: array[1..N] of string = (
    '.MP3',
    '.ACC',
    '.OGG',
    '.WAV',
    '.MIDI'
    );
var
  StrExt: string;
  StrDir: string;
  SearchRec: TSearchRec;
  i: Integer;
begin
  StrDir := IncludeTrailingBackslash(aDir);
  //Form1._msg('Папка: ' + StrDir);
  if FindFirst(StrDir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      Application.ProcessMessages;
      StrExt := UpperCase(ExtractFileExt(SearchRec.Name));
      if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
        Continue;
      if (SearchRec.Attr and faDirectory) <> 0 then
        FindIt(StrDir + SearchRec.Name, aLog, typ)
      else
        case typ of
          0: begin
              for i := 1 to N do begin
                if StrExt = ArrExt[i] then begin
                  alog.add(StrDir + SearchRec.Name);
                  Break;
                end;
              end;
            end;
          1: begin
              if StrExt = '.AMR' then begin
                aLog.add(StrDir + SearchRec.Name);
                Break;
              end;

            end;
          2: begin
              for i := 1 to N do begin
                if StrExt = Atrext1[i] then begin
                  aLog.add(StrDir + SearchRec.Name);
                  Break;
                end;
              end;
            end;
          3: begin
              for i := 1 to N do begin
                if StrExt = Atrext2[i] then begin
                  aLog.add(StrDir + SearchRec.Name);
                  Break;
                end;
              end;
            end;
        end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

function CheckFiles(s: string): Boolean;
begin
  if FileExists(s) then result := True else begin
    Form1._msg('->  File : ' + extractfilename(s) + ' not found! Check it!');
    result := False;
  end;
end;

function getphoneSWver(s: string): string;
begin

end;

function checkSWver(): boolean;
var
  s: string;
  i: integer;
  s2, s3: string;
begin
  result := false;
  try
    s2 := '';
    s := '';
    s3 := '';
    form1._msg('->  Check SW version...');
    swver := Copy(Form1.cbbSelPC.text, Pos('ver ', Form1.cbbSelPC.text) + 4, (Length(Form1.cbbSelPC.text) - Pos('ver ', Form1.cbbSelPC.text)) + 4);
    i := 0;
    i := Pos('ver', SWver);
 //form1._msg(inttostr(i));
    if i > 0 then i := i + 3;
    if i > 0 then swver := Copy(SWver, i, Length(SWver) - (i - 1));
    swver := Trim(swver);
    if (SWver[1] = 'v') or (SWver[1] = 'V') then swver := Copy(SWver, 2, Length(SWver) - 1);
    swver := Trim(SWver);
    i := 0;
    form1._msg('FlashFile version : ' + SWver);
    if PhInfoRecord.APECoreSW <> '' then begin
      form1._msg('Phone version : ' + PhInfoRecord.APECoreSW);
      s := PhInfoRecord.APECoreSW;
      if s[1] = 'V' then s := copy(s, 3, length(s) - 2);
      for i := 1 to length(s) do begin
        if s[i] = ' ' then Break;
        if s[i] = #10 then Break;
        if s[i] <> '.' then s2 := s2 + s[i];
      end;
// form1._msg(s2);
    end else begin
      s := Copy(PhInfoRecord.MCUSW, 3, length(PhInfoRecord.MCUSW));
      form1._msg('Phone version : ' + s);
      for i := 1 to length(s) do begin
        if s[i] = ' ' then Break;
        if s[i] = #10 then Break;
        if s[i] <> '.' then s2 := s2 + s[i];
      end;
 //form1._msg(s2);
    end;
    for i := 1 to length(SWver) do begin
      if Swver[i] = ' ' then Break;
      if s[i] = #10 then Break;
      if SWver[i] <> '.' then s3 := s3 + SWver[i];
    end;
 //form1._msg(s3);
    s2 := Trim(s2);
    s3 := Trim(s3);
    if (s2 <> '') and (s3 <> '') then begin
      if strtoint(s2) = StrToInt(s3) then Form1._msg('->  Check SW version : Reflash');
      if strtoint(s3) > StrToInt(s2) then Form1._msg('->  Check SW version : Upgrade');
      if strtoint(s3) < StrToInt(s2) then
      begin
        Form1._msg('->  Check SW version : Downgrade try');
        result := True;
      end;
    end
    else Form1._msg('->  Error on SW version check... ');
  except
    Form1._msg('->  Error on SW version check... ');
  end;
end;

function resetLTnew(): Boolean;
var
  b: Integer;
begin
  result := False;
  b := ReadLTF;
  case b of
    1: if PmWriteRecord(88, 0, '000000000000000000000000000000000000000000000000000000000000000000000000') <> 'Error' then form1._msg('Reset Done!')
      else form1._msg('Reset Error!');
    2: if (PMwriterecord(373, 0, '0000000000000000000000000000000000000000000000000000000000000000000000000000000001FF0000') <> 'Error') and
      (PMwriterecord(374, 0, '00000000') <> 'Error')
        then form1._msg('Reset Done!')
      else form1._msg('Reset Error!');
    3: if PmWriteRecord(382, 1, '00000000') <> 'Error' then form1._msg('Reset Done!')
      else form1._msg('Reset Error!');
  else
    begin
      Form1._msg('Error check LifeTimer Data, break :(');
      Form1._msg('Reset It manually, please');
      Exit;
    end;
  end;
  result := true;
end;

function CheckCamSW(): Boolean;
var
  cs1, cs2, cs3, pms, fs1, fs2: string;
begin
  form1._msg('Checking Camera Configuration data...');
  CheckCamVer[7] := msgid;
  CheckCamVer[10] := $01;
  USBBulkWritePort(@CheckCamVer, Length(CheckCamVer));
  USBBulkReadPort($FFFF);
  if (rxBuf[11] = $01) and (rxBuf[15] = $01) then begin
    cs1 := hex2chr(Buftohexstr(@rxBuf[20], rxBuf[19]));
    Form1._msg('Cam1_HW : ' + cs1);
  end else Form1._msg('Not found HW description, looks like not exist');
  form1._msg('Done!');
  form1._msg('');
end;



function CheckFulFile(core: string): Boolean;
const
  maxlen: dWORD = $4FFFF;
var
  buf: array[0..$4FFFF] of byte;
  HdrLen,
    CurrBlockLen: Cardinal;
  EntryPoint,
    DataLen,
    TargetOffset,
    CRCTmp: LongInt;
  i, n, Blocks,
    Packets, icl,
    CurrPacketSize,
    TokenHdrLen: Integer;
  good: Integer;
  fs: TFileStream;
  cmtcount, cmtdin,
    TokenSubType, unk: integer;
  ttxbuf: array[0..$4FFFF] of byte;
  apebyte: Byte;
begin
  Result := False;
     //Form1._msg('Check : Processing '+ExtractFileName(core));
  fs := TFileStream.Create(core, fmOpenRead);
  fs.Seek(0, sofromBeginning);
  Blocks := 0;
  cmtcount := 0; cmtdin := 0;
  Application.ProcessMessages;
  try
    fs.Read(ttxbuf[0], 1);
    if ttxbuf[0] <> $B2 then
    begin
      fs.free;
      result := false;
      exit;
    end;

    fs.ReadBuffer(ttxbuf[0], 4);
    HdrLen := HexToInt(IntToHex(ttxbuf[0], 2) + IntToHex(ttxbuf[1], 2) +
      IntToHex(ttxbuf[2], 2) + IntToHex(ttxbuf[3], 2));

    fs.Seek(HdrLen, sofromcurrent);
     {ms:=TMemoryStream.Create;}
    while fs.Position < fs.Size do
    begin
      Application.ProcessMessages;
      fs.ReadBuffer(ttxbuf[8], 1);
      case ttxbuf[8] of
        $54: //Flash-token
          begin
            fs.ReadBuffer(ttxbuf[$09], $3);
            TokenHdrLen := ttxbuf[$0B];
            TokenSubType := TokenHdrLen;
            fs.Seek(fs.position - 4, sofrombeginning);
            inc(TokenHdrLen, 5);
            fs.ReadBuffer(ttxbuf[8], TokenHdrLen);
            apebyte := ttxbuf[12];

            CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - 1], 2) +
              IntToHex(ttxbuf[TokenHdrLen], 2) +
              IntToHex(ttxbuf[TokenHdrLen + 1], 2) +
              IntToHex(ttxbuf[TokenHdrLen + 2], 2));
                   //Form1._msg('CurrLen : '+inttostr(CurrBlockLen));

            case TokenSubType of
              $0E:
                begin
                  ttxbuf[8 + TokenHdrLen] := $00;
                  fs.ReadBuffer(ttxbuf[9 + TokenHdrLen], CurrBlockLen);
                end;
              $15:
                begin
                  DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000;
                  fs.ReadBuffer(ttxbuf[$0A + TokenHdrLen], CurrBlockLen);
                end;
            else
              DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000;
              fs.ReadBuffer(ttxbuf[$0A + TokenHdrLen], CurrBlockLen);
            end;
            Application.ProcessMessages;

            inc(blocks);

          end; //End of Case $54

        $5D: //Phoenix-segment
          begin

            fs.ReadBuffer(ttxbuf[$09], $3);
            TokenHdrLen := ttxbuf[$0B];
            TokenSubType := TokenHdrLen;
            fs.Seek(fs.position - 4, sofrombeginning);
            inc(TokenHdrLen, 5);
            fs.ReadBuffer(ttxbuf[8], TokenHdrLen);
            apebyte := ttxbuf[44];
            case TokenSubType of
              $2D:

                CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - 1], 2) +
                  IntToHex(ttxbuf[TokenHdrLen], 2) +
                  IntToHex(ttxbuf[TokenHdrLen + 1], 2) +
                  IntToHex(ttxbuf[TokenHdrLen + 2], 2));
              $43:

                CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - $17], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $16], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $15], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $14], 2));
            else
              begin
                fs.Free;
                result := false;
                exit;
              end;
            end; //End of Case
            good := 0;
            if good < $10 then
            begin
              fs.Seek(CurrBlockLen, soFromCurrent);
              continue;
            end
            else
            begin
              case TokenSubType of
                $2D:
                  begin
                    DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000; //$0000
                    fs.ReadBuffer(ttxBuf[$0A + TokenHdrLen], CurrBlockLen);
                  end;
                $43:
                  begin
                    fs.ReadBuffer(ttxBuf[$08 + TokenHdrLen], CurrBlockLen);
                    Application.ProcessMessages;
                  end;
              end;
            end;
          end;
          //End of Case $5D
      else
        begin //Unknow Tokens or Bad File
          fs.free;
          result := false;
          exit;
        end;
      end;
    end;
    fs.free;
    result := True;
    Application.ProcessMessages;
  except
    fs.free;
    result := false;
    exit;
  end;

end;

function checkflfiles(): Boolean;
var
  bad: integer;
begin
  result := false;
  if (core <> '') or (Form1.chkMCUen.checked = true) then begin
    if not CheckFulFile(core) then begin
      Form1._msg('Bad file : ' + extractfilename(core));
      core := ''; Form1.chkMCUen.checked := False; Form1.MCUt.Text := '';
      bad := bad + 1;
    end;
  end;
  if (ppm <> '') or (Form1.chkPPMe.Checked = True) then begin
    if not CheckFulFile(ppm) then begin
      Form1._msg('Bad file : ' + extractfilename(ppm));
      ppm := ''; Form1.chkPPMe.checked := False; Form1.PPMt.Text := '';
      bad := bad + 1;
    end;
  end;
  if (ppm1 <> '') or (Form1.chkPPM1e.Checked = True) then begin
    if not CheckFulFile(ppm1) then begin
      Form1._msg('Bad file : ' + extractfilename(ppm1));
      ppm1 := ''; Form1.chkPPM1e.checked := False; Form1.PPM1t.Text := '';
      bad := bad + 1;
    end;
  end;
  if (image <> '') or (Form1.chkCNTe.Checked = True) then begin
    if not CheckFulFile(image) then begin
      Form1._msg('Bad file : ' + extractfilename(image));
      image := ''; Form1.chkCNTe.checked := False; Form1.CNTt.Text := '';
      bad := bad + 1;
    end;
  end;
  if (ape <> '') or (Form1.chkAPEe.Checked = True) then begin
    if not CheckFulFile(ape) then begin
      Form1._msg('Bad file : ' + extractfilename(ape));
      ape := ''; Form1.chkAPEe.checked := False; Form1.APEt.Text := '';
      bad := bad + 1;
    end;
  end;
  if (cnt3 <> '') or (Form1.chkcnt3.checked = true) then begin
    if not CheckFulFile(cnt3) then begin
      Form1._msg('Bad file : ' + extractfilename(cnt3));
      cnt3 := ''; Form1.chkcnt3.checked := False; Form1.cnt3t.Text := '';
      bad := bad + 1;
    end;
  end;
  if bad > 0 then result := False else result := True;
end;

function readset(tp: string; rec: string): boolean;
var
  setini: TIniFile;
begin
  setini := TIniFile.Create(ExtractFileDir(Application.ExeName) + '\settings.ini');
  result := setini.readbool(tp, rec, False);
  setini.Free;
end;

function getmodel(data: string): string;
var
  s, model, swdate, swver: string;
  i, cnt: integer;
  p1, p2, p3: string;
begin
  p1 := chr($0A) + 'R';
  p2 := chr($0A) + 'NH';
  p3 := chr($0A) + 'NEM';
  model := '';
  if pos(p1, data) <> 0 then begin
    i := pos(p1, data);
    Inc(i);
    if i > 0 then begin
      repeat
        model := model + data[i];
        Inc(i);
      until data[i] = chr($0A);
    end
    else model := '';
  end
  else
    if pos(p2, data) <> 0 then
    begin
      i := pos(p2, data);
      Inc(i);
      if i > 0 then begin
        repeat
          model := model + data[i];
          Inc(i);
        until data[i] = chr($0A);
      end else model := '';
    end
    else
      if pos(p3, data) <> 0 then
      begin
        i := pos(p3, data);
        Inc(i);
        if i > 0 then begin
          repeat
            model := model + data[i];
            Inc(i);
          until data[i] = chr($0A);
        end else model := '';
      end
      else model := '';
  if model <> '' then result := model;
end;

function InfineonResetCode(): Boolean;
var
  s: string;
  i: integer;
begin
  result := false;
  s := Pmreadrecord(32, 0);
  if (s <> '') and (s <> 'Error') and (Length(s) = 20) then begin
    if PMwriterecord(32, 0, '00000000000000000000') <> 'Ok' then Exit;
  end else exit;
  s := PmReadrecord(32, 1);
  if (s <> '') and (s <> 'Error') then begin
    if PMwriterecord(32, 1, '00') <> 'Ok' then Exit;
  end else exit;
  s := PmReadrecord(32, 2);
  if (s <> '') and (s <> 'Error') then begin
    if PMwriterecord(32, 2, '0000') <> 'Ok' then Exit;
  end else exit;
  result := True;
end;

function dct4codereset(): Boolean;
var
  s: string;
  i: integer;
begin
  result := False;
  s := Pmreadrecord(308, 5);
  if (s <> '') and (s <> 'Error') and (Length(s) = 20) then begin
    if not UserCodeReset then exit;
    Form1._msg(clearUCodedata(1));
  end
  else
  begin
    if not InfineonResetCode then exit;
  end;
  result := True;
end;

procedure grabrpl(mode: integer); //00:usb 01:ufs
var
  i, x, i2, len: Integer;
  s: string;
  rpl: textFile;
  crtname: string;
  strlist: TStringList;
  clrnpc, clrcc, clrhwc, clrvar,
    clrrdd: string;
begin
  npc := ''; ccc := ''; hwc := ''; randd := ''; variantcert := '';
  clrnpc := ''; clrcc := ''; clrhwc := ''; clrvar := '';
  clrrdd := '';
  case mode of
    0:
      begin
        npc := readcertrequsb('NPC');
        if (npc <> '') and (npc <> 'Error') and (npc <> 'Blank') then begin
          i := Pos('47534D', npc);
          s := Copy(npc, i + 16, 16);
          imei_global := copy(swapstring(s), 2, 15);
          form1._msg('IMEI : ' + imei_global);
        end;
        Application.ProcessMessages;
        ccc := readcertrequsb('CCC');
        Application.ProcessMessages;
        hwc := readcertrequsb('HWC');
        Application.ProcessMessages;
        randd := readcertrequsb('R&D');
        Application.ProcessMessages;
        variantcert := readcertrequsb('VARIANT');
        Application.ProcessMessages;
      //variantcert:=readcertrequsb('RND');
      //Application.ProcessMessages;
      end;
    1: begin
        Form1.statusbar.Panels[0].Text := 'UFS : Read Certificates';
        npc := ReadCert($00, 'NPC');
        Application.ProcessMessages;
        if (npc <> '') and (npc <> 'Error') and (npc <> 'Blank') then begin
          i := Pos('47534D', npc);
          s := Copy(npc, i + 16, 16);
          imei_global := copy(swapstring(s), 2, 15);
          form1._msg('IMEI : ' + imei_global);
        end;
        Application.ProcessMessages;
        ccc := ReadCert($00, 'CCC');
        Application.ProcessMessages;
        hwc := ReadCert($00, 'HWC');
        Application.ProcessMessages;
    //randd:=ReadCert($00,'R&D');
    //Application.ProcessMessages;
        variantcert := ReadCert($00, 'VARIANT');
        Application.ProcessMessages;
        if apeexist then begin
          Form1.statusbar.Panels[0].Text := 'UFS : Read Certificates';
          apenpc := ReadCert($01, 'NPC');
          Application.ProcessMessages;
          Application.ProcessMessages;
          apecc := ReadCert($01, 'CCC');
          Application.ProcessMessages;
          apehwc := ReadCert($01, 'HWC');
          Application.ProcessMessages;
     //randd:=ReadCert($00,'R&D');
     //Application.ProcessMessages;
          apevar := ReadCert($01, 'VARIANT');
          Application.ProcessMessages;
        end;
      end;
  end;
  if (npc <> '') or (hwc <> '') or (ccc <> '') then begin
    if npc <> '' then
    begin
      i := 0;
      i2 := 1;
      s := '';
      repeat
        s := Copy(npc, i2, 80);
        if (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '') then break;
        clrnpc := clrnpc + s;
        i2 := i2 + 80;
        Inc(i);
        Application.ProcessMessages;
      until (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '');
      rplrecord.npc := clrnpc;
    end;
    if ccc <> '' then
    begin
      i := 0;
      i2 := 1;
      s := '';
      repeat
        s := Copy(ccc, i2, 80);
        if (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '') then break;
        clrcc := clrcc + s;
        i2 := i2 + 80;
        Inc(i);
        Application.ProcessMessages;
      until (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '');
      RPLRecord.ccc := clrcc;
    end;
    if hwc <> '' then
    begin
      i := 0;
      i2 := 1;
      s := '';
      repeat
        s := Copy(hwc, i2, 80);
        if (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '') then break;
        clrhwc := clrhwc + s;
        i2 := i2 + 80;
        Inc(i);
        Application.ProcessMessages;
      until (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '');
      RPLRecord.hwc := clrhwc;
    end;
    if variantcert <> '' then
    begin
      i := 0;
      i2 := 1;
      s := '';
      repeat
        s := Copy(variantcert, i2, 80);
        if (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '') then break;
        clrvar := clrvar + s;
        i2 := i2 + 80;
        Inc(i);
        Application.ProcessMessages;
      until (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '');
      RPLRecord.Variant := clrvar;
    end;
    if (randd <> '') and (randd[1] <> 'FF') then begin
      i := 0;
      i2 := 1;
      s := '';
      repeat
        s := Copy(randd, i2, 80);
        if (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '') then break;
        clrrdd := clrrdd + s;
        i2 := i2 + 80;
        Inc(i);
        Application.ProcessMessages;
      until (s = 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s = '');
    end;

    {if (apenpc<>'') or (apecc<>'') or (apehwc<>'') or (apevar<>'') then
    begin
     writeln(rpl,' ');
     writeln(rpl,'[CERT_PROG_DATA_OUT_APE]');
     if apenpc<>'' then  begin
     i:=0;
     i2:=1;
     s:='';
     repeat
     s:=Copy(apenpc,i2,80);
     if (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='') then break;
     writeln(rpl,'NPC_DATA_'+inttostr(i+1)+'='+s);
     i2:=i2+80;
     Inc(i);
     Application.ProcessMessages;
     until (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='');
     end;
     if apecc<>'' then  begin
      i:=0;
      i2:=1;
      s:='';
     repeat
     s:=Copy(apecc,i2,80);
     if (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='') then break;
     writeln(rpl,'CCC_DATA_'+inttostr(i+1)+'='+s);
     i2:=i2+80;
     Inc(i);
     Application.ProcessMessages ;
     until (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='');
     end;
     if apehwc<>'' then
     begin
     i:=0;
     i2:=1;
     s:='';
     repeat
     s:=Copy(apehwc,i2,80);
     if (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='') then break;
     writeln(rpl,'HWC_DATA_'+inttostr(i+1)+'='+s);
     i2:=i2+80;
     Inc(i);
     Application.ProcessMessages;
     until (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='');
     end;
     if apevar<>'' then  begin
     i:=0;
     i2:=1;
     s:='';
     repeat
     s:=Copy(apevar,i2,80);
     if (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='') then break;
     writeln(rpl,'VARIANT_DATA_'+inttostr(i+1)+'='+s);
     i2:=i2+80;
     Inc(i);
     Application.ProcessMessages;
     until (s='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF') or (s='');
     end;
    end; }
    Application.ProcessMessages;
   //Form1._msg('Saved to : '+crtname);
    Form1._msg('Cert Read done!');
    Form1._msg('');
  end
  else
  begin
    form1._msg('No any CRT data (MCU damaged/CERT erased), skip saving');
    Form1._msg('');
  end;
end;


function CheckMaemoFile(core: string): Boolean;
const
  maxlen: dWORD = $4FFFF;
var
  buf: array[0..$4FFFF] of byte;
  HdrLen,
    CurrBlockLen: Cardinal;
  EntryPoint,
    DataLen,
    TargetOffset,
    CRCTmp: LongInt;
  i, n, Blocks,
    Packets, icl,
    CurrPacketSize,
    TokenHdrLen: Integer;
  good: Integer;
  fs: TFileStream;
  cmtcount, cmtdin,
    TokenSubType, unk: integer;
  ttxbuf: array[0..$4FFFF] of byte;
  apebyte: Byte;
begin
  Result := False;
     //Form1._msg('Check : Processing '+ExtractFileName(core));
  fs := TFileStream.Create(core, fmOpenRead);
  fs.Seek(0, sofromBeginning);
  Blocks := 0;
  cmtcount := 0; cmtdin := 0;
  Application.ProcessMessages;
  try
    fs.Read(ttxbuf[0], 1);
    if ttxbuf[0] <> $B4 then
    begin
      fs.free;
      result := false;
      exit;
    end;

    fs.ReadBuffer(ttxbuf[0], 4);
    HdrLen := HexToInt(IntToHex(ttxbuf[0], 2) + IntToHex(ttxbuf[1], 2) +
      IntToHex(ttxbuf[2], 2) + IntToHex(ttxbuf[3], 2));

    fs.Seek(HdrLen, sofromcurrent);
     {ms:=TMemoryStream.Create;}
    while fs.Position < fs.Size do
    begin
      Application.ProcessMessages;
      fs.ReadBuffer(ttxbuf[8], 1);
      case ttxbuf[8] of
        $54: //Flash-token
          begin
            fs.ReadBuffer(ttxbuf[$09], $3);
            TokenHdrLen := ttxbuf[$0B];
            TokenSubType := TokenHdrLen;
            fs.Seek(fs.position - 4, sofrombeginning);
            inc(TokenHdrLen, 5);
            fs.ReadBuffer(ttxbuf[8], TokenHdrLen);
            apebyte := ttxbuf[12];

            CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - 1], 2) +
              IntToHex(ttxbuf[TokenHdrLen], 2) +
              IntToHex(ttxbuf[TokenHdrLen + 1], 2) +
              IntToHex(ttxbuf[TokenHdrLen + 2], 2));
                   //Form1._msg('CurrLen : '+inttostr(CurrBlockLen));

            case TokenSubType of
              $0E:
                begin
                  ttxbuf[8 + TokenHdrLen] := $00;
                  fs.ReadBuffer(ttxbuf[9 + TokenHdrLen], CurrBlockLen);
                end;
              $15:
                begin
                  DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000;
                  fs.ReadBuffer(ttxbuf[$0A + TokenHdrLen], CurrBlockLen);
                end;
            else
              DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000;
              fs.ReadBuffer(ttxbuf[$0A + TokenHdrLen], CurrBlockLen);
            end;
            Application.ProcessMessages;

            inc(blocks);

          end; //End of Case $54

        $5D: //Phoenix-segment
          begin

            fs.ReadBuffer(ttxbuf[$09], $3);
            TokenHdrLen := ttxbuf[$0B];
            TokenSubType := TokenHdrLen;
            fs.Seek(fs.position - 4, sofrombeginning);
            inc(TokenHdrLen, 5);
            fs.ReadBuffer(ttxbuf[8], TokenHdrLen);
            apebyte := ttxbuf[44];
            case TokenSubType of
              $2D:

                CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - 1], 2) +
                  IntToHex(ttxbuf[TokenHdrLen], 2) +
                  IntToHex(ttxbuf[TokenHdrLen + 1], 2) +
                  IntToHex(ttxbuf[TokenHdrLen + 2], 2));
              $43:

                CurrBlockLen := HexToInt(IntToHex(ttxbuf[TokenHdrLen - $17], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $16], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $15], 2) +
                  IntToHex(ttxbuf[TokenHdrLen - $14], 2));
            else
              begin
                fs.Free;
                result := false;
                exit;
              end;
            end; //End of Case
            good := 0;
            if good < $10 then
            begin
              fs.Seek(CurrBlockLen, soFromCurrent);
              continue;
            end
            else
            begin
              case TokenSubType of
                $2D:
                  begin
                    DWord((@ttxBuf[$8 + TokenHdrLen])^) := $0000; //$0000
                    fs.ReadBuffer(ttxBuf[$0A + TokenHdrLen], CurrBlockLen);
                  end;
                $43:
                  begin
                    fs.ReadBuffer(ttxBuf[$08 + TokenHdrLen], CurrBlockLen);
                    Application.ProcessMessages;
                  end;
              end;
            end;
          end;
          //End of Case $5D
      else
        begin //Unknow Tokens or Bad File
          fs.free;
          result := false;
          exit;
        end;
      end;
    end;
    fs.free;
    result := True;
    Application.ProcessMessages;
  except
    fs.free;
    result := false;
    exit;
  end;

end;


function FetchData(s: string): string;
var
  f: SYSTEM.Text;
  ss, s1, s5, s4, s2, s3: string;
  i, i2: integer;
begin
  System.Assign(f, s);
  System.Reset(f);
  while not Eof(f) do
  begin
    ss := '';
    system.Readln(f, ss);
    s2 := ''; s3 := ''; s1 := ''; s4 := '';
    s2 := Copy(ss, 8, 10);
    s1 := Copy(ss, 1, 4);
    s4 := Hex2Chr(s2);
    s3 := s4 + ':result:= sbk ' + s1 + ' sbk';
    Form1._msg(s3);
    Application.ProcessMessages;
  end;
  result := s3;
end;

function s40builddir(dir: string): Boolean;
var
  b: Byte;
  s: string;
  Sl: TStringList;
  i: Integer;
  datastr: string;
  ichk: integer;
begin
  result := false;
  case ConMode of
    0: b := S40CreateDir(dir);
    1: b := FbusS40CreateDir(dir);
  end;
  if (b <> $00) and (b <> $04) then begin
    SL := TstringList.create;
    repeat
      ichk := length(dir);
      i := lastpos('\', dir);
      dir := Copy(dir, 1, i - 1);
      if Length(dir) <= 3 then Break;
      Sl.Add(dir + '\');
      if length(dir) = ichk then
      begin
        form1._msg('Error on create topology');
        break;
      end;
    until Length(dir) <= 3;

    for i := Sl.count - 1 downto 0 do
    begin
      case ConMode of
        0: b := S40CreateDir(sl.strings[i]);
        1: b := FbusS40CreateDir(sl.strings[i]);
      end;
      if (b <> $00) and (b <> $04) then break
    end;
    if (b = $00) or (b = $04) then result := true;
  end
  else result := True;
end;

function CreateSimLockRpl(SimlockKey: widestring; SimlockData: WideString): boolean;
var
  i, x: integer;
  framelen: word;
  Len, endpoint: Integer;
  fbuf: array of Byte;
begin
// creating spare block with keys
  case conmode of
    0:
      begin
     //build frame
        txBuf[0] := $1B;
        txBuf[1] := $00;
        txBuf[2] := $10;
        txBuf[3] := $53;
        txBuf[4] := $00;
        txBuf[5] := $00;
        txBuf[6] := $00;
        txBuf[7] := $08;
        txBuf[8] := ISIheadertransID;
        txBuf[9] := $1E;
        i := StrToBufHex(SimlockKey, @txbuf[10]);
        txbuf[$0A + i] := $03;
        txbuf[$0A + i + 1] := $B0;
        x := StrToBufHex(SimlockData, @txbuf[$0A + i + 2]);
{word((@txbuf[$0a+i])^):=x;
wordswap(@txbuf[$0a+i]); }
        framelen := $0A + (i + x) + 2;
        i := 0;
        len := (framelen - 1);
        endpoint := len + ($4F6 - framelen);
        if framelen <> $4F6 then begin
          for i := len + 1 to endpoint do txbuf[i] := $FF;
          framelen := framelen + (endpoint - len);
        end;
        word((@txbuf[4])^) := framelen - 6;
        wordswap(@txbuf[4]);
   //form1._msg(BufToHexStr(@txbuf[0], framelen));
        USBBulkWritePort(@txbuf[0], framelen);
        USBBulkReadPort($FFFF);
   //Form1._msg(BufToHexStr(@rxBuf[0], Length(rxBuf)));
        if rxBuf[10] = $00 then result := True else result := false;
      end;
    1: begin
        Fbussendsynk;
        SetLength(Fbuf, $500);
      //build frame
        Fbuf[0] := $1E;
        Fbuf[1] := $00;
        Fbuf[2] := $10;
        Fbuf[3] := $53;
        Fbuf[4] := $00;
        Fbuf[5] := $00;
        Fbuf[6] := $00;
        Fbuf[7] := $08;
        Fbuf[8] := $5C;
        Fbuf[9] := $1E;
        i := StrToBufHex(SimlockKey, @Fbuf[10]);
        Fbuf[$0A + i] := $03;
        Fbuf[$0A + i + 1] := $B0;
        x := StrToBufHex(SimlockData, @Fbuf[$0A + i + 2]);
        framelen := $0A + (i + x) + 2;
        i := 0;
        len := (framelen - 1);
        endpoint := len + ($4F6 - framelen);
        if framelen <> $4F6 then begin
          for i := len + 1 to endpoint do Fbuf[i] := $FF;
          framelen := framelen + (endpoint - len);
        end;
        word((@Fbuf[4])^) := framelen - 6;
        wordswap(@Fbuf[4]);
       //Fbuf[framelen]:=$01;
       //form1._msg(BufToHexStr(@Fbuf[0],framelen+2));
        FbusRunLongCommand(@Fbuf[0], framelen);
       //form1._msg(byte2str(fbusansb[9])+byte2str(Fbusansb[10]));
        if fbusansb[10] = $00 then result := True else result := false;
      end;
  end;
end;

function readUIDstep1(): Boolean;
var
  tryinit: integer;
  bflag: Boolean;
begin
  result := false;
  Form1._msg('Setting FlashMode');
 //SetBuzy;
  tryinit := 0;
  bflag := false;
  repeat
    bflag := ufx_sw_fbus(fbnum, 'FlashBus');
    Application.ProcessMessages;
    Inc(tryinit);
    if tryinit = 2
      then
    begin
      if (ufx_boot(fbnum)) then
      begin
        ufx_sw_fbus(fbnum, 'FBUS');
        Application.ProcessMessages;
      end
      else
        tryinit := 5;
    end;
    if bflag = true then break;
  until tryinit = 5;
  if not bflag then
  begin
    Form1._msg('UFSx : FlashMode init fail! Reconnect box');
    Form1._msg('');
    boot_done := false;
    Form1.SetReady;
    exit;
  end;
  Form1.statusbar.Panels[0].Text := 'UFS : Booting phone...';
  ufs_cmd(3500, @CMTread[0], 2, @cmd_buf, 200);
 //Form1._msg('BootData : '+BufToHexStr(@cmd_buf[0], $FF));
  Application.ProcessMessages;
  if (FT_In_Buffer[1] > 20) and (FT_In_Buffer[2] = $C0) then FetchBootData
  else
  begin
    form1._msg('No answer from phone... :(');
    form1._msg('1. Check cable/connection, try again');
    form1._msg('2. Maybe HW fault or bad cable');
    form1._msg('');
    form1.SetReady;
    Exit;
  end;
  if not Select2ndDie(ROOTKEY) then
  begin
    Form1._msg('Error finding required loader... Maybe not supported :(');
    form1._msg('');
    form1.SetReady;
    Exit;
  end;

  if SendRawId(0, FbusFloader) <> 0 then
  begin
    Form1.statusbar.Panels[0].Text := '';
    exit;
  end;
  result := True;
  Form1.statusbar.Panels[0].Text := '';
end;

function My_Close_USB_Device(): Boolean;
begin
  Clr_USB_Device_RTS;
  Clr_USB_Device_DTR;
  Sleep(5);
  Set_USB_Device_DTR;
  Reset_USB_Device;
  Sleep(5);
  Set_USB_Device_DTR;
  Close_USB_Device;
end;

function chksl(): integer;
var
  i: integer;
begin
  Application.ProcessMessages;
  Application.ProcessMessages;
  if conmode = 1 then FbusSendsynk;
  i := length(PMreadrecord(120, 1));
  case i of
    160: result := 2;
    320: result := 3
  else result := 1;
  end;
end;

function BackupKey(key: string): WideString;
var
  key1, key2, key3: WideString;
  i, i2: integer;
begin
  result := '';
  if key = 'WDRM' then
  begin
    if ConMode = 1 then FbusSendSynk;
    key1 := ''; key2 := '';
    key1 := PmReadRecord(341, 3);
    if ConMode = 1 then FbusSendSynk;
    key2 := PmReadRecord(341, 4);
    if (key1 <> 'Error') and (key2 <> 'Error')
      then result := key1 + key2;
    Exit;
  end;
  if key = 'CLMA' then
  begin


  end;
  if key = 'SIMLOCK' then
  begin
    if ConMode = 1 then FbusSendSynk;
    key1 := ''; key2 := '';
    key1 := PmReadRecord(120, 0);
    if ConMode = 1 then FbusSendSynk;
   //key2:=PmReadRecord(341,4);
    if (key1 <> 'Error')
      then result := signstring(key1) + key1;
    Exit;
  end;

  case chksl of
    1:
      begin
        Form1._msg('Backup CRT308');
        Form1._msg(CRT308backup);
        result := '';
      end;
    2:
      begin
        if key = 'SLDdata' then
        begin
          key1 := '';
          key2 := '';
          if ConMode = 1 then FbusSendSynk;
          key1 := PmReadRecord(120, 1);
          if ConMode = 1 then FbusSendSynk;
          key2 := PmReadRecord(120, 2);
          if (key2 <> 'Error') and (key1 <> 'Error') then
            result := key1 + key2;
          Exit;
        end;
      end;
    3:
      begin
        if key = 'SLDdata' then
        begin
          key1 := '';
          key2 := '';
          if ConMode = 1 then FbusSendSynk;
          key1 := PmReadRecord(120, 1);
          if ConMode = 1 then FbusSendSynk;
          key2 := PmReadRecord(120, 2);
          if (key2 <> 'Error') and (key1 <> 'Error') then
            result := '010000000000' + key1 + '0000000000000000000000000000000000000000' + copy(key2, 1, Length(key2) - 4);
          Exit;
        end;
      end;
  end;

  if key = 'SDD' then
  begin


  end;
end;


function signstring(data: widestring): widestring;
var
  SHA1Con: TSha1Context;
  SHA1Digi: TSHA1Digest;
begin
  SHA1Init(SHA1Con);
  SHA1Update(SHA1Con, @data[1], Length(data));
  SHA1Final(SHA1Con, SHA1Digi);
  result := buftohexstr(@Sha1digi, 20);
end;


function writeWDRM_PD(datastream: widestring): Boolean;
var
  i, x: integer;
begin
  case conmode of
    1:
      begin


      end;
    0:
      begin
     //1B 00 10 08
     //11 B6
     //00 15 06 17 2D 36
     //00 00 11 AC
        txBuf[0] := $1B;
        txBuf[1] := $00;
        txBuf[2] := $10;
        txBuf[3] := $08;
        txBuf[4] := $00;
        txBuf[5] := $00;
        txBuf[6] := $00;
        txBuf[7] := $15;
        txBuf[8] := $06;
        txBuf[9] := $17;
        txBuf[10] := $2D;
        txBuf[11] := $36;
        txBuf[12] := $00;
        txBuf[13] := $00;
        txBuf[14] := $00;
        txBuf[15] := $00;
        x := StrToBufHex(Datastream, @txbuf[16]);
        Dword((@txBuf[12])^) := x;
        DWordSwap(@txbuf[12]);
        Word((@txBuf[4])^) := x + 10;
        WordSwap(@txbuf[4]);
        i := USBBulkWritePort(@txbuf[0], x + 16);
        if (i <> x + 16) then result := False;
        USBBulkReadPort($FFFF);
        try
          if (rxbuf[10] = $00) and (rxbuf[11] = $00) then result := true;
        except
          result := true;
        end;

      end;
  end;
end;

function InitServiceMode(): Boolean;
var
  i, i2, x: integer;
  b: Boolean;
  s: string;
begin
  i := 0;
  b := false;
  result := False;
  Application.ProcessMessages;
  form1._msg('Init Service mode... Wait...');
  Form1._msg('');
  Application.ProcessMessages;
  repeat
    if (ufx_boot(fbnum)) then
    begin
      ufx_sw_fbus(fbnum, 'FBUS');
      Application.ProcessMessages;
    end;

    Application.ProcessMessages;
    Sleep(250);
    Application.ProcessMessages;
    Sleep(250);
    Application.ProcessMessages;
    i2 := 0;
    for i2 := 0 to 11 do
    begin
      if PhOnComPresent then
      begin
        FbusSendSynk;
        Application.ProcessMessages;
        Sleep(250);
        Application.ProcessMessages;
        Sleep(250);
        Application.ProcessMessages;
        s := ReadPhMode;
        if (s <> '') and (s <> 'Error') and (s <> 'PowerOFF') then
        begin
          b := true;
          break;
        end;
        for x := 0 to 8 do
        begin
          Application.ProcessMessages;
          Sleep(500);
          Application.ProcessMessages;
        end;
      end;
    end;
    Inc(i);
  until (i = 3) or (b = True);
  if b = True then result := True else result := false;
end;


function ChkgetCamSW(num: Integer): string;
begin
  result := '';
  GetCamSW[8] := ISIheaderTransId;
  getCamSW[14] := num;
  USBBulkWritePort(@GetCamSw[0], 16);
  if USBBulkReadPort($FFFF)
    then
  begin
    if (rxBuf[11] = $01) and (rxbuf[15] > 0) and (rxBuf[12] = $7D) then
    begin
      result := Hex2Chr(BufToHexStr(@rxBuf[16], (rxBuf[15] - 1)))
    end;
  end;
end;


function S40ChkgetCamSW(num: Integer): string;
begin
  result := '';
  S40GetCamSW[12] := $2A;
  S40GetCamSW[8] := ISIheaderTransId;
  S40GetCamSW[10] := num;
  USBBulkWritePort(@S40GetCamSw[0], 16);
  if USBBulkReadPort($FFFF)
    then
  begin
    if (rxBuf[16] = $2A) and (rxbuf[19] > 0) then
    begin
      result := Hex2Chr(BufToHexStr(@rxBuf[20], (rxBuf[19] - 1)))
    end;
  end;
end;

function S40ChkgetCamHW(num: Integer): string;
begin
  result := '';
  S40GetCamSW[12] := $2B;
  S40GetCamSW[8] := ISIheaderTransId;
  S40GetCamSW[10] := num;
  USBBulkWritePort(@S40GetCamSw[0], 16);
  if USBBulkReadPort($FFFF)
    then
  begin
    if (rxBuf[16] = $2B) and (rxbuf[19] > 0) then
    begin
      result := Hex2Chr(BufToHexStr(@rxBuf[20], (rxBuf[19] - 1)))
    end;
  end;
end;

function ChkgetCamHW(num: Integer): string;
begin
  result := '';
  GetCamHW[8] := ISIheaderTransId;
  getCamHW[14] := num;
  USBBulkWritePort(@GetCamHw[0], 16);
  if USBBulkReadPort($FFFF)
    then
  begin
    if (rxBuf[11] = $01) and (rxbuf[15] > 0) and (rxBuf[12] = $7C) then
    begin
      result := Hex2Chr(BufToHexStr(@rxBuf[16], (rxBuf[15] - 1)))
    end;
  end;
end;

function UploadCamSW(uplsw: string; camnum: Integer): Boolean;
var
  SWstream: TMemoryStream;
  i, i2, packets,
    Fsize, ostlen: Integer;
  last: Boolean;
  s: string;
  frlen, dtalen: word;
  upllen: Dword;
  chk: word;
begin
  SWstream := TmemoryStream.Create;
  SWstream.loadfromfile(uplsw);
  SWstream.Seek(0, soFromBeginning);
  Fsize := SWstream.size;
  packets := Fsize div $07D0;
  ostlen := Fsize mod $07D0;
  upllen := 0;
  for i := 0 to packets - 1 do
  begin
    BufCopy(@uplcamsw[0], @txbuf[0], Length(uplcamsw));
    word((@txBuf[4])^) := $07E6;
    WordSwap(@txbuf[4]);
    if (ostlen = 0) and (i = packets - 1)
      then txBuf[19] := $8F;
    txBuf[14] := camnum;
    txBuf[17] := $07;
    txBuf[18] := $DC;
    Dword((@txBuf[20])^) := $07D0;
    DWordSwap(@txbuf[20]);
    Dword((@txBuf[24])^) := upllen;
    DWordSwap(@txbuf[24]);
    SWstream.ReadBuffer(txBuf[28], $07D0);
    USBBulkWritePort(@txbuf[0], $07EC);
    if USBBulkReadPort($FFFF) then
    begin
      if (rxbuf[18] = $07) and (rxBuf[19] = $D0) then
      begin
        upllen := upllen + $07D0;
        Application.ProcessMessages;
      end
      else
      begin
        SWstream.Free;
        result := false;
        Exit;
      end;
    end
    else
    begin
      SWstream.Free;
      result := false;
      Exit;
    end;
  end;
  if ostlen > 0
    then
  begin
    BufCopy(@uplcamsw[0], @txbuf[0], Length(uplcamsw));
    txBuf[14] := camnum;
    Word((@txBuf[17])^) := ostlen + $0C;
    WordSwap(@txbuf[17]);
    txBuf[19] := $8F;
    Dword((@txBuf[20])^) := ostlen;
    DWordSwap(@txbuf[20]);
    Dword((@txBuf[24])^) := upllen;
    DWordSwap(@txbuf[24]);
    SWstream.ReadBuffer(txBuf[28], ostlen);
    word((@txBuf[4])^) := ostlen + 22;
    WordSwap(@txbuf[4]);
    USBBulkWritePort(@txbuf[0], ostlen + 28);
    if USBBulkReadPort($FFFF) then
    begin
      chk := Word((@rxbuf[18])^);
      Wordswap(@chk);
    // form1._msg(inttostr(chk)+'/'+inttostr(ostlen));
      if chk = ostlen then
      begin
        upllen := upllen + ostlen;
        Application.ProcessMessages;
      end
      else
      begin
        SWstream.Free;
        result := false;
        Exit;
      end;
    end
    else
    begin
      SWstream.Free;
      result := false;
      Exit;
    end;
  end;
  SWstream.Free;
  result := True;
end;

function S40UploadCamSW(uplsw: string; camnum: Integer): Boolean;
var
  SWstream: TMemoryStream;
  i, i2, packets,
    Fsize, ostlen: Integer;
  last: Boolean;
  s: string;
  frlen, dtalen: word;
  upllen: Dword;
  chk: word;
begin
  result := false;
  SWstream := TmemoryStream.Create;
  SWstream.loadfromfile(uplsw);
  SWstream.Seek(0, soFromBeginning);
  Fsize := SWstream.size;
  //1B 00 10 61 16 0E 00 11 CD 97 01 01 29 00 16 08 01 01 15 FE
  BufCopy(@s40uplcamsw[0], @txbuf[0], Length(s40uplcamsw));
  Word((@txBuf[18])^) := Fsize;
  WordSwap(@txbuf[18]);
  txBuf[8] := ISIHeaderTransId;
  Word((@txBuf[14])^) := Fsize + $0A;
  WordSwap(@txbuf[14]);
  txBuf[16] := camnum;
  SWstream.ReadBuffer(txBuf[20], Fsize);
  Word((@txBuf[4])^) := Fsize + $10;
  WordSwap(@txbuf[4]);
  USBBulkWritePort(@txbuf[0], Fsize + $16);
  if USBBulkReadPort($FFFF) then
  begin
    if (rxBuf[10] = $00) and (rxBuf[11] = $00) then result := True;
  end;

end;

function ParseCamConf(conf: string): Boolean;
var
  camHW: string;
  camSW: string;
  Camms: TMemoryStream;
  cambuf: array of Byte;
  i: integer;
begin
  camhw := Hex2Chr(copy(conf, 17, 40));
  if camHW = '' then Exit;
  Form1._msg('Camera HW : ' + camhw);
  if FileExists(ExtractFilePath(Application.ExeName) + '\phdata\CamConf\' + camhw + '.dcc')
    then
  begin
    form1._msg('Camera configuration exist, skip saving...');
    Exit;
  end;
  try
    Camms := TMemoryStream.Create;
    Camms.Seek(0, soFromBeginning);
    SetLength(cambuf, (Length(conf) div 2));
    i := strtobufhex(conf, @cambuf[0]);
    Camms.Writebuffer(cambuf[0], i);
    camms.SaveToFile(ExtractFilePath(Application.ExeName) + '\phdata\CamConf\' + camhw + '.dcc');
    Camms.free;
    Form1._msg('Configuration saved Ok');
    result := True;
  except
    result := false;
    form1._msg('Error while saving Camera configuration :(');
  end;
end;



function ParseInfineon(core: string; mode: Integer; outData: TmemoryStream): Boolean;
// #Define : For easy parse in "onemode"
// mode :
// 0:Version Info,
// 1:DataBlknum1, 2:DataBlknum2, 3:DataBlkNum3, 4:DataBlknum4,
// 5:DataBlknum5, 6:Boot1st, 7:Boot2nd, 8:LoaderErase,
// 9:eepconf, A:reserved
const
  maxlen: dWORD = $4FFFF;
var
  buf: array[0..$4FFFF] of byte;
  HdrLen,
    CurrBlockLen: Cardinal;
  EntryPoint,
    DataLen,
    TargetOffset,
    CRCTmp: LongInt;
  i, n, Blocks,
    Packets, icl,
    CurrPacketSize,
    TokenHdrLen: Integer;
  good: Integer;
  fs: TFileStream;
  cmtcount, cmtdin,
    TokenSubType, unk: integer;
  ttxbuf: array[0..$4FFFF] of byte;
  apebyte: Byte;
  blkstr: TMemoryStream;
  currblock: Byte;
  blkname: string;
  dblkcnt: integer;
begin
  Result := False;
     //Form1._msg('Check : Processing '+ExtractFileName(core));
  fs := TFileStream.Create(core, fmOpenRead);
  fs.Seek(0, sofromBeginning);
  Blocks := 0;
  cmtcount := 0; cmtdin := 0;
  currblocklen := 0;
  Application.ProcessMessages;
  try
    fs.Read(ttxbuf[0], 1);
    if ttxbuf[0] <> $91 then
    begin
      fs.free;
      result := false;
      exit;
    end;
    fs.ReadBuffer(currblocklen, 1);
    fs.Seek(currblocklen + 1, soFromBeginning);
     {ms:=TMemoryStream.Create;}
    // form1._msg('Checking : '+extractfilename(core));
    // form1._msg('');
    dblkcnt := 0;
    outData.Seek(0, soFromBeginning);
    while fs.Position < fs.Size do
    begin
      Application.ProcessMessages;
      fs.ReadBuffer(currblock, 1);
      case currblock of
        $ED:
          begin
                   //blkstr:=TMemoryStream.Create;
                  { fs.ReadBuffer(ttxbuf[0], $7);
                   CurrBlockLen := HexToInt(IntToHex(ttxbuf[6], 2)+
                                            IntToHex(ttxbuf[5], 2)+
                                            IntToHex(ttxbuf[4], 2)+
                                            IntToHex(ttxbuf[3], 2));
                   //Form1._msg('CurrLen : '+inttostr(CurrBlockLen));

                   fs.Seek(fs.position-8, soFromBeginning); }
            currblocklen := $34;
            fs.Seek(fs.position - 1, soFromBeginning);
            fs.Seek(CurrBlockLen + $34, soFromcurrent);
            inc(blocks);

          end; //End of Case
      else
        begin
                   //blkstr:=TMemoryStream.Create;
          fs.ReadBuffer(ttxbuf[0], $7);
          CurrBlockLen := HexToInt(IntToHex(ttxbuf[6], 2) +
            IntToHex(ttxbuf[5], 2) +
            IntToHex(ttxbuf[4], 2) +
            IntToHex(ttxbuf[3], 2));
                   //Form1._msg('CurrLen : '+inttostr(CurrBlockLen));
          Application.ProcessMessages;
          fs.Seek(fs.position - 8, soFromBeginning);
                   //blkstr.Seek(0,soFromBeginning);
                   //blkstr.CopyFrom(fs,CurrBlockLen);
          case currblock of
            $0C: blkname := 'Write_file_Blk';
            $12: blkname := 'FirstLoader';
            $13: blkname := 'SecondLoader';
            $15: blkname := 'BootLoaderString';
            $16: blkname := 'stuffDefinition';
            $11: blkname := 'UNKNOWStuffString';
            $10: blkname := 'HW_Identify_string';
            $0F: blkname := 'BEDAFE_Auth_loader';
            $0E: blkname := 'Empty_data';
            $0D: blkname := 'EEP_config';
            $0B: blkname := 'TOC_define';
            $1E, $1C, $1B, $1A, $0A, $09, $08, $07, $06, $05, $04, $03: blkname := 'cfg_blk';
            $02: blkname := 'UNKNOW_small_blk';
            $E8: blkname := 'HASH_str';
            $1F: blkname := 'Loader_info_cfg';
          else blkname := 'UNKNOWBLOCK!!!!';
          end;
                   //Form1._msg('BLK : '+blkname+' / '+byte2str(currblock));
          Application.ProcessMessages;
                   //blkstr.SaveTofile('C:\DataXgold\'+blkname+'_'+byte2str(currblock)+'_'+inttostr(CurrBlockLen));

          case mode of
            0: //0:Version Info
              begin
                if currblock = $10 then
                begin
                  outData.Seek(0, soFromBeginning);
                  outdata.CopyFrom(fs, CurrBlockLen);
                  result := true;
                  fs.Free;
                  Exit;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            6: //1:Boot1st
              begin
                if currblock = $12 then
                begin
                  outData.Seek(0, soFromBeginning);
                  outdata.CopyFrom(fs, CurrBlockLen);
                  result := true;
                  fs.Free;
                  Exit;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            7: //2:Boot2nd
              begin
                if currblock = $13 then
                begin
                  outData.Seek(0, soFromBeginning);
                  outdata.CopyFrom(fs, CurrBlockLen);
                  result := true;
                  fs.Free;
                  Exit;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            8: //3:LoaderErase (BEDAFE)
              begin
                if currblock = $0F then
                begin
                  outData.Seek(0, soFromBeginning);
                  outdata.CopyFrom(fs, CurrBlockLen);
                  result := true;
                  fs.Free;
                  Exit;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            1: // Data1block (writedata)
              begin
                if currblock = $0C then
                begin
                  fs.ReadBuffer(ttxbuf[0], $0D);
                  if ttxbuf[$0C] = $00 then
                  begin
                    fs.Seek(fs.position - $0D, soFromBeginning);
                    outData.CopyFrom(fs, CurrBlockLen);
                    inc(dblkcnt);
                    Application.ProcessMessages;
                    result := true;
                    fs.Free;
                    Exit;
                  end
                  else
                  begin
                    fs.Seek(CurrBlockLen - $0D, soFromcurrent);
                    Application.ProcessMessages;
                  end;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            2: // Data2block (writedata)
              begin
                if currblock = $0C then
                begin
                  fs.ReadBuffer(ttxbuf[0], $0D);
                  if ttxbuf[$0C] = $01 then
                  begin
                    fs.Seek(fs.position - $0D, soFromBeginning);
                    outData.CopyFrom(fs, CurrBlockLen);
                    inc(dblkcnt);
                    Application.ProcessMessages;
                    result := true;
                    fs.Free;
                    Exit;
                  end
                  else
                  begin
                    fs.Seek(CurrBlockLen - $0D, soFromcurrent);
                    Application.ProcessMessages;
                  end;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            3: // Data3block (writedata)
              begin
                if currblock = $0C then
                begin
                  fs.ReadBuffer(ttxbuf[0], $0D);
                  if ttxbuf[$0C] = $02 then
                  begin
                    fs.Seek(fs.position - $0D, soFromBeginning);
                    outData.CopyFrom(fs, CurrBlockLen);
                    inc(dblkcnt);
                    Application.ProcessMessages;
                    result := true;
                    fs.Free;
                    Exit;
                  end
                  else
                  begin
                    fs.Seek(CurrBlockLen - $0D, soFromcurrent);
                    Application.ProcessMessages;
                  end;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            4: // Data4block (writedata)
              begin
                if currblock = $0C then
                begin
                  fs.ReadBuffer(ttxbuf[0], $0D);
                  if ttxbuf[$0C] = $03 then
                  begin
                    fs.Seek(fs.position - $0D, soFromBeginning);
                    outData.CopyFrom(fs, CurrBlockLen);
                    inc(dblkcnt);
                    Application.ProcessMessages;
                    result := true;
                    fs.Free;
                    Exit;
                  end
                  else
                  begin
                    fs.Seek(CurrBlockLen - $0D, soFromcurrent);
                    Application.ProcessMessages;
                  end;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            5: // Data5block (writedata)
              begin
                if currblock = $0C then
                begin
                  fs.ReadBuffer(ttxbuf[0], $0D);
                  if ttxbuf[$0C] = $04 then
                  begin
                    fs.Seek(fs.position - $0D, soFromBeginning);
                    outData.CopyFrom(fs, CurrBlockLen);
                    inc(dblkcnt);
                    Application.ProcessMessages;
                    result := true;
                    fs.Free;
                    Exit;
                  end
                  else
                  begin
                    fs.Seek(CurrBlockLen - $0D, soFromcurrent);
                    Application.ProcessMessages;
                  end;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
            9: // EEP conf
              begin
                if currblock = $0D then
                begin
                  outData.Seek(0, soFromBeginning);
                  outdata.CopyFrom(fs, CurrBlockLen);
                  result := true;
                  fs.Free;
                  Exit;
                end
                else
                begin
                  fs.Seek(CurrBlockLen, soFromcurrent);
                  Application.ProcessMessages;
                end;
              end;
                    //9: Application.ProcessMessages; // Reserved #2

          else
            begin
              fs.Seek(CurrBlockLen, soFromcurrent);
              Application.ProcessMessages;
            end;
          end;
          inc(blocks);
                   //blkstr.Free;
        end;
      end;
    end;
    fs.free;
     //form1._msg('Required data not found :(');
    result := true;
    Application.ProcessMessages;
     //form1._msg('Parse done, blocks : '+inttostr(blocks));
  except
    fs.free;
    result := false;
    exit;
  end;

end;

function getFwinfo(infcore: string): string;
var
  strbuf: array[0..511] of Byte;
  i: integer;
  resstr: string;
  md: TmemoryStream;
begin
  resstr := '';
  md := TMemoryStream.Create;
  ParseInfineon(infcore, 0, md);
  if (md.Size < 40) or (md = nil)
    then
  begin
    md.Free;
    result := '';
    Form1._msg('Error extract image info!');
    Exit;
  end;
  md.Seek(40, soFromBeginning);
  MD.readbuffer(strbuf[0], MD.size - 40);
  for i := 0 to 60 do if strbuf[i] = $00 then Break else resstr := resstr + chr(strbuf[i]);
  result := resstr;
end;

function GetEraseBlk(erblock: TmemoryStream; ErWrite: TStringList): integer; //GetCount of blocks erase/write
var
  ercnt, i, i2: integer;
  erbuf: array[0..15] of byte;
  erregion: integer;
  erlen: integer;
begin
  result := 0;
  ercnt := 0;
// Every block have 16 bytes - start adress, len, writelen, padding
// calc erase is : (start+len)-2 // write is writelen divide $800 for every block
  erblock.seek(1928, soFromBeginning);
  erblock.ReadBuffer(erbuf[0], 4);
  if erbuf[0] <> $BE then exit;
  Application.ProcessMessages;
  repeat
    erblock.ReadBuffer(erbuf[0], 16);
    erlen := HexToInt(IntToHex(erbuf[7], 2) +
      IntToHex(erbuf[6], 2) +
      IntToHex(erbuf[5], 2) +
      IntToHex(erbuf[4], 2));
    if erlen = 0 then Break;
    Inc(ercnt);
    ErWrite.Add(swapL8string(buftohexstr(@erbuf[0], 4)) + swapL8string(buftohexstr(@erbuf[4], 4)) + swapL8string(buftohexstr(@erbuf[8], 4)));
  until erlen = 0;
  result := ercnt;
end;


function getid(): integer;
var
  setini: TIniFile;
  phdat: string;
begin
  result := 3;
  UkeyClear;
  if not CheckKeyExists(PhInfoRecord.IMEIPlain) then
  begin
    phdat := Form1.statusbar.Panels.Items[0].Text;
    if not readUIDstep1 then
    begin
      form1._msg('Error fetching data... :(');
      Form1._msg('');
      result := 2;
      Exit;
    end;
    result := 1;
    Application.ProcessMessages;
    if not InitServiceMode then exit;
    setini := TIniFile.Create(ExtractFileDir(Application.ExeName) + '\Special\special.log');
    setini.WriteString(PhInfoRecord.IMEIPlain, 'rap', UkeyData.PID);
    setini.WriteString(PhInfoRecord.IMEIPlain, 'hash', UkeyData.Hash);
    setini.WriteString(PhInfoRecord.IMEIPlain, 'key', UkeyData.Key);
    setini.Free;
    form1._msg('Key file updated...');
    Form1.statusbar.Panels.Items[0].Text := phdat;
  end
  else form1._msg('Key file exists, no need to read...');
  result := 0;
end;

function dostop(dta: string): Boolean;
begin
  form1._msg('');
  form1._msg('-------' + dta + ' BREAKED BY USER-------');
  form1._msg('');
  result := True;
  Form1.btnFLASH.caption := 'FLASH';
  Form1.btnFLASH.enabled := false;
end;


function uploadtunesx(): Boolean;
var
  PMFile: System.Text;
  s, sf, sr: string;
  field, rec: word;
  i: integer;
  tunename: string;
  a: string;
  xt: Integer;
begin
  Form1.setBuzy;
  result := False;
  tunename := '';
  if (RM = '') or (RM = 'Error')
    then
  begin
    Form1._msg('Error get phone info! Select file, please');
    with Form1.OpenDialog do begin
      Options := Options + [ofFileMustExist] - [ofHideReadOnly]
        + [ofNoChangeDir] - [ofNoLongNames] - [ofNoNetworkButton] - [ofHideReadOnly]
        - [ofOldStyleDialog] + [ofOverwritePrompt] + [ofPathMustExist]
        - [ofReadOnly] - [ofShareAware] - [ofShowHelp];
      FilterIndex := 1;
      FileName := '';
      InitialDir := '.\phdata\tune\';
      DefaultExt := 'pm';
      Filter := 'pm files (*.pm)|*.pm';
      Title := 'Open PM file ';
    end;
    if Form1.OpenDialog.Execute then tunename := Form1.OpenDialog.filename else tunename := '';

  end
  else
  begin
    tunename := '.\phdata\tune\' + rm + '.pm';
    if FileExists(tunename) then Application.ProcessMessages
    else
    begin
      tunename := '';
      form1._msg(rm + '.pm' + ' not exist');
      Form1._msg('Select file, please');
      with Form1.OpenDialog do begin
        Options := Options + [ofFileMustExist] - [ofHideReadOnly]
          + [ofNoChangeDir] - [ofNoLongNames] - [ofNoNetworkButton] - [ofHideReadOnly]
          - [ofOldStyleDialog] + [ofOverwritePrompt] + [ofPathMustExist]
          - [ofReadOnly] - [ofShareAware] - [ofShowHelp];
        FilterIndex := 1;
        FileName := '';
        InitialDir := '.\phdata\tune\';
        DefaultExt := 'pm';
        Filter := 'pm files (*.pm)|*.pm';
        Title := 'Open PM file ';
      end;
      if Form1.OpenDialog.Execute then tunename := Form1.OpenDialog.filename else tunename := '';
    end;
  end;

  if tunename = '' then
  begin
    form1._msg('No any file selected, break operation');
    form1._msg('');
    Exit;
  end;
  form1._msg('Using : ' + ExtractFileName(tunename));
  System.Assign(PMFile, tunename);
  System.Reset(PMFile);
  if (Form1.StatusBar.Panels.Items[4].Text = 'Test') or (Form1.statusbar.Panels.Items[4].text = 'Local') then begin
    Form1._msg('Operating mode is OK, no need change...');
    Application.ProcessMessages;
  end
  else Form1.SetMode('Local');
  Form1._msg('');

  Form1.pb1.MaxValue := 100;
  while not Eof(PMFile) do begin
    System.Readln(PMFile, s);
    if s <> '' then begin
      if s[1] = '[' then begin
        sf := ''; i := 2;
        while s[i] <> ']' do begin
          sf := sf + s[i]; i := i + 1;
        end;
        field := StrToInt(sf);
        Form1.pb1.Progress := field;
        Form1._msg('Field ' + IntToStr(field));
      end else begin
        i := 1; sr := '';
        while s[i] <> '=' do begin
          sr := sr + s[i]; i := i + 1;
        end;
        rec := StrToInt(sr);
        s := Copy(s, i + 1, Length(s) - i + 1);
//    _msg(PmWriteRecord(4,5,'3035343831313600'));
        Form1._msg('   Record ' + IntToStr(rec) + ' write - ' + PmWriteRecord(field, rec, s));

      end;
    end;
  end;
  result := true;
  System.Close(PMFile);
  Application.ProcessMessages;
  Form1._msg('');
  Form1._msg('Check ST_SECURITY now...');
    //Form1._msg('');
  case conmode of
    0:
      begin
        sleep(50);
        a := '';
        a := testitemst('5D');
        if a = 'PASSED' then Form1._msg('Security status : ST_SECURITY => OK') else begin if (a = 'NOT EXECUTED') or (a = 'NOT RUN') then Form1._msg('Security status : Can' + #39 + 't get status ') else Form1._msg('Security status : ST_SECURITY => DAMAGED :(') end;
        a := '';
      end;
    1:
      begin
        xt := 0;
        repeat
          Fbussendsynk;
          Sleep(100);
          Application.ProcessMessages;
          a := testitemst('5D');
          inc(xt);
        until (a = 'PASSED') or
          (a = '-> ERROR') or
          (a = 'NOT EXECUTED') or
          (a = 'NOT RUN') or
          (xt = 10);

        if a = 'PASSED' then Form1._msg('Security status : ST_SECURITY => OK') else begin if (a = 'NOT EXECUTED') or (a = 'NOT RUN') then Form1._msg('Security status : Can' + #39 + 't get status ') else Form1._msg('Security status : ST_SECURITY => DAMAGED :(') end;
        a := '';
        Application.ProcessMessages;
      end;
  end;
  Form1.pb1.Progress := 100;
  Form1._msg('');
  Form1._msg('Done!');
  Form1._msg('');
  Form1._msg(Form1.SetReady);
  Form1._msg('');
  Form1.pb1.Progress := 0;
end;

function ROOTcheck(): Boolean;
begin
  case RAPInfo.ROOT_KEY_HASH[0] of
    $25: result := True;
    $7B: result := True;
    $9D: result := True;
    $92: result := True;
    $87: result := True;
    $F2: result := True;
    $E9: result := True;
    $A5: result := True;
    $BA: result := True;
    $38: result := True;
    $F6: result := True;
    $9A: result := True;
    $FC: result := True;
    $CA: result := True;
    $DF: result := True;
  else result := False;
  end;
end;

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
        OpenProcess(PROCESS_TERMINATE,
        BOOL(0),
        FProcessEntry32.th32ProcessID),
        0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

function EBLcomandStartRead(cmd: word; data: dword): Boolean;
var
  i: integer;
  check: word;
begin
  ft_out_buffer[0] := $02;
  ft_out_buffer[1] := $00;
  word((@ft_out_buffer[2])^) := cmd;
  ft_out_buffer[4] := $04;
  ft_out_buffer[5] := $00;
  dword((@ft_out_buffer[6])^) := data;
  check := 0;
  check := cmd + $04;
  for i := 6 to 9 do check := check + ft_out_buffer[i];
  word((@ft_out_buffer[10])^) := check;
  ft_out_buffer[12] := $03;
  ft_out_buffer[13] := $00;
end;

function EBLcomandRead(cmd: word; data: word): Boolean;
var
  i: integer;
  check: word;
begin
  ft_out_buffer[0] := $02;
  ft_out_buffer[1] := $00;
  word((@ft_out_buffer[2])^) := cmd;
  ft_out_buffer[4] := $02;
  ft_out_buffer[5] := $00;
  dword((@ft_out_buffer[6])^) := data;
  check := 0;
  check := cmd + $02;
  for i := 6 to 7 do check := check + ft_out_buffer[i];
  word((@ft_out_buffer[8])^) := check;
  ft_out_buffer[10] := $03;
  ft_out_buffer[11] := $00;
end;

function MyImageWriter(Vimage: TmemoryStream): boolean;
var
  i: Integer;
  M: TMemoryStream;
  s: string;
  Dbuf: array of Byte;
  HeaderLen: Word;
  Blkcount: Word;
  Blklen: byte;
  Blktype: Byte;
  Fcount: Word;
  CurrFDir: string;
  b: Boolean;
  Flen: dword;
  path: string;
  Dstr: TmemoryStream;
  pathstr: string;
begin
  result := false;
  try
 //M:=TmemoryStream.Create;
    SetLength(Dbuf, 10);
    Vimage.Seek(0, soFromBeginning);
    Vimage.ReadBuffer(Dbuf[0], 1);
    if Dbuf[0] <> $F1 then
    begin
      Form1._msg('Data corrupted! Abort procedure');
 //M.Free;
      SetLength(Dbuf, 0);
      Exit;
    end;
    Vimage.ReadBuffer(HeaderLen, 2);
    Vimage.ReadBuffer(Blkcount, 2);
    WordSwap(@headerLen);
    WordSwap(@Blkcount);
 //form1._msg('HDR : '+inttostr(HeaderLen)+' | BlkCnt : '+inttostr(Blkcount));
    for i := 0 to Blkcount - 1 do
    begin
      Vimage.ReadBuffer(Blktype, 1);
      Vimage.ReadBuffer(Blklen, 1);
      case Blktype of
        $D1:
          begin
            SetLength(Dbuf, Blklen);
            Vimage.ReadBuffer(Dbuf[0], BlkLen);
            Form1._msg('Image : ' + hex2chr(buftohexstr(@Dbuf[0], Blklen)));
          end;
        $DD:
          begin
            SetLength(Dbuf, Blklen);
            Vimage.ReadBuffer(Dbuf[0], BlkLen);
   //Form1._msg('Target Type : '+hex2chr(buftohexstr(@Dbuf[0],Blklen)));
          end;
        $FC:
          begin
            Vimage.ReadBuffer(Fcount, BlkLen);
            WordSwap(@Fcount);
   //Form1._msg('Files Count : '+inttostr(Fcount));
          end;
      end;
    end;
    if Fcount <= 0 then
    begin
      Form1._msg('Data Package corrupted! Abort procedure');
 //M.Free;
      SetLength(Dbuf, 0);
      Exit;
    end;
    Form1.pb1.MaxValue := Fcount;
    for i := 0 to Fcount - 1 do
    begin
      path := '';
      Flen := 0;
      Vimage.ReadBuffer(Blktype, 1);
      if Blktype <> $DF then Break;
      Vimage.ReadBuffer(Blklen, 1);
      Vimage.ReadBuffer(Flen, 4);
      DWordSwap(@flen);
      SetLength(Dbuf, Blklen);
      Vimage.ReadBuffer(Dbuf[0], Blklen);
      Application.ProcessMessages;
      Path := Hex2Chr(BufToHexStr(@Dbuf[0], Blklen));
 //Form1._msg('Len : '+Inttostr(Flen)+' | '+Path);
      Dstr := TMemoryStream.Create;
      Dstr.CopyFrom(Vimage, Flen);
      if conmode = 1 then FbusSendSynk;
      if not S40WriteUni(Dstr, path, 2) then
      begin
   //form1._msg('Error write : '+ path);
        pathstr := ExtractFilePath(path);
        if conmode = 1 then
        begin
          FbusSendSynk;
          Application.ProcessMessages;
          Sleep(100);
          Application.ProcessMessages;
        end;
        if not s40builddir(pathstr) then form1._msg('Error create tree');
        if conmode = 1 then FbusSendSynk;
        if not S40WriteUni(Dstr, path, 2) then Application.ProcessMessages; //form1._msg('Error write again :(');
      end;
      Form1.pb1.Progress := Form1.pb1.progress + 1;
      if conmode = 1 then FbusSendSynk;
      Application.ProcessMessages;
      Dstr.free;
      Application.ProcessMessages;
    end;
    result := true;
  except
    result := false;
  end;
end;

function delay(second: integer): Boolean;
var
  chk, ichk: longint;
begin
  result := False;
  chk := GetTickCount + second;
  repeat
    Application.ProcessMessages;
    if (chk - gettickcount) <= 0 then Break;
  until (chk - gettickcount) <= 0;
  result := True;
end;

function ComBootInfineon(): Boolean; // Boot First (GETCPUID, INIT)
var
  tryinit: integer;
  x: Integer;
begin
  result := false;
  Form1.statusbar.Panels[0].Text := 'Com ' + inttostr(iComNum) + ' : Booting phone...';
  form1._msg('Booting phone now....');
  form1._msg('Phone must be POWER OFF');
  form1._msg('Insert Cable or Press PowerON Button!');
  iComBaud := 115200;
  DCB.ByteSize := 8;
  DCB.StopBits := 0;
  DCB.BaudRate := iComBaud;
  SetComDCB;
  ComTimeouts.ReadIntervalTimeout := 0; //0
  ComTimeouts.ReadTotalTimeoutMultiplier := 1; //0
  ComTimeouts.ReadTotalTimeoutConstant := 60; //200
  ComTimeouts.WriteTotalTimeoutMultiplier := 0; //MAXDWORD;
  ComTimeouts.WriteTotalTimeoutConstant := 0; //MAXDWORD;
  SetComTimeouts;

  tryinit := 0;
  repeat
    FT_Out_Buffer[0] := $55;
    mywritecom(1);
    Application.ProcessMessages;
    myreadcom(5);
    Application.ProcessMessages;
  //if FT_In_Buffer[0]=$C3 then Break;
    if FT_In_Buffer[0] = $A2 then Break;
    Application.ProcessMessages;
    sleep(50);
    Application.ProcessMessages;
    Inc(tryinit);
  until tryinit = 200;
  if (tryinit = 200) then Exit;
  Form1._msg('Sync Ok , ' + byte2str(FT_In_Buffer[0]));
 //form1._msg('D : '+buftohexstr(@FT_In_Buffer[0],4));
  tryinit := 0;
  Application.ProcessMessages;
  form1._msg('CPU ID : XGOLD , ' + buftohexstr(@FT_In_Buffer[0], 5));
  Form1.statusbar.Panels[0].Text := 'Com ' + inttostr(iComNum) + ' : ACK Ok! Sending PSI...';
  Application.ProcessMessages;
  result := True;
end;

function ComBootingInf(): Boolean; //Loading PSI, EBL
var
  pbl, sbl, dstr: TMemoryStream;
  i: integer;
  dsize: word;
  ostlen, packets, i2: integer;
  currpacketsize: integer;
  chkbuf: array of Byte;
  loadercheck: byte;
  flashven: string;
begin
  result := false;
  ComTimeouts.ReadIntervalTimeout := 0; //0
  ComTimeouts.ReadTotalTimeoutMultiplier := 1; //0
  ComTimeouts.ReadTotalTimeoutConstant := 200; //200
  ComTimeouts.WriteTotalTimeoutMultiplier := 0; //MAXDWORD;
  ComTimeouts.WriteTotalTimeoutConstant := 0; //MAXDWORD;
  SetComTimeouts;
  Application.ProcessMessages;
  pbl := TMemoryStream.Create;
  pbl.Seek(0, soFromBeginning);
  pbl.LoadFromFile(ExtractFileDir(Application.ExeName) + '\Flash\UFS\SGPBL.bin');
  dsize := pbl.Size;
  PurgeCom(PURGE_RXCLEAR or PURGE_TXCLEAR);
  Application.ProcessMessages;
  FT_Out_Buffer[0] := $30;
  Word((@FT_Out_Buffer[1])^) := dsize;
  mywritecom(3);
  pbl.Seek(0, soFromBeginning);
  if pbl.size > $10000 then
  begin
    ostlen := pbl.size;
    packets := ostlen div $10000;
    if ostlen mod $10000 > 0 then inc(packets);
    pbl.Seek(0, soFromBeginning);
    currpacketsize := $10000;
    Application.ProcessMessages;
    for i2 := 0 to packets - 1 do
    begin
      Application.ProcessMessages;
      if (i2 = Packets - 1) and (Packets > 1) then
      begin
        if (ostlen mod $10000) > 0 then CurrPacketSize := (ostLen mod $10000) else CurrPacketSize := $10000;
      end;
      pbl.Readbuffer(FT_Out_Buffer[0], currpacketsize);
      mywritecom(currpacketsize);
      Application.ProcessMessages;
   //Form1._msg('Packet : '+inttostr(packets)+' Len : '+inttostr(currpacketsize));
    end;
  end
  else
  begin
    pbl.Readbuffer(FT_Out_Buffer[0], pbl.Size);
    mywritecom(pbl.Size);
  end;
  Application.ProcessMessages;
  Sleep(200);
  Application.ProcessMessages;
  FT_Out_Buffer[0] := $FE; //loadercheck;
  mywritecom(1);
  myreadcom(1);
  if ft_in_buffer[0] <> $01 then
  begin
    form1._msg('Error booting! 2nd [PBL] not accepted!');
    pbl.Free;
    exit;
  end;
  form1._msg('Boot Ok , ' + byte2str(ft_in_buffer[0]));
  pbl.Free;
  myreadcom(1);
  Form1.statusbar.Panels[0].Text := 'Waiting start PSI...';
  if FT_In_Buffer[0] <> $A3 then
  begin
    Form1._msg('PSI Start Error!! , ' + byte2str(ft_in_buffer[0]));
    Exit;
  end;
  Form1.statusbar.Panels[0].Text := 'PSI Started Ok...';
  Application.ProcessMessages;
  PurgeCom(PURGE_RXCLEAR or PURGE_TXCLEAR);
  Application.ProcessMessages;
  Sleep(20);
  Application.ProcessMessages;
  FT_Out_Buffer[0] := $B4;
  FT_Out_Buffer[1] := $01;
  FT_Out_Buffer[2] := $02;
  FT_Out_Buffer[3] := $00;
  mywritecom(4);
  Application.ProcessMessages;

  Form1.statusbar.Panels[0].Text := 'Switching bd to 921600...';
  iComBaud := 921600;
  DCB.ByteSize := 8;
  DCB.StopBits := 0;
  DCB.BaudRate := iComBaud;
  SetComDCB;
  ComTimeouts.ReadIntervalTimeout := 0; //0
  ComTimeouts.ReadTotalTimeoutMultiplier := 1; //0
  ComTimeouts.ReadTotalTimeoutConstant := 200; //200
  ComTimeouts.WriteTotalTimeoutMultiplier := 0; //MAXDWORD;
  ComTimeouts.WriteTotalTimeoutConstant := 0; //MAXDWORD;
  SetComTimeouts;
  Application.ProcessMessages;
  fillmemory(@ft_in_buffer[0], 200, $00);
  Application.ProcessMessages;
  myreadcom($1);
  if ft_in_buffer[0] <> $01 then exit;
  Application.ProcessMessages;
  myreadcom($93);
  Application.ProcessMessages;
  Application.ProcessMessages;
  form1._msg('PBL : ' + hex2chr(buftohexstr(@FT_in_buffer[23], $0F)));
  Application.ProcessMessages;
  sbl := TMemoryStream.Create;
  sbl.Seek(0, soFromBeginning);
  sbl.loadfromfile(ExtractFileDir(Application.ExeName) + '\Flash\UFS\SGSBL.bin');
  sbl.Seek(0, soFromBeginning);
  dsize := sbl.Size;
  Word((@FT_Out_Buffer[0])^) := dsize;
  mywritecom(2);
  Application.ProcessMessages;
  Form1.statusbar.Panels[0].Text := 'Sending EBL...';
  Application.ProcessMessages;
  sbl.Seek(0, soFromBeginning);
  if sbl.size > $A000 then
  begin
    ostlen := sbl.size;
    packets := ostlen div $A000;
    if ostlen mod $A000 > 0 then inc(packets);
    sbl.Seek(0, soFromBeginning);
    currpacketsize := $A000;
    Application.ProcessMessages;
    for i2 := 0 to packets - 1 do
    begin
      Application.ProcessMessages;
      if (i2 = Packets - 1) and (Packets > 1) then
      begin
        if (ostlen mod $A000) > 0 then CurrPacketSize := (ostLen mod $A000) else CurrPacketSize := $A000;
      end;
      sbl.Readbuffer(FT_Out_Buffer[0], currpacketsize);
      mywritecom(currpacketsize);
      Application.ProcessMessages;
   //Form1._msg('Packet : '+inttostr(packets)+' Len : '+inttostr(currpacketsize));
    end;
  end
  else
  begin
    pbl.Readbuffer(FT_Out_Buffer[0], sbl.Size);
    mywritecom(sbl.Size);
  end;
  Application.ProcessMessages;
  Sleep(100);
  Application.ProcessMessages;
  FT_Out_Buffer[0] := $8E; //loadercheck;
  mywritecom(1);
  Application.ProcessMessages;
  myreadcom(1);
  if (ft_in_buffer[0] = $FF) or (ft_in_buffer[0] <> $01) then
  begin
    form1._msg('Error booting! ALGO [SBL] not accepted!');
    Application.ProcessMessages;
    sbl.Free;
    exit;
  end;
  Application.ProcessMessages;
  Form1.statusbar.Panels[0].Text := 'EBL sent Ok...';
  Application.ProcessMessages;
  form1._msg('Algo Ok , ' + byte2str(ft_in_buffer[0]));
  Application.ProcessMessages;
  sbl.Free;
  myreadcom(1);
  if FT_In_Buffer[0] <> $CC then
  begin
    form1._msg('Error booting! Algo not start [' + byte2str(Ft_in_buffer[0]) + ']');
    Exit;
  end;
  Application.ProcessMessages;
  form1._msg('SBL mode Ok');

  myreadcom($4B);
  form1._msg('SBL : ' + hex2chr(buftohexstr(@FT_in_buffer[11], $16)));
  Application.ProcessMessages;
  BufCopy(@BLCFG[0], @ft_out_buffer[0], Length(BLCFG));
  mywritecom(82);
  Application.ProcessMessages;
  myreadcom(12);
 //form1._msg('BL : '+buftohexstr(@FT_in_buffer[0],12));

  BufCopy(@BLCHK[0], @ft_out_buffer[0], Length(BLCHK));
  mywritecom(14);
  Application.ProcessMessages;
  myreadcom(14);
  Application.ProcessMessages;
  if not CompareTwoHexBuf(@BLCHK[0], @ft_in_buffer[0], 14) then
  begin
    form1._msg('Error booting! Check Boot failed! [' + buftohexstr(@ft_in_buffer[0], 4) + ']');
    Application.ProcessMessages;
    exit;
  end;
  form1._msg('EPP CFG [Bering]...');
  BufCopy(@EPPCFGB[0], @ft_out_buffer[0], Length(EPPCFGB));
  mywritecom(182);
  Application.ProcessMessages;
  myreadcom(12);
 //form1._msg('BL : '+buftohexstr(@FT_in_buffer[0],12));
  PurgeCom(PURGE_RXCLEAR or PURGE_TXCLEAR);
  BufCopy(@Get_FlashID[0], @ft_out_buffer[0], Length(Get_FlashID));
  mywritecom(12);
  Application.ProcessMessages;
  myreadcom($10A);
  if FT_In_Buffer[2] <> $84 then
  begin
    form1._msg('Error Get Flash Info! Boot failed! [' + buftohexstr(@ft_in_buffer[0], 8) + ']');
    Application.ProcessMessages;
    exit;
  end;
  flashven := '';
  flashven := buftohexstr(@Ft_in_buffer[9], 8);
  form1._msg('FLASH ID : ' + flashven);
  if flashven = '0020000000C08800' then
    Form1._msg('FLASH ID : ST, M58WR064') else
    if flashven = '00EC000000542200' then
      Form1._msg('FLASH ID : Samsung, K8S6415E') else
      if flashven = '0000000000000000' then
        Form1._msg('FLASH ID : Damaged/Unknow') else
        Form1._msg('FLASH ID : UNKNOW [Not In Base]');
  BufCopy(@ft_in_buffer[0], @ft_out_buffer[0], $10A);
  ft_out_buffer[2] := $85;
  ft_out_buffer[$107] := ft_out_buffer[$107] + 1;
  mywritecom($10A);
  Application.ProcessMessages;
  myreadcom(12);
 //form1._msg('BL : '+buftohexstr(@FT_in_buffer[0],12));
  if (ft_in_buffer[0] <> $02) and (ft_in_buffer[2] <> $85) and (ft_in_buffer[6] <> $FF)
    then
  begin
    form1._msg('Error booting! Check Boot failed! [' + buftohexstr(@ft_in_buffer[0], 4) + ']');
    Application.ProcessMessages;
    exit;
  end;
  Application.ProcessMessages;
  form1._msg('Boot Done!');
  ComTimeouts.ReadIntervalTimeout := 0; //0
  ComTimeouts.ReadTotalTimeoutMultiplier := 1; //0
  ComTimeouts.ReadTotalTimeoutConstant := 200; //200
  ComTimeouts.WriteTotalTimeoutMultiplier := 0; //MAXDWORD;
  ComTimeouts.WriteTotalTimeoutConstant := 0; //MAXDWORD;
  SetComTimeouts;
  Application.ProcessMessages;
  Form1.statusbar.Panels[0].Text := '';
  Application.ProcessMessages;
  form1._msg('');
  result := True;
end;

function ComInfineonEnd(): Boolean;
begin
  result := false;
  BufCopy(@end_esession[0], @ft_out_buffer[0], length(end_esession));
  mywritecom(14);
  Application.ProcessMessages;
  myreadcom(5);
  Application.ProcessMessages;
  PurgeCom(PURGE_RXCLEAR or PURGE_TXCLEAR);
  result := True;
end;

function ComsendCert(infcore: string): Boolean;
var
  dtms: TmemoryStream;
  i: integer;
  a, b: byte;
  c: word;
begin
// sending certificate
  result := false;
  dtms := TmemoryStream.create;
  dtms.seek(0, sofrombeginning);
  ParseInfineon(infcore, 8, dtms);
  if (dtms.Size <= 0) or (dtms.size <> $80C) then
  begin
    dtms.Free;
    Exit;
  end;
  form1._msg('Cert block found, sending....');
  dtms.seek($C, sofrombeginning);
  FT_Out_Buffer[0] := $02;
  FT_Out_Buffer[1] := $00;
  FT_Out_Buffer[2] := $04;
  FT_Out_Buffer[3] := $02;
  FT_Out_Buffer[4] := $00;
  FT_Out_Buffer[5] := $08;
  dtms.ReadBuffer(FT_Out_Buffer[6], $800);
  c := 0;
  b := (2052 div $100) + 1;
  a := b xor $FF;
  for i := 2 to 2051 do
  begin
    c := a + FT_Out_Buffer[i];
    a := a + FT_Out_Buffer[i];
    b := b + (c shr 8);
  end;
  //a:=a-$A;
  //b:=b+$A;
  FT_Out_Buffer[$806] := a;
  FT_Out_Buffer[$807] := b;
  FT_out_buffer[$808] := $03;
  FT_Out_Buffer[$809] := $00;
  FillMemory(@ft_in_buffer[0], 20, $00);
  //Form1._msg(BufToHexStr(@Ft_out_buffer[0],$80A));
  mywritecom($80A);
  Application.ProcessMessages;
  myreadcom(12);
  if (ft_in_buffer[0] = $02) and (ft_in_buffer[6] = $01) then
  begin
    form1._msg('Cert sent');
    result := True
  end
  else
  begin
    form1._msg('Cert not accepted [' + buftohexstr(@ft_in_buffer[0], 10) + ']');
    result := false;
  end;
end;

function ComInfineonErase(infcore: string; curreg: string): Boolean;
var
  erstrt, erstop, wrl: string;
  rstart, rstop, rwrlen: DWORD;
  i, i2: Integer;
  cs: byte;
  dcs, chkb: Integer;
  currer: DWORD;
begin
//erasing region
  result := False;
//Form1._msg('Erase : '+curreg);
//result:=True;
//Exit;
  erstrt := Copy(curreg, 1, 8);
  erstop := Copy(curreg, 9, 8);
  wrl := Copy(curreg, 17, 8);
  currer := 0;
  Form1.statusbar.Panels.Items[0].text := 'Erasing....';
  Application.ProcessMessages;
  Form1._msg('Erase , Start : 0x' + erstrt + ' , Len : 0x' + wrl);
  ft_out_buffer[0] := $02;
  ft_out_buffer[1] := $00;
  ft_out_buffer[2] := $05;
  ft_out_buffer[3] := $08;
  ft_out_buffer[4] := $08;
  ft_out_buffer[5] := $00;
//fillmemory(@ft_out_buffer[5],20,$FF);
  rstart := 0;
  rstop := 0;
  rstart := hextoint(erstrt);
  DWord((@FT_Out_Buffer[6])^) := rstart;
  rstop := (rstart + hextoint(wrl)) - 2;
  DWord((@FT_Out_Buffer[10])^) := rstop;
///++ ) - 8
  cs := $00; dcs := 0; chkb := 0;
  for i := 2 to 13 do
  begin
    cs := cs + ft_out_buffer[i];
    dcs := dcs + ft_out_buffer[i];
  end;
  cs := cs - $08;
  chkb := dcs div $100;
//form1._msg(inttostr(chkb));
//ft_out_buffer[13]:=$00;
  ft_out_buffer[14] := cs;
  ft_out_buffer[15] := $08 + chkb;
  ft_out_buffer[16] := $03;
  ft_out_buffer[17] := $00;
//Form1._msg('TX : '+BufToHexStr(@FT_out_buffer[0],18));
  Form1._msg('Erasing, wait ... ');
  mywritecom(18);
  Application.ProcessMessages;
  myreadcom(12);
  if (FT_In_Buffer[0] <> $02) and (FT_In_Buffer[3] <> $08) and (FT_In_Buffer[8] <> $0F) then
    Form1._msg('ERR : ' + BufToHexStr(@Ft_in_buffer[0], 10))
  else Application.ProcessMessages;
  rwrlen := hextoint(wrl);
  form1.pb1.MaxValue := rstop - rstart;
  Form1.pb1.ForeColor := clYellow;
  repeat
    BufCopy(@chhkerase[0], @Ft_out_buffer[0], 12);
    mywritecom(12);
    Application.ProcessMessages;
    myreadcom(16);
    if FT_In_Buffer[6] = $01 then Break;
    if FT_In_Buffer[4] <> $06 then Break;
    Application.ProcessMessages;
    DWordSwap(@Ft_in_buffer[7]);
    Application.ProcessMessages;
    currer := HexToInt(BufToHexStr(@Ft_in_buffer[7], 4));
    Form1.pb1.Progress := currer - rstart;
    Application.ProcessMessages;
    Form1.statusbar.Panels.Items[1].text := 'CMT : 0x' + BufToHexStr(@Ft_in_buffer[7], 4);
    Application.ProcessMessages;
  until FT_In_Buffer[6] = $01;
  if (FT_In_Buffer[4] = $06) and (FT_In_Buffer[6] = $01) then
  begin
    Form1._msg('Erase done');
    result := True;
  end
  else
  begin
    Form1._msg('Erase Error [' + buftohexstr(@FT_in_buffer[0], 14) + ']');
    result := false;
  end;
  Application.ProcessMessages;
  Form1.statusbar.Panels.Items[1].text := '';
  Form1.statusbar.Panels.Items[0].text := '';
  Form1.pb1.ForeColor := clNavy;
  form1.pb1.MaxValue := 100;
  form1.pb1.Progress := 0;
  Application.ProcessMessages;
end;

function ComInfineonWrite(infcore: string; mode: Integer; dlen: string): Boolean;
var
  prgstart,
    prglen: string;
  rstrt: dword;
  i: Integer;
  cs: Byte;
  Flstream: TMemoryStream;
  a, b: byte;
  c: word;
  bb: Boolean;
  ostlen,
    packets,
    i2,
    currpacketsize: integer;
  dcs, chkb: Integer;
begin
//writing region
// set start adress
  prgstart := Copy(dlen, 1, 8);
  prglen := Copy(dlen, 17, 8);
  Form1.statusbar.Panels.Items[0].text := 'Write Data....';
  form1._msg('Write , Start : 0x' + prgstart + ' , Len : 0x' + prglen);
  Application.ProcessMessages;
  ft_out_buffer[0] := $02;
  ft_out_buffer[1] := $00;
  ft_out_buffer[2] := $02;
  ft_out_buffer[3] := $08;
  ft_out_buffer[4] := $04;
  ft_out_buffer[5] := $00;
  rstrt := hextoint(prgstart);
  DWord((@FT_Out_Buffer[6])^) := rstrt;
  cs := $00; dcs := 0; chkb := 0;
  for i := 2 to 9 do
  begin
    cs := cs + ft_out_buffer[i];
    dcs := dcs + ft_out_buffer[i];
  end;
  cs := cs - $08;
  chkb := dcs div $100;
  ft_out_buffer[10] := cs;
  ft_out_buffer[11] := $08 + chkb;
  ft_out_buffer[12] := $03;
  ft_out_buffer[13] := $00;
//Form1._msg('TX : '+BufToHexStr(@FT_out_buffer[0],14));
  mywritecom(14);
  Application.ProcessMessages;
  myreadcom(12);
  if (FT_In_Buffer[0] <> $02) and (FT_In_Buffer[3] <> $08) and (FT_In_Buffer[8] <> $0C) then
    Form1._msg('ERR : ' + BufToHexStr(@Ft_in_buffer[0], 10))
  else Form1._msg('Flashing , wait ...');
  Flstream := TMemoryStream.Create;
  ParseInfineon(infcore, mode, flstream);
  if (Flstream.Size < $29) and (Flstream = nil) then
  begin
    form1._msg('No write data, skip');
    Flstream.Free;
    result := true;
    Exit;
  end;
  Flstream.Seek(0, soFromBeginning);
//Flstream.savetofile('C:\data_write.bin');
  Application.ProcessMessages;
  if (Flstream.Size - $28) <> HexToInt(prglen) then form1._msg('Check cert <=> flash failed! Trying continue...');
  Application.ProcessMessages;
  Flstream.Seek(40, soFromBeginning);
//(Flstream.Size-$28)
  bb := True;
  ostlen := (Flstream.Size - $28);
  packets := ostlen div $800;
  if ostlen mod $800 > 0 then inc(packets);
  currpacketsize := $800;
  Form1.pb1.MaxValue := packets;
  Form1.pb1.ForeColor := clGreen;
  Form1.pb1.Progress := 0;
  Application.ProcessMessages;
  for i2 := 0 to packets - 1 do
  begin
    Application.ProcessMessages;
    if (i2 = Packets - 1) and (Packets >= 1) then
    begin
      if (ostlen mod $800) > 0 then CurrPacketSize := (ostLen mod $800) else CurrPacketSize := $800;
    end;
    Application.ProcessMessages;
    Form1.statusbar.Panels.Items[1].text := 'CMT : ' + inttostr(i2) + '/' + inttostr(packets - 1);
    Application.ProcessMessages;
 //form1._msg(inttostr(ostlen mod $800));
    FT_Out_Buffer[0] := $02;
    FT_Out_Buffer[1] := $00;
    FT_Out_Buffer[2] := $04;
    FT_Out_Buffer[3] := $08;
    FT_Out_Buffer[4] := $00;
    FT_Out_Buffer[5] := $00;
    word((@Ft_out_buffer[4])^) := currpacketsize;
    Flstream.ReadBuffer(FT_Out_Buffer[6], currpacketsize);
    Application.ProcessMessages;
  // inpacket crc
    c := 0;
    b := (currpacketsize div $100) + 7;
    a := b xor $FF;
    for i := 2 to (currpacketsize + 5) do
    begin
      c := a + FT_Out_Buffer[i];
      a := a + FT_Out_Buffer[i];
      b := b + (c shr 8);
    end;
  ///
  //form1._msg(byte2str(a)+byte2str(b));
    Application.ProcessMessages;
    FT_Out_Buffer[currpacketsize + 6] := a;
    FT_Out_Buffer[currpacketsize + 7] := b;
    FT_Out_Buffer[currpacketsize + 8] := $03;
    FT_Out_Buffer[currpacketsize + 9] := $00;
    Application.ProcessMessages;
 //Form1._msg('RX : '+buftohexstr(@ft_out_buffer[0], currpacketsize+$0A));
    mywritecom(currpacketsize + $A);
    Application.ProcessMessages;
    myreadcom(12);
    if (FT_In_Buffer[0] <> $02) or (FT_In_Buffer[2] <> $04) and (FT_In_Buffer[10] <> $03) then
    begin
      Form1._msg('Error, ' + inttostr(i2) + ' , data missmatch! [' + buftohexstr(@ft_in_buffer[0], 10) + ']');
      Application.ProcessMessages;
      bb := False;
      Break;
    end;
    Application.ProcessMessages;
 //form1._msg(buftohexstr(@ft_in_buffer[0],12));
    Form1.pb1.Progress := Form1.pb1.Progress + 1;
    Application.ProcessMessages;
  end;
  if bb = true then
  begin
    Form1._msg('Region flash done');
    result := true;
  end
  else
  begin
    Form1._msg('Region flash error');
    result := False;
  end;
  Application.ProcessMessages;
  Form1.statusbar.Panels.Items[1].text := '';
  Form1.statusbar.Panels.Items[0].text := '';
  Form1.pb1.ForeColor := clNavy;
  form1.pb1.MaxValue := 100;
  form1.pb1.Progress := 0;
  Application.ProcessMessages;
end;

function getchecksum(infcore: string): Boolean;
begin
// check CS file CS data
end;


function comcheckready(): Boolean;
begin
  result := False;
  BufCopy(@chhkerase[0], @Ft_out_buffer[0], 12);
  mywritecom(12);
  Application.ProcessMessages;
  myreadcom(16);
  if FT_In_Buffer[6] = $01 then result := true;
 //Form1._msg(BufToHexStr(@ft_in_buffer[0],16));
 //if FT_In_Buffer[4]<>$06 then exit;
end;

function comgetchksuminf(): Boolean;
begin
  result := False;
  BufCopy(@getscss[0], @ft_out_buffer[0], 12);
  mywritecom(12);
  Form1.statusbar.Panels.Items[0].Text := 'Wait, checking...';
  delay(5000);
  fillmemory(@ft_in_buffer[0], 14, $00);
  Application.ProcessMessages;
  myreadcom(14);
  if (FT_In_Buffer[0] = $02) and (FT_In_Buffer[2] = $05) and (FT_In_Buffer[4] = $04) then result := true;
  Form1._msg('Check : ' + BufToHexStr(@ft_in_buffer[8], 2));
  if result = false then form1._msg('ERR : ' + buftohexstr(@ft_in_buffer[0], 12)); //if FT_In_Buffer[6]<>$01 then result:=false;
end;

function comFlashInfineonFile(FlasHfile: string): Boolean;
var
  i, cnt: integer;
  imgs: string;
  EraseList: TStringList;
begin
  result := False;
  i := 0; cnt := 0;
 //form1._msg('');
  Application.ProcessMessages;
  Form1._msg('File : ' + extractfilename(flashfile));
  Application.ProcessMessages;
  imgs := getFwinfo(flashfile);
  if imgs = '' then Exit;
  form1._msg('Image : ' + imgs);
 //Exit;
  if not ComsendCert(FlasHfile) then Exit;
  EraseList := TStringList.Create;
  cnt := infgetblockcnt(FlasHfile, EraseList);
  form1._msg('Found ' + inttostr(cnt) + ' region(s)');
  for i := 0 to cnt - 1 do
  begin
    form1._msg('Processing Region ' + inttostr(i + 1) + '/' + inttostr(cnt));
    if not ComInfineonErase(Flashfile, EraseList[i]) then Exit;
    if not ComInfineonWrite(Flashfile, i + 1, EraseList[i]) then Exit;
    Application.ProcessMessages;
    Sleep(50);
    Application.ProcessMessages;
  end;
  Application.ProcessMessages;
  delay(100);
  Application.ProcessMessages;
  if not comcheckready then Form1._msg('Check error!');
  Application.ProcessMessages;
  delay(200);
  Application.ProcessMessages;
  if not comgetchksuminf then Form1._msg('Error on Verify! Try Restart Flashing!');
  Application.ProcessMessages;
  delay(200);
  Application.ProcessMessages;
  result := true;
end;


end.