home *** CD-ROM | disk | FTP | other *** search
Text File | 1999-10-06 | 63.0 KB | 1,898 lines |
- 'T:HMISYSOP.EBS for CompuServe
- ' VA 4.52 release
-
- Type MsgStatSummary
- element As Integer
- threads As Long
- messages As Long
- percentage As Double
- ttotal As Long
- mtotal As Long
- End Type
-
- 'T:iFlags for CompuServe (constant)
- Const IM_SPECIAL = 128 ' My special msg format
- Const IM_DELETE = 2048 ' Delete scratchpad file afterwards?
- Const IM_MARKUNREAD = 131072
-
- Const FAP_MAX_SECTIONS% = 24
-
- Const HMI_STATE_FIRST% = 0
- Const HMI_STATE_NEXT% = HMI_STATE_FIRST + 1
- Const HMI_STATE_ABORT% = HMI_STATE_NEXT + 1
-
- Const FAP_USF_HIGH_MSG% = &H2
- Const FAP_USF_NAME% = &H4
- Const FAP_USR_JOIN% = &H1
- Const FAP_USR_PERMANENT% = &H2
- Const FAP_WAITING_MSGS% = &H1
- Const FAP_NEW_BULLETINS% = &H2
- Const FAP_CONFERENCE_IN_PROGRESS% = &H4
- Const FAP_NOT_A_MEMBER% = &H8
- Const FAP_IS_SYSOP% = &H10 ' user is SYSOP in this Forum
- Const FAP_FREE_USER% = &H20
- Const FAP_LOCKED_OUT% = &H40
- Const FAP_TRANSACTION_BILLING% = &H80
- Const FAP_ALLOW_MULTIPLE_SEARCH% = &H100
- Const FAP_NISA_FORUM% = &H200
-
- ' SysOp Alert Flags
- Const FAP_LIBRARIES_FULL% = &H1
- Const FAP_MERGE_IS_SCHEDULED% = &H2
- Const FAP_MERGE_FAILED% = &H4
- Const FAP_MERGE_ALLOWED% = &H8
- Const FAP_MERGE_IS_RUNNING% = &H10
- Const FAP_SET_PRICES% = &H40
- Const FAP_MSG_SYSOP% = &H400
- Const FAP_CONF_SYSOP% = &H800
- Const FAP_EDIT_SYSOP% = &H1000
- Const FAP_LIB_SYSOP% = &H2000
- Const FAP_MEMBER_SYSOP% = &H4000
- Const FAP_PRIMARY_SYSOP% = &H8000
-
- ' Modify Message/Thread Request Options
- Const FAP_MM_KEEP% = &H1 ' copy to a new thread, living original
- ' unchanged, only for a message
- Const FAP_MM_PRIVATE% = &H4
- Const FAP_MM_HOLD% = &H10
-
- ' Modify Message/Thread Request Components
- Const FAP_MMC_CHANGE_SUBJECT% = &H1
- Const FAP_MMC_CHANGE_RECIPIENT% = &H4 ' only for Message
- Const FAP_MMC_CHANGE_SECTION_ID% = &H20
- Const FAP_MMC_CHANGE_EXPIRATION% = &H80
-
- ' Delete Messages Response reason flags:
- ' typedef enum FAPDELMSGREASON
- Const FAP_DM_MESSAGE_NOT_FOUND% = 0
- Const FAP_DM_MESSAGE_IS_HELD% = FAP_DM_MESSAGE_NOT_FOUND + 1
- Const FAP_DM_INVALID_ADDRESS% = FAP_DM_MESSAGE_IS_HELD + 1
- Const FAP_DM_NOT_AUTHORIZED% = FAP_DM_INVALID_ADDRESS + 1
-
- ' Forward Messages Options flags:
- Const FAP_FM_SEND_TO_DIFFERENT% = &H1
- Const FAP_FM_DELETE_ORIGINAL% = &H2
-
- ' Merge Thread Request Options
- Const FAP_MS_MERGE_AS_REPLY = &H1
-
- Const FAP_MC_THREAD_ID% = &H1000
- Const FAP_MC_THREADS% = &H8000
-
- ' The Sections bit flag values
- Const FAP_SECT_PRIVATE% = &H1
- Const FAP_SECT_READ_ONLY% = &H2
- Const FAP_SECT_VISITOR% = &H4
- Const FAP_SECT_SELECTED% = &H80
-
- ' Member Directory Components flags
- Const FAP_MDC_USER_NAME% = &H1
- Const FAP_MDC_USER_ID% = &H2
- Const FAP_MDC_INTERESTS% = &H4
- Const FAP_MDC_AUXILIARY_DATA% = &H8
- Const FAP_MDC_FLAGS% = &H10
- Const FAP_MDC_SECTIONS% = &H20
- Const FAP_MDC_SYSOP_SECTIONS% = &H40
- Const FAP_MDC_LAST_ACCESS% = &H80
- Const FAP_MDC_DATE_JOINED% = &H100
-
- ' Member Directory Search types
- ' enum FAPMDSTYPES
- Const FAP_MDS_ALL% = 0
- Const FAP_MDS_NAME% = FAP_MDS_ALL + 1
- Const FAP_MDS_USER_ID% = FAP_MDS_NAME + 1
- Const FAP_MDS_INTERESTS% = FAP_MDS_USER_ID + 1
- Const FAP_MDS_AUXILIARY_DATA% = FAP_MDS_INTERESTS + 1
- Const FAP_MDS_MSG_SECTION_ACCESS% = FAP_MDS_AUXILIARY_DATA + 1 ' Pattern is string of 24 ASCII
- Const FAP_MDS_LIB_SECTION_ACCESS% = FAP_MDS_MSG_SECTION_ACCESS + 1 ' '0' or '1' characters (0x30 and
- Const FAP_MDS_CONF_SECTION_ACCESS% = FAP_MDS_LIB_SECTION_ACCESS + 1 ' 0x31 where 0 indicates no access,
- Const FAP_MDS_MSG_SYSOP_ACCESS% = FAP_MDS_CONF_SECTION_ACCESS + 1 ' 1 indicates access
- Const FAP_MDS_LIB_SYSOP_ACCESS% = FAP_MDS_MSG_SYSOP_ACCESS + 1 ' First chracter corresponds to
- Const FAP_MDS_CONF_SYSOP_ACCESS% = FAP_MDS_LIB_SYSOP_ACCESS + 1 ' section 0
- Const FAP_MDS_LAST_VISIT% = FAP_MDS_CONF_SYSOP_ACCESS + 1
- Const FAP_MDS_DATE_JOINED% = FAP_MDS_LAST_VISIT + 1
- Const FAP_MDS_SYSOP_TYPE% = FAP_MDS_DATE_JOINED + 1
- Const FAP_MDS_LAST_UPDATED% = FAP_MDS_SYSOP_TYPE + 1
-
- ' Modify Member Record Request Components
- Const FAP_MDM_USER_NAME% = &H1
- Const FAP_MDM_FLAGS% = &H2
- Const FAP_MDM_UPDATE_MSG_ACCESS% = &H4
- Const FAP_MDM_UPDATE_LIB_ACCESS% = &H8
- Const FAP_MDM_UPDATE_CONF_ACCESS% = &H10
- Const FAP_MDM_UPDATE_MSG_SYSOP% = &H20
- Const FAP_MDM_UPDATE_LIB_SYSOP% = &H40
- Const FAP_MDM_UPDATE_CONF_SYSOP% = &H80
- Const FAP_MDM_AUXILIARY_DATA% = &H100
-
- ' Member Directory Flags
- Const FAP_MDF_LOCK_OUT% = &H1
- Const FAP_MDF_FREE_USER% = &H20
- Const FAP_MDF_SUPPORT_PERSONNEL% = &H80
- Const FAP_MDF_KEY_ACCOUNT% = &H100
- Const FAP_MDF_WIZOP% = &H200
- Const FAP_MDF_MSG_SYSOP% = &H400
- Const FAP_MDF_CONF_SYSOP% = &H800
- Const FAP_MDF_EDIT_SYSOP% = &H1000
- Const FAP_MDF_LIB_SYSOP% = &H2000
- Const FAP_MDF_MEMBER_SYSOP% = &H4000
-
- ' Delete Members Response
- ' typedef enum FAPDELMEMBERREASON
- Const FAP_DMB_UNSPECIFIED% = 0
- Const FAP_DMB_MEMBER_NOT_FOUND% = FAP_DMB_UNSPECIFIED% + 1
- Const FAP_DMB_OPERATOR_FAILURE% = FAP_DMB_MEMBER_NOT_FOUND% + 1
- Const FAP_DMB_NOT_AUTHORISED% = FAP_DMB_OPERATOR_FAILURE% + 1
-
- ' Send Announcement Request Types of description
- ' typedef enum FAPANNOUNCTYPES
- Const FAP_SA_DESC_MSG% = 0
- Const FAP_SA_DESC_LIB% = FAP_SA_DESC_MSG + 1
- Const FAP_SA_DESC_CON% = FAP_SA_DESC_LIB + 1
- Const FAP_SA_BULLETIN% = FAP_SA_DESC_CON + 1
-
- '+-----------+
- '| Bulletins |
- '+-----------+
- ' enum FAPBULLETINS
- Const FAP_BULLETIN_SHORT% = 1
- Const FAP_BULLETIN_REGULAR% = FAP_BULLETIN_SHORT + 1
- Const FAP_BULLETIN_CONFERENCE% = FAP_BULLETIN_REGULAR + 1
- Const FAP_BULLETIN_LIBRARY% = FAP_BULLETIN_CONFERENCE + 1
- Const FAP_BULLETIN_MEMBERSHIP% = FAP_BULLETIN_LIBRARY + 1
- Const FAP_BULLETIN_SYSOP% = FAP_BULLETIN_MEMBERSHIP + 1
- Const FAP_BULLETIN_NEW_MEMBER% = FAP_BULLETIN_SYSOP + 1
- Const FAP_BULLETIN_MESSAGES% = FAP_BULLETIN_NEW_MEMBER + 1
- Const FAP_BULLETIN_LOCKED_USER% = FAP_BULLETIN_MESSAGES + 1
- Const FAP_BULLETIN_ASCII_NEW_MEMBER% = FAP_BULLETIN_LOCKED_USER + 1
- Const FAP_BULLETIN_CLOSED_FORUM_ANNOUNCE% = FAP_BULLETIN_ASCII_NEW_MEMBER + 1
-
- ' Search Types
- ' enum FAPSEARCHTYPES
- Const FAP_SFH_FILENAME% = 0
- Const FAP_SFH_USER_ID% = FAP_SFH_FILENAME + 1
- Const FAP_SFH_KEYWORD% = FAP_SFH_USER_ID + 1
- Const FAP_SFH_ACCESS_COUNT% = FAP_SFH_KEYWORD + 1
- Const FAP_SFH_DATE_RANGE% = FAP_SFH_ACCESS_COUNT + 1
- Const FAP_SFH_LAST_ACCESS_RANGE% = FAP_SFH_DATE_RANGE + 1
- Const FAP_SFH_FILE_ABSTRACT% = FAP_SFH_LAST_ACCESS_RANGE + 1
- Const FAP_SFH_FILE_BODY% = FAP_SFH_FILE_ABSTRACT + 1
- Const FAP_SFH_MATCH_NON_PUBLIC_ONLY% = FAP_SFH_FILE_BODY + 1
- Const FAP_SFH_SIZE_RANGE% = FAP_SFH_MATCH_NON_PUBLIC_ONLY + 1
- Const FAP_SFH_TITLE% = FAP_SFH_SIZE_RANGE + 1
- Const FAP_SFH_FILE_TYPES% = FAP_SFH_TITLE + 1
- Const FAP_SFH_DISPOSITION% = FAP_SFH_FILE_TYPES + 1
-
- ' File Header Components bits
- Const FAP_FDC_FILENAME% = &H1
- Const FAP_FDC_USER_ID% = &H2
- Const FAP_FDC_FILE_TYPE% = &H4
- Const FAP_FDC_FILE_SIZE% = &H8
- Const FAP_FDC_TITLE% = &H10
- Const FAP_FDC_DATE_SUBMITTED% = &H20
- Const FAP_FDC_ACCESS_COUNT% = &H40
- Const FAP_FDC_KEYS% = &H80
- Const FAP_FDC_ABSTRACT% = &H100
- Const FAP_FDC_LIB_SECTION% = &H200
- Const FAP_FDC_USER_NAME% = &H400
- Const FAP_FDC_LAST_ACCESS% = &H800
- Const FAP_FDC_PRICE% = &H1000
- Const FAP_FDC_COMMENT% = &H2000
- Const FAP_FDC_EXPIRATION_DATE% = &H4000
- Const FAP_FDC_RELEASE_DATE% = &H8000
-
- ' File Header Options
- Const FAP_FILE_DELETABLE% = &H1
- Const FAP_FILE_NON_PUBLIC% = &H2
- Const FAP_FILE_MARKED_FOR_DELETION% = &H4
- Const FAP_FILE_HAS_FEE% = &H8
-
- ' Modify File Request Components
- Const FAP_MF_FILE_NAME% = &H1&
- Const FAP_MF_USER_ID% = &H2&
- Const FAP_MF_FILE_TYPE% = &H4&
- Const FAP_MF_TITLE% = &H10&
- Const FAP_MF_ACCESS_COUNT% = &H40&
- Const FAP_MF_KEYS% = &H80&
- Const FAP_MF_ABSTRACT% = &H100&
- Const FAP_MF_LIB_SECTION_ID% = &H200&
- Const FAP_MF_SET_FEE% = &H400&
- Const FAP_MF_COMMENT% = &H800&
- Const FAP_MF_EXPIRATION_DATE% = &H1000&
- Const FAP_MF_RELEASE_DATE% = &H2000&
- Const FAP_MF_TARGET_CATALOG_NO% = &H4000&
-
- ' Modify File Request Options
- Const FAP_MO_COMMIT% = &H1
- Const FAP_MO_MAKE_CHANGES% = &H2
-
- Const HMI_FT_UNSPECIFIED% = 0
- Const HMI_FT_TEXT% = 1
- Const HMI_FT_BINARY% = 2
- Const HMI_FT_IMAGE% = 3
- Const HMI_FT_RLE% = 4
- Const HMI_FT_NAPLPS% = 5
- Const HMI_FT_GIF% = 6
- Const HMI_FT_JPEG% = 7
- Const HMI_FT_ETO% = 8
- Const HMI_FT_HTML% = 9
- Const HMI_FT_PNG% = 10
-
- Declare Function MakeDateString(s As HMITIMESTAMP) As String
- Declare Function HMIGotoForum(ByVal forum As String) As Boolean
- Declare Function UniqueFileName$
- Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean
- Declare Sub ReportSuccess(id As String)
- Declare Function StartCapture(pseudo As String)
- Declare Function SectionNumber(ByVal section As String)
- Declare Function MyDate$
- Declare Sub StartSysopLog(forum As String, msg As String)
- Declare Sub EndSysopLog()
- Declare Function FullErrorMessage() As String
- Declare Function ParseString(args As String, delim As String) As String
- Declare Function ReadMessageFile(filename As String, noformat As Integer) As String
- Declare Sub ReplaceAllInString(txt As String, search As String, replace As String)
- Declare Sub WriteLibraryMessage(forum As String, filedesc As FAPFILEDESCRIPTION, downloaded As String)
- Declare Function ParseSectionList(ByVal sect As String, ByVal validsects As Long, ByRef count As Integer) As Long
- Declare Function ParseSectionList1(ByVal sect As String, ByVal validsects As Long, ByRef count As Integer, ByRef mask As Long) As Long
- Declare Sub FetchMessageThread(id As String, forum As String, number As String, thr As Boolean)
- Declare Sub NewDownloadFile(id As String, forum As String, filename As String, pubavail As Boolean)
- Declare Sub AsciiListOfMailUsers(id as String, forum As String, TheDate as String, SendMailToUsers as String)
- Declare Sub AsciiWhoIs(id As String, forum As String, uid As String)
- Declare Sub AsciiListMembers(id As String, forum As String, list As String, info As String)
- Declare Sub GetMemberCount(id As String, forum As String)
- Declare Function Plural(l As Long) As String
-
- Public WhereAmI As String 'name of last forum/page etc
- Public FAPconfig As FAPCONFIG
- Public Sysop As Boolean 'are we a sysop?
- Public szMsgSection() As FAPSECTIONENTRY, szLibSection() As FAPSECTIONENTRY
- Public Nisa As Boolean 'do we need to work round NISA "features" ?
- Public LastNisaForum As String
-
- Dim sysopconfig As FAPSYSOPCONFIG
- Dim szFilesSections(FAP_MAX_SECTIONS%) As Long
- Dim LastAsciiForum As String
- Dim LastSectionList As String
- Dim szConfSection() As FAPSECTIONENTRY
- Dim AllMsgSects As Long, AllLibSects As Long, AllConfSects As Long
- Dim PublicMsgSects As Long, PublicLibSects As Long, PublicConfSects As Long
- Dim notime AS HMITIMESTAMP
-
- Sub LogPrint(msg As String)
- Terminal.Print msg & Basic.Eoln$
- LogResult msg
- End Sub
-
- 'Go to forum as Sysop
- 'If fails, return -1
- 'If ASCII, return 0
- 'If HMI, get sysop configuration, return 1
- Function SysopGotoForum(ByVal forum As String) As Integer
-
- ' Mangle the forum name a bit
- forum = ParseString(forum, "/")
-
- If forum = LastAsciiForum Then
- Terminal.Print "Forum " & forum & " is an ASCII forum" & Basic.Eoln$
- SysopGotoForum = 0
- Exit Function
- End If
- If Not HMIGotoForum(forum) Then
- SysopGotoForum = -1
- Exit Function
- End If
- If Sysop = 0 Then
- LogPrint "You are not SYSOP of forum " & forum
- SysopGotoForum = -1
- Exit Function
- End If
- If (FAPconfig.wAlerts And FAP_NISA_FORUM%) = 0 Then
- Terminal.Print "Forum " & forum & " is an ASCII forum" & Basic.Eoln$
- LastAsciiForum = forum
- SysopGotoForum = 0
- Exit Function
- End If
-
- If LastNisaForum <> forum Then
- FAPReadSysopConfig sysopconfig, szFilesSections(), ""
- AllMsgSects = sysopconfig.svMsgSections
- AllLibSects = sysopconfig.svLibSections
- AllConfSects = sysopconfig.svConfSections
- LogSysopConfig forum
- LastNisaForum = forum
- End If
-
- SysopGotoForum = 1
- End Function
-
- Function SectionList(ByVal sectionvector As Long) As String
- Dim s As String, i As Integer
-
- While sectionvector
- If sectionvector And 1 Then
- If s > "" Then s = s + ", "
- s = s & i
- End If
- i = i + 1
- sectionvector = sectionvector \ 2
- Wend
- SectionList = s
- End Function
-
- Sub LogSysopConfig(ByVal forum As String)
- BeginSysopLog forum, "Forum information for " & forum
- CaptureText Basic.Eoln$
- If sysopconfig.wAlerts And FAP_LIBRARIES_FULL% Then CaptureLine "Libraries full"
- If sysopconfig.wAlerts And FAP_MERGE_IS_SCHEDULED% Then CaptureLine "Merge is scheduled"
- If sysopconfig.wAlerts And FAP_MERGE_FAILED% Then CaptureLine "Merge failed"
- If sysopconfig.wAlerts And FAP_MERGE_ALLOWED% Then CaptureLine "Merge allowed"
- If sysopconfig.wAlerts And FAP_MERGE_IS_RUNNING% Then CaptureLine "Merge is running"
- If sysopconfig.wAlerts And FAP_SET_PRICES% Then CaptureLine "Set prices"
- If sysopconfig.wAlerts And FAP_MSG_SYSOP% Then CaptureLine "Message sysop"
- If sysopconfig.wAlerts And FAP_CONF_SYSOP% Then CaptureLine "Conference sysop"
- If sysopconfig.wAlerts And FAP_EDIT_SYSOP% Then CaptureLine "Edit sysop"
- If sysopconfig.wAlerts And FAP_LIB_SYSOP% Then CaptureLine "Library sysop"
- If sysopconfig.wAlerts And FAP_MEMBER_SYSOP% Then CaptureLine "Member sysop"
- If sysopconfig.wAlerts And FAP_PRIMARY_SYSOP% Then CaptureLine "Primary sysop"
- CaptureLine "Message sections: " + SectionList(AllMsgSects)
- CaptureLine "Library sections: " + SectionList(AllLibSects)
- CaptureLine "Conference sections: " + SectionList(AllConfSects)
- For i = 0 To FAP_MAX_SECTIONS%
- If szFilesSections(i) Then
- CaptureLine "Library " & i & " has " & szFilesSections(i) & _
- " non-merged file" & Plural(szFilesSections(i))
- End If
- Next
- CaptureLine "Merge time: " & MakeDateString(sysopconfig.tsMergeTime)
- CaptureLine "Membership: " & sysopconfig.dwMembership
- EndSysopLog
- End Sub
-
- Sub ExtractPublicSections(szSection() As FAPSECTIONENTRY, PublicSects As Long)
- Dim i As Integer, l As Long
-
- PublicSects = 0
- For i = 0 To Ubound(szSection)
- If (szSection(i).cFlag And FAP_SECT_PRIVATE%) = 0 Then
- l = 2 ^ szSection(i).cID
- PublicSects = PublicSects And l
- End If
- Next
- End Sub
-
- Sub SysopCollectPublicSections()
- Dim sctConf As FAPSECTIONS
-
- If LastSectionList = LastNisaForum Then Exit Sub
-
- FAPReadConfSections sctConf, szConfSection()
- ExtractPublicSections szMsgSection(), PublicMsgSects
- ExtractPublicSections szLibSection(), PublicLibSects
- ExtractPublicSections szConfSection(), PublicConfSects
- LastSectionList = LastNisaForum
- End Sub
-
- Sub BeginSysopLog(ByVal forum As String, msg As String)
- StartSysopLog forum, msg
- Terminal.Print msg & Basic.Eoln$
- End Sub
-
- Sub SysopLog (msg As String)
- CaptureText msg + Basic.Eoln$
- Terminal.Print msg & Basic.Eoln$
- LogResult msg
- End Sub
-
- 'T:HMISysopModSecSub (subroutine) (CompuServe)
- 'Changes subject and section of a message all in one go
- Sub HMISysopModSecSub(id As String, forum As String, num As String, section As String, subject As String)
- On Error Goto HMISysopModSecSub_error
-
- section = SectionNumber("/"+section)
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopModSecSub_fail
- Case 0
- If subject="" THen
- SysopModify id, forum, num, section
- Else
- SysopModSecSub id, forum, num, section, subject
- End If
- Exit Sub
- End Select
-
- subject = Left$(subject, 24)
-
- BeginSysopLog forum, "Modify section: "+forum+" thread #"+num+" to section "+section +" new subject: "+subject
-
- If FAPModifyMsg (val(num), 0, FAP_MMC_CHANGE_SECTION_ID% Or FAP_MMC_CHANGE_SUBJECT%, subject, "", "", val(section), notime) = 0 Then
- Goto HMISysopModSecSub_fail
- End If
-
- EndSysopLog
- ReportSuccess id & " : Message #" & num & " New Section #" & section & " New subject " & subject
- FetchMessageThread "", forum, num, True
- Exit Sub
-
- HMISysopModSecSub_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopModSecSub_fail:
- SysopLog "Unable to modify section: "+forum+" thread #"+num+" to section "+section +" new subject: "+subject
- EndSysopLog
- End Sub
-
- Function HMIGetThreadID(num As String) As Long
- Dim hdr As FAPMSGHEADER
-
- On Error Resume Next
- Terminal.Print "Obtaining thread ID for message " & num & Basic.Eoln$
- FAPReadMsgHeader hdr, Val(num), FAP_MC_THREAD_ID%
- HMIGetThreadID = hdr.dwThreadID
- If hdr.dwThreadID = 0 Then
- SysopLog "Cannot find message " + num
- Else
- Terminal.Print "Thread ID is " & hdr.dwThreadID & Basic.Eoln$
- End If
- End Function
-
- 'T:HMISysopHold (subroutine) (CompuServe)
- Sub HMISysopHold(id As String, forum As String, num As String, onoff As String, what As String)
- Dim cOptions As Integer, result As Integer, threadid As Long
-
- On Error Goto HMISysopHold_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopHold_fail
- Case 0
- SysopHold id, forum, num, onoff, what
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Hold/unhold: "+forum+" "+what+" #"+num+" to "+onoff
-
- Select Case onoff
- Case "ON"
- cOptions = FAP_MM_HOLD%
- Case "OFF"
- cOptions = 0
- Case Else
- SysopLog "Invalid command"
- Goto HMISysopHold_fail
- End Select
-
- Select Case what
- Case "Message"
- result = FAPModifyMsg (val(num), cOptions, 0, "", "", "", 0, notime)
- FetchMessageThread "", forum, num, False
- Case "Thread"
- 'This is probably wrong - you really need to retrieve
- 'the thread map, and do FAPModifyMessage on each message in it!
- threadid = HMIGetThreadID(num)
- If threadid = 0 Then Goto HMISysopHold_fail
- result = FAPModifyThread (threadid, cOptions, 0, "", 0, notime)
- FetchMessageThread "", forum, num, True
- Case "All"
- threadid = HMIGetThreadID(num)
- If threadid = 0 Then Goto HMISysopHold_fail
- result = FAPModifyThread (threadid, cOptions, 0, "", 0, notime)
- FetchMessageThread "", forum, num, True
- Case Else
- SysopLog "Invalid command"
- Goto HMISysopHold_fail
- End Select
-
- If result = 0 Then Goto HMISysopHold_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Hold/unhold: " & forum & " " & what & " #" & num & " to " & onoff & " "
- Exit Sub
-
- HMISysopHold_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopHold_fail:
- SysopLog "Unable to hold/unhold "+forum+" #"+num+" to "+what+" "+onoff
- EndSysopLog
- End Sub
-
- 'T:HMISysopFMB (subroutine) (CompuServe)
- Sub HMISysopFMB(id As String, forum As String, num As String, userid As String, _
- priv As String, asnew As String, subject As String, section As String)
- Dim cOption As Integer, cComponents As Integer
- Dim uname As String, uid As String
-
- On Error Goto HMISysopFMB_error
-
- section = SectionNumber("/S"+section)
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopFMB_fail
- Case 0
- SysopFMB id, forum, num, userid, priv, asnew, subject, section
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Forward message: "+forum+" #"+num+" to "+userid
-
- subject = Left$(subject, 24)
-
- cOptions = 0
- cComponents = 0
- If priv = "y" Then
- cOptions = cOptions Or FAP_MM_PRIVATE%
- SysopLog "Setting private flag"
- End If
- If asnew = "y" Then
- cOptions = cOptions Or FAP_MM_KEEP%
- SysopLog "Setting Keep flag"
- End If
- If userid > "" Then
- cComponents = cComponents Or FAP_MMC_CHANGE_RECIPIENT%
- AnalyseName userid, uname, uid
- SysopLog "Changing recipient to name: '" & uname & "' id: '" & uid & "'"
- End If
- If subject > "" Then
- cComponents = cComponents Or FAP_MMC_CHANGE_SUBJECT%
- SysopLog "Changing subject to '" & subject & "'"
- End If
- If section > "" Then
- cComponents = cComponents Or FAP_MMC_CHANGE_SECTION_ID%
- SysopLog "Changing section to " & section
- End If
-
- If FAPModifyMsg (val(num), cOptions, cComponents, subject, uname, uid, val(section), notime) = 0 Then
- Goto HMISysopFMB_fail
- End If
-
- EndSysopLog
-
- ReportSuccess id & " : Forward message " & forum & " #" & num & " to " & userid & " "
- Exit Sub
-
- HMISysopFMB_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopFMB_fail:
- SysopLog "Unable to forward message #"+num+" to "+userid
- EndSysopLog
- End Sub
-
- 'T:HMISysopFMB1 (subroutine) (CompuServe)
- Sub HMISysopFMB1(id As String, forum As String, num As String, _
- userid As String, priv As String)
- HMISysopFMB id, forum, num, userid, priv, "", "", ""
- End Sub
-
- 'T:HMISysopFMB2 (subroutine) (CompuServe)
- Sub HMISysopFMB2(id As String, forum As String, num As String, _
- userid As String, priv As String, subject As String, _
- section As String)
- HMISysopFMB id, forum, num, userid, priv, "y", subject, section
- End Sub
-
- Function ReportDeleteMsgErrors(DeleteMsgs() As FAPDELETEMSG) As Boolean
- Dim i As Integer, msg As String
-
- 'Will error accessing Ubound(DeleteMsgs) if there are no error reports
- On Error Goto ReportDeleteMsgErrors_ok
- For i = 0 To Ubound(DeleteMsgs)
- Select Case DeleteMsgs(i).nReason
- Case FAP_DM_MESSAGE_NOT_FOUND%
- msg = "not found"
- Case FAP_DM_MESSAGE_IS_HELD%
- msg = "already held"
- Case FAP_DM_INVALID_ADDRESS%
- msg = "has an invalid destination address"
- Case FAP_DM_NOT_AUTHORIZED%
- msg = "- you have no authorisation to forward this message"
- Case Else
- msg = "- unknown error"
- End Select
- SysopLog "Message " & DeleteMsgs(i).dwMsgNo & " " & msg
- Next
- ReportDeleteMsgErrors = True
- Exit Function
-
- ReportDeleteMsgErrors_ok:
- ReportDeleteMsgErrors = False
- End Function
-
- 'T:HMISysopFMA (subroutine) (CompuServe)
- Sub HMISysopFMA(id As String, forum As String, num As String, userid As String)
- Dim uname As String, uid As String
- Dim lpForwardMsgs(0 To 0) As FAPFORWARDMSGS
- Dim ReturnValue() As FAPDELETEMSG
-
- On Error Goto HMISysopFMA_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopFMA_fail
- Case 0
- SysopFMA id, forum, num, userid
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Forward by Mail: "+forum+" #"+num+" mail to "+userid
-
- lpForwardMsgs(0).dwMsgNo = val(num)
- lpForwardMsgs(0).cOptions = FAP_FM_DELETE_ORIGINAL%
- If userid > "" Then
- lpForwardMsgs(0).cOptions = lpForwardMsgs(0).cOptions Or FAP_FM_SEND_TO_DIFFERENT%
- AnalyseName userid, lpForwardMsgs(0).lpRecipientName, lpForwardMsgs(0).lpRecipientId
- SysopLog "Changing recipient to name: '" & _
- lpForwardMsgs(0).lpRecipientName & "' id: '" & _
- lpForwardMsgs(0).lpRecipientId & "'"
- End If
- FAPForwardMsgs_ ReturnValue(), lpForwardMsgs()
-
- If ReportDeleteMsgErrors(ReturnValue()) Then Goto HMISysopFMA_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Forward by Mail " & forum & " #" & num & " to " & userid & " "
- Exit Sub
-
- HMISysopFMA_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopFMA_fail:
- SysopLog "Unable to forward message #"+num+" to "+userid+" by mail"
- EndSysopLog
- End Sub
-
- 'T:HMISysopDelete (subroutine) (CompuServe)
- Sub HMISysopDelete(id As String, forum As String, num As String)
- Dim msgno(0 To 0) As Long
- Dim ReturnValue() As FAPDELETEMSG
-
- On Error Goto HMISysopDelete_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopDelete_fail
- Case 0
- SysopDelete id, forum, num
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Delete Message: "+forum+" #"+num
-
- msgno(0) = val(num)
- FAPDeleteMessages ReturnValue(), msgno()
-
- If ReportDeleteMsgErrors(ReturnValue()) Then Goto HMISysopDelete_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Message #" & num & " from " & forum & " deleted "
- Exit Sub
-
- HMISysopDelete_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopDelete_fail:
- SysopLog "Unable to delete message #"+number+" from "+forum
- EndSysopLog
- End Sub
-
- 'T:HMISysopMergeThreads (subroutine) (CompuServe)
- Sub HMISysopMergeThreads(id As String, forum As String, num As String, newthreadid as String, parentmessage as String)
- Dim threadid as Long, cOptions As Integer
- Dim Result as Integer
- Dim nthreadid as Long, nparent as Long
-
- On Error Goto HMISysopMergeThread_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopMergeThread_fail
- Case 0
- SysopLog "Unable to Merge Threads in ASCII forum: "+forum
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Merge Message " & forum & " #" & num & " to thread " & newthreadid
-
- threadid = HMIGetThreadID(num)
- if threadid = 0 Then Goto HMISysopMergeThread_fail
- cOptions = 0
- nthreadid = val(newthreadid)
- nparent = val(parentmessage)
-
- if nparent then cOptions = FAP_MS_MERGE_AS_REPLY
-
- Result = FAPMergeThreads(cOptions,nthreadid,threadid,nparent)
- If Result = 0 Then Goto HMISysopMergeThread_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Message #" & num & " in " & forum & " merged to thread " & newthreadid & " message# " & parentmessage
- FetchMessageThread "", forum, num, True
- Exit Sub
-
- HMISysopMergeThread_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopMergeThread_fail:
- SysopLog "Unable to Merge message #" & num & " in " & forum & " to thread " & newthreadid & " message #" & parentmessage
- EndSysopLog
- End Sub
-
-
-
- 'Add and remove sections from the default (public) section list supplied
- 'according to string typed in by user
- Function AmendSectionList(ByVal sections As Long, validsects As long, _
- addsect As String) As Long
- Dim l As Long, count as Integer
- Dim mask as Long
-
- l = ParseSectionList1(addsect, validsects, count, mask)
- sections = sections Or l
- sections = sections And Not mask
- sections = sections And validsects
- AmendSectionList = sections
- End Function
-
- Function HMIGetMemberInfo(member As FAPMDENTRY, uid As String, _
- cComponents As Integer) As Boolean
- Dim memberdir() AS FAPMDENTRY
- Dim lpSearchTerm(0 To 0) As FAPSEARCHTERM
- Dim totcount As long
-
- lpSearchTerm(0).cType = FAP_MDS_USER_ID%
- lpSearchTerm(0).lpPattern = uid
- totcount = 1
- Terminal.Print "Searching for member details for " & uid & Basic.Eoln$
- FAPMDSearch memberdir(), HMI_STATE_FIRST%, 1, cComponents, _
- lpSearchTerm(), totcount
- If totcount <> 1 Then
- SysopLog "Member " & uid & " not found"
- HMIGetMemberInfo = False
- Exit Function
- Else
- Terminal.Print "Member details found" & Basic.Eoln$
- End If
- HMIGetMemberInfo = True
- member = memberdir(0)
- End Function
-
- Function HMIDoMemberAmendments(member() As FAPMODIFYMEMBER, _
- user As String, flgs As String, aux As String, _
- syssct as String, syslib as String, sysco as String) As Boolean
- Dim ReturnValue() As FAPDELETEMEMBER
-
- If user > "" Then
- member(0).lpName = user
- member(0).wComponents = member(0).wComponents Or FAP_MDM_USER_NAME%
- End If
- If flgs > "" Then
- Dim i As Integer
-
- For i = 1 To Len(flgs)
- Select Case Ucase$(Mid$(flgs, i, 1))
- Case "B"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_MSG_SYSOP%
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_MSG_SYSOP%
- member(0).svSysOpMsgSections = AmendSectionList(member(0).svSysOpMsgSections, AllMsgSects, syssct)
- Case "C"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_CONF_SYSOP%
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_CONF_SYSOP%
- member(0).svSysOpConfSections = AmendSectionList(member(0).svSysOpConfSections, AllConfSects, sysco)
- Case "D"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_LIB_SYSOP%
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_LIB_SYSOP%
- member(0).svSysOpLibSections = AmendSectionList(member(0).svSysOpLibSections, AllLibSects, syslib)
- Case "E"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_EDIT_SYSOP%
- Case "F"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_FREE_USER%
- Case "L"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_LOCK_OUT%
- Case "M"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_MEMBER_SYSOP%
- Case "W"
- member(0).wFlags = member(0).wFlags Or FAP_MDF_WIZOP%
- Case "Z"
- member(0).wFlags = 0
- Case Else
- SysopLog "Unrecognised flag character '" & Mid$(flgs, i, 1) & "' ignored"
- End Select
- Next
- member(0).wComponents = member(0).wComponents Or FAP_MDM_FLAGS%
- End If
- If aux > "" Then
- member(0).lpAuxiliary = aux
- member(0).wComponents = member(0).wComponents Or FAP_MDM_AUXILIARY_DATA%
- End If
-
- If member(0).wComponents And FAP_MDM_FLAGS% then
- If (Not member(0).wFlags) And FAP_MDF_MSG_SYSOP% Then
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_MSG_SYSOP%
- member(0).svSysOpMsgSections = 0
- End If
- If (Not member(0).wFlags) And FAP_MDF_CONF_SYSOP% Then
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_CONF_SYSOP%
- member(0).svSysOpConfSections = 0
- End If
- If (Not member(0).wFlags) And FAP_MDF_LIB_SYSOP% Then
- member(0).wComponents = member(0).wComponents Or FAP_MDM_UPDATE_LIB_SYSOP%
- member(0).svSysOpLibSections = 0
- End If
- If member(0).svSysOpMsgSections=0 Then member(0).wFlags = member(0).wFlags And Not FAP_MDF_MSG_SYSOP%
- If member(0).svSysOpConfSections=0 Then member(0).wFlags = member(0).wFlags And Not FAP_MDF_CONF_SYSOP%
- If member(0).svSysOpLibSections=0 Then member(0).wFlags = member(0).wFlags And Not FAP_MDF_LIB_SYSOP%
- End If
- Terminal.Print "Updating details for member " & member(0).lpUserId & Basic.Eoln$
- FAPModifyMembers ReturnValue(), member()
- On Error Goto HMIDoMemberAmendments_ok
- 'Will get an error if there were no problems, because ReturnValue is empty
- SysopLog ReturnValue(0).lpReason
- HMIDoMemberAmendments = False
- Exit Function
-
- HMIDoMemberAmendments_ok:
- Terminal.Print "Details updated" & Basic.Eoln$
- HMIDoMemberAmendments = True
- End Function
-
- 'T:HMIAddMember (subroutine) (CompuServe)
- ' Go to forum sysop area and add member
- Sub HMIAddMember(id As String, forum As String, uid As String, user as String, _
- aux As String, flgs As String, addsct As String, _
- remsct As String, addlib As String, remlib As String, _
- addco As String, remco As String)
-
- Dim lpUserIds(0 To 0) As String
- Dim msgsect As Long, libsect As Long, confsect As Long
- Dim i As Integer
- Dim member(0 To 0) As FAPMODIFYMEMBER
-
- On Error Goto HMIAddMember_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMIAddMember_fail
- Case 0
- AddMember id, forum, uid, user, aux, flgs, addsct, remsct, _
- addlib, remlib, addco, remco
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Add Member "+uid+" "+user+" to forum "+forum
-
- lpUserIds(0) = uid
- 'Now work out what secstions the new member should be in
- SysopCollectPublicSections
- msgsect = AmendSectionList(PublicMsgSects, AllMsgSects, addsct)
- libsect = AmendSectionList(PublicLibSects, AllLibSects, addlib)
- confsect = AmendSectionList(PublicConfSects, AllConfSects, addco)
-
- i = FAPAddMembers(msgsect, libsect, confsect, lpUserIds())
- 'Ignore return value, in case that uid is already a member
-
- member(0).wComponents = FAP_MDM_UPDATE_MSG_ACCESS% Or FAP_MDM_UPDATE_LIB_ACCESS% Or FAP_MDM_UPDATE_CONF_ACCESS%
- member(0).lpUserId = uid
- member(0).svMsgSections = msgsect
- member(0).svLibSections = libsect
- member(0).svConfSections = confsect
- If HMIDoMemberAmendments(member(), user, flgs, aux, remsct, remlib, remco) = 0 Then Goto HMIAddMember_fail
-
- EndSysopLog
-
- ReportSuccess id & " : " & user & " [" & uid & "] added to " & forum
- Exit Sub
-
- HMIAddMember_error:
- SysopLog "Error:" & FullErrorMessage
- HMIAddMember_fail:
- SysopLog "Unable to add user " + uid + " " + user + " to forum " + forum
- EndSysopLog
- End Sub
-
- 'T:HMIEditMember (subroutine) (CompuServe)
- ' Go to forum sysop area and edit member
- Sub HMIEditMember(id As String, forum As String, uid As String, user as String, _
- aux As String, flgs As String, addsct As String, _
- remsct As String, addlib As String, remlib As String, _
- addco As String, remco As String)
- Dim lpUserIds(0 To 0) As String
- Dim member(0 To 0) As FAPMODIFYMEMBER
- Dim cComponents As Integer
-
- On Error Goto HMIEditMember_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMIEditMember_fail
- Case 0
- EditMember id, forum, uid, user, aux, flgs, addsct, remsct, _
- addlib, remlib, addco, remco
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Edit Member "+uid+" "+user+" in forum "+forum
-
- lpUserIds(0) = uid
-
- cComponents = FAP_MDC_USER_NAME% or FAP_MDC_FLAGS% ' work around HMI problems
-
- If remsct > "" And InStr(Ucase$(flgs),"B")=0 Then flgs = flgs & "B"
- If remco > "" And InStr(Ucase$(flgs),"C")=0 Then flgs = flgs & "C"
- If remlib > "" And InStr(Ucase$(flgs),"D")=0 Then flgs = flgs & "D"
-
- If addsct > "" Or addco > "" Or addlib > "" Then cComponents = cComponents Or FAP_MDC_SECTIONS%
-
- If cComponents <> 0 Then
- 'Must find out some current information for this member
- Dim memberdir AS FAPMDENTRY
-
- If Not HMIGetMemberInfo(memberdir, uid, cComponents) Then Goto HMIEditMember_fail
- member(0).wFlags = memberdir.wFlags
- member(0).svSysOpMsgSections = memberdir.svSysOpMsgSections
- member(0).svSysOpConfSections = memberdir.svSysOpConfSections
- member(0).svSysOpLibSections = memberdir.svSysOpLibSections
- member(0).lpName=memberdir.lpName
-
- member(0).wComponents = FAP_MDM_USER_NAME% or FAP_MDM_FLAGS%
-
- SysopCollectPublicSections
-
- If cComponents And FAP_MDC_SECTIONS% Then
- member(0).wComponents = member(0).wComponents or FAP_MDM_UPDATE_MSG_ACCESS% Or FAP_MDM_UPDATE_LIB_ACCESS% Or FAP_MDM_UPDATE_CONF_ACCESS%
- member(0).svMsgSections = AmendSectionList(memberdir.svMsgSections, AllMsgSects, addsct)
- member(0).svLibSections = AmendSectionList(memberdir.svLibSections, AllLibSects, addlib)
- member(0).svConfSections = AmendSectionList(memberdir.svConfSections, AllConfSects, addco)
- End If
- End If
-
- member(0).lpUserId = uid
-
- If Not HMIDoMemberAmendments(member(), user, flgs, aux, remsct, remlib, remco) Then Goto HMIEditMember_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Member privileges for " & user & " [" & uid & "] on " & forum & " changed"
- Exit Sub
-
- HMIEditMember_error:
- SysopLog "Error:" & FullErrorMessage
- HMIEditMember_fail:
- SysopLog "Unable to edit user " + uid + " " + user + " to forum " + forum
- EndSysopLog
- End Sub
-
- 'T:HMIUploadAnnouncements (subroutine) (CompuServe)
- ' Go to forum sysop area and upload annoucements
- Sub HMIUploadAnnouncements(id As String, forum As String, ann As String, _
- filename as String, resetfl As String)
- Dim body As String, block As String
- Dim BulletinType As Integer
- Dim ofs As Long
-
- On Error Goto HMIUploadAnnouncements_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMIUploadAnnouncements_fail
- Case 0
- UploadAnnouncements id, forum, ann, filename, resetfl
- Exit Sub
- End Select
-
- BeginSysopLog forum, "Upload announcement " & ann & " for forum " & forum
-
- Select Case Val(ann)
- Case 1
- BulletinType = FAP_BULLETIN_SHORT%
- Case 2
- BulletinType = FAP_BULLETIN_REGULAR%
- Case 3
- BulletinType = FAP_BULLETIN_MEMBERSHIP%
- Case 4
- BulletinType = FAP_BULLETIN_LOCKED_USER%
- Case 5
- BulletinType = FAP_BULLETIN_ASCII_NEW_MEMBER%
- Case 6
- BulletinType = FAP_BULLETIN_NEW_MEMBER%
- Case 7
- BulletinType = FAP_BULLETIN_CONFERENCE%
- Case 8
- BulletinType = FAP_BULLETIN_LIBRARY%
- Case 9
- BulletinType = FAP_BULLETIN_MESSAGES%
- Case 10
- BulletinType = FAP_BULLETIN_SYSOP%
- End Select
-
- body = ReadMessageFile(filename, 2)
- if len(body)>0 then
- ReplaceAllInString body, "%DATE%", MyDate$
- block = Mid$(body, 1, 1024)
- ofs = 1025
- If FAPSendAnnouncement(HMI_STATE_FIRST%, FAP_SA_BULLETIN%, _
- BulletinType, 0, block) = 0 Then Goto HMIUploadAnnouncements_fail
- Do
- block = Mid$(body, ofs, 1024)
- ofs = ofs + 1024
- If FAPSendAnnouncement(HMI_STATE_NEXT%, FAP_SA_BULLETIN%, _
- BulletinType, 0, block) = 0 Then Goto HMIUploadAnnouncements_fail
- Loop Until block=""
- else
- SysopLog "Error: Could not read announcement file"
- goto HMIUploadAnnouncements_fail
- end if
- EndSysopLog
-
- ReportSuccess id & " : Announcement " & ann & " for forum " & forum & " uploaded "
- Exit Sub
-
- HMIUploadAnnouncements_error:
- SysopLog "Error:" & FullErrorMessage
- HMIUploadAnnouncements_fail:
- SysopLog "Unable to upload announcement " & ann & " for forum " & forum
- EndSysopLog
- End Sub
-
- Sub HMIForumReports(sId As String, sForum As String, repno As Integer)
- Dim sMsgStatFile As String
- Dim ReportHeader As FAPRPTCONFIG, Report() As FAPREPORT
- Dim i As Integer
- Dim title As String, body As String
-
- On Error Goto HMIForumReports_error
-
- If SysopGotoForum(sForum) <> 1 Then Goto HMIForumReports_fail
-
- Terminal.Print "Collecting forum reports for "+sForum & Basic.Eoln$
-
- FAPReportConfig ReportHeader, Report()
-
- ' Start text capture
- sMsgStatFile = UniqueFileName$()
- Capture CAPTURE_ON, sMsgStatFile
- CaptureLine "#pragma ciscontrol=yes;markunread=no;deleteexisting=no"
-
- For i = 0 To UBound(Report)
- if (i=repno) or (repno<0) then
- CaptureLine "!start " & sForum & "/Forum_Reports CompuServe"
- CaptureLine Report(i).lpTitle
- CaptureText Basic.Eoln$
-
- body = FAPReportRead (HMI_STATE_FIRST, Report(i).cReportNo, "", i, 2048)
- While body > ""
- CaptureLines body
- body = FAPReportRead (HMI_STATE_NEXT, Report(i).cReportNo, "", i, 2048)
- Wend
- CaptureLine "!end"
- end if
- Next
-
- ' Stop text capture
- CaptureText "!end" & Basic.Eoln$
- Capture CAPTURE_OFF
-
- ' Now add OutputFile to import queue
- i = QueueFile(Session.Service, sMsgStatFile, IM_SPECIAL or IM_DELETE)
-
- ReportSuccess sId & " : Message stats collection for " & sForum & " "
- Exit Sub
-
- HMIForumReports_error:
- LogResult "Error:" & FullErrorMessage
- HMIForumReports_fail:
- LogPrint "Unable to get forum reports for "+sForum
- End Sub
-
- Sub HMIAllForumReports(sId As String, sForum As String)
- HMIForumReports sId, sForum, -1
- end Sub
-
- Sub HMIForumReportsWelcome(sId As String, sForum As String)
- HMIForumReports sId, sForum, 0
- End Sub
-
- Sub HMIForumReportsMessStat(sId As String, sForum As String)
- HMIForumReports sId, sForum, 1
- End Sub
-
- Sub HMIForumReportsMessSize(sId As String, sForum As String)
- HMIForumReports sId, sForum, 2
- End Sub
-
- Sub HMIForumReportsLibActivity(sId As String, sForum As String)
- HMIForumReports sId, sForum, 3
- End Sub
-
- Sub HMIForumReportsLibStat(sId As String, sForum As String)
- HMIForumReports sId, sForum, 4
- End Sub
-
- Sub HMIForumReportsMemStat(sId As String, sForum As String)
- HMIForumReports sId, sForum, 5
- End Sub
-
- Function GetMessageNo(d As Date)
- Dim tsTime As HMITIMESTAMP, msg As Long
-
- ' Note - this function does not correct for the fact that CIS probably
- ' holds all times in EST!
- tsTime.cSeconds = 0
- tsTime.cMinutes = 0
- tsTime.cHour = 0
- tsTime.cDay = Day(d)
- tsTime.cMonth = Month(d)
- tsTime.cYear = Year(d) - 1970
- msg = FAPSearchDate(&H00FFFFFF, tsTime) ' Don't pass AllMsgSects since
- ' that causes HMI a problem
- Terminal.Print "First message posted after " & MakeDateString(tsTime)
- Terminal.Print " is #" & msg & Basic.Eoln$
- CaptureText "First message posted after " & MakeDateString(tsTime)
- CaptureText " is #" & msg & Basic.Eoln$
- If msg > FAPconfig.dwNewestMsg Then
- msg = FAPconfig.dwNewestMsg
- End If
- GetMessageNo = msg
- End Function
-
- Sub CalcStatTotals(stat As MsgStatSummary, msgcount() As FAPMSGCOUNT, flag As Boolean, msgc0() As FAPMSGCOUNT)
- Dim i As Integer, j As Integer, k As Integer
-
- stat.element = 0
- stat.ttotal = 0
- stat.mtotal = 0
- On Error Resume Next
- For i = 0 to Ubound(msgcount)
- stat.ttotal = stat.ttotal + msgcount(i).wNewThreads
- if flag then
- k = -1
- for j=0 to Ubound(msgc0)
- if msgcount(i).cMsgSection=msgc0(j).cMsgSection then k=j
- next
- if (k>=0) then msgcount(i).wNewMsgs = msgcount(i).wNewMsgs - msgc0(k).wNewMsgs
- end if
- stat.mtotal = stat.mtotal + msgcount(i).wNewMsgs
- Next
- End Sub
-
- Sub CalcStatPercentages(stat As MsgStatSummary, msgcount() As FAPMSGCOUNT, sect As Integer)
- Dim i,j as Integer
-
- stat.threads = 0
- stat.messages = 0
- stat.percentage = 0
- On Error Resume Next 'If beyond array bounds return all zeroes
- i=-1
- for j=0 to ubound(msgcount)
- if sect=msgcount(j).cMsgSection then i=j
- next
- if i>=0 then stat.element=i
- If sect = msgcount(stat.element).cMsgSection Then
- stat.threads = msgcount(stat.element).wNewThreads
- stat.messages = msgcount(stat.element).wNewMsgs
- If stat.mtotal <> 0 Then stat.percentage = 100 * stat.messages / stat.mtotal
- stat.element = stat.element + 1
- End If
- End Sub
-
- Function RFormat$(n, fmt As String)
- RFormat$ = Right$(Space$(Len(fmt)) & Format$(n, fmt), Len(fmt))
- End Function
-
- Sub HMIForumStats(sId As String, sForum As String)
- Dim sMsgStatFile As String, buf As String
- Dim d As Date, n As Date
- Dim msg As Long
- Dim msgcount0() As FAPMSGCOUNT
- Dim msgcount1() As FAPMSGCOUNT
- Dim msgcount7() As FAPMSGCOUNT
- Dim stat0 As MsgStatSummary, stat1 As MsgStatSummary, stat7 As MsgStatSummary
- Dim i As Integer, sect As Integer
-
- On Error Goto HMIForumStats_error
-
- If Not HMIGotoForum(sForum) Then
- Exit Sub
- End If
-
- Terminal.Print "Collecting message stats for "+sForum & Basic.Eoln$
-
- n = Now()
- ' Start text capture
- sMsgStatFile = UniqueFileName$()
- Capture CAPTURE_ON, sMsgStatFile
- CaptureText Basic.Eoln$ + "!end" + Basic.Eoln$
-
- CaptureLine "!start " & sForum & "/Statistics CompuServe"
- CaptureLine "Message Stats at " & Format$(n,"dd-mmm-yy hh:mm:ss")
- CaptureText Basic.Eoln$
-
- CaptureText "Current message is #" & FAPconfig.dwNewestMsg & Basic.Eoln$
-
-
- terminal.print "Getting message counts - today" & Basic.Eoln$
- d = DateAdd("d", 0, n)
- msg = GetMessageNo(d)
- FAPGetMsgCounts msgcount0(), &H00FFFFFF, msg
- CalcStatTotals stat0, msgcount0(), 0, msgcount0()
-
- d = DateAdd("d", -1, n)
- msg = GetMessageNo(d)
- Terminal.Print "Getting message counts - 1 day" & Basic.Eoln$
- FAPGetMsgCounts msgcount1(), &H00FFFFFF, msg
- CalcStatTotals stat1, msgcount1(), 1, msgcount0()
- d = DateAdd("d", -7, n)
- msg = GetMessageNo(d)
- Terminal.Print "Getting message counts - 7 days" & Basic.Eoln$
- FAPGetMsgCounts msgcount7(), &H00FFFFFF, msg
- CalcStatTotals stat7, msgcount7(), 1, msgcount0()
-
- CaptureLine " 1-Day 7-Day"
- CaptureLine "----- Section ----------- Subs / Msgs ------------ Subs / Msgs ---------"
- For i = 0 To Ubound(szMsgSection)
- sect = szMsgSection(i).cId
- CalcStatPercentages stat1, msgcount1(), sect
- CalcStatPercentages stat7, msgcount7(), sect
- CaptureText RFormat$(sect, "#0") & " "
- buf = szMsgSection(i).lpTitle
- ReplaceAllInString buf, "_", " "
- CaptureText Left$(buf + Space$(22), 22)
- CaptureText RFormat$(stat1.threads, "####0") & " /"
- CaptureText RFormat$(stat1.messages, "####0") & " ("
- CaptureText RFormat$(stat1.percentage, "##0.00") & "%) "
- CaptureText RFormat$(stat7.threads, "####0") & " /"
- CaptureText RFormat$(stat7.messages, "####0") & " ("
- CaptureText RFormat$(stat7.percentage, "##0.00") & "%)" & Basic.Eoln$
- Next
- CaptureLine "------------------------------------------------------------------------"
- CaptureText " Totals: "
- CaptureText RFormat$(stat1.ttotal, "####0") & " /"
- CaptureText RFormat$(stat1.mtotal, "####0") & " "
- CaptureText RFormat$(stat7.ttotal, "####0") & " /"
- CaptureText RFormat$(stat7.mtotal, "####0") & Basic.Eoln$
- CaptureLine "!end"
-
- ' Stop text capture
- Capture CAPTURE_OFF
-
- ' Now add OutputFile to import queue
- i = QueueFile(Session.Service, sMsgStatFile, IM_SPECIAL or IM_DELETE)
-
- ReportSuccess sId & " : Message stats collection for " & sForum & " "
- Exit Sub
-
- HMIForumStats_error:
- LogResult "Error:" & FullErrorMessage
- HMIForumStats_fail:
- LogPrint "Unable to get message stats for "+sForum
- End Sub
-
- Function SearchForFile(sect As String, fname As String, pub As Integer) As Long
- Dim fdesc() As FAPFILEDESCRIPTION, fterm() As FAPSEARCHTERM
-
- ' Scan library for the file
- SearchForFile = 0
- On Error Resume Next
- Terminal.Print "Searching for "
- If pub = 0 Then
- ReDim fterm(0 to 1)
- fterm(1).cType = FAP_SFH_MATCH_NON_PUBLIC_ONLY
- Terminal.Print "unmerged "
- Else
- ReDim fterm(0 to 0)
- End If
- Terminal.Print "file " & fname & " in section " & sect & Basic.Eoln$
- fterm(0).cType = FAP_SFH_FILENAME
- fterm(0).lpPattern = fname
- FAPSearchFile fdesc(), HMI_STATE_FIRST%, 1, 1, 2 ^ Val(sect), _
- FAP_FDC_FILENAME%, fterm()
-
- SearchForFile = fdesc(0).dwCatalogNo 'Will cause error if fdesc array empty
- End Function
-
- 'T:HMISysopRelease (subroutine) (CompuServe)
- Sub HMISysopRelease(id As String, forum As String, fname As String)
- Dim sect As String, catno As Long
-
- On Error Goto HMISysopRelease_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopRelease_fail
- Case 0
- SysopRelease id, forum, fname
- Exit Sub
- End Select
-
- sect = SectionNumber(forum)
-
- BeginSysopLog forum, "Release and Merge: "+forum+" section "+sect+" file: "+fname
-
- ' Scan library for the file
- catno = SearchForFile(sect, fname, 0)
- If catno = 0 Then
- SysopLog "File "+fname+" not found in "+forum
- Goto HMISysopRelease_fail
- End If
-
- On Error Goto HMISysopRelease_error
-
- Terminal.Print "Releasing file, catalog no. " & catno & Basic.Eoln$
- If FAPModifyFile (catno, 0, FAP_MO_COMMIT% , "", "", 0, "", 0, "", "", 0, _
- "", "", notime, notime, 0) = 0 Then Goto HMISysopRelease_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Released and Merged " & forum & " file: " & fname
- Exit Sub
-
- HMISysopRelease_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopRelease_fail:
- SysopLog "Unable to release "+fname+" in "+forum
- EndSysopLog
- End Sub
-
- 'T:HMISysopRelMerge (subroutine) (CompuServe)
- Sub HMISysopRelMerge(id As String, forum As String, fname As String)
- Dim sect As String, catno As Long
-
- On Error Goto HMISysopRelMerge_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopRelMerge_fail
- Case 0
- SysopRelMerge id, forum, fname
- Exit Sub
- End Select
-
- HMISysopRelease id, forum, fname
- Exit Sub
-
- HMISysopRelMerge_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopRelMerge_fail:
- SysopLog "Unable to release "+fname+" in "+forum
- EndSysopLog
- End Sub
-
-
- 'T:HMISysopDownload (subroutine) (CompuServe)
- Sub HMISysopDownload(id As String, forum As String, fname As String)
- Select Case SysopGotoForum(forum)
- Case -1
- SysopLog "Unable to download unreleased "+fname+" in "+forum
- EndSysopLog
- Exit Sub
- Case 0
- SysopDownload id, forum, fname
- Exit Sub
- End Select
-
- NewDownloadFile id, forum, fname, False
- End Sub
-
- 'T:HMISysopErase (subroutine) (CompuServe)
- Sub HMISysopErase(id As String, forum As String, fname As String)
- Dim sect As String, catno(0 To 0) As Long
- Dim fdel() As FAPDELETEFILE
-
- On Error Goto HMISysopErase_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopErase_fail
- Case 0
- SysopErase id, forum, fname
- Exit Sub
- End Select
-
- sect = SectionNumber(forum)
-
- BeginSysopLog forum, "Erase in: "+forum+" section "+sect+" file: "+fname
-
- ' Scan library for the file
- On Error Goto HMISysopErase_error
-
- catno(0) = SearchForFile(sect, fname, 1)
- if catno(0) = 0 Then
- catno(0) = SearchForFile(sect, fname, 0)
- If catno(0) = 0 Then
- SysopLog "File "+fname+" not found in "+forum
- Goto HMISysopErase_fail
- else
- Terminal.Print "Erasing file, catalog no. " & catno(0) & Basic.Eoln$
- FAPDeleteFiles_ fdel(), catno()
- End If
- Else
- Terminal.Print "Marking file as erased, catalog no. " & catno(0) & Basic.Eoln$
- FAPDeleteFiles_ fdel(), catno()
- End If
-
-
- EndSysopLog
-
- ReportSuccess id & " : Erased " & forum & " file: " & fname
- Exit Sub
-
- HMISysopErase_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopErase_fail:
- SysopLog "Unable to erase "+fname+" in "+forum
- EndSysopLog
- End Sub
-
- Function GetSectionSearchVector(info As String) As String
- Dim t As long, i As Integer, sectionvector As Long
- Dim lpPattern As String
-
- sectionvector = ParseSectionList(info,&H00FFFFFF, i)
- lpPattern = ""
- t = 1
- For i = 0 to 23
- If sectionvector And t Then
- lpPattern = lpPattern & "1"
- Else
- lpPattern = lpPattern & "0"
- End If
- t = t + t
- Next
- GetSectionSearchVector=lpPattern
- End Function
-
- Sub HMISysopLibrary(id As String, forum As String, section As String)
- Dim fname As String, i As Integer, t As String
- Dim tforum As String, count As Long
- Dim filedesc() As FAPFILEDESCRIPTION
- Dim searchterm(0 to 1) As FAPSEARCHTERM
- Dim searchflags As Long, sectionvector As Long, ok As Boolean
-
- Select Case SysopGotoForum(forum)
- Case -1
- LogPrint "Error downloading unmerged files list from forum "+forum
- Exit Sub
- Case 0
- SysopLibrary id, forum, section
- Exit Sub
- End Select
-
- tforum = forum
- tforum = ParseString(tforum, "/")
-
- ' Set which bits of info we want
- searchflags = &H6FF + FAP_FDC_ABSTRACT%
- ok = True
-
- ' Scan library for the files
- fname = UniqueFilename$()
- count = 0
- Capture CAPTURE_ON, fname
- CaptureText Basic.Eoln$+"#pragma ciscontrol=yes;markunread=yes;deleteexisting=no"+Basic.Eoln$
- Terminal.Print "Collecting unmerged files list from section(s) " + LTrim$(section) + Basic.Eoln$
-
- searchterm(0).cType = FAP_SFH_FILENAME%
- searchterm(0).lpPattern = "*.*"
- searchterm(1).cType = FAP_SFH_MATCH_NON_PUBLIC_ONLY
-
- ' Select section to search
- sectionvector = ParseSectionList(section, FAPconfig.svLibSections, i)
-
- Terminal.CaptureStatus CAPTURE_ON
- On Error Goto EndOfLibrary
- FAPSearchFile filedesc(), 0, 1, 1, sectionvector, searchflags, searchterm()
- Do While filedesc(0).dwCatalogNo > 0
- count = count + 1
- Terminal.CaptureStatus count
-
- WriteLibraryMessage tforum, filedesc(0), ""
-
- FAPSearchFile filedesc(), 1, 1, 1, sectionvector, searchflags, searchterm()
- Loop
- Terminal.Print "Collected "+LTrim$(Str(count))+" unmerged files" + Basic.Eoln$
- EndOfLibrary:
- If Err<>9 Then
- LogResult "Error " & FullErrorMessage
- LogResult "Error while downloading unmerged files list from "+forum
- ok = False
- End If
- On Error Goto 0
- Terminal.CaptureStatus CAPTURE_OFF
- Capture CAPTURE_OFF
-
- ' Add to import queue
- If count > 0 Then
- b = QueueFile(Session.Service, fname, IM_DELETE Or IM_MARKUNREAD)
- Else
- DeleteFile fname
- End If
-
- If ok Then ReportSuccess id & " : Downloaded unmerged files list from " & forum
- End Sub
-
- Sub HMISysopModifyFile(id As String, forum As String, fname As String, _
- newfname As String, ftype As String, subj As String, keys As String, _
- userid As String, sysopcomment As String, accesscount As String, _
- newlib As String, msgfile As String)
- Dim sect As String, catno As Long, ft As Integer, c As Long
- Dim abstract As String, options As Integer
-
- On Error Goto HMISysopModifyFile_error
-
- Select Case SysopGotoForum(forum)
- Case -1
- Goto HMISysopModifyFile_fail
- Case 0
- SysopModifyFile id, forum, fname, newfname, ftype, subj, keys, userid, sysopcomment, accesscount, msgfile
- Exit Sub
- End Select
-
- sect = SectionNumber(forum)
- BeginSysopLog forum, "Modify File: "+forum+" section "+sect+" file: "+fname
-
- ' Scan library/preview for the file
- catno = SearchForFile(sect, fname, 0) ' preview
- If catno=0 Then catno = SearchForFile(sect, fname, 1) ' public
- If catno = 0 Then
- SysopLog "File "+fname+" not found in "+forum
- Goto HMISysopModifyFile_fail
- End If
-
- On Error Goto HMISysopModifyFile_error
-
- ' Build list of what we're modifying
- c = 0
-
- If newfname<>"" Then c = c Or FAP_MF_FILE_NAME%
-
- ftype = UCase$(ftype)
- ft = 0
- If ftype="ASCII" Then ft = HMI_FT_TEXT%
- If ftype="BINARY" Then ft = HMI_FT_BINARY%
- If ftype="IMAGE" Then ft = HMI_FT_IMAGE%
- If ftype="GRAPHIC:RLE" Then ft = HMI_FT_RLE%
- If ftype="GRAPHIC:NAPLPS" Then ft = HMI_FT_NAPLPS%
- If ftype="GRAPHIC:GIF" Then ft = HMI_FT_GIF%
- If ftype="GRAPHIC:JPEG" Then ft = HMI_FT_JPEG%
- If ftype="GRAPHIC:PNG" Then ft = HMI_FT_PNG%
- If ft<>0 Then c = c Or FAP_MF_FILE_TYPE%
-
- If subj<>"" Then c = c Or FAP_MF_TITLE%
- If keys<>"" Then c = c Or FAP_MF_KEYS%
- If userid<>"" Then c = c Or FAP_MF_USER_ID%
- If sysopcomment<>"" Then c = c Or FAP_MF_COMMENT%
- If accesscount<>"" Then c = c Or FAP_MF_ACCESS_COUNT%
- abstract = ReadMessageFile(msgfile, 2)
- If abstract<>"" Then c = c Or FAP_MF_ABSTRACT%
- If UCase$(newlib)="PENDING" Then
- options = FAP_MO_MAKE_CHANGES% ' Move to pending area
- newlib = ""
- Else
- options = FAP_MO_MAKE_CHANGES% ' Make live
- End If
- If newlib<>"" Then
- c = c Or FAP_MF_LIB_SECTION_ID%
- If Not IsNumeric(Mid$(newlib, 1, 1)) Then newlib = SectionNumber("/"+newlib)
- End If
-
- Terminal.Print "Modifying file, catalog no. " & catno & Basic.Eoln$
- If FAPModifyFile (catno, c, options, newfname, userid, ft, subj, _
- Val(accesscount), keys, abstract, Val(newlib), "", sysopcomment, _
- notime, notime, 0) = 0 Then Goto HMISysopModifyFile_fail
-
- EndSysopLog
-
- ReportSuccess id & " : Modified " & forum & " file: " & fname
- Exit Sub
-
- HMISysopModifyFile_error:
- SysopLog "Error:" & FullErrorMessage
- HMISysopModifyFile_fail:
- SysopLog "Unable to modify "+fname+" in "+forum
- EndSysopLog
- End Sub
-
- 'T:ListOfMailUsers (subroutine) (CompuServe)
- Sub ListOfMailUsers(id as String, forum As String, TheDate as String, SendMailToUsers as String)
- Dim searchterm(0 To 0) As FAPSEARCHTERM
- Dim members() As FAPMDENTRY
- Dim fname As String, errmsg As String, BSCFile As String
- Dim count As Integer, i As Integer, cComp As Integer
- Dim retcount As Long
- Dim ok As Boolean
-
- If Not HMIGotoForum(forum) Then
- Exit Sub
- End If
-
- If (FAPconfig.wAlerts And FAP_NISA_FORUM%) = 0 Then
- AsciiListOfMailUsers id, forum, TheDate, SendMailToUsers
- Exit Sub
- End If
-
- Terminal.Print "Listing members joined since " & TheDate & Basic.Eoln$
-
- fname = UniqueFilename$()
- count = 0
- Capture CAPTURE_ON, fname
- CaptureLine "#pragma ciscontrol=no;deleteexisting=no"
- CaptureLine "!start " & forum & "/Membership New_Joiners"
- CaptureLine "People who have joined the forum since " + TheDate
- CaptureLine ""
-
- ' Convert Date (mm-dd-yy -> yymmdd)
- TheDate = Mid$(TheDate, 7, 2)+Mid$(TheDate, 1, 2)+Mid$(TheDate, 4, 2)
- cComp = FAP_MDC_USER_NAME% + FAP_MDC_USER_ID%
- ok = True
- searchterm(0).cType = FAP_MDS_DATE_JOINED%
- searchterm(0).lpPattern = TheDate+"0000:"
-
- If UCase$(SendMailToUsers) = "Y" then
- BSCFile = Session.ServicePath
- AddBackslash BSCFile
- BSCFile = BSCFIle & Session.Service & ".bsc"
- Open BSCFile For Append Access Write Shared As #2
-
- CaptureLine "These people will all be mailed the 'welcome to the forum'"
- CaptureLine "text the next time you do a connect to CompuServe."
- CaptureLine ""
- End If
-
- Terminal.CaptureStatus CAPTURE_ON
- On Error Goto ListOfMailUsers_error
- FAPMDSearch members(), HMI_STATE_FIRST%, 11, cComp, searchterm(), retcount
- Do While members(0).lpUserId <> ""
- For i = 0 To UBound(members)
- count = count + 1
- Terminal.CaptureStatus count, "Receiving Member Directory"
- CaptureLine members(i).lpName & " [" & members(i).lpUserId & "]"
-
- If UCase$(SendMailToUsers) = "Y" then
- Print #2, ";-; id:" & Chr(9) & "system type:" & Chr(9) & "script script:" & Chr(9) & "Send Welcome Mail to User priority:" & Chr(9) & "30 #:" & Chr(9) & forum & " #:" & Chr(9) & members(i).lpName & " [" & members(i).lpUserId & "]"
- Print #2, "WelcomeMailTo"
- Print #2, forum
- Print #2, members(i).lpName & " [" & members(i).lpUserId & "]"
- End If
- Next
- FAPMDSearch members(), HMI_STATE_NEXT%, 11, cComp, searchterm(), retcount
- Loop
- CaptureLine "!end"
- Terminal.Print "Collected "+LTrim$(Str(count))+" members" + Basic.Eoln$
- Goto ListOfMailUsers_ok
- ListOfMailUsers_error:
- If Err<>9 Then
- errmsg = FullErrorMessage()
- LogResult "Error while downloading members from "+forum+" error : " + errmsg
- ok = False
- End If
- ListOfMailUsers_ok:
- On Error Goto 0
- Terminal.CaptureStatus CAPTURE_OFF
- Capture CAPTURE_OFF
- If UCase$(SendMailToUsers) = "Y" then Close #2
-
- ' Add to import queue
- If count > 0 Then
- b = QueueFile(Session.Service, fname, IM_DELETE)
- Else
- DeleteFile fname
- End If
-
- If ok And id<>"" Then ReportSuccess id & " : Downloaded member(s) for " & forum
- End Sub
-
- 'T:ListMembers (subroutine) (CompuServe)
- Sub ListMembers(id As String, forum As String, list As String, info As String)
- Dim searchterm(0 To 0) As FAPSEARCHTERM
- Dim members() As FAPMDENTRY
- Dim fname As String, menuitem As String, errmsg As String
- Dim count As Integer, cComp AS Integer, i As Integer, t As Long
- Dim ok As Boolean
- Dim retcount As Long, sectionvector As Long
-
- If Not HMIGotoForum(forum) Then
- LogResult "Unable to access " + forum + " to get member list"
- Exit Sub
- End If
-
- If (FAPconfig.wAlerts And FAP_NISA_FORUM%) = 0 Then
- AsciiListMembers id, forum, list, info
- Exit Sub
- End If
-
- menuitem = ParseString(list, " ")
- Terminal.Print "Listing members matching " & menuitem & " " & info & Basic.Eoln$
- fname = UniqueFilename$()
- count = 0
- Capture CAPTURE_ON, fname
- CaptureLine "#pragma ciscontrol=no;deleteexisting=no"
- CaptureLine "!start " & forum & "/Membership Member_List"
- CaptureLine list & " " & info
- CaptureLine ""
-
- cComp = FAP_MDC_USER_NAME% + FAP_MDC_USER_ID%
- ok = True
- searchterm(0).lpPattern = info
- Select Case menuitem
- Case "ALL"
- searchterm(0).cType = FAP_MDS_ALL%
- Case "UID"
- searchterm(0).cType = FAP_MDS_USER_ID%
- Case "NAM"
- searchterm(0).cType = FAP_MDS_NAME%
- Case "DLV"
- searchterm(0).cType = FAP_MDS_LAST_VISIT%
- Case "AUX"
- searchterm(0).cType = FAP_MDS_AUXILIARY_DATA%
- Case "DJN"
- searchterm(0).cType = FAP_MDS_DATE_JOINED%
- Case "SFG"
- searchterm(0).cType = FAP_MDS_SYSOP_TYPE%
- Case "SMA"
- searchterm(0).cType = FAP_MDS_MSG_SECTION_ACCESS%
- searchterm(0).lpPattern = GetSectionSearchVector(info)
- Case "SLA"
- searchterm(0).cType = FAP_MDS_LIB_SECTION_ACCESS%
- searchterm(0).lpPattern = GetSectionSearchVector(info)
- Case "SCA"
- searchterm(0).cType = FAP_MDS_CONF_SECTION_ACCESS%
- searchterm(0).lpPattern = GetSectionSearchVector(info)
- Case Else
- LogResult "Unsupported membership search option used in " & forum
- Exit Sub
- End Select
-
- Terminal.CaptureStatus CAPTURE_ON
- On Error Goto ListMembers_error
- FAPMDSearch members(), HMI_STATE_FIRST%, 11, cComp, searchterm(), retcount
- Do While members(0).lpUserId <> ""
- For i = 0 To UBound(members)
- count = count + 1
- Terminal.CaptureStatus count, "Receiving Member Directory"
- CaptureLine members(i).lpName & " [" & members(i).lpUserId & "]"
- Next
- FAPMDSearch members(), HMI_STATE_NEXT%, 11, cComp, searchterm(), retcount
- Loop
- CaptureLine "!end"
- Terminal.Print "Collected "+LTrim$(Str(count))+" members" + Basic.Eoln$
- Goto ListMembers_ok
- ListMembers_error:
- If Err<>9 Then
- errmsg = FullErrorMessage()
- LogResult "Error while downloading members from "+forum+" error : " + errmsg
- ok = False
- End If
- ListMembers_ok:
- On Error Goto 0
- Terminal.CaptureStatus CAPTURE_OFF
- Capture CAPTURE_OFF
-
- ' Add to import queue
- If count > 0 Then
- b = QueueFile(Session.Service, fname, IM_DELETE)
- Else
- DeleteFile fname
- End If
-
- If ok And id<>"" Then ReportSuccess id & " : Downloaded member(s) for " & forum
- End Sub
-
- 'T:GetMemberCount (subroutine) (CompuServe)
- Sub GetMemberCount(id As String, forum As String)
- Dim searchterm(0 To 0) As FAPSEARCHTERM
- Dim members() As FAPMDENTRY
- Dim fname As String, menuitem As String, errmsg As String
- Dim count As Integer, cComp AS Integer, i As Integer
- Dim retcount As Long
-
- If Not HMIGotoForum(forum) Then
- LogResult "Unable to access " + forum + " to get membership count"
- Exit Sub
- End If
-
- If (FAPconfig.wAlerts And FAP_NISA_FORUM%) = 0 Then
- AsciiGetMemberCount id, forum
- Exit Sub
- End If
-
- Terminal.Print "Getting membership count" & Basic.Eoln$
-
- fname = UniqueFilename$()
- count = 0
- Capture CAPTURE_ON, fname
- CaptureLine "#pragma ciscontrol=no;deleteexisting=no"
- CaptureLine "!start " & forum & "/Membership Member_Count"
- CaptureLine ""
-
- cComp = FAP_MDC_USER_ID%
- searchterm(0).cType = FAP_MDS_ALL%
- searchterm(0).lpPattern = ""
-
- On Error Goto GetMemberCount_error
- FAPMDSearch members(), HMI_STATE_FIRST%, 100, cComp, searchterm(), retcount
- Do While members(0).lpUserId <> ""
- count = count + UBound(members) + 1
- Terminal.Status "Counting Forum Members " & Str(count)
- FAPMDSearch members(), HMI_STATE_NEXT%, 100, cComp, searchterm(), retcount
- Loop
- GetMemberCount_error:
- On Error Goto 0
- Terminal.Status ""
- CaptureLine "Total membership = " & count
- CaptureLine "!end"
- Capture CAPTURE_OFF
-
- ' Add to import queue
- b = QueueFile(Session.Service, fname, IM_DELETE)
-
- If id<>"" Then ReportSuccess id & " : Member count for forum " & forum & " collected"
- End Sub
-
- 'T:WhoIs (subroutine) (CompuServe)
- Sub WhoIs(id As String, forum As String, uid As String)
- Dim searchterm(0 To 0) As FAPSEARCHTERM
- Dim members() As FAPMDENTRY
- Dim fname As String, errmsg As String
- Dim cComp As Integer
- Dim retcount As Long
-
- If Not HMIGotoForum(forum) Then
- LogResult "Unable to access " + forum + " to get who is"
- Exit Sub
- End If
-
- If (FAPconfig.wAlerts And FAP_NISA_FORUM%) = 0 Then
- AsciiWhoIs id, forum, uid
- Exit Sub
- End If
-
- Terminal.Print "Who Is " & uid & Basic.Eoln$
-
- ' Search for user and get last access
- On Error Resume Next
- cComp = FAP_MDC_USER_NAME% + FAP_MDC_USER_ID% + FAP_MDC_LAST_ACCESS%
- searchterm(0).cType = FAP_MDS_USER_ID%
- searchterm(0).lpPattern = uid
- FAPMDSearch members(), HMI_STATE_FIRST%, 1, cComp, searchterm(), retcount
-
- ' Write message
- fname = UniqueFilename$()
- Capture CAPTURE_ON, fname
- CaptureLine "#pragma ciscontrol=no;deleteexisting=no"
- CaptureLine "!start " & forum & "/Sysop_Logs User_Log"
- CaptureLine ""
- CaptureLine members(0).lpName & " [" & members(0).lpUserId & "]"
- CaptureLine "Last Accessed: " & MakeDateString(members(0).tsLastAccess)
- CaptureLine "!end"
- Capture CAPTURE_OFF
- On Error Goto 0
-
- ' Add to import queue
- If QueueFile(Session.Service, fname, IM_DELETE) Then
- ReportSuccess id & " : Who is for " & uid & " collected"
- Else
- ReportSuccess id & " : Who is for " & uid & " failed"
- End If
- End Sub
-
-
-