Thanks neil.
.
Code: Select all
declare sub dopassword
Type d2
As Single mx,my
As Single mw,dy
End Type
Sub throughview(b As d2,a As Single=.5)
#define A_R( c ) ( ( c ) Shr 16 And 255 )
#define A_G( c ) ( ( c ) Shr 8 And 255 )
#define A_B( c ) ( ( c ) And 255 )
Static As Ulong _colour(81,81),clr
Static As Long result
#macro rotate(pivotx,pivoty,px,py,a,scale)
Var Newx=scale*((px-pivotx))+pivotx
Var Newy=scale*((py-pivoty))+pivoty
#endmacro
#macro incircle(cx,cy,r,mx,my,a)
If a<=1 Then
result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a
Else
result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r)
End If
#endmacro
If b.mw=0 Then b.mw=1
b.mw=Abs(b.mw)
For x As Long=b.mx-40 To b.mx+40
For y As Long=b.my-40 To b.my+40
incircle(b.mx,b.my,40,x,y,a)
If result Then
clr=Point(x,y)
_colour(x-b.mx+40,y-b.my+40)=Rgb(A_R(clr)*1,A_G(clr)*1,A_B(clr)*1)
End If
Next y
Next x
Static As Single dil
For x As Long=b.mx-40 To b.mx+40
For y As Long=b.my-40 To b.my+40
incircle(b.mx,b.my,40,x,y,a)
If result Then
rotate(b.mx,b.my,x,y,0,dil)
Var dist=Sqr((b.mx-newx)*(b.mx-newx)+(b.my-newy)*(b.my-newy))
dil=(b.mw+(.5-b.mw)*dist/(40*b.mw))
Line(NewX-dil/2,NewY-dil/2)-(NewX+dil/2,NewY+dil/2),_colour(x-b.mx+40,y-b.my+40),BF
End If
Next y
Next x
End Sub
Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
Static As Integer pitch,pitchs,xres,yres,runflag
Static As Any Ptr row,rows
Static As Integer ddx,ddy,resultx,resulty
Imageinfo im,ddx,ddy,,pitch,row
If dest=0 Then
Screeninfo xres,yres,,,pitchS
rowS=Screenptr
Else
If sc<>1 Then
Dim As Integer x,y
Imageinfo dest,x,y
Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
End If
Imageinfo dest, xres,yres,,pitchS,rows
End If
Dim As Long centreX=ddx\2,centreY=ddy\2
Dim As Single sx=Sin(angle)
Dim As Single cx=Cos(angle)
Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
Var fx=sc*.7071067811865476,sc2=1/sc
If fixedpivot=false Then
shiftx+=centreX*sc-centrex
shiftY+=centrey*sc-centrey
End If
For y As Long=centrey-fx*mx+1 To centrey+ fx*mx
Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
shfty=y+shifty
For x As Long=centrex-mx*fx To centrex+mx*fx
If x+shiftx >=0 Then 'on the screen
If x+shiftx <xres Then
If shfty >=0 Then
If shfty<yres Then
resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
If resultx >=0 Then 'on the image
If resultx<ddx Then
If resulty>=0 Then
If resulty<ddy Then
Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
End If:End If:End If:End If
End If:End If:End If:End If
Next x
Next y
End Sub
Function create As String
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
#define ic Imagecreate(20,20)
Var ypos=60,x=40
Dim As Any Ptr i(1 To 9)={ic,ic,ic,ic,ic,ic,ic,ic,ic}
Dim As String s="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
s+=Lcase(s)+"0123456789"
Dim As String acc
For n As Long=1 To 9
Var id=range(0,61)
acc+=Chr(s[id])
Draw String i(n),(0,0),Chr(s[id]),Rgb(Rnd*255,Rnd*255,Rnd*255)
Next
Color ,Rgb(255,255,255)
Cls
Dim As Long xpos
For n As Long=1 To 9
Var s=1.5+(Rnd*.5)
Var a=(Rnd-Rnd)/2
rotateimage(,i(n),a,20*n+x,ypos,s,,0)
If n=5 Then xpos=20*n+x
Next n
Dim As d2 b =Type(xpos,ypos+8,1.5,0)
throughview(b)
For n As Long=1 To 9
Imagedestroy(i(n))
Next
Return acc
End Function
'===============
sub entry
Randomize
Screenres 400,200,32
Width 400\8,200\16
Dim As String key
Do
Var word=create
' Draw String (50,180),word,Rgb(0,0,0) ''hint
Dim As String ans
Do
Locate 1,1
Color 0
Input "Please enter the characters below ",ans
If ans=word Then
Print "OK, Wait one second"
Locate 3
Print String(30,32)
sleep 1000
screen 0,,,&h80000000
dopassword
Else
Cls
word=create
'' Draw String (50,180),word,Rgb(0,0,0)
Draw String (50,30), "WRONG, TRY THE NEXT ONE:",Rgb(200,0,0)
End If
Loop Until ans=word
Sleep
Cls
key=Inkey
Loop Until key= Chr(255)+"k" Or key=Chr(27)
end sub
sub dopassword
Dim As String username, password, website
Dim As Integer choice,key,r
Key = &H59FE9749274F
Do
Print
Print "Password manager"
Print
Print "1. Store data 2. Retrieve data 3. Exit program"
Print
Input "Choose: ", choice
Select Case choice
Case 1
Randomize Key
Print
Input "Enter website: ", website
Input "Enter username: ", username
Input "Enter password: ", password
' Encrypt the password using XOR
For i As Integer = 1 To Len(password)
r = int(rnd * 256)
Mid(password, i, 1) = Chr(Asc(Mid(password, i, 1)) Xor r)
Next
' Store the username and encrypted password in a file
Open "userinfo.txt" For Append As #1
Print #1, website
Print #1, username
Print #1, password
Close #1
Print
Print "Data stored successfully."
Case 2
Randomize Key
Dim As String storedWebsite,storedUsername, storedPassword
Print
Input "Enter website: ", website
' Retrieve the encrypted password from the file
Open "userinfo.txt" For Input As #1
Do While Not(EOF(1))
Line Input #1, storedWebsite
If storedWebsite = website Then
Line Input #1, storedUsername
Line Input #1, storedPassword
For i As Integer = 1 To Len(storedPassword)
r = int(rnd * 256)
Mid(storedPassword, i, 1) = Chr(Asc(Mid(storedPassword, i, 1)) Xor r)
Next
Print
Print "Website: " + storedwebsite
Print "Username: " + storedUsername
Print "Password: " + storedPassword
Exit Do
End If
Loop
Close #1
Case 3
Exit do
Case Else
Print
Print "Invalid choice."
End Select
Loop
End
end sub
entry