xdamanipulator.frm

XDAmanipulator The cab file for your application

Sub WriteROM(address, w$)

    'Writes binary data in the string at the given address
    'We write in chunks of 4 bytes, because the modem doesn't seem
    'to like it any bigger.

    For n% = 0 To Len(w$) - 1 Step 4
    
        d$ = ""
        For m% = 3 To 0 Step -1
            d$ = d$ + Right$("00" + Trim$(Hex$(Asc(Mid$(w$, n% + 1 + m%, 1)))), 2)
            'the +1 is because the string starts at 1 and not at 0
        Next m%
            
        ATcmd ("AT%UREG=" + Trim$(Hex$(address + n%)) + "," + d$ + ",4")
        'Debug.Print "AT%UREG=" + Trim$(Hex$(address + n%)) + "," + d$ + ",4"
        
    Next n%

End Sub

Function Luhn(X$) As String

    'Calculates Luhn checksum over string of digits.
    'See http://staff.semel.fi/~kribe/document/luhn.htm
    'or do a Google search.
    
    temp = 0
    a = 0
    i = 0
    l = Len(X$)
    
    For i = 1 To l
        a = Val(Mid$(X$, l + 1 - i, 1))
        
        If i Mod 2 = 0 Then
            temp = temp + a
        Else
            a = 2 * a
            If a > 9 Then
                a = Val(Left(Trim$(Str$(a)), 1)) + Val(Right(Trim$(Str$(a)), 1))
            End If
            temp = temp + a
        End If
        
    Next i
    
    Luhn = Right$(Trim$(Str$(10 - (temp Mod 10))), 1)

End Function

Function SendExpect(o$, i$, t%) As Boolean
    'Sends o$ to the serial port referenced by MSComm1
    'and waits t% seconds for i$ to come back. Returns
    'TRUE if it does, FALSE if it does not.

    d$ = ""
    start = Timer
    MSComm1.Output = o$
    Do Until Timer - start > t%
            
        DoEvents
            
        If MSComm1.InBufferCount Then
            d$ = d$ + MSComm1.Input
        End If
    
        If InStr(d$, i$) Then
            SendExpect = True
            Exit Function
        End If
        
    Loop
    
    SendExpect = False
    
End Function

Function ATcmd(cmd$) As String
    'Sends the given AT command to the modem, returns the result.

    d$ = ""
    start = Timer
    MSComm1.Output = cmd$ + Chr$(13)
    Do Until Timer - start > 3
    
        DoEvents
            
        If MSComm1.InBufferCount Then
            d$ = d$ + MSComm1.Input
        End If
    
        X% = InStr(d$, "OK" + Chr$(13))
        If X% > 2 Then
        
            d$ = Left$(d$, X% - 2)
            
            If Left$(d$, Len(cmd$)) = cmd$ Then
                d$ = Mid$(d$, Len(cmd$) + 2)
            End If
            
            d$ = Replace(d$, Chr$(13), "")
            d$ = Replace(d$, Chr$(10), "")
            
            ' Debug.Print "ATcmd = " + d$
            ATcmd = d$
            Exit Do
        Else
            If X% = 1 Then
                ATcmd$ = ""
                Exit Do
            End If
        End If
        
        If InStr(d$, "ERROR") Then
            ATcmd$ = "ERROR"
            Exit Do
        End If
    Loop

End Function

Private Sub Form_Unload(Cancel As Integer)

    End

End Sub


Private Sub Help_Click()
    
    'Go to the XDA manipulator page when the Help button is clicked
    ShellExecute hwnd, "open", "http://xda-developers.com/manipulator", vbNullString, vbNullString, SW_NORMAL

End Sub

Private Sub IMEI_Change()
    
    If IsAllDigits(IMEI.Text) Then
    
        'Update the IMEI check digit every time something is changed.
        Luhn_digit.Caption = Luhn(IMEI.Text)
        
        'Turn on the update button once IMEI has been changed in the textbox
        update_IMEI.Visible = True
        
    End If

End Sub

Private Sub IMEI_KeyPress(KeyAscii As Integer)

    

    Select Case KeyAscii
    'backspace replaces character left of carrot with 0 and moves left.
    Case 8
        If IMEI.SelStart > (Lock8.Value * 8) Then
            IMEI.SelStart = IMEI.SelStart - 1
            IMEI.SelLength = 1
            IMEI.SelText = "0"
            IMEI.SelLength = 0
            IMEI.SelStart = IMEI.SelStart - 1
        End If
        KeyAscii = 0
        
    'digits overtype
    Case &H30 To &H39
        If IMEI.SelStart < 15 And IMEI.SelStart >= (Lock8.Value * 8) Then
            IMEI.SelLength = 1
            IMEI.SelText = Trim$(Chr$(KeyAscii))
            IMEI.SelLength = 0
        End If
        KeyAscii = 0
        
    'nothing else works
    Case Else
        KeyAscii = 0
    End Select

End Sub


Private Sub Lock8_Click()

    'display a warning if people want to change the forst 8 IMEI digits
    'and restore the original 8 digits if they turn the lock back on.
    If Lock8.Value = 0 Then
        MsgBox "Warning, we do not recommend changing the first 8 digits of the IMEI", vbExclamation, "Warning !"
        IMEI.SetFocus
    Else
        IMEI.Text = Left$(OrigIMEI, 8) + Right$(IMEI.Text, 6)
        IMEI.SetFocus
    End If

End Sub

Private Sub reset_counters_Click()

    'Reset the call duration counters. Erases the entire 8k block at 0x3F6000
    'and puts in a 01 and a bunch of zeroes for virgin counters.

    d$ = ATcmd("AT%ERASE=3f6000")
    d$ = ATcmd("AT%UREG=3f6000,0001,2")
    d$ = ATcmd("AT%UREG=3f6002,0000,2")
    d$ = ATcmd("AT%UREG=3f6004,0000,2")
    d$ = ATcmd("AT%UREG=3f6006,0000,2")
    d$ = ATcmd("AT%UREG=3f6008,0000,2")
    d$ = ATcmd("AT%UREG=3f600A,0000,2")
    
    ReadPhone
    
End Sub

Private Sub unlock_GID_Click()

    'Do the AT command with the code to unlock the GID lock
    '(mind the difference with SIDlock: 'sidlck' vs. 'lckgid'
    
    d$ = ATcmd("at%lckgid=0," + GIDlock.Caption)
    ReadPhone
    
End Sub

Private Sub unlock_SID_Click()
    
    'Do the AT command with the code to unlock the SID code
    '(mind the difference with GIDlock: 'sidlck' vs. 'lckgid'

    d$ = ATcmd("at%sidlck=0," + SIDlock.Caption)
    ReadPhone

End Sub

Private Sub update_IMEI_Click()

    'Here we do the most risky thing: First we read data from an entire 8k block holding
    'lots of data. Then we change the IMEI both in ASCII and BCD and set the correct
    'checksum bytes. Then we erase the block, and write the changed version back.
    'Scary shit....
    
    'The +1's in the Mid$ are because strings start at 1 not at 0

    If Len(IMEI.Text) = 14 Then
    
        'turn off all buttons and controls while this is happening
        Me.Enabled = False
    
        StatusMsg "Reading block ..."
        
        'Read the 8k block to datablock$
        datablock$ = ReadROM(&H3F8000, &H2000)
        
        'The ASCII version at 0x354 (relative to block, really 0x3F8354)
        Mid$(datablock$, &H354 + 1, 15) = IMEI.Text + Luhn_digit.Caption
        Mid$(datablock$, &H352 + 1, 1) = Chr$(HTCchecksum(Mid$(datablock$, &H353 + 1, 21)))
        
        'the BCD version at 0x0A (0x3F800A)
        Mid$(datablock$, &HA + 1, 7) = BCD(IMEI.Text)
        Mid$(datablock$, &H8 + 1, 1) = Chr$(HTCchecksum(Mid$(datablock$, &H9 + 1, 9)))
        
        StatusMsg "Erasing block ..."
        d$ = ATcmd("AT%ERASE=3f8000")
        
        'This takes a littl long. Should do progress indication...
        StatusMsg "Writing block ...   (do not interrupt)"
        WriteROM &H3F8000, datablock$
                
        StatusMsg "IMEI changed"
        
        'After the IMEI has been changed in the phone, the update button
        'disappears until changes are made in the textbox again.
        update_IMEI.Visible = False
        
        'turn everything back on
        Me.Enabled = True
    
    End If

End Sub
Function HTCchecksum(s$) As Byte

    'Calculate the string checksum for this modem

    check = 0
    For n% = 1 To Len(s$)
        check = check + Asc(Mid$(s$, n%, 1))
    Next
    HTCchecksum = (check And &HFF) Xor &HFF

End Function

Private Sub URL_Click()

    'Go to our site when the URL label is clicked.
    ShellExecute hwnd, "open", "http://xda-developers.com", vbNullString, vbNullString, SW_NORMAL

End Sub
Sub Restore8k()
    
    'this routine restores the 8k block starting at 0x3F8000
    'using the data from the "c:\8kbackup" file. This routine
    'is meant to be called in debug applications only, and is
    'included for the daring ones that want to play around.
    
    'We needed this a few times, and the modem seems pretty
    'forgiving if the whole block sits empty for a few minutes.
    '(Although it did make us nervous, and we did not dare turn
    'it off)
    
    'This routine is never called in the distributed version.


    'Reads the backup file. Don't tell me: 1 byte at a time
    'isn't very efficient. So sue me...
    Open "c:\8kbackup.bin" For Binary As 2
    i$ = ""
    Do While Not EOF(2)
        i$ = i$ + Input(1, #2)
    Loop
    datablock$ = i$
    
    StatusMsg "Writing block ..."
    
    WriteROM &H3F8000, datablock$
    
    StatusMsg "Done ..."

End Sub

Sub DumpRom(f$)

    'Dumps the entire ROM to a file.
    
    'This routine is never called from release version.
    
    stat$ = "Listing ROM contents to " + f$
    
    StatusMsg stat$
    
    Err = 0
    Open f$ For Output As #2
    If Err = 0 Then
    
        Help.SetFocus
        Me.Enabled = False

        
        For X = 0 To &H3FFFFF Step &H40
        
            Print #2, ATUREG(X, &H40);
            
            DoEvents
            
            If X Mod &H8000 = 0 Then
                StatusMsg stat$ + "   (" + Trim$(Str$(Int((X / &H400000) * 100))) + "%)"
            End If
            
        Next
        
        Close #2
        
        StatusMsg "Done"
        
        Me.Enabled = True
        
    Else
        
        StatusMsg "Could not open " + f$ + " for writing"
        
    End If
    
    
End Sub