VERSION 5.00 Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Begin VB.Form XDAmanipulator BorderStyle = 1 'Fixed Single Caption = "XDA manipulator" ClientHeight = 4230 ClientLeft = 45 ClientTop = 435 ClientWidth = 7500 BeginProperty Font Name = "Courier New" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "XDAmanipulator.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4230 ScaleWidth = 7500 StartUpPosition = 3 'Windows Default Begin VB.CommandButton Help Caption = "Help" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6240 TabIndex = 17 Top = 3690 Width = 1095 End Begin VB.CheckBox Lock8 Appearance = 0 'Flat BackColor = &H00CCFFFF& Caption = "Keep first 8 digits the same" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 255 Left = 2040 TabIndex = 15 ToolTipText = "Highly recommended!!!" Top = 3240 Value = 1 'Checked Visible = 0 'False Width = 2895 End Begin VB.CommandButton reset_counters Caption = "reset" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4185 TabIndex = 12 Top = 3690 Visible = 0 'False Width = 975 End Begin VB.CommandButton unlock_GID Caption = "unlock" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4185 TabIndex = 10 Top = 2325 Visible = 0 'False Width = 975 End Begin VB.CommandButton unlock_SID Caption = "unlock" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4185 TabIndex = 9 Top = 1845 Visible = 0 'False Width = 975 End Begin VB.CommandButton update_IMEI Caption = "update" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 4185 TabIndex = 8 Top = 2820 Visible = 0 'False Width = 975 End Begin VB.TextBox IMEI Appearance = 0 'Flat BackColor = &H00FFFFFF& BorderStyle = 0 'None Height = 240 Left = 2055 MaxLength = 14 TabIndex = 5 Top = 2880 Visible = 0 'False Width = 1710 End Begin MSCommLib.MSComm MSComm1 Left = 6960 Top = 1200 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True Handshaking = 2 BaudRate = 115200 End Begin VB.Label lSearching BackStyle = 0 'Transparent Caption = $"XDAmanipulator.frx":030A BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 855 Left = 720 TabIndex = 18 Top = 2040 Width = 6135 End Begin VB.Label version BackStyle = 0 'Transparent Caption = "v1.11" Height = 255 Left = 6840 TabIndex = 19 Top = 0 Width = 615 End Begin VB.Label URL BackStyle = 0 'Transparent Height = 375 Left = 0 MouseIcon = "XDAmanipulator.frx":03A8 MousePointer = 99 'Custom TabIndex = 16 Top = 0 Width = 3255 End Begin VB.Label Timers BackStyle = 0 'Transparent Height = 255 Left = 2040 TabIndex = 14 Top = 3720 Width = 1695 End Begin VB.Label Label6 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Call timers:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 720 TabIndex = 13 Top = 3705 Visible = 0 'False Width = 1095 End Begin VB.Label Luhn_digit BackStyle = 0 'Transparent Height = 375 Left = 3750 TabIndex = 11 ToolTipText = "This is a ""check-digit"". It's automatically calculated, and cannot directly be changed" Top = 2880 Visible = 0 'False Width = 255 End Begin VB.Label GIDlock BackStyle = 0 'Transparent Height = 255 Left = 2040 TabIndex = 7 Top = 2400 Width = 1695 End Begin VB.Label SIDlock BackStyle = 0 'Transparent Height = 255 Left = 2025 TabIndex = 6 Top = 1920 Width = 1815 End Begin VB.Label Label5 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "IMEI:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 720 TabIndex = 4 Top = 2865 Visible = 0 'False Width = 1095 End Begin VB.Label Label4 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "GID lock: " BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 720 TabIndex = 3 Top = 2385 Visible = 0 'False Width = 1095 End Begin VB.Label Label3 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "SID lock: " BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 720 TabIndex = 2 Top = 1905 Visible = 0 'False Width = 1095 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Status: " BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 720 TabIndex = 1 Top = 1425 Width = 1095 End Begin VB.Label lStatus BackStyle = 0 'Transparent BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2025 TabIndex = 0 Top = 1425 Width = 5415 End Begin VB.Image Image1 Height = 4500 Left = 0 Picture = "XDAmanipulator.frx":04FA Top = 0 Width = 7500 End End Attribute VB_Name = "XDAmanipulator" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'used for loading URLs into browser Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 'Keep the original IMEI for restoration of first 8 digits. Needed accross functions Dim OrigIMEI As String Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Ctrl-R If KeyCode = vbKeyR And Shift = 2 Then DumpRom "c:\RS-x-xx.bin" End If End Sub Private Sub Form_Load() 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$ = "" 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$ = "" 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 = "" reset_counters.Visible = False Else Timers.Caption = "" 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 "" '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 = "" 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 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 bytes from the phone memory at , 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 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