home *** CD-ROM | disk | FTP | other *** search
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer Declare Function GetIniSections Lib "Kernel" Alias "GetPrivateProfileString" (ByVal lpAppName As String, ByVal lpKeyName As Long, ByVal lpDefault As String, ByVal lpBuffer As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer Declare Function KillSection Lib "Kernel" Alias "WritePrivateProfileString" (ByVal lpSectionName As String, ByVal lpKeyName As Long, ByVal lpString As Long, ByVal lpFileName As String) As Integer Declare Function KillIniKey Lib "Kernel" Alias "WritePrivateProfileString" (ByVal lpSectionName As String, ByVal lpKeyName As String, ByVal lpString As Long, ByVal lpFileName As String) As Integer Declare Sub MessageBeep Lib "User" (ByVal wType As Integer) Dim GDTemp As String Function FioReadLurkerPath () As String Dim PassedString As String PassedString = Space$(255) R% = GetProfileString(GioAPPNAME, GioLURKERPATH, GioDEFAULT, PassedString, Len(PassedString)) PassedString = RTrim$(PassedString) Length% = Len(PassedString) PassedString = Left$(PassedString, (Length% - 1)) ' For consistency, make sure GSioLurkerPath ends with \ If PassedString <> GioDEFAULT And Right$(GSioLurkerPath, 1) <> "\" Then GSioLurkerPath = GSioLurkerPath + "\" End If FioReadLurkerPath = PassedString End Function Sub ConfigureLurker () Msg$ = "As a new user, you first need to configure Lurker. " Msg$ = Msg$ + "The following dialog boxes will guide you through the configuration process." SioMsgBox Msg$, 64, "Lurker" Directories.Show MODAL NewUser$ = "" RetVal% = FioUserAdd(NewUser$, TRUE) Users.Show MODAL Msg$ = "We'll add other configuration routines, such as Host and Modem, later" SioMsgBox Msg$, 64, "Lurker" ' Forums.Show MODAL Lurker.laUser.Caption = GSioActiveUser GetForums Lurker.lbForums End Sub Function FioUserAdd (NewName$, MakeDefault As Integer) As Integer ' Add user to user list. Returns True if successful, false if not ' MakeDefault = TRUE if new user is to be default user AUBegin: NewName$ = InputBox$("Enter new user name.", "Add User") If NewName$ = "" Then FioUserAdd = FALSE Exit Function End If Size% = 255 Buffer$ = Space$(Size%) a% = GetPrivateProfileString("Users", NewName$, "", Buffer$, Size%, GSioLurkerIni) If a% > 0 Then Msg$ = "There is already a user by this name. Do you wish to replace that user?" If FioMsgBox(Msg$, 36, "Lurker") = 7 Then GoTo AUBegin End If DupeFlag = TRUE counter = 1 ' Find a unique name for new user.ini file While DupeFlag NewUserIni$ = GSioLurkerPath + "User" + RTrim$(LTrim$(Str$(counter))) + ".ini" Temp$ = Dir$(NewUserIni$) If Len(Temp$) = 0 Then DupeFlag = FALSE End If counter = counter + 1 Wend RetVal% = WritePrivateProfileString("Users", NewName$, NewUserIni$, GSioLurkerIni) RetVal% = WritePrivateProfileString("Defaults", "Name", NewName$, NewUserIni$) ' If this is going to be the default user, then update "Defaults" section in Lurker.ini ' and update Global variables that maintain active UserName and UserIni If MakeDefault Then RetVal% = WritePrivateProfileString("Defaults", "User", NewName$, GSioLurkerIni) GSioActiveUser = NewName$ GSioUserIni = NewUserIni$ End If FioUserAdd = TRUE End Function Function FioWriteLurkerPath (PassedString As String) As String ' This function writes the LurkerPath at startup, and if ' the user changes it around. R% = WriteProfileString(GioAPPNAME, GioLURKERPATH, PassedString) End Function Function FioGetDirectory$ (TheCaption$, TheMessage$) ' Displays dialog box which lets user select existing or add ' new directory. Returns name of new directory. ' Requires form level variable GDTemp$ and companion ' routine, FioFillGDTemp. Also requires GetDir form ' TheCaption$ = Caption of Get Directory dialog box ' TheMessage$ = Message displayed in Get Directory dialog box If TheCaption$ <> "" Then GetDir.Caption = TheCaption$ Else GetDir.Caption = "Select Directory" End If GetDir.Label1.Caption = TheMessage$ GetDir.Show MODAL FioGetDirectory$ = GDTemp$ End Function Sub FioFillGDTemp (PassedString$) ' Used by GetDirectory to Pass string from Get Directory forms ' to Configuration module GDTemp$ = PassedString$ End Sub Function FioUserGetData (TheUser As User) As Integer ' Gets User data and places in passed parameter - TheUser ' Returns Bool ' Parameters: TheUser = Variable to be filled with User data. ' TheUser.Name should already contain name of user from "Users" section of Lurker.ini Size% = 255 Buffer$ = Space$(Size%) a% = GetPrivateProfileString("Users", TheUser.Name, "", Buffer$, Size%, GSioLurkerIni) If a% = 0 Then FioUserGetData = FALSE Exit Function End If TheUser.Ini = Left$(Buffer$, a%) a% = GetPrivateProfileString("Defaults", "ID", "", Buffer$, Size%, TheUser.Ini) TheUser.ID = Left$(Buffer$, a%) a% = GetPrivateProfileString("Defaults", "Password", "", Buffer$, Size%, TheUser.Ini) TheUser.Password = Left$(Buffer$, a%) If a% <> 0 Then TheUser.Password = FioDecrypt(TheUser.Password) End If End Function Function FioUserGetActive () As String Size% = 255 Buffer$ = Space$(Size%) a% = GetPrivateProfileString("Defaults", "User", GioDEFAULT, Buffer$, Size%, GSioLurkerIni) FioUserGetActive = Left$(Buffer$, a%) End Function Function FioUserGetIni (UserName As String) As String ' Returns path and name of UserX.Ini file for designated User ' Parameter: UserName = Name of User from "Users" section of Lurker.ini Size% = 255 Buffer$ = Space$(Size%) a% = GetPrivateProfileString("Users", UserName, GioDEFAULT, Buffer$, Size%, GSioLurkerIni) FioUserGetIni = Left$(Buffer$, a%) End Function Sub SioUserFillLB (UserLB As Control) ' Fills passed list box with list of users from [Users] section of Lurker.ini While UserLB.ListCount UserLB.RemoveItem 0 Wend Size% = 1500 Buffer$ = Space$(Size%) RetVal% = GetIniSections("Users", 0&, "", Buffer$, Size%, GSioLurkerIni) UserList$ = Left$(Buffer$, RetVal%) Null$ = Chr$(0) LastNdx = 0 NextNdx = 1 While NextNdx > 0 NextNdx = InStr(LastNdx + 1, UserList$, Null$) If NextNdx > 0 Then Cut = NextNdx - LastNdx - 1 TempUser$ = Mid$(UserList$, LastNdx + 1, Cut) UserLB.AddItem TempUser$ End If LastNdx = NextNdx Wend End Sub Function FioUserUpdate (UserRec As User) ' This procedure is used to update user record data when ' user name and user ini name have not changed UserIni$ = UserRec.Ini ID$ = UserRec.ID Password$ = UserRec.Password Password$ = FioEncrypt(Password$) RetVal% = WritePrivateProfileString("Defaults", "ID", ID$, UserIni$) RetVal% = WritePrivateProfileString("Defaults", "Password", Password$, UserIni$) End Function Function FioEncrypt (PassedString As String) As String ' FioEncrypt uses a very simple two-key substitution cipher to render ' the user's password as gibberish. It then stores the user's password ' BACKWARDS in a string. That string (Rebuild$) is returned by the function. ' For a good read, get a copy of *Archimedes' Revenge* (New York: ' W.W. Norton, 1988) from your library. The book has a really fascinating ' section on encryption. If you read it, you'll realize that this is ' really simple stuff. ' And that's the real danger--this is simple. A determined thief with a ' little ingenuity (or a DL'd copy of this module) can crack any password ' he comes across. The documentation (HEY DOCS DUDES!!) has to make it ' evident that this isn't sufficient security for any kind of network-- ' the best kind of security for a corporate user is no security at all: ' enter your password when you log on to CIS. (We trap for no entered password.) ' First off, we want to simplify our string manipulation by changing the ' whole string to upper case. We'll also measure the length of the string, ' which we'll use with For...Next loops. PassedString = UCase$(PassedString) Length = Len(PassedString) ' We need to test to be sure nobody's snuck a null string in on us.... If Length = 0 Then FioEncrypt = GioNOPASSWORD GoTo FioEncryptEnd End If Dim OutString As String, Char1 As String ' Now we'll read the string. We'll change the odd- ' numbered elements to a letter five ANSI characters higher (so A becomes ' F, and Z becomes "_"); we'll change even-numbered elements to a letter ' two characters higher. For counter = 1 To Length Char1 = Mid$(PassedString, counter, 1) Temp = Asc(Char1) ' Get the ANSI number If counter Mod 2 = 1 Then ' True answers are odd-numbered Temp = Temp + 5 ' Add 5 Else ' False answers are even-numbered Temp = Temp + 2 ' Add 2 End If Char1 = Chr$(Temp) ' Return value to encrypt Char1 OutString = Char1 + OutString ' Create OutString in *reverse* order Next FioEncrypt = OutString FioEncryptEnd: End Function Function FioDecrypt (PassedString As String) As String ' FioDecrypt is the logical "twin" of FioEncrypt. Take a peek at that to ' get a better grasp of how and why we're using encryption. ' FioDecrypt is passed a string, presumably from the Lurker.ini file, ' to decrypt. The encryption algorithm is just reversed. Dim ReversedString As String, Char1 As String, Char2 As String, OutputString As String Dim Temp As Integer ' We'll test quickly to see if we've been passed a "non-password" flag If InStr(PassedString, GioNOPASSWORD) Then ' If the INI file has no real password FioDecrypt = GioNOPASSWORD ' then we say so... GoTo FioDecryptEnd ' and quit End If Length = Len(PassedString) ' For counters For counter = 1 To Length Char1 = Mid$(PassedString, counter, 1) ' Reverse the elements: select a character ReversedString = Char1 + ReversedString ' Write it to the end of the string Next For counter = 1 To Length Char2 = Mid$(ReversedString, counter, 1) ' Select a character Temp = Asc(Char2) ' Get the ANSI value If counter Mod 2 = 1 Then ' If an odd numbered element in string Temp = Temp - 5 ' The value is changed Char2 = Chr$(Temp) ' The string is passed out to OutputString = OutputString + Char2 ' the OutputString Else ' If an even-numbered element Temp = Temp - 2 ' the value goes down by 2 Char2 = Chr$(Temp) ' and the string goes OutputString = OutputString + Char2 ' back to OutputString End If Next FioDecrypt = OutputString ' return the function value FioDecryptEnd: End Function Function FioUserMakeActive (TheUser As String) GSioActiveUser = TheUser a% = WritePrivateProfileString("Defaults", "User", GSioActiveUser, GSioLurkerIni) GSioUserIni = FioUserGetIni(GSioActiveUser) ' GIioForums = FioGetForumNames() End Function Function FioMakeSectnsNdx () As Integer ' This function reads the Sectns.lst file, searching for the Forum names. When it finds one, the function ' gets all the detail we need, writes the data to the section index, and continues on. ' The function returns the number of forums processed. If no forums are processed, the ' function returns 0. So the user can test the function as a boolean. ' This function assumes that Sectns.lst is in the program directory designated ' by GSioLurkerPath ' First off, we need to get a name for the matching index file. Dim SectnsNdx As String, SectnsLst As String SectnsNdx = GSioLurkerPath + "Sectns.ndx" SectnsLst = GSioLurkerPath + "Sectns.lst" Dim DummyRec As AllForumsNdx ' Get the record length RecLength% = Len(DummyRec) ' At this point we know the name/path of the Sections list file and the index file ' and we know the length of a ForumIndex record. Now we'll ' open both files (opening the NDX file will create it) On Error Resume Next Kill SectnsNdx ' We're starting fresh LstNum% = FileOpener(SectnsLst, READFILE, 0) ' Get file number NdxNum% = FileOpener(SectnsNdx, RANDOMFILE, RecLength%) FileSize = LOF(LstNum%) Dim a As OFSTRUCT x = OpenFile(SectnsLst, a, &H4000) FileDate = a.r1 FileTime = a.r2 DummyRec.Name = "Size" DummyRec.BytePos = FileSize Put #NdxNum%, 1, DummyRec DummyRec.Name = "Date" DummyRec.BytePos = FileDate Put #NdxNum%, , DummyRec DummyRec.Name = "Time" DummyRec.BytePos = FileTime Put #NdxNum%, , DummyRec 'Scan prologue information in Sectns.lst ProcessForumsFlag = FALSE While Not EOF(LstNum%) And Not ProcessForumsFlag Line Input #LstNum%, TextLine$ If Mid$(TextLine$, 1, 10) = "----------" Then ProcessForumsFlag = TRUE Wend ' What we need to do next is: ' * Identify the beginning of a forum ' * Extract the name of the forum ' * Write the information to the index file ' * Move on to the next forum ' The trick is that we have to find the byte where the forum begins. BUT, we ' have to use a Line Input # statement to find the line where the message begins. ' (*Mucho* faster than evaluating every character in the file.) But after a Line ' Input # statement, the Seek pointer is looking at the *next* line, not the one where ' the forum data starts. So we have to first find the byte position of the first char in the ' line, then evaluate the line.... Do While Not EOF(LstNum%) ' Chunk through each line of the file CurrentPos& = Seek(LstNum%) ' Define a marker Line Input #LstNum%, TextLine$ ' Read the line. If Left$(TextLine$, 3) <> " " And TextLine$ <> "" Then ' If a forum, go to work. If not, loop. ' If the line starts with spaces it's not the beginning of a forum. We loop back to the Do ' four lines above us. Comments further down assume we have a valid forum. ForumStart& = CurrentPos& ' We know where the forum record begins. ForumName$ = LTrim$(RTrim$(Left$(TextLine$, 31))) 'Get the forum Name ForumCount% = ForumCount% + 1 ' Increment the forum counter ' Now we write the data to the record, and write the record to the file. We could have assigned the data ' directly to the record in each of the "Now we know..." lines above, but I think it's better form to have ' all the data collection and writing happen in one place in the code. DummyRec.Name = ForumName$ DummyRec.BytePos = ForumStart& Put #NdxNum%, , DummyRec End If Loop FioMakeSectnsNdx = ForumCount% ' Return number of forums proc'd to the calling form. Close LstNum% ' We just close our files. We don't use a blanket... Close NdxNum% ' ...close because other forms may have files open too. End Function Function FioIsSectnNdxGood (Lst$, Ndx$) 'Compare size and file dates to determine if SectnsLst has changed 'since index was created 'Returns false is they aren't the same or if sectns.lst or sectns.ndx don't exist 'If either file doesn't exist, return FALSE SLst$ = Dir$(Lst$) SNdx$ = Dir$(Ndx$) If Len(SLst$) = 0 Or Len(SNdx$) = 0 Then FioIsSectnNdxGood = FALSE Exit Function End If 'Get file size of sectns list FileNum% = FileOpener(Lst$, RANDOMFILE, 1) FileSize = LOF(FileNum%) Close FileNum% 'Get date and time sectns.lst file last modified Dim a As OFSTRUCT x = OpenFile(Lst$, a, &H4000) FileDate = a.r1 FileTime = a.r2 'Sectns.ndx stores date, time and size of sectns.lst file 'in its first record. Get it to see if it matches 'with numbers obtained above Dim DummyRec As AllForumsNdx RecordLength% = Len(DummyRec) FileNum% = FileOpener(Ndx$, RANDOMFILE, RecordLength%) Get FileNum%, 1, DummyRec NdxSize = DummyRec.BytePos Get FileNum%, 2, DummyRec NdxDate = DummyRec.BytePos Get FileNum%, 3, DummyRec NdxTime = DummyRec.BytePos Close FileNum% If FileDate <> NdxDate Then FioIsSectnNdxGood = FALSE ElseIf FileTime <> NdxTime Then FioIsSectnNdxGood = FALSE ElseIf FileSize <> NdxSize Then FioIsSectnNdxGood = FALSE Else FioIsSectnNdxGood = TRUE End If End Function Function FioWriteForumData (ForumRec As forum) ' Writes forum data for new forum to UserX.ini If ForumRec.Name = "" Then FioWriteForumData = FALSE Exit Function End If GoWord$ = ForumRec.GoWord Success% = WritePrivateProfileString("Forums", ForumRec.Name, GoWord$, GSioUserIni) If GoWord$ = "" Then FioWriteForumData = FALSE Exit Function End If Success% = WritePrivateProfileString(GoWord$, "Messages", ForumRec.MessageFile, GSioUserIni) Success% = WritePrivateProfileString(GoWord$, "AppendMessages", Str$(ForumRec.AppendMsg), GSioUserIni) Success% = WritePrivateProfileString(GoWord$, "Gateway", ForumRec.Gateway, GSioUserIni) ' The next two sections were originally stored in forum data record but will now probably be kept ' in PassOptions record ' Success% = WritePrivateProfileString(GoWord$, "ActiveSections", ForumRec.ActiveSections, GSioUserIni) ' Success% = WritePrivateProfileString(GoWord$, "HMN", ForumRec.HMN, GSioUserIni) If ForumRec.MsgDirectory = "" Then Success% = KillIniKey(GoWord$, "MsgDirectory", 0&, GSioUserIni) Else Success% = WritePrivateProfileString(GoWord$, "MsgDirectory", ForumRec.MsgDirectory, GSioUserIni) End If If ForumRec.DLDirectory = "" Then Success% = KillIniKey(GoWord$, "DLDirectory", 0&, GSioUserIni) Else Success% = WritePrivateProfileString(GoWord$, "DLDirectory", ForumRec.DLDirectory, GSioUserIni) End If ' Test for DefaultID UserName$ = ForumRec.UserName If UserName$ = GSioActiveUser Then Success% = KillIniKey(GoWord$, "UserName", 0&, GSioUserIni) Else Success% = WritePrivateProfileString(GoWord$, "UserName", ForumRec.UserName, GSioUserIni) End If FioWriteForumData = TRUE End Function Function FioKillForum (ForumName$, GoWord$) As Integer ' Deletes forum data and section data from Lurker.ini Success% = KillIniKey("Forums", ForumName$, 0&, GSioUserIni) Success% = KillSection(GoWord$, 0&, 0&, GSioUserIni) Success% = KillSection(GoWord$ + " Sections", 0&, 0&, GSioUserIni) Success% = KillSection(GoWord$ + " Libraries", 0&, 0&, GSioUserIni) ' GIioForums = FioGetForumNames() End Function Function FioUpdateForumData (OldRecord As forum, NewRecord As forum) As Integer ' Update Forum record information. Name of forum to update is obtained ' from OldRecord argument. New data is contained in NewRecord. If OldRecord.Name <> "" And OldRecord.Name <> NewRecord.Name Then ForumName$ = OldRecord.Name Success% = KillIniKey("Forums", ForumName$, 0&, GSioUserIni) End If If OldRecord.GoWord <> "" And OldRecord.GoWord <> NewRecord.GoWord Then SectionToKill$ = OldRecord.GoWord Success% = KillSection(SectionToKill$, 0&, 0&, GSioUserIni) End If Success% = FioWriteForumData(NewRecord) 'SHOULDN'T NEXT LINE BE MOVED TO END OF LAST IF...END IF ' MAKE CHANGE GO WORD PROCEDURE ' Success% = FioUpdateSectionAppName(OldRecord, NewRecord) End Function Sub GetForums (LB As Control) ' Fills LB with Forum Names ClearList LB Size% = 1500 PassedString$ = Space$(Size%) a% = GetIniSections("Forums", 0&, "", PassedString$, Size%, GSioUserIni) If a% = 0 Then Exit Sub Null$ = Chr$(0) ForumNames$ = Left$(PassedString$, a%) LastNdx = 0 NextNdx = 1 counter = 0 While NextNdx > 0 NextNdx = InStr(LastNdx + 1, ForumNames$, Null$) If NextNdx > 0 Then Cut = NextNdx - LastNdx - 1 LB.AddItem Mid$(ForumNames$, LastNdx + 1, Cut) LastNdx = NextNdx End If Wend End Sub Function FioGetForumData (ForumRec As forum) As Integer ' Fills ForumRec with Forum data. Name of forum is ' passed in ForumRec.Name. Typically, calling procedure ' will declare a variable of type Forum, define the .Name field ' and pass the variable in this function. ' Returns true if successful, false if unsuccessful 'First get Forum name from passed variable ForumName$ = ForumRec.Name If ForumName$ = "" Then GetForumData = FALSE Exit Function End If 'Then get Go word from Userx.ini Size% = 255 Buffer$ = Space$(Size%) a% = GetPrivateProfileString("Forums", ForumName$, GioDEFAULT, Buffer$, Size%, GSioUserIni) GoWord$ = Left$(Buffer$, a%) If GoWord$ = GioDEFAULT Then GetForumData = FALSE Exit Function End If ForumRec.GoWord = GoWord$ 'Now use Go word to get other fields ' a% = GetPrivateProfileString(GoWord$, "HMN", "", Buffer$, Size%, GSioUserIni) ' ForumRec.HMN = Left$(Buffer$, a%) a% = GetPrivateProfileString(GoWord$, "Messages", "", Buffer$, Size%, GSioUserIni) ForumRec.MessageFile = Left$(Buffer$, a%) a% = GetPrivateProfileString(GoWord$, "Gateway", "", Buffer$, Size%, GSioUserIni) ForumRec.Gateway = Left$(Buffer$, a%) ' a% = GetPrivateProfileString(GoWord$, "ActiveSections", "", Buffer$, Size%, GSioUserIni) ' ForumRec.ActiveSections = Left$(Buffer$, a%) a% = GetPrivateProfileString(GoWord$, "MsgDirectory", "", Buffer$, Size%, GSioUserIni) ForumRec.MsgDirectory = Left$(Buffer$, a%) a% = GetPrivateProfileString(GoWord$, "DLDirectory", "", Buffer$, Size%, GSioUserIni) ForumRec.DLDirectory = Left$(Buffer$, a%) a% = GetPrivateProfileInt(GoWord$, "AppendMessages", 1, GSioUserIni) ForumRec.AppendMsg = a% a% = GetPrivateProfileString(GoWord$, "UserName", "", Buffer$, Size%, GSioUserIni) ForumRec.UserName = Left$(Buffer$, a%) If ForumRec.UserName = "" Then ForumRec.UserName = GSioActiveUser FioGetForumData = TRUE End Function 
