'$include "..\WC_Subs\WC_Subs.WCC"

     const TrdParty = "3RDPARTY"
     const UNREGISTERED = "UNREGISTERED"
     const UserData = "UserData"
     const UserName_Txt = "UserName.Txt"

     declare sub Encode_Registration

     declare sub Event_Delay ( \
       byval Delay_Seconds as integer, \
       byval Copyright as string, \
       byval Registration_Cost as integer )

     declare function Registration_Code_Good ( \
             Registration_Str  as string,   \
       byval Registration_Code as string,   \
       byval Reg_Version       as string )  \
             as boolean

     declare function Registration_Load (  \
       byval Key_Path_File     as string,  \
       byval Reg_Version       as string ) \
             as string

     declare sub Shareware_Delay ( \
       byval Delay_Seconds as integer, \
       byval Registration_Cost as integer, \
       byval Donation_Minimum as integer, \
       byval Donations_File as string, \
       byval SysOp_Bypass_Allowed as boolean )

     declare sub Show_Order_Form ( \
       byval Copyright as string,  \
       byval Registration_Cost as integer )

     declare sub Third_Party_Setup ( \
             Registration as string, \
       byval Copyright    as string, \
       byval Program_Dir  as string, \
       byval Delay_Seconds as integer, \
       byval Registration_Cost as integer, \
       byval Donation_Minimum as integer, \
       byval Donations_File as string,     \
       byval SysOp_Bypass_Allowed as boolean, \
       byval Reg_Version          as string,  \
       byval ProgName_Key         as string )

     declare sub Third_Party_Uninstall ( \
       byval PROGRAM_DIR as string )

     declare sub Third_Party_Wrapup (      \
       byval Registration      as string,  \
       byval Copyright         as string,  \
       byval Registration_Cost as integer, \
       byval ProgName_Zip      as string,  \
       byval ProgVers_Zip      as string )

     declare function UserData_Path ( \
       byval UserID as long, \
       byval UserName as string, \
       byval Create_If_Needed as boolean = true ) \
       as string

     declare sub UserData_Purge

     declare function  UserData_Program_Dir ( \
       byval UserID as long, \
       byval UserName as string, \
       byval Program_Dir as string, \
       byval Create_If_Needed as boolean = true ) \
       as string

     //////////////////////////////////////////////////////////////////////
     //////////////////////////////////////////////////////////////////////

     sub Encode_Registration
     //////////////////////////////////////////////////////////////////////
       dim RegString as string
       dim Reg_Version as string
       dim Registration_Code as string
       dim File_Num as integer
       const ProgName_Key_Default = "ProgName.Key"
       dim ProgName_Key as string
     //////////////////////////////////////////////////////////////////////
       input "Please enter the BBS RegString...........:  "; RegString
       input "Please enter the Program Reg_Version.....:  "; Reg_Version
       ?
       Registration_Code = EncodePassword ( RegString + Reg_Version )
       ? Registration_Code
       ?
       if InputYesNo ( "Save to file? (y/N):  ", false ) then
         ? "Path and file name ["; ProgName_Key_Default; "]:  ";
         input ProgName_Key
         if ProgName_Key = "" then
           ProgName_Key = ProgName_Key_Default
         end if
         File_Num = FreeFile
         open ProgName_Key for output as File_Num
         ? #File_Num, Registration_Code
         close ( File_Num )
         ? "Saved to "; ProgName_Key; "."
         WaitEnter
       end if
     end sub

     sub Event_Delay ( \
       byval Delay_Seconds as integer, \
       byval Copyright as string, \
       byval Registration_Cost as integer )
     //////////////////////////////////////////////////////////////////////
       dim Tick as integer
     //////////////////////////////////////////////////////////////////////
       MorePrompt Off
       ?
       ? "There will be a delay of "; Delay_Seconds; " seconds";
       ? " to encourage registration of this program."
       ?
       Show_Order_Form ( Copyright, Registration_Cost )
       for Tick = 1 to Delay_Seconds
         delay ( 1 )
         ? ".";
       next Tick
     end sub

     function Registration_Code_Good (     \
             Registration_Str  as string,  \
       byval Registration_Code as string,  \
       byval Reg_Version       as string ) \
             as boolean
     //////////////////////////////////////////////////////////////////////
       dim Pre_Encode_Str as string
     //////////////////////////////////////////////////////////////////////
       Registration_Code_Good = false
       Registration_Str = UNREGISTERED
       Pre_Encode_Str = MakeWild.RegString + Reg_Version
       if EncodePassword ( Pre_Encode_Str ) = Registration_Code then
         Registration_Str = MakeWild.RegString
         Registration_Code_Good = true
       else
         Registration_Code_Good = false
         Registration_Str = UNREGISTERED
       end if
     end function

     function Registration_Load ( \
       byval Key_Path_File     as string, \
       byval Reg_Version       as string ) \
             as string
     //////////////////////////////////////////////////////////////////////
       const Prompt = "SysOp, would you like to " \
         + "enter your registration code now? (Y/n):  "
       dim File_Num          as integer
       dim Registration_Code as string
       dim Temp              as string
     //////////////////////////////////////////////////////////////////////
       Registration_Load = UNREGISTERED
       Registration_Code = UNREGISTERED
       if Exists ( Key_Path_File ) then
         File_Num = FreeFile
         open Key_Path_File for input as File_Num
         input #File_Num, Registration_Code
         close #File_Num
       end if
       if Registration_Code_Good ( \
         Temp, Registration_Code, Reg_Version ) then
           Registration_Load = Temp
           exit function
       end if
       if EventRunning then
         exit function
       end if
       ?
       ? "Interactive mode detected."
       ?
       if User_Is_SysOp then
       if InputYesNo ( Prompt, true ) then
         input "Please enter your registration code:  "; Registration_Code
         if Registration_Code_Good ( \
           Temp, Registration_Code, Reg_Version ) then
             ? "Creating registration code file ";
             ? Key_Path_File; "...";
             File_Num = FreeFile
             open Key_Path_File for output as File_Num
             ? #File_Num, Registration_Code
             close ( File_Num )
             ? "done."
             Registration_Load = Temp
             exit function
         else
           Registration_Load = UNREGISTERED
           ? "Registration code invalid."
           WaitEnter
         end if
       end if
       end if
     end function

     sub Shareware_Delay ( \
       byval Delay_Seconds as integer, \
       byval Registration_Cost as integer, \
       byval Donation_Minimum as integer, \
       byval Donations_File as string, \
       byval SysOp_Bypass_Allowed as boolean )
     //////////////////////////////////////////////////////////////////////
       dim Donations_So_Far as integer
       dim New_Donation as integer
       dim Prompt as string
       dim File_Num as integer
       dim Tick as integer
       dim Max as integer
       dim Key as string*1
       dim Last_Giver as string : Last_Giver = ""
       dim LastGive_Date_Str as string : LastGive_Date_Str = ""
       dim LastGive_Date as Date
       dim LastGive_Days_Since as long : LastGive_Days_Since = 0
       dim Now as DateTime
     //////////////////////////////////////////////////////////////////////
       Color ( 11 )
       ?
       Donations_So_Far = 0
       if Exists ( Donations_File ) then
         File_Num = FreeFile
         open Donations_File for input as File_Num
         if not EOF ( File_Num ) then
           input #File_Num, Donations_So_Far
         end if
         if not EOF ( File_Num ) then
           input #File_Num, Last_Giver
         end if
         if not EOF ( File_Num ) then
           input #File_Num, LastGive_Date_Str
         end if
         close #File_Num
       end if
       ? "The cost of registration for this shareware BBS program is $";
       ? Trim ( FormatNumber ( Registration_Cost / 100, "###.##" ) ); "."
       ?
       ? "Users like you have helped by contributing $";
       ? Trim ( FormatNumber ( Donations_So_Far / 100, "###.##" ) );
       ? " so far."
       if Last_Giver <> "" then
         ?
         ? "The last user to contribute was ";
         Color ( 12 )
         ? Last_Giver;
         Color ( 11 )
         if LastGive_Date_Str <> "" then
           ? " on "; LastGive_Date_Str;
         end if
         ? "."
       end if
       ?
       ? "There will be a delay to encourage registration of this program."
       ? "You can bypass this delay by contributing ";
       Color ( 10 )
       ? Dollars_Str ( Donation_Minimum );
       Color ( 11 )
       ? " or more."
       ?
       if LastGive_Date_Str <> "" then
         DateStringToDate ( "yyyy-mm-dd", LastGive_Date_Str, \
           LastGive_Date )
         LastGive_Days_Since = abs ( Days_Since_Today ( LastGive_Date ) )
         ? "It has been "; LastGive_Days_Since;
         ? " day(s) since the last contribution."
       end if
       ? "The delay will be "; Delay_Seconds;
       if LastGive_Days_Since <> 0 then
         ? " + "; LastGive_Days_Since;
       end if
       ? " seconds."
       ?
       ? "Press SPACEBAR to bypass this delay and help registration."
       ?
       for Tick = 1 to Delay_Seconds + LastGive_Days_Since
         Key = InKey
         if Key = " " then
           if Donations_So_Far >= Registration_Cost then
             ?
             ?
             ? "Sufficient funds have already been collected from user";
             ? " contributions for registration."
             ?
             ? "Would like you like to leave your SysOp a message to ";
             ? "encourage registration? (Y/n):  ";
             if InputYesNo ( "", TRUE ) then
               Comment
             end if
           elseif User_Is_SysOp and SysOp_Bypass_Allowed then
             ?
             ?
             ? "SysOp, please register this shareware BBS program."
             WaitEnter
             exit for
           elseif User.SubscriptionBalance < Donation_Minimum then
             ?
             ?
             ? "Your account balance is ";
             ? Dollars_Str ( User.SubscriptionBalance ); "."
             ? "The minimum contribution to bypass the delay is ";
             ? Dollars_Str ( Donation_Minimum ); "."
             ?
             ? "Please contact your SysOp about increasing your ";
             ? "account balance."
             ?
             WaitEnter
           else
             ?
             ?
             ? "The minimum contribution to bypass the delay is ";
             ? Donation_Minimum; " cent(s)."
             ?
             Prompt = "How much would you like to contribute, in cents? "
             Max = Registration_Cost - Donations_So_Far
             if Max > User.SubscriptionBalance then
               Max = User.SubscriptionBalance
             end if
             New_Donation = Integer_Ask ( Prompt, 0, Max, Donation_Minimum )
             if New_Donation > 0 then
               User.SubscriptionBalance \
                 = User.SubscriptionBalance - New_Donation
               File_Num = FreeFile
               open Donations_File for output as #File_Num
               ? #File_Num, Donations_So_Far + New_Donation
               ? #File_Num, User.Name
               CurrentDateTime ( Now )
               ? #File_Num, FormatDate ( Now.D, "yyyy-mm-dd" )
               close ( File_Num )
               ? "Thank you."
             end if
             if New_Donation >= Donation_Minimum then
               exit for
             end if
           end if
         end if
         delay 1
         ? ".";
       next Tick
       ?
     end sub

     sub Show_Order_Form ( \
       byval Copyright as string, \
       byval Registration_Cost as integer )
     //////////////////////////////////////////////////////////////////////
       if EventRunning then
         MorePrompt Off
       end if
       Color ( 10 )
       ? "Press PRINT SCREEN to print this page."
       ?
       Color ( 11 )
       ? "Utility :  "; Copyright
       ? "BBS     :  "; MakeWild.BBSName
       ? "Version :  "; MakeWild.Version
       ? "SysOp   :  "; MakeWild.SysopName
       ? "BBS Reg.:  "; MakeWild.RegString
       ?
       ? "To register, send the above info, your address, plus a ";
       ? Dollars_Str ( Registration_Cost ); " check to"
       ?
       ? "Shannon Croft"
       ? "29 S. Daisy Ave. #6"
       ? "Pasadena, CA 91107-4300"
       ?
       Color ( 12 )
     end sub

     sub Third_Party_Setup ( \
             Registration as string, \
       byval Copyright    as string, \
       byval Program_Dir  as string, \
       byval Delay_Seconds as integer, \
       byval Registration_Cost as integer, \
       byval Donation_Minimum as integer, \
       byval Donations_File as string,     \
       byval SysOp_Bypass_Allowed as boolean, \
       byval Reg_Version          as string,  \
       byval ProgName_Key         as string )
     //////////////////////////////////////////////////////////////////////
       if EventRunning then
         MorePrompt Off
       end if
       cls
       Color ( 11 )
       ? Copyright
       if not Dir_Exists ( TrdParty ) then
         ? "Making sub-directory "; TrdParty; "..."
         MkDir TrdParty
       end if
       if not Dir_Exists ( TrdParty + "\" + PROGRAM_DIR ) then
         ? "Making sub-directory "; TrdParty; "\"; PROGRAM_DIR; "..."
         MkDir TrdParty + "\" + PROGRAM_DIR
       end if
       Registration = Registration_Load ( \
         TrdParty + "\" + PROGRAM_DIR + "\" + ProgName_Key, Reg_Version )
       ? "Registration:  "; Registration
       if Registration = UNREGISTERED then
         if EventRunning then
           Event_Delay ( Delay_Seconds * 5, Copyright, Registration_Cost )
         else
           Shareware_Delay ( Delay_Seconds, Registration_Cost, \
             Donation_Minimum, \
             TrdParty + "\" + Program_Dir + "\" + Program_Dir + ".$$$", \
             SysOp_Bypass_Allowed )
         end if
       end if
     end sub

     sub Third_Party_Uninstall ( \
       byval PROGRAM_DIR as string )
     //////////////////////////////////////////////////////////////////////
       dim SrchRec as SearchRec
       dim User_Dir as string
     //////////////////////////////////////////////////////////////////////
       if not Dir_Exists ( TrdParty + "\" + PROGRAM_DIR ) then
         ? "Sub-directory "; TrdParty; "\"; PROGRAM_DIR; " not found."
         WaitEnter
       end if
       Color ( 12 )
       Beep
       Beep
       Beep
       ? "You about to delete this program and its associated files."
       ?
       ? "Are you sure you want to uninstall this program?";
       if not InputYesNo ( " (y/N):  ", false ) then
         exit sub
       end if
       ?
       Dir_Del_File_By_File ( TrdParty + "\" + PROGRAM_DIR )
       ?
       ? "Remove program-specific user data?";
       if InputYesNo ( " (y/N):  ", false ) then
         if FindFirst ( TrdParty + "\" + UserData + "\*.*", \
           16, SrchRec ) = 0 then
           do
             User_Dir = TrdParty + "\" + UserData + "\" \
               + SrchRec.Name + "\" + PROGRAM_DIR
             if Dir_Exists ( User_Dir ) then
               ? "Pruning "; User_Dir; "...";
               if Dir_Prune ( User_Dir ) then
                 ? "done."
               else
                 ? "failed."
               end if
             end if
           loop while FindNext ( SrchRec ) = 0
         else
           ? "No program-specific user data directories found."
         end if
       end if
       ?
       ? "To finish the installation, remove the program calls from"
       ? "the SysOp Event Menu or from MakeMenu."
       ?
       WaitEnter
     end sub

     sub Third_Party_Wrapup (              \
       byval Registration      as string,  \
       byval Copyright         as string,  \
       byval Registration_Cost as integer, \
       byval ProgName_Zip      as string,  \
       byval ProgVers_Zip      as string )
     //////////////////////////////////////////////////////////////////////
       dim FileRec as FileRecord
     //////////////////////////////////////////////////////////////////////
       if EventRunning then
         UserData_Purge
       end if
       if Registration = UNREGISTERED then
         cls
         Show_Order_Form ( Copyright, Registration_Cost )
         if EventRunning then
           delay ( 5 )
           exit sub
         end if
         ? "When in unregistered mode, this BBS shareware utility must be"
         ? "available for download to all users of this BBS."
         if InputYesNo ( \
           "Would you like to download this BBS utility? (y/N):  ", \
           false ) then
             if GetFileInfo ( FileRec, ProgVers_Zip ) then
               Download ( ProgVers_Zip, FileRec.Area )
             elseif GetFileInfo ( FileRec, ProgName_Zip ) then
               Download ( ProgName_Zip, FileRec.Area )
             else
               ?
               Beep
               ? "Unable to find "; ProgName_Zip; " or "; ProgVers_Zip; "."
               ? "Please inform "; MakeWild.SysopName; ", your SysOp."
               ?
               if InputYesNo ( \
                 "Would you like to leave a comment to your Sysop?" \
                 + " (Y/n):  ", \
                 TRUE ) then
                   Comment
               end if
             end if
         end if
       end if
     end sub

     function UserData_Path ( \
       byval UserID as long, \
       byval UserName as string, \
       byval Create_If_Needed as boolean ) \
       as string
     //////////////////////////////////////////////////////////////////////
       dim File_Num as integer
       dim Temp as string
       dim User_Dir as string
     //////////////////////////////////////////////////////////////////////
       Temp = TrdParty + "\" + UserData + "\" + UserID_File ( UserID ) + "\"
       if not Exists ( Temp + UserName_Txt ) and Create_If_Needed then
         if not Dir_Exists ( TrdParty ) then
           ? "Making subdirectory "; TrdParty; "...";
           MkDir ( TrdParty )
           ? "done."
         end if
         if not Dir_Exists ( TrdParty + "\" + UserData ) then
           ? "Making subdirectory "; TrdParty + "\" + UserData; "...";
           MkDir ( TrdParty + "\" + UserData )
           ? "done."
         end if
         User_Dir = TrdParty + "\" + UserData + "\" + UserID_File ( UserID )
         if not Dir_Exists ( User_Dir ) then
           ? "Making subdirectory "; User_Dir; "...";
           MkDir ( User_Dir )
           ? "done."
         end if
         ? "Creating "; Temp; UserName_Txt; "...";
         File_Num = FreeFile
         open Temp + UserName_Txt for output as File_Num
         ? #File_Num, Pad ( UCase ( UserName ), 25 )
         close ( File_Num )
         ? "done."
       end if
       UserData_Path = Temp
     end function

     sub UserData_Purge
     //////////////////////////////////////////////////////////////////////
       dim Data_Path         as string
       dim Dir_Found         as boolean
       dim Dir_Rec           as SearchRec
       dim File_Num          as integer
       dim User_ID           as long
       dim User_Name         as string
       dim User_Rec          as UserRecord
       dim User_Should_Die   as boolean
       dim UserName_Txt_Path as string
     //////////////////////////////////////////////////////////////////////
       Data_Path = TrdParty + "\" + UserData + "\"
       Dir_Found = ( FindFirst ( Data_Path + "*.*", 16, Dir_Rec ) = 0 )
       do while Dir_Found
         if ( Dir_Rec.Name <> "." ) and ( Dir_Rec.Name <> ".." ) then
           User_Name = ""
           User_Should_Die = false
           ? Data_Path; Dir_Rec.Name; ":  ";
           if String_Is_Integer ( Dir_Rec.Name ) then
             User_ID = Val ( Dir_Rec.Name )
             UserName_Txt_Path = Data_Path + Dir_Rec.Name + "\" \
               + UserName_Txt
             if Exists ( UserName_Txt_Path ) then
               File_Num = FreeFile
               open UserName_Txt_Path for input as File_Num
               input #File_Num, User_Name
               close ( File_Num )
               if not User_Record_Found ( User_Rec, User_Name, User_ID ) then
                 User_Should_Die = true
               end if
             else
               User_Should_Die = true
             end if
             if User_Should_Die then
               if Dir_Prune ( Data_Path + Dir_Rec.Name ) then
                 ? "pruned."
               else
                 ? "FAILED."
               end if
             else
               ? "OK."
             end if
           else
             ? "unusual sub-directory name."
           end if
         end if
         Dir_Found = ( FindNext ( Dir_Rec ) = 0 )
       loop
     end sub

     function  UserData_Program_Dir ( \
       byval UserID as long, \
       byval UserName as string, \
       byval Program_Dir as string, \
       byval Create_If_Needed as boolean ) \
       as string
     //////////////////////////////////////////////////////////////////////
       dim Temp as string
     //////////////////////////////////////////////////////////////////////
       Temp = UserData_Path ( UserID, UserName, Create_If_Needed )
       Temp = Temp + Program_Dir
       if not Dir_Exists ( Temp ) and Create_If_Needed then
         ? "Making subdirectory "; Temp; "...";
         MkDir ( Temp )
         ? "done."
       end if
       UserData_Program_Dir = Temp
     end function