Password generator

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
neil
Posts: 594
Joined: Mar 17, 2022 23:26

Password generator

Post by neil »

With some assistance from DeepAI Chat, here's a password generator.

Code: Select all

' FreeBasic Password Generator

Dim As Integer passwordLength
Dim Shared As String letters,numbers,specialChars

letters = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
numbers = "0123456789"
specialChars = "!@#$%^&*()_+-=[]{}|;:,.<>?/"

Function GeneratePassword(length As Integer) As String
    Dim As String password
    Dim As Integer charType,i 
    
    Randomize
    
    For i = 1 To length
        charType = Int(Rnd * 3)
        
        Select Case charType
            Case 0
                password &= Mid(letters, Int(Rnd * Len(letters)) + 1, 1)
            Case 1
                password &= Mid(numbers, Int(Rnd * Len(numbers)) + 1, 1)
            Case 2
                password &= Mid(specialChars, Int(Rnd * Len(specialChars)) + 1, 1)
        End Select
    Next
    
    GeneratePassword = password
End Function

Input "Password length: ", passwordLength

Print "Generated password: " & GeneratePassword(passwordLength)
Sleep
neil
Posts: 594
Joined: Mar 17, 2022 23:26

Re: Password generator

Post by neil »

Here's a not-so-secure way to store passwords. Maybe someone has a better way of doing this using FreeBasic with encryption.

Code: Select all

' Freebasic password list

Dim As String key,password,s1
password = "secret"

Print "Enter password: ";
Do

Key = Inkey
If key > "" Then s1 += key:print "*";
if key = chr(13) Then exit do
Loop Until key = chr(27)
if key = chr(27) Then End
Print
if s1 = password + chr(13) Then

Print "Access granted"

Print
Print "Password  List"
Print "Website 1 Username site1 Password site1"
Print "Website 2 Username site2 Password site2"
Print "Website 3 Username site3 Password site3"
Print "Website 4 Username site4 Password site4"
sleep
Else
Print "Access denied"
sleep
End If
sleep
neil
Posts: 594
Joined: Mar 17, 2022 23:26

Re: Password generator

Post by neil »

Here's a minimal password manager with an encrypted password. It stores data and retrieves data from a file.

Code: Select all

'FreeBasic minimal password manager

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
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Password generator

Post by dodicat »

Thanks neil.
I have added (for fun) an entry in case you are a BOT.

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
    
Post Reply