xdamanipulator.frm

XDAmanipulator The cab file for your application

On Error Resume Next

    'Center form on screen.
    Me.Left = (Screen.Width / 2) - (Me.Width / 2)
    Me.Top = (Screen.Height / 2) - (Me.Height / 2)

    Me.Show
    
    StatusMsg "Scanning COM ports"

    ' Scans COM ports 1-8. Tries to open the port (error cycles to next port) and then

    XDAconnected = False
    
    Do Until XDAconnected

        For n% = 1 To 8
        
            DoEvents
            
            Err = 0
        
            MSComm1.CommPort = n%
            MSComm1.PortOpen = True
            
            If Err Then GoTo nextloop:
                             
            'Output a Carriage Return on serial port referenced by MSComm1
            'If within two seconds the string "FW " comes back, we conclude
            'it's an XDA in Wallaby Bootloader mode
            If SendExpect(Chr$(13), "FW ", 2) Then
                'lSearching is the explanation text to tell the user
                'to hook up an XDA in bootloader mode.
                lSearching.Visible = False
                StatusMsg "Found an XDA in Bootloader mode on COM" + Trim$(Str$(n%))
                
                'In that case, send "dualser" to talk to the modem
                'and wait for the response before exiting the loop
                If SendExpect("dualser" + Chr$(13), "AT-Command Interpreter ready", 8) Then
                    'we turn echo off to make block operations faster: we don't need
                    'to see what we just sent.
                    d$ = ATcmd("ATE0")
                    StatusMsg "Modem Ready"
                    XDAconnected = True
                    Exit For
                End If
            End If
            
            'Could be that the phone is already in modem mode.
            'In that case, jump out as well
            If ATcmd("AT+GMI") = "HTC" Then
                'lSearching is the explanation text to tell the user
                'to hook up an XDA in bootloader mode.
                lSearching.Visible = False
                StatusMsg "Modem Ready"
                XDAconnected = True
                Exit For
            End If
        
nextloop:

            MSComm1.PortOpen = False
    
        Next
        
    Loop
    
    Label3.Visible = True
    Label4.Visible = True
    Label5.Visible = True
    Label6.Visible = True
    
    ReadPhone
    
End Sub
Sub StatusMsg(s$)

    'Displays a message in the lStatus text label
    
    lStatus.Caption = s$
    DoEvents

End Sub
Sub ReadPhone()

    'This is the routine that gets all the data for the main dialog
    'and puts it in the appropriate controls.
        
    StatusMsg "Reading data from phone"
        
    'Get the SID unlock code. The data is actually returned in the
    'order in which it needs to be typed into the phone... :)
    'The phone stores the SIDlock at 0x3FE00C, and stores 0xFFFFFFFF
    'if the lock is off.
    d$ = Right$(ATcmd("AT%UREG?3fe00c,4"), 8)
    If d$ = "ERROR" Then
        d$ = GetFourTwenty()
        FourTwenty = True
    End If
        
    unlock_SID.Visible = True
        
    If Left$(d$, 8) = "FFFFFFFF" Then
        unlock_SID.Visible = False
        d$ = "<none>"
    End If
    
    If d$ = "ERROR" Then
        unlock_SID.Visible = False
    End If
    
    SIDlock.Caption = d$
    
    
    'same as above for the GID lock
    d$ = Right$(ATcmd("AT%UREG?3fe010,4"), 8)
    If d$ <> "ERROR" Then
        If d$ = "FFFFFFFF" Then
            unlock_GID.Visible = False
            d$ = "<none>"
        Else
            unlock_GID.Visible = True
        End If
        GIDlock.Caption = d$
    Else
        GIDlock.Caption = ""
        Label4.Visible = False
        unlock_GID.Visible = False
    End If
    
    'The call duration counters are stored in the 8k block starting
    'at 0x3F6000. After every call, a 4 byte record is written after the
    'last one, with 2 bytes for incoming call total and 2 bytes for outgoing,
    'all measured in seconds.
    'The first four bytes possibly holds the number of times the 8k block
    'has filled up and gotten wiped, the second four are probably offsets,
    'because 0xFFFF seconds is only 18 hours.
    'Here we only check whether the first record is written or not, or,
    'in other words, whether the duration timers are set to zero or not
    a$ = ATcmd("AT%UREG?3F600C,4")
    If a$ <> "ERROR" Then
        If Right$(a$, 8) = "FFFFFFFF" Then
            Timers.Caption = "<zero>"
            reset_counters.Visible = False
        Else
            Timers.Caption = "<non-zero>"
            reset_counters.Visible = True
        End If
    Else
        Timers.Caption = ""
        reset_counters.Visible = False
        Label6.Visible = False
    End If
    
    
    'We read the IMEI here. The IMEI is stored in two locations. Once as
    'ASCII, and once as BCD. We read the ASCII version here, and we
    'calculate the check digit ourselves using the Luhn algorithm.
    'We then read the check digit from the ROM, and see if it matches.
    'We also check the BCD version against the ASCII version, and we check
    'whether the ASCII version contains only digits.
    'As an added bonus, we also check the HTC check digits stroed with the
    'strings in ROM.
    
    'In other words: we try to make very sure the IMEI is where we think it is.
    
    'If any of these tests fail, we disable changes and display "<ERROR>"
    'instead of the IMEI. Better safe than sorry...
    
    'The OrigIMEI is kept in case people 're-lock' the first 8 digits,
    'so we can restore them to their original.
    If Not FourTwenty Then
        OrigIMEI$ = ReadROM(&H3F8354, 14)
        IMEI.Visible = True
    
        If IsAllDigits(OrigIMEI$) And _
        Luhn(OrigIMEI$) = ReadROM(&H3F8362, 1) And _
        ReadROM(&H3F8352, 1) = Chr$(HTCchecksum(ReadROM(&H3F8353, 21))) And _
        BCD(OrigIMEI$) = ReadROM(&H3F800A, 7) And _
        ReadROM(&H3F8008, 1) = Chr$(HTCchecksum(ReadROM(&H3F8009, 9))) Then
            
            Luhn_digit.Visible = True
            IMEI.Text = OrigIMEI$
            IMEI.SelStart = 15
            Lock8.Visible = True
            update_IMEI.Visible = False
            IMEI.SetFocus
    
        Else
            IMEI.Text = "<error>"
            IMEI.BackColor = &HCCFFFF
            IMEI.Enabled = False
            update_IMEI.Visible = False
    
        End If
    Else
        Label5.Visible = False
    End If
            
    StatusMsg "Ready"

End Sub
Function GetFourTwenty() As String
Dim temp, r1, r2 As Long

    'Attempts to Read the unlock code from the phone in case the 'normal' method
    'returned an error. This uses the special tricks to bypass the AT%UREG limitation
    'and unlock-code obfuscation built into RSU 4.20
    
    
    '----------------- Explanation ----------------------------------------------------------
    'First of all, they check to see whether the %UREG request lies within certain bounds
    'as follows:

    'AT%UREG?addr,len:

    'if (addr < 0x3ef000 || addr > 0x3ef007) return(0);
    'if ((addr+len) < 0x3ef000 || (addr+len) > 0x3ef007) return(0);

    'Now because addr en len are both 32 bits, we can make use of the wrap (negative in effect).
    'After the test above the maximum length will be limited to 100 (0x64).

    'So for instance:

    'AT%UREG?3FE004,FFFFFFFF

    'will read 100 bytes from 0x3FE004. The output will look like this:

    '+EXT_UREG FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
    'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF33DE33DEAF30AF30FF
    'FFFFFFFFFF00000000FFFFFFFF00B00270

    'After 74 bytes of FF, the obfuscated result code is displayed. The information needed to
    'get the unlock code is contained twice, in the format ABCDABCDEFGHEFGH if a different
    'letter is assigned to each unique nibble. Nibbles are first swapped to make EHAFGBCD.
    'Then bits 3 of nibbles H, F and B are rotated left, so that nibble H gets bit 3 from F
    'and so forth. After this, the whole 4 byte value is rotated into the lower bit. The
    'result is the 8 digit unlock code in BCD, which can be supplied to the unlock command.
    '-----------------------------------------------------------------------------------------
    
    a$ = ATcmd("AT%UREG?3fe004,ffffffff")
    
    'get the right part (ABCDEFGH)
    o$ = Mid$(a$, 163, 8)
    
    a = Val("&h" + Mid$(o$, 1, 1))
    b = Val("&h" + Mid$(o$, 2, 1))
    c = Val("&h" + Mid$(o$, 3, 1))
    d = Val("&h" + Mid$(o$, 4, 1))
    e = Val("&h" + Mid$(o$, 5, 1))
    f = Val("&h" + Mid$(o$, 6, 1))
    g = Val("&h" + Mid$(o$, 7, 1))
    h = Val("&h" + Mid$(o$, 8, 1))
    
    'shift the bit-3's
    h3 = h And 8
    h = (h And 7) Or (f And 8)
    f = (f And 7) Or (b And 8)
    b = (b And 7) Or h3
    
    'Put it into two words, performing the swaps
    r1 = (g * (16 ^ 3)) + (b * (16 ^ 2)) + (c * (16 ^ 1)) + d
    r2 = (e * (16 ^ 3)) + (h * (16 ^ 2)) + (a * (16 ^ 1)) + f
    
    'rotate left made most difficult (long is 32 bit signed and this is VB)
    temp = (r1 \ 2) Or ((r2 And 1) * 32768)
    r2 = (r2 \ 2) Or ((r1 And 1) * 32768)
    r1 = temp
    
    GetFourTwenty = Right$("0000" + Trim$(Hex(r2)), 4) + Right$("0000" + Trim$(Hex(r1)), 4)
    
    
End Function
Function BCD(i$) As String

    'Takes input as a string of digits, and returns a string of half that number
    'of bytes, coded as BCD (Currently only takes even number of digits. This is
    'OK for us, since IMEI without check digit is 14 digits.)
    
    o$ = ""
    For n% = 1 To Len(i$) - 1 Step 2
            v = Val(Mid$(i$, n%, 1)) + (16 * Val(Mid$(i$, n% + 1, 1)))
            o$ = o$ + Chr$(v)
    Next n%
    
    BCD = o$

End Function
Function IsAllDigits(i$) As Boolean

    'This function takes astring and returns TRUE if the string contains
    'only digits, false otherwise. Used for IMEI sanity check.
    
    For n% = 1 To Len(i$)
        If Mid$(i$, n%, 1) < "0" Or Mid$(i$, n%, 1) > "9" Then
            IsAllDigits = False
            Exit Function
        End If
    Next
    IsAllDigits = True
    
End Function

Function ReadROM(address, length)

    'Reads the ROM at the given address, and returns <length> bytes as a string
    '(I know: there's much nicer data types for binary blocks these days. But
    'they didn't exist yet when I learned VB, and nobody is paying me to make
    'this readable. So shut up, and be happy it's commented at all.)

    'AT%UREG does strange things if the offset is odd, so we subtract one from the
    'start address and read a byte more if we start at an odd byte
    If address Mod 2 = 1 Then
        address = address - 1
        length = length + 1
        oddone = True
    Else
        oddone = False
    End If
    
    d$ = ""
    For X = address To address + length - 1 Step &H40
        remainder = address + length - X
        If remainder > &H40 Then
            remainder = &H40
        End If
            
        d$ = d$ + ATUREG(X, remainder)
        
        DoEvents
        
    Next
    
    'if the start address was odd, we forget the first byte
    If oddone Then
        d$ = Mid$(d$, 2)
    End If
    
    If Len(d$) > length Then
        d$ = Left$(d$, length)
    End If
    
    ReadROM = d$

End Function
Function ATUREG(offset, length) As String

    'Gets <length> bytes from the phone memory at <offset>, and puts them in a string.
    'Meant to be called only by ReadROM, which should be used for ROM access.
    'ATUREG can only start at even bytes, but this has been fixed in ReadROM

    Do
        
        ' AT%UREG only reads an even number of bytes
        lentoaskfor% = Int((length + 1) / 2) * 2
        
        a$ = ATcmd("AT%UREG?" + Trim$(Hex$(offset)) + "," + Trim$(Hex$(lentoaskfor%)))

        X% = InStr(a$, "+EXT_UREG ")
        
        l$ = ""
        If X% > 0 Then
            a$ = Mid$(a$, X% + 10)
            If Len(a$) = lentoaskfor% * 2 Then
                For m% = 1 To length
                    l$ = l$ + Chr$(Val("&H" + Mid$(a$, Len(a$) - (m% * 2) + 1, 2)))
                    'the +1 is because strings start at 1 and not at 0
                Next
            End If
        End If
        
    'Repeat the whole thing if we missed bytes.
    Loop Until Len(l$) = length
        
    ATUREG = l$

End Function