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= $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 i0 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$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 j0 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]