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; 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 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; 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; if (Form1.StatusBar.Panels.Items[4].Text = 'Test') or (Form1.statusbar.Panels.Items[4].text = 'Local') then Form1._msg('Operating mode is OK, no need change...') else 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); if (Form1.StatusBar.Panels.Items[4].Text = 'Test') or (Form1.statusbar.Panels.Items[4].text = 'Local') then Form1._msg('Operating mode is OK, no need change...') else 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 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; 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.