Valhalla Legends Forums Archive | General Programming | [VB] Merry Christmas from: l)ragon

AuthorMessageTime
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

Search