Jump to content

Recommended Posts

Posted (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 by Tw33ty
Added spoiler tags to the wall of code.
Posted

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

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 account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...