[Windows] Especially for Ricardo !
Posted: Thu Sep 05, 2002 4:47 pm
Code updated for 5.20+
Restored from previous forum. Originally posted by fweil.
I am not sure you are looking for solutions to do something on the web without to be tracked and prosecuted !
Maybe this one will interest you or somebody else.
It is just for fun and nothing else.
I don't know what is the purpose of this application I found I don't remember when, and don't have any idea on how I coded it in PureBasic.
Just copy / paste and press the return key to have results, and if somebody can explain what is it!
Francois Weil
14, rue Douer
F64100 Bayonne
Restored from previous forum. Originally posted by fweil.
I am not sure you are looking for solutions to do something on the web without to be tracked and prosecuted !
Maybe this one will interest you or somebody else.
It is just for fun and nothing else.
I don't know what is the purpose of this application I found I don't remember when, and don't have any idea on how I coded it in PureBasic.
Just copy / paste and press the return key to have results, and if somebody can explain what is it!
Code: Select all
;====================================================
#background = $602020
Procedure.l IMod(a.l, b.l)
ProcedureReturn a - (b * (a / b))
EndProcedure
Procedure.l CheckCard(CCNumber.s)
Counter.l
TmpInt.l
Rep.l
Counter = 1
TmpInt = 0
While Counter <> 0
TmpInt = Val(Mid(CCNumber, Counter, 1))
If (IMod(Counter, 2)) = #False
TmpInt = TmpInt * 2
If TmpInt > 9
TmpInt = TmpInt - 9
EndIf
EndIf
Rep = Rep + TmpInt
Counter = Counter + 1
Wend
Rep = IMod(Rep, 10)
If Rep = 0
CheckCard = #True
EndIf
If CheckCard = #True
CredCardBackColor = $FFFFC0
TimerEnabled = #False
Else
CredCardBackColor = $C0FFFF
EndIf
ProcedureReturn CheckCard
EndProcedure
Procedure.s GenCard()
ChkCard:
CredCard.s = Str(Random(8999) + 1000) + Str(Random(8999) + 1000) + Str(Random(8999) + 1000) + Str(Random(8999) + 1000)
If Len(CredCard) < 16
Goto ChkCard
EndIf
Result.l = CheckCard(CredCard)
If Result
ProcedureReturn CredCard
Else
Goto ChkCard
EndIf
EndProcedure
Procedure MyWindowCallBack(WindowID.l, Message.l, wParam.l, lParam.l)
Result.l
Result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_PAINT
StartDrawing(WindowOutput(0))
DrawImage(ImageID(0), 0, 0)
StopDrawing()
Case #PB_Event_Repaint
StartDrawing(WindowOutput(0))
DrawImage(ImageID(0), 0, 0)
StopDrawing()
Case #PB_Event_MoveWindow
StartDrawing(WindowOutput(0))
DrawImage(ImageID(0), 0, 0)
StopDrawing()
Default
EndSelect
ProcedureReturn Result
EndProcedure
;
; Main starts here
;
hWnd.l
WID.l
WEvent.l
EventMenu.l
EventGadget.l
WindowXSize.l
WindowYSize.l
Quit.l
FontID.l
ImageID.l
Quit = #False
WindowXSize = 320
WindowYSize = 240
; #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_Invisible | #PB_Window_TitleBar | #PB_Window_BorderLess
hWnd = OpenWindow(0, 200, 200, WindowXSize, WindowYSize,"MyWindow",#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar)
If hWnd
AddKeyboardShortcut(0, #PB_Shortcut_Return, 20)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
LoadFont(0, "Verdana", 12)
FontID = FontID(0)
If CreateStatusBar(0, WindowID(0))
EndIf
SetWindowCallback(@MyWindowCallBack())
If CreateImage(0, WindowXSize, WindowYSize)
ImageID = ImageID(0)
StartDrawing(ImageOutput(0))
DrawingFont(FontID)
Box(0, 0, WindowXSize, WindowYSize, #background)
For i = 1 To 1000
Plot( Random(WindowXSize-1,1), Random(WindowYSize-1,1), RGB(Random(256), Random(256), Random(256)))
Next
FrontColor(RGB(255, 255, 0))
DrawingMode(1)
DrawText(WindowXSize / 2, WindowYSize / 2,"Hello world")
StopDrawing()
EndIf
StartDrawing(WindowOutput(0))
DrawImage(ImageID, 0, 0)
StopDrawing()
Repeat
WID = WindowID(0)
WEvent = WaitWindowEvent()
Select WEvent
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_Menu
EventMenu = EventMenu()
Select EventMenu
Case 20
StartDrawing(WindowOutput(0))
DrawText(20,20,GenCard())
StopDrawing()
Case 99
Quit = #True
Default
EndSelect
Case #PB_Event_Gadget
EventGadget = EventGadget()
Case #WM_LBUTTONDOWN
ReleaseCapture_()
SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Default
EndSelect
Until Quit
EndIf
End
;====================================================
Francois Weil
14, rue Douer
F64100 Bayonne