unit UnitAndrey;

interface
uses
  Windows, SysUtils, UsbMain, HexUtils, UnitMisc, Controls, Classes, ComPort,
   FbusMain, Fboots, PSAPI, pduconv, WinInet, D2XXUnit, SHA1, IniFiles, UnitUfs;

function ReadPhoneInfo():boolean;
function ReadPhMode():string;
function SetPhMode(mode:string):string;
function SetCheckPhModeStr(mode:string):string;
function SetCheckPhModeInt(imode:integer):string;
function PmGetRecCou(Field:word):integer;
function PmGetRecLen(Field:word;Rec:word):dword;
function PmReadRecord(Field:word;Rec:word):string;
function PmReadRecordWithOutCheck(Field:word;Rec:word;Len:dword):string;
procedure NokiaTRCnv (Buf:pointer) ;
procedure S40PhbExtr(s:string);
procedure ClearRec();
function PmReadRecordBuf(Buf:pointer;Field:word;Rec:word):word;
function PmWriteRecord(Field:word;Rec:word;s:string):string;
function PmWriteRecBuf(Field:word;Rec:word;Buf:Pointer;Len:word):string;
function ReadPPItem(Item:byte):string;
function WritePPItem(Item:byte;Data:byte):string;
procedure S40CalExtr(s:string);
procedure NokiaCalConvert ();
procedure ClearCalRec ();
function S40PassExtr(s:string):string;
procedure S60PassExtr(m:TMemoryStream);
procedure S40NewCalEx();
function PhOnComPresent():boolean;
function GetS40PhbCou():integer;
function GetS40PhbRecord(RecNum:word):string;
function S40PhbWrite(Buf:pointer;Len:word):string;
function FullFactorySet():Boolean;
function SWupgrDef():Boolean;
function ServiceCentreDef():Boolean;
function PrdTuneSet():Boolean;
function UserDefSet():Boolean;
function LeaveFactSet():Boolean;
function LCDSetPat(pat:word):string;
procedure GetDriveList(s:string;dl:TStrings);
procedure PlainRplPar(RS:TStrings);
procedure RPLRClear();
function ReadPhoneInfoAll():boolean;
function ScanProcess():boolean;
procedure S60SMSConv(M:TMemoryStream);
procedure SMSRClear();
procedure S40SMSConv(M:TMemoryStream);
function ConvNokPhb():string;
procedure Rndmc;
function Rndc(I: Integer): word;
procedure FileVersionInfo;
function GetInetFile (const fileURL:string; M: TStream): boolean;
procedure SaveVcf(fname:string;num:integer);
function Utf8ToQp (s:string) : string ;
function AdrStr(c:char):string;
function ChkBlankSt(s:string):string;
function DoSLUnlock():boolean;
function DoSL3UplJob():boolean;
function DoChUnlock():boolean;
function ReadPhImei():string;
function Sl2Unlock():boolean;
function CalcCode(imei:string; key:pointer):string;
function BlackList(id:string):boolean;
function CheckKeyExists(imei:string):boolean;
function DoSX4():boolean;
function sx4init():string;
procedure SignData(outd,data,key:pointer;len:integer);
function CheckServerUser ():integer;
function DoCancelJob():boolean;
function DoRepSDD ():boolean;
function DoReadKey():boolean;
function sx4st2(s:string):string;
function sx4st3(s:string):string;
function sx4chst():string;
function CheckLeter(s:string):boolean;
procedure SymbConvert () ;
function SmartExtract(V:TStream;path,csvn:string):integer;
function CompDelAndSave():boolean;
function DoUplJobFile(imei,hash,code:string):boolean;
function DoReadInfineon(MM:TMemoryStream):string;
function TryFindHases(MM:TMemoryStream):string;
function DoInfJob():boolean;
function DoRepSL ():boolean;

//function SetServerIp(srvurl:PChar):integer; stdcall; External 'BestSrvClient.dll' name 'fnSetServer';
//function CallServer(imei,log,pass:PChar;rap,key,hash,data:pointer;data_ln:integer;pm1,pm2,pm3:pointer;s_ver,r_dat,crd:PChar;mode:integer):integer; stdcall; External 'BestSrvClient.dll' name 'fnSL3ServerCall';

  type
     TCalDate = record
        Hour:string;
        Min:string;
        Day:string;
        Month:string;
        Year:string;
  end;

  type
     TCalRec = record
        Num:string;
        Typ:string;
        Note:string;
        Venue:string;
        Reason:string;
        Tel:string;
        Date1:TCalDate;
        Date2:TCalDate;
        Date3:TCalDate;
        Date4:TCalDate;
        Date5:TCalDate;
        DateBeth:TCalDate;
  end;

  type
     TAdrRec = record
        PoBox:string;
        ExAdr:string;
        Street:string;
        City:string;
        State:string;
        PostC:string;
        Country:string;
  end;

  type
        TBookRecord = record
           Post : string ;
           Name : string ;
           SurName : string ;
           OsnTelNum : string ;
           HomTelNum : string ;
           MobTelNum : string ;
           FaxTelNum : string ;
           WorTelNum : string ;
           OthTelNum : string ;
           Company : string ;
           OffName : string ;
           NickName : string ;
           Birthday : string ;
           emale : string ;
           ptt : string ;
           adress : TAdrRec ;
           AdrWork : TAdrRec ;
           http : string ;
           userid : string ;
           note : string ;
           idgroup : string ;
      end;

  type
     TSMSRec = record
        Typ:string;
        Num:string;
        Bod:string;
        DatTim:string;
        Part:string;
  end;

var
 SMSRec:TSMSRec;
 CalRec:TCalRec;
 BookRecord:TBookRecord;
 RecCou:integer;
 Buf: array [0..$ffff] of byte;
 tmarray: array [0..$1000000] of byte;
BookArray: array [0..3000] of TBookRecord;
 PassStr:TStrings;
  FileDescription:   string;
  ModName: array[0..max_path] of char; //имя модуля
 OldX,slt: Integer;
 imei_s,s308,s1200,s1201,s1202,s1203:string;
 uni_key,hash_s,rap_s,code_s:string;
 cur_sx4_rnd: array [0..15] of byte;
sdd: array [0..$4F] of byte = (
       $F3,$69,$3E,$F2,$FC,$7A,$8A,$37,$C5,$CB,$21,$CB,$7D,$13,$26,$DF,$76,$12,$F5,$5C,
       $B8,$1C,$E3,$4E,$5E,$D4,$32,$64,$E1,$EB,$E3,$2F,$E2,$E7,$EF,$21,$4C,$D6,$F9,$29,
       $39,$73,$2D,$69,$9B,$54,$32,$B1,$DB,$E9,$FB,$02,$5B,$EC,$D4,$F1,$73,$C8,$5D,$FE,
       $32,$0E,$DF,$ED,$AB,$1B,$2E,$D3,$A3,$82,$4A,$AF,$CD,$48,$16,$9E,$DD,$47,$28,$9E);
 // Decoded and prepared rpl data before hashing
pre_hash: array [0..125] of byte = (
// RAP3 ID
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00,
// SL table hash
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
// Generated decode AES key
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
// Unlock codes block
$2E, $43, $44, $F1, $D0, $4E, $BA, $C7, $63, $88, $7C, $15, $17, $8E, $85, $9E, $C1, $CE,
$70, $92, $15, $16, $C6, $A2, $DD, $4B, $F7, $2B, $C5, $18, $74, $87, $F1, $BB, $53, $08,
$8B, $DC, $03, $1A, $A3, $31, $C2, $DD, $EE, $E2, $90, $59, $32, $D9, $69, $46, $86, $FA,
$96, $D9, $70, $7A, $45, $9A, $5E, $52, $BA, $78, $85, $CE, $AE, $55, $40, $55);

PM_120_0: array [0..943] of byte = (
	$00, $00, $00, $00, $00, $00, $00, $00, $24, $40, $70, $00, $00, $00, $00, $00,
	$00, $18, $07, $00, $00, $00, $00, $00, $00, $50, $00, $00, $05, $FF, $FF, $FF, 
	$00, $B4, $00, $00, $05, $FF, $FF, $FF, $01, $18, $00, $00, $05, $FF, $FF, $FF, 
	$01, $7C, $00, $00, $05, $FF, $FF, $FF, $01, $E0, $00, $00, $05, $FF, $FF, $FF, 
	$02, $44, $00, $00, $05, $FF, $FF, $FF, $02, $A8, $00, $00, $05, $FF, $FF, $FF, 
	$00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $F8, $00, $03, $0C,
	$03, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $3E, $FF, $FF, $FF, $FF, 
	$C0, $00, $03, $0F, $02, $00, $01, $03, $00, $00, $00, $00, $7F, $FF, $6F, $3F, 
	$FF, $FF, $FF, $FF, $C0, $00, $03, $11, $02, $00, $01, $03, $00, $00, $00, $00, 
	$7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $07, $FE, $03, $13, $08, $00, $05, $03,
	$00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $07, $FE, $03, $1B,
	$08, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, 
	$F8, $00, $03, $23, $03, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $3E, 
	$FF, $FF, $FF, $FF, $C0, $00, $03, $26, $02, $00, $01, $03, $00, $00, $00, $00, 
	$7F, $FF, $6F, $3F, $FF, $FF, $FF, $FF, $C0, $00, $03, $28, $02, $00, $01, $03, 
	$00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $07, $FE, $03, $2A, 
	$08, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF,
	$07, $FE, $03, $32, $08, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07, 
	$FF, $FF, $FF, $FF, $F8, $00, $03, $3A, $03, $00, $05, $03, $00, $00, $00, $00, 
	$7F, $FF, $6F, $3E, $FF, $FF, $FF, $FF, $C0, $00, $03, $3D, $02, $00, $01, $03, 
	$00, $00, $00, $00, $7F, $FF, $6F, $3F, $FF, $FF, $FF, $FF, $C0, $00, $03, $3F, 
	$02, $00, $01, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, 
	$07, $FE, $03, $41, $08, $00, $05, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07,
	$FF, $FF, $FF, $FF, $07, $FE, $03, $49, $08, $00, $05, $03, $00, $00, $00, $00, 
	$7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $F8, $00, $03, $51, $03, $00, $05, $03, 
	$00, $00, $00, $00, $7F, $FF, $6F, $3E, $FF, $FF, $FF, $FF, $C0, $00, $03, $54, 
	$02, $00, $01, $03, $00, $00, $00, $00, $7F, $FF, $6F, $3F, $FF, $FF, $FF, $FF, 
	$C0, $00, $03, $56, $02, $00, $01, $03, $00, $00, $00, $00, $7F, $FF, $6F, $07, 
	$FF, $FF, $FF, $FF, $07, $FE, $03, $58, $08, $00, $05, $03, $00, $00, $00, $00, 
	$7F, $FF, $6F, $07, $FF, $FF, $FF, $FF, $07, $FE, $03, $60, $08, $00, $05, $03,
	$00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF, $F8, $00, $03, $68, 
	$03, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $3E, $FF, $FF, 
	$C0, $00, $03, $6B, $02, $00, $01, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, 
	$6F, $3F, $FF, $FF, $C0, $00, $03, $6D, $02, $00, $01, $03, $00, $00, $00, $00, 
	$3F, $00, $7F, $20, $6F, $07, $FF, $FF, $07, $FE, $03, $6F, $08, $00, $05, $03, 
	$00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF, $07, $FE, $03, $77,
	$08, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF, 
	$F8, $00, $03, $7F, $03, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, 
	$6F, $3E, $FF, $FF, $C0, $00, $03, $82, $02, $00, $01, $03, $00, $00, $00, $00, 
	$3F, $00, $7F, $20, $6F, $3F, $FF, $FF, $C0, $00, $03, $84, $02, $00, $01, $03, 
	$00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF, $07, $FE, $03, $86,
	$08, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF,
	$07, $FE, $03, $8E, $08, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20,
	$6F, $07, $FF, $FF, $F8, $00, $03, $96, $03, $00, $05, $03, $00, $00, $00, $00,
	$3F, $00, $7F, $20, $6F, $3E, $FF, $FF, $C0, $00, $03, $99, $02, $00, $01, $03,
	$00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $3F, $FF, $FF, $C0, $00, $03, $9B,
	$02, $00, $01, $03, $00, $00, $00, $00, $3F, $00, $7F, $20, $6F, $07, $FF, $FF,
	$07, $FE, $03, $9D, $08, $00, $05, $03, $00, $00, $00, $00, $3F, $00, $7F, $20,
	$6F, $07, $FF, $FF, $07, $FE, $03, $A5, $08, $00, $05, $03, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
	$FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);

implementation
Uses Unit1, forms, UnitPavel, CardEx;

function SmartExtract(V:TStream;path,csvn:string):integer;
var
F:TFileStream;
MM:TMemoryStream;
s,sr,sp,tmps: string;
Len,co,i,j,ln,k:integer;
st,sn:Tstrings;
begin
      Result:=0;
      MM:=TMemoryStream.Create ;
      MM.Write(tmarray[0],2);
      co:=0;
      V.Seek(0,soFromBeginning);
      V.Read(tmarray,V.Size);
      V.Seek(0,soFromBeginning);
           st:=TStringList.Create;
           i:=0;         // FF09130010FFFFFFFF
           while i < V.Size do  begin
            if dword((@tmarray[i])^)=$1309FF then if dword((@tmarray[i+4])^)=$FFFFFF10 then
            begin
               s:='';
               s:=s+BufToHexStr(@tmarray[i-4],2);
               i:=i+51;
               j:=tmarray[i];
               i:=i+j+1;
               j:=tmarray[i];
               i:=i+j+1;
               j:=tmarray[i];
               j:=j shr 1;
               s:=s+' '+BufToHexStr(@tmarray[i],j+1);
               st.Add(s);
//               Form1._msg(s);
            end;
            i:=i+1;
            Application.ProcessMessages;
           end;

           sn:=TStringList.Create;
           i:=0;         // 0913001004000000
           while i < V.Size do  begin
            if dword((@tmarray[i])^)=$10001309 then if dword((@tmarray[i+4])^)=$04 then
            begin
              j:=0;
                 while tmarray[i-j]<$F0 do j:=j+1;
                  if word((@tmarray[i-j+3])^)=0 then if tmarray[i-j-1]<>$0 then
                  s:='';
                  s:=s+BufToHexStr(@tmarray[i-j+1],2);
                  s:=s+' '+BufToHexStr(@tmarray[i-j+5],j-5);
                  sn.Add(s);
                  i:=i+8;
            end;
            i:=i+1;
            Application.ProcessMessages;
           end;
           sn.NameValueSeparator:=' ';
           st.NameValueSeparator:=' ';
           for i:=0 to sn.Count-1 do begin
             s:=sn.Names[i];
             sr:=sn.ValueFromIndex[i];
             if sr<>'' then begin
             j:=st.IndexOfName(s);
             if j<>-1 then begin
             sp:=st.ValueFromIndex[j];
             st.Delete(j);
             Len:=Length(sr)+Length(sp);
             Len:=Len shr 1;
             Len:=Len+4;
             word((@tmarray[0])^):=Len;
             word((@tmarray[2])^):=Length(sr) shr 1;
             j:=StrToBufHex(sr,@tmarray[4]);
             word((@tmarray[j+4])^):=Length(sp) shr 1;
             j:=StrToBufHex(sp,@tmarray[j+6]);
             MM.Write(tmarray[0],Len+2);
             co:=co+1;
             end;
             end;
           end;
           sn.Free;
           st.Free;
           MM.Seek(0,soFromBeginning) ;  // пишем подсчитанное кол-во
           word((@tmarray[0])^):=co ;  // в свой файл
           MM.Write(tmarray[0],2);
           Str(co,s);
           if co = 0 then begin
              Result:=0;
              exit;
            end ;
           RecCou := 0 ;
             MM.Seek(2,soFromBeginning) ;
             for i := 0 to co-1 do begin
             MM.Read(tmarray[0],2);
             Len:=word((@tmarray[0])^);
             MM.Read(tmarray[0],Len);
//              Form1._msg(BufToHexStr(@tmarray[0],Len));
             SymbConvert ;
             CompDelAndSave;
              Application.ProcessMessages;
             end;
            if Form1.csvch.Checked then begin
             F:=TFileStream.Create(csvn,fmCreate);
             tmps:=('Name ; Surname ; Common ; Home ; Mobile ; Fax ; Oth/Vid ; Work ; e-mail ; OffName ; Nick ; Address ; Post ; Company ; Birthday ; Note ; Group ; WWW ; UserId ; PTT ');
             F.Write(tmps[1],Length(tmps));
             word ((@tmarray[0])^):=$0A0D;
             F.Write(tmarray[0],2);
            end;
            for i:=0 to RecCou-1 do begin
            BookRecord:=BookArray[i];
            SaveVcf(path,i);
            if Form1.csvch.Checked then begin
             tmps:=Utf8toAnsi(BookRecord.Name+';'+ BookRecord.SurName+';'+BookRecord.OsnTelNum+';'+
                     BookRecord.HomTelNum+';'+BookRecord.MobTelNum+';'+BookRecord.FaxTelNum+';'+
                     BookRecord.OthTelNum+';'+BookRecord.WorTelNum+';'+BookRecord.emale+';'+
                     BookRecord.OffName+';'+BookRecord.NickName+';'+AdrStr(' ')+';'+
                     BookRecord.Post+';'+BookRecord.Company+';'+BookRecord.Birthday+';'+
                     BookRecord.note+';'+BookRecord.idgroup+';'+BookRecord.http+';'+
                     BookRecord.userid+';'+BookRecord.ptt);
             F.Write(tmps[1],Length(tmps));
             word ((@tmarray[0])^):=$0A0D;
             F.Write(tmarray[0],2);
             end;
            end;
            if Form1.csvch.Checked then begin
            F.Free;
            Form1._msg('csv file save to '+csvn);
            end;
            Result:=RecCou;
end;

function CompDelAndSave():boolean;
label ex;
var
i:integer;
begin
      Result:=false;
      if RecCou=0 then begin BookArray[0]:=BookRecord ; RecCou:=1; Result:=true; goto ex; end
      else begin
        for i:=0 to RecCou-1 do begin
         if BookArray[i].Name=BookRecord.Name then if BookArray[i].SurName=BookRecord.SurName then
         if BookArray[i].MobTelNum=BookRecord.MobTelNum then  if BookArray[i].WorTelNum=BookRecord.WorTelNum then
         if BookArray[i].HomTelNum=BookRecord.HomTelNum then  if BookArray[i].FaxTelNum=BookRecord.FaxTelNum then
         if BookArray[i].OthTelNum=BookRecord.OthTelNum then
          goto ex;
        end;
      BookArray[RecCou]:=BookRecord ;
      RecCou:=RecCou+1;
      Result:=true;
      end;
ex:
end;

function CheckLeter(s:string):boolean;
var
i:integer;
begin
   Result:=false;
   for i:=1 to Length(s) do begin
    if s[i]>='@' then begin
    Result:=true;
    exit;
    end;
   end;
end;

procedure SymbConvert () ;
label skip;
var
 len,i,ln,j : integer ;
 s : string ;
begin
           ClearRec;
      //Name
           i:=2;
           Len:=word((@tmarray[0])^);
           while i<Len do begin
           s:='';
           ln:=tmarray[i] shr 1;
           i:=i+1;
           for j:=0 to ln-1 do begin
            if tmarray[i+j] >= $20 then
            if tmarray[i+j] >= $80 then s:=s+Chr(tmarray[i+j]+$30) else s:=s+Chr(tmarray[i+j]);
           end;
           if BookRecord.Name ='' then BookRecord.Name:= AnsiToUtf8(s) else BookRecord.SurName:= AnsiToUtf8(s);
           i:=i+ln;
           end;
    // Phone
           i:=Len+4;
           s:='';
           ln:=tmarray[i] shr 1;
           i:=i+1;
           for j:=0 to ln-1 do begin
            if tmarray[i+j]<>0 then begin
              if tmarray[i+j] >= $20 then if tmarray[i+j] >= $80 then s:=s+Chr(tmarray[i+j]+$30) else s:=s+Chr(tmarray[i+j])
              end
            else begin
              if ((s<>' ') and (s<>'private')) then
                if CheckLeter(s) then begin
                if Pos(':\',s)=0 then BookRecord.note:=BookRecord.note+' '+s;
                end else if BookRecord.MobTelNum<>'' then BookRecord.MobTelNum:=BookRecord.MobTelNum+' '+s else BookRecord.MobTelNum:=s;
              s:='';
            end;
           end;
end;

function sx4chst():string;
begin
      Result:='Error';
      if ConMode =0 then Result:=UsbSx4chst  else Result:=FbusSx4chst ;
end;

function sx4st3(s:string):string;
begin
      Result:='Error';
      if ConMode =0 then Result:=UsbSx4st3(s)  else Result:=FbusSx4st3(s) ;
end;

function sx4st2(s:string):string;
begin
      Result:='Error';
      if ConMode =0 then Result:=UsbSx4st2(s)  else Result:=FbusSx4st2(s) ;
end;

function DoReadKey():boolean;
begin
         Result:=false;
         imei_s:=ReadPhImei;
         if imei_s='Error' then exit;
         Form1._msg('Phone Imei: '+imei_s);
  if getid =0 then   Result:=true;

end;

function DoRepSL ():boolean;
var
sSource,sDest    : TMemoryStream;
tarr: array [0..49] of byte;
in_block: array [0..79] of byte;
buff: array [0..200] of byte;
akey,s,tk: string;
dead,dead1:string;
i:integer;
keyd:pointer;
begin
         Result:=false;
         imei_s:=ReadPhImei;
         if imei_s='Error' then exit;
         Form1._msg('Phone Imei: '+imei_s);
 case getid of
// 0: Form1._msg('Init Service mode Ok, can proceed...');  // All done
 1: begin Form1._msg('Init service mode fail :('); exit; end;// Init Service mode faled
 2: begin Form1._msg('Can'+#39+'t read Unique data! :('); exit; end; // ID read failed
 3: begin Form1._msg('UFSx error, reconnect and try again...'); exit; end; // Fail at all
 end;
//       rap_s:='06A00103623B625034E4751D97204AE464C0C58C';
//       hash_s:='9DDBFCFE6E73CED7D8C6268C8EB85723';
//       uni_key:='15B5B9ED78B8EAADF456C27C4CAC02FF54928168';
       rap_s:=UkeyData.PID;
       hash_s:=UkeyData.Hash;
       uni_key:=UkeyData.key;
    dead:='AB0FBD96AF2AC271D26264AFDEAD0400';
    dead1:='AB0FBD96AF2AC271D26264AFDEAD0100';
    FillChar(tarr,50,0);
    StrToBufHex(dead1,@tarr[0]);
    StrToBufHex(dead,@tarr[15]);
    SetLength(tk,16);
    SHAx(@tarr[0],30,@tk[1]);
    tk[16]:=Chr(0);
    FillChar(tarr,50,0);
    tarr[0]:=1;
    StrToBufHex(rap_s,@tarr[1]);
    StrToBufHex(uni_key,@tarr[9]);
    CopyMemory(@tarr[29],@tk[1],16);
    SetLength(akey,16);
    SHAx(@tarr[0],45,@akey[1]);
    FillChar(in_block,80,0);
    CopyMemory(@in_block[0],@pre_hash[56],70);
   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(in_block,$50);
  sSource.Seek(0,soFromBeginning);
  Form1.AESEncrypt(sSource,sDest,@akey[1]);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(Buf,sDest.Size);
  sDest.Free;
  RPLRecord.SIMLOCK_KEY:=BufToHexStr(@Buf,80);

    SHAx(@PM_120_0,Length(PM_120_0),@tarr[0]);
    StrToBufHex(rap_s,@pre_hash[0]);
    CopyMemory(@pre_hash[$14],@tarr[0],20);
    CopyMemory(@pre_hash[$28],@akey[1],16);
    SHAx(@pre_hash[0],Length(pre_hash),@tarr[0]);
  RPLRecord.SIMLOCK_KEY:=RPLRecord.SIMLOCK_KEY+BufToHexStr(@tarr[0],20);
  RPLRecord.SIMLOCK:=BufToHexStr(@PM_120_0,Length(PM_120_0));
//  RPLRecord.SIMLOCK:=BufToHexStr(@pre_hash[$14],20);
//  RPLRecord.SIMLOCK:=RPLRecord.SIMLOCK+BufToHexStr(@PM_120_0,Length(PM_120_0));
//            Form1._msg(RPLRecord.SIMLOCK);
//            Form1._msg(RPLRecord.SIMLOCK_KEY);
//            exit;
      Form1.SetMode('Test');
        case conmode of
         0: begin
            s:='Writing SimLock Data...   '+UsbRplsimlockdata(RPLRecord.SIMLOCK);
            Form1._msg(s);
            if Pos ('Ok',s)=0 then begin Result:=false; exit; end;
            s:='Writing SimLock Key...   '+UsbWriteSimLokkey(RPLRecord.SimLock_key);
            Form1._msg(s);
            if Pos ('Ok',s)<>0 then Result:=true else Result:=false;
            end;
         1: begin
           if WriteSLDataSL2(RPLRecord.SIMLOCK) then Form1._msg('Writing SimLock Data...   Ok')
              else begin Form1._msg('Writing SimLock Data...   Error'); Result:=false; exit; end;
           if WriteSLkeySL2(RPLRecord.SimLock_key) then begin Form1._msg('Writing SimLock Key...   Ok'); Result:=true; end
              else begin Form1._msg('Writing SimLock Key...   Error'); Result:=false; end;
            end;  
        end;
end;

function DoRepSDD ():boolean;
var
sSource,sDest    : TMemoryStream;
tarr: array [0..49] of byte;
buff: array [0..200] of byte;
akey,s,tk: string;
dead,dead1:string;
i:integer;
keyd:pointer;
begin
         Result:=false;
         imei_s:=ReadPhImei;
         if imei_s='Error' then exit;
         Form1._msg('Phone Imei: '+imei_s);
 case getid of
// 0: Form1._msg('Init Service mode Ok, can proceed...');  // All done
 1: begin Form1._msg('Init service mode fail :('); exit; end;// Init Service mode faled
 2: begin Form1._msg('Can'+#39+'t read Unique data! :('); exit; end; // ID read failed
 3: begin Form1._msg('UFSx error, reconnect and try again...'); exit; end; // Fail at all
 end;
       rap_s:=UkeyData.PID;
       hash_s:=UkeyData.Hash;
       uni_key:=UkeyData.key;
    dead:='AB0FBD96AF2AC271D26264AFDEAD0300';
    dead1:='AB0FBD96AF2AC271D26264AFDEAD0100';
    FillChar(tarr,50,0);
    StrToBufHex(dead1,@tarr[0]);
    StrToBufHex(dead,@tarr[15]);
    SetLength(tk,16);
    SHAx(@tarr[0],30,@tk[1]);
    tk[16]:=Chr(0);
    FillChar(tarr,50,0);
    tarr[0]:=1;
    StrToBufHex(rap_s,@tarr[1]);
    StrToBufHex(uni_key,@tarr[9]);
    CopyMemory(@tarr[29],@tk[1],16);
    SetLength(akey,16);
    SHAx(@tarr[0],45,@akey[1]);
    FillChar(buff,200,0);
    CopyMemory(@buff,@sdd,80);

    SignData(@buff[$58],@buff,@akey[1],$51);

   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(buff,$60);
  sSource.Seek(0,soFromBeginning);
  Form1.AESEncrypt(sSource,sDest,@akey[1]);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(Buf,sDest.Size);
  sDest.Free;
  RPLRecord.SUPERDONGLE_KEY:=BufToHexStr(@Buf,96);

      Form1.SetMode('Test');
        case conmode of
         0: begin
            s:='Writing Super Dongle Key...   '+UsbWriteSDDkey(RPLRecord.SUPERDONGLE_KEY);
            Form1._msg(s);
            if Pos ('Ok',s)<>0 then Result:=true else Result:=false;
            end;
         1: if FWriteSDkeySLx(RPLRecord.SUPERDONGLE_KEY) then begin Form1._msg('Writing Super Dongle Key...   Ok'); Result:=true; end
              else begin Form1._msg('Writing Super Dongle Key...   Error'); Result:=false; end;
        end;
end;

function CheckServerUser ():integer;
var
i,j:integer;
s,h:string;
M:TMemoryStream;
begin
   Form1._msg('');
   Form1._msg('Link to my account: http://'+Form1.SrvEd.Text+':8002');
   Form1._msg('Login: '+UidSrv);
   Form1._msg('Password: '+UidPas);
   Form1._msg('');
   Form1._msg('Connecting to server...');
   Form1._msg('');
   Result:=-1;
   M:=TMemoryStream.Create;
   s:=UidSrv+UidPas;
   h:='';
   SetLength(h,20);
   SHAx(@s[1],Length(s),@h[1]);
   s:=BufToHexStr(@h[1],20);
   if not GetInetFile('http://'+Form1.SrvEd.Text+':8001/info.php?user='+UidSrv+'&pass='+s,M) then
    begin
     Form1._msg('Server not found...');
     M.Free;
     exit;
    end;
   s:='';
   M.Seek(0,soFromBeginning);
   SetLength(s,M.Size);
   M.Read(s[1],M.Size);
   h:='';
   for i:=1 to Length (s) do begin
     if s[i]>=Chr($20) then h:=h+s[i];
     if (s[i]=Chr($0A)) or (i=Length(s))then
       begin
        Form1._msg(h);
        j:=Pos ('credit: ',h);
        if j<>0 then Result:=StrToInt(Copy(h,9,(Length(h)-8)));
        h:='';
       end;
   end;
    Form1._msg('');
end;

function DoSX4():boolean;
var
i:integer;
sSource,sDest    : TMemoryStream;
tarr: array [0..49] of byte;
resp: array [0..24] of byte;
akey,s,d: string;
dead:string;

begin
   Result:=false;
         imei_s:=ReadPhImei;
         if imei_s='Error' then exit;
         Form1._msg('Phone Imei: '+imei_s);
  if Form1.custk.Checked then begin
  Form1._msg('Use custom key...');
  s:='F3693EF2FC7A8A37C5CB21CB7D1326DF7612F55CB81CE34E5ED43264E1EBE32FE2E7EF214CD6F9293973';
  s:=s+'2D699B5432B1DBE9FB025BECD4F173C85DFE320EDFEDAB1B2ED3A3824AAFCD48169EDD47289E';
  StrToBufHex(s,@Buf);
  end else begin
         s308:=PmReadRecord(308,1);
         if s308='Error' then exit;

 case getid of
// 0: Form1._msg('Init Service mode Ok, can proceed...');  // All done
 1: begin Form1._msg('Init service mode fail :('); exit; end;// Init Service mode faled
 2: begin Form1._msg('Can'+#39+'t read Unique data! :('); exit; end; // ID read failed
 3: begin Form1._msg('UFSx error, reconnect and try again...'); exit; end; // Fail at all
 end;
       rap_s:=UkeyData.PID;
       hash_s:=UkeyData.Hash;
       uni_key:=UkeyData.key;

    dead:='AB0FBD96AF2AC271D26264AFDEAD0300';
    FillChar(tarr,50,0);
    tarr[0]:=1;
    StrToBufHex(rap_s,@tarr[1]);
    StrToBufHex(uni_key,@tarr[9]);
    StrToBufHex(dead,@tarr[29]);
    s:=Copy(s308,Pos(dead,s308)-16,160+32+16);
    SetLength(akey,16);
    SHAx(@tarr[0],45,@akey[1]);
    i:=StrToBufHex(s,@Buf);
   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(Buf[24],80);
  sSource.Seek(0,soFromBeginning);
  Form1.AESDecrypt(sSource,sDest,@akey[1],@Buf[0]);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(Buf,sDest.Size);
  sDest.Free;
  end;
  s:=sx4init;
  Form1._msg('Step 1...');
  StrToBufHex(s,@cur_sx4_rnd);
    FillChar(resp,24,0);
    resp[0]:=1;
    resp[2]:=1;
    FillChar(tarr,50,0);
    BufCopy(@Buf,@tarr[0],$0A);
    BufCopy(@cur_sx4_rnd,@tarr[$0A],16);
    SetLength(akey,16);
    SHAx(@tarr[0],26,@akey[1]);
   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(resp,16);
  sSource.Seek(0,soFromBeginning);
  Form1.AESEncrypt(sSource,sDest,@akey[1]);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(resp,sDest.Size);
  sDest.Free;
  SignData(@tarr,@resp,@akey[1],16);
  s:='';
  SetLength(s,24);
  BufCopy(@resp,@s[1],16);
  BufCopy(@tarr,@s[17],8);
  d:=sx4st2(s);
  Form1._msg('Step 2...');
    FillChar(tarr,50,0);
    BufCopy(@akey[1],@tarr[0],16);
    SHAx(@tarr[0],26,@akey[1]);
  StrToBufHex(d,@resp);
  SignData(@tarr,@resp,@akey[1],16);
  if Pos(BufToHexStr(@tarr,8),d)=0 then begin
  Form1._msg('SX4 Auth fail...');
  exit;
  end;
    FillChar(resp,24,0);
    resp[0]:=3;
    resp[1]:=1;
   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(resp,16);
  sSource.Seek(0,soFromBeginning);
  Form1.AESEncrypt(sSource,sDest,@akey[1]);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(resp,sDest.Size);
  sDest.Free;
  SignData(@tarr,@resp,@akey[1],16);
  s:='';
  SetLength(s,24);
  BufCopy(@resp,@s[1],16);
  BufCopy(@tarr,@s[17],8);
  sx4st3(s);
  Form1._msg('Step 3...');
  d:='SX4 Auth - '+sx4chst;
  Form1._msg(d);
  Result:=true;
end;

function DoCancelJob():boolean;
var
s,a,b:string;
s1,s2,s3:string;
i:integer;
begin
   Result:=false;
//   imei_s:=Form1.ImeiCancelEd.Text;
//   UidSrv:='FF0001ABCD';
//   UidPas:='12345678';
   a:=UidSrv+Chr(0); b:=UidPas+Chr(0);
   if Length(imei_s)<>15 then exit;
   imei_s:=imei_s+Chr(0);
   SetLength(s1,200);
   FillChar(s1[1],200,0);
   SetLength(s2,20000);
   FillChar(s2[1],20000,0);
   SetLength(s3,200);
   FillChar(s3[1],200,0);
   s:='https://'+Form1.SrvEd.Text+':443'+Chr(0);
   i:=5;
      i:=SetServerIp(PChar(s));
        if i=0 then
              i:=CallServer(PChar(imei_s),PChar(a),PChar(b),nil,nil,nil,nil,0,nil,nil,nil,PChar(s1),PChar(s2),PChar(s3),6);
         if i=0 then Result:=true else
             begin
             Form1._msg('Error '+IntToStr(i));
             exit;
             end;
   i:=1;
   s:='';
   while s1[i]<>Chr(0) do begin
     if s1[i]>=Chr($20) then s:=s+s1[i];
     if s1[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Server version: '+s);
   i:=1;
   s:='';
   while s2[i]<>Chr(0) do begin
     if s2[i]>=Chr($20) then s:=s+s2[i];
     if s2[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg(s);
   i:=1;
   s:='';
   while s3[i]<>Chr(0) do begin
     if s3[i]>=Chr($20) then s:=s+s3[i];
     if s3[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Credit left: '+s);
end;

procedure SignData(outd,data,key:pointer;len:integer);
var
sp00: array [0..19] of byte;
sp14: array [0..$40] of byte;
sp54: array [0..$FF] of byte;
s:string;
i:integer;
begin

        FillChar(sp54,$40,0);
        BufCopy(key,@sp54,16);

        BufCopy(@sp54,@sp14,$40);
        for i:=0 to $40 do sp14[i]:=sp14[i] xor $36;

        s:='';
        SetLength(s,$40+len);
        BufCopy(@sp14,@s[1],$40);
        BufCopy(data,@s[$41],len);
        SHAx(@s[1],Length(s),@sp00);

        BufCopy(@sp54,@sp14,$40);
        for i:=0 to $40 do sp14[i]:=sp14[i] xor $5C;
        BufCopy(@sp14,@sp54,$40);
        BufCopy(@sp00,@sp54[$40],20);
        SHAx(@sp54,$40+20,@sp00);
        BufCopy(@sp00,outd,20);
end;

function sx4init():string;
begin
      Result:='Error';
      if ConMode =0 then Result:=UsbSx4st1  else Result:=FbusSx4st1 ;
end;

function CheckKeyExists(imei:string):boolean;
var
  setini:TIniFile;
  s:string;
begin
  try
  Result:=true;
 setini:=TIniFile.Create(ExtractFileDir(Application.ExeName)+'\Special\special.log');
 if setini.SectionExists(imei) then begin
 s:=setini.ReadString(imei,'rap','');
 if s<>'' then UkeyData.PID:=s else Result:=false;
 s:=setini.ReadString(imei,'hash','');
 if s<>'' then UkeyData.Hash:=s else Result:=false;
 s:=setini.ReadString(imei,'key','');
 if s<>'' then UkeyData.Key:=s else Result:=false;
 end else Result:=false;
 setini.Free;
 except
  Result:=false;
 end;
end;

function BlackList(id:string):boolean;
var
infst,bestst:string;
begin
     Result:=false;
     infst:=' ';
     bestst:='01385575 0F9B4571 05B5578B 100E488B 03604891 ';
     if Infinity then
        if Pos (id,infst)=0 then exit else begin CardBlock; Result:=true; end
      else
        if Pos (id,bestst)=0 then exit else begin CardBlock; Result:=true; end
end;

function CalcCode(imei:string; key:pointer):string;
var
  i:integer;
  imei_p: dword;
  tmp: string;
  hash:    array[0..19] of byte;
  ImeiAr:    array[0..3] of dword;
  shadigest: array [0..19] of byte;

  CodeBuff: array[0..15] of byte;
begin
        Result:='Error';
        tmp := imei + '_';
        copymemory(@ImeiAr[0], pointer(tmp), length(tmp));
        imei_p := (ImeiAr[0] xor ImeiAr[1] xor ImeiAr[2] xor ImeiAr[3]) and $7070707;
        copymemory(@CodeBuff[0], @imei_p, 4);
          CopyMemory(@hash[0],key, 10);

          hash[10] := 7;
          SHAx(@hash[0],11,@shadigest);
          for i := 0 to 10 do
            CodeBuff[i + 4] := shadigest[i] mod 10;
          CopyMemory(@hash[1], @hash[0], 10);
          hash[0] := $00;
          CopyMemory(@hash[11], @imei_p, 4);
          CopyMemory(@hash[11 + 4], @CodeBuff[4], 4);
          SHAx(@hash[0],19,@shadigest);
          tmp := '';
          for i := 0 to 10 do
            CodeBuff[4 + 4 + i] := ((shadigest[i] mod 10) + CodeBuff[4 + 4 + i]) mod 10;
          CopyMemory(@hash[11], @CodeBuff[4 + 4], 7);
          SHAx(@hash[0],18,@shadigest);
          for i := 0 to 7 do
            CodeBuff[i] := ((shadigest[i] mod 10) + CodeBuff[i]) mod 10;
          hash[0] := $01;
          CopyMemory(@hash[11], @CodeBuff[0], 8);
          SHAx(@hash[0],19,@shadigest);
          for i := 0 to 7 do
            CodeBuff[4 + 4 + i] := ((shadigest[i] mod 10) + CodeBuff[4 + 4 + i]) mod 10;
          hash[0] := $01;
          CopyMemory(@hash[11], @CodeBuff[4 + 4], 7);
          SHAx(@hash[0],18,@shadigest);
          for i := 0 to 7 do
            CodeBuff[i] := ((shadigest[i] mod 10) + CodeBuff[i]) mod 10;
          for i := 0 to 14 do
            tmp := tmp + char($30 + CodeBuff[i]);
          Result:=tmp;

end;

function Sl2Unlock():boolean;
var
sSource,sDest    : TMemoryStream;
tarr: array [0..49] of byte;
akey,s: string;
dead:string;
i:integer;
keyd:pointer;
begin
    Result:=false;
    dead:='AB0FBD96AF2AC271D26264AFDEAD0400';
    FillChar(tarr,50,0);
    tarr[0]:=1;
    StrToBufHex(rap_s,@tarr[1]);
    StrToBufHex(uni_key,@tarr[9]);
    StrToBufHex(dead,@tarr[29]);
    s:=Copy(s308,Pos(dead,s308)+32,$810);
    SetLength(akey,16);
    SHAx(@tarr[0],45,@akey[1]);
    i:=StrToBufHex(s,@Buf);
   sSource:=TMemoryStream.Create;
  sDest:=TMemoryStream.Create;
  sSource.Write(Buf,i);
  sSource.Seek(0,soFromBeginning);
  Form1.AESDecrypt(sSource,sDest,@akey[1],nil);
  sSource.Free;
  sDest.Seek(0,soFromBeginning);
  sDest.Read(Buf,sDest.Size);
  sDest.Free;
   if ((Chr(Buf[1])='L') and (Chr(Buf[2])='P') and (Chr(Buf[3])='A')) then keyd:=@Buf[64] else
    if ((Chr(Buf[1])='L') and (Chr(Buf[2])='2') and (Chr(Buf[3])='0')) then keyd:=@Buf[28] else exit;
    s:=(CalcCode(imei_s,keyd));
   if s<>'Error' then begin
      Form1._msg('Using F-bus count...');
     Form1._msg('Sending code '+s+' Level : 7 to SimLock Server...');
     if ConMode =0 then  Form1._msg('Simlock Server Answer: '+uncksend(s,7)) else Form1._msg('Simlock Server Answer: '+fncksend(s,7));
    end else exit;
   Result:=true;
end;

function DoChUnlock():boolean;
var
s,a,b,im1:string;
s1,s2,s3:string;
i:integer;
CL:TStrings;
begin
   Result:=false;
//   imei_s:='358283036272821';
   imei_s:=ReadPhImei;
//   UidSrv:='FF0001ABCD';
//   UidPas:='12345678';
   a:=UidSrv+Chr(0); b:=UidPas+Chr(0);
   if imei_s='Error' then exit;
   im1:=imei_s+Chr(0);
   SetLength(s1,200);
   FillChar(s1[1],200,0);
   SetLength(s2,20000);
   FillChar(s2[1],20000,0);
   SetLength(s3,200);
   FillChar(s3[1],200,0);
   s:='https://'+Form1.SrvEd.Text+':443'+Chr(0);
   i:=5;
      i:=SetServerIp(PChar(s));
        if i=0 then
              i:=CallServer(PChar(im1),PChar(a),PChar(b),nil,nil,nil,nil,0,nil,nil,nil,PChar(s1),PChar(s2),PChar(s3),4);
         if i=0 then Result:=true else
             begin
             Form1._msg('Error '+IntToStr(i));
             exit;
             end;
   i:=1;
   s:='';
   while s1[i]<>Chr(0) do begin
     if s1[i]>=Chr($20) then s:=s+s1[i];
     if s1[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Server version: '+s);
   i:=1;
   s:='';
   CL:=TStringList.Create;
   while s2[i]<>Chr(0) do begin
     if s2[i]>=Chr($20) then s:=s+s2[i];
     if s2[i]=Chr($0A) then begin Form1._msg(s); CL.Add(s); s:=''; end;
     i:=i+1;
   end;
   CL.Add(' ');
   i:=0;
   s:='';
   if CL.Count<>0 then begin
   while i<CL.Count-1 do begin
     if Pos(imei_s+',',CL.Strings[i])<>0 then
         begin
          i:=i+1;
          if Pos('Code: #pw+',CL.Strings[i])<>0 then begin
             s:=Copy(CL.Strings[i],Pos('Code: #pw+',CL.Strings[i])+10,15);
             break;
          end;
         end
     else if Pos(imei_s+':',CL.Strings[i])<>0 then
         begin
          if Pos('Code: #pw+',CL.Strings[i])<>0 then begin
             s:=Copy(CL.Strings[i],Pos('Code: #pw+',CL.Strings[i])+10,15);
             break;
          end;
         end;
    i:=i+1;
   end;
   end else s:='';
     Form1._msg('');
   if s<>'' then begin
      Form1._msg('Using F-bus count...');
     Form1._msg('Sending code '+s+' Level : 7 to SimLock Server...');
     if ConMode =0 then  Form1._msg('Simlock Server Answer: '+uncksend(s,7)) else Form1._msg('Simlock Server Answer: '+fncksend(s,7));

   end else Form1._msg('Unlock code not found for connected phone...');

   CL.Free;
end;

function DoUplJobFile(imei,hash,code:string):boolean;
var
i,met:integer;
s,a,b:string;
s1,s2,s3: string;
pm1:  array[0..200] of byte;
begin
   Result:=false;
   a:=UidSrv+Chr(0); b:=UidPas+Chr(0);
   SetLength(s1,200);
   FillChar(s1[1],200,0);
   SetLength(s2,20000);
   FillChar(s2[1],20000,0);
   SetLength(s3,200);
   FillChar(s3[1],200,0);
   s:='https://'+Form1.SrvEd.Text+':443'+Chr(0);
   met:=StrToBufHex(hash,@pm1);
   Form1._msg('Connecting to server...');
     i:=SetServerIp(PChar(s));
   if ((code<>'') and (Length(code)=15)) then begin
     i:=CallServer(PChar(imei+code+Chr(0)),PChar(a),PChar(b),nil,nil,nil,@pm1,met,nil,nil,nil,PChar(s1),PChar(s2),PChar(s3),13);
   end else begin
     i:=CallServer(PChar(imei+Chr(0)),PChar(a),PChar(b),nil,nil,nil,nil,0,@pm1,nil,nil,PChar(s1),PChar(s2),PChar(s3),11);
   end;
   if i=0 then Result:=true else Form1._msg('Error '+IntToStr(i));
   i:=1;
   s:='';
   while s1[i]<>Chr(0) do begin
     if s1[i]>=Chr($20) then s:=s+s1[i];
     if s1[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Server version: '+s);
   i:=1;
   s:='';
   while s2[i]<>Chr(0) do begin
     if s2[i]>=Chr($20) then s:=s+s2[i];
     if s2[i]=Chr($0A) then
     begin
      Form1._msg(s);
       s:='';
     end;
     i:=i+1;
   end;
   Form1._msg(s);
   i:=1;
   s:='';
   while s3[i]<>Chr(0) do begin
     if s3[i]>=Chr($20) then s:=s+s3[i];
     if s3[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Credit left: '+s);
end;

function DoSL3UplJob():boolean;
var
igBat: System.Text;
inl:TIniFile;
s:string;
i,len,met:integer;
s1,s2,s3,hashs: string;
a,b:string;
rap:  array[0..20] of byte;
Hash: array[0..20] of byte;
key:  array[0..20] of byte;
pm0:  array[0..4000] of byte;
pm1:  array[0..200] of byte;
pm2:  array[0..200] of byte;
pm3:  array[0..200] of byte;
begin
   Result:=false;
   a:=UidSrv+Chr(0); b:=UidPas+Chr(0);
   SetLength(s1,200);
   FillChar(s1[1],200,0);
   SetLength(s2,20000);
   FillChar(s2[1],20000,0);
   SetLength(s3,200);
   FillChar(s3[1],200,0);
   s:='https://'+Form1.SrvEd.Text+':443'+Chr(0);
   len:=StrToBufHex(s1200,@pm0);
   StrToBufHex(s1201,@pm1);
   StrToBufHex(s1202,@pm2);
   StrToBufHex(s1203,@pm3);
   StrToBufHex(rap_s,@rap);
   StrToBufHex(uni_key,@key);
   StrToBufHex(hash_s,@Hash);
   hashs:='';
   if Form1.CbLnck.Checked then met:=10 else met:=2;
   Form1._msg('Connecting to server...');
     i:=SetServerIp(PChar(s));
     i:=CallServer(PChar(imei_s+Chr(0)),PChar(a),PChar(b),@rap,@key,@hash,@pm0,len,@pm1,@pm2,@pm3,PChar(s1),PChar(s2),PChar(s3),met);
   if i=0 then Result:=true else Form1._msg('Error '+IntToStr(i));
   i:=1;
   s:='';
   while s1[i]<>Chr(0) do begin
     if s1[i]>=Chr($20) then s:=s+s1[i];
     if s1[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Server version: '+s);
   i:=1;
   s:='';
      if Form1.CbLnck.Checked then begin
      while s2[i]<>Chr(0) do begin
        s:=s+s2[i];
        i:=i+1;
        end;
        if Length(s)<>$140 then s:='Error in hash string' else begin hashs:=s;s:='Request Submited';  end;
      end else begin
   while s2[i]<>Chr(0) do begin
     if s2[i]>=Chr($20) then s:=s+s2[i];
     if s2[i]=Chr($0A) then
     begin
      Form1._msg(s);
       s:='';
     end;
     i:=i+1;
   end;
   end;
   Form1._msg(s);
   i:=1;
   s:='';
   while s3[i]<>Chr(0) do begin
     if s3[i]>=Chr($20) then s:=s+s3[i];
     if s3[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Credit left: '+s);
   if Form1.CbLnck.Checked then begin
   if hashs<>'' then begin
   Form1._msg('Create Log file for local calculation...');
    inl:=TIniFile.Create(StartDir+'Local_calc\'+imei_s+'.bcl');
    inl.WriteString('Log','imei',imei_s);
    inl.WriteString('Log','hash',hashs);
    inl.Free;
             System.Assign (igBat,StartDir+'Local_calc\'+imei_s+'.bat') ;
             System.Rewrite (igBat);
//ighashgpu -t:sha1 -salt:003583140332653200 -h:13CF7B2D82621F38BE22CC96F77E0ABD2F680C03 -uh:00010203040506070809 -min:15 -max:15
             System.WriteLn(igBat,'ighashgpu -t:sha1 -salt:00'+Copy(imei_s,1,14)+'00 -h:'+Copy(hashs,1,40)+' -uh:00010203040506070809 -min:15 -max:15');
             System.Close(igBat);
    Form1._msg('File '+StartDir+'Local_calc\'+imei_s+'.bcl created - Ok');
   end else Result:=false;
   end;
end;

function DoInfJob():boolean;
var
igBat: System.Text;
inl:TIniFile;
s:string;
i:integer;
s1,s2,s3,hashs: string;
a,b:string;
pm1:  array[0..200] of byte;
pm2:  array[0..200] of byte;
begin
   Result:=false;
   a:=UidSrv+Chr(0); b:=UidPas+Chr(0);
   SetLength(s1,200);
   FillChar(s1[1],200,0);
   SetLength(s2,20000);
   FillChar(s2[1],20000,0);
   SetLength(s3,200);
   FillChar(s3[1],200,0);
   s:='https://'+Form1.SrvEd.Text+':443'+Chr(0);
   StrToBufHex(s1201,@pm1);
   StrToBufHex(s1202,@pm2);
   hashs:='';
   Form1._msg('Connecting to server...');
     i:=SetServerIp(PChar(s));
     i:=CallServer(PChar(imei_s+Chr(0)),PChar(a),PChar(b),nil,nil,nil,nil,0,@pm1,@pm2,nil,PChar(s1),PChar(s2),PChar(s3),12);
   if i=0 then Result:=true else Form1._msg('Error '+IntToStr(i));
   i:=1;
   s:='';
   while s1[i]<>Chr(0) do begin
     if s1[i]>=Chr($20) then s:=s+s1[i];
     if s1[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Server version: '+s);
   i:=1;
   s:='';
      while s2[i]<>Chr(0) do begin
        s:=s+s2[i];
        i:=i+1;
        end;
        if Length(s)<>$140 then s:='Error in hash string' else begin hashs:=s;s:='Request Submited';  end;
   Form1._msg(s);
   i:=1;
   s:='';
   while s3[i]<>Chr(0) do begin
     if s3[i]>=Chr($20) then s:=s+s3[i];
     if s3[i]=Chr($0A) then begin Form1._msg(s); s:=''; end;
     i:=i+1;
   end;
   Form1._msg('Credit left: '+s);
   if hashs<>'' then begin
   Form1._msg('Create Log file for local calculation...');
    inl:=TIniFile.Create(StartDir+'Local_calc\'+imei_s+'.bcl');
    inl.WriteString('Log','imei',imei_s);
    inl.WriteString('Log','hash',hashs);
    inl.Free;
             System.Assign (igBat,StartDir+'Local_calc\'+imei_s+'.bat') ;
             System.Rewrite (igBat);
//ighashgpu -t:sha1 -salt:003583140332653200 -h:13CF7B2D82621F38BE22CC96F77E0ABD2F680C03 -uh:00010203040506070809 -min:15 -max:15
             System.WriteLn(igBat,'ighashgpu -t:sha1 -salt:00'+Copy(imei_s,1,14)+'00 -h:'+Copy(hashs,1,40)+' -uh:00010203040506070809 -min:15 -max:15');
             System.Close(igBat);
    Form1._msg('File '+StartDir+'Local_calc\'+imei_s+'.bcl created - Ok');
   end else Result:=false;
end;

function DoReadInfineon(MM:TMemoryStream):string;
begin
  Result:='Error';
  if not Boot_infineon then
 begin
 Form1._msg('Boot failed, phone not found');
 Form1._msg('');
 exit;
 end;
 if not halfboot then
 begin
 form1._msg('Error booting phone...');
 form1._msg('');
 Exit;
 end;
// Form1._msg('PSI : '+psi);
 Form1._msg('Trying dump eeprom....');
 dumpppmcatalog($780000,$800000,MM);
 MM.Seek(0,soFromBeginning);
 Result:=psi;
end;

function TryFindHases(MM:TMemoryStream):string;
var
i:integer;
begin
Result:='Error';
  MM.Read(tmarray,MM.Size-$A0);
  for i:=0 to MM.Size do begin
    if tmarray[i]=$F4 then
     if tmarray[i+1]=$15 then
      if tmarray[i+2]=$01 then
       if tmarray[i+3]=$FF then
        if tmarray[i+4]=$A0 then
         if tmarray[i+5]=$00 then
          begin
           Result:=BufToHexStr(@tmarray[i+8],$A0);
           exit;
          end;
  end;
         Form1._msg('Hash not found...:(');
end;

function DoSLUnlock():boolean;
var
//ini1:System.Text;
s: string;
i:integer;
MM:TMemoryStream;
DD:TFileStream;
begin
   Result:=false;
         imei_s:=ReadPhImei;
         if imei_s='Error' then exit;
         Form1._msg('Phone Imei: '+imei_s);
     if Generation='30' then begin
         Form1._msg('Infineon XGOLD phone found...');
         MM:=TMemoryStream.Create;
         s:=DoReadInfineon(MM);
       if s='Error' then begin MM.Free; exit; end;
        slt:=3;
        s1202:=s;
        s:=TryFindHases(MM);
        MM.Free;
        if s='Error' then exit;
        s1201:=s;
     end else begin
         Form1._msg('Checking locks...');
     if conmode=0 then checklock(getlockfield)
     else checklock(getlockdata);

     s:=PmReadRecord(120,2);

       if s='Error' then exit;
       if s='' then begin
         Form1._msg('PA_SL phone detected...');
         slt:=0;
         s308:=PmReadRecord(308,1);
         if s308='Error' then exit;
       end else if Length(s)=40 then begin
         Form1._msg('PA_SL2 phone detected...');
         slt:=1;
         s308:=PmReadRecord(308,1);
         if s308='Error' then exit;
       end else if Length(s)=260 then begin
         Form1._msg('PA_SL3 phone detected...');
         slt:=2;
         s1202:=s;
         s1200:=PmReadRecord(120,0);
         if s1200='Error' then exit;
         s1201:=PmReadRecord(120,1);
         if s1201='Error' then exit;
         s1203:=PmReadRecord(120,3);
         if s1203='Error' then exit;
       end else begin
         Form1._msg('SL N/A...');
         exit;
       end;

 case getid of
// 0: Form1._msg('Init Service mode Ok, can proceed...');  // All done
 1: begin Form1._msg('Init service mode fail :('); exit; end;// Init Service mode faled
 2: begin Form1._msg('Can'+#39+'t read Unique data! :('); exit; end; // ID read failed
 3: begin Form1._msg('UFSx error, reconnect and try again...'); exit; end; // Fail at all
 end;

       rap_s:=UkeyData.PID;
       hash_s:=UkeyData.Hash;
       uni_key:=UkeyData.key;
   end;
       case slt of
       2: Result:=DoSL3UplJob();
       3: Result:=DoInfJob();
       1: Result:=Sl2Unlock ;
       0: Result:=Sl2Unlock ;
       end;
end;

function ReadPhImei():string;
begin
      if ConMode =0 then Result:=UsbReadIMEIPl
        else Result:=FbusReadIMEIPl ;
end;

function AdrStr(c:char):string;
begin
             Result:=BookRecord.adress.PoBox+c+BookRecord.adress.ExAdr+c+BookRecord.adress.Street+c+
                BookRecord.adress.City+c+BookRecord.adress.State+c+BookRecord.adress.PostC+c+BookRecord.adress.Country;
end;

function Utf8ToQp (s:string) : string ;
var
 i: integer ;
begin
      Result:='';
      if s='' then exit;
      for i:=1 to Length (s) do begin
      if s[i] = '|' then s[i]:=';' ;
      if ((Ord(s[i]) >= $80) or (Ord(s[i])=$20)) then Result:=Result+'='+IntToHex(Ord(s[i]),1) // т.к. не все проги понимают
                else Result:=Result+s[i];                                               // строку в чистом Utf8
      end;
end;

procedure SaveVcf(fname:string;num:integer);
var
PMFile:System.Text;
s:string;
Len:integer;
begin
             System.Assign ( PMFile , fname+IntToStr(num)+'.vcf' ) ;
             System.Rewrite ( PMFile );
             System.WriteLn (PMFile, 'BEGIN:VCARD');                              //  Это заголовок
             System.WriteLn (PMFile, 'VERSION:2.1');                              //
             System.WriteLn (PMFile, 'N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:'+Utf8ToQp(BookRecord.Name)+';'+Utf8ToQp(BookRecord.SurName)+';;;');                        //  выводим
                 if BookRecord.OsnTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.OsnTelNum) do begin
                      if BookRecord.OsnTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.OsnTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL:'+s);
                      end;
             if BookRecord.HomTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.HomTelNum) do begin
                      if BookRecord.HomTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL;HOME:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.HomTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL;HOME:'+s);  //
                      end;
             if BookRecord.MobTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.MobTelNum) do begin
                      if BookRecord.MobTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL;CELL:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.MobTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL;CELL:'+s);  //
                      end;
             if BookRecord.FaxTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.FaxTelNum) do begin
                      if BookRecord.FaxTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL;FAX:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.FaxTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL;FAX:'+s);   //  выводим номера если они есть
                      end;
             if BookRecord.OthTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.OthTelNum) do begin
                      if BookRecord.OthTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.OthTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL:'+s);       //
                      end;
             if BookRecord.WorTelNum <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.WorTelNum) do begin
                      if BookRecord.WorTelNum[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'TEL;WORK:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.WorTelNum[Len];
                      end;
                      System.WriteLn (PMFile, 'TEL;WORK:'+s);
                      end;
             if BookRecord.adress.PoBox+BookRecord.adress.ExAdr+BookRecord.adress.Street+BookRecord.adress.City+BookRecord.adress.State+BookRecord.adress.PostC+BookRecord.adress.Country  <> '' then
                System.WriteLn (PMFile, 'ADR;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:'+Utf8ToQp(AdrStr(';')));    // выводим
     //        if StrAddrWork <> '' then   System.WriteLn (PMFile, 'ADR;WORK;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;'+StrAddrWork);    // выводим
             if BookRecord.Post <> '' then  System.WriteLn (PMFile, 'TITLE;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:'+Utf8ToQp(BookRecord.Post));   // оставшиеся
             if BookRecord.Company <> '' then   System.WriteLn (PMFile, 'ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:'+Utf8ToQp(BookRecord.Company)+';');// строковые значения если есть
             if BookRecord.emale <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.emale) do begin
                      if BookRecord.emale[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'EMAIL:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.emale[Len];
                      end;
                      System.WriteLn (PMFile, 'EMAIL:'+s);
                      end;
             if BookRecord.http <> '' then begin
                      s:='';
                      for Len:=1 to Length (BookRecord.http) do begin
                      if BookRecord.http[Len] = ' ' then begin
                               System.WriteLn (PMFile, 'URL:'+s);
                               s:='';
                               end
                        else s:=s+BookRecord.http[Len];
                      end;
                      System.WriteLn (PMFile, 'URL:'+s);
                      end;
             if BookRecord.note <> '' then   System.WriteLn (PMFile, 'NOTE;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:'+Utf8ToQp(BookRecord.note));// строковые значения если есть
             if BookRecord.Birthday <> '' then   System.WriteLn (PMFile, 'BDAY:'+Copy(BookRecord.Birthday,1,4)+Copy(BookRecord.Birthday,6,2)+Copy(BookRecord.Birthday,9,2));
             System.WriteLn (PMFile, 'END:VCARD');   // конец текущей записи Vcard
             System.Close (PMFile);
end;

procedure Rndmc;
begin
  OldX := GetTickCount;
end;

function Rndc(I: Integer): word;
var  X: Integer;
begin
  X := (35789 * OldX + 13849) mod 65536;
  OldX := X;
  X := X mod I;
  Result:=X and $FFFF;
end;

function SurNameconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.SurName);
      word(Buf^):=$47;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Nameconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.Name);
      word(Buf^):=$46;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function TTelconv(s:string;Buf:pointer;st:byte;m:word):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      word(Buf^):=$B;
      inc(Integer(Buf));
      inc(Integer(Buf));
      ws:=UTF8Decode(s);
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+10;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      word(Buf^):=m;
      inc(Integer(Buf));
      inc(Integer(Buf));
      word(Buf^):=$0;
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Postconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.Post);
      word(Buf^):=$54;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Compconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.Company);
      word(Buf^):=$55;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Nickconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.NickName);
      word(Buf^):=$56;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function OffNconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.OffName);
      word(Buf^):=$52;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Noteconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      ws:=UTF8Decode(BookRecord.note);
      word(Buf^):=$A;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Adconv(Buf:pointer;st:byte;m:byte;wd:WideString):pointer;
var
Len:byte;
Len1:word;
begin
      word(Buf^):=m;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Len:=(Length(wd) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@wd[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Twebeconv(s:string;Buf:pointer;st:byte;m:word):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      word(Buf^):=m;
      inc(Integer(Buf));
      inc(Integer(Buf));
      ws:=UTF8Decode(s);
      Len:=(Length(ws) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@ws[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function Adrconv(Buf:pointer;st:byte;j:byte):pointer;
var
Len:byte;
Len1:word;
ws:WideString;
begin
      word(Buf^):=$4A;
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=0;
      inc(Integer(Buf));
      byte(Buf^):=8;
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      word(Buf^):=0;
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=j;
      inc(Integer(Buf));
      if BookRecord.adress.ExAdr<>'' then begin
        Buf:=Adconv(Buf,st,$4B,UTF8Decode(BookRecord.adress.ExAdr));
      end;
      if BookRecord.adress.Street<>'' then begin
        Buf:=Adconv(Buf,st,$4C,UTF8Decode(BookRecord.adress.Street));
      end;
      if BookRecord.adress.City<>'' then begin
        Buf:=Adconv(Buf,st,$4D,UTF8Decode(BookRecord.adress.City));
      end;
      if BookRecord.adress.State<>'' then begin
        Buf:=Adconv(Buf,st,$4E,UTF8Decode(BookRecord.adress.State));
      end;
      if BookRecord.adress.PostC<>'' then begin
        Buf:=Adconv(Buf,st,$4F,UTF8Decode(BookRecord.adress.PostC));
      end;
      if BookRecord.adress.Country<>'' then begin
        Buf:=Adconv(Buf,st,$50,UTF8Decode(BookRecord.adress.Country));
      end;
      Result:=Buf;
end;

function Birdconv(Buf:pointer;st:byte):pointer;
var
Len:integer;
begin
      word(Buf^):=$57;
      inc(Integer(Buf));
      inc(Integer(Buf));
      word(Buf^):=$0C00;
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=st;
      inc(Integer(Buf));
      byte(Buf^):=0;
      inc(Integer(Buf));
      Val (Copy(BookRecord.Birthday,1,4),word(Buf^),Len);
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      Val (Copy(BookRecord.Birthday,6,2),byte(Buf^),Len);
      inc(Integer(Buf));
      Val (Copy(BookRecord.Birthday,9,2),byte(Buf^),Len);
      inc(Integer(Buf));
      word(Buf^):=0;
      inc(Integer(Buf));
      inc(Integer(Buf));
      Result:=Buf;
end;

function OldNameconv(Buf:pointer;st:byte):pointer;
var
Len:byte;
Len1:word;
wd:WideString;
begin
      word(Buf^):=$7;
      inc(Integer(Buf));
      inc(Integer(Buf));
      wd:='';
      if BookRecord.Name<>'' then wd:=UTF8Decode(BookRecord.Name);
      if BookRecord.SurName<>'' then if wd<>'' then wd:=wd+' '+UTF8Decode(BookRecord.SurName) else wd:=UTF8Decode(BookRecord.SurName);
      Len:=(Length(wd) shl 1)+2;
      Len1:=Len+6;
      if (Len1 and 3)<>0 then word(Buf^):=Len1+2 else word(Buf^):=Len1;
      WordSwap(Buf);
      inc(Integer(Buf));
      inc(Integer(Buf));
      byte(Buf^):=$3F;
      inc(Integer(Buf));
      byte(Buf^):=Len;
      inc(Integer(Buf));
      Result:=BufCopySwapWord(@wd[1],Buf,Len);
      if (Len1 and 3)<>0 then begin
        word(Result^):=0;
        inc(Integer(Result));
        inc(Integer(Result));
      end;
end;

function ConvNokPhb():string;
label n1,n2;
var
 i,Len,j:integer;
 s:string;
 Buf1:pointer;
begin
      for i:=0 to 16384 do Buf[i]:=$FF;
      Buf1:=@Buf[4];
      i:=0;
      if BookRecord.Name<>'' then begin
      i:=i+1;
      Buf1:=Nameconv(Buf1,i);
      end;
      if BookRecord.SurName<>'' then begin
      i:=i+1;
      Buf1:=SurNameconv(Buf1,i);
      end;
//      if BookRecord.Name+BookRecord.SurName<>'' then begin
//      i:=i+1;
//      Buf1:=OldNameconv(Buf1,i);
//      end;
      if BookRecord.OsnTelNum<>'' then begin
         BookRecord.OsnTelNum:=BookRecord.OsnTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.OsnTelNum) do begin
           if BookRecord.OsnTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,0);
              s:='';
           end
           else s:=s+BookRecord.OsnTelNum[Len];
         end;
      end;
      if BookRecord.MobTelNum<>'' then begin
         BookRecord.MobTelNum:=BookRecord.MobTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.MobTelNum) do begin
           if BookRecord.MobTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,3);
              s:='';
           end
           else s:=s+BookRecord.MobTelNum[Len];
         end;
      end;
      if BookRecord.HomTelNum<>'' then begin
         BookRecord.HomTelNum:=BookRecord.HomTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.HomTelNum) do begin
           if BookRecord.HomTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,2);
              s:='';
           end
           else s:=s+BookRecord.HomTelNum[Len];
         end;
      end;
      if BookRecord.WorTelNum<>'' then begin
         BookRecord.WorTelNum:=BookRecord.WorTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.WorTelNum) do begin
           if BookRecord.WorTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,6);
              s:='';
           end
           else s:=s+BookRecord.WorTelNum[Len];
         end;
      end;
      if BookRecord.FaxTelNum<>'' then begin
         BookRecord.FaxTelNum:=BookRecord.FaxTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.FaxTelNum) do begin
           if BookRecord.FaxTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,4);
              s:='';
           end
           else s:=s+BookRecord.FaxTelNum[Len];
         end;
      end;
      if BookRecord.OthTelNum<>'' then begin
         BookRecord.OthTelNum:=BookRecord.OthTelNum+' ';
         s:='';
         for Len:=1 to Length (BookRecord.OthTelNum) do begin
           if BookRecord.OthTelNum[Len] = ' ' then begin
              i:=i+1;
              Buf1:=TTelconv(s,Buf1,i,5);
              s:='';
           end
           else s:=s+BookRecord.OthTelNum[Len];
         end;
      end;
      if BookRecord.Post<>'' then begin
      i:=i+1;
      Buf1:=Postconv(Buf1,i);
      end;
      if BookRecord.Company<>'' then begin
      i:=i+1;
      Buf1:=Compconv(Buf1,i);
      end;
      if BookRecord.NickName<>'' then begin
      i:=i+1;
      Buf1:=Nickconv(Buf1,i);
      end;
      if BookRecord.OffName<>'' then begin
      i:=i+1;
      Buf1:=OffNconv(Buf1,i);
      end;
      if BookRecord.note<>'' then begin
      i:=i+1;
      Buf1:=Noteconv(Buf1,i);
      end;
      if BookRecord.emale<>'' then begin
         BookRecord.emale:=BookRecord.emale+' ';
         s:='';
         for Len:=1 to Length (BookRecord.emale) do begin
           if BookRecord.emale[Len] = ' ' then begin
              i:=i+1;
              Buf1:=Twebeconv(s,Buf1,i,8);
              s:='';
           end
           else s:=s+BookRecord.emale[Len];
         end;
      end;
      if BookRecord.http<>'' then begin
         BookRecord.http:=BookRecord.http+' ';
         s:='';
         for Len:=1 to Length (BookRecord.http) do begin
           if BookRecord.http[Len] = ' ' then begin
              i:=i+1;
              Buf1:=Twebeconv(s,Buf1,i,$2C);
              s:='';
           end
           else s:=s+BookRecord.http[Len];
         end;
      end;
      j:=0;
      if  BookRecord.adress.ExAdr<>'' then j:=j+1;
      if  BookRecord.adress.Street<>'' then j:=j+1;
      if  BookRecord.adress.City<>'' then j:=j+1;
      if  BookRecord.adress.Country<>'' then j:=j+1;
      if  BookRecord.adress.PostC<>'' then j:=j+1;
      if  BookRecord.adress.State<>'' then j:=j+1;
      if j<>0 then begin
      i:=i+1;
      Buf1:=Adrconv(Buf1,i,j);
      end;
     { if BookRecord.Birthday<>'' then begin
      i:=i+1;
      Buf1:=Birdconv(Buf1,i);
      end;    }
      word((@Buf[2])^):=i;
      WordSwap(@Buf[2]);
      word((@Buf[0])^):=0;
      i:=0;
      while word((@Buf[i])^)<>$FFFF do i:=i+1;
      word((@Buf[0])^):=i-2;
//             Form1._msg(BufToHexStr(@buf,i));
      Result:=BufToHexStr(@Buf[0],i);
end;

procedure S40SMSConv(M:TMemoryStream);
var
tm:TTimeStamp;
tm1: TDateTime;
t,i,Len,ln,j,k:integer;
s:string;
begin
    SMSRClear;
    M.Seek(0,soFromBeginning);
    if M.Size>$1FFF then exit;
    M.Read(Buf[0],M.Size);
    i:=$5E;
    k:=0;
    s:='';
    while word((@Buf[i])^)<>0 do begin
     WordSwap(@Buf[i]);
     i:=i+2;
     k:=k+1;
    end;
             SetLength (s,255);
             j:=UnicodeToUtf8(@s[1],255,@Buf[$5E],k);
             SetLength (s,j-1);
          SMSRec.Num:=s;
    i:=$B0;
    t:=Buf[i] and $F;
    if ((t=4) or (t=0)) then SMSRec.Typ:='0';
    if t=1 then SMSRec.Typ:='1';
    if SMSRec.Typ<>'' then begin
       if SMSRec.Typ='0' then begin
         s:='';
         i:=i+5;
         while not((word((@Buf[i])^)=$108) or (word((@Buf[i])^)=$100)) do i:=i+1;
//         if Buf[i-1]=$20 then i:=i-1;
//         i:=i+1;
         j:=Buf[i];
         s:=BufToHexStr(@Buf[i+1],7);
         tm1:=PduToDateTime(@s[1]);
         SMSRec.DatTim:= DateTimeToStr(tm1);
         i:=i+8;
         Len:=Buf[i];
         i:=i+1;
         if Len<>0 then begin
         if word((@Buf[i])^)=5 then begin
          i:=i+5;
          SMSRec.Part:=Chr(Buf[i]+$30)+' of '+Chr(Buf[i-1]+$30);
          Len:=Len-6;
          i:=i+1;
         end else SMSRec.Part:='1 of 1';
         if j=8 then begin
          ln:=Len shr 1;
          k:=0;
          for j:=0 to ln-1 do begin
           WordSwap(@Buf[i+k]);
           k:=k+2;
          end;
             SetLength (s,255);
             j:=UnicodeToUtf8(@s[1],255,@Buf[i],Ln);
             SetLength (s,j-1);
          SMSRec.Bod:=s;
         end;
         if j=0 then begin
           ln:=Len*7;
           k:=ln mod 8;
           ln:=ln div 8;
           if k<>0 then ln:=ln+1;
         s:=BufToHexStr(@Buf[i],ln);
         SMSRec.Bod:=PduToAscii(@s[1],Ln*2);
         SetLength(SMSRec.Bod,Len);
         end;
         end;
       end;
       if SMSRec.Typ='1' then begin
         s:='';
         i:=i+6;
         while Buf[i]<>0 do i:=i+1;
         i:=i+1;
         j:=Buf[i];
//         s:=BufToHexStr(@Buf[i+1],7);
//         tm1:=PduToDateTime(@s[1]);
//         SMSRec.DatTim:= DateTimeToStr(tm1);
//          Form1._msg(Utf8Decode(SMSRec.DatTim));
         i:=i+2;
         Len:=Buf[i];
         i:=i+1;
         if Len<>0 then begin
         if word((@Buf[i])^)=5 then begin
          i:=i+5;
          SMSRec.Part:=Chr(Buf[i]+$30)+' of '+Chr(Buf[i-1]+$30);
          Len:=Len-6;
          i:=i+1;
         end else SMSRec.Part:='1 of 1';
         if j=8 then begin
          ln:=Len shr 1;
          k:=0;
          for j:=0 to ln-1 do begin
           WordSwap(@Buf[i+k]);
           k:=k+2;
          end;
             SetLength (s,255);
             j:=UnicodeToUtf8(@s[1],255,@Buf[i],Ln);
             SetLength (s,j-1);
          SMSRec.Bod:=s;
         end;
         if j=0 then begin
           ln:=Len*7;
           k:=ln mod 8;
           ln:=ln div 8;
           if k<>0 then ln:=ln+1;
         s:=BufToHexStr(@Buf[i],ln);
         SMSRec.Bod:=PduToAscii(@s[1],Ln*2);
         SetLength(SMSRec.Bod,Len);
         end;
         end;
       end;
    end;
end;

procedure S60SMSConv(M:TMemoryStream);
var
tm:TTimeStamp;
tm1: TDateTime;
i:integer;
s:string;
begin
    SMSRClear;
    M.Seek(0,soFromBeginning);
    M.Read(Buf[0],4);
    if dword((@Buf[0])^)=$10003C68 then begin
    M.Read(Buf[0],4);
    i:=0;
    M.Read(Buf[0],M.Size-8);
     while i<M.Size-12 do begin
       if dword((@Buf[i])^)=$10003A25 then begin
         i:=i+5;
         s:='';
//         Form1._msg(BufToHexStr(@Buf[i+1],M.Size-i-9));
         if Buf[i]<>$0E then begin
          if Buf[i+1]<$20 then i:=i+2;
          if Buf[i]<$20 then i:=i+1;
           while Buf[i]<>$0E do begin
             if Buf[i]<$80 then s:=s+Chr(Buf[i]) else s:=s+Chr(Buf[i]+$30);
             i:=i+1;
           end;
         end;
         SMSRec.Bod:=s;
//         Form1._msg(Utf8Decode(AnsiToUtf8(s)));
//         Form1._msg(BufToHexStr(@Buf[i+1],M.Size-i-9));
         i:=i+1;
         if dword((@Buf[i])^)=$18342920 then begin
           i:=i+10;
           if Buf[i]=0 then begin
           tm:= MSecsToTimeStamp((Comp((@Buf[i+21])^)-32561990000000)/1000);
           tm1:= TimeStampToDateTime(tm);
           SMSRec.DatTim:= DateTimeToStr(tm1);
//           Form1._msg(SMSRec.DatTim);
             s:='';
             i:=i+32;
             while ((Buf[i]>$2A) and (Buf[i]<$3A)) do begin
               if Buf[i]<$80 then s:=s+Chr(Buf[i]) else s:=s+Chr(Buf[i]+$30);
               i:=i+1;
             end;
           SMSRec.Typ:='0';
//         Form1._msg(Utf8Decode(AnsiToUtf8(s)));
             i:=i+3;
             s:='';
             while Buf[i]<>0 do begin
               if Buf[i]<$80 then s:=s+Chr(Buf[i]) else s:=s+Chr(Buf[i]+$30);
               i:=i+1;
             end;
           SMSRec.Num:=s;
//         Form1._msg(Utf8Decode(AnsiToUtf8(s)));
           end else begin
           if dword((@Buf[i+18])^)<>0 then begin
           tm:= MSecsToTimeStamp((Comp((@Buf[i+18])^)-32561990000000)/1000);
           tm1:= TimeStampToDateTime(tm);
           SMSRec.DatTim:= DateTimeToStr(tm1);
           end;
//           Form1._msg(SMSRec.DatTim);
             s:='';
             i:=i+27;
             while ((Buf[i]>$2A) and (Buf[i]<$3A)) do begin
               if Buf[i]<$80 then s:=s+Chr(Buf[i]) else s:=s+Chr(Buf[i]+$30);
               i:=i+1;
             end;
           SMSRec.Num:=s;
//         Form1._msg(Utf8Decode(AnsiToUtf8(s)));
           SMSRec.Typ:='1';
           end;
         end;
       end;
       i:=i+1;
     end;
    end;
end;

procedure SMSRClear();
begin
     SMSRec.Typ:='';
     SMSRec.Num:='';
     SMSRec.Bod:='';
     SMSRec.DatTim:='';
     SMSRec.Part:='';
end;

procedure FileVersionInfo;
type
 PLangAndCodePage = ^TLangAndCodePage;
 TLangAndCodePage = packed record
   wLanguage: Word;
   wCodePage: Word;
 end;
var
 I, InfoSize, BlockLength: Cardinal;
 pInfo: Pointer;
 pLangCP: PLangAndCodePage;
 pDesc: PChar;
 FileName: string;
begin
 FileName:= ModName;
 InfoSize:= GetFileVersionInfoSize(PChar(FileName), Cardinal(nil^));
 if InfoSize <> 0 then
 begin
   GetMem(pInfo, InfoSize);
   try
     if GetFileVersionInfo(PChar(FileName), 0, InfoSize, pInfo) then
       if VerQueryValue(pInfo, '\VarFileInfo\Translation', Pointer(pLangCP), BlockLength) then
         for I := 0 to Pred(BlockLength div sizeof(TLangAndCodePage)) do
         begin                                                            //CompanyName,Legalcopyright
           if VerQueryValue(pInfo, PChar(Format('\StringFileInfo\%.4x%.4x\FileDescription',
            [pLangCP.wLanguage, pLangCP.wCodePage])), Pointer(pDesc), BlockLength) then
             FileDescription:= pDesc;
           Inc(pLangCP)
         end
   finally
     FreeMem(pInfo, InfoSize);
   end ;
 end ;
end;

function GetInetFile (const fileURL:string; M: TStream): boolean;
 const
   BufferSize = 4096;
 var
   hSession, hURL: HInternet;
   Buffer: array[1..BufferSize] of Byte;
   BufferLen: DWORD;
   f: File;
   sAppName: string;
 begin
  result := false;
  sAppName := 'BB5Tool.exe' ;
  hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
 try
   hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
   try
    repeat
     InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
     M.Write(Buffer, BufferLen);
    until BufferLen = 0;
    result := True;
   finally
    InternetCloseHandle(hURL);
   InternetCloseHandle(hSession);
   end
 Except
 Result:=false;
   InternetCloseHandle(hSession);
 end
 end;

function ScanProcess():boolean;
label ex;
var
  M:TMemoryStream;
  ph, snap: THandle; //дескрипторы процесса и снимка
  mh: hmodule; //дескриптор модуля
  procs: array[0..$FFF] of dword; //массив для хранения дескрипторов процессов
  count, cm: cardinal; //количество процессов
  i: integer;
  s:string;
  e:string;
  a,b:dword;
begin
    Result:=false;
//    exit;
    if not EnumProcesses(@procs, sizeof(procs), count) then exit;
    for i := 0 to count div 4 - 1 do
    begin
      ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        false, procs[i]);
      if ph > 0 then
      begin
        EnumProcessModules(ph, @mh, 4, cm);
        GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName));
        s:=(string(ModName));
           FileDescription:='';
           FileVersionInfo;
//         Form1._msg (FileDescription);
         s:=s+';'+FileDescription;
//         Form1._msg (s);
        CloseHandle(ph);
       if Pos('USBlyzer',s)<>0 then begin Result:=true; e:='00'; goto ex; end;
       if Pos('USB Protocol Analyzer',s)<>0 then begin Result:=true;e:='01'; goto ex; end;
       if Pos('USBTrace',s)<>0 then begin Result:=true; e:='02';goto ex; end;
       if Pos('studio.exe',s)<>0 then begin Result:=true;e:='03'; goto ex; end;
//       if Pos('Device Monitor',s)<>0 then begin Result:=true; e:='04'; goto ex; end;
       if Pos('Device Monitoring',s)<>0 then begin Result:=true;e:='05'; goto ex; end;
       if Pos('Snoopy',s)<>0 then begin Result:=true; e:='06'; goto ex; end;
       if Pos('SnoopyPro',s)<>0 then begin Result:=true; e:='07'; goto ex; end;
       if Pos('Sniff',s)<>0 then begin Result:=true; e:='08'; goto ex; end;
       if Pos('SniffUSB',s)<>0 then begin Result:=true; e:='09'; goto ex; end;
       if Pos('ftusbrdwks',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('ftusbsrvc',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('usbmonitor',s)<>0 then begin Result:=true; e:='12'; goto ex; end;
       if Pos('usbclient',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('usbrdwks',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('ausbmon',s)<>0 then begin Result:=true; e:='15'; goto ex; end;
       if Pos('USB Monitor Pro',s)<>0 then begin Result:=true; e:='16'; goto ex; end;
       if Pos('HHD Software',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('Device Monitoring Studio',s)<>0 then begin Result:=true; e:='18'; goto ex; end;
       if Pos('USBly',s)<>0 then begin Result:=true; e:='19'; goto ex; end;
       if Pos('ftusbmon',s)<>0 then begin Result:=true; e:='20'; goto ex; end;
       if Pos('USB filter',s)<>0 then begin Result:=true; e:='21'; goto ex; end;
       if Pos('Port Monitor',s)<>0 then begin Result:=true; e:='22'; goto ex; end;
       if Pos('232Analyzer',s)<>0 then begin Result:=true; e:='23'; goto ex; end;
       if Pos('aspmon',s)<>0 then begin Result:=true; e:='24'; goto ex; end;
       if Pos('VisualUsb',s)<>0 then begin Result:=true; e:='25'; goto ex; end;
       if Pos('Visual USB',s)<>0 then begin Result:=true; e:='26'; goto ex; end;
       if Pos('USB over Network',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('USB for Remote',s)<>0 then begin Result:=true; e:='27'; goto ex; end;
       if Pos('dede',s)<>0 then begin Result:=true; e:='29'; goto ex; end;
       if Pos('DeDe',s)<>0 then begin Result:=true; e:='30'; goto ex; end;
       if Pos('ollydbg',s)<>0 then begin Result:=true; e:='31'; goto ex; end;
       if Pos('Analysing Debugger',s)<>0 then begin Result:=true; e:='32'; goto ex; end;
{       if Pos('',s)<>0 then begin Result:=true; exit; end;
       if Pos('',s)<>0 then begin Result:=true; exit; end;
       if Pos('',s)<>0 then begin Result:=true; exit; end;
       if Pos('',s)<>0 then begin Result:=true; exit; end;
       if Pos('',s)<>0 then begin Result:=true; exit; end;
}
      end;
    end;
ex:
    if Result then begin

      if e<>'27' then CardDestroy;
      M:=TMemoryStream.Create;
      if not GetInetFile('http://www.bb5tool.com/bad/bed.php?data='+fullid+e,M) then begin M.Free; exit; end;;
      M.Free;
      exit;
    end;
end;

procedure PlainRplPar(RS:TStrings);
var
i:integer;
sn,sv:string;
begin
   RPLRClear;
   for i:=0 to RS.Count-1 do begin
   sn:='';
   sv:='';
   if ((Pos('DATA',RS.Strings[i])<> 0) and (Pos('=',RS.Strings[i])<> 0)) then begin
     RS.NameValueSeparator:='=';
     sn:=RS.Names[i];
     sv:=RS.ValueFromIndex[i];
     if Pos ('NPC',sn)<>0 then RPLRecord.NPC:=RPLRecord.NPC+sv;
     if Pos ('CCC',sn)<>0  then RPLRecord.CCC:=RPLRecord.CCC+sv;
     if Pos ('HWC',sn)<>0  then RPLRecord.HWC:=RPLRecord.HWC+sv;
     if Pos ('SIMLOCK_DATA',sn)<>0  then RPLRecord.SIMLOCK:=RPLRecord.SIMLOCK+sv;
     if Pos ('SIMLOCK_KEY',sn)<>0 then RPLRecord.SIMLOCK_KEY:=RPLRecord.SIMLOCK_KEY+sv;
     if Pos ('SUPERDONGLE_KEY',sn)<>0  then RPLRecord.SUPERDONGLE_KEY:=RPLRecord.SUPERDONGLE_KEY+sv;
     if Pos ('CMLA_KEY',sn)<>0  then RPLRecord.CMLA_KEY:=RPLRecord.CMLA_KEY+sv;
     if Pos ('WMDRM_PD',sn)<>0  then RPLRecord.WMDRM_PD:=RPLRecord.WMDRM_PD+sv;
     if Pos ('VARIANT',sn)<>0  then RPLRecord.variant:=RPLRecord.Variant+sv;
   end;
   end;
end;

procedure RPLRClear();
begin
     RPLRecord.NPC:='';
     RPLRecord.CCC:='';
     RPLRecord.HWC:='';
     RPLRecord.SIMLOCK:='';
     RPLRecord.SIMLOCK_KEY:='';
     RPLRecord.SUPERDONGLE_KEY:='';
     RPLRecord.CMLA_KEY:='';
     RPLRecord.WMDRM_PD:='';
     RPLRecord.Variant:='';
end;


procedure GetDriveList(s:string;dl:TStrings);
var
i,j,k,Len:integer;
st:string;
begin
     StrToBufHex(s,@Buf);
     j:=Buf[5];
     i:=6;
     for k:=0 to j-1 do begin
      st:=Chr(Buf[i+1]);
      st:=st+':';
      i:=i+5;
      Len:=Buf[i];
      if Len=0 then Len:=1;
      i:=i+1;
      while Len<>0 do begin
       if Buf[i+1]<>0 then st:=st+Chr(Buf[i+1]);
       Len:=Len-1;
       i:=i+2;
      end;
     dl.Add(st);
     end;
end;

function LCDSetPat(pat:word):string;
begin
  if ConMode =0 then Result:=UsbSetPat(pat) else Result:=FbusSetPat(pat);
end;

function FullFactorySet():Boolean;
begin
  if ConMode =0 then Result:=UsbFullFactorySet else Result:=FbusFullFactorySet;
end;

function SWupgrDef():Boolean;
begin
  if ConMode =0 then Result:=UsbSWupgrDef else Result:=FbusSWupgrDef;
end;

function ServiceCentreDef():Boolean;
begin
  if ConMode =0 then Result:=UsbServiceCentreDef else Result:=FbusServiceCentreDef;
end;

function PrdTuneSet():Boolean;
begin
  if ConMode =0 then Result:=UsbPrdTuneSet else Result:=FbusPrdTuneSet;
end;

function UserDefSet():Boolean;
begin
  if ConMode =0 then Result:=UsbUserDefSet else Result:=FbusUserDefSet;
end;

function LeaveFactSet():Boolean;
begin
  if ConMode =0 then Result:=UsbLeaveFactSet else Result:=FbusLeaveFactSet;
end;

function PhOnComPresent():boolean;
begin
    Result:=false;
    if fbdev=0 then begin
    If hCom = INVALID_HANDLE_VALUE then
     if OpenCom(false) = false then exit;
     end;
     if FbusSendSynk = false then exit;
      if FbusChkMode >$F0 then exit else Result:=true;
end;

function WritePPItem(Item:byte;Data:byte):string;
begin
     if ConMode =0 then Result:=UsbWritePPItem(Item,Data) else Result:=FbusWritePPItem(Item,Data) ;
end;

function ReadPPItem(Item:byte):string;
begin
     if ConMode =0 then Result:=UsbReadPPItem(Item) else Result:=FbusReadPPItem(Item);
end;

function PmWriteRecBuf(Field:word;Rec:word;Buf:Pointer;Len:word):string;
begin
     if ConMode =0 then Result:=UsbPmWriteRecBuf(Field,Rec,Buf,Len) else Result:=FbusPmWriteRecordBuf(Field,Rec,Buf,Len);
end;

function PmWriteRecord(Field:word;Rec:word;s:string):string;
begin
     if (Form1.sk308.Checked and ((Field=120) or (Field=308))) then begin Result:='Skiped'; exit; end; 
     if ConMode =0 then Result:=UsbPmWriteRecord(Field,Rec,s) else Result:=FbusPmWriteRecord(Field,Rec,s);
end;

procedure S60PassExtr(m:TMemoryStream);
var
i,j,k,Len:integer;
st:string;
begin
     m.Seek(0,soFromBeginning);
     i:=m.Size;
     m.Read(Buf,i);
     j:=0;
     while j<i do begin
      j:=j+20;
      Len:=Buf[j-1];
        SetLength (st,255);
        k:=UnicodeToUtf8(@st[1],255,@Buf[j],(Len shr 1));
        SetLength (st,k-1);
        PassStr.Add(st);
      j:=j+Len;
     end;
end;

function S40PassExtr(s:string):string;
var
i,Len:integer;
st:string;
begin
     StrToBufHex(s,@Buf);
     i:=16;
     Len:=Buf[32] shr 1;
     if Len=0 then while word((@Buf[i+Len*2])^)<>0 do Len:=Len+1;
        SetLength (st,255);
        i:=UnicodeToUtf8(@st[1],255,@Buf[16],Len);
        SetLength (st,i-1);
     Result:='';
     for i:=1 to Length(st) do if st[i]=Chr($20) then Result:=Result+'[space]' else Result:=Result+st[i];
end;

procedure S40NewCalEx();
var
i,j,k,l,len,col,com,ls:integer;
s:string;
begin
     ClearCalRec;
     i:=20;
     col:=Buf[19];
     for j:=0 to col-1 do begin
       com:=word((@Buf[i])^);
       WordSwap(@Buf[i+2]);
       len:=word((@Buf[i+2])^);
         case com of
          $0101:begin
                 WordSwap(@Buf[i+6]);
                 CalRec.Num:=IntToStr(word((@Buf[i+6])^));
                end;
          $0301:begin
                 case Buf[i+7] of
                  1: CalRec.Typ:='Meeting';
                  2: CalRec.Typ:='Call';
                  3: CalRec.Typ:='Birthday';
                  4: CalRec.Typ:='Note';
                  5: CalRec.Typ:='Memo';
                  6: CalRec.Typ:='Anniversary';
                 end;
                end;
          $0B01:begin
                 WordSwap(@Buf[i+6]);
                 CalRec.DateBeth.Year:=IntToStr(word((@Buf[i+6])^));
                end;
          $0102:begin
                 WordSwap(@Buf[i+4]);
                 ls:=word((@Buf[i+4])^);
                 l:=0;
                   for k:=0 to ls-1 do begin
                     WordSwap(@Buf[i+6+l]);
                     l:=l+2;
                   end;
                 SetLength (s,255);
                 l:=UnicodeToUtf8(@s[1],255,@Buf[i+6],ls);
                 SetLength (s,l-1);
                 CalRec.Note:= s; //Utf8ToAnsi(s) ;
                end;
          $0202:begin
                 WordSwap(@Buf[i+4]);
                 ls:=word((@Buf[i+4])^);
                 l:=0;
                   for k:=0 to ls-1 do begin
                     WordSwap(@Buf[i+6+l]);
                     l:=l+2;
                   end;
                 SetLength (s,255);
                 l:=UnicodeToUtf8(@s[1],255,@Buf[i+6],ls);
                 SetLength (s,l-1);
                 CalRec.Reason:= s; //Utf8ToAnsi(s) ;
                end;
          $0302:begin
                 WordSwap(@Buf[i+4]);
                 ls:=word((@Buf[i+4])^);
                 l:=0;
                   for k:=0 to ls-1 do begin
                     WordSwap(@Buf[i+6+l]);
                     l:=l+2;
                   end;
                 SetLength (s,255);
                 l:=UnicodeToUtf8(@s[1],255,@Buf[i+6],ls);
                 SetLength (s,l-1);
                 CalRec.Venue:= s; //Utf8ToAnsi(s) ;
                end;
          $0402:begin
                 WordSwap(@Buf[i+4]);
                 ls:=word((@Buf[i+4])^);
                 l:=0;
                   for k:=0 to ls-1 do begin
                     WordSwap(@Buf[i+6+l]);
                     l:=l+2;
                   end;
                 SetLength (s,255);
                 l:=UnicodeToUtf8(@s[1],255,@Buf[i+6],ls);
                 SetLength (s,l-1);
                 CalRec.Tel:= s; //Utf8ToAnsi(s) ;
                end;
          $0103:begin
                 WordSwap(@Buf[i+4]);
                 CalRec.Date1.Year:=IntToStr(word((@Buf[i+4])^));
                 CalRec.Date1.Day:=IntToStr(Buf[i+7]);
                 CalRec.Date1.Month:=IntToStr(Buf[i+6]);
                 CalRec.DateBeth.Day:=IntToStr(Buf[i+7]);
                 CalRec.DateBeth.Month:=IntToStr(Buf[i+6]);
                 CalRec.Date1.Hour:=IntToStr(Buf[i+8]);
                 CalRec.Date1.Min:=IntToStr(Buf[i+9]);
                end;
          $0203:begin
                 WordSwap(@Buf[i+4]);
                 CalRec.Date2.Year:=IntToStr(word((@Buf[i+4])^));
                 CalRec.Date2.Day:=IntToStr(Buf[i+7]);
                 CalRec.Date2.Month:=IntToStr(Buf[i+6]);
                 CalRec.Date2.Hour:=IntToStr(Buf[i+8]);
                 CalRec.Date2.Min:=IntToStr(Buf[i+9]);
                end;
          $0303:begin
                 WordSwap(@Buf[i+4]);
                 CalRec.Date3.Year:=IntToStr(word((@Buf[i+4])^));
                 CalRec.Date3.Day:=IntToStr(Buf[i+7]);
                 CalRec.Date3.Month:=IntToStr(Buf[i+6]);
                 CalRec.Date3.Hour:=IntToStr(Buf[i+8]);
                 CalRec.Date3.Min:=IntToStr(Buf[i+9]);
                end;
          $0403:begin
                 WordSwap(@Buf[i+4]);
                 CalRec.Date4.Year:=IntToStr(word((@Buf[i+4])^));
                 CalRec.Date4.Day:=IntToStr(Buf[i+7]);
                 CalRec.Date4.Month:=IntToStr(Buf[i+6]);
                 CalRec.Date4.Hour:=IntToStr(Buf[i+8]);
                 CalRec.Date4.Min:=IntToStr(Buf[i+9]);
                end;
          $FF03:begin
                 WordSwap(@Buf[i+4]);
                 CalRec.Date5.Year:=IntToStr(word((@Buf[i+4])^));
                 CalRec.Date5.Day:=IntToStr(Buf[i+7]);
                 CalRec.Date5.Month:=IntToStr(Buf[i+6]);
                 CalRec.Date5.Hour:=IntToStr(Buf[i+8]);
                 CalRec.Date5.Min:=IntToStr(Buf[i+9]);
                end;
         end;
       i:=i+len;
     end;
end;

procedure S40CalExtr(s:string);
begin
     ClearCalRec;
     StrToBufHex(s,@Buf);
     NokiaCalConvert;
end;

procedure S40PhbExtr(s:string);
begin
     ClearRec;
     StrToBufHex(s,@Buf);
     NokiaTRCnv (@Buf);
end;

procedure NokiaCalConvert ();
var
s:string;
Len:word;
i,tm,typ,Poz:integer;
begin
    ClearCalRec;
       CalRec.Num:=IntToStr(dword((@Buf[0])^));
       CalRec.Date1.Year:=IntToStr(word((@Buf[4])^));
       CalRec.Date1.Month:=IntToStr(Buf[6]);
       CalRec.Date1.Day:=IntToStr(Buf[7]);
       CalRec.Date1.Hour:=IntToStr(Buf[8]);
       CalRec.Date1.Min:=IntToStr(Buf[9]);
       i:=0;
       if word((@Buf[18])^)=0 then i:=4;
       if word((@Buf[18])^)=1 then if word((@Buf[16])^)=1 then i:=4 ;
        typ:= word((@Buf[18+i])^);
        CalRec.Date2.Year:=IntToStr(word((@Buf[24+i])^));
        CalRec.Date2.Month:=IntToStr(Buf[26+i]);
        CalRec.Date2.Day:=IntToStr(Buf[27+i]);
        CalRec.Date2.Hour:=IntToStr(Buf[28+i]);
        CalRec.Date2.Min:=IntToStr(Buf[29+i]);
        case typ of
        $8:CalRec.Typ:='Note';
       $80:CalRec.Typ:='Call';
        $4:begin
            CalRec.Typ:='Birthday';
             if word((@Buf[40+i])^)=$FFFF then CalRec.DateBeth.Year:=CalRec.Date1.Year
              else CalRec.DateBeth.Year:=IntToStr(word((@Buf[40+i])^));
             CalRec.DateBeth.Day:=CalRec.Date1.Day;
             CalRec.DateBeth.Month:=CalRec.Date1.Month;
           end;
      $200: CalRec.Typ:='Memo';
        $1:begin
             CalRec.Typ:='Meeting';
             Len:=word((@Buf[50+i])^);
             Poz:= word((@Buf[46+i])^)*2;
             SetLength(s,1024);
             tm:=UnicodeToUtf8(@s[1],255,@Buf[56+i+Poz],Len);
             SetLength (s,tm-1);
             CalRec.Venue := s; //Utf8ToAnsi(s) ;
           end;
        $2:begin
             CalRec.Typ:='Call';
             Len:=word((@Buf[50+i])^);
             Poz:= word((@Buf[46+i])^)*2;
             SetLength(s,1024);
             tm:=UnicodeToUtf8(@s[1],255,@Buf[56+i+Poz],Len);
             SetLength (s,tm-1);
             CalRec.Tel := s; //Utf8ToAnsi(s) ;
           end;
        end;
            Len:=word((@Buf[46+i])^);
            SetLength(s,1024);
            tm:=UnicodeToUtf8(@s[1],255,@Buf[56+i],Len);
            SetLength (s,tm-1);
            CalRec.Note := s; //Utf8ToAnsi(s) ;
end;

procedure ClearCalRec ();
begin
      CalRec.Date1.Hour:='';
      CalRec.Date1.Min:='';
      CalRec.Date1.Day:='';
      CalRec.Date1.Month:='';
      CalRec.Date1.Year:='';
      CalRec.Date2.Hour:='';
      CalRec.Date2.Min:='';
      CalRec.Date2.Day:='';
      CalRec.Date2.Month:='';
      CalRec.Date2.Year:='';
      CalRec.Date3.Hour:='';
      CalRec.Date3.Min:='';
      CalRec.Date3.Day:='';
      CalRec.Date3.Month:='';
      CalRec.Date3.Year:='';
      CalRec.Date4.Hour:='';
      CalRec.Date4.Min:='';
      CalRec.Date4.Day:='';
      CalRec.Date4.Month:='';
      CalRec.Date4.Year:='';
      CalRec.Date5.Hour:='';
      CalRec.Date5.Min:='';
      CalRec.Date5.Day:='';
      CalRec.Date5.Month:='';
      CalRec.Date5.Year:='';
      CalRec.DateBeth.Hour:='';
      CalRec.DateBeth.Min:='';
      CalRec.DateBeth.Day:='';
      CalRec.DateBeth.Month:='';
      CalRec.DateBeth.Year:='';
      CalRec.Num:='';
      CalRec.Typ:='';
      CalRec.Note:='';
      CalRec.Venue:='';
      CalRec.Reason:='';
      CalRec.Tel:='';
end;

procedure ClearRec();
begin
           BookRecord.Name := '' ;
           BookRecord.SurName := '' ;
           BookRecord.OffName := '' ;
           BookRecord.NickName := '' ;
           BookRecord.Post := '' ;
           BookRecord.Company := '' ;
           BookRecord.Birthday := '' ;
           BookRecord.OsnTelNum := '' ;
           BookRecord.HomTelNum := '' ;
           BookRecord.MobTelNum := '' ;
           BookRecord.FaxTelNum := '' ;
           BookRecord.WorTelNum := '' ;
           BookRecord.OthTelNum := '' ;
           BookRecord.emale := '' ;
           BookRecord.ptt := ''  ;
           BookRecord.http := ''  ;
           BookRecord.userid := '' ;
           BookRecord.note := '' ;
           BookRecord.idgroup := '' ;
           BookRecord.adress.PoBox:='';
           BookRecord.adress.ExAdr:='';
           BookRecord.adress.Street:='';
           BookRecord.adress.City:='';
           BookRecord.adress.State:='';
           BookRecord.adress.PostC:='';
           BookRecord.adress.Country:='';
end;

procedure NokiaTRCnv (Buf:pointer) ;
var
  len,len1,tm,tm1,i,j,tip,nln,k,CoR1,CoR : integer;
  com,com1 : byte ;
  tmpn,tmpn1 : pointer ;
  s : string ;
begin
         CoR:=byte(Buf^);
         inc (integer(Buf));
  for j:=1 to CoR do begin
       len:=word (Buf^);
       inc (integer(Buf));
       inc (integer(Buf));
       com := byte(Buf^);
       inc (integer(Buf));
       inc (integer(Buf));
       tmpn:=Buf;
    case com of
     $7 : begin
        tm1 := len shr 1;
        dec (integer(Buf));
        if byte(Buf^) = $3f then begin
         inc (integer(Buf));
         inc (integer(Buf));
         inc (integer(Buf));
         tm1 := tm1-1;
        end
        else inc (integer(Buf));
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.Name := s; //Utf8ToAnsi(s) ;
     end ;
     $B : begin
        tip:=byte (Buf^);
        inc (integer(Buf));
        inc (integer(Buf));
        nln:=byte (Buf^);
        if nln =0 then begin
          inc (integer(Buf));
          inc (integer(Buf));
          nln:=byte (Buf^);
          end
          else begin
          inc (integer(Buf));
          inc (integer(Buf));
          if byte (Buf^)<> 0 then begin
          dec (integer(Buf));
          dec (integer(Buf));
          end;
          nln:=byte (Buf^);
          end;
        if nln =0 then begin
          inc (integer(Buf));
          inc (integer(Buf));
          nln:=byte (Buf^);
          end;
        tm:=nln and 1;
        nln:=nln+tm;
        nln:=nln shr 1 ;
        inc (integer(Buf));
        s:=BufToHexStr(Buf,nln);
        for i:=1 to Length (s) do begin
           if s[i] = 'A' then s[i]:='0';
           if s[i] = 'B' then s[i]:='*';
           if s[i] = 'C' then s[i]:='#';
           if s[i] = 'D' then s[i]:='p';
           if s[i] = 'E' then s[i]:='w';
           if s[i] = 'F' then s[i]:='+';
           end;
           SetLength (s,(Length(s)-tm));
        case tip of
              0 : if BookRecord.OsnTelNum = '' then BookRecord.OsnTelNum:= s
                     else BookRecord.OsnTelNum := BookRecord.OsnTelNum + ' '+s;
              1 : if BookRecord.OsnTelNum = '' then BookRecord.OsnTelNum:= s
                     else BookRecord.OsnTelNum := BookRecord.OsnTelNum + ' '+s;
              2 : if BookRecord.HomTelNum = '' then BookRecord.HomTelNum:= s
                     else BookRecord.HomTelNum := BookRecord.HomTelNum + ' '+s;
              3 : if BookRecord.MobTelNum = '' then BookRecord.MobTelNum:= s
                     else BookRecord.MobTelNum := BookRecord.MobTelNum + ' '+s;
              4 : if BookRecord.FaxTelNum = '' then BookRecord.FaxTelNum:= s
                     else BookRecord.FaxTelNum := BookRecord.FaxTelNum + ' '+s;
              5 : if BookRecord.OthTelNum = '' then BookRecord.OthTelNum:= s
                     else BookRecord.OthTelNum := BookRecord.OthTelNum + ' '+s;
              6 : if BookRecord.WorTelNum = '' then BookRecord.WorTelNum:= s
                     else BookRecord.WorTelNum := BookRecord.WorTelNum + ' '+s;
              10 : if BookRecord.OsnTelNum = '' then BookRecord.OsnTelNum:= s
                     else BookRecord.OsnTelNum := BookRecord.OsnTelNum + ' '+s;
              12 : if BookRecord.OthTelNum = '' then BookRecord.OthTelNum:= s
                     else BookRecord.OthTelNum := BookRecord.OthTelNum + ' '+s;
              end;
     end ;
     $55 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.Company := s; //Utf8ToAnsi(s) ;
        end ;
     $54 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.Post := s; //Utf8ToAnsi(s) ;
        end ;
     $56 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.NickName := s ; //Utf8ToAnsi(s) ;
        end ;
     $52 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.OffName := s; //Utf8ToAnsi(s) ;
        end ;
     $47 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.SurName := s ; //Utf8ToAnsi(s) ;
        end ;
     $46 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.Name := s; //Utf8ToAnsi(s) ;
        end ;
     $A : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        if BookRecord.note = '' then BookRecord.note:= s
        else BookRecord.note:= BookRecord.note+' '+s;
        end ;
     $9 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.Street := s; //Utf8ToAnsi(s) ;
        end ;
    $2C : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        if BookRecord.http = '' then BookRecord.http:= s
        else BookRecord.http:= BookRecord.http+' '+s;
        end ;
     $3F : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        if BookRecord.ptt = '' then BookRecord.ptt:= s
        else BookRecord.ptt:= BookRecord.ptt+' '+s;
        end ;
     $8 : begin
        tm1 := len shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        if BookRecord.emale = '' then BookRecord.emale:= s
        else BookRecord.emale:= BookRecord.emale+' '+s;
        end ;
     $38 : begin
        tm1:=len-4;
        tm1 := tm1 shr 1;
        SetLength (s,255);
        inc (integer(Buf));
        inc (integer(Buf));
        inc (integer(Buf));
        inc (integer(Buf));
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.userid := s; //Utf8ToAnsi(s) ;
        end;
     $57 : begin
        BookRecord.Birthday:=IntToStr(word(Buf^))+'.';
        inc (integer(Buf));
        inc (integer(Buf));
        s:=IntToStr(byte(Buf^));
        if Length(s)<>2 then s:='0'+s;
        BookRecord.Birthday:=BookRecord.Birthday+s+'.';
        inc (integer(Buf));
        s:=IntToStr(byte(Buf^));
        if Length(s)<>2 then s:='0'+s;
        BookRecord.Birthday:=BookRecord.Birthday+s;
        end;
     $43 : begin
        tm1 := word (Buf^);
         case tm1 of
         1 : BookRecord.idgroup := 'Famile' ;
         2 : BookRecord.idgroup := 'VIP' ;
         3 : BookRecord.idgroup := 'Frend' ;
         4 : BookRecord.idgroup := 'Work' ;
         else BookRecord.idgroup := 'Other' ;
         end ;
        end ;
     $1E : begin
        tm1 := byte (Buf^);
         case tm1 of
         1 : BookRecord.idgroup := 'Famile' ;
         2 : BookRecord.idgroup := 'VIP' ;
         3 : BookRecord.idgroup := 'Frend' ;
         4 : BookRecord.idgroup := 'Work' ;
         else BookRecord.idgroup := 'Other' ;
         end ;
        end ;
     $4A : begin
        CoR1 := word (Buf^);
        inc (integer(Buf));
        inc (integer(Buf));
  for k:=1 to CoR1 do begin
       len1:=word (Buf^);
       inc (integer(Buf));
       inc (integer(Buf));
       com1 := byte(Buf^);
       inc (integer(Buf));
       inc (integer(Buf));
       tmpn1:=Buf;
    case com1 of
     $4B : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.ExAdr :=s; //Utf8ToAnsi(s) ;
        end ;
     $4C : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.Street :=s; //Utf8ToAnsi(s) ;
        end ;
     $4D : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.City :=s; //Utf8ToAnsi(s) ;
        end ;
     $4E : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.State :=s; //Utf8ToAnsi(s) ;
        end ;
     $4F : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.PostC :=s; //Utf8ToAnsi(s) ;
        end ;
     $50 : begin
        tm1 := len1 shr 1;
        SetLength (s,255);
        tm:=UnicodeToUtf8(@s[1],255,Buf,tm1);
        SetLength (s,tm-1);
        BookRecord.adress.Country :=s; //Utf8ToAnsi(s) ;
        end ;
    end;
        Buf:=tmpn1;
        for i:=1 to len1 do inc (integer(Buf));
    end;
    end ;
    end;
        Buf:=tmpn;
        for i:=1 to len do inc (integer(Buf));
  end;
end;

function S40PhbWrite(Buf:pointer;Len:word):string;
begin
     if ConMode =0 then Result:=UsbS40PhbRecWr(Buf,Len) else Result:=FbusS40PhbRecWr(Buf,Len);
end;

function PmReadRecordBuf(Buf:pointer;Field:word;Rec:word):word;
begin
     Result:=StrToBufHex(PmReadRecord(Field,Rec),Buf);
end;

function PmReadRecordWithOutCheck(Field:word;Rec:word;Len:dword):string;
begin
     if ConMode =0 then Result:=UsbPmReadRecord(Field,Rec,Len) else Result:=FbusPmReadRecord(Field,Rec,Len);
end;

function PmReadRecord(Field:word;Rec:word):string;
var
Len:dword;
begin
     Result:='';
     if PmGetRecCou(Field)= 0 then exit;
     Len:=PmGetRecLen (Field,Rec);
     if Len>=$F0000000 then begin Result:='Error'; exit; end;
     if ConMode =0 then Result:=UsbPmReadRecord(Field,Rec,Len) else Result:=FbusPmReadRecord(Field,Rec,Len);
end;

function GetS40PhbRecord(RecNum:word):string;
begin
     if ConMode =0 then Result:=UsbGetS40PhbRecord(RecNum) else Result:=FbusGetS40PhbRecord(RecNum);
end;

function GetS40PhbCou():integer;
begin
     if ConMode =0 then Result:=UsbGetS40PhbCou() else Result:=FbusGetS40PhbCou();
end;

function PmGetRecLen(Field:word;Rec:word):dword;
begin
     if ConMode =0 then Result:=UsbPmGetRecLen(Field,Rec) else Result:=FbusPmGetRecLen(Field,Rec);
end;

function PmGetRecCou(Field:word):integer;
begin
     if ConMode =0 then Result:=UsbPmGetRecCou(Field) else Result:=FbusPmGetRecCou(Field);
end;

function SetPhMode(mode:string):string;
var
imode:integer;
begin
  imode:=1;
  if mode='Local' then imode:=5;
  if mode='Test' then imode:=4;
      if ConMode =0 then Result:=UsbSetPhoneMode(imode)
        else Result:=FbusSetPhoneMode(imode) ;
end;

function SetCheckPhModeInt(imode:integer):string;
var
i:integer;
s:string;
begin
  Result:='Error';
      if ConMode =0 then begin
       UsbSetPhoneMode(imode);
       i:=100;
       s:= ReadPhMode;
       while ((s <> 'Error') and( i<>0)) do begin
       sleep (100);
       //if catchdevice=$02 then begin result:='Error'; Exit; end;
       i:=i-1;
       s:= ReadPhMode;
       end;
       if s=PhModeToStr(imode) then begin Result:=s; exit; end;
    sleep(1000);
    i:=100;
    USBClosePort;
     while ((not DevPresent) and (i<>0)) do begin
      Application.ProcessMessages;
      sleep (1000);
      Application.ProcessMessages;
      i:=i-1;
     end;
   end
   else
   begin
     FbusSetPhoneMode(imode) ;
     sleep(1000);
     i:=60;
     while ((not PhOnComPresent) and (i<>0)) do begin
       PurgeCom(PURGE_TXCLEAR or PURGE_RXCLEAR);
      sleep (1000);
      i:=i-1;
     end;
     Sleep(1000);
    // FbusrunCommand(@checkmode, Length(checkmode));
     //if fbusansB[
     //form1._msg(buftohexstr(@fbusstr[1], Length(FbusStr)));
   end;
   sleep (500);
       PurgeCom(PURGE_TXCLEAR or PURGE_RXCLEAR);
   restrtphone2;
   Result:= ReadPhMode;
end;

function SetCheckPhModeStr(mode:string):string;
var
imode:integer;
begin
  imode:=1;
  if mode='Local' then imode:=5;
  if mode='Test' then imode:=4;
  Result:=SetCheckPhModeInt(imode);
end;

function ReadPhMode():string;
begin
      if ConMode =0 then Result:=UsbReadPhMode
        else Result:=FbusReadPhMode ;
end;

function ReadPhoneInfoAll():boolean;
var
i:integer;
begin
     Result:=false;
     PhInfoClear;
     if ConMode =0 then USBReadPhInfoAll else FbusReadPhInfoAll;
     Result:=true;
end;

function ChkBlankSt(s:string):string;
var
i:integer;
begin
 Result:='';
 for i:=1 to Length(s) do if s[i]<Chr($20) then Result:=Result+' ' else Result:=Result+s[i];
end;

function ReadPhoneInfo():boolean;
var
i:integer;
begin
     Result:=false;
     PhInfoClear;
     if ConMode =0 then USBReadPhInfo else FbusReadPhInfo;
     Result:=true;
end;


end.





