Jump to content
Tuts 4 You

PureBasic Keygen Template


tim619

Recommended Posts

Posted
index.php?app=downloads&module=display&section=screenshot&id=936

File Name: PureBasic Keygen Template

File Submitter: tim619

File Submitted: 21 Mar 2014

File Category: Source Code

Today I release a Keygen which I programmed a few days ago.

It is written in PureBasic (v5.0) and can be compiled using x86 or x64 Compiler.

The features of this Keygen Template are:

-The language is very easy to understand and the code is not too much.

-transparency

-chiptune support

-fading in and out of transparency and music

-window always on top

-Key copied to clipboard autom.

-the "core" should also compile on MAC and Unix Version.

have fun :rudolph:

Click here to download this file

  • 3 weeks later...
Posted

This is very good work here! I had no idea the language was this easy and beginner friendly aswell, PureBasic needs more support. anyhow, thank you for this Template good sir! ^^


Teddy Rogers
Posted

I had no idea the language was this easy and beginner friendly aswell, PureBasic needs more support.

 

Yes, I agree. Have been taking a look at the language a bit more closely myself recently, I even purchased a PureBasic licence the other week!

 

Ted.

Posted

I still can't understand, why PB is so underrated. It is a miracle language (fortunatelly or unfortunately) for malware development :)


Posted

@X-ProgRammeR no problem here dont run from archive select winrar extract its extract normal.


  • Like 1
Posted

@X-Programmer: Could this be the problem?.. ;)


 




Note: The binary included is x64 only...



Posted

Kao mate hi has problem with extraction with winrar i don have 64 byte i have 32 i don get any extract probs


  • Like 1
X-ProgRammeR
Posted

I run that in x32 :D So i think that's only the cause. 


  • Like 1
  • 11 years later...
hitech444
Posted

Do you think the generated codes will work on SpiderBasic, little brother of PureBasic???

 

  • Like 1
Teddy Rogers
Posted
7 hours ago, hitech444 said:

Do you think the generated codes will work on SpiderBasic

I have not looked at the code though I do not see why the core of the keygen could not. It may need a few tweaks to get running on (PB6.x and) SB3.x...

Ted.

  • Like 1
hitech444
Posted

Crap!!! Downloaded SB3.02 is a limited version.... Does not upgrade to the full monty... I guess I have to buy it...

Same goes with sister prog PB... no serial, you just download the full thing... 

Difficult for a newbie to try his hands on....

  • Like 1
Teddy Rogers
Posted
11 hours ago, hitech444 said:

Difficult for a newbie to try his hands on....

The free version of PureBasic has a limit of around 800 lines of code (I can't comment on SpiderBasic, will assume it is similar). That is plenty of room for creating, testing and building keygen templates and the "core" component mentioned here.

Download it and give it a try...

Ted.

  • Like 1
hitech444
Posted

Sorry for confusing you - my mistake! I just want the full SB. PB and SB trials are compiled limited editions of the full versions, they don't upgrade to full as I thought.  So that's hard to change? Isn't it?

  • Like 1
Teddy Rogers
Posted
19 hours ago, hitech444 said:

they don't upgrade to full as I thought.

Have you checked the limitations? I downloaded both SB and PB demos and checked for you...

image.png image.png

I have not tried SB however, in PB demo I was able to build (with some fixes) and compile an executable using @tim619 code. Check out the attached .zip file.

keygen_fixed.zip

To get it working in PB6.x I had to replace the legacy "module" commands to "music". In the process I noticed a number of other problems (threading, declarations, command order and event window) and spent a few minutes doing some quick fixes for you. I have not checked the "keygen" code, left it as is...

Spoiler


Declare MusicAndEffects(void)
Declare SetWindowTransparency(Window.i, transparency.i)

Global Window_0
Global Thread
Global ThreadEnd
Global ThreadExited

Window_0 = OpenWindow(#PB_Any, 0, 0, 420, 70, "************ Keygen", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Invisible)
Text_0 = TextGadget(#PB_Any, 10, 12, 50, 20, "Version:")
Text_1 = TextGadget(#PB_Any, 20, 44, 40, 20, "Serial:")
Combo_0 = ComboBoxGadget(#PB_Any, 60, 10, 270, 20)
String_1 = StringGadget(#PB_Any, 60, 40, 270, 20, "", #PB_String_ReadOnly)
Button_0 = ButtonGadget(#PB_Any, 340, 10, 70, 20, "Generate")
Button_1 = ButtonGadget(#PB_Any, 340, 40, 70, 20, "Activate")

AddGadgetItem(Combo_0, -1,"Full Version")
AddGadgetItem(Combo_0, -1,"Limited Version")
SetGadgetState(Combo_0, 0)

SetWindowTransparency(Window_0,0)
HideWindow(Window_0,0) 
StickyWindow(Window_0,1) ; 0 is window id, 1 is always stay on top

Thread = CreateThread(@MusicAndEffects(), #Null)

Repeat  
  
  Event = WaitWindowEvent()
  
  Select Event
      
    Case #PB_Event_Gadget
      
      Select EventGadget()
        Case Button_0
          Dim Key1Random.s(4)
          Key1Random(0) = "0"
          Key1Random(1) = "1"
          Key1Random(2) = "2"
          Key1Random(3) = "4"
          Key1Random(4) = "5"
          RandomizeArray(Key1Random())
          Dim Key2Random.s(4)
          Key2Random(0) = "1"
          Key2Random(1) = "2"
          Key2Random(2) = "3"
          Key2Random(3) = "4"
          Key2Random(4) = "5"
          RandomizeArray(Key2Random())
          Dim Key3Random.s(4)
          Key3Random(0) = "0"
          Key3Random(1) = "2"
          Key3Random(2) = "3"
          Key3Random(3) = "4"
          Key3Random(4) = "5"
          RandomizeArray(Key3Random())
          Dim Key4Random.s(4)
          Key4Random(0) = "0"
          Key4Random(1) = "1"
          Key4Random(2) = "3"
          Key4Random(3) = "4"
          Key4Random(4) = "5"
          RandomizeArray(Key4Random())     
          
          Key1.s = Str(Random(9))+Str(Random(9))+Str(Random(9))+Key1Random(0)+Str(Random(9))+Str(Random(9))
          Key2.s = Key2Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))
          Key3.s = Str(Random(9))+Key3Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))
          Key4.s = Str(Random(9))+Str(Random(9))+Key4Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))
          
          If GetGadgetState(Combo_0) = 0 ; Full Version
            Dim NumReplace.s(3)
            NumReplace(0) = "5"
            NumReplace(1) = "6"
            NumReplace(2) = "7"
            NumReplace(3) = "9"
            RandomizeArray(NumReplace()); 4 fac. = 24 diff. possib.
            
            Num1Replace.s = NumReplace(0)
            Num2Replace.s = NumReplace(1)
            Num3Replace.s = NumReplace(2)
            Num4Replace.s = NumReplace(3)
          Else ; Limited Version
            Random.i = Mod(Random(1)+1, 2)
            ; We have two possibilities to get the multiplied result
            ; so we make a random test to decide which numbers we use...
            If Random = 0
              Dim NumReplace.s(3)
              NumReplace(0) = "3"
              NumReplace(1) = "5"
              NumReplace(2) = "8"
              NumReplace(3) = "8"
              RandomizeArray(NumReplace()); 4 fac/2
            Else 
              Dim NumReplace.s(3)
              NumReplace(0) = "4"
              NumReplace(1) = "5"
              NumReplace(2) = "6"
              NumReplace(3) = "8"
              RandomizeArray(NumReplace()); 4 fac
            EndIf
            
            Num1Replace.s = NumReplace(0)
            Num2Replace.s = NumReplace(1)
            Num3Replace.s = NumReplace(2)
            Num4Replace.s = NumReplace(3)
          EndIf
          
          ;This "emulates" the actionscript function substr()
          ;and because AS interprets the actual position as actual pos. +1
          ;we have to add one number
          ;Than one hardcoded pos. is asked (in first case pos. number 4)
          ;We go to this pos. read the number go to pos. of read number and there
          ;has to be one number of our RandomizeArray()
          ;I removed one number for every field always the pos. -1 number because
          ;that number would overwrite the hardcoded number and algo would be wrong...
          Pos1.s = Mid(Key1,4,1) 
          IntPos1.i = Val(Pos1)+1
          Num1.s = Mid(Key1,IntPos1,1)
          Key11.s = RemoveString(Key1, Num1, #PB_String_CaseSensitive, IntPos1, 1)
          Key1final.s = InsertString(Key11, Num1Replace, IntPos1)
          
          Pos2.s = Mid(Key2,1,1)
          IntPos2.i = Val(Pos2)+1
          Num2.s = Mid(Key2,IntPos2,1)
          Key21.s = RemoveString(Key2, Num2, #PB_String_CaseSensitive, IntPos2, 1)
          Key2final.s = InsertString(Key21, Num2Replace, IntPos2)
          
          Pos3.s = Mid(Key3,2,1)
          IntPos3.i = Val(Pos3)+1
          Num3.s = Mid(Key3,IntPos3,1)
          Key31.s = RemoveString(Key3, Num3, #PB_String_CaseSensitive, IntPos3, 1)
          Key3final.s = InsertString(Key31, Num3Replace, IntPos3)
          
          Pos4.s = Mid(Key4,3,1)
          IntPos4.i = Val(Pos4)+1
          Num4.s = Mid(Key4,IntPos4,1)
          Key41.s = RemoveString(Key4, Num4, #PB_String_CaseSensitive, IntPos4, 1)
          Key4final.s = InsertString(Key41, Num4Replace, IntPos4)
          
          Final.s = Key1final+"-"+Key2final+"-"+Key3final+"-"+Key4final
          Datfile.s = "field_1="+Key1final+"&field_2="+Key2final+"&field_3="+Key3final+"&field_4="+Key4final     
          
          SetClipboardText(Final)      
          SetGadgetText(String_1, Final)
          ;Well serial is generated successfull.. BUT target wont accept typing in UI
          ;so we have to write the serial to the desired directory if....
        Case Button_1
          ; the button activate is pressed...
          If Len(Datfile) > 1
            If CreateFile(0, GetEnvironmentVariable("windir")+"\wind.dat")
              WriteStringN(0, Datfile)
              CloseFile(0)
              SetGadgetText(String_1, "Successfully activated :-)") 
            Else
              SetGadgetText(String_1, "Couldn't write keyfile... :-(")
            EndIf      
          Else
            SetGadgetText(String_1, "Generate serial first...")
          EndIf
      EndSelect
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case Window_0
          If IsThread(Thread)
            ThreadEnd = #True
          Else
            ThreadExited = #True
          EndIf
      EndSelect
  EndSelect 
  
Until ThreadExited = #True

End 

Procedure.i SetWindowTransparency(Window.i, transparency.i)
  
  SetWindowLongPtr_(WindowID(Window.i),#GWL_EXSTYLE,#WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID(Window.i),0,transparency,#LWA_ALPHA)
  
EndProcedure

Procedure MusicAndEffects(void)
  Protected XMMusic, i
  
  ; Initialise and start music.
  
  If InitSound()
    
    XMMusic = CatchMusic(#PB_Any, ?ModuleStart, ?ModuleEnd-?ModuleStart)
    
    If IsMusic(XMMusic)
      
      PlayMusic(XMMusic)
      MusicVolume(XMMusic, 1)
      
      ; Fade in window and increase volume.
      
      For i = 1 To 200
        MusicVolume(XMMusic, i/4)
        Delay(15)
        SetWindowTransparency(Window_0,i)
      Next i
      
      ; When music ends it goes to 255, so works for every length less equal 255
      
      Repeat
        
        If GetMusicPosition(XMMusic) = 255 
          SetMusicPosition(XMMusic, 0)
          PlayMusic(XMMusic)
        EndIf
        
        ; Reduce using unnecessary CPU time.
        
        Sleep_(1000)
        
      Until ThreadEnd = #True
      
      ; Fade out window and decrease volume.
      
      For i = 200 To 1 Step -1
        Delay(5)
        SetWindowTransparency(Window_0,i)
        MusicVolume(XMMusic, i/4)
      Next i
      
    EndIf
  EndIf
  
  ThreadExited = #True
  
EndProcedure

DataSection
  ModuleStart: 
  IncludeBinary "daydreams.xm"; filename
  ModuleEnd:
EndDataSection

Ted.

  • Like 1
hitech444
Posted (edited)

Well, thanks a lot for the fixed keygen but I can't see the relevance... we need to modify the SB exe inside to make it work for much more code lines.... Am I missing something here???

I would expect to advice me to search for 800 and change it to something much, much bigger.....

Edited by hitech444
  • Like 1
Teddy Rogers
Posted

@hitech444 if your original question was intended to mean, "can this PureBasic "keygen" be used to activate the full version of SpiderBasic", then I misunderstood you and wasted my time updating the PB code. This is an example keygen template written in PureBasic, it is not a real keygen and, cannot be used to activate either PureBasic or SpiderBasic. The free versions of these cannot be activated using a serial number, there is a full version download and installer - accessible to paid customers. You could theoretically remove the code line limit in the free version/s.

If your question was, "can I run this PureBasic "keygen" code in SpiderBasic", then yes. A few, quick and rough, modifications to the original PureBasic code will make it work...

Spoiler
Declare CloseWindowEvent()
Declare GadgetEvents()

Global Window_0 = OpenWindow(#PB_Any, 0, 0, 420, 70, "************ Keygen", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Global Text_0 = TextGadget(#PB_Any, 10, 12, 50, 20, "Version:")
Global Text_1 = TextGadget(#PB_Any, 20, 44, 40, 20, "Serial:")
Global Combo_0 = ComboBoxGadget(#PB_Any, 60, 10, 270, 20)
Global String_1 = StringGadget(#PB_Any, 60, 40, 270, 20, "", #PB_String_ReadOnly)
Global Button_0 = ButtonGadget(#PB_Any, 340, 10, 70, 20, "Generate")
Global Button_1 = ButtonGadget(#PB_Any, 340, 40, 70, 20, "Activate")

AddGadgetItem(Combo_0, -1,"Full Version")
AddGadgetItem(Combo_0, -1,"Limited Version")
SetGadgetState(Combo_0, 0)

BindEvent(#PB_Event_Gadget, @GadgetEvents())
BindEvent(#PB_Event_CloseWindow, @CloseWindowEvent())

CompilerIf #PB_Compiler_OS <> #PB_OS_Web
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
CompilerEndIf

Procedure CloseWindowEvent()
  CloseWindow(EventWindow())
EndProcedure

Procedure GadgetEvents()
  Protected Datfile.s
  
  Select EventGadget()
    Case Button_0
      SetGadgetText(String_1, "Here Button 1")
      Dim Key1Random.s(4)
      Key1Random(0) = "0"
      Key1Random(1) = "1"
      Key1Random(2) = "2"
      Key1Random(3) = "4"
      Key1Random(4) = "5"
      RandomizeArray(Key1Random())
      Dim Key2Random.s(4)
      Key2Random(0) = "1"
      Key2Random(1) = "2"
      Key2Random(2) = "3"
      Key2Random(3) = "4"
      Key2Random(4) = "5"
      RandomizeArray(Key2Random())
      Dim Key3Random.s(4)
      Key3Random(0) = "0"
      Key3Random(1) = "2"
      Key3Random(2) = "3"
      Key3Random(3) = "4"
      Key3Random(4) = "5"
      RandomizeArray(Key3Random())
      Dim Key4Random.s(4)
      Key4Random(0) = "0"
      Key4Random(1) = "1"
      Key4Random(2) = "3"
      Key4Random(3) = "4"
      Key4Random(4) = "5"
      RandomizeArray(Key4Random())     
      
      Key1.s = Str(Random(9))+Str(Random(9))+Str(Random(9))+Key1Random(0)+Str(Random(9))+Str(Random(9))
      Key2.s = Key2Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))
      Key3.s = Str(Random(9))+Key3Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))+Str(Random(9))
      Key4.s = Str(Random(9))+Str(Random(9))+Key4Random(0)+Str(Random(9))+Str(Random(9))+Str(Random(9))
      
      If GetGadgetState(Combo_0) = 0 ; Full Version
        Dim NumReplace.s(3)
        NumReplace(0) = "5"
        NumReplace(1) = "6"
        NumReplace(2) = "7"
        NumReplace(3) = "9"
        RandomizeArray(NumReplace()); 4 fac. = 24 diff. possib.
        
        Num1Replace.s = NumReplace(0)
        Num2Replace.s = NumReplace(1)
        Num3Replace.s = NumReplace(2)
        Num4Replace.s = NumReplace(3)
      Else ; Limited Version
        Random.i = Mod(Random(1)+1, 2)
        ; We have two possibilities to get the multiplied result
        ; so we make a random test to decide which numbers we use...
        If Random = 0
          Dim NumReplace.s(3)
          NumReplace(0) = "3"
          NumReplace(1) = "5"
          NumReplace(2) = "8"
          NumReplace(3) = "8"
          RandomizeArray(NumReplace()); 4 fac/2
        Else 
          Dim NumReplace.s(3)
          NumReplace(0) = "4"
          NumReplace(1) = "5"
          NumReplace(2) = "6"
          NumReplace(3) = "8"
          RandomizeArray(NumReplace()); 4 fac
        EndIf
        
        Num1Replace.s = NumReplace(0)
        Num2Replace.s = NumReplace(1)
        Num3Replace.s = NumReplace(2)
        Num4Replace.s = NumReplace(3)
      EndIf
      
      ;This "emulates" the actionscript function substr()
      ;and because AS interprets the actual position as actual pos. +1
      ;we have to add one number
      ;Than one hardcoded pos. is asked (in first case pos. number 4)
      ;We go to this pos. read the number go to pos. of read number and there
      ;has to be one number of our RandomizeArray()
      ;I removed one number for every field always the pos. -1 number because
      ;that number would overwrite the hardcoded number and algo would be wrong...
      Pos1.s = Mid(Key1,4,1) 
      IntPos1.i = Val(Pos1)+1
      Num1.s = Mid(Key1,IntPos1,1)
      Key11.s = RemoveString(Key1, Num1, #PB_String_CaseSensitive, IntPos1, 1)
      Key1final.s = InsertString(Key11, Num1Replace, IntPos1)
      
      Pos2.s = Mid(Key2,1,1)
      IntPos2.i = Val(Pos2)+1
      Num2.s = Mid(Key2,IntPos2,1)
      Key21.s = RemoveString(Key2, Num2, #PB_String_CaseSensitive, IntPos2, 1)
      Key2final.s = InsertString(Key21, Num2Replace, IntPos2)
      
      Pos3.s = Mid(Key3,2,1)
      IntPos3.i = Val(Pos3)+1
      Num3.s = Mid(Key3,IntPos3,1)
      Key31.s = RemoveString(Key3, Num3, #PB_String_CaseSensitive, IntPos3, 1)
      Key3final.s = InsertString(Key31, Num3Replace, IntPos3)
      
      Pos4.s = Mid(Key4,3,1)
      IntPos4.i = Val(Pos4)+1
      Num4.s = Mid(Key4,IntPos4,1)
      Key41.s = RemoveString(Key4, Num4, #PB_String_CaseSensitive, IntPos4, 1)
      Key4final.s = InsertString(Key41, Num4Replace, IntPos4)
      
      Final.s = Key1final+"-"+Key2final+"-"+Key3final+"-"+Key4final
      Datfile.s = "field_1="+Key1final+"&field_2="+Key2final+"&field_3="+Key3final+"&field_4="+Key4final     
      
      SetClipboardText(Final)      
      SetGadgetText(String_1, Final)
      ;Well serial is generated successfull.. BUT target wont accept typing in UI
      ;so we have to write the serial to the desired directory if....
    Case Button_1
      Debug "Here Button 2"
      ; the button activate is pressed...
      If Len(Datfile) > 1
        SetGadgetText(String_1, "Successfully activated :-)") 
      Else
        SetGadgetText(String_1, "Generate serial first...")
      EndIf
  EndSelect
  
EndProcedure

Ted.

  • Thanks 1

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...