'**************************'
'*' 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
Eg.Usage:
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
What does this do? What is its usage? How is it implemented?
QuoteWhat 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
Some Christmas present, eh? ::)