Simple Accountmanager

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
mrminecrafttnt
Posts: 131
Joined: Feb 11, 2013 12:23

Simple Accountmanager

Post by mrminecrafttnt »

Code: Select all

type account
    username as string
    userpassword as string
    userid as integer
    loggedin as integer
    banned as integer
    used as integer
end type

dim shared as account accounts(10)

sub parsewords (source as string, byref part1 as string,byref part2 as string,parsetarget as string = "=")
    part1 = left(source,instr(source,parsetarget)-1)
    part2 = right(source,instr(source,parsetarget)+1)
end sub

function search_account (username as string,d() as account) as integer
    if username = "" then return -1
    for i as integer = lbound(d) to ubound(d)
        if d(i).username = username then return i
    next
    return -1
end function

function login_account (username as string,password as string,d() as account) as integer
    dim as integer id = search_account(username,d())
    if id = -1 then print "Account not found" : return 0
    if d(id).loggedin = 1 then print "User is allready loggedin!": return 0
    if d(id).banned = 1 then print "User is banned!":return 0
    if d(id).userpassword = password and d(id).used = 1 and d(id).banned = 0 then
        d(id).loggedin = 1
        return -1
    else
        return 0
    end if
end function

function logout_account (username as string,d() as account) as integer
    dim as integer id = search_account(username,d())
    if id > -1 then
        d(id).loggedin = 0
        return -1
    end if
    return 0
end function

   

function add_account(username as string,password as string,d() as account) as integer
    dim as integer foundid = search_account(username,d())
    if foundid > -1 then print "Username already exists" : return 0
    if username = "" then Print "Empty Username" : return 0
    for i as integer = lbound(d) to ubound(d)
        if d(i).used = 0 then
            d(i).used = 1
            d(i).username = username
            d(i).userpassword = password
            return -1
        end if
    next
    return 0
end function

sub ban_account(username as string,d() as account)
    dim as integer id = search_account(username,d())
    if id > -1 then d(id).banned = 1 else print "Username not found"
end sub

sub delete_account(username as string,d() as account)
    dim as integer id = search_account(username,d())
    if id > -1 then
        with d(id)
            .username = ""
            .userpassword = ""
            .userid = 0
            .loggedin = 0
            .banned = 0
            .used = 0
        end with
        print "User Deleted"
    else
        print "failed"
    end if
end sub

    print "User deleted"

dim as string username,password
do
   
    cls
    locate 1
    print "1- Login"
    print "2- Logout"
    print "3- Ban account"
    print "4- Delete account"
    print "5- Add account"
    print "6- Exit"
    locate csrlin + 1
    select case val(input(1))
    case 1
        print "Login"
        input "Username :";username
        input "Password :";password
        if login_account(username,password,accounts()) = -1 then
            print "sucess"
        else
            print "failed"
        end if
    case 2
        print "Logout"
        input "Username :";username
        if logout_account(username,accounts()) = -1 then
            print "sucess"
        else
            print "failed"
        end if
    case 3
        print "Ban User"
        input "Username : ";username
        ban_account(username,accounts())
    case 4
        print "Delete User"
        Input "Username :";username
        delete_account(username,accounts())
    case 5
        print "Add Account"
        input "Username :";username
        input "Password :";password
        if add_account(username,password,accounts()) = -1 then print "sucess" else print "failed"
    case 6
        exit do
    end select
    sleep 1000
loop
sancho2
Posts: 547
Joined: May 17, 2015 6:41

Re: Simple Accountmanager

Post by sancho2 »

Looks good.
The sub parsewords is not used.
Post Reply