CoolBasic Forums

Posted: **Tue Sep 16, 2008 6:02 pm**

Über kräk engine by DatsuniG

Värkkäilinpä tässä sitten ajan kuluksi koodin, joka käy läpi kaikki mahdolliset 5 kirjaimen salasanat. Tästä saa helposti muokattua koodin, joka käy läpi ensin kaikki 1 kirjaimen salasanat, sitten 2 jne. jne. Text1$ on salasana, jota yritetään ratkaista.

Ja tämän olis voinut tehdä siistimminkin/lyhkäsemminkin, mutta tein tämän vain huvin vuoksi : )

Code: Select all

Dim temptext(5) As String 
Dim crack(5)
sekunti=0


For a=1 To 5
crack(a)=65
Next a

password$=""
text1$="CaBEc"

mytimer#=Timer()
statetimer=Timer()

Repeat 

overall+1
crack(5)=crack(5)+1

If crack(5)=122 Then
crack(4)=crack(4)+1
crack(5)=65
EndIf 

If crack(4)=122 Then
crack(4)=65
crack(3)=crack(3)+1
EndIf 

If crack(3)=122 Then
crack(3)=65
crack(2)=crack(2)+1
EndIf 

If crack(2)=122 Then
crack(2)=65
crack(1)=crack(1)+1
EndIf 

If crack(1)=255 Then End 

temptext(5)=Chr(crack(5))
temptext(4)=Chr(crack(4))
temptext(3)=Chr(crack(3))
temptext(2)=Chr(crack(2))
temptext(1)=Chr(crack(1))

password=temptext(1)+temptext(2)+temptext(3)+temptext(4)+temptext(5)

If Timer()>statetimer+10000 Then
statetimer=Timer()
sekunti+10
Text 0,0,"Salasanoja käyty läpi "+overall+" kpl "+sekunti+" sekunnissa"
Text 0,20,"Eli "+overall/sekunti+" kappaletta sekunnissa"
DrawScreen 
EndIf 

Until text1=password
aika#=mytimer/1000


Repeat
Text 0,0,"Salasana on "+text1
Text 0,20,"Käytiin läpi "+overall+" salasanaa."
Text 0,40,"Aikaa meni "+aika+" sekuntia."
DrawScreen
Forever

KATSO TÄMÄ
viewtopic.php?p=16059#p16059

EDIT:

Nonniin koodia optimoitu ja lisätty ajastin. Tämähän on pieni muotoinen nopeus testi : )

Posted: **Tue Sep 16, 2008 6:06 pm**

Mulla ei kyllä toiminut :O Ensin odotin semmoset 3000 salasanaa, sitten ajattelin sulkea ohjelman niin ensin MAV ja sitten "CBRun.exe ei vastaa". Tiedä sitten johtuuko koneestani, kun CB:n virheilmoitukset ovat joskus konekohtaisia.

Mutta otappa tuo Framelimit tuolta pois, sillä tämänhän kuuluisi toimia mahdollisimman nopeasti, eikö vain? ;D

EDIT: Suljin siis äksästä, en ESC:stä.

Posted: **Tue Sep 16, 2008 6:13 pm**

MUlla kyllä toimi yhtä nopeesti Framelimitin kanssa ja ilman. : O Ja tuon MAVin syytä pohdiskelin itsekkin.

Posted: **Tue Sep 16, 2008 6:21 pm**

DatsuniG wrote:Ja tuon MAVin syytä pohdiskelin itsekkin.

Johtuu tästä

Code: Select all

Dim crack(5)

ja tästä

Code: Select all

For a=1 To 10
crack(a)=65
Next a

Posted: **Tue Sep 16, 2008 6:24 pm**

Jaahas tuommoinen oli tuonne unohtunut. Kiitos avusta. : )

Posted: **Tue Sep 16, 2008 6:27 pm**

Tuota noin... Jos käytät DrawScreenia jokaisen "kierroksen" jälkeen, ohjelma voi kokeilla vain 75 tai 85* eri yhdistelmää sekunnissa. Ja siksi se on hidas. Tekisit mieluummin niin että kokeillaan ensin sataa salasanaa ja sitten drawscreen. Sitten kokeillaan taas seuraavaa sataa salasanaa, ja sitten taas drawscreen.

Kokeileppa ajaa tämä koodi:

Code: Select all

Dim temptext(6) As String 
Dim crack(10)

For a=1 To 10
crack(a)=65
Next a

password$=""
text1$="AABEc"

Repeat 
    
    For i=1 To 100
    
        overall+1
        crack(5)=crack(5)+1
        
        If crack(5)=122 Then
        crack(4)=crack(4)+1
        crack(5)=65
        EndIf 
        
        If crack(4)=122 Then
        crack(4)=65
        crack(3)=crack(3)+1
        EndIf 
        
        If crack(3)=122 Then
        crack(3)=65
        crack(2)=crack(2)+1
        EndIf 
        
        If crack(2)=122 Then
        crack(2)=65
        crack(1)=crack(1)+1
        EndIf 
    
        temptext(5)=Chr(crack(5))
        temptext(4)=Chr(crack(4))
        temptext(3)=Chr(crack(3))
        temptext(2)=Chr(crack(2))
        temptext(1)=Chr(crack(1))
    
        password$=temptext(1)+temptext(2)+temptext(3)+temptext(4)+temptext(5)
        If password$ = text1$ Then Goto solved
        
        If crack(1)=255 Then End 
    
    Next i
    
    Text 0,0,password
    Text 0,20,"Läpikäydyt salasanat: "+overall 
    
    DrawScreen 

Forever

solved:
    Repeat
    Text 0,0,"Salasana on "+text1
    Text 0,20,"Käytiin läpi "+overall+" salasanaa."
    DrawScreen
Forever

Teoriassa (jos koneesi ei ole kovin tehoton) salasanan ratkaisemisen pitäisi nyt sujua noin 200 kertaa nopeammin.

EDIT: Koodiisi oli päässyt sellainen virhe että password -muuttujaa ei oltu määritelty tekstimuuttujaksi, joten salasanaa ei koskaan löydy. Päivitin koodin, nyt se toimii.
EDIT: Ja nopea siitä tulikin! Tuo selvittää salasanan alle sekunnissa, alkuperäiseltä koodilta siihen meni varmaan kymmeniä minuutteja.
EDIT: Tuota voi muuten buustata entisestäänkin laittamalla for -loopin to -arvoksi 2000 tai vastaavaa...
EDIT: Ja btw, CoolBasicilla ei tällaisia kannata tehdä, tuohan vie yli 90 prosenttia koneen resursseista, vaikka se vain laskee muutamia pluslaskuja...
EDIT: Muistio itselleni: Editoit liikaa.

Posted: **Tue Sep 16, 2008 6:50 pm**

1. Password on määritelty stringiksi.
2. Kyllä minä sen tiedän että tämä toimii nopeammin ilman ruudunpäivitystä. Mutta eikös tämä ole täällä juuri sen takia että voi muutella kaikkia? : )
No tässä olisi nyt optimoituna + ajastimen kanssa

Code: Select all

Dim temptext(5) As String 
Dim crack(5)
sekunti=0


For a=1 To 5
crack(a)=65
Next a

password$=""
text1$="CaBEc"

mytimer#=Timer()
statetimer=Timer()

Repeat 

overall+1
crack(5)=crack(5)+1

If crack(5)=122 Then
crack(4)=crack(4)+1
crack(5)=65
EndIf 

If crack(4)=122 Then
crack(4)=65
crack(3)=crack(3)+1
EndIf 

If crack(3)=122 Then
crack(3)=65
crack(2)=crack(2)+1
EndIf 

If crack(2)=122 Then
crack(2)=65
crack(1)=crack(1)+1
EndIf 

If crack(1)=255 Then End 

temptext(5)=Chr(crack(5))
temptext(4)=Chr(crack(4))
temptext(3)=Chr(crack(3))
temptext(2)=Chr(crack(2))
temptext(1)=Chr(crack(1))

password=temptext(1)+temptext(2)+temptext(3)+temptext(4)+temptext(5)

If Timer()>statetimer+10000 Then
sekunti+10
Print "Salasanoja käyty läpi "+overall+"kpl "+sekunti+" sekunnissa"
statetimer=Timer()
EndIf 

Until text1=password
aika#=mytimer/1000


Repeat
Text 0,0,"Salasana on "+text1
Text 0,20,"Käytiin läpi "+overall+" salasanaa."
Text 0,40,"Aikaa meni "+aika+" sekuntia."
DrawScreen
Forever

EDIT:

Nonniin 364801kpl salasanoja 10 sekunnissa \,,/

Posted: **Tue Sep 16, 2008 6:56 pm**

Teinpäs tästä vielä tälläisen funktiomuotoisen, toimii minkä tahansa pituisilla merkkijonoilla ja päivitysväliä voi itse säätää _step parametrillä. Joten edes tuo mainitsemasi 50000 yhdistelmää sekunnissa ei jää kovin kauaksi omalla koneellani (voisi tietysti kokeilla kuinka suurella arvolla saataisiin optimaalisin nopeus).

Otin myös numerot mukaan merkkijonoihin. Tosin samantien voisi kai ottaa koko ASCII taulukon, vaikkakin se vaikuttaisi nopeuteen haitallisesti.

Code: Select all

txt$=Crack("AxAy")

Repeat 

    Text 0,0,txt$

    DrawScreen 

Forever


Function Crack(_txt$,_step=10000)
    
    lenght=Len(_txt$)
    
    Dim cracked(lenght)
    
    For a=1 To lenght
        cracked(a)=48
    Next a
    
    overall=0
    
    Repeat
        
        For i=1 To _step
        
            overall+1
            cracked(lenght)=cracked(lenght)+1
           
            For o=2 To lenght
                If cracked(o)=122 Then
                   cracked(o)=48
                   cracked(o-1)=cracked(o-1)+1
                EndIf
            Next o
            
            password$=""
            For o=1 To lenght
                
                password$=password$+Chr(cracked(o))
            Next o
            
            If password$ = _txt$ Then Return "Salasana on "+_txt$+". Käytiin läpi "+overall+" salasanaa."
           
            If cracked(1)=255 Then Return "Salasanaa ei löytynyt."
        
        Next i
        
        Text 0,0,"Läpikäydyt salasanat: "+overall
        
        Text 0,20,"Salasana: "+password$
        
        DrawScreen 

    Forever
    
End Function

Posted: **Tue Sep 16, 2008 7:13 pm**

DatsuniG wrote:Ja tämän olis voinut tehdä siistimminkin/lyhkäsemminkin, mutta tein tämän vain huvin vuoksi : )

Tällä tarkoitin juuri tätä otto90x funktion For next rakennetta. : )

Posted: **Fri Sep 26, 2008 11:33 pm**

Hmm... Joo... Tämähän on aika hieno. =D Ääkköset toimii, mutta laittakaapa salasanaksi "äö", niin ei löydä salasanaa =O
En kyllä itse tarvi =D Mutta hauska tällä on leikkiä... xD

Posted: **Sat Sep 27, 2008 9:58 am**

Tässä nyt olisi vielä tämmöinen versio. Mikä lähtee salasanan pituudesta 1 ja kasvaen niin kauvan että oikea salasana löytyy. Myös toimii ä,ö,Ä,Ö. Toki voisi laittaa koko ASCII-taulukon, mutta nopeus kärsisi liikaa. Tähän kun vielä yhdistää MD5-hashin, että murtaa niitä. Tosin oisi jo niin niin hidas (kokeiltu on). Tosin C++:lla tuli tämä sama koodattua ja oli 'hitusen' nopeempi

Code: Select all

    txt$=Crack("Äöa")

    Repeat

        Text 0,0,txt$

        DrawScreen

    Forever


    Function Crack(_txt$,_step=10000)
       
        lenght=1
       
        Dim cracked(lenght)
       
        For a=1 To lenght
            cracked(a)=48
        Next a
       
        overall=0
       
        Repeat
           
            For i=1 To _step
           
                overall+1
                cracked(lenght)=cracked(lenght)+1
                If lenght > 1 Then 
                    For o=2 To lenght
                        If cracked(o) = 122 Then cracked(o) = 196 ' "Ä"
                        If cracked(o) = 197 Then cracked(o) = 214 ' "Ö"
                        If cracked(o) = 215 Then cracked(o) = 226 ' "ä"
                        If cracked(o) = 227 Then cracked(o) = 246 ' "ö"
                        If cracked(o)=247 Then '"ö"
                           cracked(o)=48
                           cracked(o-1)=cracked(o-1)+1
                        EndIf
                    Next o
                EndIf 
                password$=""
                For o=1 To lenght
                   
                    password$=password$+Chr(cracked(o))
                Next o
               
                If password$ = _txt$ Then Return "Salasana on "+_txt$+". Käytiin läpi "+overall+" salasanaa."
               
                If cracked(1)=255 Then 
                    lenght + 1
                    ReDim cracked(lenght)
                    For a=1 To lenght
                        cracked(a)=48
                    Next a
                EndIf 
           
            Next i
           
            Text 0,0,"Läpikäydyt salasanat: "+overall
           
            Text 0,20,"Salasana: "+password$
           
            DrawScreen

        Forever
       
    End Function

Posted: **Sat Sep 27, 2008 3:44 pm**

Onkos tuosta mahdollista saada pois nuo merkit? Että ei kävis niitä läpi ollenkaan... Eli kävis läpi vaan kirjaimet ja numerot. Miten se tehdään? =D

EDIT:

Tai pelkät kirjaimet =/

CoolBasic Forums

Über kräk engine

Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine

Re: Über kräk engine