[VB] Merry Christmas from: l)ragon

[l)ragon]

Code Select Expand

'**************************'
'*'   Mod UserDatabase   '*'
'**************************'
Public UserFile As String
Public CFolder As String
Public LoadTextError As String
Public PasswordSearch As String
Public PasswordSearchFail As String
Public SaveThisPass As String
Public SaveThisUName As String
Public SaveThisClient As String



Sub SaveText(Lst As String, file As String)
On Error GoTo error
Dim mystr As String

Open file For Output As #1
Print #1, Lst
Close 1
Exit Sub
error:
x = "" 'MsgBox("There has been a error!", vbOKOnly, "Error")
End Sub

Public Function FindPass(xUFilex As String)
On Error GoTo ErrorLine
Dim pos As Long
Dim Count As Integer
Dim sfile As String
Dim nfile As Integer
Dim msg As String
Dim txtopen2 As String

PasswordSearchFail = ""
PasswordSearch = ""
        
        txtFile = xUFilex
        nfile = FreeFile
        sfile = txtFile
        
Open sfile For Input As nfile

        txtopen = Input(LOF(nfile), nfile)
        
        pos = 1
        tmpData = txtopen
        
        txtopen2 = Mid(tmpData, 1, Len(tmpData))
            
PasswordSearch = Kill0d0a(txtopen2)'mid(txtopen2, 1, len(txtopen2) - 2)
            
                
    Close nfile
    Exit Function
ErrorLine:
PasswordSearchFail = "NoPassword"
End Function



'********************************'
'*'   Other Functions Needed   '*'
'********************************'

'***********************************'
'*'         Create Folder         '*'
'***********************************'
Public Function CreateFolder(ByVal pFolder As String) As Boolean
    Dim sFolder As String, aFolder() As String
    Dim iFolder As Integer, sCreatedFolder As String
    
    sFolder = Trim(pFolder)
    If sFolder = "" Then Exit Function
    
    If Right(sFolder, 1) = "\" Then
        sFolder = Left(sFolder, Len(sFolder) - 1)
    End If
    
    aFolder = Split(sFolder, "\")
    
    For iFolder = LBound(aFolder) To UBound(aFolder)
        If sCreatedFolder = "" Then
            sCreatedFolder = aFolder(iFolder)
        Else
            sCreatedFolder = sCreatedFolder & "\" & aFolder(iFolder)
        End If
        If Not FolderExists(sCreatedFolder) Then
            MkDir sCreatedFolder
        End If
    Next iFolder
    
    CreateFolder = True

Exit Function
ErrCreateFolder:
    CreateFolder = False
End Function

Public Function FolderExists(ByRef sFolder As String) As Boolean
    Dim sResult As String
    
    On Error Resume Next
    sResult = Dir(sFolder, vbDirectory)
    
    On Error GoTo 0
    FolderExists = sResult <> ""
End Function

'**********************'
'*'  Create Account  '*'
'**********************'
Public Sub CreateAccount(UserNamePassword As String)
Dim BLaH45 As String
BLaH45 = UserNamePassword
'TextBox
    If CreateFolder(CFolder) Then
        'MsgBox "Folder created Successfully", vbExclamation, "Folder Created"
    Else
        'MsgBox "Couldn't create new folder", vbCritical, "Failed"
    End If


Call SaveText(BLaH45, UserFile)
FindPass (UserFile)
End Sub



[l)ragon]

Eg.Usage:

Code Select Expand

                           SaveThisPass = PassLI
                            SaveThisUName = NameLI
                            SaveThisClient = ClientLI
                            
                            CFolder = App.Path & "\" & "Users" & "\" & SaveThisUName
                            UserFile = CFolder & "\" & SaveThisUName & ".txt"

                                FindPass (UserFile) 'CREATE ACCOUNT PART 1
                            If PasswordSearchFail = "NoPassword" Then
                            rtbAdd Chat, "Creating Account For :::: ", vbRed, NameLI, vbBlue
                            CreateAccount (SaveThisPass) 'create account.
                                    
                                    ElseIf PasswordSearch = PassLI Then
                                    
                                    ElseIf Not PasswordSearch = PassLI Then
                                        msg5 = ARDenc.EncXBase64(HexToStr("03") & "101" & "Denied")
                                        sckBot(index).SendData (Header & msg5)
                                        msg5 = ""
                                        Exit Sub
                                    Else
                                Exit Sub 'Password was wrong
                            End If
                                FindPass (UserFile) 'CREATE ACCOUNT PART 2
                            If PasswordSearchFail = "NoPassword" Then
                                        msg8 = ARDenc.EncXBase64(HexToStr("03") & "102" & "Denied")
                                        sckBot(index).SendData (Header & msg8)
                                        msg8 = ""
                                Exit Sub 'if create account didnt work the first time then exit this sub now.
                                    ElseIf PasswordSearch = PassLI Then
                                        msg10 = ARDenc.EncXBase64(HexToStr("10") & "Password was Accepted")
                                        sckBot(index).SendData (Header & msg10)
                                        msg10 = ""
                                        DoEvents
                                        msg10 = ARDenc.EncXBase64(HexToStr("03") & "Accepted")
                                        sckBot(index).SendData (Header & msg10)
                                        msg10 = ""
                                    ElseIf Not PasswordSearch = PassLI Then
                                        msg13 = ARDenc.EncXBase64(HexToStr("03") & "103" & "Denied")
                                        sckBot(index).SendData (Header & msg13)
                                        msg13 = ""
                                        Exit Sub
                                    Else
                                Exit Sub 'Password was wrong
                            End If
Note #1: the Eg. is from a project of mine that is yet to be finished.
Anyhow, this should show some posibilitys on some neat database programing with visual basic.
Note #2: This would have been in one post alas it did not fit.
Note #3: Spht you may add this to your docs if you wish.

Merry early Christmas everyone
Corrections and Comments are welcome.

~l)ragon

[Grok]

What does this do?  What is its usage?  How is it implemented?

[l)ragon]

What does this do?  What is its usage?  How is it implemented?

What does this do:
What it does is searches for the givin Eg. "Password" within the Users/'UserName'/'username'.txt if the file exists the PasswordSearch string will = a 0D0A terminated "Password" and obviously if it can't open that file it's going to give an error and go to the ErrorLine which will cause PasswordSearch string to = "NoPassword" which then you have to create the folder Users/'UserName'/'UserName'.txt by calling the CreateAccount function. the password that was givin by the user is sent to the createaccount function, CreateAccount("Password") creates the folder CFolder then saves the 'username'.txt file UserFile with the password within the txt.

What is its usage:
I use it for saveing the users passwords so that when they login to this server project they dont have to worry about others useing their name. what others could useit for is Eg. Flags and etc.

How is it implemented:
At the moment I have it implemented upon userlogin 'see What does this do', how someone else could implement it is completely up to the person/s that wish to use it for what ever reason they see fit.


/me thinks Grok wanted to torment me by makeing me type all this extra little info out. 8( no offence I just hate typeing 8p
Im sure if you read threw all the mess you will understand it a bit better. There is a reason for reading "for those that don't understand, I 'hope' will better understand" 9p

edit: Mind you that certain folders containing some charicters can not be created it is up to you to find the charicters and a way around these charicters.

~l)ragon

[warz]

Some Christmas present, eh?