Author | Message | Time |
---|---|---|
dRAgoN | [code] '**************************' '*' 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 [/code] | December 20, 2002, 2:32 AM |
dRAgoN | Eg.Usage: [code] 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 [/code] 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 | December 20, 2002, 2:33 AM |
Grok | What does this do? What is its usage? How is it implemented? | December 20, 2002, 7:17 AM |
dRAgoN | [quote]What does this do? What is its usage? How is it implemented?[/quote] 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 | December 20, 2002, 3:53 PM |
warz | Some Christmas present, eh? ::) | December 21, 2002, 3:16 AM |