const Copyright = "EvalFile v2.0 (C) 1995 David Wallace Croft" '$include "C:\App\Comm\WC\Code\WC_Subs.WCC" REM ------------------------------------------------------------------ REM -- Does not notice download after activity log scanned until REM -- user logs out. REM -- Only scans node 1 activity log. REM ------------------------------------------------------------------ const Mail_Conference = 0 const Bias_Count = 30 const Initial_Cost = 1 const Days_Per_Cent = 30 const Max_Increase = 1 const Max_Decrease = 1 const FileUser_Dir = "Door\EvalFile\FileUser\" const UserData_Dir = "Door\EvalFile\UserData\" const EvalList_WCX = "Code\List\List.WCX" REM const UserInfo_Dir = "Door\EvalFile\UserInfo\" const AllFiles_Txt = "ALLFILES.TXT" const EvalFile_Tmp = "EVALFILE.TMP" const EvalFile_Tm1 = "EVALFILE.TM1" const Scanning_Flag = "EvalFile: activity log scanned" type Eval_Rec_Type UserID as long Cost as integer Eval as string*1 end type sub Costs_Update REM ------------------------------------------------------------------ dim FileRec as FileRecord dim Days as long dim New_Cost as integer REM ------------------------------------------------------------------ ? "Updating file costs..." if GetFileInfo ( FileRec, "" ) then do ? Pad ( FileRec.Name, 12 ); " "; FileRec.Cost; " "; if not File_Is_Free ( FileRec ) then Days = Days_Since ( FileRec.FileTime ) if Days > 0 then New_Cost = Days_Per_Cent * FileRec.Downloads / Days if New_Cost > FileRec.Cost + Max_Increase then FileRec.Cost = FileRec.Cost + Max_Increase elseif New_Cost < FileRec.Cost - Max_Decrease then FileRec.Cost = FileRec.Cost - Max_Decrease else FileRec.Cost = New_Cost end if if UpdateFile ( FileRec ) then ? FileRec.Cost else ? "unchanged due to error in UpdateFile" end if else ? "unchanged since less than a day has passed" end if else ? "unchanged since marked as free file" end if if not GetNextFile ( FileRec ) then exit do end if loop end if end sub sub Eval_Info ( Rating as real, Count as integer, Paid as long, \ byval File_Name as string ) REM ------------------------------------------------------------------ REM -- If cannot file Eval record, returns 1.0, 0, 0. REM ------------------------------------------------------------------ dim Index as long dim Count_Yes as integer dim Count_No as integer dim Eval_Rec as Eval_Rec_Type dim File_Num as integer REM Paid = 0 File_Num = FreeFile if File_Num = 0 then ? "Error: no more file available to open. Halting!" ? "Delaying 10 seconds..." delay 10 end end if if not Exists ( FileUser_Dir + File_Name ) then Rating = 1.0 Count = 0 Paid = 0 exit sub end if Count_Yes = 0 Count_No = 0 open FileUser_Dir + File_Name for random as #File_Num len = Len ( Eval_Rec_Type ) for Index = 1 to LOF ( File_Num ) get #File_Num, Index, Eval_Rec if Eval_Rec.Eval = "Y" then Count_Yes = Count_Yes + 1 elseif Eval_Rec.Eval = "N" then Count_No = Count_No + 1 end if Paid = Paid + Eval_Rec.Cost next Index close ( File_Num ) Count = Count_Yes + Count_No if Count >= Bias_Count then Rating = Count_Yes / Count else Rating = 1.0 - ( Count_No / Bias_Count ) end if end sub sub Message_Send_Uploader ( \ User_Name as string, Cost as integer, File_Name as string ) REM ------------------------------------------------------------------ dim MsgHeader as MessageHeader REM ------------------------------------------------------------------ MsgHeader.From = MakeWild.SysOpName MsgHeader.FromTitle = "EVALFILE" MsgHeader.To = User_Name MsgHeader.Subject = "EvalFile Uploader Reward" FlagSet ( MsgHeader.Flags, 1 ) if not AddMessage ( MsgHeader, \ "You received " + Dollars_Str ( Cost ) + \ " for the upload of " + File_Name + ".", \ "", Mail_Conference ) then Beep ? "Error in placing message in conference "; Mail_Conference; ? " for "; User_Name end if end sub sub Message_Send_Downloader ( \ User_Name as string, File_List_File as string ) REM ------------------------------------------------------------------ dim MsgHeader as MessageHeader REM ------------------------------------------------------------------ MsgHeader.From = MakeWild.SysOpName MsgHeader.FromTitle = "EVALFILE" MsgHeader.To = User_Name MsgHeader.Subject = "Please evaluate these files using File Menu option K" FlagSet ( MsgHeader.Flags, 1 ) if AddMessage ( MsgHeader, File_List_File, "", Mail_Conference ) then ? "Message placed in conference "; Mail_Conference; " for "; ? User_Name else Beep ? "Error in placing message in conference "; Mail_Conference; ? " for "; User_Name end if end sub function Update_Files_Downloaded ( \ UserName as string, \ File_List_File as string ) \ as boolean REM ------------------------------------------------------------------ REM File_List_File has list of files that the user downloaded. REM ------------------------------------------------------------------ dim File_Name as string dim Previously_Downloaded as boolean dim Line as string dim FileRec as FileRecord dim Eval_Rec as Eval_Rec_Type dim Index as long dim Eval_Rec_Tmp as Eval_Rec_Type dim DownloaderRec as UserRecord REM ------------------------------------------------------------------ if not GetUser ( DownloaderRec, UserName ) then Update_Files_Downloaded = false exit function end if open File_List_File for input as #1 while not EOF ( 1 ) input #1, File_Name ? File_Name Eval_Rec.UserID = DownloaderRec.UserID Eval_Rec.Eval = " " if GetFileInfo ( FileRec, File_Name ) then Eval_Rec.Cost = FileRec.Cost else Eval_Rec.Cost = 0 end if open FileUser_Dir + File_Name for random as #2 len = Len ( Eval_Rec_Type ) Previously_Downloaded = false for Index = 1 to LOF ( 2 ) get #2, Index, Eval_Rec_Tmp if Eval_Rec_Tmp.UserID = Eval_Rec.UserID then put #2, Index, Eval_Rec Previously_Downloaded = true exit for end if next Index if not Previously_Downloaded then put #2, , Eval_Rec end if close ( 2 ) wend close #1 Message_Send_Downloader ( UserName, File_List_File ) Update_Files_Downloaded = true end function sub Scan_Activity_Log REM ------------------------------------------------------------------ dim Line as string dim User_Name as string dim Files_Downloaded as boolean dim File_Name as string dim Just_Grab_UserName as boolean REM Run "Code\Log_Scan\Log_Scan" Just_Grab_UserName = false if ReadBackOpen ( "Activity.1" ) then Files_Downloaded = false do if ReadBackTOF then exit do end if Line = ReadBackNext if Line = " * " + Scanning_Flag then if not Files_Downloaded then ? "Scanning of activity log completed." exit do else Just_Grab_UserName = true end if elseif ( Len ( Line ) >= 5 ) and ( Mid ( Line, 3, 1 ) = ":" ) then ? Mid ( Line, 1, 5 ) if ( InStr ( Line, " on locally, " ) <> 0 ) or ( InStr ( Line, " bps on " ) <> 0 ) then User_Name = Mid ( Line, 7 ) User_Name = Left ( User_Name, InStr ( User_Name, " [" ) - 1 ) ? "User: "; User_Name if Files_Downloaded then if Update_Files_Downloaded ( User_Name, EvalFile_Tmp ) then ? "Recorded downloads by "; User_Name else ? "Unable to update file downloaded for "; User_Name; "!" end if end if Files_Downloaded = false if Just_Grab_UserName then ? "Scanning of activity log completed." exit do end if end if elseif InStr ( Line, " downloaded " ) <> 0 then if not Just_Grab_UserName then File_Name = Mid ( Line, 15 ) File_Name = Left ( File_Name, InStr ( File_Name, "]" ) - 1 ) ? "Downloaded: "; File_Name if Files_Downloaded then open EvalFile_Tmp for append as #1 else open EvalFile_Tmp for output as #1 Files_Downloaded = true end if ? #1, File_Name close #1 end if elseif InStr ( Line, "* Sent file " ) <> 0 then if not Just_Grab_UserName then File_Name = Mid ( Line, 19 ) File_Name = Left ( File_Name, InStr ( File_Name, " at CPS " ) - 1 ) while InStr ( File_Name, "\" ) > 0 File_Name = Mid ( File_Name, InStr ( File_Name, "\" ) + 1 ) wend if Files_Downloaded then open EvalFile_Tmp for append as #1 else open EvalFile_Tmp for output as #1 Files_Downloaded = true end if ? #1, File_Name close #1 ? "Sent: "; File_Name end if end if loop ReadBackClose ActivityLog Scanning_Flag else ? "Error opening activity log!" ? "Delaying 5 seconds..." delay 5 end if end sub sub Sort_All_Files REM ------------------------------------------------------------------ dim Counter as long const Total_Files = 1000 dim FileRec as FileRecord dim Rating as real dim Count as integer type Rating_Rec_Type Name as string*12 Rating as string*7 Count as string*5 end type dim Rating_Rec as Rating_Rec_Type dim File_Name as string dim File_Area as long dim FileArea_Tmp as string dim FileArea_Txt as string dim Got_Next_File as boolean dim SrchRec as SearchRec dim FileAreaRec as FileAreaRecord dim AllFiles_Path as string dim AllFiles_Size as long dim Index as long dim Dummy as long dim FileRecNext as FileRecord dim AllFiles_DateTime as DateTime REM if GetFirstFile ( FileRecNext, 1 ) then open AllFiles_Txt for output as #3 ? #3, "" ? #3, "" ? #3, " "; AllFiles_Txt; " "; CurrentDateTime AllFiles_DateTime ? #3, FormatDate ( AllFiles_DateTime.D, "yyyy-mm-dd" ); " "; ? #3, FormatTime ( AllFiles_DateTime.T, "hh:mm" ); " "; ? #3, MakeWild.BBSName; " "; MakeWild.Phone ? #3, " Created by "; Copyright ? #3, "" ? #3, " Rating = user evaluation, 1.0 is great, 0.0 is poor." ? #3, " Count = number of user evaluations for this file." ? #3, " Cost = amount deducted from your account balance to download." ? #3, "" do Counter = 1 File_Area = FileRecNext.Area if GetFileArea ( FileAreaRec, File_Area ) then ? " ----------------------------------------------------------------------" ? " ----------------------------------------------------------------------" ? " "; FormatNumber ( File_Area, "@####" ); ": "; ? FileAreaRec.Name ? " ----------------------------------------------------------------------" ? " ----------------------------------------------------------------------" ? "" ? #3, " ----------------------------------------------------------------------" ? #3, " ----------------------------------------------------------------------" ? #3, " "; FormatNumber ( File_Area, "@####" ); ": "; ? #3, FileAreaRec.Name ? #3, " ----------------------------------------------------------------------" ? #3, " ----------------------------------------------------------------------" ? #3, "" else Beep ? "Error: unable to get file area name for"; File_Area; "!" end if SortStart FileArea_Tmp = "ALL" + \ FormatNumber ( File_Area, "@####" ) + ".TMP" ? "Creating temporary file "; FileArea_Tmp; "..." if Exists ( FileArea_Tmp ) then Del ( FileArea_Tmp ) end if Open FileArea_Tmp for random as #1 len = Len ( Rating_Rec_Type ) do Rating_Rec.Name = FileRecNext.Name Eval_Info ( Rating, Count, Dummy, FileRecNext.Name ) Rating_Rec.Rating = FormatNumber ( Rating, "#.#####" ) Rating_Rec.Count = FormatNumber ( Count, "@####" ) REM ? Rating_Rec.Rating + Rating_Rec.Count \ REM + FormatNumber ( FileRec.Cost, "@####" ) \ REM + Pad ( Rating_Rec.Name, 12 ), Counter SortAdd ( Rating_Rec.Rating + Rating_Rec.Count \ + FormatNumber ( FileRec.Cost, "@####" ) \ + Rating_Rec.Name, Counter ) put #1, Counter, Rating_Rec Counter = Counter + 1 ? "."; Got_Next_File = GetNextFile ( FileRecNext, 1 ) if not Got_Next_File then exit do end if loop until FileRecNext.Area <> File_Area ? FileArea_Txt = "ALL" + \ FormatNumber ( File_Area, "@####" ) + ".TXT" ? "Creating file area sorted listing "; FileArea_Txt; "..." open FileArea_Txt for output as #2 do Counter = SortPrev if Counter > -1 then get #1, Counter, Rating_Rec ? #2, Rating_Rec.Name; " "; ? #2, Rating_Rec.Rating; " "; ? #2, Rating_Rec.Count; " " REM if GetFileInfo ( FileRec, Rating_Rec.Name, File_Area ) then if GetFileInfo ( FileRec, Rating_Rec.Name ) then ? #3, " "; ? #3, Pad ( Rating_Rec.Name, 12 ); " "; ? #3, Rating_Rec.Rating; " "; ? #3, Rating_Rec.Count; " "; ? #3, LeftPad ( Dollars_Str ( FileRec.Cost ), 6 ); " "; ? #3, FileRec.Uploader ? #3, " "; Mid ( FileRec.Description, 1, 70 ) ? #3, "" else ? "Error: unable to get file info for "; Rating_Rec.Name; "!" end if end if loop until Counter < 0 Close ( 1 ) ? "Deleting temporary file "; FileArea_Tmp; "..." Del ( FileArea_Tmp ) Close ( 2 ) loop until not Got_Next_File Close ( 3 ) if FindFirst ( AllFiles_Txt, 0, SrchRec ) = 0 then AllFiles_Size = SrchRec.Size else ? "Error: unable to locate "; AllFiles_Txt; "!" AllFiles_Size = 0 end if if GetFileInfo ( FileRec, AllFiles_Txt ) then AllFiles_Path = File_Dir ( FileRec ) + AllFiles_Txt ? "Updating "; AllFiles_Txt; "..." if CopyFile ( AllFiles_Txt, AllFiles_Path ) then CurrentDateTime ( FileRec.FileTime ) FileRec.Size = AllFiles_Size if not UpdateFile ( FileRec ) then ? "Error: unable to update "; AllFiles_Txt; "!" end if else ? "Error: unable to copy "; AllFiles_Txt; " to "; \ AllFiles_Path + "!" end if else ? "Adding "; AllFiles_Txt; " to File Area 1..." if GetFileArea ( FileAreaRec, 1 ) then if CopyFile ( AllFiles_Txt, FileAreaRec.Path + AllFiles_Txt ) then FileRec.Size = AllFiles_Size FileRec.Name = AllFiles_Txt FileRec.Password = "" CurrentDateTime ( FileRec.FileTime ) CurrentDateTime ( FileRec.LastAccess ) FileRec.Uploader = "EvalFile" FileRec.UploaderID = 0 FileRec.Description = "List of all files on this BBS sorted by EvalFile ratings" FileRec.Flags = 4 FileRec.Downloads = 0 FileRec.Cost = 0 FileRec.Area = 1 FileRec.KeyWords ( 1 ) = "LIST" FileRec.KeyWords ( 2 ) = "ALLFILES" FileRec.KeyWords ( 3 ) = "FILES" FileRec.KeyWords ( 4 ) = "BBS" FileRec.KeyWords ( 5 ) = "EVALFILE" FileRec.KeyWords ( 6 ) = "RATINGS" FileRec.StoredPath = "" FileRec.LongDesc ( 1 ) = "List of all files on this BBS sorting by EvalFile ratings" FileRec.LongDesc ( 2 ) = "" FileRec.LongDesc ( 3 ) = "Files are sorted by file area, rating, and evaluation count." for Index = 4 to 15 FileRec.LongDesc ( Index ) = "" next Index if not AddFile ( FileRec ) then ? "Error: unable to add "; AllFiles_Txt; "!" end if else ? "Error: unable to copy "; AllFiles_Txt; " to "; \ FileAreaRec.Path + AllFiles_Txt + "!" end if else ? "Error: unable to get info on File Area 1!" end if end if else Beep ? "Error: No files available on the BBS!" ? "Delaying 10 seconds..." Delay 10 end if end sub sub Assign_Ratings_To_Descriptions REM ------------------------------------------------------------------ dim Rating as real dim Rating_Str as string dim FileRec as FileRecord dim SrchRec_Var as SearchRec dim File_Name as string dim Dum_Int as integer dim Dum_Long as long REM ? "Assigning ratings to descriptions..." if FindFirst ( FileUser_Dir + "*.*", 0, SrchRec_Var ) = 0 then do File_Name = SrchRec_Var.Name Eval_Info ( Rating, Dum_Int, Dum_Long, File_Name ) Rating_Str = FormatNumber ( Rating, "#.#####" ) print SrchRec_Var.Name, Rating, "..."; if GetFileInfo ( FileRec, SrchRec_Var.Name ) then if Len ( FileRec.Description ) > 0 then FileRec.Description = Pad ( Mid ( FileRec.Description, 1, 70 ), 70 ) else FileRec.Description = Pad ( "No description", 70 ) end if if Mid ( Rating_Str, 1, 1 ) = "1" then FileRec.Description = FileRec.Description + "+++++" else FileRec.Description = FileRec.Description + Mid ( Rating_Str, 3, 5 ) end if UpdateFile ( FileRec ) print "done." else print "file not found." end if if FindNext ( SrchRec_Var ) <> 0 then exit do end if loop end if end sub function Eval_Rec_Get ( Eval_Rec as Eval_Rec_Type, FileRec as FileRecord, \ byval File_Name as string ) as boolean REM ------------------------------------------------------------------ REM -- Retrieves Eval_Rec for user from filename REM -- returns false if not found in filename REM -- returns Eval_Rec and FileRec REM ------------------------------------------------------------------ dim Index as long dim User_Found as boolean dim File_Num as integer REM Eval_Rec_Get = false User_Found = false if GetFileInfo ( FileRec, UCase ( File_Name ) ) then if Exists ( FileUser_Dir + File_Name ) then File_Num = FreeFile open ( FileUser_Dir + File_Name ) for random as File_Num len = Len ( Eval_Rec_Type ) for Index = 1 to LOF ( File_Num ) get #File_Num, Index, Eval_Rec if Eval_Rec.UserID = User.UserID then Eval_Rec_Get = true exit for end if next Index close ( File_Num ) end if end if end function function Eval_Rec_Put ( File_Name as string, Eval_Rec as Eval_Rec_Type ) \ as boolean REM ------------------------------------------------------------------ dim Index as long dim Eval_Rec_Tmp as Eval_Rec_Type REM Eval_Rec_Put = false if Exists ( FileUser_Dir + File_Name ) then open FileUser_Dir + File_Name for random as #1 len = Len ( Eval_Rec_Type ) for Index = 1 to LOF ( 1 ) get #1, Index, Eval_Rec_Tmp if Eval_Rec_Tmp.UserID = Eval_Rec.UserID then put #1, Index, Eval_Rec Eval_Rec_Put = true exit for end if next Index close ( 1 ) end if end function function Reward_Evaluator as boolean REM ------------------------------------------------------------------ REM Reward_Evaluator = false if User.Downloads > 0 then User.Downloads = User.Downloads - 1 if UpdateUser ( User ) then Reward_Evaluator = true end if end if end function function Reward_Uploader ( \ Uploader as string, Cost as integer, File_Name as string ) \ as boolean REM ------------------------------------------------------------------ dim Uploader_Rec as UserRecord REM Reward_Uploader = false if GetUser ( Uploader_Rec, Uploader ) then Uploader_Rec.SubscriptionBalance = \ Uploader_Rec.SubscriptionBalance + Cost if UpdateUser ( Uploader_Rec ) then Reward_Uploader = true Message_Send_Uploader ( Uploader, Cost, File_Name ) end if end if end function sub Evaluate_Files ( Unevaluated as string ) REM ------------------------------------------------------------------ dim Eval_Old as string*1 dim File_Name as string dim Eval_Rec as Eval_Rec_Type dim FileRec as FileRecord dim Uploader as string REM if Unevaluated = "" then ? "Please enter the name of the downloaded file [ENTER=Abort]: "; input File_Name if Trim ( File_Name ) = "" then exit sub end if else ? "Please enter the name of the downloaded file ["; ? Unevaluated; "]: "; input File_Name if File_Name = "" then File_Name = Unevaluated Unevaluated = "" end if end if File_Name = UCase ( File_Name ) if Eval_Rec_Get ( Eval_Rec, FileRec, File_Name ) then ? ? FileRec.Name ? ? Mid ( FileRec.Description, 1, 70 ) ? FileInfo ( FileRec.Name, FileRec.Area ) ? Eval_Old = Eval_Rec.Eval if InputYesNo ( "Did you find this file worth downloading (y/N)? ", false ) then Eval_Rec.Eval = "Y" else Eval_Rec.Eval = "N" end if if not Eval_Rec_Put ( File_Name, Eval_Rec ) then ? "Error: evaluation record not updated." WaitEnter end if if Eval_Old <> "Y" and Eval_Old <> "N" then ? "Thank you for your evaluation, "; Trim ( User.Name ); "." if Reward_Evaluator then ? "Your download count has been reduced by one." end if if Eval_Rec.Eval = "Y" then ? "Our thanks to the uploader, "; Trim ( FileRec.Uploader ); "!" if Eval_Rec.Cost > 0 then Uploader = FileRec.Uploader if Reward_Uploader ( Uploader, Eval_Rec.Cost, File_Name ) then ? Trim ( FileRec.Uploader ); " has been awarded "; ? Eval_Rec.Cost; " credits." end if end if if UCase ( Mid ( FileRec.Description, 1, 14 ) ) = "NO DESCRIPTION" then ? ? "The uploader of this file did not give it a short description." ? "You may become the uploader of this file by giving it one." ? "You would then be entitled to any subsequent uploader credits." ? if InputYesNo ( \ "Would you like to give this file a short description (y/N)? ", \ false ) then do ? "Please enter a one-line description for this file [ENTER=Abort]." input FileRec.Description if FileRec.Description = "" then exit do end if FileRec.Description = Mid ( FileRec.Description, 1, 70 ) ? ? FileRec.Description loop until \ InputYesNo ( "Is this the way you want it to read (Y/n)? ", true ) if FileRec.Description <> "" then FileRec.Uploader = User.Name FileRec.UploaderID = User.UserID if not UpdateFile ( FileRec ) then Beep ? "Error: unable to update file description." WaitEnter end if end if end if end if end if end if else ? ? "Your EvalFile record of "; File_Name; " could not be found." ? ? "Possible reasons are" ? "(1) the activity log has not been scanned for your download yet," ? "(2) the file has been deleted from the BBS," ? "(3) you have not downloaded that file yet." ? "(4) you mis-spelled the file name, or" end if WaitEnter end sub sub Event_Mode REM ------------------------------------------------------------------ MorePrompt Off Scan_Activity_Log Costs_Update Sort_All_Files Assign_Ratings_To_Descriptions ? "Delaying 5 seconds before returning to the BBS..." delay 5 end sub function Find_Unevaluated as string REM ------------------------------------------------------------------ dim Eval_Rec as Eval_Rec_Type dim FileRec as FileRecord dim File_Found as boolean : File_Found = false const Download_Dir = "File\Download\" dim Download_Usr as string dim File_Num_Download as integer dim File_Name as string*12 REM Find_Unevaluated = "" ? ? "Searching for your unevaluated downloaded files." ? "Press any key to stop searching." ? Download_Usr = Download_Dir + UserID_File ( User.UserID ) if Exists ( Download_Usr ) then File_Num_Download = FreeFile open Download_Usr for input as File_Num_Download do while not EOF ( File_Num_Download ) input #File_Num_Download, File_Name File_Name = UCase ( Trim ( Left ( File_Name, 12 ) ) ) if Inkey <> "" then ? if not InputYesNo ( "Continue search? (y/N): ", false ) then exit do end if ? end if if Eval_Rec_Get ( Eval_Rec, FileRec, File_Name ) then if Eval_Rec.Eval = " " then Find_Unevaluated = FileRec.Name File_Found = true ? ? FileRec.Name ? if not InputYesNo ( "Continue search? (y/N): ", false ) then exit do end if else ? "."; end if else ? "."; end if loop close ( File_Num_Download ) end if ? ? ? "Search completed." if not File_Found then ? ? "No unevaluated downloaded files found." ? ? "Possible reasons: " ? "(1) the activity log has not been scanned for your downloads yet," ? "(2) the files have been deleted from the BBS," ? "(3) you have not downloaded any files yet," ? "(4) you have already evaluated your downloaded files." end if WaitEnter end function sub Menu_File_Records REM ------------------------------------------------------------------ dim Option as string*1 dim File_Name as string dim Index as long dim Eval_Rec as Eval_Rec_Type dim Rating as real dim Count as integer dim Paid as long REM do cls ? Copyright ? ? "EVALFILE FILE RECORDS MENU" ? ? "E -- Examine a file record" ? "S -- Statistics for a file record" ? "Q -- Quit" ? ? "Option: "; input Option Option = UCase ( Option ) select case Option case "E" ? "File name: "; input File_Name ? if Exists ( FileUser_Dir + File_Name ) then open ( FileUser_Dir + File_Name ) for random as #1 len = Len ( Eval_Rec_Type ) for Index = 1 to LOF ( 1 ) get #1, Index, Eval_Rec ? "Downloader UserID: "; Eval_Rec.UserID; " "; ? "Amount Paid: "; Eval_Rec.Cost; " "; ? "Evaluation: "; Eval_Rec.Eval next Index close ( 1 ) else ? "Unable to find record for that file." end if WaitEnter case "Q" exit sub case "S" ? "File name: "; input File_Name File_Name = UCase ( File_Name ) ? Eval_Info ( Rating, Count, Paid, File_Name ) ? "File Name Rating Count Paid" ? Pad ( File_Name, 12 ); " "; ? FormatNumber ( Rating, "#.#####" ); " "; ? FormatNumber ( Count, "@####" ); " "; ? Dollars_Str ( Paid ) WaitEnter case else Beep end select loop end sub sub Menu_Maintenance REM ------------------------------------------------------------------ dim Option as string*1 REM do cls ? Copyright ? ? "EVALFILE MAINTENANCE MENU" ? ? "If EvalFile.WCX is installed as a nightly event," ? "it will perform maintenance unattended." ? ? "A -- All Maintenance" ? "1 -- Scan Activity Log" ? "2 -- Costs Update" ? "3 -- Sort All Files by File Area and Ratings" ? "4 -- Assign Ratings to Descriptions" ? "Q -- Quit" ? ? "Option: "; input Option Option = UCase ( Option ) select case Option case "A" if InputYesNo ( "Automatically log off afterwards? (Y/n): ", true ) then Event_Mode Goodbye else Event_Mode MorePrompt On WaitEnter end if case "1" MorePrompt Off Scan_Activity_Log MorePrompt On WaitEnter case "3" Sort_All_Files WaitEnter case "4" MorePrompt Off Assign_Ratings_To_Descriptions MorePrompt On WaitEnter case "2" MorePrompt Off Costs_Update MorePrompt On WaitEnter case "Q" exit sub case else Beep end select loop end sub sub Menu_SysOp dim Option as string REM ------------------------------------------------------------------ if UserSec.SysopStatus = 0 then ? Beep ? "You must have SysOp status to enter this menu." ? WaitEnter exit sub end if while Option <> "Q" cls ? Copyright ? ? "EVALFILE SYSOP MENU" ? ? "F -- File Records Menu" ? "M -- Maintenance Menu" ? "Q -- Quit" ? ? "Option: "; input Option Option = Ucase ( Option ) select case Option case "F" Menu_File_Records case "M" Menu_Maintenance case "Q" REM -- Quitting case else Beep end select wend end sub sub Menu_Uploader REM ------------------------------------------------------------------ dim Option as string*1 dim File_Name as string dim Index as long dim Eval_Rec as Eval_Rec_Type dim Rating as real dim Count as integer dim Paid as long dim FileRec as FileRecord REM do cls ? Copyright ? ? "EVALFILE UPLOADER MENU" ? ? "C -- Change the description of a file" ? "E -- Examine a file record" ? "R -- Rating and total payment for a file" ? "S -- Search files (for your username)" ? "Q -- Quit" ? ? "Option: "; input Option Option = UCase ( Option ) select case Option case "C" ? "File name: "; input File_Name File_Name = UCase ( File_Name ) ? if GetFileInfo ( FileRec, File_Name ) then if FileRec.UploaderID = User.UserID then do ? FileRec.Name ? FileRec.Description ? ? "Please enter a one-line description for this file [ENTER=Abort]." input FileRec.Description if FileRec.Description = "" then exit do end if FileRec.Description = Mid ( FileRec.Description, 1, 70 ) ? ? FileRec.Description loop until \ InputYesNo ( "Is this the way you want it to read (Y/n)? ", true ) if FileRec.Description <> "" then if not UpdateFile ( FileRec ) then Beep ? "Error: unable to update file description." WaitEnter end if end if else ? "You must be the uploader of the file to change its description." WaitEnter end if else ? "Unable to locate the file "; File_Name; "." ? "You may have mis-spelled it or it might have been deleted." WaitEnter end if case "E" ? "File name: "; input File_Name ? if Exists ( FileUser_Dir + File_Name ) then open ( FileUser_Dir + File_Name ) for random as #1 len = Len ( Eval_Rec_Type ) for Index = 1 to LOF ( 1 ) get #1, Index, Eval_Rec ? "Amount Paid: "; Eval_Rec.Cost; " "; ? "Evaluation: "; Eval_Rec.Eval next Index close ( 1 ) else ? "Unable to find record for that file." end if WaitEnter case "Q" exit sub case "R" ? "File name: "; input File_Name File_Name = UCase ( File_Name ) ? Eval_Info ( Rating, Count, Paid, File_Name ) ? "File Name Rating Count Paid" ? Pad ( File_Name, 12 ); " "; ? FormatNumber ( Rating, "#.#####" ); " "; ? FormatNumber ( Count, "@####" ); " "; ? Dollars_Str ( Paid ) WaitEnter case "S" SearchFiles case else Beep end select loop end sub sub User_Mode REM ------------------------------------------------------------------ dim Option as string dim Unevaluated as string : Unevaluated = "" dim Default as string : Default = "F" REM ------------------------------------------------------------------ while Option <> "Q" cls color 14 ? Copyright ? ? "EVALFILE MAIN MENU" ? ? "THIS IS NEW. LET ME KNOW OF THE BUGS! -- David Croft" ? ? "A -- download AllFiles.Txt, a list of all downloadable files" ? "C -- leave a Comment to the SysOp" color 12 ? "E -- Evaluate a previously downloaded file" color 13 ? "F -- Find your unevaluated files" color 14 ? "G -- Goodbye (log off the BBS)" ? "L -- List files available for download" ? "Q -- Quit (return to the BBS)" if UserSec.SysopStatus > 0 then ? "S -- SysOp Menu" end if ? "U -- Uploader Menu" ? ? "Option ["; Default; "]: "; input Option Option = UCase ( Option ) if Option = "" then Option = Default end if select case Option case "A" Download ( "ALLFILES.TXT", 1 ) case "C" Comment case "E" Evaluate_Files ( Unevaluated ) Default = "F" case "F" Unevaluated = Find_Unevaluated if Unevaluated <> "" then Default = "E" else Default = "Q" end if case "G" Goodbye ( true ) case "L" Chain ( EvalList_WCX ) case "Q" ? "Returning to BBS..." case "S" Menu_SysOp case "U" Menu_Uploader case else Beep end select wend end sub REM ------------------------------------------------------------------ REM ------------------------------------------------------------------ ? Copyright ? if EventRunning then Event_Mode else User_Mode end if