The 'best' only-one-play protected system

Just starting out? Need help? Post your questions and find answers here.
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

The 'best' only-one-play protected system

Post by Olli »

Hello !

Simple :

1) Execute the code below (no external API, no catch, no virus, no bacteria, etc...)
2) Run the program
3) Press [Escape] key to quit the program

Now, it is ready : you cannot execute this source code anymore !!! (bug ? Only on Windows ?)

To be clear :
- no ASM routine !
- code absolutely without external functions !
- only native functions !
- no registers base touch !
- whatever the debugger is !
- even compiled !
- price : $0.00 it is given ! ! !

and thank you pureBasic ! :D

(be careful : no guaranty, my version : 5.73 LTS x64 DEMO version)
To execute it one more time, change the constant starting number from 5555 to another number.

Code: Select all

Enumeration 5555
    #pif
EndEnumeration

Procedure screen()
    InitSprite()
    InitKeyboard()
    InitMouse()
    ExamineDesktops()
    dw = DesktopWidth(0)
    dh = DesktopHeight(0)
    dd = DesktopDepth(0)
    df = DesktopFrequency(0)
    OpenScreen(dw, dh, dd, "", #PB_Screen_SmartSynchronization, df)
    FlipBuffers()
EndProcedure

Procedure main01()
    Define cycle.I
    screen()    
    Repeat
        Delay(33)
        ExamineKeyboard()
        ExamineMouse()
        cycle + 1
        cycle & 127
        If cycle = 0
            ClearScreen(0)        
            FlipBuffers()
        EndIf
    Until KeyboardPushed(#PB_Key_All) Or MouseDeltaX() Or MouseDeltaY()
    CloseScreen()    
EndProcedure

Structure win0
    wn0.I
    x.I
    y.I
    iw.I
    ih.I
    name.S{40}
    flags.I
    
    ev.I
    evMenu.I
    scrSaverDelay.I
    itemQuit.I
    
    gdt.I
    ftTitle.I
    ftCode.I
EndStructure

Procedure rect(x.I, y.I, w.I, h.I, c.I)
    Define x2.I = x + w - 1
    Define y2.I = y + h - 1
    LineXY(x, y, x2, y, c)
    LineXY(x, y, x, y2, c)
    LineXY(x2, y, x2, y2, c)
    LineXY(x, y2, x2, y2, c)    
EndProcedure

Procedure monofont(*this.win0, x.I, y.I, w.I, h.I)
    With *this
        Define lineW.I = w
        Define lineH.I = 24
        Define mfH.I = Int(h / 24) * 24
        DrawingFont(FontID(\ftCode) )
        For Yi = y To (y + mfH - 1) Step 0
            DrawText(x, Yi, Str((Yi - y) / lineH), RGB(0, 0, 0), RGB(255, 255, 255) )
            rect(x, Yi, w, lineH, c)        
            Yi + lineH
        Next
        rect(x, y, w, h, RGB(0, 0, 0) )
    EndWith
EndProcedure

Procedure gdtRedraw(*this.win0)
    With *this
        If StartDrawing(CanvasOutput(\gdt) )
            DrawingFont(FontID(\ftTitle) )
            DrawText(0, 0, "This will be read only one time... ", RGB(0, 127, 0), RGB(255, 255, 255) )
            DrawingFont(FontID(\ftCode) )
            DrawText(0, 64, "10 PRINT 'Bonjour'", RGB(0, 0, 0), RGB(255, 255, 255) )
            monofont(*this, 20, 88, \iw - 40, \ih - 88 - 20)
            StopDrawing()
        EndIf
        EndWith        
EndProcedure

Procedure wn0save(*this.win0, fname.S)
    Define file.I
    With *this
        file = CreateFile(#PB_Any, fname)
        WriteData(file, *this, MemorySize(*this) )
        CloseFile(file)
    EndWith
EndProcedure

Procedure wn0load(*this.win0, fname.S)
    Define file.I
    With *this
        file = ReadFile(#PB_Any, fname)
        ReadData(file, *this, MemorySize(*this) ) 
        CloseFile(file)
    EndWith
EndProcedure

Procedure main()
    Define cfgFile.S = "C:\VSA\veille.dat"
    Define *this.win0 = AllocateMemory(SizeOf(win0) )
    With *this
        If FileSize(cfgFile) = -1 Or 0
        \x = 100
        \y = 100
        \iw = 800
        \ih = 600
        \name = "Test"
        \scrSaverDelay = 30000
        Else
            wn0load(*this, cfgFile)
        EndIf
        \flags = #PB_Window_SystemMenu | #PB_Window_SizeGadget
        \wn0 = OpenWindow(#PB_Any, \x, \y, \iw, \ih, \name, \flags)
        \gdt = CanvasGadget(#PB_Any, 0, 0, \iw, \ih, #PB_Canvas_Keyboard)
        \ftTitle = LoadFont(#PB_Any, "verdana", 24)
        \ftCode = LoadFont(#PB_Any, "courier new", 10)
        gdtRedraw(*this)
        AddWindowTimer(\wn0, 1, \scrSaverDelay)
        \itemQuit = #pif
        AddKeyboardShortcut(\wn0, #PB_Shortcut_Escape, \itemQuit)
        Repeat            
            \ev = WaitWindowEvent()
            If \ev = #PB_Event_SizeWindow
                \iw = WindowWidth(\wn0)
                \ih = WindowHeight(\wn0)
                ResizeGadget(\gdt, 0, 0, \iw, \ih)
                gdtRedraw(*this)
            EndIf
            If \ev = #PB_Event_Timer
                RemoveWindowTimer(\wn0, 1)
                main01()
                AddWindowTimer(\wn0, 1, \scrSaverDelay)
            EndIf
            If \ev = #PB_Event_Menu
                \evMenu = EventMenu()
            EndIf
        Until \evMenu = \itemQuit
        wn0save(*this, cfgFile)
    EndWith    
EndProcedure

    main()
Question :

Code: Select all

Structure win0
    wn0.I    ; window handle
    x.I         ; window x position
    y.I         ; window y position
    iw.I       ; window width
    ih.I       ; window height
    name.S{40}    ; window title
    flags.I      ; window flags
    
    ev.I              ; real-time event code
    evMenu.I   ; real-time menu item code
    scrSaverDelay.I  ; screen saver delay
    itemQuit.I    ; item code to quit
    
    gdt.I           ; canvas gadget handle
    ftTitle.I      ; font for title
    ftCode.I    ; font for code
EndStructure
Knowing this structure is saved on disk, which variable (field) is saved and so prevents the program from being executed again ?
breeze4me
Enthusiast
Enthusiast
Posts: 511
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: The 'best' only-one-play protected system

Post by breeze4me »

Code: Select all

......
Until \evMenu = \itemQuit
Because the value at the previous end of the program is stored in the restored "\evMenu" field, the program ends immediately as soon as it runs.

Fixed code:

Code: Select all

Repeat
  ...
  
  If \ev = #PB_Event_Menu
    \evMenu = EventMenu()
    If \evMenu = \itemQuit
      Quit = 1
    EndIf
  EndIf
Until Quit
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

Re: The 'best' only-one-play protected system

Post by Olli »

I am really a nut...
Post Reply