me parece que el abq no se resetea.Iniciado por presario2500
me parece que ablas del motorrrrolla
me parece que el abq no se resetea.
me parece que ablas del motorrrrolla
A ver si le puedes echar un vistazo a este
su nombre es v27 ultimate unloop
'NEW Mod #4 by johnnyL!! Good luck.
'
' Modified and renamed by No1b4me to include unlooper option
'
' INS 5C & 7F Glitch Routine
'
' Glitches into cards using INS 5C.
' Glitches 7F cards.
'
' Requirements: INS5C7F Atmel code to work!!!
'
' Anonymous
'
' Special thanks go to AOL6945 and especially CLIPGRP, both of whom without their help
' this would not be possible.
'
'
Option Explicit
Const dss_DefaultButton1 = 0
Const dss_DefaultButton2 = 256
Const dss_DefaultButton3 = 512
Const fsoError = -1
Const fsoOpenRead = 0
Const fsoOpenWrite = 1
Const fsoOpenReadWrite = 2
Const fsoSEEK_SET = 0
Const fsoSEEK_CUR = 1
Const fsoSEEK_END = 2
Const FileFilter = "All Eprom Files (*.bin, *.crd)|*.bin;*.crd;|Bin Files (*.bin)|*.bin|Crd Files (*.crd)|*.crd|All (*.*)|*.*"
Dim OutFile
Dim InFile
Dim HUBinFile
Dim ZipCode
Dim Guide
Dim HexZipCode1
Dim HexZipCode2
Dim HexZipCode3
Dim HexTimeZone
Dim DefaultTZButton
Dim DefaultDaylightButton
Dim TimeZone
Dim Daylight
Dim CodeProtection
Dim ScriptStart
Dim ScriptEnd
Dim glttl
Dim chglch
Dim d0,D1,D2,D3,D4,D5,D6,D7,D8,d9
Sub Main()
Dim ErrorString
Dim MenuPrompt
Dim Choice
Dim PromptString
Dim RetVal
Dim GotInput
Dim ThisChar
Dim Version
Dim Password
Sc.Verbose = 0
chglch = 0
d0 = 0
glttl = 0
If Sc.Version < 4.5 Then
ErrorString = "You need version 4.5 or greater of WinExplorer to run this script"
Sc.MsgBox ErrorString, vbCritical
Err.Raise 1050, , ErrorString
End If
if ChipVer <> 1 then
sc.MsgBox("You need chip version UL4S to run this script" & VbCr & "Flash your chip with the Included UL4S code")
Exit Sub
end if
Do
MenuPrompt = " Modifed version of No1B4me's script--HU Unlooper and INS5C & 7F Glitch Loader/Cleaner ! " & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " This should unloop HU cards faster as the random glitch range was shortened." & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " Run this script for a couple mins.. if not unlooped .. then abort script and rerun it." & vbCrLf
MenuPrompt = MenuPrompt & " May take a couple restarts. Good luck!" & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " Watch for the valid ATR responses.. 3F 7F ...when u see a lot of those.. You are on the right track." & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " *** P.S. if card unloops and u select a bin to write to card and it says ->in use.. select another bin" & vbCrLf
MenuPrompt = MenuPrompt & " or close winexplorer then reopen and rerun script." & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " Big shout out to No1B4me and unatester..Awesome work!" & vbCrLf & vbCrLf
MenuPrompt = MenuPrompt & " Please choose from the following menu choices:"
Choice = Sc.ButtonBox(MenuPrompt, 0, " HU Unlooper and INS5C & 7F Glitch Loader No1B4me script edited by johnnyL!", "Unloop", "Exit")
Select Case Choice
Case "1"
RetVal = 3
call IsCardPresent()
if(GetATR = True) then
RetVal=Sc.ButtonBox("This card appears to have a good ATR"& VbCr &"Unloop anyway", vbDefaultButton2 + vbQuestion, "Unlooper", "Yes", "No")
if RetVal = 1 then RetVal = 3
End if
if RetVal = 3 then
HUBinfile = False
if(BootCard())= 1 then
sc.print VbCr & "Select a good eeprom bin to write to the card" & VbCr
Call GetFile()
If HUBinFile = True then
Call WriteCard()
call ShowAtr()
else
Fs.FileClose(InFile)
end if
end if
end if
Case "2", ""
Exit Sub
Case Else
MenuPrompt = "Invalid Input!" & vbCrLf
End Select
Loop While True = True
end sub
Sub LoadBootStrap()
Dim RetValue
Dim GotInput
Dim DAC
Dim ATRDAC
Dim DAC4C
Dim Delay
Dim Delay5C
Dim Counter
Counter = 0
ATRDAC = &h70
DAC4C = &h85
DAC = &h8C
Delay = &h1A
Delay5C = 4
Do
Call IsCardPresent()
Sc.Write("A1")
GotInput = False
If Counter = 12 then
Counter = 0
DAC = &h8C
Delay = &h1A
end if
If Counter = 1 then
DAC = &h8C
Delay = &h8E
DAC4C = &h85
Delay5C = 4
end if
If Counter = 2 then
DAC = &h8A
Delay = &h1A
Delay5C = 5
end if
If Counter = 3 then
DAC = &h8A
Delay = &h8E
Delay5C = 4
end if
If Counter = 4 then
DAC = &h88
Delay = &h1A
DAC4C = &h82
Delay5C = 5
end if
If Counter = 5 then
DAC = &h88
Delay = &h8E
Delay5C = 4
end if
If Counter = 6 then
DAC = &h86
Delay = &h1A
Delay5C = 5
end if
If Counter = 7 then
DAC = &h86
Delay = &h8E
Delay5C = 4
end if
If Counter = 8 then
DAC = &h84
Delay = &h1A
DAC4C = &h80
Delay5C = 5
end if
If Counter = 9 then
DAC = &h84
Delay = &h8E
Delay5C = 4
end if
If Counter = 10 then
DAC = &h82
Delay = &h1A
Delay5C = 5
end if
If Counter = 11 then
DAC = &h82
Delay = &h8E
DAC4C = &h71
Delay5C = 4
end if
Call Sc.ProgressBox ("Glitching... DAC: " & HexString(DAC,2) & vbcr & " Delay: " & HexString(Delay,2), 1, 999, "Hu Card Unlock")
Sc.Write("06100E10019300")
Sc.Delay(80)
Sc.Read(&h02)
RetValue = Sc.GetByte(&h01)
Sc.Read (RetValue)
Sc.Write("B0")
Sc.Write(HexString(DAC,2))
' 5C glitch
Sc.Write("121AC4485C0000048020003F09830B" & HexString(Delay5C,2) & HexString(Delay,2) & "8100")
Sc.Delay(80)
Sc.Read(&h02)
RetValue = Sc.GetByte(&h01)
Sc.Read (RetValue)
Sc.Write("B0")
Sc.Write(HexString(DAC4C,2))
'Sc.Write("85")
Sc.Write("0B 15 C4 48 4C 00 00 FF 70 C9 08 00")
Sc.Delay(80)
If Sc.BytesInBuffer > 0 Then
Sc.Read(&h02)
RetValue = Sc.GetByte(&h01)
Sc.Read (RetValue)
End If
Sc.Write("34F00000000069FFFFFFFF523FFD2284E1724007 72FF14C5E2AB0100C3DA07F88C010000000000000000000000 0000000000008000")
Sc.Delay(80)
Sc.Read(&h02)
If Sc.GetByte(&h0) = &h34 then
If Sc.GetByte(&h01) = &h01 then
Sc.Read(&h01)
If Sc.GetByte(&h0) = &h84 then
GotInput = True
else
GotInput = False
end if
end if
end if
Counter = Counter + 1
Loop Until GotInput = True
Sc.Write("42FF225272FF14E1E2D007E2D029E2D02A778007 18753F07D307D807C5E2AB0060C3DA07F8726015D404E700D5 7640070DD3078ECEFB70012ADA07F700C49E2A00FA00")
Sc.Delay(80)
Sc.Read(&h02)
Call Sc.ProgressBox ("", 0, 0, "")
end sub
Sub GetFile()
Dim FileName
Dim FileSize
FileName = Fs.FileOpenDialog(FileFilter, "Please select a valid HU Eprom (*.bin) file", "Default.bin")
If FileName <> "" Then
If Fs.FileExists(FileName) = 0 Then
Sc.MsgBox("The file does not exist")
Else
InFile = Fs.FileOpen(FileName, fsoOpenRead)
End If
End If
FileSize = Fs.FileSeek(InFile, 0, fsoSEEK_END)
'Sc.Print "The file size is " & FileSize & vbCr
if FileSize <> "8192" then
Sc.MsgBox("This file is NOT a valid HU bin file" & vbcr & "or the bin file you are trying to open" & vbcr & "is being used by another program")
HUBinFile = False
exit sub
else
HUBinFile = True
end if
end sub
Sub WriteCard()
Dim EPROM
Dim ThisByte
Dim Address
Dim RetValue
Dim Location
Dim EPROMBytes
Dim EPROMBytes2
Address = 8192
Location = 0
Sc.Write("A2")
'Call WDTMR()
'call Fs.FileSeek(InFile, 0, fsoSEEK_SET)
'EPROMBytes = ""
'For ThisByte = 20 to (22) - 1
'EPROMBytes = EPROMBytes & HexString(Fs.FileGetc(InFile), 2)
'Next
'Sc.Write("07C4812014" & EPROMBytes & "00")
'Sc.Read(&h02)
'Sc.Print "2014: " & EPROMBytes & vbcr
Call Sc.ProgressBox ("Writing EPROM memory..." & vbcr & "2000: " & EPROMBytes, EPROM, 255, "Unlooper/Unlocker")
call Fs.FileSeek(InFile, Location, fsoSEEK_SET)
Do
Call WDTMR()
EPROMBytes = ""
For ThisByte = Location to (Location + 16) - 1
EPROMBytes = EPROMBytes & HexString(Fs.FileGetc(InFile), 2)
Next
EPROMBytes2 = ""
For ThisByte = (Location + 16) to (Location + 32) - 1
EPROMBytes2 = EPROMBytes2 & HexString(Fs.FileGetc(InFile), 2)
Next
Sc.Write("25E29F" & HexString(Address,4) & EPROMBytes & EPROMBytes2 & "00")
Sc.Read(&h02)
Call Sc.ProgressBox ("Writing EPROM memory..." & vbcr & HexString(Address,4) & ": " & EPROMBytes & vbcr & HexString(Address + 16,2) & ": " & EPROMBytes2, EPROM, 255, "Unlooper/Unlocker")
EPROM = EPROM + 1
Address = Address + 32
Location = Location + 32
loop until EPROM = 255
Fs.FileClose(InFile)
Sc.Write("A0") ' turn the LED off
Sc.Write("020200")
Sc.Delay(100)
Sc.Read(&h02)
Call Sc.ProgressBox ("", 0, 0, "")
end sub
Sub WriteThruBootStrap(Address, Bytes, Note, CurrentNumber, TotalNumber)
'Write Thru Boot Strap routine enables easy writing to the card
'after boot strap is loaded by providing the ability to specify
'a note for ProgressBox and it's counters, address location
'and the actual bytes to write. Bytes to write must NOT
'contain spaces so that they can be automatically calculated.
'You may write up to 64 bytes at one time.
'Example with a note:
'Call WriteThruBootStrap("2080", "FFFFFFFF", "Writing to EPROM..., 1, 1)
'Example without a note:
'Call WriteThruBootStrap("2080", "FFFFFFFF", "", "", "")
Dim DecNumberOfBytesInGlitchPacket
Dim HexNumberOfBytesInGlitchPacket
Dim HexNumberOfBytesToTransmit
Dim HexNumberOfBytesToWrite
DecNumberOfBytesInGlitchPacket = 9 + (Len(Bytes))/2
If DecNumberOfBytesInGlitchPacket < &h10 Then
HexNumberOfBytesInGlitchPacket = "0" & Hex(DecNumberOfBytesInGlitchPacket)
Else
HexNumberOfBytesInGlitchPacket = Hex(DecNumberOfBytesInGlitchPacket)
End If
HexNumberOfBytesToWrite = Hex(118 + DecNumberOfBytesInGlitchPacket)
HexNumberOfBytesToTransmit = Hex(182 + DecNumberOfBytesInGlitchPacket)
If Note <> "" or CurrentNumber <> "" or TotalNumber <> "" then
Call Sc.ProgressBox (Note, CurrentNumber, TotalNumber, "Unlocker")
else
end if
Sc.Write(HexNumberOfBytesInGlitchPacket & "C2" & HexNumberOfBytesToWrite & Address & HexNumberOfBytesToTransmit & Bytes & "0EFF8000")
Sc.Read(&h03)
End Sub
Sub WDTMR()
Dim RetValue
Sc.Write("05150E108000")'SET WDTMR
sc.delay(70)
Sc.Read(&h02)
RetValue = Sc.GetByte(&h01)
Sc.Read(RetValue)
end sub
Sub IsCardPresent()
Dim RetValue
Dim GotInput
ScriptStart = Now
Sc.Print "----------------------------------------------------------------" & vbCr
Sc.Print "Start: " & ScriptStart & vbCr 'main screen
Sc.Print "----------------------------------------------------------------" & vbCr
Do
Sc.Write("A0") ' turn the LED off
Sc.Write("80") 'Is card present?
Sc.Delay(100)
If Sc.BytesInBuffer > 0 then
Sc.Read(&h01)
RetValue = Sc.GetByte(0)
end if
If RetValue = &h0 then
Call Sc.ProgressBox ("*** Please insert your card... ***", 1, 999, "Unlooper/Unlocker")
GotInput = False
else
If RetValue = &hFF then
GotInput = True
else
If RetValue <> &h0 or RetValue <> &hFF then
Sc.Write("A0") ' turn the LED off
Sc.Write("020200")
Sc.Delay(100)
If Sc.BytesInBuffer > 1 then
Sc.Read(&h02)
GotInput = False
else
GotInput = False
end if
end if
End if
End if
Loop Until GotInput = True
end sub
Function HexString(Number,Length)
' This function takes 2 arguments, a number and a length. It converts the decimal
' number given by the first argument to a Hexidecimal string with its length
' equal to the number of digits given by the second argument
Dim RetVal
Dim CurLen
RetVal=Hex(Number)
CurLen=Len(RetVal)
If CurLen<Length Then
RetVal=String(Length-CurLen,"0") & RetVal
End If
HexString=RetVal
End Function
Function Hex2Dec(HexNumber)
' This function takes 1 argument, a string containing a hex value of any digit length
' and returns the decimal equivalent
Dim DecimalValue
Dim DigitCount
Dim Digit
Dim HexDigit
HexNumber = Replace(UCase(HexNumber), " ", "")
DigitCount = Len(HexNumber)
For Digit = 1 To DigitCount
HexDigit = Mid(HexNumber, Digit, 1)
If Asc(HexDigit) < 58 Then
DecimalValue = HexDigit * 16 ^ (DigitCount - Digit)
Else
DecimalValue = (Asc(HexDigit) - 55) * 16 ^ (DigitCount - Digit)
End If
Hex2Dec = Hex2Dec + DecimalValue
Next
End Function
Function GetATR ()
Dim temp
Call Sc.ProgressBox(0,0,0,0)
Sc.Write("06100E10019300")
Sc.Delay(500)
Sc.Read(&h02)
temp = Sc.GetByte(&h01)
Sc.Read (temp)
if(temp <> 20) then
GetATR = False
else
GetATR = True
end if
End Function
'
'Bootcard for unlooping
'
Function BootCard()
Dim cnt,b, RetVal, boot, kk,katr
Dim atrlock,cter, glcnt, mtries,kp
RANDOMIZE TIMER
atrlock=0
cter=0
glcnt=0
mtries = 0
sc.verbose = False
DO
katr=0
mtries = mtries + 1
if mtries = 5000 then
call RndGr()
mtries = 0
end if
boot = 0
'==============================================
'vcc + last 2 glitch 4 bootloader
D2 = INT(RND * &h00) + &h34 ' 56 - 62 These are the glitch value ranges.
D3 = INT(RND * &h00) + &ha ' 8 - 11<<<<The Hex value of 07 is added at a random number up to 04 not 5 cuz it always rounds down ie 4.87755 = 4
D4 = INT(RND * &h00) + &h9c '135 - 191
D9 = INT(RND * &h00) + &h364 '865 - 866
'==========================================
' Atr glich point search range
if atrlock = 0 then
D7 = INT(RND * &h00) + &h1e ' 29 - 30
D8 = INT(RND * &h00) + &h48 ' 57 - 59
D1 = INT(RND * &h00) + &he0 '168 - 175
D5 = INT(RND * &h00) + &h25e '606
D6 = INT(RND * &h00) + &h3e ' 63 - 67
end if
call ProgUpdate(kp,atrlock)
sc.verbose = 0
sc.write("A1")
delay(10)
if Chk4Card() = 0 then
BootCard=0
Exit Function
end if
delay(30)
sc.write("B0" & HexString(D1,02))
glttl = glttl + 1
sc.write("0f1f0120" & HexString(D5,4) & "0c" & HexString(D7,2) & "20" & HexString(D6,4) & "0d00" & HexString(D8,2) & "0000")
Sc.Read(&h02)
cter=cter+1
cnt=0
Sc.Write("028000")
if Sc.Read(&h02) = 2 then
cnt = sc.getbyte(1)
if cnt = 1 then sc.read(1)
end if
if cter > 75 then
glcnt = glcnt + 1
if glcnt = 24 then
glcnt = 0
call RndGr()
end if
cter = 0
atrlock = 0
end if
if cnt > 0 then
kp=kp+1
if kp >33 then kp = 33
sc.print "============================================"&VbC r&"ATR"&VbCr
for b = 0 to 10
Sc.Write("028000")
if Sc.Read(&h02) = 2 then
cnt = sc.getbyte(1)
else
cnt = 0
end if
if cnt > 0 then
cnt = sc.read(cnt)
kk=sc.getbyte(0)
if kk = &h38 then
sc.print "38 "
Sc.Write("028000")
cnt = 0
if Sc.Read(&h02) = 2 then
cnt = sc.getbyte(1)
if(cnt = 0) then exit for
Sc.Read(cnt)
if(sc.getbyte(0)) = &hb0 then
chglch = chglch + 1
If chglch > 75 Then
chglch = 0
call BootCard()
End if
sc.print "B0" & VbCr & "Attempting to install bootloader.. " '& VbCr
Sc.Print "D1-D9 values: " & D1 & ", " & D2 & ", " & D3 & ", " & D4 & ", " & D5 & ", " & D6 & ", " & D7 & ", " & D8 & ", " & D9
d0=d0+1
katr=1
cter = 0
glcnt = 0
atrlock =1
exit for
end if
end if
end if
end if
sc.print HexString(kk,2) &" "
next
sc.print VbCr &"============================================"&Vb Cr
'sc.print VbCr & cter & VbCr
if katr = 1 then
sc.write("B0" & HexString(D4,02))
sc.write("071f800d" & HexString(D3,02)& HexString(D2,02)&"0000")
if Sc.Read(&h02) > 1 then
cnt = sc.getbyte(1)
else
cnt = 0
end if
if cnt > 0 then
cnt = sc.read(cnt)
for b = 0 to cnt - 1
next
Sc.Write("31eeFFFFfed18d52E0FD2266E1B9E17201CF725f 0772FF14C5E2AB0100C3DA07F88C0100FFFFFFFFFFFFFFFFFF FFFFFF0000")
if Sc.Read(&h02)<2 then Sc.Read(&h02)
Sc.Write("11c060200350042001500320" & HexString(D9,04) & "0d010000")
Sc.Read(&h02)
for b = 0 to 8
Sc.Write("028000")
if Sc.Read(&h02) = 2 then
cnt = sc.getbyte(1)
else
cnt = 0
end if
if cnt > 0 then
cnt = sc.read(cnt)
kk=sc.getbyte(0)
if kk = &h66 then
Sc.Write("028000")
cnt = 0
if Sc.Read(&h02) = 2 then
cnt = sc.getbyte(1)
if(cnt = 0) then exit for
Sc.Read(cnt)
if(sc.getbyte(0)) = &h99 then
boot=1
sc.print VbCr & "Bootloader installed After " & d0 & " attempts!" & VbCr
Sc.Print "Total # of glitches applied to card " & glttl & VbCr
Sc.Print "D1 - D9 values used: " & D1 & ", " & D2 & ", " & D3 & ", " & D4 & ", " & D5 & ", " & D6 & ", " & D7 & ", " & D8 & ", " & D9 & VbCr
ScriptEnd = Now
Sc.Print "Elapsed time: " + FormatNumber((CDbl(ScriptEnd) - CDbl(ScriptStart)) * 24 * 60, 2, True, True, True) & " minutes" & vbCr
exit for
end if
end if
end if
else
exit for
end if
next
if boot = 1 then
Sc.Write("021500")
Sc.Read(2)
Sc.Write("42FF225272FF14E1E2D007E2D029E2D02A778007 16753F07D307F75011E29B2A70012ADA07F78E013A00D7D307 D8078ECEFBD40770012ADA07F300C6F76211F7631100")
Sc.Read(2)
Sc.Write("21DE8E0149F76011F76111881c931270FF1203FB F70011728512DA12FDF70011F900")
Sc.Read(2)
BootCard=1
Exit Function
end if
end if
end if
else
kp=kp-1
if kp<1 then kp=1
end if
loop
End Function
Sub RndGr
Dim g1,g2,g3,g4,g5,g6
Dim dly,v
RANDOMIZE TIMER
sc.print VbCr & "Random gliching the card to whip it into shape" & VbCr
sc.verbose = false
for v = 1 to 800
g1 = INT(RND * &hFF)
g2 = INT(RND * &hFF)
g3 = INT(RND * &hFF)
g4 = INT(RND * &hFF)
g5 = INT(RND * &hFF)
g6 = INT(RND * &h4F) + &h80
dly= INT(RND * &h200)
sc.write("B0" & HexString(g6,2))
sc.write("111f0120" & HexString(dly,4) & "0c" & HexString(g1,2) & "0c" & HexString(g2,2) & "0a" & "0c" & HexString(g3,2) & "0c" & HexString(g4,2) & "0c" & HexString(g5,2) & "00")
sc.read(2)
next
End Sub
Function ShowAtr()
Dim cnt,tmp,b,Msg
Msg="Unlooper"
tmp=""
sc.write("0610010e109300")
if Sc.Read(&h02) > 1 then
cnt = sc.getbyte(1)
else
cnt = 0
end if
ScriptEnd = Now
tmp = "Card Unlooped Successfully after " & glttl & " total glitches to the card." & VbCr & VbCr & d0 & " bootload attempts were made to the card." & VbCr & VbCr & "Successfull D1 - D9 values used: " & D1 & ", " & D2 & ", " & D3 & ", " & D4 & ", " & D5 & ", " & D6 & ", " & D7 & ", " & D8 & ", " & D9 & VbCr & VbCr & VbCr & "Total time to unloop and write HU bin: " & FormatNumber((CDbl(ScriptEnd) - CDbl(ScriptStart)) * 24 * 60, 2, True, True, True) & " minutes" & vbCr & VbCr & "ATR Returned:" & VbCr
if cnt > 0 then
cnt = sc.read(cnt)
for b = 0 to cnt -1
tmp=tmp & HexString(sc.getbyte(b),2) & " "
next
sc.print VbCr & tmp & VbCr
cnt = Sc.ButtonBox(tmp, 0, Msg, "Ok")
else
tmp=""
tmp=tmp+"Card did not return an ATR"+VbCr+"Try to unloop the card again"+VbCr
tmp=tmp+"This happens sometimes when the card"+VbCr
tmp=tmp+"doesn't take the eeprom write"
cnt = Sc.ButtonBox(tmp, 0,Msg , "Ok")
end if
End Function
Sub ProgUpdate(pg,atrlock)
Dim i
Dim Msg
Msg="Glitches applied to card thus far " & glttl & " Elapsed Time: " + FormatNumber((CDbl(Now) - CDbl(ScriptStart)) * 24 * 60, 2, True, True, True) + " minutes"
if atrlock = 1 then
Msg=Msg+VbCr+"Values of D1-D9: " & D1 & ", " & D2 & ", " & D3 & ", " & D4 & ", " & D5 & ", " & D6 & ", " & D7 & ", " & D8 & ", " & D9 &vbcr
Msg=Msg+"ATR locked!" + " Bootloader Attempts: " & (d0) & VbCr
else
Msg=Msg+VbCr+"Values of D1-D9: " & D1 & ", " & D2 & ", " & D3 & ", " & D4 & ", " & D5 & ", " & D6 & ", " & D7 & ", " & D8 & ", " & D9 &vbcr
Msg=Msg+"Attempting to lock onto ATR." + " Bootloader Attempts: " & (d0) & VbCr
end if
Call Sc.ProgressBox(Msg,pg,33,"Unlooper")
End Sub
Function Chk4Card()
Dim tmp
sc.write("80")
sc.delay(10)
if sc.read(1) = 1 then
tmp=sc.getbyte(0)
If tmp = &h0 then
Chk4Card=0
sc.write("A0")
Call Sc.ProgressBox(0,0,0,0)
sc.MsgBox("Card Removed Unlooping ended prematurely")
else
Chk4Card=1
end if
end if
End Function
Function ChipVer()
ChipVer = 1
sc.write("90")
delay(80)
if sc.read(4) <> 4 then
ChipVer = 0
Exit Function
end if
if getbyte(0) <> &h55 then ChipVer = 0
if getbyte(1) <> &h4c then ChipVer = 0
if getbyte(2) <> &h34 then ChipVer = 0
if getbyte(3) <> &h53 then ChipVer = 0
End Function
otro que parece bueno pero tampoco me va y uso el t43
' ================
' = Turbo Unloop =
' ================
' = v1.1 =
' ================
'
' by aol6945
'
' This script requires WinExplorer 4.6 or higher.
'
' Read the Documentation.htm file for more information
'
' Global Variable Definitions
Option Explicit
' Constants used throughout script
Const ScriptName="TurboUnloop"
Const ScriptVer="1.1"
' Glitching values/constants
Dim DAC(12),Delay(12),GlitchDelay(12) ' Working values
Dim DACL(12),DelayL(12),GlitchDelayL(12) ' Lower range limit constants
Dim DACI(12),DelayI(12),GlitchDelayI(12) ' Initial Value Constants
Dim DACH(12),DelayH(12),GlitchDelayH(12) ' High range limit constants
Dim Tries(12) ' Running total of number of times a glitch has been tried
Dim TotalTries(12) ' Running total of number of times a glitch task has been tried
Dim TriesLimit(12) ' Upper limit for trying this glitch - exceeding it means new glitch values will be selected
Dim TriesLimitN(12) ' Normal limit for number of times to try a glitch
Dim TriesLimitI(12) ' Initial limit for trying initial glitches
Dim AltProcTriesLimit(12) ' Limit on Total tries before switching glitch procedures
Dim AltProc(12) ' The glitch set that is the alternate procedure
Dim GlitchProc(12) ' The procedure number within the task that should be run with these glitch parameters
Dim FailsLimit(12) ' Failure limit for trying previously successful glitches - exceeding it means saved glitch values will be deleted and new ones will be searched for
Dim GlitchLogic(12) ' 0=Try successive glitches by incrementing glitch values, 1=Try random glitch values
Dim Search(12) ' 0=Using saved glitch parameters, 1=Searching for new glitch parameters
Dim TaskSet(5) ' Holds which set of glitches is currently being used for a task
' Global Unlooper Packet Variables
Dim ATR(13)
Dim PacketResponse(4)
Dim GPPLen,GPRLen ' Glitch Packet "Processed" Length, Glitch Packet Response Length
Dim GPR(70) ' Glitch Packet Response
Const MasterFailLimit=25000 ' Maximum number of glitch tries before giving up
' Constants for file manipulation
Const fsoError=-1
Const fsoOpenRead=0
Const fsoOpenWrite=1
Const fsoOpenReadWrite=2
Const fsoSEEK_SET=0
Const fsoSEEK_CUR=1
Const fsoSEEK_END=2
' ==================
' = Pre-Main Setup =
' ==================
' Setup WinExplorer to Unlooper settings
Call UnlooperSettings()
' ==================
' = Main Procedure =
' ==================
Sub Main()
' Main Program Loop and Menu
Dim MenuChoice
Dim MsgPrompt
Dim ErrorValue
' Suppress window output
Sc.Verbose=False
' Verify correct version of WinExplorer
If VerifyWinExplorer()=0 Then Exit Sub
' User must agree to disclaimer
If Disclaimer()=0 Then Exit Sub
' User better have read the docs or I'm gonna shoot him
If ReadMe()=0 Then Exit Sub
' Verify that an unlooper is connected and we can communicate with it
If VerifyUnlooper()=0 Then Exit Sub
' Show Splash screen
Call Sc.PictureBox("Turbo-Unloop.jpg",5)
Do
MsgPrompt="=== "+ScriptName+" "+ScriptVer+" ==="+vbCr+vbCr
MenuChoice=Sc.ButtonBox(MsgPrompt,vbDefaultButton1 ,ScriptName+" "+ScriptVer+" - Main Menu","Card Status","Read Card","Fix Card","Write .img/.bin","Exit")
' Initialize Glitch values
Call SetGlitchValues()
Select Case MenuChoice
Case 1:
ErrorValue=CardStatus()
Case 2:
ErrorValue=ReadCard()
Case 3:
ErrorValue=FixCard()
Case 4:
ErrorValue=WriteCard()
End Select
Loop Until MenuChoice=5
' Show ending graphic
Call Sc.PictureBox("Turbo-Unloop-b.jpg",5)
End Sub
' =========================
' = High-Level Procedures =
' =========================
Function ReadCard()
ReadCard=GlitchDrive(0)
End Function
Function FixCard()
FixCard=GlitchDrive(1)
End Function
Function WriteCard()
WriteCard=GlitchDrive(2)
End Function
Function GlitchDrive(Func)
' This function drives the unlooper to fix a card.
' The Func variable controls whether the routine is going to Read the card (Func=0),
' Unloop/Fix the card (Func=1), or Write a user-supplied .img or .bin (Func=2)
Dim i,j
Dim Stage
Dim RetVal
Dim CardStatus
Dim MsgPrompt
Dim Display
Dim MasterTries
Dim Finished
Dim EID,CAMID,USW,IRD,LastDynCode
Dim WriteListEEP(4096) ' Array of strings consisting of hex address, hex length, and bytes to write
Dim WriteListBoot(72) ' Array of byte values consisting of the bytes to write to 8020h-8067h when exiting the bootloader
GlitchDrive=0
MasterTries=0
Finished=0
' Turn off LED
Sc.Write("A0")
' Glitcher Driver (The Illudium PU-36 Explosive Glitch Modulator)
Stage=1
Display=0
Do While (Finished=0)
If (Stage>1) And (Stage<22) And (CardInserted()=0) Then
Stage=14
End If
If (Stage>1) And (Stage<22) And (MasterTries>MasterFailLimit) Then
Stage=15
End If
MasterTries=MasterTries+1
Select Case Stage
Case 1: ' Wait for card to be inserted
Call WaitCardInsert()
Stage=2
Case 2: ' Check the card status (Does it have ATR, can it process a packet?)
' Turn on LED Green
Sc.Write("A1")
Call GenericMsg("Checking ATR ...")
Sc.Delay(500)
If CheckGoodCard() Then
CardStatus=1 ' Unlooped, properly working non-BS card
ElseIf CheckGoodCardBS() Then
CardStatus=2 ' Unlooped, properly working BS card
Else
CardStatus=0 ' Looped
End If
If Func=0 Then Stage=3 ' Read card - start glitching
If Func=1 Then Stage=11 ' Fix card - go load the FixBin.img
If Func=2 Then Stage=12 ' Write .img/.bin - go load the .img or .bin that user wants to write
If CardStatus=2 Then TaskSet(1)=AltProc(TaskSet(1)) ' If working BS card, start with BS glitches
If CardStatus<>0 And Func=1 Then Stage=16 ' Trying to unloop a card that is already unlooped
If CardStatus=0 And Func=2 Then Stage=17 ' Trying to write .img or .bin to a looped card
Case 3: ' Glitch Task 1 - Attempt to get 1st byte of ATR
' Turn on LED Green
Sc.Write("A1")
' Clear ATR
ATR(0)=&H100
If Params(TaskSet(1)) Or Display<1 Then
Call GlitchMsg(1)
Display=1
End If
If GlitchTask1(TaskSet(1)) Then
Stage=4
Tries(TaskSet(1))=0
Search(TaskSet(1))=0
Else
If Search(TaskSet(1))=1 Then Display=0
If TotalTries(TaskSet(1))>=AltProcTriesLimit(TaskSet( 1)) Then
' If we've tried AltProcTriesLimit glitches for one glitch parameter set and won't pop, try alternate glitch parameter set
TotalTries(TaskSet(1))=0
TaskSet(1)=AltProc(TaskSet(1))
End If
End If
Case 4: ' Glitch Task 2 - Get Next 10 bytes of ATR
If Params(TaskSet(2)) Or Display<2 Then
Call GlitchMsg(2)
Display=2
End If
If GlitchTask2(TaskSet(2)) Then
Stage=5
Tries(TaskSet(2))=0
Search(TaskSet(2))=0
Else
Stage=3 ' Glitch task 2 failed - start over
End If
Case 5: ' Glitch Task 3 - Get last 2 bytes of ATR and get card to process a packet
If Params(TaskSet(3)) Or Display<3 Then
Call GlitchMsg(3)
Display=3
End If
If GlitchTask3(TaskSet(3)) Then
If Search(TaskSet(3))=0 Then
' If these are parameters we've already found, go to next glitch task
If Func=0 Then
Stage=7
Else
Stage=6
End If
Else
Stage=3 ' Otherwise, we already "used" the one processable packet on finding the glitch
End If ' parameters, so we have to start over.
Tries(TaskSet(3))=0
Search(TaskSet(3))=0
Else
If TotalTries(TaskSet(3))>=AltProcTriesLimit(TaskSet( 3)) Then
' If we've tried AltProcTriesLimit glitches for one glitch parameter set and won't pop, try alternate glitch parameter set
TotalTries(TaskSet(3))=0
TaskSet(3)=AltProc(TaskSet(3))
End If
Stage=3 ' Glitch task 3 failed - start over
End If
Case 6: ' Glitch Task 4 - Fill Memory to overwrite stack to write bootloader
If Params(TaskSet(4)) Or Display<4 Then
Call GlitchMsg(4)
Display=4
End If
If GlitchTask4(TaskSet(4)) Then
Stage=8
Tries(TaskSet(4))=0
Search(TaskSet(4))=0
Else
Stage=3 ' Glitch task 4 failed - start over
End If
Case 7: ' Glitch Task 4B - Fill Memory to overwrite stack to read EEPROM
If Params(TaskSet(4)) Or Display<4 Then
Call GlitchMsg(4)
Display=4
End If
If GlitchTask4B(TaskSet(4)) Then
Stage=10
Tries(TaskSet(4))=0
Search(TaskSet(4))=0
Else
Stage=3 ' Glitch task 4B failed - start over
End If
Case 8: ' Glitch task 5 - Get into the bootloader
If Params(TaskSet(5)) Or Display<5 Then
Call RWMsg("Activating Bootloader ...",1,225)
Display=5
End If
If GlitchTask5(TaskSet(5)) Then
If Func=1 Then
Stage=9 ' Bootloader is active, get card info
Else
Stage=13 ' Don't get card info on write .img/.bin
End If
ElseIf TotalTries(TaskSet(5))>25 Then
Stage=3 ' Tried to glitch into bootloader many times, can't get in. Reglitch.
TotalTries(TaskSet(5))=0
Else
If TotalTries(TaskSet(5))>=AltProcTriesLimit(TaskSet( 5)) Then
' If we've tried AltProcTriesLimit glitches for one glitch parameter set and won't pop, try alternate glitch parameter set
TotalTries(TaskSet(5))=0
TaskSet(5)=AltProc(TaskSet(5))
End If
End If ' Otherwise try to glitch into bootloader again
Case 9: ' Get card info
If Display<6 Then
Call RWMsg("Getting Card Info ...",1,225)
Display=6
End If
If GetCardInfo(EID,CAMID,USW,IRD,LastDynCode) Then
Stage=13 ' Got info, go to write Fixbin
Else
Stage=3 ' Bootloader is on card but failed? Probable corrupted bootloader. Reglitch.
End If
Case 10: ' Read and Save EEPROM
If ReadBin() Then
Stage=18 ' Successfully read EEPROM, go to finished.
Else
If CardInserted()<>0 Then
Stage=15 ' Couldn't read card, display error.
Else
Stage=14 ' Card was removed during read.
End If
End If
Case 11: ' Load the FixBin.img into the WriteListEEP and WriteListBoot arrays
If Fs.FileExists("FixBin.img")<>0 And ReadImgFile("FixBin.img",WriteListEEP,WriteListBoo t)=1 Then
Stage=3 ' Successfully read FixBin.img, start glitching
Else
' Turn off LED
Sc.Write("A0")
' Clear Progress Box
Call RemoveMsg()
RetVal=Sc.MsgBox("Unable to load FixBin.img",vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Unloop Procedure")
Stage=22
End If
Case 12: ' Load a user-specified .img or .bin into the WriteListEEP and WriteListBoot arrays
If ReadFile(WriteListEEP,WriteListBoot)=1 Then
Stage=3 ' Successfully read user's file, start glitching
Else
' Turn off LED
Sc.Write("A0")
' Clear Progress Box
Call RemoveMsg()
Stage=22
End If
Case 13: ' Write the WriteListEEP array, and exit the bootlaoder, writing the WriteListBoot array
If WriteWriteList(WriteListEEP) And ExitBootloader(WriteListBoot) Then
Stage=18 ' Finished and successful
Else
If CardInserted()<>0 Then
Stage=15 ' Error writing card, display error.
Else
Stage=14 ' Card was removed during write.
End If
End If
Case 14: ' Card was Removed
' Turn off LED
Sc.Write("A0")
' Clear Progress Box
Call RemoveMsg()
RetVal=Sc.MsgBox("Card was Removed",vbInformation+vbOKOnly,ScriptName+" "+ScriptVer+" - Unloop Procedure")
Stage=22
Case 15: ' Error glitching or reading/writing card
' Turn on LED Red
Sc.Write("A2")
' Disconnect Card
SendGP("02")
' Clear Progress Box
Call RemoveMsg()
RetVal=Sc.MsgBox("Error: Unable to Glitch/Load Card",vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Unloop Procedure")
' Turn off LED
Sc.Write("A0")
Stage=22
Case 16: ' Trying to unloop a card that is not looped
Sc.Write("A0")
Call RemoveMsg()
MsgPrompt="This card has a good ATR and can process packets."+vbCr+_
"It is probably not looped."+vbCr
If CardStatus=2 Then
MsgPrompt=MsgPrompt+"(Although this is a Black Sunday card)."+vbCr
End If
MsgPrompt=MsgPrompt+vbCr+"Do you want to fix/unloop the card anyway?"
RetVal=Sc.MsgBox(MsgPrompt,vbQuestion+vbYesNo+vbDe faultButton2,ScriptName+" "+ScriptVer+" - Fix Good Card?")
If RetVal=vbNo Then
Stage=22
Else
Stage=11
End If
Case 17: ' Trying to write .img/.bin to a looped card
Sc.Write("A0")
Call RemoveMsg()
MsgPrompt="This card has a bad ATR or no ATR, and cannot process packets."+vbCr+_
"It is probably looped."+vbCr
MsgPrompt=MsgPrompt+vbCr+"You need to fix the card with the 'Fix Card' option before you"
MsgPrompt=MsgPrompt+vbCr+"can write an .img or .bin to the card."
RetVal=Sc.MsgBox(MsgPrompt,vbExclamation+vbOKOnly, ScriptName+" "+ScriptVer+" - Card is Looped")
Stage=22
Case 18: ' Finished & successful
' Disconnect Card
SendGP("02")
' Turn off LED
Sc.Write("A0")
' Clear Progress Box
Call RemoveMsg()
GlitchDrive=1
If Func=0 Then Stage=20
If Func=1 Then Stage=19
If Func=2 Then Stage=21
Case 19: ' After-Fix Display
MsgPrompt="Finished Fixing Card, Repair Sequence: "+HexString(DAC(TaskSet(1)),2)+"/"+HexString(Delay(TaskSet(1)),2)+"/"+_
HexString(GlitchDelay(TaskSet(1)),2)+"/"+HexString(DAC(TaskSet(3)),2)+"/"+HexString(Delay(TaskSet(3)),2)+"/"+HexString(GlitchDelay(TaskSet(3)),2)+"/"+_
HexString(DAC(TaskSet(4)),2)+"/"+HexString(Delay(TaskSet(4)),2)+"/"+HexString(GlitchDelay(TaskSet(4)),2)+vbCr+vb Cr
MsgPrompt=MsgPrompt+"Before Repair:"+vbCr
MsgPrompt=MsgPrompt+"EID: "+vbTab+EID+vbCr+_
"CAM ID: "+vbTab+CStr(HexToDec(CAMID))+CStr(CheckDigit(HexT oDec(CAMID)))+" ("+CAMID+")"+vbCr+_
"USW: "+vbTab+CStr(HexToDec(USW))+" ("+USW+")"+vbCr+_
"IRD: "+vbTab+IRD+vbCr
If HexToDec(USW)>=63 And HexToDec(USW)<=67 Then
MsgPrompt=MsgPrompt+"Last Executed Dynamic Code: "
For i=0 to (Len(LastDynCode)\2)-1
MsgPrompt=MsgPrompt+Mid(LastDynCode,i*2+1,2)+" "
Next
End If
MsgPrompt=MsgPrompt+vbCr+vbCr
MsgPrompt=MsgPrompt+"After Repair:"+vbCr+"ATR: "+vbTab
If CheckGoodCard() Then
CardStatus=1
ElseIf CheckGoodCardBS() Then
CardStatus=2
Else
CardStatus=0
End If
If CardStatus>0 Then
For i=0 to 12
MsgPrompt=MsgPrompt+HexString(ATR(i),2)+" "
Next
GlitchDrive=1
Else
MsgPrompt=MsgPrompt+"Error! Still bad ATR!"
End If
MsgPrompt=MsgPrompt+vbCr
If CardStatus=2 Then
MsgPrompt=MsgPrompt+vbTab+"(This is a Black Sunday card)."
End If
RetVal=Sc.MsgBox(MsgPrompt,vbInformation+vbOKOnly, ScriptName+" "+ScriptVer+" - Unloop Procedure")
Stage=22
Case 20: ' After-Read Display
MsgPrompt="Finished Reading Card, Glitch Sequence: "+HexString(DAC(TaskSet(1)),2)+"/"+HexString(Delay(TaskSet(1)),2)+"/"+_
HexString(GlitchDelay(TaskSet(1)),2)+"/"+HexString(DAC(TaskSet(3)),2)+"/"+HexString(Delay(TaskSet(3)),2)+"/"+HexString(GlitchDelay(TaskSet(3)),2)+"/"+_
HexString(DAC(TaskSet(4)),2)+"/"+HexString(Delay(TaskSet(4)),2)+"/"+HexString(GlitchDelay(TaskSet(4)),2)+vbCr+vb Cr
RetVal=Sc.MsgBox(MsgPrompt,vbInformation+vbOKOnly, ScriptName+" "+ScriptVer+" - Read Procedure")
GlitchDrive=1
Stage=22
Case 21: ' After-Write .img/.bin Display
MsgPrompt="Finished Writing .img/.bin, Glitch Sequence: "+HexString(DAC(TaskSet(1)),2)+"/"+HexString(Delay(TaskSet(1)),2)+"/"+_
HexString(GlitchDelay(TaskSet(1)),2)+"/"+HexString(DAC(TaskSet(3)),2)+"/"+HexString(Delay(TaskSet(3)),2)+"/"+HexString(GlitchDelay(TaskSet(3)),2)+"/"+_
HexString(DAC(TaskSet(4)),2)+"/"+HexString(Delay(TaskSet(4)),2)+"/"+HexString(GlitchDelay(TaskSet(4)),2)+vbCr+vb Cr
RetVal=Sc.MsgBox(MsgPrompt,vbInformation+vbOKOnly, ScriptName+" "+ScriptVer+" - Write Procedure")
GlitchDrive=1
Stage=22
Case 22: ' Exit Glitch Loop
Finished=1
End Select
Loop
End Function
Function CardStatus()
' This function attempts to gain information about the card currently in the unlooper.
' It reports the information back to the user. Function returns 0 on error, 1 on
' status successfully determined.
Dim EID,CAMID,USW,IRD,Fuse
Dim CAMIDDec
Dim RetVal
Dim i
Dim MsgPrompt,ToWrite
Dim INS2AData(128)
Dim GoodATR(13),ATRBytes
Dim ATRGood,BS,INS2AGood,ParmsGood
CardStatus=0
GoodATR(0)=&H3F
GoodATR(1)=&H78
GoodATR(2)=&H12
GoodATR(3)=&H25
GoodATR(4)=&H01
GoodATR(5)=&H40
GoodATR(6)=&HB0
GoodATR(7)=&H03
GoodATR(8)=&H4A
GoodATR(9)=&H50
GoodATR(10)=&H20
GoodATR(11)=&H48
GoodATR(12)=&H55
' Turn Off LED
Sc.Write("A0")
' Verify Unlooper is present
If VerifyUnlooper()=0 Then Exit Function
' Wait for card insertion
Call WaitCardInsert()
' Turn On LED Green
Sc.Write("A1")
' Set the DAC Voltage
ToWrite="B080" ' Set DAC to 80h
Sc.Write(ToWrite)
' Check if we have an ATR
Call GenericMsg("Checking ATR ...")
Sc.Delay(500)
BS=0 ' Assume not a BS card
ATR(0)=&H100 ' Assume no ATR
ToWrite="10018C" ' Glitch procedure, set baud to ATR, reset card, receive 13 bytes, end procedure
SendGP(ToWrite)
i=0
Do While (GPRLen>i)
ATR(i)=GPR(i)
i=i+1
Loop
ATRGood=0
ATRBytes=GPRLen
' See if the ATR is good
If (ATRBytes=13) Then
ATRGood=1
For i=0 to 12
If ATR(i)<>GoodATR(i) Then
ATRGood=0
End If
Next
End If
If ATRBytes=0 Then ' Didn't get any bytes of ATR. Check if card is BS'd
ToWrite="10012003D50B8C" ' Glitch procedure, set baud to ATR, reset card, delay 03D5 clock cycles, glitch Vcc, receive 13 bytes, end procedure
SendGP(ToWrite)
i=0
Do While (GPRLen>i)
ATR(i)=GPR(i)
i=i+1
Loop
ATRGood=0
ATRBytes=GPRLen
If ATRBytes>1 Then BS=1 ' If we got bytes this time, card is a BS card
' See if the ATR is good
If (ATRBytes=13) Then
ATRGood=1
For i=0 to 12
If ATR(i)<>GoodATR(i) Then
ATRGood=0
End If
Next
End If
End If
INS2AGood=0
' Check if we can process a packet
Call GenericMsg("Checking Packet Processing ...")
Sc.Delay(500)
If ATRGood Then ' If we got a good ATR, see if we can get the card to process an INS 2A packet
' Send an INS 2A
ToWrite="15C4482A0000830E0480" ' Set baud to P2 xmit/rcv, transmit 5 bytes, set watchdog timer to 04, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=&H01 and GPR(0)=&H2A Then
ToWrite="BF"
SendGP(ToWrite)
If GPRLen=&H40 Then
For i=&H0 To &H3F
INS2AData(i)=GPR(i)
Next
End If
ToWrite="BF"
SendGP(ToWrite)
If GPRLen=&H40 Then
For i=&H0 To &H3F
INS2AData(i+&H40)=GPR(i)
Next
End If
ToWrite="81"
SendGP(ToWrite)
If GPRLen=&H02 and GPR(0)=&H90 and GPR(1)=&H00 Then
INS2AGood=1
End If
End If
End If
If INS2AGood Then ' If we got a good INS 2A then analyze it for information
EID=""
For i=0 to 7
EID=EID+HexString(INS2AData(i),2)
Next
Fuse=HexString(INS2AData(8),2)
CAMID=""
For i=0 to 3
CAMID=CAMID+HexString(INS2AData(i+20),2)
Next
IRD=""
For i=0 to 3
IRD=IRD+HexString((INS2AData(i+20) Xor INS2AData(i+24)),2)
Next
USW=&H100*INS2AData(28)+INS2AData(29)
End If
MsgPrompt="Card Analysis Complete:"+vbCr+vbCr
If ATRBytes>0 Then
If BS=0 Then
MsgPrompt=MsgPrompt+"This is a Non-BS H card."+vbCr
Else
MsgPrompt=MsgPrompt+"This is a Black Sunday H card."+vbCr
End If
Else
MsgPrompt=MsgPrompt+"Unable to determine if this is a Black Sunday H card or not."+vbCr
End If
MsgPrompt=MsgPrompt+"ATR:"+vbTab
If ATRBytes>0 Then
For i=0 to ATRBytes-1
MsgPrompt=MsgPrompt+HexString(ATR(i),2)+" "
Next
If ATRGood Then
MsgPrompt=MsgPrompt+" (Good ATR)"+vbCr+vbCr
Else
MsgPrompt=MsgPrompt+" (Bad ATR)"+vbCr+vbCr
End If
Else
MsgPrompt=MsgPrompt+"----"+" (No ATR)"+vbCr+vbCr
End If
If INS2AGood Then
ParmsGood=1
MsgPrompt=MsgPrompt+"This card can process packets. Card Information:"+vbCr
MsgPrompt=MsgPrompt+vbTab+"EID: "+vbTab+EID+vbCr
MsgPrompt=MsgPrompt+vbTab+"Fuse: "+vbTab+Fuse+" "
Select Case HexToDec(Fuse)
Case &H00:
MsgPrompt=MsgPrompt+"(Virgin Card)"+vbCr
Case &H05:
MsgPrompt=MsgPrompt+"(Unmarried and Not Activated)"+vbCr
Case &H20:
MsgPrompt=MsgPrompt+"(Married and Not Activated)"+vbCr
Case &H24:
MsgPrompt=MsgPrompt+"(Married and Cancelled)"+vbCr
Case &H25:
MsgPrompt=MsgPrompt+"(Married and Activated)"+vbCr
Case Else:
MsgPrompt=MsgPrompt+"(Unknown Fuse Byte)"+vbCr
ParmsGood=0
End Select
CAMIDDec=HexToDec(CAMID)
If CAMIDDec<0 Then CAMIDDec=&H7FFFFFFF
MsgPrompt=MsgPrompt+vbTab+"CAM ID: "+vbTab+CStr(CAMIDDec)+CStr(CheckDigit(CAMIDDec))+ " ("+CAMID+") "
If (CAMIDDec>=0) And (CAMIDDec<4000000) Then
MsgPrompt=MsgPrompt+"(F Card CAM ID)"+vbCr
ElseIf (CAMIDDec>=4000000) And (CAMIDDec<16000000) Then
MsgPrompt=MsgPrompt+"(H Card CAM ID)"+vbCr
ElseIf (CAMIDDec>=16000000) And (CAMIDDec<50000000) Then
MsgPrompt=MsgPrompt+"(HU Card CAM ID)"+vbCr
Else
MsgPrompt=MsgPrompt+"(Invalid CAM ID)"+vbCr
ParmsGood=0
End If
MsgPrompt=MsgPrompt+vbTab+"IRD: "+vbTab+IRD+vbCr
MsgPrompt=MsgPrompt+vbTab+"USW: "+vbTab+CStr(USW)+" ("+HexString(USW,4)+") "
If (USW=0) Then
MsgPrompt=MsgPrompt+"(Original EEPROM On Card)"+vbCr+vbCr
ElseIf (USW>0) And (USW<26) Then
MsgPrompt=MsgPrompt+"(Valid Old USW)"+vbCr+vbCr
ElseIf (USW>=26) And (USW<63) Then
MsgPrompt=MsgPrompt+"(Valid USW, Dynamic code not active)"+vbCr+vbCr
ElseIf (USW>=63) And (USW<67) Then
MsgPrompt=MsgPrompt+"(Valid USW, Dynamic code active)"+vbCr+vbCr
ElseIf (USW=67) Then
MsgPrompt=MsgPrompt+"(Current USW, Dynamic code active)"+vbCr+vbCr
Else
MsgPrompt=MsgPrompt+"(Invalid USW)"+vbCr+vbCr
ParmsGood=0
End If
End If
If ATRGood and INS2AGood Then
MsgPrompt=MsgPrompt+"This appears to be a properly working card"
If ParmsGood Then
MsgPrompt=MsgPrompt+"."+vbCr
Else
MsgPrompt=MsgPrompt+", but this card"+vbCr+"appears to have one or more invalid parameters."+vbCr+_
"Try writing a valid .bin to the card."+vbCr
End If
Else
If ATRGood Then
MsgPrompt=MsgPrompt+"This card has a good ATR, but is not properly processing packets."+vbCr
Else
MsgPrompt=MsgPrompt+"This card is looped."+vbCr
End If
MsgPrompt=MsgPrompt+vbCr+"Try to fix it with the 'Fix Card' option and/or write a valid .bin to the card."+vbCr
End If
' Remove the "Getting status" message
Call RemoveMsg()
' Turn Off LED
Sc.Write("A0")
Call Sc.MsgBox(MsgPrompt,vbInformation+vbOKOnly,ScriptN ame+" "+ScriptVer+" - Card Information")
CardStatus=1
End Function
' ========================
' = Mid-Level Procedures =
' ========================
Function VerifyUnlooper()
' This subroutine makes sure that the unlooper is connected and working properly.
' If not, an error message is displayed and the script is aborted.
Dim ErrorString
VerifyUnlooper=1
If UnlooperResetVerify()=0 Then
ErrorString="Unable to communicate with unlooper."+vbCr+vbCr+_
"This means one of the following:"+vbCr+vbCr+_
"- You have not selected 'Unlooper' in the WinExplorer quicksettings."+vbCr+_
"- Your unlooper is not powered up in unlooper mode (powered up with card OUT if"+vbCr+_
" you are using Black Sunday Atmel code)."+vbCr+_
"- You are trying to use a programmer instead of an unlooper."+vbCr+_
"- Your unlooper is not connected to the same COM port selected in the WinExplorer settings."+vbCr+_
"- Your unlooper is not a WildThing-compatible unlooper."+vbCr+_
"- Your unlooper is not powered on."+vbCr+vbCr+_
"Please correct this problem and try to run the script again."
Call Sc.MsgBox(ErrorString,vbCritical,ScriptName+" "+ScriptVer+" - Communication Error")
VerifyUnlooper=0
End If
End Function
Sub WaitCardInsert()
' This function waits for a card to be inserted
Call Sc.ProgressBox("Please Insert A Card into the Unlooper"+vbCr+"(With NO DPBB/Bootloader - Insert the card by itself)"+vbCr+"(It may take a few seconds to recognize that the card is inserted.)",1,100,ScriptName+" "+ScriptVer+" - Insert Card")
Do While (CardInserted()=0)
Loop
End Sub
Function Params(g)
' This function updates the glitch parameters of the selected glitch
' parameter set. The function returns 1 if the current working glitches
' were updated, 0 otherwise.
Dim Temp
Params=0
' Initialize to starting values if this is first entry
If DAC(g)=0 And Search(g)=1 Then
DAC(g)=DACI(g)
Delay(g)=DelayI(g)
GlitchDelay(g)=GlitchDelayI(g)
TriesLimit(g)=TriesLimitI(g)
Tries(g)=0
Params=1
Else
Tries(g)=Tries(g)+1
If Search(g)=0 Then ' We're trying glitch settings that worked before.
' If we have tried these settings repeatedly and reached the fail limit, this is not a real good
' set of glitch parameters, so try to find a different set.
If Tries(g)>FailsLimit(g) Then
Search(g)=1
Tries(g)=TriesLimit(g)+1
End If
End If
If Search(g)=1 Then ' We're searching for glitch parameters that work
' If we have tried these settings repeatedly and reached the tries limit, these parameters didn't
' work, so try to find a different set.
TotalTries(g)=TotalTries(g)+1 ' Only increment TotalTries when searching
If Tries(g)>TriesLimit(g) Then
If GlitchLogic(g)=0 Then ' Increment the parameters
Temp=ParmInc(DAC(g),DACL(g),DACH(g),ParmInc(Delay( g),DelayL(g),DelayH(g),ParmInc(GlitchDelay(g),Glit chDelayL(g),GlitchDelayH(g),1)))
Else
DAC(g)=RandomRange(DACL(g),DACH(g)) ' Select random voltage
Delay(g)=RandomRange(DelayL(g),DelayH(g)) ' Select random delay
GlitchDelay(g)=RandomRange(GlitchDelayL(g),GlitchD elayH(g)) ' Select random glitch delay
End If
TriesLimit(g)=TriesLimitN(g)
Tries(g)=0
Params=1
End If
End If
End If
End Function
Sub GlitchMsg(t)
' This function displays a progress box on the status of unlooping
' What is displayed depends on the task the sub is called with, t
Dim i
Dim Msg
Msg="Status:"+vbTab+"Glitching ..."+vbCr+"Sequ: "+vbTab
If t>=1 Then
Msg=Msg+HexString(DAC(TaskSet(1)),2)+"/"+HexString(Delay(TaskSet(1)),4)+"/"+HexString(GlitchDelay(TaskSet(1)),2)
End If
If t>=3 Then
Msg=Msg+"/"+HexString(DAC(TaskSet(3)),2)+"/"+HexString(Delay(TaskSet(3)),4)+"/"+HexString(GlitchDelay(TaskSet(3)),2)
End If
If t>=4 Then
Msg=Msg+"/"+HexString(DAC(TaskSet(4)),2)+"/"+HexString(Delay(TaskSet(4)),4)+"/"+HexString(GlitchDelay(TaskSet(4)),2)
End If
Msg=Msg+vbCr+"ATR: "+vbTab
If t>=1 Then
If ATR(0)<>&H100 Then
Msg=Msg+HexString(ATR(0),2)+" "
Else
Msg=Msg+"----"
End If
End If
If t>=2 Then
For i=1 to 10
Msg=Msg+HexString(ATR(i),2)+" "
Next
End If
If t>=3 Then
For i=11 to 12
Msg=Msg+HexString(ATR(i),2)+" "
Next
End If
Call Sc.ProgressBox(Msg,t,5,ScriptName+" "+ScriptVer+" - Unloop Procedure")
End Sub
Sub GenericMsg(Message)
' This function displays a progress box on the status of unlooping
' No glitches or ATR are displayed, only the passed Message
Dim i
Dim Msg
Msg="Status: "+vbTab+Message+vbCr+"Sequ: "+vbCr+"ATR: "
Call Sc.ProgressBox(Msg,1,5,ScriptName+" "+ScriptVer+" - Unloop Procedure")
End Sub
Sub RWMsg(Message,Progress,MaxProgress)
' This function displays a progress box on the status of unlooping
' The full glitch sequence and ATR are displayed along with the passed Message
' The Progress and MaxProgress control the progress bar, Progress is auto-incremented
Dim i
Dim Msg
Msg="Status: "+vbTab+Message+vbCr+"Sequ: "+vbTab
Msg=Msg+HexString(DAC(TaskSet(1)),2)+"/"+HexString(Delay(TaskSet(1)),4)+"/"+HexString(GlitchDelay(TaskSet(1)),2)+"/"
Msg=Msg+HexString(DAC(TaskSet(3)),2)+"/"+HexString(Delay(TaskSet(3)),4)+"/"+HexString(GlitchDelay(TaskSet(3)),2)+"/"
Msg=Msg+HexString(DAC(TaskSet(4)),2)+"/"+HexString(Delay(TaskSet(4)),4)+"/"+HexString(GlitchDelay(TaskSet(4)),2)+" - Success!"+vbCr+"ATR: "+vbTab
For i=0 to 12
Msg=Msg+HexString(ATR(i),2)+" "
Next
Call Sc.ProgressBox(Msg,Progress,MaxProgress,ScriptName +" "+ScriptVer+" - Unloop Procedure")
End Sub
Sub RemoveMsg()
' This function removes the progress box from the screen.
Call Sc.ProgressBox("",0,0,"")
End Sub
Function GetCardInfo(EID,CAMID,USW,IRD,LastDynCode)
GetCardInfo=0
If ReadViaBootloader("8008",&H08,EID)=0 Then Exit Function
If ReadViaBootloader("8374",&H04,CAMID)=0 Then Exit Function
If HexToDec(Left(CAMID,2))>=&H80 Then CAMID=HexString(HexToDec(Left(CAMID,2))-&H80,2)+Right(CAMID,6)
If ReadViaBootloader("8406",&H02,USW)=0 Then Exit Function
If ReadViaBootloader("83D0",&H04,IRD)=0 Then Exit Function
If HexToDec(USW)>=63 And HexToDec(USW)<67 Then
If ReadViaBootloader("893C",&H11,LastDynCode)=0 Then Exit Function
ElseIf HexToDec(USW)=67 Then
If ReadViaBootloader("8924",&H15,LastDynCode)=0 Then Exit Function
End If
GetCardInfo=1
End Function
Function ReadBin()
' This function reads the bin off the card via the stack unwind, and saves
' it to a file. The read stack must already be on the card. The function
' returns 1 on successful read, 0 on failure.
Dim Progress
Dim i,j,k
Dim EEPROM(4096)
Dim ToWrite
ReadBin=0
For i=&H80 to &H8F
For j=&H00 to &HC0 Step &H40
Call RWMsg("Reading EEPROM ...",Progress,64)
ToWrite="BF" ' Glitch Procedure, read 64 bytes, end procedure
SendGP(ToWrite)
If GPRLen<>&H40 Then Exit Function
For k=&H0 to &H3F
EEPROM((i-&H80)*&H100+j+k)=GPR(k)
Next
Progress=Progress+1
Next
Next
i=SaveEEPROMFile(EEPROM)
ReadBin=1
End Function
' =============================
' = Basic Unlooper Procedures =
' =============================
Function UnlooperResetVerify()
' This function attempts to reset the unlooper and verify that it is
' present, connected, and working properly. 1 is returned if successful,
' 0 if not.
Dim RetVal,UnlooperID
Dim i
UnlooperResetVerify=0
Sc.ByteDelay=0 ' Unlooper doesn't need byte delay
Call Sc.Reset() ' Reset the unlooper
RetVal=Sc.Flush() ' Flush the receive buffer
If SendUL("90")=1 Then ' Ask the unlooper to identify itself
If Sc.Read(4)=4 Then ' We should receive 4 bytes from unlooper
For i=0 to 3 ' Assemble the unlooper version string
UnlooperID=UnlooperID+Chr(Sc.GetByte(i))
Next
If (UnlooperID="V5.0" Or UnlooperID="SU-2") Then
UnlooperResetVerify=1 ' We are successfully communicating with a WildThing or SU-2 Unlooper
Sc.Write("A0") ' Turn LED off if it is on
End If
End If
End If
End Function
Function CardInserted()
' This function determines whether a card is inserted in the unlooper.
' 1 is returned if Yes, 0 if no.
Dim RetVal
CardInserted=0
If SendUL("80")=1 Then
Sc.Read(1)
If Sc.GetByte(0)=&HFF Then
CardInserted=1
End If
End If
End Function
Function CheckGoodCard()
' This function checks to see if the card currently in the unlooper is not looped
' 1 is returned if the card is currently good, 0 if there is something wrong with it
Dim ToWrite
Dim GoodATR(13)
Dim i
GoodATR(0)=&H3F
GoodATR(1)=&H78
GoodATR(2)=&H12
GoodATR(3)=&H25
GoodATR(4)=&H01
GoodATR(5)=&H40
GoodATR(6)=&HB0
GoodATR(7)=&H03
GoodATR(8)=&H4A
GoodATR(9)=&H50
GoodATR(10)=&H20
GoodATR(11)=&H48
GoodATR(12)=&H55
' Set the DAC Voltage
ToWrite="B080" ' Set DAC to 80h
Sc.Write(ToWrite)
ToWrite="10018C" ' Glitch procedure, set baud to ATR, reset card, receive 13 bytes, end procedure
SendGP(ToWrite)
i=0
Do While (GPRLen>i)
ATR(i)=GPR(i)
i=i+1
Loop
CheckGoodCard=0
' See if the ATR is good
If (GPRLen=13) Then
CheckGoodCard=1
For i=0 to 12
If ATR(i)<>GoodATR(i) Then
CheckGoodCard=0
End If
Next
End If
' If so, see if the card will process a packet
If CheckGoodCard=1 Then
ToWrite="15C448060000000E0283" ' Glitch procedure, transmit packet header, Set watchdog timer to 02, receive 4 bytes, end procedure
SendGP(ToWrite)
If (GPRLen<>4 Or GPR(2)<>&H90 Or GPR(3)<>&H00) Then
CheckGoodCard=0 ' See if we get a response from the packet
End If
End If
End Function
Function CheckGoodCardBS()
' This function checks to see if the card currently in the unlooper is not looped
' 1 is returned if the card is currently good, 0 if there is something wrong with it
Dim ToWrite
Dim GoodATR(13)
Dim i
GoodATR(0)=&H3F
GoodATR(1)=&H78
GoodATR(2)=&H12
GoodATR(3)=&H25
GoodATR(4)=&H01
GoodATR(5)=&H40
GoodATR(6)=&HB0
GoodATR(7)=&H03
GoodATR(8)=&H4A
GoodATR(9)=&H50
GoodATR(10)=&H20
GoodATR(11)=&H48
GoodATR(12)=&H55
' Set the DAC Voltage
ToWrite="B080" ' Set DAC to 80h
Sc.Write(ToWrite)
ToWrite="10012003D50B8C" ' Glitch procedure, set baud to ATR, reset card, delay 03D5 clock cycles, glitch Vcc, receive 13 bytes, end procedure
SendGP(ToWrite)
i=0
Do While (GPRLen>i)
ATR(i)=GPR(i)
i=i+1
Loop
CheckGoodCardBS=0
' See if the ATR is good
If (GPRLen=13) Then
CheckGoodCardBS=1
For i=0 to 12
If ATR(i)<>GoodATR(i) Then
CheckGoodCardBS=0
End If
Next
End If
' If so, see if the card will process a packet
If CheckGoodCardBS=1 Then
ToWrite="15C448060000000E0283" ' Glitch procedure, set baud to P2 normal xmit/rcv, transmit packet header, set watchdog timer to 02, receive 4 bytes, end procedure
SendGP(ToWrite)
If (GPRLen<>4 Or GPR(2)<>&H90 Or GPR(3)<>&H00) Then
CheckGoodCardBS=0 ' See if we get a response from the packet
End If
End If
End Function
Sub SendGP(GP)
' This subroutine sends a glitch packet to the unlooper and receives the response
' The glitch packet should not have the length byte or the end procedure commands
Dim Length
Dim i
Call Replace(GP," ","")
GP=GP+"00" ' Add the end procedure byte
Length=Len(GP)\2
GP=HexString(Length,2)+GP ' Add the glitch procedure start/length byte
If SendUL(GP)=1 Then ' Send the glitch packet, and if we received a response,
If Sc.Read(2)=2 Then ' Did we get 2 bytes? If so,
' Receive the response packet "# bytes processed" byte and "bytes to send" byte
GPPLen=Sc.GetByte(0) ' Get the processed byte length from unlooper
GPRLen=Sc.GetByte(1) ' Get the number of bytes the unlooper has to send
If GPRLen>0 Then Sc.Read(GPRLen) ' Read additional bytes from the unlooper if they're coming
i=0
Do While (GPRLen>i) ' Put all bytes that the unlooper had to send into the GPR array
GPR(i)=Sc.GetByte(i)
i=i+1
Loop
Else
' We didn't receive 2 bytes from the unlooper
GPPLen=0
GPRLen=0
End If
Else
' We didn't receive a response from the unlooper
GPPLen=0
GPRLen=0
End If
End Sub
Function ReadViaBootloader(Address,Length,Bytes)
' This function reads EEPROM via the bootloader.
' The bytes read are returned in in the Bytes variable if the read was successful
' The empty string is returned otherwise. The function returns 1 on a successful
' read, 0 on failure
Dim TempStr
Dim AddrH, AddrL, RcvLen
Dim i
Dim ToWrite
AddrH=Left(Address,2)
AddrL=Right(Address,2)
RcvLen=HexString(Length+&H80,2)
ToWrite="1F" ' Glitch procedure, set baud to Debug
ToWrite=ToWrite+InsertByteDelay(AddrH+AddrL+HexStr ing(Length,2))
ToWrite=ToWrite+RcvLen ' Receive Length+1 bytes
SendGP(ToWrite)
Bytes=""
ReadViaBootloader=0
If GPRLen>0 Then
If GPR(GPRLen-1)=&H52 Then
For i=0 to GPRLen-2
Bytes=Bytes+HexString(GPR(i),2)
Next
ReadViaBootloader=1
End If
End If
End Function
Function WriteViaBootloader(Address,DeclLength,Bytes)
' This function writes bytes to EEPROM using the bootloader
' It returns 1 on no error, 0 on unsuccessful write
Dim AddrH, AddrL, SendLen, Length
Dim ToWrite
WriteViaBootloader=0
AddrH=Left(Address,2)
AddrL=Right(Address,2)
Call Replace(Bytes," ","")
Length=Len(Bytes)\2
If Length<>DeclLength Then Exit Function ' Make sure actual number of bytes is same as declared
SendLen=HexString(Length+&H80,2)
ToWrite="1F" ' Glitch procedure, set baud rate to Debug
ToWrite=ToWrite+InsertByteDelay(AddrH+AddrL+SendLe n+Bytes)
ToWrite=ToWrite+"0E0A80" ' set watchdog timer to 0Ah, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 And GPR(0)=&HFF Then
WriteViaBootloader=1
End If
End Function
Function InsertByteDelay(Bytes)
' This function places 283 cycle clock delays in between each byte of Bytes and returns the
' resulting string. This is used when bytes need to be send to the bootloader
Dim Length,BuildString
Dim i
Call Replace(Bytes," ","")
Length=Len(Bytes)\2
BuildString="C0"+Left(Bytes,2) ' Glitch procedure, transmit 1 byte
For i=1 to Length-1
BuildString=BuildString+"200100C0"+Mid(Bytes,i*2+1 ,2) ' delay 283 clock cycles, transmit 1 byte
Next
InsertByteDelay=BuildString
End Function
Function ExitBootloader(WriteListBoot)
' This function exits the bootloader and erases it from the card
' It returns 1 when bootloader is successfully erased, 0 if error
Dim ToWrite
Dim i,j
Call RWMsg("Exiting Bootloader ...",225,225)
ToWrite=InsertByteDelay("0000D2") ' Glitch procedure, transmit 3 bytes with 283 clock cycle delay, end procedure
SendGP(ToWrite)
For i=0 To 64 Step 8
ToWrite=""
For j=0 to 7 ' Send 8 bytes at a time with 283 cycle clock delay on each
ToWrite=ToWrite+HexString(WriteListBoot(i+j),2)
Next
ToWrite=InsertByteDelay(ToWrite)
SendGP(ToWrite)
Next
ToWrite=InsertByteDelay("32000F04930468485011") ' Send the ending stack to overwrite the bootloader and exit
ToWrite=ToWrite+"0E0B8001" ' Glitch procedure, set watchdog timer to 0Bh, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 and GPR(0)=&H55 Then
ExitBootloader=1
Else
ExitBootloader=0
End If
End Function
Function WriteWriteList(WriteListEEP)
' This function writes the EEPROM information stored in WriteList to the card
' via the bootloader.
Dim i,TotalLines
Dim Address,Length,Bytes
WriteWriteList=0
TotalLines=0
Do While (WriteListEEP(TotalLines)<>"") ' Find total number of lines we need to write
TotalLines=TotalLines+1
Loop
For i=0 to TotalLines-1
Call RWMsg("Writing EEPROM ...",i,TotalLines) ' Send message that we're writing the lines
Address=Left(WriteListEEP(i),4) ' Get the address,
Length=HexToDec(Mid(WriteListEEP(i),5,2)) ' the length,
Bytes=Right(WriteListEEP(i),Len(WriteListEEP(i))-6) ' and the bytes to write
If WriteViaBootloader(Address,Length,Bytes)=0 Then Exit Function ' Write 'em via the bootloader
Next
WriteWriteList=1
End Function
' ===================================
' = Unlooper Base Glitch Procedures =
' ===================================
Function GlitchTask1(g)
' This function applies the first glitch to the card:
' Glitch Task 1 - Glitch past Black Sunday 8000h/33h check
'
' The function returns 1 if the glitch was successful, 0 if it failed.
' The current glitch values are always used - it is the responsibility
' of the caller to keep track of tries and change the glitch values
' The routine only tries the glitch once.
' The routine will try any set of glitch parameters in the array, as
' called with the g variable
Dim ToWrite
Dim i
ToWrite="B0"+HexString(DAC(g),2) ' Set glitch voltage (DAC)
Sc.Write(ToWrite)
Select Case GlitchProc(g)
Case 1:
ToWrite="10012003D5" ' Glitch procedure, set baud to ATR, reset card, delay 03D5h clock cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX clock cycles
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
Case 2:
ToWrite="10012003D5" ' Glitch procedure, set baud to ATR, reset card, delay 03D5h clock cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX clock cycles
ToWrite=ToWrite+"0C"+HexString(GlitchDelay(g),2) ' Glitch Vcc, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"0C"+HexString(GlitchDelay(g),2) ' Glitch Vcc, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
Case 3:
ToWrite="1001" ' Glitch procedure, set baud to ATR, reset card
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX clock cycles
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
End Select
SendGP(ToWrite)
i=0
If GPRLen=0 Then ATR(0)=&H100 ' Flag no ATR if we didn't get a response
Do While (GPRLen>i)
ATR(i)=GPR(i)
i=i+1
Loop
GlitchTask1=0
If (GPRLen>0 And ATR(0)=&H3F) Then
GlitchTask1=1
End If
End Function
Function GlitchTask2(g)
' This function applies the second glitch to the card:
' Glitch Task 2 - Get next 10 bytes of ATR
'
' The function returns 1 if the glitch was successful, 0 if it failed.
' The current glitch values are always used - it is the responsibility
' of the caller to keep track of tries and change the glitch values
' The routine only tries the glitch once
Dim i
SendGP("89") ' Glitch procedure, receive 10 bytes, end procedure
For i=1 to 10
ATR(i)=GPR(i-1)
Next
GlitchTask2=1
End Function
Function GlitchTask3(g)
' This function applies the third glitch to the card:
' Glitch Task 3 - Glitch for last 2 bytes of ATR and packet response
'
' The function returns 1 if the glitch was successful, 0 if it failed.
' The current glitch values are always used - it is the responsibility
' of the caller to keep track of tries and change the glitch values
' The routine only tries the glitch once
' The routine will try any set of glitch parameters in the array, as
' called with the g variable
Dim ToWrite
Dim i
ToWrite="B0"+HexString(DAC(g),2)
Sc.Write(ToWrite) ' Set DAC voltage
Select Case GlitchProc(g)
Case 1:
ToWrite="040720"+HexString(Delay(g),4) ' Glitch procedure, pull I/O high, wait I/O low, delay XXXX clock cycles
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"03202710" ' Pull I/O low, Delay 2710h clock cycles
ToWrite=ToWrite+"81" ' Read 2 bytes from unlooper, end procedure
End Select
SendGP(ToWrite)
i=0
Do While (GPRLen>i)
ATR(i+11)=GPR(i)
i=i+1
Loop
If Search(3)=1 Then
GlitchTask3=0
ToWrite="C4480600000083" ' Glitch procedure, transmit packet header, receive 4 bytes, end procedure
SendGP(ToWrite)
If (GPRLen=4 And GPR(2)=&H90 And GPR(3)=&H00) Then
GlitchTask3=1 ' See if we get a response from the packet
End If
Else
GlitchTask3=1
End If
End Function
Function GlitchTask4(g)
' This function applies the fourth glitch to the card:
' Glitch Task 4 - Glitch to try to fill memory with stack and bootloader for writing
'
' The function returns 1 if the glitch was successful, 0 if it failed.
' The current glitch values are always used - it is the responsibility
' of the caller to keep track of tries and change the glitch values
' The routine only tries the glitch once
' The routine will try any set of glitch parameters in the array, as
' called with the g variable
Dim ToWrite
Dim i
ToWrite="B0"+HexString(DAC(g),2) ' Set DAC Voltage
Sc.Write(ToWrite)
Select Case GlitchProc(g)
Case 1:
ToWrite="C348060000" ' Glitch procedure, transmit 4 byte header
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX Cycles
ToWrite=ToWrite+"C0D2" ' Transmit 1 byte
ToWrite=ToWrite+"20"+HexString(GlitchDelay(g),4) ' Delay XXXX Cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc, end procedure
End Select
SendGP(ToWrite)
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"030000000000000000000000000000000 00000000000000000000000000000000000000000000000000 0802802FD000000000000000000000000000000000000"
SendGP(ToWrite)
GlitchTask4=0
If (GPPLen=&H42) Then
' Try to write remainder of bootloader
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"000000000000000000000000000000000 00000000000000000000074081205FF1203F2745212040F795 F7A03116112116A10E706FB12014F80E9FAFF79681161"
SendGP(ToWrite)
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"E5836009796812057C35E080D89080208 98122091201C8DAFA2200000000003200F7056105610250119 604904050116A11F70593043600360036003600360036"
SendGP(ToWrite)
ToWrite="CA" ' Glitch procedure, attempt to fill memory with 11 bytes
ToWrite=ToWrite+"0036003600360036003600"
SendGP(ToWrite)
ToWrite="C6" ' Glitch procedure, final wrap-around to unwind the stack
ToWrite=ToWrite+"1F802000FF0301"
SendGP(ToWrite)
' See if the stack got unwound
ToWrite="80" ' Glitch procedure, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 And GPR(0)=&H55 Then ' Bootloader stack got unwound
ToWrite="0E0B80" ' Glitch procedure, set watchdog timer to 11, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 and GPR(0)=&H77 Then
GlitchTask4=1 ' Bootloader is on the card!
End If
End If
End If
End Function
Function GlitchTask4B(g)
' This function applies the first glitch to the card:
' Glitch Task 4 - Glitch to try to fill memory with stack for reading
'
' The function returns 1 if the glitch was successful, 0 if it failed.
' The current glitch values are always used - it is the responsibility
' of the caller to keep track of tries and change the glitch values
' The routine only tries the glitch once
' The routine will try any set of glitch parameters in the array, as
' called with the g variable
Dim ToWrite
Dim i
ToWrite="B0"+HexString(DAC(g),2) ' Set DAC Voltage
Sc.Write(ToWrite)
Select Case GlitchProc(g)
Case 1:
ToWrite="C348060000" ' Glitch procedure, transmit 4 byte header
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX Cycles
ToWrite=ToWrite+"C0D2" ' Transmit 1 byte
ToWrite=ToWrite+"20"+HexString(GlitchDelay(g),4) ' Delay XXXX Cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc, end procedure
End Select
SendGP(ToWrite)
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"030000000000000000000000000000000 00000000000000000000000000000000000000000000000000 080000000000000000000000000000000000000000000"
SendGP(ToWrite)
GlitchTask4B=0
If (GPPLen=&H42) Then
' Try to write remainder of stack
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"000000000000000000000000000000000 00000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000003200F7"
SendGP(ToWrite)
ToWrite="FF" ' Glitch procedure, attempt to fill memory with 64 bytes
ToWrite=ToWrite+"059304F70561058A078A078A078A078A0 78A078A078A078A078A078A078A078A078A078A078A0700005 5066A11F7056105F70593043600360036003600360036"
SendGP(ToWrite)
ToWrite="CA" ' Glitch procedure, attempt to fill memory with 11 bytes
ToWrite=ToWrite+"0036003600360036003600"
SendGP(ToWrite)
ToWrite="C6" ' Glitch procedure, final wrap-around to unwind the stack
ToWrite=ToWrite+"1F000000FF0301"
SendGP(ToWrite)
' See if the stack got unwound
ToWrite="80" ' Glitch procedure, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 And GPR(0)=&H55 Then ' Stack got unwound
ToWrite="0E0B80" ' Glitch procedure, set watchdog timer to 11, receive 1 byte, end procedure
SendGP(ToWrite)
If GPRLen=1 and GPR(0)=&H77 Then
GlitchTask4B=1 ' Ready to read the card!
End If
End If
End If
End Function
Function GlitchTask5(g)
' This function attempts to activate the unlooper bootloader that is
' supposed to be on the card. 1 is returned if successful, 0 if not.
'
' The routine will try any set of glitch parameters in the array, as
' called with the g variable
Dim ToWrite
Dim i
' Glitch procedure 5 - Glitch past Black Sunday 8000h/33h check and into bootloader
ToWrite="B0"+HexString(DAC(g),2) ' Set glitch voltage (DAC)
Sc.Write(ToWrite)
Select Case GlitchProc(g)
Case 1:
ToWrite="1F012003D5" ' Glitch procedure, set baud to Debug, reset card, delay 03D5h clock cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX clock cycles
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"0D"+HexString(GlitchDelay(g),2) ' Overrev clock, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
Case 2:
ToWrite="1F012003D5" ' Glitch procedure, set baud to Debug, reset card, delay 03D5h clock cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc
ToWrite=ToWrite+"20"+HexString(Delay(g),4) ' Delay XXXX clock cycles
ToWrite=ToWrite+"0C"+HexString(GlitchDelay(g),2) ' Glitch Vcc, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"0C"+HexString(GlitchDelay(g),2) ' Glitch Vcc, delay XX clock cycles, glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
Case 3:
ToWrite="1F0120"+HexString(Delay(g),4) ' Glitch procedure, set baud to Debug, reset card, delay 03D5h clock cycles
ToWrite=ToWrite+"0B" ' Glitch Vcc
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
Case 4:
ToWrite="1F01202710" ' Glitch procedure, set baud to Debug, reset card, delay 2710h clock cycles
ToWrite=ToWrite+"80" ' Read 1 byte from unlooper, end procedure
End Select
SendGP(ToWrite)
GlitchTask5=0
If (GPRLen>0 And GPR(0)=&H52) Then
GlitchTask5=1 ' See if the bootloader is on the card
End If
End Function
' ============================
' = File-Handling Procedures =
' ============================
Function SaveEEPROMFile(EEPROM)
Dim GotInput
Dim OutFile
Dim FileSize
Dim i
Dim FileName
Dim Fuse,FuseXor
Dim CAMID
Const FileFilter="Bin Files (*.bin)|*.bin|All Files (*.*)|*.*"
FileName=""
GotInput=False
SaveEEPROMFile=False
For i=&H374 to &H377
CAMID=CAMID+HexString(EEPROM(i),2)
Next
CAMID=CAMID+".bin"
Do
FileName=Fs.FileSaveDialog(FileFilter,ScriptName+" "+ScriptVer+" - Save Bin File",CAMID)
If (FileName<>"") Then ' If the filename returned is empty, the user clicked cancel.
OutFile=Fs.FileCreate(FileName) ' Create the new file
Call Fs.FileSeek(OutFile,&H0,fsoSEEK_SET)
For i=0 to 4095
Call Fs.FilePutc(OutFile,EEPROM(i))
Next
GotInput=True
SaveEEPROMFile=True
Fs.FileClose(OutFile)
Else
GotInput=True
End If
Loop Until GotInput=True
End Function
Function ReadFile(WriteListEEP,WriteListBoot)
' This function reads a .bin or .img file specified by the user into
' the WriteListEEP and WriteListBoot arrays
Dim GotInput
Dim Filename
Const FileFilter="Bin Files (*.bin)|*.bin|Image Files (*.img)|*.img"
FileName=""
GotInput=False
ReadFile=0
Do
Filename=Fs.FileOpenDialog(FileFilter,ScriptName+" "+ScriptVer+" - Select File to Write","")
If (Filename<>"") Then ' If the filename returned is empty, the user clicked cancel.
If Fs.FileExists(Filename)<>0 Then ' We have a filename, verify the file exists
If LCase(Right(Filename,4))=".bin" Then
ReadFile=ReadBinFile(Filename,WriteListEEP,WriteLi stBoot)
GotInput=True
ElseIf LCase(Right(Filename,4))=".img" Then
ReadFile=ReadImgFile(Filename,WriteListEEP,WriteLi stBoot)
GotInput=True
Else
Call Sc.MsgBox("This is not an .img or .bin file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Wrong File Type")
End If
Else
Call Sc.MsgBox("The file does not exist"+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - File does not exist")
End If
Else
GotInput=UserCancel()
End If
Loop Until GotInput=True
End Function
Function ReadBinFile(Filename,WriteListEEP,WriteListBoot)
' This function reads a .bin file named Filename into the WriteListEEP and WriteListBoot arrays
Dim InFile
Dim FileSize
Dim i,j
Dim Fuse,FuseXor
Dim EEPROM(4096)
Dim DefaultWLB
Dim DisplayFilename
ReadBinFile=0
DisplayFilename=Filename
For i=1 to Len(Filename)
If Mid(Filename,i,1)="\" Then
DisplayFilename=Mid(Filename,i+1)
End If
Next
' Initialize the WriteList arrays
DefaultWLB="00FF440D010312200000000000000000000000 00000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000 000000"
For i=0 to 71
WriteListBoot(i)=HexToDec(Mid(DefaultWLB,i*2+1,2))
Next
For i=0 to 4095
WriteListEEP(i)=""
Next
InFile=Fs.FileOpen(Filename,fsoOpenRead) ' Open the file
FileSize=Fs.FileSeek(InFile,&H0,fsoSEEK_END) ' Seek to the end of the file to get the size
Call Fs.FileSeek(InFile,&H20,fsoSEEK_SET) ' Get the fuse bytes
Fuse=Fs.FileGetc(InFile) ' Make sure the file size is correct and the fuse bytes verify.
FuseXor=Fs.FileGetc(InFile) ' If either of these are not true, the file is not a valid H-card file.
If (FileSize=4096) And ((Fuse XOR FuseXor)=&HFF) Then
Call Fs.FileSeek(InFile,&H0,fsoSEEK_SET) ' We have a valid H-card file - Read it
Call GenericMsg("Loading "+DisplayFilename+" ...") ' Display message that file is being loaded
For i=0 to 4095
EEPROM(i)=Fs.FileGetc(InFile)
Next
' Convert the EEPROM to WriteListEEP and WriteListBoot
' Use the bin contents from 8020h-806Fh to fill the WriteListBoot array
For i=&H20 to &H67
WriteListBoot(i-&H20)=EEPROM(i)
Next
' Use the bin contents from 8070h-8FFFh to fill the WriteListEEP array
For i=&H68 to &HFE8 Step &H10
WriteListEEP((i-&H68)\16)=HexString((i\&H100)+&H80,2)+HexString ((i Mod &H100),2)+"10"
For j=&H00 to &H0F
WriteListEEP((i-&H68)\16)=WriteListEEP((i-&H68)\16)+HexString(EEPROM(i+j),2)
Next
Next
For i=&HFF8 to &HFF8 Step &H10
WriteListEEP((i-&H68)\16)=HexString((i\&H100)+&H80,2)+HexString ((i Mod &H100),2)+"08"
For j=&H00 to &H07
WriteListEEP((i-&H68)\16)=WriteListEEP((i-&H68)\16)+HexString(EEPROM(i+j),2)
Next
Next
ReadBinFile=1
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be an H-card .bin file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not an H-card File")
End If
Fs.FileClose(InFile)
End Function
Function ReadImgFile(Filename,WriteListEEP,WriteListBoot)
' This function reads an .img file named Filename into the WriteListEEP and WriteListBoot arrays
Dim InFile
Dim i,j
Dim DefaultWLB
Dim NextChar,NextByte,CurPos
Dim LengthHex,Length
Dim AddressHex,AddrH,AddrL
Dim Address
Dim WLEIndex
Dim Checksum
Dim FileSize
Dim Finished
Dim DisplayFilename
ReadImgFile=0
DisplayFilename=Filename
For i=1 to Len(Filename)
If Mid(Filename,i,1)="\" Then
DisplayFilename=Mid(Filename,i+1)
End If
Next
Call GenericMsg("Loading "+DisplayFilename+" ...") ' Display message that file is being loaded
' Initialize the WriteList arrays
DefaultWLB="00FF440D010312200000000000000000000000 00000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000 000000"
For i=0 to 71
WriteListBoot(i)=HexToDec(Mid(DefaultWLB,i*2+1,2))
Next
For i=0 to 4095
WriteListEEP(i)=""
Next
WLEIndex=0
InFile=Fs.FileOpen(Filename,fsoOpenRead) ' Open the file
FileSize=Fs.FileSeek(InFile,&H0,fsoSEEK_END) ' Seek to the end of the file to get the size
Call Fs.FileSeek(InFile,&H0,fsoSEEK_SET) ' Seek back to the beginning of the file
CurPos=0
Finished=0
Do While (Finished=0)
NextChar=""
Do While (NextChar<>":" And CurPos<FileSize) ' Loop until we have the start of an Intel hex line
NextChar=Chr(Fs.FileGetc(InFile))
CurPos=CurPos+1
Loop
If NextChar=":" Then ' Have a line to process. If not, EOF
LengthHex=Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGetc (InFile)) ' Get the length byte
CurPos=CurPos+2
If IsHex(LengthHex) Then
Length=HexToDec(LengthHex)
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
AddressHex=Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGet c(InFile))+Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGet c(InFile))
CurPos=CurPos+4 ' Get the address
If IsHex(AddressHex) Then
AddrH=HexToDec(Left(AddressHex,2))
AddrL=HexToDec(Right(AddressHex,2))
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
If (Length<&H40) And (AddrH>=&H80 And AddrH<=&H8F) Then ' Verify parameters within range
Checksum=Length+AddrH+AddrL
NextByte=Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGetc( InFile)) ' Get the 00h byte
CurPos=CurPos+2
If IsHex(NextByte) Then
Checksum=Checksum+HexToDec(NextByte)
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
For Address=(AddrH*&H100+AddrL) To (AddrH*&H100+AddrL)+Length-1 ' Prepare to read length bytes
NextByte=Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGetc( InFile)) ' Get the next byte
CurPos=CurPos+2
If IsHex(NextByte) Then
Checksum=Checksum+HexToDec(NextByte)
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
If (Address>=32800) And (Address<32872) Then
WriteListBoot(Address-32800)=HexToDec(NextByte)
ElseIf (Address>=32872) And (Address<36864) Then
If WriteListEEP(WLEIndex)="" Then
WriteListEEP(WLEIndex)=HexString(Address,4)+HexStr ing((AddrH*&H100+AddrL)+Length-Address,2)
End If
WriteListEEP(WLEIndex)=WriteListEEP(WLEIndex)+Next Byte
End If
Next
NextByte=Chr(Fs.FileGetc(InFile))+Chr(Fs.FileGetc( InFile)) ' Get the Checksum byte
CurPos=CurPos+2
If IsHex(NextByte) Then
Checksum=(&H100-(Checksum Mod &H100)) Mod &H100
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
If Checksum<>HexToDec(NextByte) Then
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
If WriteListEEP(WLEIndex)<>"" Then WLEIndex=WLEIndex+1
ElseIf (Length=0) Then
' Ignore lines with 0 bytes to write (like config records)
Else
Call RemoveMsg()
Call Sc.MsgBox("The file does not appear to be valid .img file."+vbCrLf,vbExclamation+vbOKOnly,ScriptName+" "+ScriptVer+" - Not a Valid .img File")
Fs.FileClose(InFile)
Exit Function
End If
Else
Finished=1
End If
Loop
ReadImgFile=1
Fs.FileClose(InFile)
End Function
' ========================
' = Low-Level Procedures =
' ========================
Sub SetGlitchValues()
Dim i
' Glitch Task 1 Parameter Set A
DAC(1)=&H0
DACL(1)=&H70
DACI(1)=&H82
DACH(1)=&H90
Delay(1)=&H0
DelayL(1)=&H2157
DelayI(1)=&H2158
DelayH(1)=&H2159
GlitchDelay(1)=&H0
GlitchDelayL(1)=&H10
GlitchDelayI(1)=&H20
GlitchDelayH(1)=&H40
Tries(1)=0
TotalTries(1)=0
TriesLimit(1)=0
TriesLimitN(1)=3
TriesLimitI(1)=50
GlitchProc(1)=3
AltProc(1)=5
AltProcTriesLimit(1)=500
FailsLimit(1)=35
GlitchLogic(1)=1
Search(1)=1
' Glitch Task 2 Parameter Set A
' This is an unused set of glitch parameters. Unused glitch parameters should
' be set as follows for proper glitch display.
DAC(2)=&H1
DACL(2)=&H1
DACI(2)=&H1
DACH(2)=&H1
Delay(2)=&H0
DelayL(2)=&H0
DelayI(2)=&H0
DelayH(2)=&H0
GlitchDelay(2)=&H0
GlitchDelayL(2)=&H0
GlitchDelayI(2)=&H0
GlitchDelayH(2)=&H0
Tries(2)=0
TotalTries(2)=0
TriesLimit(2)=0
TriesLimitN(2)=1
TriesLimitI(2)=1
GlitchProc(2)=1
AltProc(2)=0
AltProcTriesLimit(2)=500
FailsLimit(2)=1
GlitchLogic(2)=0
Search(2)=0
' Glitch Task 3 Parameter Set A
DAC(3)=&H0
DACL(3)=&H70
DACI(3)=&H82
DACH(3)=&H90
Delay(3)=&H0
DelayL(3)=&H600
DelayI(3)=&H604
DelayH(3)=&H618
GlitchDelay(3)=&H0
GlitchDelayL(3)=&H30
GlitchDelayI(3)=&H38
GlitchDelayH(3)=&H40
Tries(3)=0
TotalTries(3)=0
TriesLimit(3)=0
TriesLimitN(3)=2
TriesLimitI(3)=10
GlitchProc(3)=1
AltProc(3)=11
AltProcTriesLimit(3)=250
FailsLimit(3)=25
GlitchLogic(3)=1
Search(3)=1
' Glitch Task 4 Parameter Set A
DAC(4)=&H0
DACL(4)=&H70
DACI(4)=&H82
DACH(4)=&HA0
Delay(4)=&H0
DelayL(4)=&H4550
DelayI(4)=&H4E20
DelayH(4)=&H5000
GlitchDelay(4)=&H0
GlitchDelayL(4)=&H128
GlitchDelayI(4)=&H138
GlitchDelayH(4)=&H150
Tries(4)=0
TotalTries(4)=0
TriesLimit(4)=0
TriesLimitN(4)=1
TriesLimitI(4)=40
GlitchProc(4)=1
AltProc(4)=0
AltProcTriesLimit(4)=500
FailsLimit(4)=10
GlitchLogic(4)=1
Search(4)=1
' Glitch Task 1 Parameter Set B
DAC(5)=&H0
DACL(5)=&H70
DACI(5)=&H82
DACH(5)=&H90
Delay(5)=&H0
DelayL(5)=&H1D00
DelayI(5)=&H1D2B
DelayH(5)=&H1D40
GlitchDelay(5)=&H0
GlitchDelayL(5)=&H08
GlitchDelayI(5)=&H0C
GlitchDelayH(5)=&H10
Tries(5)=0
TotalTries(5)=0
TriesLimit(5)=0
TriesLimitN(5)=3
TriesLimitI(5)=100
GlitchProc(5)=1
AltProc(5)=12
AltProcTriesLimit(5)=2500
FailsLimit(5)=100
GlitchLogic(5)=1
Search(5)=1
' Glitch Task 1 Parameter Set D
DAC(6)=&H0
DACL(6)=&H70
DACI(6)=&H82
DACH(6)=&H90
Delay(6)=&H0
DelayL(6)=&H1D29
DelayI(6)=&H1D2B
DelayH(6)=&H1D2D
GlitchDelay(6)=&H0
GlitchDelayL(6)=&H0A
GlitchDelayI(6)=&H0C
GlitchDelayH(6)=&H0E
Tries(6)=0
TotalTries(6)=0
TriesLimit(6)=0
TriesLimitN(6)=3
TriesLimitI(6)=100
GlitchProc(6)=1
AltProc(6)=7
AltProcTriesLimit(6)=1000
FailsLimit(6)=100
GlitchLogic(6)=1
Search(6)=1
' Glitch Task 1 Parameter Set E
DAC(7)=&H0
DACL(7)=&H70
DACI(7)=&H82
DACH(7)=&H90
Delay(7)=&H0
DelayL(7)=&H1D29
DelayI(7)=&H1D2B
DelayH(7)=&H1D2D
GlitchDelay(7)=&H0
GlitchDelayL(7)=&H0D
GlitchDelayI(7)=&H0F
GlitchDelayH(7)=&H11
Tries(7)=0
TotalTries(7)=0
TriesLimit(7)=0
TriesLimitN(7)=3
TriesLimitI(7)=100
GlitchProc(7)=2
AltProc(7)=8
AltProcTriesLimit(7)=1000
FailsLimit(7)=100
GlitchLogic(7)=1
Search(7)=1
' Glitch Task 1 Parameter Set F
DAC(8)=&H0
DACL(8)=&H70
DACI(8)=&H82
DACH(8)=&H90
Delay(8)=&H0
DelayL(8)=&H1D19
DelayI(8)=&H1D1B
DelayH(8)=&H1D1D
GlitchDelay(8)=&H0
GlitchDelayL(8)=&H0A
GlitchDelayI(8)=&H0D
GlitchDelayH(8)=&H11
Tries(8)=0
TotalTries(8)=0
TriesLimit(8)=0
TriesLimitN(8)=3
TriesLimitI(8)=50
GlitchProc(8)=1
AltProc(8)=1
AltProcTriesLimit(8)=1000
FailsLimit(8)=100
GlitchLogic(8)=1
Search(8)=1
' Glitch Task 5 Parameter Set A
DAC(9)=&H0
DACL(9)=&H70
DACI(9)=&H82
DACH(9)=&H90
Delay(9)=&H0
DelayL(9)=&H3D4
DelayI(9)=&H3D5
DelayH(9)=&H3D6
GlitchDelay(9)=&H0
GlitchDelayL(9)=&H08
GlitchDelayI(9)=&H0B
GlitchDelayH(9)=&H10
Tries(9)=0
TotalTries(9)=0
TriesLimit(9)=0
TriesLimitN(9)=3
TriesLimitI(9)=3
GlitchProc(9)=4
AltProc(9)=10
AltProcTriesLimit(9)=3
FailsLimit(9)=25
GlitchLogic(9)=1
Search(9)=1
' Glitch Task 5 Parameter Set B
DAC(10)=&H0
DACL(10)=&H70
DACI(10)=&H82
DACH(10)=&H90
Delay(10)=&H0
DelayL(10)=&H3D4
DelayI(10)=&H3D5
DelayH(10)=&H3D6
GlitchDelay(10)=&H0
GlitchDelayL(10)=&H08
GlitchDelayI(10)=&H0B
GlitchDelayH(10)=&H10
Tries(10)=0
TotalTries(10)=0
TriesLimit(10)=0
TriesLimitN(10)=3
TriesLimitI(10)=10
GlitchProc(10)=3
AltProc(10)=9
AltProcTriesLimit(10)=25
FailsLimit(10)=25
GlitchLogic(10)=1
Search(10)=1
' Glitch Task 3 Parameter Set B
DAC(11)=&H0
DACL(11)=&H70
DACI(11)=&H82
DACH(11)=&H90
Delay(11)=&H0
DelayL(11)=&H600
DelayI(11)=&H630
DelayH(11)=&H6B0
GlitchDelay(11)=&H0
GlitchDelayL(11)=&H10
GlitchDelayI(11)=&H20
GlitchDelayH(11)=&H40
Tries(11)=0
TotalTries(11)=0
TriesLimit(11)=0
TriesLimitN(11)=2
TriesLimitI(11)=2
GlitchProc(11)=1
AltProc(11)=3
AltProcTriesLimit(11)=500
FailsLimit(11)=35
GlitchLogic(11)=1
Search(11)=1
' Glitch Task 1 Parameter Set C
DAC(12)=&H0
DACL(12)=&H70
DACI(12)=&H82
DACH(12)=&H90
Delay(12)=&H0
DelayL(12)=&H1D60
DelayI(12)=&H1D80
DelayH(12)=&H1DA0
GlitchDelay(12)=&H0
GlitchDelayL(12)=&H06
GlitchDelayI(12)=&H0C
GlitchDelayH(12)=&H14
Tries(12)=0
TotalTries(12)=0
TriesLimit(12)=0
TriesLimitN(12)=3
TriesLimitI(12)=100
GlitchProc(12)=1
AltProc(12)=6
AltProcTriesLimit(12)=2500
FailsLimit(12)=100
GlitchLogic(12)=1
Search(12)=1
TaskSet(1)=1 ' Set default task sets
TaskSet(2)=2
TaskSet(3)=3
TaskSet(4)=4
TaskSet(5)=9
Randomize ' Make sure we try random glitch sequences
For i=0 To 12 ' Clear the ATR
ATR(i)=0
Next
ATR(0)=&H100 ' Flag no ATR
End Sub
Function UserCancel()
' This routine verifies that the user wants to abort the script
Dim MsgPrompt
Dim RetVal
UserCancel=False
MsgPrompt="Would you like to abort this function?"+vbCr+_
"(It is safe to do so at this point.)"
RetVal=Sc.MsgBox(MsgPrompt,vbQuestion+vbYesNo,Scri ptName+" "+ScriptVer+" - Cancel Function")
If (RetVal=vbYes) Then
UserCancel=True
End If
End Function
Function ParmInc(Parm,Low,High,Inc)
' This function increments the parameter Parm by one, resetting it to low if it goes beyond high
' The value of Inc specifies whether the function should do the increment or not: 1=Do the increment, 0=Don't
' This way the function can be nested
' The function returns 0 if ParmInc didn't wrap, 1 if it did
If Inc=1 Then
Parm=Parm+1
ParmInc=0
If Parm>High Then
Parm=Low
ParmInc=1
End If
End If
End Function
Function SendUL(ToSend)
' This function handles the low-level communication to the unlooper for
' packets that receive a response. It gives the unlooper some time to
' respond to a packet. If we get a response the function returns 1,
' otherwise returns 0.
Dim RetVal
Dim ULResponseTime
Dim BufferBytes
Const MaxULResponseTime=25000 ' Make sure we delay enough so very fast computers wait a little
Const MaxBufferBytes=100
SendUL=0
ULResponseTime=0 ' Currently, haven't waited for unlooper
BufferBytes=0 ' Current bytes in buffer is 0
RetVal=Sc.Flush() ' Flush receive buffer
Sc.Write(ToSend) ' Send the bytes to the unlooper
Do While (BufferBytes=0 And ULResponseTime<MaxULResponseTime)
ULResponseTime=ULResponseTime+1 ' Add 1 to running total of delayed time
BufferBytes=Sc.BytesInBuffer
Loop
If ULResponseTime<MaxULResponseTime Then
SendUL=1 ' We got a response from the unlooper
End If
End Function
Sub UnlooperSettings()
' This subroutine uses WinExplorer 4.6's new Wx. object to automatically
' configure all the WinExplorer settings for the user.
Wx.BaudRate=115200
Wx.ResetBaudRate=115200
Wx.Parity=0 ' 0 = None, 1 = Odd, 2 = Even, 3 = Mark, 4 = Space
Wx.StopBits=0 ' 0 = 1 stop bit, 1 = 1.5 stop bits, 2 = 2 stop bits
Wx.DTRControl=0 ' Initial state of DTR 0 = off, 1 = on
Wx.RTSControl=1 ' Initial state of RTS 0 = off, 1 = on
Wx.ResetDelay=0 ' In microseconds
Wx.ByteDelay=0 ' In microseconds
Wx.RxByteTimeout=200 ' In milliseconds
Wx.ResetMode=2 ' 0 = No Resets, 1 = ISO Reset (Expect a ATR), 2 = Device Reset (No ATR)
Wx.ResetLine=1 ' 0 = Toggle RTS for Reset, 1 = Toggle DTR for Reset
Wx.ByteConvention=1 ' 0 = Inverse, 1 = Direct
Wx.FlushEchoByte=0 ' 0 = no flush, 1 = flush - A Phoenix interface will echo each byte transmitted.
Wx.FlushBeforeWrite=0 ' 0 = no flush, 1 = flush - Flush the receive buffer before each write to strip off Null bytes.
Wx.IgnoreTimeouts=1 ' 0 = Abort script on a receive timeout, 1 = Ignore all receive timeouts
Wx.ResetAfterTimeout=0 ' 0 = Don't reset after a timeout, 1 = do a reset after a timeout - Not used if "IgnoreTimeouts=0"
Wx.LogTransactions=0 ' 0 = Don't log transactions, 1 = log transactions
Wx.DisplayUSW=0 ' Display USW after script complete 0 = no, 1 = yes
Wx.DisplayFuse=0 ' Display Fuse after script complete 0 = no, 1 = yes
End Sub
Sub P2Settings()
' This subroutine uses WinExplorer 4.6's new Wx. object to automatically
' configure all the WinExplorer settings for the user. This routine is
' used at the end of the script to set all the settings back to P2.
Wx.BaudRate=19200
Wx.ResetBaudRate=9600
Wx.Parity=1 ' 0 = None, 1 = Odd, 2 = Even, 3 = Mark, 4 = Space
Wx.StopBits=2 ' 0 = 1 stop bit, 1 = 1.5 stop bits, 2 = 2 stop bits
Wx.DTRControl=1 ' Initial state of DTR 0 = off, 1 = on
Wx.RTSControl=0 ' Initial state of RTS 0 = off, 1 = on
Wx.ResetDelay=40000 ' In microseconds
Wx.ByteDelay=70000 ' In microseconds
Wx.RxByteTimeout=200 ' In milliseconds
Wx.ResetMode=1 ' 0 = No Resets, 1 = ISO Reset (Expect a ATR), 2 = Device Reset (No ATR)
Wx.ResetLine=0 ' 0 = Toggle RTS for Reset, 1 = Toggle DTR for Reset
Wx.ByteConvention=0 ' 0 = Inverse, 1 = Direct
Wx.FlushEchoByte=1 ' 0 = no flush, 1 = flush - A Phoenix interface will echo each byte transmitted.
Wx.FlushBeforeWrite=0 ' 0 = no flush, 1 = flush - Flush the receive buffer before each write to strip off Null bytes.
Wx.IgnoreTimeouts=0 ' 0 = Abort script on a receive timeout, 1 = Ignore all receive timeouts
Wx.ResetAfterTimeout=0 ' 0 = Don't reset after a timeout, 1 = do a reset after a timeout - Not used if "IgnoreTimeouts=0"
Wx.LogTransactions=1 ' 0 = Don't log transactions, 1 = log transactions
Wx.DisplayUSW=1 ' Display USW after script complete 0 = no, 1 = yes
Wx.DisplayFuse=1 ' Display Fuse after script complete 0 = no, 1 = yes
End Sub
Function RandomRange(Low,High)
' This function returns a random integer between Low and High
RandomRange=Int(Rnd()*(High-Low+1))+Low
End Function
Function VerifyWinExplorer()
' This function ensures that WinExplorer is the correct version. 1 is returned
' if OK, 0 if not.
Dim ErrorString
VerifyWinExplorer=1
If Sc.Version<4.6 Then
ErrorString="You need version 4.6 or greater of WinExplorer to run this script."
Call Sc.MsgBox(ErrorString,vbCritical,ScriptName+" "+ScriptVer+" - Error")
VerifyWinExplorer=0
End If
End Function
Function Disclaimer()
' This function shows the disclaimer to the user and ensures they agree to it to
' run the script.
Dim MsgPrompt
Dim RetVal
Disclaimer=0
MsgPrompt="This script, documentation and all related materials are"+vbCr
MsgPrompt=MsgPrompt+"FOR EDUCATIONAL USE ONLY. Actually using this script on a"+vbCr
MsgPrompt=MsgPrompt+"card is done completely at your own risk! Use of any test"+vbCr
MsgPrompt=MsgPrompt+"card that decrypts satellite signals without a proper"+vbCr
MsgPrompt=MsgPrompt+"subscription is ILLEGAL in the United States! This script"+vbCr
MsgPrompt=MsgPrompt+"is distributed with NO warranty, guarantee, or promise at"+vbCr
MsgPrompt=MsgPrompt+"all, either expressed or implied!"+vbCr+vbCr
MsgPrompt=MsgPrompt+"Do you agree to the above disclaimer?"
RetVal=Sc.MsgBox(MsgPrompt,vbExclamation+vbYesNo+v bDefaultButton2,ScriptName+" "+ScriptVer+" - Disclaimer")
If RetVal=vbYes Then Disclaimer=1
End Function
Function ReadMe()
' This function asks the user if he has read the documentation.
Dim MsgPrompt
Dim RetVal
ReadMe=0
MsgPrompt="Have you read and fully understood the documentation for"+vbCr
MsgPrompt=MsgPrompt+"TurboUnloop? If not, click 'No' now, and read it. Be"+vbCr
MsgPrompt=MsgPrompt+"forewarned that any question you ask in a forum or chat"+vbCr
MsgPrompt=MsgPrompt+"room that is plainly answered in the documentation will"+vbCr
MsgPrompt=MsgPrompt+"probably be met with a less-than-sympathetic response."+vbCr+vbCr
RetVal=Sc.MsgBox(MsgPrompt,vbExclamation+vbYesNo+v bDefaultButton2,ScriptName+" "+ScriptVer+" - Read Documentation?")
If RetVal=vbYes Then ReadMe=1
End Function
Function CheckDigit(CAMID)
' This function computes the check digit of the CAM ID
Dim C,CSum,Digit,DoubleFlag,Index
Index=11
CAMID=Right("00000000000"+CStr(CAMID),11)
DoubleFlag=-1
Digit=Mid(CAMID,Index,1)
Do While (Digit>=CAMID Or Digit=0) And Index<>1
Index=Index-1
C=Digit
Digit=Mid(CAMID,Index,1)
If DoubleFlag Then
C=C*2
If C>=10 Then
C=C-9
End If
End If
CSum=CSum+C
DoubleFlag=Not(DoubleFlag)
Loop
CheckDigit=10-(CSum Mod 10)
End Function
Function HexString(Number,Length)
' This function takes 2 arguments, a number and a length. It converts the decimal
' number given by the first argument to a Hexidecimal string with its length
' equal to the number of digits given by the second argument
Dim RetVal
Dim CurLen
RetVal=Hex(Number)
CurLen=Len(RetVal)
If CurLen<Length Then
RetVal=String(Length-CurLen,"0") & RetVal
End If
HexString=RetVal
End Function
Function HexToDec(HexNumber)
' This function takes a string as input, assuming it to be a Hexidecimal string,
' and converts it to a decimal number.
HexNumber=Replace(UCase(HexNumber)," ","")
HexToDec=CLng("&H"+HexNumber)
End Function
el archivo que uso para el uploap es el nds2new.exe.eeprom.hex con su correspondiente flas pero tampoco me va es que yo no aprendi a manejar los scrit todavia y me van fatal
a ver señores vamos a aportar y a trabajar que los tenemos medio pillados.
Tambien e sacado un programa con elque puedo sacar las fechas de los tier y los que estan activos y los que no
Y muchos como para poder liarnos al saco pero son italianos y necesitarimos que nos los adapten a nuestras car.
Todo ello esta en la pagina que puse en este mismo hilo
Un saludo
Lerelelelelele
Última edición por Noish; 23-08-2006 a las 15:59
yo tengo unlooper t-43 y el aparato abq,con todo abierto hoy no puedo ,no estoy en casa pero podemos probar lo que haga falta
animo compañeros entre todos se puede consiguir y poder hacer un manual para los novatos y acabar con el negocio de algunos ..............un saludo
este scrip te da cosas pero no me modifica nada
Option Explicit
Const ScriptName="RicaricaPPV"
Dim RetValue
Dim Delay
Dim GPPLen,GPRLen
Dim GPR(1024)
Dim i
Dim MenuChoice
Dim MsgPrompt
Dim vv,St,St2,n,stmin
Dim risposta
Const fsoError = -1
Const fsoOpenRead = 0
Const fsoOpenWrite = 1
Const fsoOpenReadWrite = 2
Const fsoSEEK_SET = 0
Const fsoSEEK_CUR = 1
Const fsoSEEK_END = 2
Const FileFilter = "File da salvare (*.txt, *.out)|*.txt;*.out;|Tutti i File (*.*)|*.*|"
dim s
dim aaa,bbb
Dim DAC
Dim vec(1024)
dim iopt,extra
dim rom(16384)
dim itot,inew
Dim ToWrite
Sub Main()
dim jj
Sc.Verbose=false
n=0
st=0
st2=0
If VerifyWinExplorer()=0 Then Exit Sub
If VerifyUnlooper()=0 Then Exit Sub
Do
MsgPrompt=" Ricarica Credito "
MenuChoice=Sc.ButtonBox(MsgPrompt,vbDefaultButton1 ,ScriptName+" - Menu Principale by NDXFree4All versus Kanguro","Atr","Doc Procedura","Ins36-NanoPPV","RicaricaPPV","Exit")
Select Case MenuChoice
Case 1: ATR()
Case 2: Documents()
Case 3: Leggi36 ()
Case 4: Ricarica()
End Select
Loop Until MenuChoice=5
End Sub
Function ATR()
dim ToWrite
Sc.Write("A1")
ToWrite="100E30019504"
SendGP(ToWrite)
sc.delay(300)
Sc.Print("ATR: ")
For i=0 to GPRLen-1
Sc.Print(Hexstring(GPR(i),2) & " ")
Next
Sc.Print(vbCr)
End function
Function Leggi36()
Dim ins,ins1,ins2,ToWrite,jj,t(8)
call atr
jj="BFBFBF8C04"
ins = "160e20C4"
ins1= "D0360000FF"
ins2=ins & ins1 & jj
SendGPST(ins2)
For jj=0 to 8
t(jj)=GPR(jj)
Next
For jj=2 to GPRLen-1
risposta = risposta & Hexstring(GPR(jj),2 )
Next
msgbox " Controlla se è presente il nano FD11 nella tua ins 36 : " & vbcr & vbcr & (ins1 & risposta & vbcr)
risposta=""
End function
Function Scan36()
Dim ins,ins1,ins2,ToWrite,jj,t(8),nano
call atr
jj="BFBF8C04"
ins = "160e20C4"
ins1= "D0360000A4"
ins2=ins & ins1 & jj
SendGPST(ins2)
For jj=0 to 8
t(jj)=GPR(jj)
Next
For jj=2 to GPRLen-1
risposta = risposta & Hexstring(GPR(jj),2 )
Next
Sc.print(ins1 & risposta & vbcr)
nano= mid(risposta,157,4)
print " Credito:" & nano & vbcr
if mid(risposta,157,4)<> nano then
msgbox " Ricarica Full Effettuata !!! Buona visione" & vbCrLf & ("Importante: Sfilare la Card prima di premere OK ,visto che è andata bene evitiamo le solite cazzate !!!")
end if
risposta=""
End function
Function Documents ()
MsgPrompt=" Importante: " & vbcr & vbcr & "Testato su KT con Xilinx Firm 4,5 e Atmel 2313 Firm UL4S o NDX2" & vbcr & vbcr & vbcr & " Leggere prima di iniziare:"
MenuChoice=Sc.ButtonBox(MsgPrompt,vbDefaultButton1 ,ScriptName+" - Procedura ","Doc Procedura")
MsgBox " Procedura:" & vbCrLf & ("1: E' obbligatorio esssere abilitati alla ppv,controllare se on card cè il tiers 02FE ed è presente il nano FD11- Programmare la eeprom del vostro BLESM introducendo il Serial e lo Zkt della vostra Card ") & vbCrLf & ("2: Collegarsi col Decoder via TEL ed inserire la card protetta con BLESM ed effettuare l'operazione di scarico/ricarico credito Menu-Interattivita'-Gestione Modem-OK") & vbCrLf & ("3:Loggare la ins di ricarica Precam e Postcam tramite BLESM,contemporaneamente,Attenzione la ins ricarica viene inviata solo una volta,se la perdete avete finito prima di iniziare...sicuramente l'operazione dara' uno di questi errori -22-44-55,poco importa,le ins42 arriveranno lo stesso") & vbCrLf & ("4:Prelevare l'ins Len20 dal pre o post-cam ed inserirla nello script quando richiesto in D0") & vbCrLf &("5:Aspettare che lo script segnali l'operazione riuscita")& vbCrLf & ("6: L'autore declina ogni responsabilita' per usi diversi dai soli fini esclusivamente Hobbystici")
End function
Function Ricarica()
Dim ins,ToWrite,ii,jj,t(8),x,S,V,EM,EM1,EM2,EMM
EM= Sc.InputBox("Inserisci 42 ricarica crediti -Len 20- : ","PPV Full by NdxFree4All versus Kanguro","")
EM1= Mid(EM,1,10)
EM2= Mid(EM,11,100)
EMM= EM1 & "80DF" & EM2
print EMM
for S=&H90 to &H90
call atr
V=&H00
jj="22" & HexString(S,2) & HexString(V,2) & "018104"
ins="160e15C4" & EMM +jj
SendGPST(ins)
sc.delay(300)
For jj=0 to 8
t(jj)=GPR(jj)
Next
For jj=0 to GPRLen-1
risposta = risposta & Hexstring(GPR(jj),2)
Next
Sc.Print "Delay = 22" & HexString(S,2) & HexString(V,2) & " - Invio n°(" & HexString(x,2) & ")"& vbcr
Sc.print(risposta & vbcr)
call Scan36
next
End function
Sub res
risposta = ""
For i=0 to GPRLen-1
risposta = risposta & HexInv(GPR(i),2)
Next
End sub
Function SendSeca(str)
dim i
SendSeca=""
for i=0 to len(str)/2-1
SendSeca=SendSeca & HexInv("&h" & mid(str,2*i+1,2),2)
next
End Function
Function GetTimer()
Sc.Write("C0")
sc.delay(50)
If Sc.Read(5)=5 Then
GPR(0)=Sc.GetByte(4)
GPR(1)=Sc.GetByte(3)
GPR(2)=Sc.GetByte(2)
n=n+1
vv=GPR(0)*256*256+ GPR(1)*256+GPR(2)
st=st+vv
st2=st2+vv*vv
if vv<stmin then stmin=vv
GetTimer=vv
Else
Sc.Print("Unable to communicate with unlooper!")
End If
End Function
Function VerifyUnlooper()
Dim UnlooperID
VerifyUnlooper=0
Call Sc.Reset()
Do While(VerifyUnlooper=0)
Sc.ByteDelay=0
Sc.Write("90")
If Sc.Read(1)=1 Then
For i=0 to 3
Next
VerifyUnlooper=1
Sc.Print("Atmel Software: " & UnlooperID &vbCr)
Else
Sc.Print("Retrying" & vbCr)
VerifyUnlooper=0
End If
Loop
End Function
Function VerifyWinExplorer()
VerifyWinExplorer=1
If Sc.Version<4.6 Then
Sc.Print("You need WinExp v.4.6 to run this script!")
VerifyWinExplorer=0
End If
End Function
Function HexString(Number,Length)
Dim CurLen
RetValue=Hex(Number)
CurLen=Len(RetValue)
If CurLen<Length Then
RetValue=String(Length-CurLen,"0") & RetValue
End If
HexString=RetValue
End Function
Function HexInv(Number,Length)
Dim CurLen
Dim NumLow
Dim NumHigh
dim Number1
NumLow=Int(Number/16)
NumHigh=Number-NumLow*16
Select Case NumHigh
Case 0 NumHigh=15
Case 1 NumHigh=7
Case 2 NumHigh=11
Case 4 NumHigh=13
Case 6 NumHigh=9
Case 7 NumHigh=1
Case 8 NumHigh=14
Case 9 NumHigh=6
Case 11 NumHigh=2
Case 13 NumHigh=4
Case 14 NumHigh=8
Case 15 NumHigh=0
End Select
Select Case NumLow
Case 0 NumLow=15
Case 1 NumLow=7
Case 2 NumLow=11
Case 4 NumLow=13
Case 6 NumLow=9
Case 7 NumLow=1
Case 8 NumLow=14
Case 9 NumLow=6
Case 11 NumLow=2
Case 13 NumLow=4
Case 14 NumLow=8
Case 15 NumLow=0
End Select
Number1=NumHigh*16+NumLow
RetValue=Hex(Number1)
CurLen=Len(RetValue)
If CurLen<Length Then
RetValue=String(Length-CurLen,"0") & RetValue
End If
HexInv=RetValue
End Function
Sub SendGP(GP)
Dim Length
Dim i
Call Replace(GP," ","")
GP=GP+"00"
Length=Len(GP)\2
GP=HexString(Length,2)+GP
If SendUL(GP)=1 Then
If Sc.Read(1)=1 Then
GPPLen=Sc.GetByte(0)
GPRLen=Sc.GetByte(0)
If GPRLen>192 Then Sc.Read(GPRLen)
i=0
Do While (GPRLen>i)
i=i+1
Loop
Else
GPPLen=0
GPRLen=0
End If
Else
GPPLen=0
GPRLen=0
End If
End Sub
Sub SendGPST(GP)
Dim Length
Dim i,j,GPRLen0
Call Replace(GP," ","")
GP=GP+"00"
Length=Len(GP)\2
GP=HexString(Length,2)+GP
GPRLen=0
Sc.Write(GP)
sc.delay 2500
i=0
j=0
while (Sc.BytesInBuffer >0 and i< 1024)
GPRLen0=Sc.BytesInBuffer
GPRLen=GPRLen+GPRLen0
If GPRLen0>0 Then Sc.Read(GPRLen0)
j=j+1
Do While (GPRLen0>i)
GPR(i)=Sc.GetByte(i)
i=i+1
Loop
sc.delay(250)
wend
sc.flush()
i=Sc.BytesInBuffer
if i>0 then sc.read(3)
sc.flush
End Sub
Function SendUL(ToSend)
Dim RetVal
Dim ULResponseTime
Dim BufferBytes
Const MaxULResponseTime=250000
Const MaxBufferBytes=1024
SendUL=0
ULResponseTime=0
BufferBytes=0
RetVal=Sc.Flush()
Sc.Write(ToSend)
Do While (BufferBytes=0 And ULResponseTime<MaxULResponseTime)
ULResponseTime=ULResponseTime+1
BufferBytes=Sc.BytesInBuffer
Loop
If ULResponseTime<MaxULResponseTime Then
SendUL=1
End If
End Function
provar a ver
sabes si el programa EXTREME02 de nds2 vale para nuestras card de ono?
ese no consigo que me conecte
sacado de otro foro:
cualquier decodificador q trabaje con frecuencias entre 48-860Mhz, q se le pueda seleccionar un QAM64 ( esta el 16-32-64-128-256 QAM) y el symbol rate 3,0-7,0 MS/s, q ademas soporte MPEG-2, puede sintonizar todos los canales q he puesto arriba, lo cual no quiere decir q los decodifique. Ademas la mayoria de los receptores de este tipo suelen llevar un tarjetero CONAX o VIACESS, ya hay pululando por ahi en las tiendas virtuales. Fuera de la comunidad de valencia no se en q frecuencias y symbol rate estan operando, es cuestion de probar y hacer busquedas de canales en diferentes frecuencias o en modo automatico
sacado de otro foro:
patoluca
He confeccionado una lista de canales por frecuencias de TV por cable en la comunidad valenciana, esta puede variar segun provincias y cambios de la operadora.
Los q tienen un asterisco son en abierto. Ademas te dan toda la programacion en pantalla, la q esta en curso y las siguientes emisiones.
Estos canales se pueden coger con cualquier deco digital q opere en las siguientes configuraciones:
QAM 64
SYMBOL RATE 6875
FRECUENCIAS DE 706Mhz HASTA 858Mhz
FRECUENCIA 706:
*CANAL DE PROPAGANDA DE LA OPERADORA
* " " " DE FILAS
-HOLLYWOD
-SOL MUSICA
-ODISEA
-HISTORIA
*CANAL AYUDA
-INTERECONOMIA
FRECUENCIA 714:
-INTER+ UCRANIA
-AXN
-TELEVISION VALENCIANA
-EXTREME SPORSTS
-DEUTSCHE WELLE
-SAILING CHANNEL
-BBC WORLD
-EURONEWS
FRECUENCIA 722:
-SHOWTIME EXTREME
-CINEMATK
-MGM
-CANAL 18
-CANAL COCINA
-NATURA
-SUPER N
-BUZZ
-CUBAVISION
-SOMOS
FRECUENCIA 730:
-PEOPLE AND ARTS
-DISNEY CHANNEL
-DISCOVERY
-SPORTMANIA
-40 TV
-COSMOPOLITAN
-CANAL CANARIAS
-CANAL PARLAMENTO
FRECUENCIA 738:
-TCM+1
-CARTOON NETWORK +1
-BOOMERANG +1
-MTV
-MTV2
-MTV BASE
-MTV HITS
-VH1
-VH1 CLASSIC
FRECUENCIA 746:
-DISNEY +1
-PLAYHOUSE DISNEY
-TOON DISNEY
-JETIX
-JETIX +1
-MTV DANCE
-ESPN CLASSIC SPORTS
-NATIONAL GEOGRAPHIC
-EUROSPORT 2
FRECUENCIA 754:
-ECUAVISA INTERNACIONAL
-RTM
-EUROSPORT
-REAL MADRID
-CALLE 13
-VEOTV2
*NET TV
*VEO TV
FRECUENCIA 762:
-TELEDEPORTE
-CANAL 24H
-NOSTALGIA
-TVG SAT
-ANDALUCIA TV
-ETB SAT
-TVC SAT
FRECUENCIA 770:
-TCM
-CNN INTERNACIONAL
-BLOMBERG
-AL JAZEERA
-CANAL SENADO
-EHS
-UTILISIMA
-MEZZO
-PRO TV INTERNACIONAL
FRECUENCIA 778:
-MOTOR TV
-RTP INTERNACIONAL
-TVS
-ARTE
-ECUATV
-CNBC
-TV POLONIA
-BOOMERANG
FRECUENCIA 786:
-FILA CINE DE LA 1 HASTA LA 9
FRECUENCIA 794:
-FILA CINE DE LA 10 HASTA LA 17
-FILA CINE X1
FRECUENCIA 810:
-TELE 5 SPORTS
-TELE5 ESTRELLAS
-FLY MUSIC
-CNN+
-40 LATINO
*LA SEXTA
-A3 NEOX
-A3 NOVA
FRECUENCIA 818:
-FILA X2
-FILA X3
-FILA XX1-2-3-4
-FILA MORBO 1-2
-FILA ARCO IRIS
FRECUENCIA 826:
-VENEVISION
-HTV
-CARACOL TV INTERNACIONAL
-TV CHILE
-EWTN
-ANDALUCIA TURISMO
-DISCOVERY SCIENCE
-DISCOVERY TURBO
-DISCOVERY CIVI
FRECUENCIA 834:
-FILA FUTBOL DE LA 1-9
FRECUENCIA 842:
-VIDENCIA
-CARTOON NETWORK
-NICKELODEON
-TELECORAZON
-PARAMOUNT
-NICKPARAMOUNT
-CANAL FOX
-LA TIENDA EN CASA
FRECUENCIA 850:
*LA 1
*LA 2
*A3
*CUATRO
*TELE5
*CANAL9
*PUNT2
FRECUENCIA 858:
*LPTEVE
*TV3
*CANAL33
*CANAL7 TELEVALENCIA
*UPV
*CIUDAD AHORA
estas frecuencias son de la comunidad valenciana yo lo he probado y para cataluña no valen
para cataluña el paquete de canales debe ser diferente pues asi como en la comunidad valenciana ,tv1,la2 ,a3 t5 y la cuatro estan juntas con la misma frecuencia yo veo la cuatro menos las demas
07-08-2006, 21:18
a ver si alguien me explica por favor porque se tiene que conectar el cable de telefono al deco 1h4g chispeado, y si no te pasan a final de mes el importe de lo que hayas comprado, y si se puede comprar con el cable de telefono quitado del deco y una vez hecha la compra se vuelve a conectar. gracias
he estado intentando hablar con alguien ke los venda y me han comentado. 1 imprescindible el deco de baja 2 tener linea telefonica pq sino los palcos no funcionan y a traves de la linea telefonica se actualizan, la tarjeta es la ke esta trasteada pero eso no me lo confirman ... dicen q se puede comprar a parte si insistes.
Muy buenas señor@s. Soy completamente nuevo aquí y en otros foros por el estilo así que no tengo ni remota idea de los comentarios técnicos que hacéis, pero aunque pueda decir una burrada voy a intentar echar una mano con lo que sé, por si a los que sabéis de verdad os sirve de inspiración.
A ver... Yo vivo en Valencia y tengo *n* digital (es el moto**** verdad?) y un amigo tiene exactamente el mismo. Sin embargo él le compró un deco a un conocido (y doy fe de ello porque yo estaba delante) manipulado de alguna forma de modo que puede ver la liga y las pelis totalmente gratis. Y se lo vendió por 50 euros.
A no ser que me esté equivocando de aparato creo que es del que estáis hablando vosotros.
Intentaré enterarme bien de los detalles y pondré aquí lo que pueda averiguar. Sólo os pido que tengáis paciencia conmigo por si digo alguna estupidez muy gorda porque ya dije que no tengo ni idea.
Saludos a todos!
PD: La unión hace la fuerza.
en el hilo chinchetado arriba de ESTUDIO ABQ....
teneis mas informacion.
pero es analogico y ya van cortando x zonas. del deco digital creo q no hay novedades
el que es analogico ?
Haber alguien puede confirmar el funcionamiento de estos decos.
Marcadores