Tw33ty Posted January 8, 2010 Share Posted January 8, 2010 (edited) Okay im Working on a Tool like Legality checker jsut an extended version. Its almost done but one thing is missing: Checking Algorythms for Chained shinys. Actually i Have a working algorythm but its way to slow! What i need now is a faster method wich takes about 2-3 secs to check, not like my code from 1 minute to up to 2 hrs. Heres my code (c#) -edit: already figured out Thanks in Advance =) Tw33ty P.s. You can post vb code aswell im familliar with it aswell Edited January 16, 2010 by Tw33ty Added spoiler tags to the wall of code. Link to comment Share on other sites More sharing options...
evandixon Posted January 8, 2010 Share Posted January 8, 2010 Is the follwoing a proper translation(EDIT: To VB?) of your code above? If so, thank this site. 'To be completed not functionnal! 'sA,sB,sC,sD are the Hex values from save file for HID,LID, DV1,DV2 Public Sub CheckforChainedShiny(ByVal sA As String, ByVal sB As String, ByVal sC As String, ByVal sD As String, ByVal origPoki As pokemon) Dim dummyPoki As New pokemon() Dim Bits As String() = New String(13) {} Dim BinaryID As String = Nothing Dim PatternLID As String = Nothing Dim PatternHID As String = Nothing Dim sHexIs As String = Nothing Dim sHexOld As String = Nothing Dim sHexCheck As String = Nothing Dim sSeed As String = Nothing Dim HID As String = Nothing Dim LID As String = Nothing Dim isOK As Boolean = False Dim isFailed As Boolean = False Dim lErg As Long = 0 Dim lHex As Long = 0 Dim iLength As Integer = 0 Dim iIndex As Integer = 0 Dim HP As Integer = 0 Dim SPD As Integer = 0 Dim ATT As Integer = 0 Dim DEF As Integer = 0 Dim INT As Integer = 0 Dim SPA As Integer = 0 HID = 0 LID = 0 PatternHID = Nothing PatternLID = Nothing Try BinaryID = toBin("&h" & sA) While BinaryID.Length < 16 BinaryID = "0" & BinaryID End While For i = 1 To 13 Bits(i) = 0 Bits(i) = BinaryID.Substring(BinaryID.Length - 3 - i, 1) If i = 1 Then PatternHID = BinaryID.Substring(BinaryID.Length - 3 - i, 1) Else PatternHID = BinaryID.Substring(BinaryID.Length - 3 - i, 1) + PatternHID End If Next BinaryID = toBin("&h" & sB) While BinaryID.Length < 16 BinaryID = "0" & BinaryID End While For i = 1 To 13 If i = 1 Then PatternLID = BinaryID.Substring(BinaryID.Length - 3 - i, 1) Else PatternLID = BinaryID.Substring(BinaryID.Length - 3 - i, 1) + PatternLID End If Next sHexIs = "0" lHex = 0 sSeed = &H0 While isOK = False 'set current seed sHexIs = sSeed lHex = sSeed 'call rng twice at first lErg = rng(lHex) sHexIs = Conversion.Hex(lErg) While sHexIs.Length < 16 sHexIs = "0" & sHexIs End While iLength = sHexIs.Length Try sHexIs = "&h" & sHexIs.Substring(iLength - 8) LID = sHexIs.Substring(sHexIs.Length - 4) lHex = sHexIs Catch ex As Exception End Try lErg = rng(lHex) sHexIs = Conversion.Hex(lErg) While sHexIs.Length < 16 sHexIs = "0" & sHexIs End While iLength = sHexIs.Length Try sHexIs = "&h" & sHexIs.Substring(iLength - 8) HID = sHexIs.Substring(sHexIs.Length - 4) lHex = sHexIs Catch ex As Exception End Try iIndex = 12 isFailed = Nothing For i = 1 To 13 'call rng and check if bit pattern fits lErg = rng(lHex) sHexIs = Conversion.Hex(lErg) iLength = sHexIs.Length Try sHexIs = "&h" & Conversion.Hex(lErg).Substring(iLength - 8) iLength = sHexIs.Length lHex = sHexIs BinaryID = toBin(sHexIs).Substring(iLength - 1, 1) Catch ex As Exception Interaction.MsgBox("Fehler bei PAttern Check") End Try If Bits(i) = BinaryID Then iIndex = iIndex - 1 Else isFailed = True ' TODO: might not be correct. Was : Exit For Exit For End If Next 'IF not failed check if found pattern fits fixed PID If isFailed = False Then 'fix the HID and LID from current Seed HID = toBin("&h" & HID) HID = HID.Substring(HID.Length - 3) HID = PatternHID + HID LID = toBin("&h" & LID) LID = LID.Substring(LID.Length - 3) LID = PatternLID + LID HID = toDec(HID) LID = toDec(LID) sHexCheck = Conversion.Hex(CInt(HID)) While sHexCheck.Length < 4 sHexCheck = 0 + sHexCheck End While If sHexCheck = sA Then isFailed = False sHexCheck = Conversion.Hex(CInt(LID)) While sHexCheck.Length < 4 sHexCheck = 0 + sHexCheck End While If sHexCheck = sB Then isFailed = False 'MsgBox("Pattern found") 'call rng twice and check dvs lErg = rng(lHex) sHexIs = Conversion.Hex(lErg) iLength = sHexIs.Length sHexIs = "&h" & Conversion.Hex(lErg).Substring(iLength - 8) lHex = sHexIs BinaryID = Conversion.Hex(lHex) While BinaryID.Length < 8 BinaryID = "0" & BinaryID End While dummyPoki.convertToStat(DEF, ATT, HP, CDec("&h") + BinaryID.Substring(0, 4)) lErg = rng(lHex) sHexIs = Conversion.Hex(lErg) iLength = sHexIs.Length sHexIs = "&h" & Conversion.Hex(lErg).Substring(iLength - 8) lHex = sHexIs BinaryID = Conversion.Hex(lHex) While BinaryID.Length < 8 BinaryID = "0" & BinaryID End While dummyPoki.convertToStat(SPD, SPA, INT, CDec("&h") + BinaryID.Substring(0, 4)) If dummyPoki.DV_ALL = origPoki.DV_ALL Then checkChain = True Exit Sub End If End If End If End If 'RNG has done its way up to the max If sSeed = "4294967294" Then isLegit = False End If sSeed = sSeed + &H1 End While Catch ex As Exception End Try End Sub Link to comment Share on other sites More sharing options...
Tw33ty Posted January 9, 2010 Author Share Posted January 9, 2010 Half and half. I started to work on it with a vb code and changed to c# while developing. Link to comment Share on other sites More sharing options...
Tw33ty Posted January 16, 2010 Author Share Posted January 16, 2010 Nvm i already figured out why. For those interested: i ran the loop from 0 to FFFFFFFF Thats why it took so long. Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now