├── .gitignore ├── Hermes.r ├── Hermes.proj.r ├── LICENSE ├── README.md ├── prepare.sh └── Source ├── Telnet.p ├── Message & Text Output.p ├── LoadAndSave.p ├── SystPrefs2.p ├── TCPTypes.p ├── HUtils7.p ├── WebTosser.p ├── CreateNewFiles.p ├── MesEdit.p └── Import.p /.gitignore: -------------------------------------------------------------------------------- 1 | /Working 2 | .DS_Store 3 | -------------------------------------------------------------------------------- /Hermes.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/malyn/HermesBBS/HEAD/Hermes.r -------------------------------------------------------------------------------- /Hermes.proj.r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/malyn/HermesBBS/HEAD/Hermes.proj.r -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1989-2013, Michael Alyn Miller 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice 8 | unmodified, this list of conditions, and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 3. Neither the name of Michael Alyn Miller nor the names of the contributors to 13 | this software may be used to endorse or promote products derived from this 14 | software without specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY 17 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 23 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Hermes BBS # 2 | 3 | Open source version of the Hermes BBS for Classic Mac OS (System 6 and 4 | 7) computers. You will need a copy of THINK Pascal 4.0.2 in order to 5 | compile Hermes. The build environment is designed for a PowerPC-based 6 | Mac OS X computer with a full Classic install. 7 | 8 | See [the Hermes BBS web site](http://www.HermesBBS.com/) for more 9 | information. 10 | 11 | ## Compilation ## 12 | 13 | Open a Mac OS X terminal and type `./prepare.sh working`. That will 14 | create a Working directory with THINK Pascal project files, resource 15 | files, and source files. You can then build and edit the code in the 16 | Working directory with THINK Pascal. 17 | 18 | When you are ready to commit your changes, type `./prepare.sh source`. 19 | That will copy changed source and resource files from Working back into 20 | the Git source directory. Note that the THINK Pascal project file will 21 | not be copied as it changes on every build and rarely needs to be 22 | checked in. Actual changes to the project file can be prepared with 23 | `./prepare.sh project`. 24 | 25 | ## Copyright and License ## 26 | 27 | Copyright © 1989-2013, Michael Alyn Miller 28 | All rights reserved. 29 | 30 | Redistribution and use in source and binary forms, with or without 31 | modification, are permitted provided that the following conditions are 32 | met: 33 | 34 | 1. Redistributions of source code must retain the above copyright notice 35 | unmodified, this list of conditions, and the following disclaimer. 36 | 2. Redistributions in binary form must reproduce the above copyright 37 | notice, this list of conditions and the following disclaimer in the 38 | documentation and/or other materials provided with the distribution. 39 | 3. Neither the name of Michael Alyn Miller nor the names of the 40 | contributors to this software may be used to endorse or promote 41 | products derived from this software without specific prior written 42 | permission. 43 | 44 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY 45 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 46 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 47 | PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE 48 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 49 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 50 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 51 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 52 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 53 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF 54 | THE POSSIBILITY OF SUCH DAMAGE. 55 | -------------------------------------------------------------------------------- /prepare.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | 4 | # ###################################################################### 5 | # CONFIG VARIABLES 6 | # 7 | 8 | # Configure the location of THINK Pascal; default to the Classic Apps 9 | # directory, although this can be overriden with the THINK_PASCAL 10 | # environment variable. 11 | THINK_PASCAL=${THINK_PASCAL:-"/Applications (Mac OS 9)/THINK Pascal 4.0.2"} 12 | 13 | # Locate THINK Pascal's RInclude's folder. 14 | RINCLUDES="$THINK_PASCAL/THINK Pascal 4.0 Utilities/Rez Utilities/RIncludes" 15 | 16 | # Configure the remaining Mac OS X paths that we need for our script. 17 | PATH=/sbin:/bin:/usr/bin:/Developer/Tools 18 | 19 | # Locate the Working directory where we put generated files. 20 | WORKING=Working 21 | 22 | # Whether or not we should clobber modified files in the Working 23 | # directory. Setting this to true (which is available using a command 24 | # line argument) means that the Working directory will be replaced by 25 | # the contents of Source. 26 | SHOULD_CLOBBER=false 27 | 28 | 29 | # ###################################################################### 30 | # SOURCE -> WORKING 31 | # 32 | 33 | # Convert Rez files into Mac OS files with a resource fork. 34 | # 35 | # Usage: RezToResource(sourceFile, targetFile, [macosType], [macosCreator]) 36 | # macosType defaults to 'rsrc' 37 | # macosCreator defaults to 'RSED' 38 | function RezToResource() { 39 | # Parse the arguments. 40 | SOURCE=$1 41 | TARGET=$2 42 | MACOS_TYPE=${3:-rsrc} 43 | MACOS_CREATOR=${4:-RSED} 44 | 45 | # Ignore targets that are newer than the source (unless we are 46 | # clobbering targets). 47 | if [ -f $TARGET ]; then 48 | if [ \( ! $SOURCE -nt $TARGET \) -o \( $SHOULD_CLOBBER != true \) ]; then 49 | echo "$TARGET is up to date" 50 | return 0 51 | fi 52 | fi 53 | 54 | echo "Converting $SOURCE to $TARGET" 55 | 56 | # Create the intermediate file into which we will stage our output. 57 | # We use an intermediate file so that we do not write a corrupt 58 | # output file into the target location. 59 | INT=`mktemp -t hermes_prepare` 60 | 61 | # Convert the Rez file into a Mac OS file with a resource fork; do 62 | # not overwrite the target if the conversion fails. 63 | Rez "$RINCLUDES/SysTypes.r" "$RINCLUDES/Types.r" $SOURCE -o $INT -t $MACOS_TYPE -c $MACOS_CREATOR 64 | if [ $? -eq 0 ]; then 65 | ditto -rsrcFork $INT $TARGET 66 | touch -r $SOURCE $TARGET 67 | rm -f $INT 68 | return 0 69 | else 70 | echo "..failed!" 71 | rm -f $INT 72 | return 1 73 | fi 74 | } 75 | 76 | # Convert UTF-8 Unix text files into MacRoman Mac OS text files. 77 | # 78 | # Usage: UnixTextToMacText(sourceFile, targetFile, [macosType], [macosCreator]) 79 | # macosType defaults to 'TEXT' 80 | # macosCreator defaults to 'PJMM' 81 | function UnixTextToMacText() 82 | { 83 | # Parse the arguments. 84 | SOURCE=$1 85 | TARGET=$2 86 | MACOS_TYPE=${3:-TEXT} 87 | MACOS_CREATOR=${4:-PJMM} 88 | 89 | # Ignore already-converted files. 90 | if [ ! $SOURCE -nt $TARGET ]; then 91 | echo "$TARGET is up to date" 92 | return 93 | fi 94 | 95 | echo "Translating $SOURCE into $TARGET" 96 | 97 | # Create the intermediate file into which we will stage our output. 98 | # We use an intermediate file so that we do not write a corrupt 99 | # output file into the target location. 100 | INT=`mktemp -t hermes_prepare` 101 | 102 | # Convert the file; do not overwrite the target if the conversion 103 | # fails. 104 | tr '\n' '\r' < $SOURCE | iconv -f UTF-8 -t MacRoman > $INT 105 | if [ $? -ne 0 ]; then 106 | echo "..failed!" 107 | rm -f $INT 108 | return 1 109 | fi 110 | 111 | # The file has been converted; now we need to see if the contents are the 112 | # same. If not, then we will only clobber the file if asked to do so. 113 | # This ensures that we don't accidentally overwriting our working changes. 114 | if [ -f $TARGET ]; then 115 | INTMD5=`md5 -q $INT` 116 | TARGETMD5=`md5 -q $TARGET` 117 | if [ \( $INTMD5 != $TARGETMD5 \) -a \( $SHOULD_CLOBBER != true \) ]; then 118 | echo "..refusing to clobber modified working file!" 119 | rm -f $INT 120 | return 1 121 | fi 122 | fi 123 | 124 | # Copy the file into the target location and set its type and 125 | # modification date. 126 | cp $INT $TARGET 127 | SetFile -t $MACOS_TYPE -c $MACOS_CREATOR $TARGET 128 | touch -r $SOURCE $TARGET 129 | 130 | # Remove the intermediate file. 131 | rm -f $INT 132 | } 133 | 134 | # Prepares/Updates the Working directory by converting Rez files into 135 | # resource files and Unix text files into Mac OS text files. 136 | function PrepareWorking() 137 | { 138 | # Create the working directories, just in case this is our first 139 | # time running the script. 140 | mkdir -p $WORKING 141 | mkdir -p $WORKING/Includes 142 | mkdir -p $WORKING/Source 143 | 144 | # Prepare working files. 145 | RezToResource Hermes.proj.r $WORKING/Hermes.proj QPRJ PJMM 146 | RezToResource Hermes.r $WORKING/Hermes.rsrc 147 | 148 | IFS=' 149 | ' 150 | SOURCES=`ls Source/*.p` 151 | for f in $SOURCES; do 152 | UnixTextToMacText "$f" "Working/Source/`basename $f`" 153 | done 154 | 155 | # Prepare includes. 156 | UnixTextToMacText Includes/HermHeaders.h $WORKING/Includes/HermHeaders.h 157 | } 158 | 159 | 160 | # ###################################################################### 161 | # WORKING -> SOURCE 162 | # 163 | 164 | # Convert Mac OS files with a resource fork into Rez files. 165 | # 166 | # Usage: ResourceToRez(sourceFile, targetFile) 167 | function ResourceToRez() { 168 | # Parse the arguments. 169 | SOURCE=$1 170 | TARGET=$2 171 | 172 | # Ignore targets that have exactly the same modification time as the 173 | # source file. Every other condition (including where the target is 174 | # newer than the source) gets converted. We do this because the 175 | # user may have discarded their previous changes and caused the 176 | # target to have a newer modification time than the source, even 177 | # though the source file has newer contents. 178 | if [ \( ! $SOURCE -nt $TARGET \) -a \( ! $TARGET -nt $SOURCE \) ]; then 179 | echo "$TARGET is up to date" 180 | return 181 | fi 182 | 183 | echo "Converting $SOURCE to $TARGET" 184 | 185 | # Create the intermediate file into which we will stage our output. 186 | # We use an intermediate file so that we do not write a corrupt 187 | # output file into the target location. 188 | INT=`mktemp -t hermes_prepare` 189 | 190 | # Convert the Mac OS file into a Rez file; do not overwrite the 191 | # target if the conversion fails. 192 | DeRez $SOURCE "$RINCLUDES/SysTypes.r" "$RINCLUDES/Types.r" > $INT 193 | if [ $? -eq 0 ]; then 194 | cp $INT $TARGET 195 | touch -r $SOURCE $TARGET 196 | rm -f $INT 197 | return 0 198 | else 199 | echo "..failed!" 200 | rm -f $INT 201 | return 1 202 | fi 203 | } 204 | 205 | # Convert MacRoman Mac OS text files into UTF-8 Unix text files. 206 | # 207 | # Usage: MacTextToUnixText(sourceFile, targetFile) 208 | function MacTextToUnixText() 209 | { 210 | SOURCE=$1 211 | TARGET=$2 212 | 213 | # Ignore targets that have exactly the same modification time as the 214 | # source file. Every other condition (including where the target is 215 | # newer than the source) gets converted. We do this because the 216 | # user may have discarded their previous changes and caused the 217 | # target to have a newer modification time than the source, even 218 | # though the source file has newer contents. 219 | if [ \( ! $SOURCE -nt $TARGET \) -a \( ! $TARGET -nt $SOURCE \) ]; then 220 | echo "$TARGET is up to date" 221 | return 222 | fi 223 | 224 | echo "Translating $SOURCE into $TARGET" 225 | 226 | INT=`mktemp -t hermes_prepare` 227 | 228 | # Convert the file; do not overwrite the target if the conversion 229 | # fails. 230 | tr '\r' '\n' < $SOURCE | iconv -f MacRoman -t UTF-8 > $INT 231 | if [ $? -ne 0 ]; then 232 | echo "..failed!" 233 | rm -f $INT 234 | return 1 235 | fi 236 | 237 | # Copy the file into the target location and set its type and 238 | # modification date. 239 | cp $INT $TARGET 240 | touch -r $SOURCE $TARGET 241 | 242 | # Remove the intermediate file. 243 | rm -f $INT 244 | } 245 | 246 | # Prepares/Updates the Source directory by converting resource files 247 | # into Rez files and Mac OS text files into Unix text files. 248 | function PrepareSource() 249 | { 250 | # Prepare BBS source files. 251 | ResourceToRez $WORKING/Hermes.rsrc Hermes.r 252 | 253 | IFS=' 254 | ' 255 | WORKING_SOURCES=`ls $WORKING/Source/*.p` 256 | for f in $WORKING_SOURCES; do 257 | MacTextToUnixText "$f" "Source/`basename $f`" 258 | done 259 | 260 | # Prepare includes. 261 | MacTextToUnixText $WORKING/Includes/HermHeaders.h Includes/HermHeaders.h 262 | } 263 | 264 | 265 | # ###################################################################### 266 | # MAIN ENTRY POINT 267 | # 268 | 269 | # Prepare source or working according to the command line arguments. 270 | if [ "x$1" == "xworking" ]; then 271 | PrepareWorking 272 | elif [ "x$1" == "xclobberworking" ]; then 273 | SHOULD_CLOBBER=true 274 | PrepareWorking 275 | elif [ "x$1" == "xsource" ]; then 276 | PrepareSource 277 | elif [ "x$1" == "xproject" ]; then 278 | ResourceToRez $WORKING/Hermes.proj Hermes.proj.r 279 | else 280 | echo "usage: prepare.sh working|clobberworking|source|project" 281 | echo 282 | echo " working: convert source files into working files." 283 | echo 284 | echo " clobberworking: convert source files into working files," 285 | echo " clobbering any working modifications." 286 | echo 287 | echo " source: convert working files back into source and resource files" 288 | echo " (but not project files; use 'project' for that)." 289 | echo 290 | echo " project: convert working project files back into Rez files." 291 | exit 1 292 | fi 293 | -------------------------------------------------------------------------------- /Source/Telnet.p: -------------------------------------------------------------------------------- 1 | { Segments: Telnet_1 } 2 | unit Telnet; 3 | 4 | interface 5 | uses 6 | Processes, AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, NodePrefs, InpOut4; 7 | 8 | procedure DoTelnetNegotiation; 9 | 10 | implementation 11 | const 12 | TelnetTimeout = 60; { ticks } 13 | 14 | { Telnet sequences. } 15 | telnetSE = 240; 16 | telnetNOP = 241; 17 | telnetDataMark = 242; 18 | telnetBreak = 243; 19 | telnetInterruptProcess = 244; 20 | telnetAbortOutput = 245; 21 | telnetAreYouThere = 246; 22 | telnetEraseCharacter = 247; 23 | telnetEraseLine = 248; 24 | telnetGoAhead = 249; 25 | telnetSB = 250; 26 | telnetWILL = 251; 27 | telnetWONT = 252; 28 | telnetDO = 253; 29 | telnetDONT = 254; 30 | telnetIAC = 255; 31 | 32 | { The telnet options we process. } 33 | TRANSMIT_BINARY = $00; 34 | ECHO = $01; 35 | SUPPRESS_GO_AHEAD = $03; 36 | 37 | type 38 | { Telnet state. } 39 | eTelnetState = (waitingIAC, waitingCommand, waitingCode); 40 | 41 | { Q Method types. } 42 | eUsHim = (NO, WANTNO, WANTYES, YES); 43 | eUsQHimQ = (EMPTY, OPPOSITE); 44 | qOptionPtr = ^qOption; 45 | qOption = record 46 | us: eUsHim; 47 | usq: eUsQHimQ; 48 | him: eUsHim; 49 | himq: eUsQHimQ; 50 | end; 51 | qOptionListPtr = ^qOptionList; 52 | qOptionList = record 53 | options: array[0..3] of qOption; 54 | end; 55 | 56 | {$S Telnet_1} 57 | function GetTelnetString (command, code: byte): Str255; 58 | var 59 | tempString, tempString2: Str255; 60 | begin 61 | tempString := ''); 85 | GetTelnetString := tempString; 86 | end; 87 | 88 | procedure LogTelnet (logStr: Str255); 89 | var 90 | path: str255; 91 | logRef: integer; 92 | logStrSize: longInt; 93 | result: OSerr; 94 | begin 95 | { Display to the SysOp. } 96 | OutLineSysop(logStr, true); 97 | 98 | { Write to the file if requested. } 99 | if InitSystHand^^.DebugTelnetToFile then 100 | begin 101 | path := concat(sharedPath, 'Misc:Telnet Log'); 102 | result := FSOpen(path, 0, logRef); 103 | if result <> noErr then 104 | begin 105 | result := FSDelete(path, 0); 106 | result := Create(path, 0, 'HRMS', 'TEXT'); 107 | result := FSOpen(path, 0, LogRef); 108 | end; 109 | if result = noErr then 110 | begin 111 | logStr := concat(logStr, char(13)); 112 | result := SetFPos(logRef, fsFromLEOF, 0); 113 | logStrSize := length(logStr); 114 | result := FSWrite(logRef, logStrSize, @logStr[1]); 115 | result := FSClose(logRef); 116 | end; 117 | end; 118 | end; 119 | 120 | procedure SendTelnet (command, code: byte); 121 | var 122 | { Temporary vars. } 123 | result: OSErr; 124 | 125 | { General vars. } 126 | writeBytes: packed array[0..2] of byte; 127 | begin 128 | with curGlobs^ do 129 | begin 130 | if InitSystHand^^.DebugTelnet then 131 | LogTelnet(concat('Telnet: sending ', GetTelnetString(command, code))); 132 | 133 | { Prepare our sequence. } 134 | writeBytes[0] := telnetIAC; 135 | writeBytes[1] := command; 136 | writeBytes[2] := code; 137 | 138 | { Send the sequence. } 139 | nodeTCP.tcpWDSPtr^.size := 3; 140 | nodeTCP.tcpWDSPtr^.buffer := @writeBytes; 141 | nodeTCP.tcpWDSPtr^.term := 0; 142 | 143 | with nodeTCP.tcpPBPtr^ do 144 | begin 145 | ioResult := 1; 146 | ioCompletion := nil; 147 | 148 | ioCRefNum := ippDrvrRefNum; 149 | csCode := TCPcsSend; 150 | tcpStream := nodeTCP.tcpStreamPtr; 151 | 152 | send.ulpTimeoutValue := 0; 153 | send.ulpTimeoutAction := -1; 154 | send.validityFlags := $c0; 155 | send.pushFlag := 1; 156 | send.urgentFlag := 0; 157 | send.wds := nodeTCP.tcpWDSPtr; 158 | send.userDataPtr := nil; 159 | end; 160 | 161 | result := PBControl(ParmBlkPtr(nodeTCP.tcpPBPtr), false); 162 | end; 163 | end; 164 | 165 | procedure DoTelnetNegotiation; 166 | label 167 | 2; 168 | 169 | var 170 | { Temporary vars. } 171 | result: OSErr; 172 | tempString: Str255; 173 | 174 | { General variables. } 175 | readCnt: integer; 176 | readBytes: packed array[0..1] of byte; 177 | cb: TCPControlBlock; 178 | opt: qOptionPtr; 179 | useANSI: Boolean; 180 | 181 | { State variables. } 182 | options: qOptionListPtr; 183 | state: eTelnetState; 184 | curCommand: byte; 185 | begin 186 | with curGlobs^ do 187 | begin 188 | { crossint7 is the current telnet command. crossint8 is the state variable. } 189 | { crosslong is used to hold the options pointer. } 190 | curCommand := crossint7; 191 | state := eTelnetState(crossint8); 192 | options := qOptionListPtr(crosslong); 193 | 194 | case crossint of 195 | 1: { Enter telnet negotiation stage. } 196 | begin 197 | if InitSystHand^^.DebugTelnet then 198 | LogTelnet('Telnet: beginning telnet negotiation..'); 199 | 200 | { Initialize our telnet state and set our timeout counter. If we don't receive any telnet} 201 | { negotiation codes in TelnetTimeout seconds, then we conclude negotiation. } 202 | state := waitingIAC; 203 | lastKeyPressed := TickCount; 204 | 205 | { Initialize our option state. We only will process options that we know about. } 206 | { Everything else gets ignored. } 207 | options := qOptionListPtr(NewPtrClear(sizeof(qOptionList))); 208 | 209 | { Things we ask for. } 210 | options^.options[TRANSMIT_BINARY].us := YES; 211 | options^.options[TRANSMIT_BINARY].usq := EMPTY; 212 | options^.options[TRANSMIT_BINARY].him := WANTYES; 213 | options^.options[TRANSMIT_BINARY].himq := EMPTY; 214 | SendTelnet(telnetDO, TRANSMIT_BINARY); 215 | 216 | options^.options[ECHO].us := WANTYES; 217 | options^.options[ECHO].usq := EMPTY; 218 | options^.options[ECHO].him := NO; 219 | options^.options[ECHO].himq := EMPTY; 220 | SendTelnet(telnetWILL, ECHO); 221 | 222 | { Things we are asked. } 223 | options^.options[SUPPRESS_GO_AHEAD].us := YES; 224 | options^.options[SUPPRESS_GO_AHEAD].usq := EMPTY; 225 | options^.options[SUPPRESS_GO_AHEAD].him := NO; 226 | options^.options[SUPPRESS_GO_AHEAD].himq := EMPTY; 227 | 228 | { Start reading characters. } 229 | crossint := 2; 230 | end; 231 | 232 | 2: 233 | begin { Telnet negotiation loop. } 234 | 2: { Only continue if there is data to read. } 235 | readCnt := TCPBytesToRead(@nodeTCP); 236 | if readCnt <> 0 then 237 | begin 238 | { Read a byte. } 239 | with cb do 240 | begin 241 | ioResult := 1; 242 | ioCompletion := nil; 243 | 244 | ioCRefNum := ippDrvrRefNum; 245 | csCode := TCPcsRcv; 246 | tcpStream := nodeTCP.tcpStreamPtr; 247 | 248 | receive.commandTimeoutValue := 0; 249 | receive.markFlag := 0; 250 | receive.urgentFlag := 0; 251 | receive.rcvBuff := @readBytes; 252 | receive.rcvBuffLength := 1; 253 | receive.userDataPtr := nil; 254 | end; { with cb } 255 | result := PBControl(ParmBlkPtr(@cb), false); 256 | if result = noErr then 257 | begin 258 | { Reset our telnet timeout. } 259 | lastKeyPressed := TickCount; 260 | 261 | { Store the amount of data read. } 262 | readCnt := cb.receive.rcvBuffLength; 263 | if InitSystHand^^.DebugTelnet then 264 | begin 265 | NumToString(readBytes[0], tempString); 266 | LogTelnet(concat('Telnet: received character #', tempString)); 267 | end; 268 | 269 | { Process this byte through our state machine. } 270 | case state of 271 | waitingIAC: 272 | case readBytes[0] of 273 | telnetIAC: 274 | begin 275 | { Look for a telnet command. } 276 | state := waitingCommand; 277 | end; 278 | otherwise 279 | begin 280 | { We received an out of state character; telnet negotiation must be over. } 281 | crossint := 99; 282 | if InitSystHand^^.DebugTelnet then 283 | LogTelnet('Telnet: out of state character; concluding negotiation.'); 284 | end; 285 | end; 286 | 287 | waitingCommand: 288 | begin 289 | curCommand := readBytes[0]; 290 | if (readBytes[0] = telnetWILL) or (readBytes[0] = telnetWONT) or (readBytes[0] = telnetDO) or (readBytes[0] = telnetDONT) then 291 | state := waitingCode 292 | else 293 | begin 294 | { We received an out of state character; telnet negotiation must be over. } 295 | crossint := 99; 296 | if InitSystHand^^.DebugTelnet then 297 | LogTelnet('Telnet: out of state character; concluding negotiation.'); 298 | end; 299 | end; 300 | 301 | waitingCode: 302 | begin 303 | if InitSystHand^^.DebugTelnet then 304 | LogTelnet(concat('Telnet: received ', GetTelnetString(curCommand, readBytes[0]))); 305 | if (readBytes[0] = TRANSMIT_BINARY) or (readBytes[0] = ECHO) or (readBytes[0] = SUPPRESS_GO_AHEAD) then 306 | begin 307 | { Process this code according to the command. } 308 | opt := @options^.options[readBytes[0]]; 309 | 310 | if InitSystHand^^.DebugTelnet then 311 | begin 312 | tempString := 'Telnet:'; 313 | if opt^.us = YES then 314 | tempString := concat(tempString, ' us=YES;') 315 | else 316 | tempString := concat(tempString, ' us=NO;'); 317 | if opt^.usq = EMPTY then 318 | tempString := concat(tempString, ' usq=EMPTY;') 319 | else 320 | tempString := concat(tempString, ' usq=OPPOSITE;'); 321 | if opt^.him = YES then 322 | tempString := concat(tempString, ' him=YES;') 323 | else 324 | tempString := concat(tempString, ' him=NO;'); 325 | if opt^.himq = EMPTY then 326 | tempString := concat(tempString, ' himq=EMPTY;') 327 | else 328 | tempString := concat(tempString, ' himq=OPPOSITE;'); 329 | LogTelnet(tempString); 330 | end; 331 | 332 | case curCommand of 333 | telnetWILL: 334 | begin 335 | if opt^.him = NO then 336 | begin 337 | if opt^.us = YES then 338 | begin 339 | opt^.him := YES; 340 | SendTelnet(telnetDO, readBytes[0]); 341 | end 342 | else 343 | SendTelnet(telnetDONT, readBytes[0]); 344 | end 345 | else if opt^.him = YES then 346 | { ignore } 347 | else if (opt^.him = WANTNO) and (opt^.himq = EMPTY) then 348 | begin 349 | opt^.him := NO; 350 | if InitSystHand^^.DebugTelnet then 351 | LogTelnet('Telnet: error; DONT answered by WILL.') 352 | end 353 | else if (opt^.him = WANTNO) and (opt^.himq = OPPOSITE) then 354 | begin 355 | opt^.him := YES; 356 | opt^.himq := EMPTY; 357 | if InitSystHand^^.DebugTelnet then 358 | LogTelnet('Telnet: error; DONT answered by WILL.'); 359 | end 360 | else if (opt^.him = WANTYES) and (opt^.himq = EMPTY) then 361 | begin 362 | opt^.him := YES; 363 | end 364 | else if (opt^.him = WANTNO) and (opt^.himq = OPPOSITE) then 365 | begin 366 | opt^.him := WANTNO; 367 | opt^.himq := EMPTY; 368 | SendTelnet(telnetDONT, readBytes[0]); 369 | end; 370 | end; 371 | end; 372 | end 373 | else 374 | begin 375 | { Unknown code. } 376 | if InitSystHand^^.DebugTelnet then 377 | LogTelnet('Telnet: unknown telnet code; ignoring.'); 378 | end; 379 | 380 | { Wait for the next code. } 381 | state := waitingIAC; 382 | end; 383 | 384 | otherwise 385 | begin 386 | { We received random data; telnet negotiation must be over. } 387 | crossint := 99; 388 | if InitSystHand^^.DebugTelnet then 389 | LogTelnet('Telnet: unknown character received; concluding negotiation.'); 390 | end; 391 | end; { case state } 392 | end; { result = noErr } 393 | end 394 | else { readCnt <> 0 } 395 | begin 396 | if TickCount > (lastKeyPressed + TelnetTimeout) then 397 | begin 398 | { We received random data; telnet negotiation must be over. } 399 | crossint := 99; 400 | if InitSystHand^^.DebugTelnet then 401 | LogTelnet('Telnet: telnet negotiation timed out; concluding negotiation.'); 402 | end; 403 | end; 404 | end; 405 | 406 | 99: { Telnet negotiation complete. } 407 | begin 408 | { Determine if this user supports ANSI. } 409 | useANSI := true; 410 | 411 | { Free our option pointer. } 412 | DisposPtr(Ptr(options)); 413 | 414 | { Log the user in. } 415 | if InitSystHand^^.DebugTelnet then 416 | LogTelnet('Telnet: telnet negotiation complete.'); 417 | DoLogon(useANSI); 418 | end; 419 | end; 420 | 421 | { crossint7 is the current telnet command. crossint8 is the state variable. } 422 | { crosslong is used to hold the options pointer. } 423 | crossint7 := curCommand; 424 | crossint8 := integer(state); 425 | crosslong := longint(options); 426 | end; 427 | end; 428 | 429 | end. -------------------------------------------------------------------------------- /Source/Message & Text Output.p: -------------------------------------------------------------------------------- 1 | { Segments: MessNTextOutput_1 } 2 | unit MessNTextOutput; 3 | 4 | interface 5 | uses 6 | AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, NodePrefs2, Message_Editor, Terminal, inpOut4; 7 | 8 | procedure PrintCurMessage (updateQPtrs: boolean); 9 | procedure PrintCurEMail; 10 | function isTwoByteScript: boolean; 11 | 12 | implementation 13 | 14 | 15 | {$S MessNTextOutput_1} 16 | procedure PrintCurMessage (updateQPtrs: boolean); 17 | var 18 | tempString, s1, s2, tempString2, tempString3, tempString4, tempString5, posterName, theSize, theTime: str255; 19 | ref, i: integer; 20 | tempLong: longInt; 21 | result: OSerr; 22 | tempDate: DateTimeRec; 23 | begin 24 | with curglobs^ do 25 | begin 26 | if curWriting <> nil then 27 | DisposHandle(handle(curWriting)); 28 | curWriting := nil; 29 | readMsgs := true; 30 | lastKeyPressed := tickCount; 31 | curMesgRec := curBase^^[inMessage - 1]; 32 | if curMesgRec.fromUserNum <> 0 then 33 | begin 34 | bCR; 35 | curwriting := ReadMessage(curmesgrec.storedAs, inForum, inConf); 36 | mesRead := mesRead + 1; 37 | if not continuous and not inZscan then 38 | ClearScreen; 39 | posterName := curMesgRec.fromUserName; 40 | if curMesgRec.fromUserNum > 0 then 41 | begin 42 | NumToString(curMesgRec.fromUserNum, tempString5); 43 | posterName := concat(posterName, ' #', tempstring5); 44 | end; 45 | if (BoardSection <> MessageSearcher) then 46 | begin 47 | NumToString(inMessage, tempString); 48 | NumToString(curNumMess, tempString2); 49 | end 50 | else 51 | begin 52 | NumToString(crossInt8 + 1, tempString); 53 | NumToString(MessageSearch^^.NumFound, tempString2); 54 | end; 55 | bufferIt('Subj', false, 4); 56 | bufferIt(concat(': ', curMesgrec.title), false, 0); 57 | templong := 71 - (6 + length(curmesgRec.title)); 58 | tempstring3 := ''; 59 | if templong > 0 then 60 | tempstring3 := stringOf(' ' : tempLong); 61 | bufferIt(tempstring3, false, 0); 62 | bufferIt(concat('(', tempstring, '/', tempstring2, ')'), false, 3); 63 | if ((thisUser.cosysop) or (MConferenceOp(InForum, inConf, ThisUser)) or (MForumOp(InForum, ThisUser))) and not curMesgRec.deletable then 64 | begin 65 | bufferIt('||||', true, 4); 66 | bufferIt('> Permanent Message', false, 6); 67 | if thisUser.TerminalType = 1 then 68 | bufferIt('', false, 0); 69 | end; 70 | tempstring3 := takeMsgTop; {Date Time Sequence} 71 | bufferIt('From', true, 4); 72 | wasAnonymous := false; 73 | if (curMesgRec.anonyFrom) then 74 | wasAnonymous := true; 75 | if (curMesgRec.anonyFrom) and (thisUser.CantReadAnon) then 76 | bufferIt(': >UNKNOWN<', false, 0) 77 | else 78 | begin 79 | if (MConference[inForum]^^[inConf].ConfType = 0) and (tempString3[1] > '@') then 80 | begin 81 | if (curmesgRec.fromUserNum <> 0) and (curMesgRec.fromuserNum <= numUserRecs) then 82 | begin 83 | if (curMesgRec.anonyFrom) and (not thisUser.CantReadAnon) then 84 | tempString := concat(': <<<', posterName, '>>> ') 85 | else if ((thisUser.coSysOp) or (MConferenceOp(inForum, inConf, ThisUser)) or (MForumOp(InForum, ThisUser))) and newHand^^.handle and newHand^^.realname and (myusers^^[curMesgRec.fromUserNum - 1].real <> '•') then 86 | tempString := concat(': ', posterName, ' [ ', myUsers^^[curMesgRec.fromUserNum - 1].real, ' ]') 87 | else if (not newHand^^.handle) and (MConference[inForum]^^[inConf].ShowCity) and (myUsers^^[curMesgRec.fromUserNum - 1].city <> '•') then 88 | tempString := stringOf(': ', posterName, ' ' : 40 - length(postername), myUsers^^[curMesgRec.fromuserNum - 1].City, ', ', myUsers^^[curMesgRec.fromuserNum - 1].State) 89 | else if ((thisUser.coSysop) or (MConferenceOp(InForum, inConf, ThisUser)) or (MForumOp(InForum, ThisUser))) and not newHand^^.handle and newhand^^.realname and ((myUsers^^[curMesgRec.fromUserNum - 1].state <> '•') and (myUsers^^[curMesgRec.fromUserNum - 1].city <> '•')) then 90 | tempString := concat(': ', posterName, ' [ ', myUsers^^[curMesgRec.fromUserNum - 1].city, ', ', myUsers^^[curMesgRec.fromUserNum - 1].state, ' ]') 91 | else 92 | tempstring := concat(': ', posterName); 93 | bufferIt(tempString, false, 0); 94 | end 95 | else 96 | bufferIt(': <>', false, 0); 97 | end 98 | else 99 | begin 100 | if FindUser(curMesgRec.fromUserName, tempuser) then 101 | NumToString(tempUser.userNum, tempstring) 102 | else 103 | tempstring := ''; 104 | if length(tempstring) > 0 then 105 | begin 106 | if (not newHand^^.handle) and (MConference[inForum]^^[inConf].ShowCity) and (myUsers^^[tempUser.UserNum - 1].city <> '•') then 107 | tempString := StringOf(': ', curMesgRec.fromUserName, ' #', tempString, ' ' : 40 - (length(curMesgRec.fromUserName)), ' ', myUsers^^[tempUser.UserNum - 1].City, ', ', myUsers^^[tempUser.UserNum - 1].State) 108 | else if ((thisUser.coSysop) or (MConferenceOp(InForum, inConf, ThisUser)) or (MForumOp(InForum, ThisUser))) and not newHand^^.handle and newhand^^.realname and ((myUsers^^[tempUser.UserNum - 1].state <> '•') and (myUsers^^[tempUser.UserNum - 1].city <> '•')) then 109 | tempString := concat(': ', curMesgRec.fromUserName, ' #', tempString, ' [ ', myUsers^^[tempUser.UserNum - 1].City, ', ', myUsers^^[tempUser.UserNum - 1].State, ' ]') 110 | else 111 | tempString := concat(': ', curMesgRec.fromUserName, ' #', tempString); 112 | bufferIt(tempString, false, 0); 113 | end 114 | else 115 | bufferIt(concat(': ', curMesgRec.fromUserName), false, 0); 116 | end; 117 | end; 118 | if MConference[inForum]^^[inConf].Threading then 119 | begin 120 | NumToString(curMesgrec.touserNum, tempString5); 121 | bufferIt('To ', true, 4); 122 | if not curMesgRec.anonyTo then 123 | begin 124 | if curMesgRec.toUserNum > 0 then 125 | bufferIt(concat(': ', curMesgrec.toUserName, ' #', tempstring5), false, 0) 126 | else if curMesgRec.toUserNum = TABBYTOID then 127 | bufferIt(concat(': ', curMesgrec.toUserName), false, 0) 128 | else 129 | bufferIt(': All', false, 0); 130 | end 131 | else 132 | bufferIt(concat(': >UNKNOWN<'), false, 0); 133 | end; 134 | if (curMesgRec.anonyFrom) and (thisUser.CantReadAnon) then 135 | tempString3 := '>>>INACTIVE<<<'; 136 | bufferIt('Date', true, 4); 137 | bufferIt(stringOf(': ', tempString3, ' '), false, 0); 138 | if (MConference[inForum]^^[inConf].ConfType <> 0) and ((tempString3[1] >= '0') and (tempString3[1] <= '9')) then 139 | begin 140 | tempString3 := concat(GetDate(curMesgRec.DateEn), ' ', whatTime(curMesgRec.DateEn)); 141 | bufferIt('Imported', false, 4); 142 | bufferIt(concat(': ', tempString3), false, 0); 143 | end; 144 | 145 | WasAttach := false; 146 | WasAttachMac := true; 147 | AttachFName := char(0); 148 | if (curMesgRec.FileAttached) then 149 | begin 150 | WasAttach := true; 151 | AttachFName := curMesgRec.FileName; 152 | WasAttachMac := curMesgRec.isAMacFile; 153 | 154 | for i := 1 to forumIdx^^.numDirs[0] do 155 | if (forums^^[0].dr[i].DirName = 'Message Attachments') then 156 | tempSubDir := i; 157 | tempInDir := 0; 158 | theSize := char(0); 159 | theTime := char(0); 160 | if OpenDirectory(tempInDir, tempSubDir) then 161 | begin 162 | curDirPos := 0; 163 | allDirSearch := false; 164 | descSearch := false; 165 | fileMask := concat(AttachFName, '*'); 166 | GetNextFile(tempInDir, tempSubDir, fileMask, curDirPos, curFil, 0); 167 | if curFil.flName <> '' then 168 | begin 169 | if curFil.byteLen = -1 then 170 | theSize := '' 171 | else 172 | theSize := concat(doNumber(curFil.byteLen div 1024), 'k'); 173 | if (currentBaud <> 0) and (nodeType = 1) then 174 | tempLong := curFil.bytelen div (modemDrivers^^[modemID].rs[rsIndex].effRate div 10) 175 | else 176 | tempLong := 0; 177 | theTime := Secs2Time(tempLong); 178 | theTime := concat(TheTime, ' to download.'); 179 | end; 180 | end; 181 | 182 | tempString := concat('FILE ATTACHMENT: ', curMesgRec.FileName, ' - ', theSize, ' - ', theTime); 183 | bufferIt(tempString, true, 4); 184 | end; 185 | 186 | end; 187 | if updateQPtrs then 188 | if (curmesgRec.DateEn > thisuser.lastMsgs[inforum, inConf]) and not threadmode then 189 | thisuser.lastmsgs[inforum, inConf] := curmesgRec.DateEn; 190 | bufferbCR; 191 | bufferbCR; 192 | Releasebuffer; 193 | if textHnd <> nil then 194 | disposHandle(handle(texthnd)); 195 | texthnd := nil; 196 | textHnd := texthand(curWriting); 197 | curWriting := nil; 198 | if textHnd <> nil then 199 | begin 200 | scanFile(textHnd); 201 | curtextPos := 0; 202 | openTextSize := GetHandleSize(handle(texthnd)); 203 | BoardAction := ListText; 204 | end 205 | else 206 | OutLine('Message not found.', true, 0); 207 | end; 208 | end; 209 | 210 | procedure PrintCurEMail; 211 | var 212 | tempString, tempString2, tempString3, tempString4, tempString5: str255; 213 | tempDate: DateTimeRec; 214 | totEm, numit: integer; 215 | printMail: EmailRec; 216 | begin 217 | with curglobs^ do 218 | begin 219 | FindMyEmail(thisUser.UserNum); 220 | totEm := GetHandleSize(handle(myEmailList)) div 2; 221 | if atEmail >= totem then 222 | atEmail := totem - 1; 223 | if atEmail < 0 then 224 | atEmail := 0; 225 | if totEm > 0 then 226 | begin 227 | printMail := theEmail^^[myEmailList^^[atEmail]]; 228 | bCR; 229 | if textHnd <> nil then 230 | DisposHandle(handle(texthnd)); 231 | textHnd := nil; 232 | textHnd := textHand(ReadMessage(printMail.storedAs, 0, 0)); 233 | if textHnd <> nil then 234 | scanFile(textHnd); 235 | tempString3 := StringOf('(', AtEmail + 1 : 0, '/', TotEm : 0, '): ', printMail.title); 236 | bufferIt(tempString3, true, 0); 237 | wasAnonymous := false; 238 | if (printMail.anonyFrom) then 239 | wasAnonymous := true; 240 | if (printMail.anonyFrom) and not (thisUser.coSysop) then 241 | begin 242 | bufferIt('Name: >UNKNOWN<', true, 0); 243 | tempUser.UserName := '???'; 244 | end 245 | else 246 | begin 247 | if not ((mailer^^.MailerAware) and (printMail.fromUser = TABBYTOID)) then 248 | begin 249 | NumToString(printMail.fromUser, tempString2); 250 | if FindUser(tempString2, tempUser) then 251 | begin 252 | NumToString(tempUser.UserNum, tempString3); 253 | if (printMail.anonyFrom) and ((thisUser.coSysop) or (thisUser.CantReadAnon)) then 254 | tempString := concat('Name: <<<', tempuser.UserName, ' #', tempString3, '>>>') 255 | else if (thisUser.coSysop and newHand^^.handle) then 256 | tempString := concat('Name: ', tempuser.UserName, ' #', tempString3, ' [ ', tempUser.realName, ' ]') 257 | else if (thisUser.coSysOp and newHand^^.realname) then 258 | tempString := concat('Name: ', tempUser.UserName, ' #', tempString3, ' [ ', tempUser.City, ', ', tempUser.State, ' ] ') 259 | else 260 | tempString := concat('Name: ', tempuser.UserName, ' #', tempString3); 261 | bufferIt(tempString, true, 0); 262 | end 263 | else 264 | bufferIt('Name: <>', true, 0); 265 | end 266 | else 267 | begin 268 | curWriting := TextHand(textHnd); 269 | tempstring5 := takeMsgTop; 270 | textHnd := textHand(curWriting); 271 | curWriting := nil; 272 | if FindUser(tempstring5, tempUser) then 273 | NumToString(tempuser.userNum, tempstring3) 274 | else 275 | tempstring3 := ''; 276 | if length(tempstring3) > 0 then 277 | tempstring3 := concat(' #', tempstring3); 278 | bufferIt(concat('Name: ', tempstring5, tempstring3), true, 0); 279 | end; 280 | end; 281 | IUDateString(printMail.dateSent, abbrevDate, tempstring3); 282 | IUTimeString(printMail.dateSent, true, tempstring2); 283 | if (printMail.anonyFrom) and not (thisUser.coSysop) then 284 | tempstring := 'Date: >>INACTIVE<<' 285 | else 286 | tempString := concat('Date: ', tempString3, ' ', tempString2); 287 | bufferIt(tempString, true, 0); 288 | isMM := false; 289 | if (printMail.multiMail) then 290 | isMM := true; 291 | WasAttach := false; 292 | WasAttachMac := true; 293 | AttachFName := char(0); 294 | if (printMail.FileAttached) then 295 | begin 296 | WasAttach := true; 297 | AttachFName := printMail.FileName; 298 | WasAttachMac := printMail.isAMacFile; 299 | tempString := concat('FILE ATTACHMENT: ', printMail.FileName); 300 | bufferIt(tempString, true, 0); 301 | end; 302 | bufferbCR; 303 | Releasebuffer; 304 | if textHnd <> nil then 305 | begin 306 | curtextPos := 0; 307 | openTextSize := GetHandleSize(handle(texthnd)); 308 | BoardAction := ListText; 309 | ListTextFile; 310 | end 311 | else 312 | OutLine('Message not found.', true, 0); 313 | end; 314 | end; 315 | end; 316 | 317 | function MySWRoutineAvailable (trapWord: Integer): Boolean; 318 | const 319 | _Unimplemented = $A89F; 320 | var 321 | trType: TrapType; 322 | begin 323 | {first determine whether it is an Operating System or Toolbox routine} 324 | if ORD(BAND(trapWord, $0800)) = 0 then 325 | trType := OSTrap 326 | else 327 | trType := ToolTrap; 328 | {filter cases where older systems mask with $1FF rather than $3FF} 329 | if (trType = ToolTrap) and (ORD(BAND(trapWord, $03FF)) >= $200) and (GetToolboxTrapAddress($A86E) = GetToolboxTrapAddress($AA6E)) then 330 | MySWRoutineAvailable := FALSE 331 | else 332 | MySWRoutineAvailable := (NGetTrapAddress(trapWord, trType) <> GetToolboxTrapAddress(_Unimplemented)); 333 | end; 334 | 335 | function GetScriptManagerVariable (selector: INTEGER): LONGINT; 336 | inline 337 | $2F3C, $8402, $0008, $A8B5; 338 | 339 | function isTwoByteScript: boolean; 340 | const 341 | _Gestalt = $A1AD; 342 | 343 | gestaltScriptMgrVersion = 'scri'; 344 | 345 | smSysScript = 18; {System script} 346 | smRoman = 0; {Roman} 347 | smJapanese = 1; {Japanese} 348 | smTradChinese = 2; {Traditional Chinese} 349 | smKorean = 3; {Korean} 350 | smSimpChinese = 25; {Simplified Chinese} 351 | var 352 | selectorValue: longint; 353 | ScriptMgrVersion: longint; 354 | result: OSErr; 355 | begin 356 | isTwoByteScript := false; 357 | if MySWRoutineAvailable(_Gestalt) then 358 | begin 359 | result := Gestalt(gestaltScriptMgrVersion, ScriptMgrVersion); 360 | if (result = noErr) and (ScriptMgrVersion > $0000) then 361 | begin 362 | selectorValue := GetScriptManagerVariable(smSysScript); 363 | if (selectorValue = smJapanese) or (selectorValue = smTradChinese) or (selectorValue = smKorean) or (selectorValue = smSimpChinese) then 364 | isTwoByteScript := true; 365 | end; 366 | end; 367 | end; 368 | 369 | 370 | 371 | end. -------------------------------------------------------------------------------- /Source/LoadAndSave.p: -------------------------------------------------------------------------------- 1 | {$S LoadAndSave_1} 2 | unit LoadAndSave; 3 | 4 | interface 5 | 6 | uses 7 | AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, CTBUtilities, CreateNewFiles; 8 | 9 | procedure WriteUser (theUser: UserRec); 10 | procedure DoSystRec (Save: boolean); 11 | procedure DoMenuRec (Save: boolean); 12 | procedure DoTransRec (Save: boolean); 13 | procedure DoForumRec (Save: boolean); 14 | procedure DoGFileRec (Save: boolean); 15 | procedure DoMailerRec (Save: boolean); 16 | procedure DoSecRec (Save: boolean); 17 | procedure LoadNewUser (Save: boolean); 18 | procedure DoFBRec (Save: boolean); 19 | procedure DoMForumRec (Save: boolean); 20 | procedure DoMConferenceRec (Save: Boolean; WhichOne: integer); 21 | procedure DoAddressBooks (var TheBook: AddressBookHand; TheUserNum: integer; Save: boolean); 22 | procedure LoadActionWordList; 23 | procedure SaveRemoveActionWord (Save: boolean; AW: ActionWordRec; Offset: longint); 24 | 25 | implementation 26 | {$S LoadAndSave_1} 27 | procedure WriteUser; 28 | var 29 | tempstring: str255; 30 | result: OSerr; 31 | SizeofAUser: LongInt; 32 | UsersRes: integer; 33 | begin 34 | SizeOfaUser := SizeOf(UserRec); 35 | result := FSOpen(concat(SharedFiles, 'Users'), 0, UsersRes); 36 | if result <> noErr then 37 | begin 38 | result := Create(concat(sharedFiles, 'Users'), 0, 'HRMS', 'DATA'); 39 | result := FSOpen(concat(SharedFiles, 'Users'), 0, UsersRes); 40 | end; 41 | result := SetFPos(UsersRes, fsFromStart, (SizeOfaUser * longint(theUser.UserNum - 1))); 42 | Result := FSWrite(UsersRes, SizeofAUser, @theUser); 43 | Result := FSClose(UsersRes); 44 | end; 45 | 46 | procedure DoSystRec (Save: boolean); 47 | var 48 | SystemRes: integer; 49 | tempSystHand: SystHand; 50 | begin 51 | SystemRes := OpenRFPerm(concat(SharedFiles, 'System Prefs'), 0, fsRdWrPerm); 52 | if SystemRes = -1 then 53 | sysbeep(10); 54 | handle(tempSystHand) := Get1Resource('Sprf', 0); 55 | if reserror <> noErr then 56 | sysbeep(10); 57 | HNoPurge(handle(tempSystHand)); 58 | if reserror <> noErr then 59 | sysbeep(10); 60 | if save then 61 | tempSystHand^^ := InitSystHand^^ 62 | else 63 | InitSystHand^^ := tempSystHand^^; 64 | if save then 65 | begin 66 | ChangedResource(handle(tempSystHand)); 67 | WriteResource(handle(tempSystHand)); 68 | end; 69 | HPurge(handle(tempSystHand)); 70 | CloseResFile(SystemRes); 71 | UseResFile(myResourceFile); 72 | end; 73 | 74 | procedure DoMenuRec (Save: boolean); 75 | var 76 | tempFileName: str255; 77 | sharedRef, GFilesRes: integer; 78 | initMenuHand: NodeMenuHand; 79 | begin 80 | GFilesRes := OpenRFPerm(concat(SharedFiles, 'Menus'), 0, fsRdWrPerm); 81 | handle(initMenuHand) := Get1Resource('MenU', 0); 82 | HNoPurge(handle(InitMenuHand)); 83 | if reserror <> noErr then 84 | sysbeep(10); 85 | if save then 86 | initMenuHand^^ := MenuHand^^ 87 | else 88 | MenuHand^^ := initMenuHand^^; 89 | if save then 90 | begin 91 | ChangedResource(handle(initMenuHand)); 92 | WriteResource(handle(initMenuHand)); 93 | end; 94 | HPurge(handle(initMenuHand)); 95 | CloseResFile(GFilesRes); 96 | useResFile(myResourceFile); 97 | end; 98 | 99 | procedure DoTransRec (Save: boolean); 100 | var 101 | tempFileName: str255; 102 | sharedRef, GFilesRes: integer; 103 | initTransHand: TransMenuHand; 104 | begin 105 | GFilesRes := OpenRFPerm(concat(SharedFiles, 'Menus'), 0, fsRdWrPerm); 106 | handle(initTransHand) := Get1Resource('MenU', 1); 107 | HNoPurge(handle(initTransHand)); 108 | if reserror <> noErr then 109 | sysbeep(10); 110 | if save then 111 | initTransHand^^ := transHand^^ 112 | else 113 | transHand^^ := initTransHand^^; 114 | if save then 115 | begin 116 | ChangedResource(handle(initTransHand)); 117 | WriteResource(handle(initTransHand)); 118 | end; 119 | HPurge(handle(initTranshand)); 120 | CloseResFile(GFilesRes); 121 | useResFile(myResourceFile); 122 | end; 123 | 124 | procedure DoForumRec (Save: boolean); 125 | var 126 | tempFileName: str255; 127 | sharedRef, Dirs: integer; 128 | initTransHand: ForumIdxHand; 129 | freshFm: ForumIdxHand; 130 | begin 131 | Dirs := OpenRFPerm(concat(SharedFiles, 'Directories'), 0, fsRdWrPerm); 132 | if Dirs = -1 then 133 | begin 134 | result := Create(concat(sharedFiles, 'Directories'), 0, 'HRMS', 'DATA'); 135 | CreateResFile(concat(sharedFiles, 'Directories')); 136 | Dirs := OpenRFPerm(concat(SharedFiles, 'Directories'), 0, fsRdWrPerm); 137 | freshFm := ForumIdxHand(NewHandleClear(SizeOf(ForumIdxRec))); 138 | AddResource(handle(FreshFm), 'Info', 0, 'Forum Information'); 139 | end; 140 | handle(initTransHand) := Get1Resource('Info', 0); 141 | HNoPurge(handle(initTransHand)); 142 | if reserror <> noErr then 143 | sysbeep(10); 144 | if save then 145 | initTransHand^^ := forumIdx^^ 146 | else 147 | forumIdx^^ := initTransHand^^; 148 | if save then 149 | begin 150 | ChangedResource(handle(initTransHand)); 151 | WriteResource(handle(initTransHand)); 152 | end; 153 | HPurge(handle(initTranshand)); 154 | CloseResFile(Dirs); 155 | useResFile(myResourceFile); 156 | end; 157 | 158 | procedure DoGFileRec (Save: boolean); 159 | var 160 | tempFileName: str255; 161 | sharedRef, GFilesRes: integer; 162 | initGFileHand: GFileSecHand; 163 | begin 164 | GFilesRes := OpenRFPerm(concat(SharedFiles, 'GFiles'), 0, fsRdWrPerm); 165 | if (GfilesRes <> -1) then 166 | begin 167 | handle(initGFileHand) := Get1Resource('Gfil', 0); 168 | HNoPurge(handle(InitGFileHand)); 169 | if reserror <> noErr then 170 | sysbeep(10); 171 | if save then 172 | initGFileHand^^ := intGFileRec^^ 173 | else 174 | intGFileRec^^ := initGFileHand^^; 175 | if save then 176 | begin 177 | ChangedResource(handle(initGFileHand)); 178 | WriteResource(handle(initGFileHand)); 179 | end; 180 | HPurge(handle(initGFileHand)); 181 | CloseResFile(GFilesRes); 182 | useResFile(myResourceFile); 183 | end; 184 | end; 185 | 186 | procedure DoMailerRec (Save: boolean); 187 | var 188 | tempFileName: str255; 189 | sharedRef, Dirs: integer; 190 | initmailerhand: mailerhand; 191 | freshFm: mailerhand; 192 | begin 193 | Dirs := OpenRFPerm(concat(SharedFiles, 'Mailer Prefs'), 0, fsRdWrPerm); 194 | handle(initMailerHand) := Get1Resource('Info', 0); 195 | HNoPurge(handle(initMailerHand)); 196 | if reserror <> noErr then 197 | sysbeep(10); 198 | if save then 199 | initMailerHand^^ := mailer^^ 200 | else 201 | mailer^^ := initMailerHand^^; 202 | if save then 203 | begin 204 | ChangedResource(handle(initMailerHand)); 205 | WriteResource(handle(initMailerHand)); 206 | end; 207 | HPurge(handle(initMailerHand)); 208 | ReleaseResource(handle(initMailerHand)); 209 | CloseResFile(Dirs); 210 | useResFile(myResourceFile); 211 | end; 212 | 213 | procedure DoSecRec (Save: boolean); 214 | var 215 | tempFileName: str255; 216 | sharedRef, GFilesRes: integer; 217 | initTransHand: SecLevHand; 218 | begin 219 | GFilesRes := OpenRFPerm(concat(SharedFiles, 'Security Levels'), 0, fsRdWrPerm); 220 | handle(initTransHand) := Get1Resource('Lvls', 0); 221 | HNoPurge(handle(initTranshand)); 222 | if reserror <> noErr then 223 | sysbeep(10); 224 | if save then 225 | initTransHand^^ := secLevels^^ 226 | else 227 | secLevels^^ := initTransHand^^; 228 | if save then 229 | begin 230 | ChangedResource(handle(initTransHand)); 231 | WriteResource(handle(initTransHand)); 232 | end; 233 | HPurge(handle(initTranshand)); 234 | CloseResFile(GFilesRes); 235 | useResFile(myResourceFile); 236 | end; 237 | 238 | procedure LoadNewUser (Save: boolean); 239 | var 240 | i, sref: integer; 241 | OldUser: NewUserHand; 242 | t1, t2: Str255; 243 | begin 244 | sref := OpenRFPerm(concat(SharedFiles, 'New User'), 0, fsRdWrPerm); 245 | if sref = -1 then 246 | CreateNewUser(concat(SharedFiles, 'New User')) 247 | else 248 | begin 249 | handle(OldUser) := Get1Resource('NEWu', 0); 250 | HNoPurge(handle(OldUser)); 251 | if reserror <> noErr then 252 | SysBeep(10); 253 | if save then 254 | OldUser^^ := NewHand^^ 255 | else 256 | NewHand^^ := OldUser^^; 257 | if save then 258 | begin 259 | ChangedResource(handle(OldUser)); 260 | WriteResource(handle(OldUser)); 261 | end; 262 | HPurge(handle(OldUser)); 263 | closeResFile(sref); 264 | end; 265 | useResFile(myResourceFile); 266 | end; 267 | 268 | procedure DoFBRec (Save: boolean); 269 | var 270 | tempFileName: str255; 271 | sharedRef, MessageRes: integer; 272 | InitFeedBack: FeedBackHand; 273 | begin 274 | MessageRes := OpenRFPerm(concat(SharedFiles, 'Message'), 0, fsRdWrPerm); 275 | handle(InitFeedBack) := Get1Resource('MFor', 1); 276 | HNoPurge(handle(InitFeedBack)); 277 | if reserror <> noErr then 278 | sysbeep(10); 279 | if save then 280 | InitFeedBack^^ := InitFBHand^^ 281 | else 282 | InitFBHand^^ := InitFeedBack^^; 283 | if save then 284 | begin 285 | ChangedResource(handle(InitFeedBack)); 286 | WriteResource(handle(InitFeedBack)); 287 | end; 288 | HPurge(handle(InitFeedBack)); 289 | CloseResFile(MessageRes); 290 | useResFile(myResourceFile); 291 | end; 292 | 293 | procedure DoMForumRec (Save: boolean); 294 | var 295 | MForumRes: Integer; 296 | tempMForum: MForumHand; 297 | begin 298 | MForumRes := OpenRFPerm(concat(SharedFiles, 'Message'), 0, fsRdWrPerm); 299 | handle(tempMForum) := Get1Resource('MFor', 0); 300 | 301 | HNoPurge(handle(tempMForum)); 302 | if resError <> noErr then 303 | sysBeep(0); 304 | if Save then 305 | tempMForum^^ := MForum^^ 306 | else 307 | MForum^^ := tempMForum^^; 308 | if Save then 309 | begin 310 | ChangedResource(handle(tempMForum)); 311 | WriteResource(handle(tempMForum)); 312 | end; 313 | HPurge(handle(tempMForum)); 314 | CloseResFile(MForumRes); 315 | UseResFile(myResourceFile); 316 | end; 317 | 318 | procedure DoMConferenceRec (Save: Boolean; WhichOne: integer); 319 | var 320 | MConfRes: integer; 321 | tempMConf: FiftyConferencesHand; 322 | begin 323 | MConfRes := OpenRFPerm(concat(SharedFiles, 'Message'), 0, fsRdWrPerm); 324 | handle(tempMConf) := Get1Resource('Conf', WhichOne); 325 | 326 | HNoPurge(handle(tempMConf)); 327 | if resError <> noErr then 328 | sysBeep(0); 329 | if Save then 330 | tempMConf^^ := MConference[WhichOne]^^ 331 | else 332 | MConference[WhichOne]^^ := tempMConf^^; 333 | if Save then 334 | begin 335 | ChangedResource(handle(tempMConf)); 336 | WriteResource(handle(tempMConf)); 337 | end; 338 | HPurge(handle(tempMConf)); 339 | CloseResFile(MConfRes); 340 | UseResFile(myResourceFile); 341 | end; 342 | 343 | procedure DoAddressBooks (var TheBook: AddressBookHand; TheUserNum: integer; Save: boolean); 344 | var 345 | ABFile: integer; 346 | SizeOfBook: longint; 347 | result: OSErr; 348 | begin 349 | result := FSOpen(concat(sharedPath, 'Shared Files:Address Books'), 0, ABFile); 350 | if result = noErr then 351 | begin 352 | SizeOfBook := SizeOf(AddressBookArray); 353 | result := SetFPos(ABFile, fsFromStart, SizeOfBook * (TheUserNum - 1)); 354 | if Save then 355 | result := FSWrite(ABFile, SizeOfBook, pointer(TheBook^)) 356 | else 357 | result := FSRead(ABFile, SizeOfBook, pointer(TheBook^)); 358 | end; 359 | result := FSClose(ABFile); 360 | end; 361 | 362 | procedure SortActionWordList; 363 | external; 364 | 365 | procedure LoadActionWordList; 366 | var 367 | result: OSErr; 368 | TheFile, i: integer; 369 | SizeOfThis, NumAWords: longint; 370 | AW: ActionWordRec; 371 | begin 372 | if ActionWordHand <> nil then 373 | begin 374 | DisposHandle(handle(ActionWordHand)); 375 | ActionWordHand := nil; 376 | end; 377 | ChatHand^^.NumActionWords := 0; 378 | result := FSOpen(concat(sharedPath, 'Shared Files:Action Words'), 0, TheFile); 379 | if result = noErr then 380 | begin 381 | SizeOfThis := SizeOf(ActionWordRec); 382 | result := GetEOF(TheFile, NumAWords); 383 | NumAWords := NumAWords div SizeOfThis; 384 | if NumAWords > 0 then 385 | begin 386 | ChatHand^^.NumActionWords := NumAWords; 387 | ActionWordHand := ActionWordHandle(NewHandleClear(SizeOf(ActionWordRec) * NumAWords)); 388 | MoveHHi(handle(ActionWordHand)); 389 | for i := 1 to NumAWords do 390 | begin 391 | result := FSRead(TheFile, SizeOfThis, @AW); 392 | ActionWordHand^^[i - 1].ActionWord := AW.ActionWord; 393 | ActionWordHand^^[i - 1].Offset := (i - 1) * SizeOfThis; 394 | end; 395 | SortActionWordList; 396 | end 397 | else 398 | SysBeep(0); 399 | result := FSClose(TheFile); 400 | end 401 | else 402 | SysBeep(0); 403 | end; 404 | 405 | procedure SaveRemoveActionWord (Save: boolean; AW: ActionWordRec; Offset: longint); 406 | var 407 | result: OSErr; 408 | TheFile, TheFile2, i: integer; 409 | SizeOfAW, FilePos: longint; 410 | Done: boolean; 411 | begin 412 | result := FSOpen(concat(sharedPath, 'Shared Files:Action Words'), 0, TheFile); 413 | if result = noErr then 414 | begin 415 | SizeOfAW := SizeOf(ActionWordRec); 416 | if (Save) and (OffSet <> -1) then 417 | begin 418 | result := SetFPos(TheFile, fsFromStart, Offset); 419 | result := FSWrite(TheFile, SizeOfAW, @AW); 420 | result := FSClose(TheFile); 421 | end 422 | else if (Save) and (Offset = -1) then {If Offset = -1 then New Action Word} 423 | begin 424 | result := SetFPos(TheFile, fsFromLEOF, 0); 425 | result := FSWrite(TheFile, SizeOfAW, @AW); 426 | SetHandleSize(handle(ActionWordHand), GetHandleSize(handle(ActionWordHand)) + SizeOfAW); 427 | ChatHand^^.NumActionWords := ChatHand^^.NumActionWords + 1; 428 | ActionWordHand^^[ChatHand^^.NumActionWords - 1].ActionWord := AW.ActionWord; 429 | result := GetFPos(TheFile, FilePos); 430 | FilePos := FilePos - SizeOfAW; 431 | ActionWordHand^^[ChatHand^^.NumActionWords - 1].Offset := FilePos; 432 | result := FSClose(TheFile); 433 | end 434 | else if not Save then 435 | begin 436 | if ChatHand^^.NumActionWords - 1 > 0 then 437 | begin 438 | result := Create(concat(sharedPath, 'Shared Files:Action Words Temp'), 0, 'HRMS', 'DATA'); 439 | result := FSOpen(concat(sharedPath, 'Shared Files:Action Words Temp'), 0, TheFile2); 440 | FilePos := 0; 441 | for i := 1 to ChatHand^^.NumActionWords do 442 | if (SizeOfAW * (i - 1) <> Offset) then 443 | begin 444 | result := FSRead(TheFile, SizeOfAW, @AW); 445 | result := FSWrite(TheFile2, SizeOfAW, @AW); 446 | end 447 | else 448 | result := FSRead(TheFile, SizeOfAW, @AW); 449 | result := FSClose(TheFile); 450 | result := FSClose(TheFile2); 451 | result := FSDelete(concat(sharedPath, 'Shared Files:Action Words'), 0); 452 | result := Rename(concat(sharedPath, 'Shared Files:Action Words Temp'), 0, concat(sharedPath, 'Shared Files:Action Words')); 453 | LoadActionWordList; 454 | end 455 | else 456 | begin 457 | result := FSClose(TheFile); 458 | result := FSDelete(concat(sharedPath, 'Shared Files:Action Words'), 0); 459 | end; 460 | end; 461 | end; 462 | end; 463 | 464 | end. -------------------------------------------------------------------------------- /Source/SystPrefs2.p: -------------------------------------------------------------------------------- 1 | { Segments: SystPrefs2_1} 2 | unit SystemPrefs2; 3 | 4 | interface 5 | 6 | uses 7 | AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, nodePrefs, nodePrefs2, CTBUtilities; 8 | 9 | procedure OpenStrings (which: integer); 10 | procedure CloseStrings; 11 | procedure UpdateStrings; 12 | procedure ClickStrings (theEvent: EventRecord; ItemHit: Integer); 13 | procedure WhatDay (myDate: DateTimeRec; var myDayString: str255); 14 | function InTrash (trashedName: str255): boolean; 15 | procedure OpenAboutBox; 16 | procedure CloseAboutBox; 17 | procedure PrintStatus (disp: Str255); 18 | procedure StartMySound (soundName: str255; async: boolean); 19 | 20 | implementation 21 | 22 | var 23 | slist: ListHandle; 24 | tempCell: cell; 25 | EmptyCh: Char; 26 | TotalStrings: ^Integer; 27 | Hndl: Handle; 28 | offSet, theplace: Longint; 29 | theError, theRes: Integer; 30 | cSize: Point; 31 | 32 | {$S SystPrefs2_1} 33 | procedure SlideTextIn (theText: str255; vert, size: integer; useColor: boolean); 34 | var 35 | isOdd: boolean; 36 | scrPos: array[1..80] of integer; 37 | rightChar, leftChar, baseCPos, i, whichPair, numPairs, curRH, curLH: integer; 38 | begin 39 | TextSize(size); 40 | baseCPos := screenBits.bounds.right div 2 - (StringWidth(theText) div 2); 41 | i := 1; 42 | scrPos[i] := baseCPos; 43 | while (i < length(theText)) do 44 | begin 45 | i := i + 1; 46 | scrPos[i] := scrPos[i - 1] + CharWidth(thetext[i - 1]); 47 | end; 48 | if (length(theText) mod 2) > 0 then 49 | isOdd := true 50 | else 51 | isOdd := false; 52 | if isOdd then 53 | begin 54 | curRH := screenBits.bounds.right; 55 | rightChar := length(theText) div 2 + 1; 56 | repeat 57 | if curRH > scrPos[rightChar] then 58 | begin 59 | ForeColor(blackColor); 60 | MoveTo(curRH, vert); 61 | DrawChar(theText[rightChar]); 62 | curRH := curRH - 25; 63 | if curRH < scrPos[rightChar] then 64 | curRH := scrPos[rightChar]; 65 | if useColor then 66 | ForeColor(yellowColor) 67 | else 68 | ForeColor(whiteColor); 69 | MoveTo(curRH, vert); 70 | DrawChar(theText[rightChar]); 71 | end; 72 | until (curRH = scrPos[rightChar]); 73 | for i := (rightChar + 1) to length(theText) do 74 | scrPos[i - 1] := scrPos[i]; 75 | delete(theText, rightChar, 1); 76 | end; 77 | numPairs := length(theText) div 2; 78 | whichPair := 1; 79 | repeat 80 | rightChar := length(theText) div 2 + 1; 81 | leftChar := length(theText) div 2; 82 | rightChar := rightChar + whichPair - 1; 83 | leftChar := leftChar - whichPair + 1; 84 | curRH := screenBits.bounds.right; 85 | curLH := 0; 86 | repeat 87 | if curRH > scrPos[rightChar] then 88 | begin 89 | ForeColor(blackColor); 90 | MoveTo(curRH, vert); 91 | DrawChar(theText[rightChar]); 92 | if size < 18 then 93 | curRH := curRH - 40 94 | else 95 | curRH := curRH - 25; 96 | if curRH < scrPos[rightChar] then 97 | curRH := scrPos[rightChar]; 98 | if useColor then 99 | ForeColor(yellowColor) 100 | else 101 | ForeColor(whiteColor); 102 | MoveTo(curRH, vert); 103 | DrawChar(theText[rightChar]); 104 | end; 105 | if curLH < scrPos[leftChar] then 106 | begin 107 | ForeColor(blackColor); 108 | MoveTo(curLH, vert); 109 | DrawChar(theText[leftChar]); 110 | if size < 18 then 111 | curLH := curLH + 40 112 | else 113 | curLH := curLH + 25; 114 | if curLH > scrPos[leftChar] then 115 | curLH := scrPos[leftChar]; 116 | if useColor then 117 | ForeColor(yellowColor) 118 | else 119 | ForeColor(whiteColor); 120 | MoveTo(curLH, vert); 121 | DrawChar(theText[leftChar]); 122 | end; 123 | until (curRH = scrPos[rightChar]) and (curLH = scrPos[leftChar]); 124 | whichPair := whichPair + 1; 125 | until (whichPair > numPairs); 126 | end; 127 | 128 | procedure EndMySound; 129 | begin 130 | if myChannel <> nil then 131 | begin 132 | result := SndDisposeChannel(myChannel, true); 133 | DisposPtr(ptr(myChannel)); 134 | myChannel := nil; 135 | if mySound <> nil then 136 | HPurge(mySound); 137 | mySound := nil; 138 | end; 139 | end; 140 | 141 | {$D-} 142 | 143 | procedure mySndCallBack (theChan: SndChannelPtr; theCmd: SndCommand); 144 | var 145 | myA5: longint; 146 | begin 147 | if theCmd.param1 = 1 then 148 | begin 149 | myA5 := SetA5(theCmd.param2); 150 | gSndCalledBack := true; 151 | myA5 := SetA5(myA5); 152 | end; 153 | end; 154 | 155 | {$D+} 156 | 157 | procedure StartMySound (soundName: str255; async: boolean); 158 | var 159 | mySndCmd: SndCommand; 160 | begin 161 | myChannel := SndChannelPtr(NewPtrClear(SizeOf(SndChannel))); 162 | myChannel^.qLength := stdQLength; 163 | mySound := GetNamedResource('snd ', soundName); 164 | if (mySound <> nil) then 165 | begin 166 | if SndNewChannel(myChannel, 0, initMono, nil) <> noErr then 167 | begin 168 | ReleaseResource(mySound); 169 | mySound := nil; 170 | DisposPtr(ptr(myChannel)); 171 | myChannel := nil; 172 | end 173 | else 174 | begin 175 | gSndCalledBack := false; 176 | if async then 177 | myChannel^.callBack := @mySndCallBack; 178 | result := SndPlay(myChannel, mySound, async); 179 | if async then 180 | begin 181 | mySndCmd.cmd := callBackCmd; 182 | mySndCmd.param1 := 1; 183 | mySndCmd.param2 := SetCurrentA5; 184 | result := SndDoCommand(myChannel, mySndCmd, TRUE); 185 | end 186 | else 187 | EndMySound; 188 | end; 189 | end; 190 | end; 191 | 192 | function RetStr (index: integer): str255; 193 | var 194 | ts: str255; 195 | begin 196 | UseResFile(StringsRes); 197 | GetIndString(RetStr, stringSet, index); 198 | UseResFile(myResourceFile); 199 | end; 200 | 201 | 202 | procedure OpenAboutBox; 203 | var 204 | freeMemoryStr: Str255; 205 | freeMemory: LONGINT; 206 | serialStr: Str255; 207 | statusStr: Str255; 208 | begin 209 | if AboutDilg = nil then 210 | begin 211 | AboutDilg := GetNewDialog(1539, nil, pointer(-1)); 212 | 213 | freeMemory := MaxMem(freeMemory); 214 | NumToString(freeMemory, freeMemoryStr); 215 | 216 | if (length(InitSystHand^^.realSerial) > 0) then 217 | serialStr := copy(InitSystHand^^.realSerial, 1, 8) 218 | else 219 | serialStr := 'Unregistered'; 220 | 221 | statusStr := 'Okay'; 222 | 223 | SetDItemText(AboutDilg, 1, HERMES_VERSION); 224 | SetDItemText(AboutDilg, 2, freeMemoryStr); 225 | SetDItemText(AboutDilg, 3, serialStr); 226 | SetDItemText(AboutDilg, 4, statusStr); 227 | MoveWindow(AboutDilg, (screenbits.bounds.right - (AboutDilg^.portRect.right - AboutDilg^.portRect.left)) div 2, (screenbits.bounds.bottom - (AboutDilg^.portRect.bottom - AboutDilg^.portRect.Top)) div 2, true); 228 | ShowWindow(aboutDilg); 229 | SelectWindow(aboutDilg); 230 | DrawDialog(aboutDilg); 231 | end; 232 | end; 233 | 234 | procedure PrintStatus (disp: Str255); 235 | var 236 | itemRect: Rect; 237 | itemHandle: Handle; 238 | itemType: INTEGER; 239 | savedPort: GrafPtr; 240 | begin 241 | if (AboutDilg <> nil) then 242 | begin 243 | GetDItem(aboutDilg, 4, itemType, itemHandle, itemRect); 244 | if (itemHandle <> nil) then 245 | begin 246 | GetPort(savedPort); 247 | SetPort(aboutDilg); 248 | SetDItemText(AboutDilg, 4, disp); 249 | SetPort(savedPort); 250 | end; 251 | end; 252 | end; 253 | 254 | procedure CloseAboutBox; 255 | begin 256 | if AboutDilg <> nil then 257 | begin 258 | DisposDialog(AboutDilg); 259 | AboutDilg := nil; 260 | FlushEvents(mouseDown + mouseUp, 0); 261 | end; 262 | end; 263 | 264 | function InTrash (trashedName: str255): boolean; 265 | var 266 | trashRef, i, lastI: integer; 267 | lengTrash: longint; 268 | trashStuff: CharsHandle; 269 | checkStr: str255; 270 | begin 271 | inTrash := false; 272 | UprString(trashedName, true); 273 | result := FSOpen(concat(sharedPath, 'Misc:Trash Users'), 0, trashRef); 274 | if result = noErr then 275 | begin 276 | result := GetEOF(trashRef, lengTrash); 277 | if lengTrash > 0 then 278 | begin 279 | trashStuff := CharsHandle(NewHandle(lengTrash)); 280 | if memError = noErr then 281 | begin 282 | result := FSRead(trashref, lengTrash, pointer(trashStuff^)); 283 | i := 0; 284 | lastI := 0; 285 | while (i <= lengTrash) do 286 | begin 287 | if (trashStuff^^[i] = char(13)) then 288 | begin 289 | checkStr[0] := char(i - lastI); 290 | BlockMove(pointer(ord4(@trashStuff^^[lastI])), pointer(ord4(@checkStr[1])), i - lastI); 291 | if pos(checkStr, trashedName) > 0 then 292 | inTrash := true; 293 | lastI := i + 1; 294 | end; 295 | i := i + 1; 296 | end; 297 | DisposHandle(handle(trashStuff)); 298 | end; 299 | end; 300 | result := FSClose(trashRef); 301 | end; 302 | end; 303 | 304 | procedure WhatDay; 305 | begin 306 | case myDate.dayOfWeek of 307 | 1: 308 | myDayString := 'Sun, '; 309 | 2: 310 | myDayString := 'Mon, '; 311 | 3: 312 | myDayString := 'Tue, '; 313 | 4: 314 | myDayString := 'Wed, '; 315 | 5: 316 | myDayString := 'Thu, '; 317 | 6: 318 | myDayString := 'Fri, '; 319 | 7: 320 | myDayString := 'Sat, '; 321 | otherwise 322 | end; 323 | end; 324 | 325 | procedure WriteString; 326 | var 327 | DType: integer; 328 | DItem: Handle; 329 | tempRect: rect; 330 | tempString: Str255; 331 | i: integer; 332 | begin 333 | if LGetSelect(true, tempCell, sList) then 334 | begin 335 | if (EditingString > 0) then 336 | begin 337 | GetDItem(StringDilg, 4, DType, DItem, tempRect); 338 | GetIText(DItem, TempString); 339 | EmptyCh := Char(0); 340 | UseResFile(StringsRes); 341 | Hndl := GetResource('STR#', stringSet); 342 | if Hndl <> nil then 343 | begin 344 | HNoPurge(Hndl); 345 | TotalStrings := Pointer(Ord4(Hndl^)); 346 | offset := 2; 347 | for i := 1 to Pred(EditingString) do 348 | offset := offset + Succ(Length(RetStr(i))); 349 | theplace := Munger(Hndl, offset, nil, Succ(Length(RetStr(EditingString))), Pointer(Ord4(@TempString)), Succ(Length(TempString))); 350 | ChangedResource(Hndl); 351 | theError := ResError; 352 | if theError = noErr then 353 | WriteResource(Hndl); 354 | HPurge(Hndl); 355 | ReleaseResource(Hndl); 356 | UseResFile(MyResourceFile); 357 | end 358 | else 359 | ProblemRep(StringOf('Error #', reserror : 0, ' With String Resources.')); 360 | end; 361 | end; 362 | end; 363 | 364 | procedure CloseStrings; 365 | begin 366 | if (StringDilg <> nil) then 367 | begin 368 | WriteString; 369 | LDispose(slist); 370 | DisposDialog(StringDilg); 371 | StringDilg := nil; 372 | end; 373 | end; 374 | 375 | procedure UpDateStrings; 376 | var 377 | SavePort: WindowPtr; 378 | tempRect: rect; 379 | begin 380 | if (StringDilg <> nil) then 381 | begin 382 | GetPort(SavePort); 383 | SetPort(StringDilg); 384 | EraseRect(StringDilg^.portRect); 385 | DrawDialog(StringDilg); 386 | TempRect := sList^^.rView; 387 | InsetRect(TempRect, -1, -1); 388 | FrameRect(TempRect); 389 | 390 | LUpdate(StringDilg^.visRgn, sList); 391 | 392 | SetPort(SavePort); 393 | end; 394 | end; 395 | 396 | procedure ClickStrings (theEvent: EventRecord; itemHit: integer); 397 | var 398 | myPt: Point; 399 | code, tempInt, y, i, xx: integer; 400 | tempInt2, tempLong: longint; 401 | temprect: rect; 402 | tempstring, t1, textSearch: str255; 403 | DType: integer; 404 | DItem: Handle; 405 | Doubleclick: Boolean; 406 | tc2: cell; 407 | CItem, CTempItem: controlhandle; 408 | tempMenu: Menuhandle; 409 | adder: integer; 410 | adder2: real; 411 | SearchDilg: DialogPtr; 412 | begin 413 | if (StringDilg <> nil) and (frontWindow = StringDilg) then 414 | begin 415 | with theNodes[visibleNode]^ do 416 | begin 417 | SetPort(StringDilg); 418 | myPt := theEvent.where; 419 | GlobalToLocal(myPt); 420 | GetDItem(StringDilg, itemHit, DType, DItem, tempRect); 421 | CItem := Pointer(Ditem); 422 | case ItemHit of 423 | 1: 424 | CloseStrings; 425 | 6: 426 | begin 427 | searchDilg := GetNewDialog(3468, nil, pointer(-1)); 428 | SetPort(searchDilg); 429 | ShowWindow(searchDilg); 430 | GetDItem(searchDilg, 1, Dtype, DItem, tempRect); 431 | InsetRect(tempRect, -4, -4); 432 | PenSize(3, 3); 433 | FrameRoundRect(tempRect, 16, 16); 434 | repeat 435 | ModalDialog(nil, i); 436 | until (i = 1) or (i = 2); 437 | if (i = 1) then 438 | begin 439 | GetDItem(searchDilg, 4, Dtype, Ditem, tempRect); 440 | GetIText(Ditem, textSearch); 441 | tempCell.v := 0; 442 | tempCell.h := 0; 443 | if length(textSearch) > 0 then 444 | if LSearch(Pointer(ord(@textsearch) + 1), Length(textsearch), nil, tempcell, sList) then 445 | LSetSelect(true, tempCell, sList); 446 | end; 447 | DisposDialog(searchDilg); 448 | end; 449 | 2: 450 | begin 451 | WriteString; 452 | DoubleClick := LClick(myPt, theEvent.modifiers, sList); 453 | tempCell.h := 0; 454 | tempCell.v := 0; 455 | if LGetSelect(true, tempCell, sList) then 456 | begin 457 | GetDItem(StringDilg, 4, DType, DItem, tempRect); 458 | SetIText(DItem, RetStr(tempCell.v + 1)); 459 | SelIText(StringDilg, 4, 0, 32767); 460 | EditingString := TempCell.v + 1; 461 | end; 462 | end; 463 | end; 464 | end; 465 | end; 466 | end; 467 | 468 | procedure OpenStrings (which: integer); 469 | var 470 | ThisEditText: TEHandle; 471 | TheDialogPtr: DialogPeek; 472 | tempRect, tr2: Rect; 473 | tempString: Str255; 474 | myC: Point; 475 | DType, i: integer; 476 | DItem: Handle; 477 | DataBounds: Rect; 478 | CItem, CTempItem: controlhandle; 479 | templong: longint; 480 | begin 481 | with curglobs^ do 482 | if (StringDilg = nil) then 483 | begin 484 | theRes := which; 485 | StringDilg := GetNewDialog(80, nil, Pointer(-1)); 486 | SetPort(StringDilg); 487 | TheDialogPtr := DialogPeek(StringDilg); 488 | ThisEditText := TheDialogPtr^.textH; 489 | HLock(Handle(ThisEditText)); 490 | ThisEditText^^.txSize := 12; 491 | TextSize(12); 492 | ThisEditText^^.txFont := monaco; 493 | TextFont(monaco); 494 | ThisEditText^^.txFont := 4; 495 | ThisEditText^^.fontAscent := 12; 496 | ThisEditText^^.lineHeight := 12 + 4 + 0; 497 | HUnLock(Handle(ThisEditText)); 498 | 499 | GetDItem(StringDilg, 4, DType, DItem, TempRect); 500 | TempRect.right := tempRect.Right - 15; 501 | InsetRect(TempRect, -1, -1); 502 | FrameRect(TempRect); 503 | InsetRect(TempRect, 1, 1); 504 | 505 | GetDItem(StringDilg, 2, DType, DItem, tempRect); 506 | TempRect.right := tempRect.Right - 15; 507 | InsetRect(TempRect, -1, -1); 508 | FrameRect(TempRect); 509 | InsetRect(TempRect, 1, 1); 510 | SetRect(dataBounds, 0, 0, 1, 0); 511 | csize.h := tempRect.Right - tempRect.Left; 512 | csize.v := 16; 513 | slist := LNew(tempRect, DataBounds, cSize, 0, StringDilg, false, false, false, true); 514 | slist^^.selFlags := lOnlyOne + lNoNilHilite; 515 | i := 0; 516 | repeat 517 | i := i + 1; 518 | GetIndString(TempString, 17, i); 519 | if length(tempString) > 0 then 520 | AddListString(tempString, slist); 521 | until (length(tempString) = 0); 522 | LDoDraw(True, slist); 523 | csize.h := 0; 524 | csize.v := 0; 525 | 526 | EditingString := 0; 527 | 528 | ShowWindow(StringDilg); 529 | SelectWindow(StringDilg); 530 | end 531 | else 532 | SelectWindow(StringDilg); 533 | end; 534 | end. -------------------------------------------------------------------------------- /Source/TCPTypes.p: -------------------------------------------------------------------------------- 1 | unit TCPTypes; 2 | 3 | { TCPTypes © Peter Lewis, Oct 1991 } 4 | { This source is Freeware } 5 | 6 | interface 7 | 8 | { Hacks } 9 | type 10 | unsignedword = INTEGER; 11 | unsignedlong = LONGINT; 12 | 13 | { Stolen from MacTypes.p } 14 | type 15 | SInt8 = -128..127; 16 | SInt16 = INTEGER; 17 | SInt32 = LONGINT; 18 | UInt8 = 0..255; 19 | UInt16 = INTEGER; 20 | UInt32 = LONGINT; 21 | 22 | {$PUSH} 23 | {$ALIGN MAC68K} 24 | 25 | { MacTCP return Codes in the range -23000 through -23049 } 26 | const 27 | ipBadLapErr = -23000; { bad network configuration } 28 | ipBadCnfgErr = -23001; { bad IP configuration error } 29 | ipNoCnfgErr = -23002; { missing IP or LAP configuration error } 30 | ipLoadErr = -23003; { error in MacTCP load } 31 | ipBadAddrErr = -23004; { error in getting address } 32 | connectionClosingErr = -23005; { connection is closing } 33 | invalidLengthErr = -23006; 34 | connectionExistsErr = -23007; { request conflicts with existing connection } 35 | connectionDoesntExistErr = -23008; { connection does not exist } 36 | insufficientResourcesErr = -23009; { insufficient resources to perform request } 37 | invalidStreamPtrErr = -23010; 38 | streamAlreadyOpenErr = -23011; 39 | connectionTerminatedErr = -23012; 40 | invalidBufPtrErr = -23013; 41 | invalidRDSErr = -23014; 42 | invalidWDSErr = -23014; 43 | openFailedErr = -23015; 44 | commandTimeoutErr = -23016; 45 | duplicateSocketErr = -23017; 46 | 47 | { Error codes from internal IP functions } 48 | ipDontFragErr = -23032; { Packet too large to send w/o fragmenting } 49 | ipDestDeadErr = -23033; { destination not responding } 50 | icmpEchoTimeoutErr = -23035; { ICMP echo timed-out } 51 | ipNoFragMemErr = -23036; { no memory to send fragmented pkt } 52 | ipRouteErr = -23037; { can't route packet off-net } 53 | 54 | nameSyntaxErr = -23041; 55 | cacheFaultErr = -23042; 56 | noResultProcErr = -23043; 57 | noNameServerErr = -23044; 58 | authNameErrErr = -23045; 59 | noAnsErr = -23046; 60 | dnrErr = -23047; 61 | outOfMemoryErr = -23048; 62 | 63 | { connectionState } 64 | const 65 | CState_Closed = 0; 66 | CState_Listening = 2; 67 | CState_Opening1 = 4; 68 | CState_Opening2 = 6; 69 | CState_Established = 8; 70 | CState_Closing1 = 10; 71 | CState_Closing2 = 12; 72 | CState_Closing3 = 16; 73 | CState_Closing4 = 18; 74 | CState_Closing5 = 20; 75 | CState_PleaseClose = 14; 76 | 77 | type 78 | AddrClasses = integer; 79 | const 80 | AC_A = 1; 81 | AC_NS = 2; 82 | AC_CNAME = 5; 83 | AC_HINFO = 13; 84 | AC_MX = 15; 85 | 86 | const 87 | CTRUE = $FF; 88 | CFALSE = $00; 89 | 90 | type 91 | C_BOOLEAN = SignedByte; 92 | CSTRING = Ptr; 93 | CStr30 = packed array[0..29] of char; 94 | CStr255 = packed array[0..255] of char; 95 | ipAddr = unsignedlong; 96 | ipAddrArray = array[1..1000] of ipAddr; 97 | ipAddrArrayPtr = ^ipAddrArray; 98 | ipPort = unsignedword; 99 | StreamPtr = Ptr; 100 | 101 | type 102 | wdsType = record { Write block for TCP driver. } 103 | size: UInt16; { Number of bytes. } 104 | buffer: Ptr; { Pointer to bytes. } 105 | term: UInt16; { Zero for end of blocks. } 106 | end; 107 | wdsPtr = ^wdsType; 108 | wdsEntry = record 109 | size: UInt16; { Number of bytes. } 110 | buffer: Ptr; { Pointer to bytes. } 111 | end; 112 | 113 | type 114 | HInfoRec = record 115 | cpuType: CStr30; 116 | osType: CStr30; 117 | end; 118 | 119 | type 120 | MXRec = record 121 | preference: integer; { unsigned! } 122 | exchange: CStr255; 123 | end; 124 | 125 | type 126 | hostInfo = record 127 | rtnCode: longint; 128 | rtnHostName: CStr255; 129 | case integer of 130 | 1: ( 131 | addrs: array[1..4] of ipAddr; 132 | ); 133 | 2: ( 134 | hinfo: HInfoRec; 135 | ); 136 | 3: ( 137 | mx: MXRec; 138 | ); 139 | end; 140 | hostInfoPtr = ^hostInfo; 141 | {} 142 | { hostInfo = record} 143 | { rtnCode: longint;} 144 | { rtnHostName: Str255;} 145 | { addrs: array[1..4] of ipAddr;} 146 | { end;} 147 | { hostInfoPtr = ^hostInfo;} 148 | {} 149 | 150 | type 151 | cacheEntryRecord = record 152 | cname: CSTRING; 153 | typ: integer; 154 | class: integer; 155 | ttl: longint; 156 | case integer of 157 | 1: ( 158 | name: CSTRING; 159 | ); 160 | 2: ( 161 | addr: ipAddr; 162 | ); 163 | end; 164 | cacheEntryRecordPtr = ^cacheEntryRecord; 165 | 166 | const { csCodes for the TCP driver: } 167 | TCPcsGetMyIP = 15; 168 | TCPcsEchoICMP = 17; 169 | TCPcsLAPStats = 19; 170 | TCPcsCreate = 30; 171 | TCPcsPassiveOpen = 31; 172 | TCPcsActiveOpen = 32; 173 | { TCPcsActOpenWithData = 33;} 174 | TCPcsSend = 34; 175 | TCPcsNoCopyRcv = 35; 176 | TCPcsRcvBfrReturn = 36; 177 | TCPcsRcv = 37; 178 | TCPcsClose = 38; 179 | TCPcsAbort = 39; 180 | TCPcsStatus = 40; 181 | TCPcsExtendedStat = 41; 182 | TCPcsRelease = 42; 183 | TCPcsGlobalInfo = 43; 184 | 185 | UDPcsCreate = 20; 186 | UDPcsRead = 21; 187 | UDPcsBfrReturn = 22; 188 | UDPcsWrite = 23; 189 | UDPcsRelease = 24; 190 | UDPcsMaxMTUSize = 25; 191 | UDPcsStatus = 26; 192 | UDPcsMultiCreate = 27; 193 | UDPcsMultiSend = 28; 194 | UDPcsMultiRead = 29; 195 | 196 | type 197 | TCPEventCode = integer; 198 | const 199 | TEC_Closing = 1; 200 | TEC_ULPTimeout = 2; 201 | TEC_Terminate = 3; 202 | TEC_DataArrival = 4; 203 | TEC_Urgent = 5; 204 | TEC_ICMPReceived = 6; 205 | TEC_last = 32767; 206 | 207 | type 208 | UDPEventCode = integer; 209 | const 210 | UDPDataArrival = 1; 211 | UDPICMPReceived = 2; 212 | lastUDPEvent = 32767; 213 | 214 | type 215 | TCPTerminateReason = integer; 216 | const {TCPTerminateReasons: } 217 | TTR_RemoteAbort = 2; 218 | TTR_NetworkFailure = 3; 219 | TTR_SecPrecMismatch = 4; 220 | TTR_ULPTimeoutTerminate = 5; 221 | TTR_ULPAbort = 6; 222 | TTR_ULPClose = 7; 223 | TTR_ServiceError = 8; 224 | TTR_last = 32767; 225 | 226 | type 227 | ICMPMsgType = integer; 228 | const 229 | ICMP_NetUnreach = 0; 230 | ICMP_HostUnreach = 1; 231 | ICMP_ProtocolUnreach = 2; 232 | ICMP_PortUnreach = 3; 233 | ICMP_FragReqd = 4; 234 | ICMP_SourceRouteFailed = 5; 235 | ICMP_TimeExceeded = 6; 236 | ICMP_ParmProblem = 7; 237 | ICMP_MissingOption = 8; 238 | 239 | type 240 | TCPNotifyProc = ProcPtr; 241 | { procedure TCPNotifyProc(tcpStream:StreamPtr; event:TCPEventCode; userDataPtr:Ptr; } 242 | { terminReason:TCPTerminateReason; icmpMsg:ICMPReportPtr); } 243 | 244 | type 245 | TCPIOCompletionProc = ProcPtr; 246 | { C procedure TCPIOCompletionProc(iopb:TCPControlBlockPtr); - WHY IS THIS A C PROC???? } 247 | 248 | type 249 | UDPNotifyProc = ProcPtr; 250 | { procedure UDPProc(udpStream:StreamPtr ; eventCode:integer;userDataPtr:Ptr; icmpMsg:ICMPReportPtr) } 251 | 252 | type 253 | UDPIOCompletionProc = ProcPtr; 254 | { C procedure UDPIOCompletionProc(iopb:UDPiopb Ptr) } 255 | 256 | type 257 | ICMPEchoNotifyProc = ProcPtr; 258 | { C procedure ICMPEchoNotifyProc(iopb:IPControlBlockPtr) } 259 | { WARNING: Ignore the docs, its a C proceudre no matter what they say } 260 | 261 | type 262 | ICMPReport = record 263 | stream: StreamPtr; 264 | localhost: ipAddr; 265 | localport: ipPort; 266 | remotehost: ipAddr; 267 | remoteport: ipPort; 268 | reporttype: ICMPMsgType; 269 | optionalAddlInfo: integer; 270 | optionalAddlInfoPtr: Ptr; 271 | end; 272 | 273 | const 274 | NBP_TABLE_SIZE = 20; { number of NBP table entries } 275 | NBP_MAX_NAME_SIZE = 16 + 10 + 2; 276 | ARP_TABLE_SIZE = 20; { number of ARP table entries } 277 | 278 | type 279 | nbpEntry = record 280 | ip_address: ipAddr; { IP address } 281 | at_address: longint; { matching AppleTalk address } 282 | gateway: Boolean; { TRUE if entry for a gateway } 283 | valid: Boolean; { TRUE if LAP address is valid } 284 | probing: Boolean; { TRUE if NBP lookup pending } 285 | age: integer; { ticks since cache entry verified } 286 | access: integer; { ticks since last access } 287 | filler: packed array[1..116] of Byte; { for internal use only !!! } 288 | end; 289 | EnetAddr = record 290 | en_hi: integer; 291 | en_lo: longint; 292 | end; 293 | arpEntry = record 294 | age: integer; { cache aging field } 295 | protocol: integer; { Protocol type } 296 | ip_address: ipAddr; { IP address } 297 | en_address: EnetAddr; { matching Ethernet address } 298 | end; 299 | AddrXlation = record 300 | case integer of 301 | 0: ( 302 | arp_table: ^arpEntry 303 | ); 304 | 1: ( 305 | nbp_entry: ^nbpEntry 306 | ) 307 | end; 308 | LAPStats = record 309 | ifType: integer; 310 | ifString: CSTRING; 311 | ifMaxMTU: integer; 312 | ifSpeed: longint; 313 | ifPhyAddrLength: integer; 314 | ifPhysicalAddress: CSTRING; 315 | addr: AddrXlation; 316 | slotNumber: integer; 317 | end; 318 | IPEchoPB = record 319 | dest: ipAddr; { echo to IP address } 320 | data: wdsEntry; 321 | timeout: integer; 322 | options: Ptr; 323 | optlength: integer; 324 | icmpCompletion: ICMPEchoNotifyProc; 325 | userDataPtr: Ptr; 326 | end; 327 | LAPStatsPB = record 328 | lapStatsPtr: ^LAPStats; 329 | end; 330 | ICMPEchoInfo = record 331 | params: array[1..11] of integer; 332 | echoRequestOut: longint; { time in ticks of when the echo request went out } 333 | echoReplyIn: longint; { time in ticks of when the reply was received } 334 | data: wdsEntry; { data received in responce } 335 | options: Ptr; 336 | userDataPtr: Ptr; 337 | end; 338 | IPGetMyIPPB = record 339 | ourAddress: ipAddr; { our IP address } 340 | ourNetMask: ipAddr; { our IP net mask } 341 | end; 342 | 343 | IPControlBlock = record 344 | qLink: QElemPtr; 345 | qType: INTEGER; 346 | ioTrap: INTEGER; 347 | ioCmdAddr: Ptr; 348 | ioCompletion: TCPIOCompletionProc; {completion routine, or NIL if none} 349 | ioResult: OSErr; {result code} 350 | ioNamePtr: StringPtr; 351 | ioVRefNum: INTEGER; 352 | ioCRefNum: INTEGER; {device refnum} 353 | case csCode : integer of 354 | TCPcsGetMyIP: ( 355 | getmyip: IPGetMyIPPB; 356 | ); 357 | TCPcsEchoICMP: ( 358 | echo: IPEchoPB 359 | ); 360 | 9999: ( 361 | echoinfo: ICMPEchoInfo 362 | ); 363 | TCPcsLAPStats: ( 364 | lapstat: LAPStatsPB 365 | ); 366 | end; 367 | IPControlBlockPtr = ^IPControlBlock; 368 | 369 | type 370 | UDPCreatePB = record { for create and release calls } 371 | rcvBuff: Ptr; 372 | rcvBuffLen: longint; 373 | notifyProc: UDPNotifyProc; 374 | localport: ipPort; 375 | userDataPtr: Ptr; 376 | endingPort: ipPort; 377 | end; 378 | 379 | type 380 | UDPSendPB = record 381 | reserved: integer; 382 | remoteip: ipAddr; 383 | remoteport: ipPort; 384 | wds: wdsPtr; 385 | checksum: SignedByte; 386 | sendLength: integer; 387 | userDataPtr: Ptr; 388 | localport: ipPort; 389 | end; 390 | 391 | type 392 | UDPReceivePB = record 393 | timeout: integer; 394 | remoteip: ipAddr; 395 | remoteport: ipPort; 396 | rcvBuff: Ptr; 397 | rcvBuffLen: integer; 398 | secondTimeStamp: integer; 399 | userDataPtr: Ptr; 400 | destHost: ipAddr; 401 | destPort: ipPort; 402 | end; 403 | 404 | type 405 | UDPMTUPB = record 406 | mtuSize: integer; 407 | remoteip: ipAddr; 408 | userDataPtr: Ptr; 409 | end; 410 | 411 | type 412 | UDPControlBlock = record 413 | qLink: QElemPtr; 414 | qType: INTEGER; 415 | ioTrap: INTEGER; 416 | ioCmdAddr: Ptr; 417 | ioCompletion: UDPIOCompletionProc; 418 | ioResult: OSErr; 419 | ioNamePtr: StringPtr; 420 | ioVRefNum: integer; 421 | ioCRefNum: integer; 422 | csCode: integer; 423 | udpStream: StreamPtr; 424 | case integer of 425 | UDPcsCreate, UDPcsMultiCreate, UDPcsRelease: ( 426 | create: UDPCreatePB 427 | ); 428 | UDPcsWrite, UDPcsMultiSend: ( 429 | send: UDPSendPB 430 | ); 431 | UDPcsRead, UDPcsMultiRead: ( 432 | receive: UDPReceivePB 433 | ); 434 | UDPcsBfrReturn: ( 435 | return: UDPReceivePB 436 | ); 437 | UDPcsMaxMTUSize: ( 438 | mtu: UDPMTUPB 439 | ); 440 | end; 441 | UDPControlBlockPtr = ^UDPControlBlock; 442 | 443 | const { Validity Flags } 444 | timeOutValue = $80; 445 | timeOutAction = $40; 446 | typeOfService = $20; 447 | precedence = $10; 448 | 449 | const { TOSFlags } 450 | lowDelay = $01; 451 | throughPut = $02; 452 | reliability = $04; 453 | 454 | type 455 | TCPCreatePB = packed record 456 | rcvBuff: Ptr; 457 | rcvBuffLen: longint; 458 | notifyProc: TCPNotifyProc; 459 | userDataPtr: Ptr; 460 | end; 461 | 462 | TCPOpenPB = packed record 463 | ulpTimeoutValue: Byte; 464 | ulpTimeoutAction: SignedByte; 465 | validityFlags: Byte; 466 | commandTimeoutValue: Byte; 467 | remotehost: ipAddr; 468 | remoteport: ipPort; 469 | localhost: ipAddr; 470 | localport: ipPort; 471 | tosFlags: Byte; 472 | precedence: Byte; 473 | dontFrag: C_BOOLEAN; 474 | timeToLive: Byte; 475 | security: Byte; 476 | optionCnt: Byte; 477 | options: array[0..39] of Byte; 478 | userDataPtr: Ptr; 479 | end; 480 | 481 | TCPSendPB = packed record 482 | ulpTimeoutValue: Byte; 483 | ulpTimeoutAction: SignedByte; 484 | validityFlags: Byte; 485 | pushFlag: Byte; 486 | urgentFlag: C_BOOLEAN; 487 | wds: wdsPtr; 488 | sendFree: longint; 489 | sendLength: integer; 490 | userDataPtr: Ptr; 491 | end; 492 | 493 | TCPReceivePB = packed record 494 | commandTimeoutValue: Byte; 495 | filler: Byte; 496 | markFlag: C_BOOLEAN; 497 | urgentFlag: C_BOOLEAN; 498 | rcvBuff: Ptr; 499 | rcvBuffLength: integer; 500 | rdsPtr: Ptr; 501 | rdsLength: integer; 502 | secondTimeStamp: integer; 503 | userDataPtr: Ptr; 504 | end; 505 | 506 | TCPClosePB = packed record 507 | ulpTimeoutValue: Byte; 508 | ulpTimeoutAction: SignedByte; 509 | validityFlags: Byte; 510 | userDataPtrX: Ptr; { Thats mad! Its not on a word boundary! Parhaps a documentation bug??? } 511 | end; 512 | 513 | HistoBucket = packed record 514 | value: integer; 515 | counter: longint; 516 | end; 517 | 518 | const 519 | NumOfHistoBuckets = 7; 520 | 521 | type 522 | TCPConnectionStats = packed record 523 | dataPktsRcvd: longint; 524 | dataPktsSent: longint; 525 | dataPktsResent: longint; 526 | bytesRcvd: longint; 527 | bytesRcvdDup: longint; 528 | bytesRcvdPastWindow: longint; 529 | bytesSent: longint; 530 | bytesResent: longint; 531 | numHistoBuckets: integer; 532 | sentSizeHisto: array[1..NumOfHistoBuckets] of HistoBucket; 533 | lastRTT: unsignedword; 534 | tmrRTT: unsignedword; 535 | rttVariance: unsignedword; 536 | tmrRTO: unsignedword; 537 | sendTries: Byte; 538 | sourceQuenchRcvd: Byte; 539 | end; 540 | TCPConnectionStatsPtr = ^TCPConnectionStats; 541 | 542 | TCPStatusPB = packed record 543 | ulpTimeoutValue: Byte; 544 | ulpTimeoutAction: SignedByte; 545 | unused: longint; 546 | remotehost: ipAddr; 547 | remoteport: ipPort; 548 | localhost: ipAddr; 549 | localport: ipPort; 550 | tosFlags: Byte; 551 | precedence: Byte; 552 | connectionState: Byte; 553 | filler: Byte; 554 | sendWindow: integer; 555 | rcvWindow: integer; 556 | amtUnackedData: integer; 557 | amtUnreadData: integer; 558 | securityLevelPtr: Ptr; 559 | sendUnacked: longint; 560 | sendNext: longint; 561 | congestionWindow: longint; 562 | rcvNext: longint; 563 | srtt: longint; 564 | lastRTT: longint; 565 | sendMaxSegSize: longint; 566 | connStatPtr: TCPConnectionStatsPtr; 567 | userDataPtr: Ptr; 568 | end; 569 | 570 | TCPAbortPB = packed record 571 | userDataPtr: Ptr; 572 | end; 573 | 574 | TCPParam = packed record 575 | tcpRTOA: StringPtr; 576 | tcpRTOMin: longint; 577 | tcpRTOMax: longint; 578 | tcpMaxSegSize: longint; 579 | tcpMaxConn: longint; 580 | tcpMaxWindow: longint; 581 | end; 582 | TCPParamPtr = ^TCPParam; 583 | 584 | TCPStats = packed record 585 | tcpConnAttempts: longint; 586 | tcpConnOpened: longint; 587 | tcpConnAccepted: longint; 588 | tcpConnClosed: longint; 589 | tcpConnAborted: longint; 590 | tcpOctetsIn: longint; 591 | tcpOctetsOut: longint; 592 | tcpOctetsInDup: longint; 593 | tcpOctetsRetrans: longint; 594 | tcpInputPackets: longint; 595 | tcpOutputPkts: longint; 596 | tcpDupPkts: longint; 597 | tcpRetransPkts: longint; 598 | end; 599 | TCPStatsPtr = ^TCPStats; 600 | 601 | StreamPtrArray = array[1..1000] of StreamPtr; 602 | StreamPtrArrayPtr = ^StreamPtrArray; 603 | 604 | TCPGlobalInfoPB = packed record 605 | tcpParamp: TCPParamPtr; 606 | tcpStatsp: TCPStatsPtr; 607 | tcpCDBTable: StreamPtrArrayPtr; 608 | userDataPtr: Ptr; 609 | maxTCPConnections: integer; 610 | end; 611 | 612 | TCPControlBlock = record 613 | qLink: QElemPtr; 614 | qType: INTEGER; 615 | ioTrap: INTEGER; 616 | ioCmdAddr: Ptr; 617 | ioCompletion: TCPIOCompletionProc; {completion routine, or NIL if none} 618 | ioResult: OSErr; {result code} 619 | ioNamePtr: StringPtr; 620 | ioVRefNum: INTEGER; 621 | ioCRefNum: INTEGER; {device refnum} 622 | csCode: integer; 623 | tcpStream: StreamPtr; 624 | case integer of 625 | TCPcsCreate: ( 626 | create: TCPCreatePB 627 | ); 628 | TCPcsActiveOpen, TCPcsPassiveOpen: ( 629 | open: TCPOpenPB; 630 | ); 631 | TCPcsSend: ( 632 | send: TCPSendPB; 633 | ); 634 | TCPcsNoCopyRcv, TCPcsRcvBfrReturn, TCPcsRcv: ( 635 | receive: TCPReceivePB; 636 | ); 637 | TCPcsClose: ( 638 | close: TCPClosePB; 639 | ); 640 | TCPcsAbort: ( 641 | abort: TCPAbortPB; 642 | ); 643 | TCPcsStatus: ( 644 | status: TCPStatusPB; 645 | ); 646 | TCPcsGlobalInfo: ( 647 | globalInfo: TCPGlobalInfoPB 648 | ); 649 | end; 650 | TCPControlBlockPtr = ^TCPControlBlock; 651 | 652 | {$ALIGN RESET} 653 | {$POP} 654 | 655 | implementation 656 | 657 | end. -------------------------------------------------------------------------------- /Source/HUtils7.p: -------------------------------------------------------------------------------- 1 | { Segments: HUtils7_1 } 2 | unit HUtils7; 3 | 4 | interface 5 | uses 6 | Processes, AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, NodePrefs, NodePrefs2, InpOut4, InpOut3, inpout2, InpOut, ChatroomUtils, User, terminal, SystemPrefs, Message_Editor, Import, fileTrans, FileTrans2, HUtils2, HermesUtils, notification, PPCToolbox, Processes, EPPC, AppleEvents, HUtils3, HUtils5, HUtils6, Telnet; 7 | 8 | procedure IdleUser; 9 | procedure PixelToBBSPos (thePixel: point; var thetextpos: point); 10 | procedure HighlightChar (whichChar: point); 11 | procedure HandleSelection (aPoint: point; theEvent: EventRecord); 12 | procedure VActionProc (control: ControlHandle; part: INTEGER); 13 | procedure StartSS; 14 | procedure EndSS; 15 | procedure DrawSSInfo; 16 | procedure OpenSSLock; 17 | procedure UpdateSSLock (theWindow: windowPtr); 18 | procedure DoSSLock (theEvent: EventRecord; itemHit: integer); 19 | procedure CloseSSLock (GotIt: boolean); 20 | 21 | implementation 22 | const 23 | GrayRgn = $09EE; 24 | MBarHeight = $0BAA; 25 | 26 | type 27 | RgnHdlPtr = ^RgnHandle; 28 | WordPtr = ^INTEGER; 29 | var 30 | ourProcess, savedFProcess: ProcessSerialNumber; 31 | 32 | {$S HUtils7_1} 33 | procedure StartSS; 34 | var 35 | screenRgn, savedGray, newGray: RgnHandle; 36 | same: boolean; 37 | begin 38 | screenSaver := true; 39 | if (gMac.systemVersion >= $0700) then 40 | begin 41 | result := GetFrontProcess(savedFProcess); 42 | result := GetCurrentProcess(ourProcess); 43 | result := SameProcess(savedFProcess, ourProcess, same); 44 | if not same then 45 | result := SetFrontProcess(ourProcess); 46 | end; 47 | gMBarHeight := WordPtr(MBarHeight)^; 48 | WordPtr(MBarHeight)^ := 0; 49 | screenRgn := NewRgn; 50 | RectRgn(screenRgn, screenBits.bounds); 51 | savedGray := RgnHdlPtr(GrayRgn)^; 52 | newGray := NewRgn; 53 | UnionRgn(screenRgn, savedGray, newGray); 54 | RgnHdlPtr(GrayRgn)^ := newGray; 55 | ssWind := NewWindow(nil, screenBits.bounds, '', true, 2, pointer(-1), false, 0); 56 | SetPort(ssWind); 57 | BackColor(blackColor); 58 | EraseRect(screenBits.bounds); 59 | RgnHdlPtr(GrayRgn)^ := savedGray; 60 | DisposeRgn(newGray); 61 | HideCursor; 62 | lastSSDraw := 0; 63 | end; 64 | 65 | procedure EndSS; 66 | var 67 | clobberedRgn: RgnHandle; 68 | savePort: GrafPtr; 69 | wMgrPort: GrafPtr; 70 | begin 71 | screenSaver := false; 72 | WordPtr(MBarHeight)^ := gMBarHeight; 73 | if (gMac.systemVersion >= $0700) then 74 | result := SetFrontProcess(savedFProcess); 75 | DisposeWindow(ssWind); 76 | ssWind := nil; 77 | HiliteMenu(0); 78 | DrawMenuBar; 79 | ShowCursor; 80 | end; 81 | 82 | procedure DrawSSInfo; 83 | const 84 | maxNodesPerColumn = 25; 85 | var 86 | infoStr: array[1..MAX_NODES] of str255; 87 | ts: str255; 88 | i, maxLen, b, numUsersOn, nodesDrawn: integer; 89 | stp: point; 90 | begin 91 | { Find out how many users are online. } 92 | numUsersOn := 0; 93 | for i := 1 to InitSystHand^^.numNodes do 94 | if (theNodes[i]^.boardMode = User) or (theNodes[i]^.boardMode = answering) then 95 | numUsersOn := numUsersOn + 1; 96 | 97 | { Prepare ourselves for drawing. } 98 | SetPort(ssWind); 99 | BackColor(blackColor); 100 | ForeColor(whiteColor); 101 | EraseRect(screenBits.bounds); 102 | 103 | { Set the font and size. } 104 | TextFont(0); 105 | TextSize(16); 106 | 107 | { Draw the stat lines if there are no users online. } 108 | if numUsersOn = 0 then 109 | begin 110 | { Build the stat strings. } 111 | infoStr[1] := stringOf('C: ', doNumber(TotalCalls), ' • T: ', doNumber(TotalMins), ' • P: ', TotalPosts : 0, ' • F: ', numFeedbacks : 0, ' • U: ', TotalUls : 0, '/', TotalFuls : 0, ' • D: ', TotalDls : 0, '/', TotalFDls : 0); 112 | infoStr[2] := stringOf('MF: ', doNumber(FreeMem div 1024), 'k • DF: ', doNumber(FreeK(sharedPath) div 1024), 'k • LU: ', InitSystHand^^.lastUser); 113 | 114 | { Figure out which string is longer and set the maxLen. } 115 | if StringWidth(infoStr[1]) > StringWidth(infoStr[2]) then 116 | maxLen := StringWidth(infoStr[1]) 117 | else 118 | maxLen := StringWidth(infoStr[2]); 119 | 120 | { Position our text. } 121 | SetPt(stp, 0, 0); 122 | b := (screenbits.bounds.right - maxLen); 123 | if b > 0 then 124 | stp.h := (ABS(RANDOM) mod b) + 1; 125 | b := (screenbits.bounds.bottom - (2 * 20)); { 2 = num lines } 126 | if b > 0 then 127 | stp.v := (ABS(RANDOM) mod b) + 16; 128 | 129 | { Draw our stat lines. } 130 | MoveTo(stp.h, stp.v); 131 | DrawString(infoStr[1]); 132 | stp.v := stp.v + 20; 133 | 134 | MoveTo(stp.h, stp.v); 135 | DrawString(infoStr[2]); 136 | stp.v := stp.v + 20; 137 | end 138 | else 139 | { There are users online; draw the node information. } 140 | begin 141 | { Get all of the info strings. } 142 | maxLen := 0; 143 | for i := 1 to InitSystHand^^.numNodes do 144 | begin 145 | NumToString(i, infoStr[i]); 146 | case (theNodes[i]^.boardMode) of 147 | waiting: 148 | infoStr[i] := ''; 149 | failed: 150 | infoStr[i] := 'Initialization failed'; 151 | terminal: 152 | infoStr[i] := 'Terminal'; 153 | answering: 154 | infoStr[i] := concat(infoStr[i], ': Logon in progress'); 155 | user: 156 | begin 157 | if theNodes[i]^.thisUser.userNum > 0 then 158 | begin 159 | infoStr[i] := concat(infoStr[i], ': ', theNodes[i]^.thisUser.userName); 160 | ts := WhatUser(i); 161 | infoStr[i] := concat(infoStr[i], ' : ', ts); 162 | if theNodes[i]^.triedChat then 163 | infoStr[i] := concat(infoStr[i], ', CHAT: ', theNodes[i]^.chatreason); 164 | end 165 | else 166 | infoStr[i] := concat(infoStr[i], ': Logon in progress'); 167 | end; 168 | otherwise 169 | end; 170 | 171 | { Figure out which string is longer and set the maxLen. } 172 | b := StringWidth(infoStr[i]); 173 | if (b > maxLen) then 174 | maxLen := b; 175 | end; 176 | 177 | { Position our text. } 178 | SetPt(stp, 0, 0); 179 | i := numUsersOn div maxNodesPerColumn; 180 | if numUsersOn mod maxNodesPerColumn <> 0 then 181 | i := i + 1; 182 | b := (screenbits.bounds.right - (i * (maxLen + 10))); 183 | if b > 0 then 184 | stp.h := (ABS(RANDOM) mod b) + 1; 185 | b := (screenbits.bounds.bottom - (maxNodesPerColumn * 20)); 186 | if b > 0 then 187 | stp.v := (ABS(RANDOM) mod b) + 16; 188 | 189 | { Draw our stat lines. } 190 | nodesDrawn := 0; 191 | for i := 1 to InitSystHand^^.numNodes do 192 | begin 193 | if infoStr[i] <> '' then 194 | begin 195 | MoveTo(stp.h, stp.v); 196 | DrawString(infoStr[i]); 197 | 198 | { Add one to the nodes-drawn count and adjust the horizontal and vertical } 199 | { position accordingly. } 200 | nodesDrawn := nodesDrawn + 1; 201 | if nodesDrawn mod maxNodesPerColumn = 0 then 202 | begin 203 | stp.h := stp.h + maxLen + 10; 204 | stp.v := stp.v - ((maxNodesPerColumn - 1) * 20); 205 | end 206 | else 207 | stp.v := stp.v + 20; 208 | end; { if } 209 | end; { for } 210 | end; { if } 211 | 212 | { Update our lastSSDraw timer. } 213 | lastSSDraw := TickCount; 214 | end; 215 | 216 | procedure OpenSSLock; 217 | begin 218 | if SSLockDlg = nil then 219 | begin 220 | SSLockDlg := GetNewDialog(260, nil, Pointer(-1)); 221 | SetPort(SSLockDlg); 222 | SetGeneva(SSLockDlg); 223 | DrawDialog(SSLockDlg); 224 | ForeColor(BlueColor); 225 | BackColor(WhiteColor); 226 | SetTextBox(SSLockDlg, 3, '• Hermes II Screen Saver Lock •'); 227 | ForeColor(BlackColor); 228 | SelIText(SSLockDlg, 2, 0, 32767); 229 | SSCount := tickcount; 230 | end 231 | else 232 | SelectWindow(SSLockDlg); 233 | end; 234 | 235 | procedure UpdateSSLock; 236 | var 237 | SavedPort: GrafPtr; 238 | begin 239 | if (SSLockDlg <> nil) and (theWindow = SSLockDlg) then 240 | begin 241 | GetPort(SavedPort); 242 | SetPort(SSLockDlg); 243 | DrawDialog(SSLockDlg); 244 | ForeColor(BlueColor); 245 | BackColor(WhiteColor); 246 | SetTextBox(SSLockDlg, 3, '• Hermes II Screen Saver Lock •'); 247 | ForeColor(BlackColor); 248 | SetPort(SavedPort); 249 | end; 250 | end; 251 | 252 | procedure CloseSSLock; 253 | begin 254 | if (SSLockDlg <> nil) then 255 | begin 256 | DisposDialog(SSLockDlg); 257 | SSLockDlg := nil; 258 | end; 259 | if GotIt then 260 | EndSS 261 | else 262 | DrawSSInfo; 263 | SSCount := 0; 264 | end; 265 | 266 | procedure DoSSLock; 267 | var 268 | s1, s2: str255; 269 | n: integer; 270 | begin 271 | n := 2; 272 | if (SSLockDlg <> nil) and (SSLockDlg = FrontWindow) then 273 | begin 274 | case itemHit of 275 | 1: 276 | begin 277 | s2 := copy(InitSystHand^^.realSerial, 1, 10); 278 | s1 := GetTextBox(SSLockDlg, 4); 279 | if s1 = InitSystHand^^.OverridePass then 280 | CloseSSLock(true) 281 | else if s1 = s2 then 282 | CloseSSLock(true) 283 | else 284 | begin 285 | SysBeep(0); 286 | CloseSSLock(false); 287 | end; 288 | end; 289 | otherwise 290 | ; 291 | end; 292 | end; 293 | end; 294 | 295 | procedure VActionProc (control: ControlHandle; part: INTEGER); 296 | var 297 | amount: INTEGER; 298 | window: WindowPtr; 299 | theT: TEHandle; 300 | begin 301 | if part <> 0 then 302 | begin 303 | window := control^^.contrlOwner; 304 | theT := TEHandle(windowPeek(window)^.refCon); 305 | case part of 306 | inUpButton, inDownButton: 307 | amount := 1; {one line} 308 | inPageUp, inPageDown: 309 | amount := (theT^^.viewRect.bottom - theT^^.viewRect.top) div theT^^.lineHeight; {one page} 310 | otherwise 311 | end; 312 | if (part = inDownButton) | (part = inPageDown) then 313 | amount := -amount; {reverse direction} 314 | CommonAction(control, amount); 315 | if amount <> 0 then 316 | TEPinScroll(0, amount * theT^^.lineHeight, theT); 317 | end; 318 | end; {VActionProc} 319 | 320 | 321 | procedure IdleUser; 322 | var 323 | tempLong, tempLong2: longint; 324 | i, b: integer; 325 | savePort: GrafPtr; 326 | tempstring: str255; 327 | mysavedBD: BDact; 328 | begin 329 | with curglobs^ do 330 | begin 331 | if (BoardMode = User) and not sysopLogon and (hangingUp < 0) then 332 | begin 333 | if UserHungUp then (*Check to see if carrier was lost*) 334 | begin 335 | if myTrans.active then (*If a x-fer was happening then quit sending and clear*) 336 | begin 337 | extTrans^^.flags[carrierLoss] := true; 338 | ClearInBuf; 339 | repeat 340 | ContinueTrans; 341 | until not myTrans.active; 342 | end; 343 | if (thisUser.userNum) > 0 then 344 | sysopLog(RetInStr(2), 6); 345 | HangupAndReset; 346 | end; 347 | end; 348 | if not myTrans.active then 349 | begin 350 | if TabbyPaused then (* If Mailer Running then check for Activate Node Temp *) 351 | begin (* If found Hermes takes control of port *) 352 | if (length(SavedInPort) > 0) then 353 | begin 354 | if FSOpen('ActivateNode.temp', 0, i) = noErr then 355 | begin 356 | result := FSClose(i); 357 | result := FSDelete('ActivateNode.temp', 0); 358 | CloseComPort; 359 | InPortName := SavedInPort; 360 | SavedInPort := ''; 361 | TabbyPaused := false; 362 | OpenComPort; 363 | HangUpAndReset; 364 | doDetermineZMH; 365 | end; 366 | end; 367 | end; 368 | if hangingUp >= 0 then (* if hanging up >=0 then User in hangup sequence.*) 369 | HangUpAndReset; (* Otherwise hangingUp := -1 *) 370 | if ((BoardMode = Failed) and (lastTry + 1800 < tickCount) and (NumFails < 3)) or ((BoardMode = Waiting) and (lastTry + 72000 < tickCount)) then 371 | HangUpAndReset; (* Check for Modem Initilization Failure*) 372 | (* If users window is open then draw appropriate stuff in window *) 373 | i := isMyBBSwindow(frontWindow); 374 | if (i > 0) and (tickCount > (lastBlink + getCaretTime)) then 375 | begin 376 | if not gBBSwindows[i]^.scrollFreeze and (visibleNode = activeNode) then 377 | begin 378 | if (gBBSwindows[i]^.cursorRect.top > gBBSwindows[i]^.ansiRect.top) and (gBBSwindows[i]^.cursorRect.right <= gBBSwindows[i]^.ansiRect.right) then 379 | begin 380 | GetPort(savePort); 381 | with gBBSwindows[i]^ do 382 | begin 383 | SetPort(ansiPort); 384 | InvertRect(cursorRect); 385 | if cursorOn then 386 | cursorOn := False 387 | else 388 | cursorOn := True; 389 | end; 390 | lastBlink := tickCount; 391 | SetPort(savePort); 392 | end; 393 | end; 394 | end; 395 | if (toBeSent <> nil) then (* Is there anything that has to be outputted *) 396 | begin 397 | if (nodeType = 3) then 398 | begin 399 | if (nodeTCP.tcpPBPtr^.ioResult <> 1) then 400 | if AsyncMWrite(outputRef, 0, nil) <> noErr then 401 | ; 402 | end 403 | else if (nodeType = 2) then 404 | begin 405 | if (nodeDSPWritePtr^.ioResult <> 1) then 406 | if AsyncMWrite(outputRef, 0, nil) <> noErr then 407 | ; 408 | end 409 | else if (nodeType = 1) then 410 | begin 411 | if (myBlocker.ioResult <> 1) then 412 | if AsyncMWrite(outputRef, 0, nil) <> noErr then 413 | ; 414 | end; 415 | end; 416 | if (BoardMode = Answering) then (* Check for timeout when answering *) 417 | begin 418 | if (BoardSection = TelnetNegotiation) then 419 | DoTelnetNegotiation 420 | else if (tickCount > (lastKeyPressed + 14400)) then 421 | HangUpAndReset; 422 | end 423 | else if (BoardMode = Terminal) then 424 | begin 425 | if dialing and not waitdialresponse then 426 | doDialIdle; 427 | end 428 | else if (BoardMode = User) and (hangingUp < 0) then (*Standard Conditions*) 429 | begin 430 | if BoardSection = External then 431 | if myExternals^^[activeUserExternal].GameIdle then 432 | if GameIdleOn then 433 | CallUserExternal(GAMEIDLE, activeUserExternal); 434 | if prompting then 435 | begin 436 | if (BoardSection <> Post) and (BoardSection <> Email) and (BoardSection <> NewUser) and (BoardSection <> Logon) then 437 | begin 438 | if (ticksLeft(activeNode) <= 0) then (*Check out of time*) 439 | begin 440 | sysopLog(concat(' ', RetInStr(3)), 0); 441 | ClearScreen; 442 | bCR; 443 | OutLine(RetInStr(3), true, 0); 444 | bCR; 445 | if ReadTextFile('Log Off', 1, false) then 446 | begin 447 | if thisUser.TerminalType = 1 then 448 | noPause := true; 449 | BoardAction := ListText; 450 | ListTextFile; 451 | end 452 | else 453 | begin 454 | bCR; 455 | OutLine('Can''t find Logoff file', true, 0); 456 | end; 457 | OffDo := Hanger; 458 | BoardSection := OffStage; 459 | SetBookMark; 460 | end; 461 | end; 462 | end; 463 | tempLong := tickCount; 464 | if timeFlagged then (* Check another timeout *) 465 | begin 466 | if (tempLong > (lastKeyPressed + longint(timeout * 60 * 60))) then 467 | begin 468 | timeFlagged := false; 469 | OutLine(RetInStr(6), true, 6); 470 | OutLine('', false, 0); 471 | bCR; 472 | Delay(30, tempLong); 473 | sysopLog(' ***TIMEOUT***', 0); 474 | HangupAndReset; 475 | exit(idleUser); 476 | end; 477 | end 478 | else if (tempLong > (lastkeyPressed + longint((timeOut * 60 * 60) div 2))) then 479 | begin (* User Not Hit key within timeout time in NodePrefs *) 480 | if (sysopStop or (not inZScan and not continuous and not ((BoardSection = ListFiles) and (ListDo = ListFour)) and not (BoardAction = Repeating))) and not TimeFlagged then 481 | begin 482 | NumToString(timeout, tempstring); 483 | if (BoardSection = Chatroom) then 484 | ChatroomSingle(activeNode, false, true, concat(RetInStr(4), tempstring, RetInStr(5))) 485 | else 486 | begin 487 | mySavedBD := BoardAction; 488 | BoardAction := none; 489 | bCR; 490 | OutChr(char(7)); 491 | OutLine(concat(RetInStr(4), tempstring, RetInStr(5)), false, 6); 492 | if thisUser.TerminalType = 1 then 493 | dom(0); 494 | bCR; 495 | BoardAction := mySavedBD; 496 | if (BoardAction = Writing) then 497 | ListLine(online) 498 | else if boardAction = Prompt then 499 | ReprintPrompt; 500 | end; 501 | timeFlagged := true; 502 | end; 503 | end; 504 | if (myBlocker.ioResult <> 1) and (BoardAction = ListText) then (* Output text file*) 505 | ListTextFile 506 | else if ((BoardAction = none) or (BoardAction = Repeating)) then 507 | if not SysopStop then (*Run through BookMark*) 508 | SetBookmark; 509 | if ((BoardAction <> ListText) and (lnsPause >= thisUser.ScrnHght)) or ((BoardAction = ListText) and (lnsPause >= (thisUser.ScrnHght - 1))) then (*Determine if pause needed *) 510 | begin 511 | if (thisUser.PauseScreen and not listingHelp and not continuous and not inZScan) or (lnsPause >= 29999) then 512 | begin 513 | if BoardAction <> ListText then 514 | bCR; 515 | savedBdAction := BoardAction; 516 | InPause := true; 517 | PAUSEPrompt(RetInStr(7)); 518 | end; 519 | end; 520 | end; 521 | if (hangingUp < 0) then (*Do incoming chars*) 522 | begin 523 | tempLong := GetHandleSize(handle(sysopkeyBuffer)); 524 | if tempLong > 0 then (*Check sysopkey buffer first *) 525 | begin 526 | i := 0; 527 | while (i < tempLong) and (BoardAction <> none) and (BoardAction <> ListText) do 528 | begin 529 | doSysopKey(sysopKeyBuffer^^[i], false); (*Send individual keys to routine.*) 530 | i := i + 1; 531 | end; 532 | BlockMove(pointer(ord4(sysopKeyBuffer^) + i), pointer(sysopKeyBuffer^), GetHandleSize(handle(sysopKeyBuffer)) - i); 533 | SetHandleSize(handle(sysopKeyBuffer), getHandleSize(handle(sysopKeyBuffer)) - i); 534 | end; 535 | if not stopRemote then (* If Squelch user from User Menu not selected *) 536 | begin 537 | if not sysopLogon then 538 | CheckForChars; (* Read out of serial port buffer *) 539 | if (BoardMode = Terminal) and (XferAutoStart = 2) then 540 | begin 541 | if XFerAutoStart = 2 then 542 | DoMenuCommand(longint($03F10007), 0); 543 | XferAutoStart := 0; 544 | end; 545 | i := length(typeBuffer); 546 | if i > 0 then 547 | begin 548 | if (i > 80) then (* Only handle 80 chars at once for multiuser friendliness *) 549 | i := 80; 550 | b := 1; 551 | while (b <= i) and (BoardAction <> none) and (BoardAction <> ListText) do 552 | begin 553 | doSerialChar(typeBuffer[b]); (*Check buffer 1 char at a time *) 554 | b := b + 1; 555 | end; 556 | if (b > 1) then 557 | delete(typeBuffer, 1, b - 1); (*Delete checked chars from the buffer *) 558 | end; 559 | end; 560 | end; 561 | end 562 | else 563 | ContinueTrans; (*If myTrans.active then continue transferring *) 564 | end; 565 | end; 566 | end. -------------------------------------------------------------------------------- /Source/WebTosser.p: -------------------------------------------------------------------------------- 1 | { Segments: WebTosser_1 } 2 | unit WebTosser; 3 | 4 | interface 5 | uses 6 | Processes, AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, NodePrefs2, NodePrefs, Import, InpOut4; 7 | 8 | procedure DoWebTosser; 9 | 10 | implementation 11 | const 12 | WebTosserTimeout = 60; { ticks } 13 | 14 | {$S WebTosser_1} 15 | procedure LogWebTosser (logStr: Str255); 16 | var 17 | path: str255; 18 | logRef: integer; 19 | logStrSize: longInt; 20 | result: OSerr; 21 | begin 22 | { Display to the SysOp. } 23 | if DebugWebTosser or DebugWebTosserOnce then 24 | OutLineSysop(logStr, true); 25 | 26 | { Write to the file if requested. } 27 | if DebugWebTosserToFile or DebugWebTosserToFileOnce then 28 | begin 29 | path := concat(sharedPath, 'Misc:Web Tosser Log'); 30 | result := FSOpen(path, 0, logRef); 31 | if result <> noErr then 32 | begin 33 | result := FSDelete(path, 0); 34 | result := Create(path, 0, 'HRMS', 'TEXT'); 35 | result := FSOpen(path, 0, LogRef); 36 | end; 37 | if result = noErr then 38 | begin 39 | logStr := concat(logStr, char(13)); 40 | result := SetFPos(logRef, fsFromLEOF, 0); 41 | logStrSize := length(logStr); 42 | result := FSWrite(logRef, logStrSize, @logStr[1]); 43 | result := FSClose(logRef); 44 | end; 45 | end; 46 | end; 47 | 48 | procedure LogWebTosserError (logStr: Str255); 49 | begin 50 | LogWebTosser(logStr); 51 | WriteNetLog(logStr); 52 | end; 53 | 54 | procedure DoWebTosser; 55 | label 56 | 1; 57 | const 58 | { Timeouts. } 59 | CONNECT_TIMEOUT = 30; 60 | SEND_TIMEOUT = 30; 61 | RECEIVE_TIMEOUT = 30; 62 | DISCONNECT_TIMEOUT = 30; 63 | { Buffer sizes. } 64 | RECEIVE_BUFFER = 8192; 65 | { Header constants. } 66 | NODENUMBER_PART_HEADER = 'Content-Disposition: form-data; name="nodenumber"'; 67 | PASSWORD_PART_HEADER = 'Content-Disposition: form-data; name="password"'; 68 | AREASBBS_PART_HEADER1 = 'Content-Disposition: form-data; name="areasbbs!"; filename="areas.bbs"'; 69 | AREASBBS_PART_HEADER2 = 'Content-Type: text/plain'; 70 | GE_PART_HEADER1 = 'Content-Disposition: form-data; name="genericexport!"; filename="Generic Export"'; 71 | GE_PART_HEADER2 = 'Content-Type: application/octet-stream'; 72 | GE_PART_HEADER3 = 'Content-Transfer-Encoding: binary'; 73 | var 74 | { Temporary vars. } 75 | result: OSErr; 76 | i, writeCnt, giPos: longint; 77 | tempString: Str255; 78 | receiveBuffer: Ptr; 79 | 80 | { General variables. } 81 | areasBbsLength, genericExportLength: longint; 82 | contentLength: longint; 83 | begin 84 | case webTosserDo of 85 | WebTosserConnect: 86 | begin 87 | { Log the start of the poll. } 88 | WriteNetLog(Concat('Web Tosser poll started at: ', WhatTime(-1))); 89 | 90 | { Initialize the web tosser. } 91 | webTosserAreasBbsRefNum := -1; 92 | webTosserGenericExportRefNum := -1; 93 | webTosserGenericImportRefNum := -1; 94 | 95 | { Create a new Generic Import file, which must not already exist. } 96 | result := FSOpen(Concat(Mailer^^.GenericPath, 'Generic Import'), fsRdPerm, webTosserGenericImportRefNum); 97 | if result = noErr then 98 | begin 99 | webTosserGenericImportRefNum := -1; 100 | LogWebTosserError('Generic Import file already exists; aborting Web Tosser poll.'); 101 | webTosserDo := WebTosserDone; 102 | Exit(DoWebTosser); 103 | end; 104 | 105 | result := Create(Concat(Mailer^^.GenericPath, 'Generic Import'), 0, 'HRMS', 'TEXT'); 106 | if result <> noErr then 107 | begin 108 | LogWebTosserError(Concat('Error creating Generic Import file: ', StringOf(result : 0), '.')); 109 | webTosserDo := WebTosserDone; 110 | Exit(DoWebTosser); 111 | end; 112 | 113 | result := FSOpen(Concat(Mailer^^.GenericPath, 'Generic Import'), fsRdWrPerm, webTosserGenericImportRefNum); 114 | if result <> noErr then 115 | begin 116 | webTosserGenericImportRefNum := -1; 117 | LogWebTosserError(Concat('Error opening Generic Import file: ', StringOf(result : 0), '.')); 118 | webTosserDo := WebTosserDone; 119 | Exit(DoWebTosser); 120 | end; 121 | 122 | { Open the Areas.BBS and Generic Export files. } 123 | result := FSOpen(Concat(sharedPath, 'Misc:Areas.BBS'), fsRdPerm, webTosserAreasBbsRefNum); 124 | if result <> noErr then 125 | begin 126 | webTosserAreasBbsRefNum := -1; 127 | LogWebTosserError(Concat('Error opening Areas.BBS file: ', StringOf(result : 0), '.')); 128 | webTosserDo := WebTosserDone; 129 | Exit(DoWebTosser); 130 | end; 131 | 132 | result := FSOpen(Concat(Mailer^^.GenericPath, 'Generic Export'), fsRdPerm, webTosserGenericExportRefNum); 133 | if result <> noErr then 134 | webTosserGenericExportRefNum := -1; 135 | 136 | { Create the TCP stream. } 137 | result := CreateTCPStream(@webTosserTCP); 138 | if result <> noErr then 139 | begin 140 | LogWebTosserError(Concat('Error creating TCP stream: ', StringOf(result : 0), '.')); 141 | webTosserDo := WebTosserDone; 142 | Exit(DoWebTosser); 143 | end; 144 | 145 | { Initiate the connection to the Hermes Web Tosser. } 146 | IPAddrToString(Mailer^^.hwtIPAddr, tempString); 147 | LogWebTosser(Concat('Opening connection to Hermes Web Tosser at ', tempString, '.')); 148 | InitiateTCPConnection(@webTosserTCP, Mailer^^.hwtIPAddr, 80, CONNECT_TIMEOUT); 149 | webTosserDo := WebTosserConnectWait; 150 | end; 151 | 152 | WebTosserConnectWait: 153 | begin 154 | { Keep waiting if the connection has not yet been opened. } 155 | if webTosserTCP.tcpPBPtr^.ioResult = 1 then 156 | Exit(DoWebTosser); 157 | 158 | { Connection open; see if there was an error. } 159 | if webTosserTCP.tcpPBPtr^.ioResult <> noErr then 160 | begin 161 | LogWebTosserError(Concat('Connection failed with error ', StringOf(webTosserTCP.tcpPBPtr^.ioResult : 0), '.')); 162 | DestroyTCPStream(@webTosserTCP); 163 | webTosserDo := WebTosserDone; 164 | Exit(DoWebTosser); 165 | end; 166 | 167 | { The connection was opened successfully; build and send the POST arguments. } 168 | LogWebTosser('Connection opened; building POST request...'); 169 | 170 | { Generate a MIME boundary without the "--" prefix. } 171 | webTosserMimeBoundary := Concat('-------------------------', StringOf(TickCount : 0), '-', Mailer^^.hwtPassword); 172 | 173 | { Get the lengths of the Areas.BBS and Generic Export files. } 174 | result := GetEOF(webTosserAreasBbsRefNum, areasBbsLength); 175 | if webTosserGenericExportRefNum <> -1 then 176 | result := GetEOF(webTosserGenericExportRefNum, genericExportLength) 177 | else 178 | genericExportLength := 0; 179 | 180 | { Calculate the content length. } 181 | contentLength := 0; 182 | contentLength := contentLength + (2 + Length(webTosserMimeBoundary) + 2) + (Length(NODENUMBER_PART_HEADER) + 2) + 2 + (Integer(Mailer^^.hwtNodeNumber[0]) + 2); 183 | contentLength := contentLength + (2 + Length(webTosserMimeBoundary) + 2) + (Length(PASSWORD_PART_HEADER) + 2) + 2 + (Integer(Mailer^^.hwtPassword[0]) + 2); 184 | contentLength := contentLength + (2 + Length(webTosserMimeBoundary) + 2) + (Length(AREASBBS_PART_HEADER1) + 2) + (Length(AREASBBS_PART_HEADER2) + 2) + 2 + areasBbsLength + 2; 185 | contentLength := contentLength + (2 + Length(webTosserMimeBoundary) + 2) + (Length(GE_PART_HEADER1) + 2) + (Length(GE_PART_HEADER2) + 2) + (Length(GE_PART_HEADER3) + 2) + 2 + genericExportLength + 2; 186 | contentLength := contentLength + (2 + Length(webTosserMimeBoundary) + 2 + 2); 187 | 188 | { Build the HTTP POST request. } 189 | webTosserSending := Concat('POST / HTTP/1.0', Char(13), Char(10), 'Host: tosser.hermesbbs.com', Char(13), Char(10), 'Content-Type: multipart/form-data; boundary=', webTosserMimeBoundary, Char(13), Char(10), 'Content-Length: ', StringOf(contentLength : 0), Char(13), Char(10), Char(13), Char(10)); 190 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 191 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 192 | webTosserTCP.tcpWDSPtr^.term := 0; 193 | 194 | { Send the request. } 195 | LogWebTosser('Sending POST request...'); 196 | webTosserDo := WebTosserSend; 197 | webTosserDoNext := WebTosserSendNodeNumber; 198 | end; 199 | 200 | WebTosserSendNodeNumber: 201 | begin 202 | { Build the nodenumber part. } 203 | webTosserSending := Concat('--', webTosserMimeBoundary, Char(13), Char(10), NODENUMBER_PART_HEADER, Char(13), Char(10), Char(13), Char(10), Mailer^^.hwtNodeNumber, Char(13), Char(10)); 204 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 205 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 206 | webTosserTCP.tcpWDSPtr^.term := 0; 207 | 208 | { Send the part. } 209 | LogWebTosser('Sending nodenumber part...'); 210 | webTosserDo := WebTosserSend; 211 | webTosserDoNext := WebTosserSendPassword; 212 | end; 213 | 214 | WebTosserSendPassword: 215 | begin 216 | { Build the password part. } 217 | webTosserSending := Concat('--', webTosserMimeBoundary, Char(13), Char(10), PASSWORD_PART_HEADER, Char(13), Char(10), Char(13), Char(10), Mailer^^.hwtPassword, Char(13), Char(10)); 218 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 219 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 220 | webTosserTCP.tcpWDSPtr^.term := 0; 221 | 222 | { Send the part. } 223 | LogWebTosser('Sending password part...'); 224 | webTosserDo := WebTosserSend; 225 | webTosserDoNext := WebTosserSendAreasBBSHeader; 226 | end; 227 | 228 | WebTosserSendAreasBBSHeader: 229 | begin 230 | { Build the Areas.BBS part header. } 231 | webTosserSending := Concat('--', webTosserMimeBoundary, Char(13), Char(10), AREASBBS_PART_HEADER1, Char(13), Char(10), AREASBBS_PART_HEADER2, Char(13), Char(10), Char(13), Char(10)); 232 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 233 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 234 | webTosserTCP.tcpWDSPtr^.term := 0; 235 | 236 | { Send the part header. } 237 | LogWebTosser('Sending Areas.BBS part header...'); 238 | webTosserDo := WebTosserSend; 239 | webTosserDoNext := WebTosserSendAreasBBSFile; 240 | end; 241 | 242 | WebTosserSendAreasBBSFile: 243 | begin 244 | { Send the Areas.BBS file. } 245 | LogWebTosser('Sending Areas.BBS file...'); 246 | webTosserSendingRefNum := webTosserAreasBbsRefNum; 247 | webTosserDo := WebTosserSendFile; 248 | webTosserDoNextFile := WebTosserSendGenericExportHeader; 249 | end; 250 | 251 | WebTosserSendGenericExportHeader: 252 | begin 253 | { Build the Generic Export part header (including the CRLF prefix that completes the Areas.BBS part. } 254 | webTosserSending := Concat(Char(13), Char(10), '--', webTosserMimeBoundary, Char(13), Char(10), GE_PART_HEADER1, Char(13), Char(10), GE_PART_HEADER2, Char(13), Char(10), GE_PART_HEADER3, Char(13), Char(10), Char(13), Char(10)); 255 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 256 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 257 | webTosserTCP.tcpWDSPtr^.term := 0; 258 | 259 | { Send the part header. } 260 | LogWebTosser('Sending Generic Export part header...'); 261 | webTosserDo := WebTosserSend; 262 | 263 | { Only send the Generic Export file if we have one. } 264 | if webTosserGenericExportRefNum <> -1 then 265 | webTosserDoNext := WebTosserSendGenericExportFile 266 | else 267 | webTosserDoNext := WebTosserSendRequestTrailer; 268 | end; 269 | 270 | WebTosserSendGenericExportFile: 271 | begin 272 | { Send the Generic Export file. } 273 | LogWebTosser('Sending Generic Export file...'); 274 | webTosserSendingRefNum := webTosserGenericExportRefNum; 275 | webTosserDo := WebTosserSendFile; 276 | webTosserDoNextFile := WebTosserSendRequestTrailer; 277 | end; 278 | 279 | WebTosserSendRequestTrailer: 280 | begin 281 | { Build the request trailer (including the CRLF prefix that completes the Generic Export part. } 282 | webTosserSending := Concat(Char(13), Char(10), '--', webTosserMimeBoundary, '--', Char(13), Char(10)); 283 | webTosserTCP.tcpWDSPtr^.size := Length(webTosserSending); 284 | webTosserTCP.tcpWDSPtr^.buffer := Ptr(LongInt(@webTosserSending) + 1); 285 | webTosserTCP.tcpWDSPtr^.term := 0; 286 | 287 | { Send the part. } 288 | LogWebTosser('Sending request trailer...'); 289 | webTosserDo := WebTosserSend; 290 | webTosserDoNext := WebTosserReceiveGenericImport; 291 | webTosserParseGenericImportState := wtpgiCheckHttpStatusCode; 292 | end; 293 | 294 | WebTosserReceiveGenericImport: 295 | begin 296 | { Keep looping if the TCP read would block. } 297 | if TCPReadWillBlock(@webTosserTCP.tcpPBPtr) then 298 | Exit(DoWebTosser); 299 | 300 | { Receive the next RECEIVE_BUFFER bytes of the file. } 301 | receiveBuffer := NewPtr(RECEIVE_BUFFER); 302 | with webTosserTCP.tcpPBPtr^ do 303 | begin 304 | ioResult := 1; 305 | ioCompletion := nil; 306 | 307 | ioCRefNum := ippDrvrRefNum; 308 | csCode := TCPcsRcv; 309 | tcpStream := webTosserTCP.tcpStreamPtr; 310 | 311 | receive.commandTimeoutValue := 0; 312 | receive.markFlag := 0; 313 | receive.urgentFlag := 0; 314 | receive.rcvBuff := receiveBuffer; 315 | receive.rcvBuffLength := RECEIVE_BUFFER; 316 | receive.userDataPtr := nil; 317 | end; 318 | 319 | result := PBControl(ParmBlkPtr(webTosserTCP.tcpPBPtr), false); 320 | 321 | { Write out the bytes if data was received, otherwise close the connection or fail the } 322 | { transfer depending on the error code. } 323 | if result = noErr then 324 | begin 325 | writeCnt := webTosserTCP.tcpPBPtr^.receive.rcvBuffLength; 326 | LogWebTosser(Concat('Received ', StringOf(writeCnt : 0), ' bytes of the Generic Import file.')); 327 | 328 | { Process the data according to our parse state. } 329 | for giPos := 1 to writeCnt do 330 | case webTosserParseGenericImportState of 331 | wtpgiCheckHttpStatusCode: 332 | begin 333 | if Ptr(Longint(receiveBuffer) + 9)^ = Ord('2') then 334 | begin 335 | webTosserParseGenericImportState := wtpgiSkippingHeader; 336 | end 337 | else 338 | begin 339 | LogWebTosserError(Concat('Hermes Web Tosser server was unable to process the request.')); 340 | webTosserDo := WebTosserDisconnect; 341 | Exit(DoWebTosser); 342 | end; 343 | end; 344 | 345 | wtpgiSkippingHeader: 346 | begin 347 | 1: 348 | if Ptr(Longint(receiveBuffer) + (giPos - 1))^ = 13 then 349 | webTosserParseGenericImportState := wtpgiSkippingLF1; 350 | end; 351 | 352 | wtpgiSkippingLF1: 353 | begin 354 | if Ptr(LongInt(receiveBuffer) + (giPos - 1))^ = 10 then 355 | begin 356 | webTosserParseGenericImportState := wtpgiSkippingCR2; 357 | end 358 | else 359 | begin 360 | webTosserParseGenericImportState := wtpgiSkippingHeader; 361 | goto 1; 362 | end; 363 | end; 364 | 365 | wtpgiSkippingCR2: 366 | begin 367 | if Ptr(LongInt(receiveBuffer) + (giPos - 1))^ = 13 then 368 | begin 369 | webTosserParseGenericImportState := wtpgiSkippingLF2; 370 | end 371 | else 372 | begin 373 | webTosserParseGenericImportState := wtpgiSkippingHeader; 374 | goto 1; 375 | end; 376 | end; 377 | 378 | wtpgiSkippingLF2: 379 | begin 380 | if Ptr(LongInt(receiveBuffer) + (giPos - 1))^ = 10 then 381 | begin 382 | webTosserParseGenericImportState := wtpgiReadingFile; 383 | end 384 | else 385 | begin 386 | webTosserParseGenericImportState := wtpgiSkippingHeader; 387 | goto 1; 388 | end; 389 | end; 390 | 391 | wtpgiReadingFile: 392 | begin 393 | writeCnt := writeCnt - (giPos - 1); 394 | result := FSWrite(webTosserGenericImportRefNum, writeCnt, Ptr(LongInt(receiveBuffer) + (giPos - 1))); 395 | DisposPtr(receiveBuffer); 396 | 397 | if result <> noErr then 398 | begin 399 | LogWebTosserError(Concat('Error writing Generic Import file: ', StringOf(result : 0), '.')); 400 | webTosserDo := WebTosserDisconnect; 401 | end; 402 | 403 | Exit(DoWebTosser); 404 | end; 405 | end; 406 | 407 | { Free the receive buffer. } 408 | DisposPtr(receiveBuffer); 409 | end 410 | else if result = connectionClosingErr then 411 | begin 412 | DisposPtr(receiveBuffer); 413 | 414 | LogWebTosser('Done receiving Generic Import file.'); 415 | result := GetEOF(webTosserGenericImportRefNum, writeCnt); 416 | result := FSClose(webTosserGenericImportRefNum); 417 | webTosserGenericImportRefNum := -1; 418 | 419 | WriteNetLog(Concat('Web Tosser received ', StringOf(writeCnt : 0), ' byte Generic Import file.')); 420 | 421 | { Delete empty Generic Import files; process non-empty Generic Import files. } 422 | if writeCnt = 0 then 423 | begin 424 | LogWebTosser('Deleting empty Generic Import file.'); 425 | result := FSDelete(Concat(Mailer^^.GenericPath, 'Generic Import'), 0); 426 | end 427 | else 428 | begin 429 | { Check for a Generic Import file now (since we just finished receiving one). We also have to set } 430 | { GBytes to the final size of the Generic Import file so that the DoCompareFileSize routine will see } 431 | { the same file size right away, otherwise it will take an additional 20 seconds for the next check } 432 | { to come along and see that the file size has stabilized. } 433 | lastGenericCheck := 0; 434 | GBytes := writeCnt; 435 | end; 436 | 437 | { Delete the Generic Export file (if any). } 438 | if webTosserGenericExportRefNum <> -1 then 439 | begin 440 | result := FSClose(webTosserGenericExportRefNum); 441 | webTosserGenericExportRefNum := -1; 442 | result := FSDelete(Concat(Mailer^^.GenericPath, 'Generic Export'), 0); 443 | end; 444 | 445 | { Web Tosser poll was successfull; clear the last-failed timer. } 446 | lastFailedWebTosserAutoPoll := 0; 447 | 448 | webTosserDo := WebTosserDisconnect; 449 | end 450 | else if result <> noErr then 451 | begin 452 | DisposPtr(receiveBuffer); 453 | LogWebTosserError(Concat('Error receiving Generic Import file: ', StringOf(result : 0), '.')); 454 | webTosserDo := WebTosserDisconnect; 455 | Exit(DoWebTosser); 456 | end; 457 | end; 458 | 459 | WebTosserSendFile: 460 | begin 461 | { Read the next 250 bytes of the file. } 462 | writeCnt := 250; 463 | result := FSRead(webTosserSendingRefNum, writeCnt, @webTosserSending); 464 | if result = noErr then 465 | begin 466 | webTosserTCP.tcpWDSPtr^.size := writeCnt; 467 | webTosserTCP.tcpWDSPtr^.buffer := @webTosserSending; 468 | webTosserTCP.tcpWDSPtr^.term := 0; 469 | webTosserDo := WebTosserSend; 470 | webTosserDoNext := WebTosserSendFile; 471 | end 472 | else if result = eofErr then 473 | begin 474 | webTosserTCP.tcpWDSPtr^.size := writeCnt; 475 | webTosserTCP.tcpWDSPtr^.buffer := @webTosserSending; 476 | webTosserTCP.tcpWDSPtr^.term := 0; 477 | webTosserDo := WebTosserSend; 478 | webTosserDoNext := webTosserDoNextFile 479 | end 480 | else 481 | begin 482 | LogWebTosserError(Concat('Error reading file in state ', StringOf(webTosserDoNextFile : 0), ': ', StringOf(result : 0), '.')); 483 | webTosserDo := WebTosserDisconnect; 484 | Exit(DoWebTosser); 485 | end; 486 | end; 487 | 488 | WebTosserSend: 489 | begin 490 | with webTosserTCP.tcpPBPtr^ do 491 | begin 492 | ioResult := 1; 493 | ioCompletion := nil; 494 | 495 | ioCRefNum := ippDrvrRefNum; 496 | csCode := TCPcsSend; 497 | tcpStream := webTosserTCP.tcpStreamPtr; 498 | 499 | send.ulpTimeoutValue := SEND_TIMEOUT; 500 | send.ulpTimeoutAction := -1; 501 | send.validityFlags := $c0; 502 | send.pushFlag := 0; 503 | send.urgentFlag := 0; 504 | send.wds := webTosserTCP.tcpWDSPtr; 505 | send.userDataPtr := nil; 506 | end; 507 | 508 | result := PBControl(ParmBlkPtr(webTosserTCP.tcpPBPtr), true); 509 | webTosserDo := WebTosserSendWait; 510 | end; 511 | 512 | WebTosserSendWait: 513 | begin 514 | { Keep waiting if the request has not yet been sent. } 515 | if webTosserTCP.tcpPBPtr^.ioResult = 1 then 516 | Exit(DoWebTosser); 517 | 518 | { See if the request was sent successfully. } 519 | if webTosserTCP.tcpPBPtr^.ioResult <> noErr then 520 | begin 521 | LogWebTosserError(Concat('Send failed with error ', StringOf(webTosserTCP.tcpPBPtr^.ioResult : 0), '.')); 522 | webTosserDo := WebTosserDisconnect; 523 | Exit(DoWebTosser); 524 | end; 525 | 526 | { Next state. } 527 | webTosserDo := webTosserDoNext; 528 | end; 529 | 530 | WebTosserDisconnect: 531 | begin 532 | { Close the connection. } 533 | LogWebTosser('Closing connection...'); 534 | CloseTCPConnection(@webTosserTCP, DISCONNECT_TIMEOUT); 535 | webTosserDo := WebTosserDisconnectWait; 536 | end; 537 | 538 | WebTosserDisconnectWait: 539 | begin 540 | { Keep waiting if the connection has not yet been closed. } 541 | if webTosserTCP.tcpPBPtr^.ioResult = 1 then 542 | Exit(DoWebTosser); 543 | 544 | { Connection closed, we're done. } 545 | LogWebTosser('Connection closed.'); 546 | DestroyTCPStream(@webTosserTCP); 547 | webTosserDo := WebTosserDone; 548 | end; 549 | 550 | WebTosserDone: 551 | begin 552 | { We're done polling. } 553 | if webTosserAreasBbsRefNum <> -1 then 554 | begin 555 | result := FSClose(webTosserAreasBbsRefNum); 556 | webTosserAreasBbsRefNum := -1; 557 | end; 558 | if webTosserGenericExportRefNum <> -1 then 559 | begin 560 | result := FSClose(webTosserGenericExportRefNum); 561 | webTosserGenericExportRefNum := -1; 562 | end; 563 | 564 | { Delete the (partially-received) Generic Import file if it is still open. } 565 | if webTosserGenericImportRefNum <> -1 then 566 | begin 567 | result := FSClose(webTosserGenericImportRefNum); 568 | webTosserGenericImportRefNum := -1; 569 | result := FSDelete(Concat(Mailer^^.GenericPath, 'Generic Import'), 0); 570 | end; 571 | 572 | shouldPollWebTosser := false; 573 | arePollingWebTosser := false; 574 | 575 | WriteNetLog(Concat('Web Tosser poll finished at: ', WhatTime(-1))); 576 | WriteNetLog(' '); 577 | end; 578 | end; 579 | end; 580 | 581 | end. -------------------------------------------------------------------------------- /Source/CreateNewFiles.p: -------------------------------------------------------------------------------- 1 | {$Segments: CreateNewFiles_1} 2 | unit CreateNewFiles; 3 | 4 | interface 5 | 6 | uses 7 | AppleTalk, ADSP, Serial, Sound, CommResources, CRMSerialDevices, TCPTypes, Initial, NodePrefs2; 8 | 9 | procedure CreateSystemPrefs (Path, HFPath: str255); 10 | procedure CreateMessage (Path: str255); 11 | procedure CreateMailer (Path, HDPath: str255); 12 | procedure CreateNewUser (Path: str255); 13 | procedure CreateSecurityLevels (Path: str255); 14 | procedure CreateForumInformation (Path: str255); 15 | procedure CreateDirectories (Path, HFPath: str255); 16 | procedure CreateAddressBooks (Path: str255); 17 | procedure CreateActionWords (Path: str255); 18 | 19 | implementation 20 | 21 | {$S CreateNewFiles_1} 22 | procedure CreateSystemPrefs; 23 | var 24 | freshSyst: SystHand; 25 | templong: longint; 26 | i, TheFile: integer; 27 | begin 28 | freshSyst := SystHand(NewHandleClear(SizeOf(SystRec))); 29 | with freshSyst^^ do 30 | begin 31 | BBSName := 'Unnamed BBS'; 32 | OverridePass := 'SYSOP'; 33 | NewUserPass := 'NUP'; 34 | NumCalls := 0; 35 | NumUsers := 0; 36 | OpStartHour := 0; 37 | OpEndHour := 0; 38 | Closed := false; 39 | NumNodes := 1; 40 | GetDateTime(templong); 41 | Secs2Date(templong, LastMaint); 42 | LastUL := 0; 43 | LastDL := 0; 44 | LastPost := 0; 45 | LastEmail := 0; 46 | AnonyUser := 0; 47 | AnonyAuto := false; 48 | SerialNumber := '';{char(0)} 49 | SerialNumber[0] := char(0); 50 | GfilePath := concat(HFPath, ':GFiles:'); 51 | LastUser := 'UNKNOWN'; 52 | MsgsPath := concat(HFPath, ':Messages:'); 53 | DataPath := concat(HFPath, ':Data:'); 54 | numMForums := 1; 55 | for i := 1 to MAX_NODES do 56 | begin 57 | callsToday[i] := 0; 58 | mPostedToday[i] := 0; 59 | eMailToday[i] := 0; 60 | uploadsToday[i] := 0; 61 | kuploaded[i] := 0; 62 | minsToday[i] := 0; 63 | dlsToday[i] := 0; 64 | kdownloaded[i] := 0; 65 | failedULs[i] := 0; 66 | failedDLs[i] := 0; 67 | end; 68 | MailDLCost := 1.0; 69 | UnUsed1 := 0; 70 | TwoWayChat := true; 71 | UseXWind := false; 72 | ninePoint := true; 73 | FreeMailDL := false; 74 | FreePhone := false; 75 | ClosedTransfers := false; 76 | protocolTime := 8; 77 | BlackOnWhite := 1; 78 | MailDeleteDays := 60; 79 | twoColorChat := true; 80 | UsePauses := false; 81 | DLCredits := 0; 82 | logDays := 10; 83 | logDetail := 0; 84 | realSerial := ''; 85 | realSerial[0] := char(0); 86 | GetDateTime(startDate); 87 | screenSaver[0] := 1; 88 | screenSaver[1] := 5; 89 | NumNNodes := 0; 90 | for i := 0 to MAX_NODES_M_1 do 91 | begin 92 | Bbsnames[i] := char(0); 93 | Bbsnumbers[i] := char(0); 94 | BbsdialIt[i] := false; 95 | Bbsdialed[i] := false; 96 | WnodesStd[i + 1].top := 0; 97 | WnodesStd[i + 1].left := 0; 98 | WnodesStd[i + 1].right := 0; 99 | WnodesStd[i + 1].bottom := 0; 100 | WNodesUser[i + 1].top := 0; 101 | WNodesUser[i + 1].left := 0; 102 | WNodesUser[i + 1].right := 0; 103 | WNodesUser[i + 1].bottom := 0; 104 | wIsOpen[i + 1] := true; 105 | end; 106 | Bbsnames[0] := 'Olympus'; 107 | Bbsnumbers[0] := '1-206-643-2874'; 108 | wIsOpen[0] := false; 109 | WnodesStd[1].top := 40; 110 | WnodesStd[1].left := 2; 111 | WnodesStd[1].right := 502; 112 | WnodesStd[1].bottom := 330; 113 | WNodesUser[1].top := 40; 114 | WNodesUser[1].left := 2; 115 | WNodesUser[1].right := 502; 116 | WNodesUser[1].bottom := 330; 117 | Wstatus.top := 569; 118 | Wstatus.left := 5; 119 | Wstatus.right := 505; 120 | Wstatus.bottom := 619; 121 | for i := 1 to 26 do 122 | Restrictions[i] := char(0); 123 | Totals := false; 124 | EndString := '';{char(0)} 125 | EndString[0] := char(0); 126 | UseBold := false; 127 | version := SYSTREC_VERSION; 128 | Wusers.top := 41; 129 | Wusers.left := 365; 130 | Wusers.right := 502; 131 | Wusers.bottom := 339; 132 | WUserOpen := false; 133 | Quoter := true; 134 | MailAttachments := true; 135 | SSLock := false; 136 | NoANSIDetect := false; 137 | NoXFerPathChecking := false; 138 | QuoteHeader := 'On %date, %sender quoted %receiver: %title.'; 139 | QuoteHeaderAnon := 'On %date, %receiver was quoted: %title.'; 140 | UseQuoteHeader := true; 141 | QuoteHeaderOptions := UseNormal; 142 | { Added in 3.5.9b1 } 143 | ResetSystemColors(freshSyst); 144 | DebugTelnet := false; 145 | DebugTelnetToFile := false; 146 | { Added in 3.5.11b2 } 147 | DebugWebTosser := false; 148 | DebugWebTosserToFile := false; 149 | { Reserved bytes for expansion. } 150 | for i := 1 to 468 do 151 | reserved[i] := char(0); 152 | end; 153 | result := Create(Path, 0, 'HRMS', 'DATA'); 154 | CreateResFile(Path); 155 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 156 | AddResource(handle(freshSyst), 'Sprf', 0, 'System Prefs'); 157 | CloseResFile(TheFile); 158 | end; 159 | 160 | procedure CreateMessage; 161 | var 162 | i, x, TheFile: integer; 163 | result: OSErr; 164 | freshFb: feedbackHand; 165 | freshForum: MForumHand; 166 | freshConference: MConferencesArray; 167 | begin 168 | freshForum := MForumHand(NewHandleClear(SizeOf(MForumArray))); 169 | with freshForum^^[1] do 170 | begin 171 | Name := 'Forum #1'; 172 | numConferences := 15; 173 | MinSL := 5; 174 | MinAge := 0; 175 | AccessLetter := char(0); 176 | Moderators[1] := 0; 177 | Moderators[2] := 0; 178 | Moderators[3] := 0; 179 | for i := 1 to 25 do 180 | reserved[i] := char(0); 181 | end; 182 | for i := 2 to 20 do 183 | with freshForum^^[i] do 184 | begin 185 | Name := StringOf('Forum #', i : 0); 186 | numConferences := 0; 187 | MinSL := 5; 188 | MinAge := 0; 189 | AccessLetter := char(0); 190 | Moderators[1] := 0; 191 | Moderators[2] := 0; 192 | Moderators[3] := 0; 193 | for x := 1 to 25 do 194 | reserved[x] := char(0); 195 | end; 196 | for i := 1 to 20 do 197 | begin 198 | freshConference[i] := FiftyConferencesHand(NewHandleClear(SizeOf(FiftyConferences))); 199 | end; 200 | for i := 1 to freshForum^^[1].numConferences do 201 | with freshConference[1]^^[i] do 202 | begin 203 | Name := StringOf('Conference #', i : 0); 204 | SLtoRead := 5; 205 | SLtoPost := 30; 206 | MaxMessages := 50; 207 | AnonID := 0; 208 | MinAge := 0; 209 | AccessLetter := char(0); 210 | Threading := true; 211 | ConfType := 0; 212 | RealNames := false; 213 | ShowCity := false; 214 | FileAttachments := true; 215 | DLCost := 0.0; 216 | EchoName := char(0); 217 | Moderators[1] := 0; 218 | Moderators[2] := 0; 219 | Moderators[3] := 0; 220 | for x := 1 to 27 do 221 | reserved[x] := char(0); 222 | end; 223 | result := Create(Path, 0, 'HRMS', 'DATA'); 224 | CreateResFile(Path); 225 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 226 | AddResource(handle(freshForum), 'MFor', 0, 'MForum Information'); 227 | for i := 1 to 20 do 228 | AddResource(handle(freshConference[i]), 'Conf', i, ''); 229 | freshFB := FeedBackhand(NewHandleClear(SizeOf(FeedBackRec))); 230 | AddResource(handle(freshFB), 'MFor', 1, 'Feedback'); 231 | CloseResFile(TheFile); 232 | end; 233 | 234 | procedure CreateMailer; 235 | var 236 | freshMailer: MailerHand; 237 | result: OSErr; 238 | TheFile: integer; 239 | begin 240 | freshMailer := MailerHand(NewHandleClear(SizeOf(MailerRec))); 241 | with freshMailer^^ do 242 | begin 243 | Application := HDPath; 244 | GenericPath := HDPath; 245 | MailerAware := false; 246 | SubLaunchMailer := 3; 247 | EventPath := concat(HDPath, 'System Folder:Preferences:'); 248 | MailerNode := 1; 249 | AllowCrashMail := false; 250 | ImportSpeed := 4; 251 | UseRealNames := false; 252 | CrashMailPath := HDPath; 253 | UseEMSI := false; 254 | hwtIPAddr := $4537ea64; 255 | end; 256 | result := Create(Path, 0, 'HRMS', 'DATA'); 257 | CreateResFile(Path); 258 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 259 | AddResource(handle(freshMailer), 'Info', 0, 'Mailer Information'); 260 | CloseResFile(TheFile); 261 | end; 262 | 263 | procedure CreateNewUser; 264 | var 265 | freshNewUser: NewUserHand; 266 | result: OSErr; 267 | TheFile: integer; 268 | begin 269 | freshNewUser := NewUserHand(NewHandleClear(SizeOf(NewUserRec))); 270 | with freshNewUser^^ do 271 | begin 272 | Handle := false; 273 | Gender := true; 274 | RealName := true; 275 | BirthDay := true; 276 | City := true; 277 | Country := false; 278 | VoicePN := true; 279 | DataPN := false; 280 | Company := false; 281 | Street := true; 282 | Computer := true; 283 | Sysop[1] := false; 284 | Sysop[2] := false; 285 | Sysop[3] := false; 286 | SysopText[1] := char(0); 287 | SysopText[2] := char(0); 288 | SysopText[3] := char(0); 289 | NoVFeedback := false; 290 | QScanBack := 30; 291 | NoAutoCapital := false; 292 | end; 293 | result := Create(Path, 0, 'HRMS', 'DATA'); 294 | CreateResFile(Path); 295 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 296 | AddResource(handle(freshNewUser), 'NEWu', 0, 'New User Options'); 297 | CloseResFile(TheFile); 298 | end; 299 | 300 | procedure CreateSecurityLevels; 301 | var 302 | freshSecLevels: SecLevHand; 303 | result: OSErr; 304 | TheFile, i: integer; 305 | begin 306 | freshSecLevels := SecLevHand(NewHandleClear(SizeOf(NewSecurity))); 307 | with freshSecLevels^^[5] do 308 | begin 309 | Active := true; 310 | Class := 'Limited'; 311 | TransLevel := 5; 312 | PostMessage := true; 313 | UDRatio := true; 314 | PCRatio := true; 315 | AnonMsg := true; 316 | AutoMsg := true; 317 | Listuser := true; 318 | BBSList := true; 319 | Uploader := true; 320 | ReadAnon := true; 321 | PPFile := true; 322 | DLRatioOneTo := 10; 323 | PostRatioOneTo := 4; 324 | MessComp := 1.0; 325 | XferComp := 1.0; 326 | MesgDay := 4; 327 | LnsMessage := 40; 328 | CallsPrDay := 2; 329 | TimeAllowed := 10; 330 | end; 331 | with freshSecLevels^^[10] do 332 | begin 333 | Active := true; 334 | Class := 'New User'; 335 | TransLevel := 10; 336 | PostMessage := true; 337 | UDRatio := true; 338 | AnonMsg := true; 339 | AutoMsg := true; 340 | Listuser := true; 341 | BBSList := true; 342 | Uploader := true; 343 | ReadAnon := true; 344 | PPFile := true; 345 | DLRatioOneTo := 99; 346 | PostRatioOneTo := 4; 347 | MessComp := 1.0; 348 | XferComp := 1.0; 349 | MesgDay := 4; 350 | LnsMessage := 40; 351 | CallsPrDay := 3; 352 | TimeAllowed := 10; 353 | end; 354 | with freshSecLevels^^[30] do 355 | begin 356 | Active := true; 357 | Class := 'Validated'; 358 | TransLevel := 30; 359 | UDRatio := true; 360 | PCRatio := true; 361 | AnonMsg := true; 362 | AutoMsg := true; 363 | ReadAnon := true; 364 | DLRatioOneTo := 5; 365 | PostRatioOneTo := 4; 366 | MessComp := 1.0; 367 | XferComp := 1.0; 368 | MesgDay := 10; 369 | LnsMessage := 100; 370 | CallsPrDay := 8; 371 | TimeAllowed := 40; 372 | end; 373 | with freshSecLevels^^[60] do 374 | begin 375 | Active := true; 376 | Class := 'Hi Access'; 377 | TransLevel := 60; 378 | AnonMsg := true; 379 | AutoMsg := true; 380 | ReadAnon := true; 381 | DLRatioOneTo := 0; 382 | PostRatioOneTo := 4; 383 | MessComp := 1.0; 384 | XferComp := 1.0; 385 | MesgDay := 20; 386 | LnsMessage := 100; 387 | CallsPrDay := 12; 388 | TimeAllowed := 60; 389 | end; 390 | with freshSecLevels^^[200] do 391 | begin 392 | Active := true; 393 | Class := 'CoSysOp'; 394 | TransLevel := 200; 395 | DLRatioOneTo := 0; 396 | PostRatioOneTo := 0; 397 | MessComp := 1.0; 398 | XferComp := 1.0; 399 | MesgDay := 99; 400 | LnsMessage := 200; 401 | CallsPrDay := 99; 402 | TimeAllowed := 180; 403 | end; 404 | with freshSecLevels^^[255] do 405 | begin 406 | Active := true; 407 | Class := 'SysOp'; 408 | TransLevel := 255; 409 | DLRatioOneTo := 0; 410 | PostRatioOneTo := 0; 411 | MessComp := 1.0; 412 | XferComp := 1.0; 413 | MesgDay := 99; 414 | LnsMessage := 200; 415 | CallsPrDay := 99; 416 | TimeAllowed := 180; 417 | for i := 1 to 26 do 418 | Restrics[i] := true; 419 | end; 420 | result := Create(Path, 0, 'HRMS', 'DATA'); 421 | CreateResFile(Path); 422 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 423 | AddResource(handle(freshSecLevels), 'Lvls', 0, 'Security Levels'); 424 | CloseResFile(TheFile); 425 | end; 426 | 427 | procedure CreateForumInformation; 428 | var 429 | freshForum: ForumIdxHand; 430 | result: OSErr; 431 | TheFile: integer; 432 | begin 433 | freshForum := ForumIdxHand(NewHandleClear(SizeOf(ForumIdxRec))); 434 | with freshForum^^ do 435 | begin 436 | NumForums := 2; 437 | Name[0] := 'Sysop'; 438 | Name[1] := 'Area #1'; 439 | MinDsl[0] := 200; 440 | MinDsl[1] := 0; 441 | numDirs[0] := 3; 442 | numDirs[1] := 15; 443 | end; 444 | result := Create(Path, 0, 'HRMS', 'DATA'); 445 | CreateResFile(Path); 446 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 447 | AddResource(handle(freshForum), 'Info', 0, 'Forum Information'); 448 | CloseResFile(TheFile); 449 | end; 450 | 451 | procedure CreateDirectories; 452 | var 453 | freshDir: ReadDirHandle; 454 | result: OSErr; 455 | TheFile, i: integer; 456 | s: str255; 457 | begin 458 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 459 | if resError <> noErr then 460 | begin 461 | result := Create(Path, 0, 'HRMS', 'DATA'); 462 | CreateResFile(Path); 463 | TheFile := OpenRFPerm(Path, 0, fsRdWrPerm); 464 | end; 465 | 466 | freshDir := ReadDirHandle(NewHandleClear(SizeOf(DirDataFile))); 467 | with freshDir^^.Dr[1] do 468 | begin 469 | DirName := 'Sysop Uploads'; 470 | Path := concat(HFPath, ':Files:Sysop:01:'); 471 | MinDSL := 200; 472 | DSLtoUL := 10; 473 | DSLtoDL := 200; 474 | MaxFiles := 200; 475 | Restriction := char(0); 476 | NonMacFiles := 0; 477 | mode := 0; 478 | MinAge := 0; 479 | FileNameLength := 20; 480 | freeDir := false; 481 | AllowUploads := false; 482 | Handles := false; 483 | ShowUploader := false; 484 | Color := 0; 485 | TapeVolume := false; 486 | SlowVolume := false; 487 | Operators[1] := 0; 488 | Operators[2] := 0; 489 | Operators[3] := 0; 490 | DLCost := 1.0; 491 | ULCost := 1.0; 492 | DLCreditor := 0.0; 493 | HowLong := 0; 494 | UploadOnly := false; 495 | end; 496 | with freshDir^^.Dr[2] do 497 | begin 498 | DirName := 'Mail Attachments'; 499 | Path := concat(HFPath, ':Files:Sysop:02:'); 500 | MinDSL := 200; 501 | DSLtoUL := 10; 502 | DSLtoDL := 200; 503 | MaxFiles := 1000; 504 | Restriction := char(0); 505 | NonMacFiles := 0; 506 | mode := 0; 507 | MinAge := 0; 508 | FileNameLength := 31; 509 | freeDir := false; 510 | AllowUploads := false; 511 | Handles := false; 512 | ShowUploader := false; 513 | Color := 0; 514 | TapeVolume := false; 515 | SlowVolume := false; 516 | Operators[1] := 0; 517 | Operators[2] := 0; 518 | Operators[3] := 0; 519 | DLCost := 1.0; 520 | ULCost := 0.0; 521 | DLCreditor := 0.0; 522 | HowLong := 0; 523 | UploadOnly := false; 524 | end; 525 | with freshDir^^.Dr[3] do 526 | begin 527 | DirName := 'Message Attachments'; 528 | Path := concat(HFPath, ':Files:Sysop:03:'); 529 | MinDSL := 200; 530 | DSLtoUL := 10; 531 | DSLtoDL := 200; 532 | MaxFiles := 1000; 533 | Restriction := char(0); 534 | NonMacFiles := 0; 535 | mode := 0; 536 | MinAge := 0; 537 | FileNameLength := 31; 538 | freeDir := false; 539 | AllowUploads := false; 540 | Handles := false; 541 | ShowUploader := false; 542 | Color := 0; 543 | TapeVolume := false; 544 | SlowVolume := false; 545 | Operators[1] := 0; 546 | Operators[2] := 0; 547 | Operators[3] := 0; 548 | DLCost := 1.0; 549 | ULCost := 0.0; 550 | DLCreditor := 0.0; 551 | HowLong := 0; 552 | UploadOnly := false; 553 | end; 554 | AddResource(handle(freshDir), 'Dirs', UniqueID('Dirs'), 'Sysop'); 555 | ReleaseResource(handle(freshDir)); 556 | 557 | freshDir := ReadDirHandle(NewHandleClear(SizeOf(DirDataFile))); 558 | for i := 1 to 15 do 559 | with freshDir^^.Dr[i] do 560 | begin 561 | DirName := StringOf('Directory', i : 0); 562 | if i < 10 then 563 | s := StringOf('0', i : 0) 564 | else 565 | s := StringOf(i : 0); 566 | Path := concat(HFPath, ':Files:Area #1:', s, ':'); 567 | MinDSL := 10; 568 | DSLtoUL := 10; 569 | DSLtoDL := 30; 570 | MaxFiles := 500; 571 | Restriction := char(0); 572 | NonMacFiles := 0; 573 | mode := 0; 574 | MinAge := 0; 575 | FileNameLength := 20; 576 | freeDir := false; 577 | AllowUploads := false; 578 | Handles := false; 579 | ShowUploader := false; 580 | Color := 0; 581 | TapeVolume := false; 582 | SlowVolume := false; 583 | Operators[1] := 0; 584 | Operators[2] := 0; 585 | Operators[3] := 0; 586 | DLCost := 1.0; 587 | ULCost := 1.0; 588 | DLCreditor := 0.0; 589 | HowLong := 0; 590 | UploadOnly := false; 591 | end; 592 | AddResource(handle(freshDir), 'Dirs', UniqueID('Dirs'), 'Area #1'); 593 | CloseResFile(TheFile); 594 | end; 595 | 596 | procedure CreateAddressBooks; 597 | var 598 | ABFile, UFile, i: integer; 599 | result: OSErr; 600 | BlankBook: AddressBookHand; 601 | UFileSize, SizeOfBook: longint; 602 | begin 603 | BlankBook := AddressBookHand(NewHandle(sizeOf(AddressBookArray))); 604 | for i := 1 to 40 do 605 | BlankBook^^[i] := char(0); 606 | 607 | result := FSOpen(concat(sharedPath, 'Shared Files:Users'), 0, UFile); 608 | if result = noErr then 609 | begin 610 | result := GetEOF(UFile, UFileSize); 611 | if UFileSize >= SizeOf(UserRec) then 612 | begin 613 | UFileSize := UFileSize div SizeOf(UserRec); 614 | result := Create(Path, 0, 'HRMS', 'DATA'); 615 | result := FSOpen(Path, 0, ABFile); 616 | SizeOfBook := SizeOf(AddressBookArray); 617 | for i := 1 to UFileSize do 618 | result := FSWrite(ABFile, SizeOfBook, pointer(BlankBook^)); 619 | result := FSClose(ABFile); 620 | end 621 | else 622 | result := Create(Path, 0, 'HRMS', 'DATA'); 623 | end 624 | else 625 | result := Create(Path, 0, 'HRMS', 'DATA'); 626 | result := FSClose(UFile); 627 | if BlankBook <> nil then 628 | begin 629 | DisposHandle(handle(BlankBook)); 630 | BlankBook := nil; 631 | end; 632 | end; 633 | 634 | procedure CreateActionWords; 635 | var 636 | TheFile: integer; 637 | result: OSErr; 638 | SizeOfThis: longint; 639 | AW: ActionWordRec; {Action Word} 640 | begin 641 | result := Create(Path, 0, 'HRMS', 'DATA'); 642 | result := FSOpen(Path, 0, TheFile); 643 | SizeOfThis := SizeOf(ActionWordRec); 644 | AW.ActionWord := 'BORING'; 645 | AW.TargetUser := '[U] says, "You are boring me to tears."'; 646 | AW.OtherUser := '[T] has bored [U] to tears.'; 647 | AW.Initiating := 'You tell [T], "You''re boring me to tears.'; 648 | AW.Unspecified := '[U] is bored to tears.'; 649 | result := FSWrite(TheFile, SizeOfThis, @AW); 650 | AW.ActionWord := 'BYE'; 651 | AW.TargetUser := '[U] tells you goodbye as [U:he/she] heads out the door.'; 652 | AW.OtherUser := '[U] tells [T] bye as [U:he/she] heads out the door.'; 653 | AW.Initiating := 'You say "Goodbye [T]."'; 654 | AW.Unspecified := '[U] says "Goodbye everyone."'; 655 | result := FSWrite(TheFile, SizeOfThis, @AW); 656 | AW.ActionWord := 'CALL'; 657 | AW.TargetUser := '[U] says, "Can I call you later?"'; 658 | AW.OtherUser := '[U] says, "[T] can I call you later?"'; 659 | AW.Initiating := 'You ask [T] if you can call them later.'; 660 | AW.Unspecified := '[U] says "Can I call all of you?"'; 661 | result := FSWrite(TheFile, SizeOfThis, @AW); 662 | AW.ActionWord := 'CUSS'; 663 | AW.TargetUser := '[U] cusses you out in disgust.'; 664 | AW.OtherUser := '[U] is cussing at [T] in disgust.'; 665 | AW.Initiating := 'You start swearing at [T] in disgust.'; 666 | AW.Unspecified := '[U] says, "@#%!#@$!@%@."'; 667 | result := FSWrite(TheFile, SizeOfThis, @AW); 668 | AW.ActionWord := 'DANCE'; 669 | AW.TargetUser := '[U] is spinning you around the dance floor.'; 670 | AW.OtherUser := '[U] is spinning [T] around the dance floor.'; 671 | AW.Initiating := 'You take [T] for a spin around the dance floor.'; 672 | AW.Unspecified := '[U] would like to dance with someone.'; 673 | result := FSWrite(TheFile, SizeOfThis, @AW); 674 | AW.ActionWord := 'DATE'; 675 | AW.TargetUser := '[U] asks you, "Would you like to go out sometime soon?"'; 676 | AW.OtherUser := '[U] asks [T] if [T:he/she] would like to go out.'; 677 | AW.Initiating := 'You ask [T] to accompany you on a date.'; 678 | AW.Unspecified := '[U] wants to know if anyone wants to go on a date.'; 679 | result := FSWrite(TheFile, SizeOfThis, @AW); 680 | AW.ActionWord := 'DRINK'; 681 | AW.TargetUser := '[U] hands you a drink.'; 682 | AW.OtherUser := '[U] hands [T] a drink.'; 683 | AW.Initiating := 'You hand [T] a refreshing beverage.'; 684 | AW.Unspecified := '[U] says, "Drinks for everyone."'; 685 | result := FSWrite(TheFile, SizeOfThis, @AW); 686 | AW.ActionWord := 'EMAIL'; 687 | AW.TargetUser := '[U] says, "Send me the details in E-mail."'; 688 | AW.OtherUser := '[U] tells [T] to send [U:him/her] the details in E-mail.'; 689 | AW.Initiating := 'You tell [T] to send the details in E-mial.'; 690 | AW.Unspecified := '[U] says, "I''ll send everyone the details in E-mail."'; 691 | result := FSWrite(TheFile, SizeOfThis, @AW); 692 | AW.ActionWord := 'EYES'; 693 | AW.TargetUser := '[U] says "Your eyes light up this room."'; 694 | AW.OtherUser := '[U] thinks [T]''s eyes light up the room. '; 695 | AW.Initiating := 'You tell [T] that [T:his/her] eyes light up the room.'; 696 | AW.Unspecified := '[U] looks into everyone''s eyes.'; 697 | result := FSWrite(TheFile, SizeOfThis, @AW); 698 | AW.ActionWord := 'FUNNY'; 699 | AW.TargetUser := '[U] thinks you are a funny [T:guy/lady]!'; 700 | AW.OtherUser := '[U] thinks [T] is funny!'; 701 | AW.Initiating := 'You think they are funny!!!!'; 702 | AW.Unspecified := '[U] thinks you all are funny!!!'; 703 | result := FSWrite(TheFile, SizeOfThis, @AW); 704 | AW.ActionWord := 'GRIN'; 705 | AW.TargetUser := '[U] is grinning slyly at you.'; 706 | AW.OtherUser := '[U] is grinning slyly at [T].'; 707 | AW.Initiating := 'You grin slyly at [T].'; 708 | AW.Unspecified := '[U] is grinning from ear to ear.'; 709 | result := FSWrite(TheFile, SizeOfThis, @AW); 710 | AW.ActionWord := 'HIGH5'; 711 | AW.TargetUser := '[U] says, "ALL RIGHT [T:MAN/GIRL]!!!!"'; 712 | AW.OtherUser := '[U] yells at [T], "All RIGHT!!!"'; 713 | AW.Initiating := 'You yell at [T], "ALL RIGHT [T:MAN/GIRL]!!!!"'; 714 | AW.Unspecified := '[U] runs around the room and high fives'' everyone.'; 715 | result := FSWrite(TheFile, SizeOfThis, @AW); 716 | AW.ActionWord := 'HUG'; 717 | AW.TargetUser := '[U] is hugging you.'; 718 | AW.OtherUser := '[U] is hugging [T].'; 719 | AW.Initiating := 'You are hugging [T].'; 720 | AW.Unspecified := '[U] needs a group hug.'; 721 | result := FSWrite(TheFile, SizeOfThis, @AW); 722 | AW.ActionWord := 'KICK'; 723 | AW.TargetUser := '[U] kicks you on your butt.'; 724 | AW.OtherUser := '[U] kicks [T] on [T:his/her] butt.'; 725 | AW.Initiating := 'You are kicking [T] on [T:his/her] butt.'; 726 | AW.Unspecified := '[U] says, "I''m going to kick all of you."'; 727 | result := FSWrite(TheFile, SizeOfThis, @AW); 728 | AW.ActionWord := 'KISS'; 729 | AW.TargetUser := '[U] kisses you lightly on your cheek.'; 730 | AW.OtherUser := '[U] kisses [T] lightly on [T:his/her] cheek.'; 731 | AW.Initiating := 'You kiss [T] lightly on [T:his/her] cheek.'; 732 | AW.Unspecified := '[U] blows kisses to everyone.'; 733 | result := FSWrite(TheFile, SizeOfThis, @AW); 734 | AW.ActionWord := 'LAUGH'; 735 | AW.TargetUser := '[U] is laughing at you.'; 736 | AW.OtherUser := '[U] laughs at [T].'; 737 | AW.Initiating := 'You laugh at [T].'; 738 | AW.Unspecified := '[U] laughs out loud.'; 739 | result := FSWrite(TheFile, SizeOfThis, @AW); 740 | AW.ActionWord := 'LISTEN'; 741 | AW.TargetUser := '[U] is listening intensely to your every word.'; 742 | AW.OtherUser := '[U] listens intently to what [T] has to say.'; 743 | AW.Initiating := 'You listen intently to what [T] has to say.'; 744 | AW.Unspecified := '[U] is listening to what everyone has to say.'; 745 | result := FSWrite(TheFile, SizeOfThis, @AW); 746 | AW.ActionWord := 'LOVE'; 747 | AW.TargetUser := '[U] says, "I love you [T]."'; 748 | AW.OtherUser := '[U] says [U:he/she] loves [T].'; 749 | AW.Initiating := 'You tell [T], "I love you."'; 750 | AW.Unspecified := '[U] exclaims, "I''m in love."'; 751 | result := FSWrite(TheFile, SizeOfThis, @AW); 752 | AW.ActionWord := 'PRETTY'; 753 | AW.TargetUser := '[U] says, "I think you are very pretty."'; 754 | AW.OtherUser := '[U] tells [T], "You are very pretty."'; 755 | AW.Initiating := 'You say to [T], "You are very pretty."'; 756 | AW.Unspecified := '[U] asks, "Am I pretty?"'; 757 | result := FSWrite(TheFile, SizeOfThis, @AW); 758 | AW.ActionWord := 'PUNCH'; 759 | AW.TargetUser := '[U] punches you on the nose.'; 760 | AW.OtherUser := '[U] punches [T] on the nose.'; 761 | AW.Initiating := 'You punch [T] on the nose.'; 762 | AW.Unspecified := '[U] punches everyone.'; 763 | result := FSWrite(TheFile, SizeOfThis, @AW); 764 | AW.ActionWord := 'SAD'; 765 | AW.TargetUser := '[U] frowns and says, "You are making me sad."'; 766 | AW.OtherUser := '[T] has made [U] very sad.'; 767 | AW.Initiating := 'You tell [T] that [T:he/she] is making you sad.'; 768 | AW.Unspecified := '[U] is very sad.'; 769 | result := FSWrite(TheFile, SizeOfThis, @AW); 770 | AW.ActionWord := 'SMILE'; 771 | AW.TargetUser := '[U] is smiling at you.'; 772 | AW.OtherUser := '[U] is smiling at [T].'; 773 | AW.Initiating := 'You smile at [T].'; 774 | AW.Unspecified := '[U] is smiling at everyone.'; 775 | result := FSWrite(TheFile, SizeOfThis, @AW); 776 | AW.ActionWord := 'SORRY'; 777 | AW.TargetUser := '"I''m really sorry", [U] says.'; 778 | AW.OtherUser := '[U] tells [T] that [U:he/she] is sorry.'; 779 | AW.Initiating := 'You tell [T] you are sorry.'; 780 | AW.Unspecified := '[U] says, "I''m sorry all."'; 781 | result := FSWrite(TheFile, SizeOfThis, @AW); 782 | AW.ActionWord := 'TICKLE'; 783 | AW.TargetUser := '[U] is tickling your side.'; 784 | AW.OtherUser := '[U] is tickling [T]''s side.'; 785 | AW.Initiating := 'You tickle [T]''s sides.'; 786 | AW.Unspecified := '[U] wants to tickle someone.'; 787 | result := FSWrite(TheFile, SizeOfThis, @AW); 788 | AW.ActionWord := 'TIME'; 789 | AW.TargetUser := '[U] asks you, "What time is it?"'; 790 | AW.OtherUser := '[U] asks [T] "What time is it."'; 791 | AW.Initiating := 'You ask [T] for the time.'; 792 | AW.Unspecified := '[U] exclaims, "Time....take five."'; 793 | result := FSWrite(TheFile, SizeOfThis, @AW); 794 | AW.ActionWord := 'WAIT'; 795 | AW.TargetUser := '[U] wants you to wait just a second.'; 796 | AW.OtherUser := '[U] wants [T] to wait just a second.'; 797 | AW.Initiating := 'You ask [T] to wait just a second.'; 798 | AW.Unspecified := '[U] is asking everybody to wait just a second.'; 799 | result := FSWrite(TheFile, SizeOfThis, @AW); 800 | AW.ActionWord := 'WAVE'; 801 | AW.TargetUser := '[U] is waving at you.'; 802 | AW.OtherUser := '[U] is waving at [T].'; 803 | AW.Initiating := 'You wave at [T].'; 804 | AW.Unspecified := '[U] is waving to everybody.'; 805 | result := FSWrite(TheFile, SizeOfThis, @AW); 806 | AW.ActionWord := 'WELCOME'; 807 | AW.TargetUser := '[U] welcomes you to the chat room.'; 808 | AW.OtherUser := '[U] welcomes [T] to the chat room.'; 809 | AW.Initiating := 'You welcome [T] to the chat room.'; 810 | AW.Unspecified := '[U] says, "Welcome all!!"'; 811 | result := FSWrite(TheFile, SizeOfThis, @AW); 812 | AW.ActionWord := 'WINK'; 813 | AW.TargetUser := '[U] is winking at you from across the room.'; 814 | AW.OtherUser := '[U] winks at [T] from across the room.'; 815 | AW.Initiating := 'You wink at [T] from across the room.'; 816 | AW.Unspecified := '[U] winks at everyone.'; 817 | result := FSWrite(TheFile, SizeOfThis, @AW); 818 | AW.ActionWord := 'YELL'; 819 | AW.TargetUser := '[U] yells at you to get your attention.'; 820 | AW.OtherUser := '[U] yells at [T] to get [T:his/her] attention.'; 821 | AW.Initiating := 'You yell at [T] to get [T:his/her] attention.'; 822 | AW.Unspecified := '[U] is yelling at the top of [U:his/her] lungs.'; 823 | result := FSWrite(TheFile, SizeOfThis, @AW); 824 | result := FSClose(TheFile); 825 | end; 826 | 827 | end. -------------------------------------------------------------------------------- /Source/MesEdit.p: -------------------------------------------------------------------------------- 1 | { Segments: MesEdit_1 } 2 | unit Message_Editor; 3 | interface 4 | uses 5 | AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, systemprefs, SystemPrefs2, NodePrefs, NodePrefs2; 6 | 7 | procedure OpenBase (whichForum, whichSub: integer; extraRec: boolean); 8 | procedure SaveBase (wForum, wSub: integer); 9 | procedure LoadFileAsMsg (name: str255); 10 | procedure AddLine (toAdd: str255); 11 | procedure DeletePost (wForum, wConf, wMesg: integer; delePost: boolean); 12 | function takeMsgTop: str255; 13 | procedure SaveNetMail (OtherName: str255); 14 | function SaveMessAsEmail: boolean; 15 | procedure LoadHelpFile; 16 | procedure HeReadIt (ReadMa: eMailRec); 17 | function LoadSpecialText (myText: charsHandle; which: integer): boolean; 18 | procedure DeleteMail (whichNum: longint); 19 | function isPostRatioOK: boolean; 20 | procedure FindMyEmail (userNum: integer); 21 | function FindMyDmail (userNum: integer): integer; 22 | function OpenMData (wForum, wConf: integer; Index: boolean): integer; 23 | function SaveMessage (charsToSave: TextHand; wForum, wConf: integer): longint; 24 | function ReadMessage (storedAs: longint; wForum, wConf: integer): TextHand; 25 | procedure RemoveMessage (storedAs: longint; wForum, wConf: integer); 26 | function SavePost (wForum, wConf: integer): boolean; 27 | procedure SaveNetPost; 28 | 29 | implementation 30 | var 31 | NumIndexes: integer; 32 | 33 | {$S MesEdit_1} 34 | procedure DeleteFileAttachment (IsItMail: boolean; FileName: str255); 35 | external; 36 | 37 | procedure DeleteMail; 38 | var 39 | tempStored: longint; 40 | i, theNum, twoNum: integer; 41 | begin 42 | theNum := whichNum; 43 | if (theEmail <> nil) and (theNum >= 0) and (theNum < availEmails) then 44 | begin 45 | if theEmail^^[theNum].multiMail then 46 | begin 47 | twoNum := -1; 48 | tempStored := theEmail^^[theNum].storedAs; 49 | for i := 1 to availEmails do 50 | if (theEmail^^[i - 1].storedAs = tempStored) and ((i - 1) <> theNum) then 51 | twoNum := i; 52 | if twoNum = -1 then 53 | begin 54 | if (theEmail^^[theNum].FileAttached) then 55 | DeleteFileAttachment(true, theEmail^^[theNum].FileName); 56 | RemoveMessage(theEmail^^[theNum].storedAs, 0, 0); 57 | end; 58 | end 59 | else if theEmail^^[theNum].MType = 1 then 60 | RemoveMessage(theEmail^^[theNum].storedAs, 0, 0); 61 | if (availEmails - 1) > theNum then 62 | begin 63 | BlockMove(@theEmail^^[theNum + 1], @theEmail^^[theNum], longint(availEmails - 1 - theNum) * SizeOf(emailRec)); 64 | end; 65 | SetHandleSize(handle(theEmail), GetHandleSize(handle(theEmail)) - SizeOf(emailRec)); 66 | availEmails := availEmails - 1; 67 | emailDirty := true; 68 | SaveEmailData; 69 | emailDirty := false; 70 | end; 71 | end; 72 | 73 | procedure FindMyEmail (userNum: integer); 74 | var 75 | i: integer; 76 | numOfEm: integer; 77 | begin 78 | with curGlobs^ do 79 | begin 80 | if myEmailList <> nil then 81 | SetHandleSize(handle(myEmailList), 0) 82 | else 83 | myEmailList := intListHand(NewHandle(0)); 84 | HNoPurge(handle(myEmailList)); 85 | if (theEmail <> nil) and (availEmails > 0) then 86 | begin 87 | numOfEm := 0; 88 | for i := 1 to availEmails do 89 | begin 90 | if (theEmail^^[i - 1].toUser = userNum) and (theEmail^^[i - 1].MType = 1) then 91 | begin 92 | numOfEm := numOfEm + 1; 93 | SetHandleSize(handle(myEmailList), getHandleSize(handle(myEmailList)) + 2); 94 | myEmailList^^[numOfEm - 1] := i - 1; 95 | end; 96 | end; 97 | end; 98 | end; 99 | end; 100 | 101 | function FindMyDmail (userNum: integer): integer; 102 | var 103 | i: integer; 104 | numOfEm: integer; 105 | begin 106 | numOfEm := 0; 107 | i := 0; 108 | with curGlobs^ do 109 | begin 110 | while (i < availEmails) do 111 | begin 112 | if (theEmail^^[i].MType = 0) and (theEmail^^[i].toUser = userNum) then 113 | numOfEm := numOfEm + 1; 114 | i := i + 1; 115 | end; 116 | end; 117 | FindMyDmail := NumOfEm; 118 | end; 119 | 120 | procedure DeletePost (wForum, wConf, wMesg: integer; delePost: boolean); 121 | var 122 | MessDataHnd: MesgHand; 123 | result: OSerr; 124 | tempString, tempString2, s2, s3: str255; 125 | MesgRef, tempInt, i: integer; 126 | AllRecsSize, tempLong: longint; 127 | tempBool: boolean; 128 | tempMesg: MesgRec; 129 | booshi: handle; 130 | s26: string[26]; 131 | s31: string[31]; 132 | begin 133 | with curglobs^ do 134 | begin 135 | s26 := MConference[wForum]^^[wConf].Name; 136 | s31 := MForum^^[wForum].Name; 137 | tempString := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' Data'); 138 | result := FSOpen(tempString, 0, mesgRef); 139 | if result = noErr then 140 | begin 141 | result := GetEOF(mesgRef, AllRecsSize); 142 | if (AllRecsSize div SizeOf(mesgRec)) >= wMesg then 143 | begin 144 | result := SetFPos(mesgRef, fsFromStart, longint(wMesg - 1) * SizeOf(mesgRec)); 145 | tempLong := SizeOf(mesgrec); 146 | result := FSRead(mesgref, templong, @tempMesg); 147 | if (AllRecsSize - SizeOf(MesgRec) * longint(wMesg)) > 0 then 148 | begin 149 | booshi := NewHandle(AllRecsSize - SizeOf(MesgRec) * longint(wMesg)); 150 | if memerror = 0 then 151 | begin 152 | HLock(handle(booshi)); 153 | tempLong := AllRecsSize - SizeOf(MesgRec) * longint(wMesg); 154 | result := FSRead(mesgRef, tempLong, pointer(booshi^)); 155 | result := SetFPos(mesgRef, fsFromStart, longint(wMesg - 1) * SizeOf(mesgRec)); 156 | tempLong := AllRecsSize - SizeOf(MesgRec) * longint(wMesg); 157 | result := FSWrite(mesgRef, tempLong, pointer(booshi^)); 158 | HUnlock(handle(booshi)); 159 | DisposHandle(handle(booshi)); 160 | end 161 | else 162 | SysBeep(1); 163 | end; 164 | result := SetEOF(mesgRef, AllRecsSize - SizeOf(mesgRec)); 165 | result := FSClose(mesgRef); 166 | if allrecsSize - (SizeOf(MesgRec)) <= 0 then 167 | result := FSDelete(tempString, 0); 168 | if delePost then 169 | begin 170 | if tempMesg.FileAttached then 171 | DeleteFileAttachment(false, tempMesg.FileName); 172 | RemoveMessage(tempMesg.storedAs, wForum, wConf); 173 | end; 174 | if curBase <> nil then 175 | begin 176 | if wMesg <= curNumMess then 177 | begin 178 | if (wMesg < curNumMess) then 179 | begin 180 | BlockMove(@curBase^^[wMesg], @curBase^^[wMesg - 1], Sizeof(mesgRec) * longint(curNumMess - wMesg)); 181 | end; 182 | curNumMess := curNumMess - 1; 183 | end; 184 | end; 185 | end 186 | else 187 | result := FSClose(mesgRef); 188 | end; 189 | end; 190 | end; 191 | 192 | function OpenMData (wForum, wConf: integer; Index: boolean): integer; 193 | var 194 | s1, s2: str255; 195 | myRef, i: integer; 196 | SizeOfFile: longint; 197 | s26: string[26]; 198 | s31: string[31]; 199 | begin 200 | with curglobs^ do 201 | begin 202 | if (curIndex <> nil) and (Index) then 203 | begin 204 | DisposHandle(handle(curIndex)); 205 | curIndex := nil; 206 | end; 207 | if wForum > 0 then 208 | begin 209 | s26 := MConference[wForum]^^[wConf].Name; 210 | s31 := MForum^^[wForum].Name; 211 | if Index then 212 | s1 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' Indx') 213 | else 214 | s1 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' Text') 215 | end 216 | else 217 | begin 218 | if Index then 219 | s1 := concat(InitSystHand^^.msgsPath, 'Email:Email Indx') 220 | else 221 | s1 := concat(InitSystHand^^.msgsPath, 'Email:Email Text'); 222 | end; 223 | 224 | result := FSOpen(s1, 0, myRef); 225 | if result <> noErr then 226 | begin 227 | s2 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' HDR'); 228 | result := FSOpen(s2, 0, myRef); 229 | if result <> noErr then 230 | result := Create(s2, 0, 'HRMS', 'TEXT') 231 | else 232 | result := FSClose(myRef); 233 | s2 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' AHDR'); 234 | result := FSOpen(s2, 0, myRef); 235 | if result <> noErr then 236 | result := Create(s2, 0, 'HRMS', 'TEXT') 237 | else 238 | result := FSClose(myRef); 239 | 240 | result := Create(s1, 0, 'HRMS', 'MESG'); 241 | result := FSOpen(s1, 0, myRef); 242 | if Index then 243 | begin 244 | curIndex := MessIndexHand(NewHandle(0)); 245 | MoveHHi(handle(curIndex)); 246 | NumIndexes := 0; 247 | end; 248 | end 249 | else if (result = noErr) and (Index) then 250 | begin 251 | result := GetEOF(myRef, SizeOfFile); 252 | curIndex := MessIndexHand(NewHandle(SizeOfFile)); 253 | MoveHHi(handle(curIndex)); 254 | result := FSRead(myRef, SizeOfFile, pointer(curIndex^)); 255 | NumIndexes := GetHandleSize(handle(curIndex)) div 2; 256 | end; 257 | OpenMData := myRef; 258 | end; 259 | end; 260 | 261 | procedure RemoveMessage (storedAs: longint; wForum, wConf: integer); 262 | var 263 | theRef: integer; 264 | csec, nsec, CurSize: longint; 265 | begin 266 | with curglobs^ do 267 | begin 268 | theRef := OpenMData(wForum, wConf, true); 269 | csec := storedas; 270 | while (csec > 0) and (csec <= NumIndexes) do 271 | begin 272 | nsec := curIndex^^[csec]; 273 | curIndex^^[csec] := 0; 274 | csec := nsec; 275 | end; 276 | result := SetFPos(theRef, fsFromStart, 0); 277 | CurSize := GetHandleSize(handle(curIndex)); 278 | result := FSWrite(theRef, CurSize, pointer(curIndex^)); 279 | result := FSClose(theRef); 280 | end; 281 | end; 282 | 283 | function SaveMessage (charsToSave: TextHand; wForum, wConf: integer): longint; {returns first block saved} 284 | var 285 | mLength, mWritten, mToWrite, CurSize, BlockSize: longint; 286 | theIRef, theMRef: integer; 287 | BlockCounter, BlocksNeeded, indexCounter, ExtraBlocks, i: integer; 288 | BlocksArray: array[1..50] of integer; 289 | NullBlock: packed array[1..512] of char; 290 | begin 291 | with curglobs^ do 292 | begin 293 | mLength := GetHandleSize(handle(charsToSave)); 294 | theIRef := OpenMData(wForum, wConf, true); 295 | BlockCounter := 1; 296 | BlocksNeeded := (mLength + 511) div 512; 297 | if BlocksNeeded > 50 then 298 | BlocksNeeded := 50; 299 | indexCounter := 1; 300 | while (BlockCounter <= BlocksNeeded) and (indexCounter <= NumIndexes) do 301 | begin 302 | if (curIndex^^[indexCounter] = 0) then 303 | begin 304 | BlocksArray[BlockCounter] := indexCounter; 305 | BlockCounter := BlockCounter + 1; 306 | end; 307 | indexCounter := indexCounter + 1; 308 | end; 309 | if (indexCounter > NumIndexes) and (NumIndexes <> 15000) then 310 | begin 311 | ExtraBlocks := BlocksNeeded - (BlockCounter - 1); 312 | CurSize := GetHandleSize(handle(curIndex)); 313 | SetHandleSize(handle(curIndex), CurSize + (ExtraBlocks * 2)); 314 | for i := 1 to ExtraBlocks do 315 | begin 316 | BlocksArray[BlockCounter] := indexCounter; 317 | BlockCounter := BlockCounter + 1; 318 | indexCounter := indexCounter + 1; 319 | end; 320 | end 321 | else if (NumIndexes >= 15000) then 322 | begin 323 | SaveMessage := -1; 324 | Exit(SaveMessage); 325 | end; 326 | theMRef := OpenMData(wForum, wConf, false); 327 | BlocksArray[BlockCounter] := -1; 328 | BlockCounter := 1; 329 | BlockSize := 512; 330 | mWritten := 0; 331 | while (BlockCounter <= BlocksNeeded) do 332 | begin 333 | result := SetFPos(theMRef, fsFromStart, BlockSize * longint(BlocksArray[BlockCounter] - 1)); 334 | if (mWritten + BlockSize) > mLength then 335 | begin 336 | mToWrite := mLength - mWritten; 337 | result := FSWrite(theMRef, mToWrite, @charsToSave^^[(BlockCounter - 1) * BlockSize]); 338 | mToWrite := BlockSize - (mLength - mWritten); 339 | for i := 1 to mToWrite do 340 | NullBlock[i] := char(0); 341 | result := FSWrite(theMRef, mToWrite, @NullBlock); 342 | end 343 | else 344 | begin 345 | result := FSWrite(theMRef, BlockSize, @charsToSave^^[(BlockCounter - 1) * BlockSize]); 346 | mWritten := mWritten + BlockSize; 347 | end; 348 | curIndex^^[BlocksArray[BlockCounter]] := BlocksArray[BlockCounter + 1]; 349 | BlockCounter := BlockCounter + 1; 350 | end; 351 | result := FSClose(theMRef); 352 | result := SetFPos(theIRef, fsFromStart, 0); 353 | CurSize := GetHandleSize(handle(curIndex)); 354 | result := FSWrite(theIRef, CurSize, pointer(curIndex^)); 355 | result := FSClose(theIRef); 356 | 357 | SaveMessage := BlocksArray[1]; 358 | end; 359 | end; 360 | 361 | function ReadMessage (storedAs: longint; wForum, wConf: integer): TextHand; 362 | var 363 | theIRef, theMRef: integer; 364 | BlocksNeeded, BlockCounter, indexCounter, ActualSize: integer; 365 | BlockSize: longint; 366 | tempchars: Texthand; 367 | begin 368 | with curglobs^ do 369 | begin 370 | BlockSize := 512; 371 | theIRef := OpenMData(wForum, wConf, true); 372 | indexCounter := storedAs; 373 | BlocksNeeded := 0; 374 | while (indexCounter > 0) and (indexCounter <= NumIndexes) do 375 | begin 376 | BlocksNeeded := BlocksNeeded + 512; 377 | indexCounter := curIndex^^[indexCounter]; 378 | end; 379 | if BlocksNeeded = 0 then 380 | begin 381 | ReadMessage := nil; 382 | result := FSClose(theIRef); 383 | Exit(ReadMessage); 384 | end; 385 | tempChars := TextHand(NewHandle(BlocksNeeded)); 386 | if MemError <> noErr then 387 | begin 388 | ReadMessage := nil; 389 | result := FSClose(theIRef); 390 | Exit(ReadMessage); 391 | end; 392 | indexCounter := storedAs; 393 | BlockCounter := 0; 394 | theMRef := OpenMData(wForum, wConf, false); 395 | while (indexCounter > 0) and (indexCounter <= NumIndexes) do 396 | begin 397 | result := SetFPos(theMRef, fsFromStart, BlockSize * (longint(indexCounter) - 1)); 398 | result := FSRead(theMRef, BlockSize, @tempChars^^[BlockCounter]); 399 | BlockCounter := BlockCounter + BlockSize; 400 | indexCounter := curIndex^^[indexCounter]; 401 | end; 402 | result := FSClose(theIRef); 403 | result := FSClose(theMRef); 404 | ActualSize := BlockCounter - 512; 405 | while (ActualSize < BlockCounter) and (tempchars^^[ActualSize] <> char(26)) do 406 | ActualSize := ActualSize + 1; 407 | SetHandleSize(handle(tempChars), ActualSize); 408 | MoveHHi(handle(tempChars)); 409 | end; 410 | ReadMessage := tempchars; 411 | end; 412 | 413 | function SavePost (wForum, wConf: integer): boolean; 414 | var 415 | s, s2: str255; 416 | myRef: integer; 417 | templong: longint; 418 | s26: string[26]; 419 | s31: string[31]; 420 | begin 421 | with curglobs^ do 422 | begin 423 | curMesgRec.HasRead := false; 424 | curMesgRec.storedAs := SaveMessage(curWriting, wForum, wConf); 425 | if (curMesgRec.storedAs <> -1) then 426 | begin 427 | s26 := MConference[wForum]^^[wConf].Name; 428 | s31 := MForum^^[wForum].Name; 429 | s := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' Data'); 430 | result := FSOpen(s, 0, myRef); 431 | if result <> noErr then 432 | begin 433 | s2 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' HDR'); 434 | result := FSOpen(s2, 0, myRef); 435 | if result <> noErr then 436 | result := Create(s2, 0, 'HRMS', 'TEXT') 437 | else 438 | result := FSClose(myRef); 439 | s2 := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' AHDR'); 440 | result := FSOpen(s2, 0, myRef); 441 | if result <> noErr then 442 | result := Create(s2, 0, 'HRMS', 'TEXT') 443 | else 444 | result := FSClose(myRef); 445 | 446 | result := Create(s, 0, 'HRMS', 'DATA'); 447 | result := FSOpen(s, 0, myRef); 448 | end; 449 | result := SetFPos(myRef, fsFromLEOF, 0); 450 | tempLong := SizeOf(mesgRec); 451 | result := FSWrite(myRef, tempLong, @curMesgRec); 452 | result := FSClose(myRef); 453 | SavePost := true; 454 | end 455 | else 456 | SavePost := false; 457 | end; 458 | end; 459 | 460 | function isPostRatioOK: boolean; 461 | var 462 | tempReal, tempReal2, tempReal3: real; 463 | begin 464 | tempReal := curglobs^.thisUser.messagesPosted; 465 | tempReal2 := curglobs^.thisUser.totalLogons; 466 | tempReal3 := SecLevels^^[curglobs^.thisUser.SL].postRatioOneTo; 467 | if tempReal3 = 0 then 468 | tempreal3 := 1; 469 | if (tempReal / tempReal2) >= (1 / tempReal3) then 470 | isPostRatioOK := TRUE 471 | else 472 | isPostRatioOK := FALSE; 473 | end; 474 | 475 | function takeMsgTop: str255; 476 | var 477 | i, b, c: longint; 478 | ts: str255; 479 | begin 480 | with curglobs^ do 481 | begin 482 | i := GetHandleSize(handle(curWriting)); 483 | b := 0; 484 | while (b < i) and (curWriting^^[b] <> char(13)) do 485 | b := b + 1; 486 | if curWriting^^[b] = char(13) then 487 | begin 488 | if (b < 80) then 489 | begin 490 | ts := ''; 491 | for c := 1 to (b) do 492 | ts := concat(ts, '.'); 493 | BlockMove(@curWriting^^[0], @ts[1], b); 494 | BlockMove(@curWriting^^[b + 1], @curWriting^^[0], i - (b + 1)); 495 | SetHandleSize(handle(curWriting), i - (b + 1)); 496 | takemsgTop := ts; 497 | end 498 | else 499 | takeMsgTop := ''; 500 | end 501 | else 502 | takemsgtop := ''; 503 | end; 504 | end; 505 | 506 | procedure AddLine (toAdd: str255); 507 | var 508 | i, b: longint; 509 | begin 510 | with curglobs^ do 511 | begin 512 | toAdd := concat(toAdd, char(13)); 513 | i := length(toAdd); 514 | b := getHandleSize(handle(curWriting)); 515 | SetHandleSize(handle(curWriting), b + i); 516 | BlockMove(@curWriting^^[0], @curWriting^^[i], b); 517 | BlockMove(@toAdd[1], pointer(curWriting^), i); 518 | end; 519 | end; 520 | 521 | function LoadSpecialText (myText: charsHandle; which: integer): boolean; 522 | var 523 | numChars, searchPos, i, searchPos2: integer; 524 | serialTemp, temp: str255; 525 | ck, ck2: longint; 526 | begin 527 | with curglobs^ do 528 | begin 529 | LoadSpecialText := false; 530 | if mytext <> nil then 531 | begin 532 | numChars := GetHandleSize(handle(myText)); 533 | if textHnd <> nil then 534 | begin 535 | HPurge(handle(texthnd)); 536 | DisposHandle(handle(textHnd)); 537 | end; 538 | textHnd := nil; 539 | CurTextPos := 0; 540 | OpenTextSize := 0; 541 | SysopStop := false; 542 | SearchPos := 0; 543 | i := 0; 544 | while (i <> which) and (SearchPos < numChars) do 545 | begin 546 | if (myText^^[SearchPos] = char(24)) then 547 | i := i + 1; 548 | SearchPos := SearchPos + 1; 549 | end; 550 | if (i = which) then 551 | begin 552 | while (myText^^[searchPos] <> char(13)) and (searchPos < numChars) do 553 | SearchPos := searchPos + 1; 554 | SearchPos := SearchPos + 1; 555 | SearchPos2 := SearchPos; 556 | while (MyText^^[searchPos2] <> char(24)) and (SearchPos2 < numChars) do 557 | begin 558 | SearchPos2 := SearchPos2 + 1; 559 | end; 560 | SearchPos2 := SearchPos2 - 1; 561 | SearchPos2 := SearchPos2 - SearchPos; 562 | TextHnd := Texthand(NewHandle(SearchPos2)); 563 | MoveHHi(handle(textHnd)); 564 | HNoPurge(handle(textHnd)); 565 | OpenTextSize := SearchPos2; 566 | curtextPos := 0; 567 | BlockMove(@myText^^[searchPos], @textHnd^^[0], SearchPos2); 568 | LoadSpecialText := true; 569 | end; 570 | end; 571 | end; 572 | end; 573 | 574 | procedure LoadHelpFile; 575 | var 576 | serialTemp, temp: str255; 577 | ck, ck2: longint; 578 | myTempStr: str255; 579 | sharedref, i, x: integer; 580 | myHUtils2: CharsHandle; 581 | LENGTH, cksm: longint; 582 | begin 583 | HelpFile := nil; 584 | UseResFile(TextRes); 585 | if not curGlobs^.thisUser.AlternateText then 586 | HelpFile := CharsHandle(GetNamedResource('HTxt', 'Help')) 587 | else 588 | HelpFile := CharsHandle(GetNamedResource('ATxt', 'Help')); 589 | if (ResError = noErr) and (HelpFile <> nil) then 590 | begin 591 | DetachResource(handle(HelpFile)); 592 | MoveHHi(handle(HelpFile)); 593 | HNoPurge(handle(HelpFile)); 594 | end; 595 | useResFile(myResourceFile); 596 | end; 597 | 598 | procedure LoadFileAsMsg (name: str255); 599 | var 600 | tempint: integer; 601 | templong: longint; 602 | begin 603 | with curglobs^ do 604 | begin 605 | if curWriting <> nil then 606 | begin 607 | HPurge(handle(curWriting)); 608 | DisposHandle(handle(curwriting)); 609 | end; 610 | curwriting := nil; 611 | result := FSOpen(name, 0, tempint); 612 | if (result <> 0) then 613 | begin 614 | name := concat(sharedPath, 'misc:', name); 615 | result := FSOpen(name, 0, tempint); 616 | end; 617 | if (result = 0) then 618 | begin 619 | result := GetEOF(tempint, templong); 620 | curWriting := TextHand(NewHandle(templong)); 621 | HNoPurge(handle(curWriting)); 622 | MoveHHi(handle(curWriting)); 623 | result := FSRead(tempint, templong, pointer(curWriting^)); 624 | result := FSClose(tempint); 625 | SetHandleSize(handle(curWriting), getHandleSize(handle(curWriting)) + 1); 626 | curWriting^^[getHandleSize(handle(curWriting)) - 1] := char(26); 627 | end; 628 | end; 629 | end; 630 | 631 | procedure HeReadIt (ReadMa: eMailRec); 632 | var 633 | tempEM: emailrec; 634 | tempInt: integer; 635 | begin 636 | GetDateTime(tempEM.dateSent); 637 | tempEM.title := ReadMa.Title; 638 | if not myUsers^^[readMa.touser - 1].dltd then 639 | begin 640 | tempEM.fromUser := ReadMa.toUser; 641 | tempEM.touser := ReadMa.fromUser; 642 | tempEM.anonyFrom := false; 643 | if readma.anonyFrom then 644 | tempEM.anonyFrom := true; 645 | tempEM.anonyTo := false; 646 | tempEM.MType := 0; 647 | tempEM.multimail := true; 648 | tempEM.storedAs := 0; 649 | tempEM.FileAttached := false; 650 | tempEM.FileName := char(0); 651 | for tempInt := 0 to 15 do 652 | tempEM.reserved[tempint] := char(0); 653 | SetHandleSize(handle(theEmail), GetHandleSize(handle(theEmail)) + SizeOf(emailRec)); 654 | BlockMove(@tempEm, @theEmail^^[availEmails], sizeof(emailrec)); 655 | availEmails := availEmails + 1; 656 | emailDirty := true; 657 | end; 658 | end; 659 | 660 | {$D-} 661 | 662 | procedure OpenBase (whichForum, whichSub: integer; extraRec: boolean); 663 | var 664 | s1, s2, tempString: str255; 665 | ref: integer; 666 | tempLong: longInt; 667 | s26: string[26]; 668 | s31: string[31]; 669 | begin 670 | with curglobs^ do 671 | begin 672 | CloseBase; 673 | s26 := MConference[whichForum]^^[whichSub].Name; 674 | s31 := MForum^^[whichForum].Name; 675 | tempString := concat(InitSystHand^^.msgsPath, s31, ':', s26, ' Data'); 676 | result := FSOpen(tempString, 0, ref); 677 | if result = noErr then 678 | begin 679 | result := GetEOF(ref, tempLong); 680 | if tempLong > 0 then 681 | begin 682 | if not extraRec then 683 | curBase := SubDyHand(NewHandle(tempLong)) 684 | else 685 | Curbase := SubDyHand(NewHandle(tempLong + SizeOf(mesgRec))); 686 | if MemError = noErr then 687 | begin 688 | HNoPurge(handle(curBase)); 689 | MoveHHi(handle(curBase)); 690 | curNumMess := tempLong div SizeOf(mesgRec); 691 | HLock(handle(curBase)); 692 | result := SetFPos(ref, fsFromStart, 0); 693 | result := FSRead(ref, tempLong, pointer(curBase^)); 694 | HUnlock(handle(curBase)); 695 | end 696 | else 697 | begin 698 | curNumMess := 0; 699 | end; 700 | end 701 | else 702 | curNumMess := 0; 703 | result := FSClose(ref); 704 | end 705 | else 706 | begin 707 | curNumMess := 0; 708 | if extraRec then 709 | Curbase := SubDyHand(NewHandle(SizeOf(mesgRec))) 710 | else 711 | curBase := nil; 712 | end; 713 | end; 714 | end; 715 | 716 | procedure SaveBase (wForum, wSub: integer); 717 | var 718 | s1, s2, tempstring: str255; 719 | ref: integer; 720 | templong: longint; 721 | s26: string[26]; 722 | s31: string[31]; 723 | begin 724 | with curglobs^ do 725 | begin 726 | s26 := MConference[wForum]^^[wSub].Name; 727 | s31 := MForum^^[wForum].Name; 728 | tempString := stringOf(InitSystHand^^.msgsPath, s31, ':', s26, ' Data'); 729 | result := FSDelete(tempString, 0); 730 | result := Create(tempstring, 0, 'HRMS', 'DATA'); 731 | result := FSOpen(tempstring, 0, ref); 732 | templong := getHandleSize(handle(curBase)); 733 | result := FSWrite(ref, templong, pointer(curBase^)); 734 | result := FSClose(ref); 735 | end; 736 | end; 737 | 738 | procedure dToTabbyDate (theDate: dateTimeRec; var dater: str255; var time: str255); 739 | var 740 | t1: str255; 741 | begin 742 | NumToString(theDate.month, t1); 743 | if length(t1) = 1 then 744 | t1 := concat('0', t1); 745 | dater := t1; 746 | NumToString(theDate.day, t1); 747 | if length(t1) = 1 then 748 | t1 := concat('0', t1); 749 | dater := concat(dater, '/', t1); 750 | if theDate.year >= 2000 then 751 | NumToString(theDate.year - 2000, t1) 752 | else 753 | NumToString(theDate.year - 1900, t1); 754 | if length(t1) = 1 then 755 | t1 := concat('0', t1); 756 | dater := concat(dater, '/', t1); 757 | NumToString(theDate.hour, t1); 758 | if length(t1) = 1 then 759 | t1 := concat('0', t1); 760 | time := t1; 761 | NumToString(theDate.minute, t1); 762 | if length(t1) = 1 then 763 | t1 := concat('0', t1); 764 | time := concat(time, ':', t1); 765 | NumToString(theDate.second, t1); 766 | if length(t1) = 1 then 767 | t1 := concat('0', t1); 768 | time := concat(time, ':', t1); 769 | end; 770 | 771 | function CheckColorCodes (Position: integer): integer; 772 | var 773 | Finish: integer; 774 | begin 775 | with curGlobs^ do 776 | begin 777 | Finish := Position; 778 | repeat 779 | Finish := Finish + 1; 780 | until curWriting^^[Finish] <> char(3); 781 | if (pos(curWriting^^[Finish], '0123456789') <> 0) and (pos(curWriting^^[Finish + 1], '0123456789') <> 0) then 782 | Finish := Finish + 4; 783 | 784 | CheckColorCodes := Finish; 785 | end; 786 | end; 787 | 788 | procedure CleanMessage; 789 | var 790 | tLen, posit, SPPos, Finish: integer; 791 | begin 792 | with curglobs^ do 793 | begin 794 | tLen := GetHandleSize(handle(curWriting)) - 1; 795 | posit := 0; 796 | if (tLen + 1) > 0 then 797 | begin 798 | while (posit <= tLen) do 799 | begin 800 | if curWriting^^[posit] = char(3) then 801 | begin 802 | Finish := CheckColorCodes(posit); 803 | BlockMove(@curWriting^^[Finish + 1], @curWriting^^[posit], tLen - (Finish + 1)); 804 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) - ((Finish + 1) - posit)); 805 | tLen := tLen - ((Finish + 1) - posit); 806 | posit := posit - 1; 807 | end 808 | else if (curWriting^^[posit] = char(8)) or (curWriting^^[posit] = char(11)) or (curWriting^^[posit] = char(9)) then 809 | begin 810 | BlockMove(@curWriting^^[posit + 1], @curWriting^^[posit], tLen - (posit + 1)); 811 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) - 1); 812 | tLen := tlen - 1; 813 | end 814 | else if (curWriting^^[posit] = char(13)) then 815 | begin 816 | if (posit - 1 > 0) then 817 | begin 818 | SPPos := posit; 819 | repeat 820 | SPPos := SPPos - 1; 821 | until (SPPos = 0) or (curWriting^^[SPPos] <> char(32)); 822 | if (posit - SPPos > 1) and (SPPos <> 0) then 823 | begin 824 | SPPos := SPPos + 1; 825 | BlockMove(@curWriting^^[posit], @curWriting^^[SPPos], tLen - posit); 826 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) - (posit - SPPos)); 827 | tLen := tLen - (posit - SPPos); 828 | posit := SPPos; 829 | end; 830 | end; 831 | end; 832 | posit := posit + 1; 833 | end; 834 | end; 835 | end; 836 | end; 837 | 838 | procedure DoAddToDailyTotal (NumIm, NumEx: integer); 839 | external; 840 | 841 | procedure SaveNetPost; 842 | var 843 | tempTabby: tabbyHeader; 844 | tempdstr, temptstr, s: str255; 845 | myRef, i, x: integer; 846 | templong: longint; 847 | nowDate: dateTimeRec; 848 | TabHeader: string[31]; 849 | holder: charsHandle; 850 | begin 851 | with curglobs^ do 852 | begin 853 | with tempTabby do 854 | begin 855 | holder := charsHandle(NewHandle(getHandleSize(handle(curWriting)))); 856 | HNoPurge(handle(holder)); 857 | BlockMove(pointer(curwriting^), pointer(holder^), GetHandleSize(handle(curWriting))); 858 | TabHeader := 'AEA N/A '; 859 | i := (inForum * 100) + inConf; 860 | NumToString(i, s); 861 | for i := 5 to length(s) + 5 do 862 | tabHeader[i] := s[i - 4]; 863 | TabHeader[4] := char(13); 864 | GetTime(nowDate); 865 | dToTabbyDate(nowDate, tempdstr, temptstr); 866 | if length(s) = 4 then 867 | tabHeader := concat(tabHeader, char(13), tempdStr, char(13), temptStr, char(13)) 868 | else 869 | begin 870 | tabHeader[8] := char(13); 871 | tabHeader := concat(tabHeader, tempdStr, char(13), temptStr, char(13)); 872 | end; 873 | CleanMessage; 874 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) + 1); 875 | CurWriting^^[getHandleSize(handle(curWriting)) - 1] := char(13); 876 | CurWriting^^[getHandleSize(handle(curWriting)) - 2] := char(0); 877 | s := curMesgRec.title; 878 | if s[1] = char(0) then 879 | delete(s, 1, 1); 880 | AddLine(s); 881 | if curMesgRec.toUserNum = 0 then 882 | AddLine('All') 883 | else 884 | AddLine(curMesgRec.toUserName); 885 | if newhand^^.realname and newhand^^.handle and MConference[inForum]^^[inConf].RealNames and (thisUser.realname <> '•') then 886 | AddLine(thisUser.realname) 887 | else 888 | AddLine(thisUser.userName); 889 | AddLine(''); 890 | s := concat(mailer^^.GenericPath, 'Generic Export'); 891 | result := FSOpen(s, 0, myRef); 892 | if result <> noErr then 893 | begin 894 | result := Create(s, 0, 'HRMS', 'TEXT'); 895 | result := FSOpen(s, 0, myRef); 896 | end; 897 | result := SetFPos(myRef, fsFromLEOF, 0); 898 | tempLong := length(tabHeader); 899 | result := FSWrite(myRef, tempLong, @tabHeader[1]); 900 | tempLong := GetHandleSize(handle(curWriting)); 901 | HLock(handle(curWriting)); 902 | result := FSWrite(myRef, templong, pointer(curWriting^)); 903 | HUnlock(handle(curWriting)); 904 | result := FSClose(myRef); 905 | DisposHandle(handle(curWriting)); 906 | curWriting := TextHand(holder); 907 | DoAddToDailyTotal(0, 1); 908 | end; 909 | end; 910 | end; 911 | 912 | procedure SaveNetMail (OtherName: str255); 913 | var 914 | tempTabby: tabbyHeader; 915 | tempdstr, temptstr, s: str255; 916 | myRef, i: integer; 917 | templong: longint; 918 | nowDate: dateTimeRec; 919 | TabHeader: string[31]; 920 | begin 921 | with curglobs^ do 922 | begin 923 | with tempTabby do 924 | begin 925 | TabHeader := 'AMA N/A '; 926 | TabHeader[4] := char(13); 927 | TabHeader[8] := char(13); 928 | GetTime(nowDate); 929 | dToTabbyDate(nowDate, tempdstr, temptstr); 930 | tabHeader := concat(tabHeader, tempdStr, char(13), temptStr, char(13)); 931 | CleanMessage; 932 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) + 1); 933 | CurWriting^^[getHandleSize(handle(curWriting)) - 1] := char(13); 934 | CurWriting^^[getHandleSize(handle(curWriting)) - 2] := char(0); 935 | if INetMail and (Mailer^^.InternetMail = FidoGated) then 936 | AddLine(concat('to: ', myFido.name)); 937 | AddLine(curEmailRec.title); 938 | if (INetMail) and (Mailer^^.InternetMail = FidoGated) then 939 | begin 940 | if FidoNetAccount(Mailer^^.FidoAddress) then 941 | ; 942 | end; 943 | AddLine(myFido.name); 944 | if OtherName <> char(0) then 945 | AddLine(OtherName) 946 | else 947 | begin 948 | if newHand^^.Handle and newHand^^.realName and Mailer^^.UseRealNames then 949 | AddLine(thisUser.RealName) 950 | else 951 | AddLine(thisUser.userName); 952 | end; 953 | 954 | AddLine(myFido.atNode); 955 | s := concat(mailer^^.GenericPath, 'Generic Export'); 956 | result := FSOpen(s, 0, myRef); 957 | if result <> noErr then 958 | begin 959 | result := Create(s, 0, 'HRMS', 'TEXT'); 960 | result := FSOpen(s, 0, myRef); 961 | end; 962 | result := SetFPos(myRef, fsFromLEOF, 0); 963 | tempLong := 26; 964 | result := FSWrite(myRef, tempLong, @tabHeader[1]); 965 | tempLong := GetHandleSize(handle(curWriting)); 966 | HLock(handle(curWriting)); 967 | result := FSWrite(myRef, templong, pointer(curWriting^)); 968 | HUnlock(handle(curWriting)); 969 | result := FSClose(myRef); 970 | DoAddToDailyTotal(0, 1); 971 | end; 972 | end; 973 | end; 974 | 975 | function SaveMessAsEmail: boolean; 976 | var 977 | s: str255; 978 | myRef, i: integer; 979 | templong: longint; 980 | begin 981 | with curglobs^ do 982 | begin 983 | curEmailrec.storedAs := SaveMessage(curWriting, 0, 0); 984 | if (curEmailRec.storedAs <> -1) then 985 | begin 986 | if curEmailRec.multimail then 987 | i := numMultiUsers 988 | else 989 | i := 1; 990 | SetHandleSize(handle(theEmail), GetHandleSize(handle(theEmail)) + (SizeOf(emailRec) * longint(i))); 991 | if not CurEmailRec.multiMail then 992 | BlockMove(@curEmailRec, @theEmail^^[availEmails], SizeOf(emailRec)) 993 | else 994 | begin 995 | for i := 1 to numMultiUsers do 996 | begin 997 | curEmailRec.toUser := multiUsers[i]; 998 | BlockMove(@curEmailRec, @theEmail^^[availEmails + (i - 1)], SizeOf(emailrec)); 999 | end; 1000 | i := numMultiusers; 1001 | end; 1002 | availEmails := availEmails + i; 1003 | emailDirty := true; 1004 | SaveEmailData; 1005 | emailDirty := false; 1006 | SaveMessAsEmail := true; 1007 | end 1008 | else 1009 | SaveMessAsEmail := false; 1010 | end; 1011 | end; 1012 | 1013 | 1014 | end. -------------------------------------------------------------------------------- /Source/Import.p: -------------------------------------------------------------------------------- 1 | { Segments: Import_1 } 2 | unit Import; 3 | 4 | interface 5 | uses 6 | AppleTalk, ADSP, Serial, Sound, TCPTypes, Initial, LoadAndSave, Message_Editor, NodePrefs2, NodePrefs, SystemPrefs2; 7 | 8 | procedure WriteNetLog (what: str255); 9 | procedure doDetermineZMH; 10 | procedure doCheckForGeneric; 11 | procedure doMailerImport; 12 | procedure DrawImportStatus (Increase: boolean; NumBytes: integer); 13 | procedure WriteNetUsageRecord; 14 | procedure DoAddToDailyTotal (NumIm, NumEx: integer); 15 | 16 | implementation 17 | type 18 | NetTotalRec = record 19 | Calls: integer; 20 | NumImported: longint; 21 | NumExported: longint; 22 | end; 23 | 24 | NetSubRec = record 25 | Forum: integer; 26 | Sub: integer; 27 | Category: integer; 28 | NumImported: integer; 29 | end; 30 | 31 | {$S Import_1 } 32 | procedure WriteNetLog (what: str255); 33 | var 34 | tempString: str255; 35 | LogRef, i, tempUserNum: integer; 36 | templong: longInt; 37 | result, myOSerr: OSerr; 38 | myUserHand: UserHand; 39 | begin 40 | tempString := concat(sharedPath, 'Misc:Network Today Log'); 41 | result := FSOpen(tempString, 0, LogRef); 42 | if result <> noErr then 43 | begin 44 | result := FSDelete(tempString, 0); 45 | result := Create(tempString, 0, 'HRMS', 'TEXT'); 46 | result := FSOpen(tempString, 0, LogRef); 47 | end; 48 | if result = noErr then 49 | begin 50 | what := concat(what, char(13)); 51 | result := SetFPos(LogRef, fsFromLEOF, 0); 52 | templong := length(what); 53 | result := FSWrite(LogRef, templong, @what[1]); 54 | end; 55 | result := FSClose(LogRef); 56 | end; 57 | 58 | procedure WriteNetLogTotals; 59 | var 60 | result: OSErr; 61 | templong, NumEntries, TotalImported: longint; 62 | TheFile, LowEntryFor, LowEntrySub, LowEntryPos, i: integer; 63 | NetEntry: NetSubRec; 64 | done: boolean; 65 | tempstring, tempString2: str255; 66 | s34: string[34]; 67 | begin 68 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Net'), 0, TheFile); 69 | if result <> noErr then 70 | Exit(WriteNetLogTotals); 71 | 72 | WriteNetLog('AREANAME FORUM CON CAT MSGS'); 73 | WriteNetLog('---------------------------------- ----- --- ---- ----'); 74 | result := GetEOF(TheFile, templong); 75 | NumEntries := templong div SizeOf(NetSubRec); 76 | templong := SizeOf(NetSubRec); 77 | done := false; 78 | while not done do 79 | begin 80 | LowEntryFor := 32766; 81 | LowEntrySub := 32766; 82 | LowEntryPos := 0; 83 | result := SetFPos(TheFile, fsFromStart, 0); 84 | for i := 1 to NumEntries do 85 | begin 86 | result := FSRead(TheFile, templong, @NetEntry); 87 | if (NetEntry.Forum < LowEntryFor) then 88 | LowEntryFor := NetEntry.Forum; 89 | end; 90 | 91 | result := SetFPos(TheFile, fsFromStart, 0); 92 | for i := 1 to NumEntries do 93 | begin 94 | result := FSRead(TheFile, templong, @NetEntry); 95 | if (NetEntry.Forum = LowEntryFor) and (NetEntry.Sub < LowEntrySub) then 96 | begin 97 | LowEntrySub := NetEntry.Sub; 98 | LowEntryPos := i - 1; 99 | end; 100 | end; 101 | 102 | if (LowEntrySub <> 32766) and (LowEntryFor <> 32766) then 103 | begin 104 | result := SetFPos(TheFile, fsFromStart, templong * LowEntryPos); 105 | result := FSRead(TheFile, templong, @NetEntry); 106 | if (NetEntry.Sub = 0) and (NetEntry.Forum = 0) then 107 | s34 := concat('Network Mail', ' ') 108 | else 109 | s34 := concat(MConference[NetEntry.Forum]^^[NetEntry.Sub].Name, ' '); 110 | tempstring := concat(s34, ' '); 111 | NumToString(NetEntry.Forum, tempstring2); 112 | if (length(tempString2) = 1) then 113 | tempString2 := concat('00', tempstring2) 114 | else if (length(tempstring2) = 2) then 115 | tempString2 := concat('0', tempString2); 116 | tempString := concat(tempString, ' ', tempString2); 117 | 118 | NumToString(NetEntry.Sub, tempstring2); 119 | if (length(tempString2) = 1) then 120 | tempString2 := concat('00', tempstring2) 121 | else if (length(tempstring2) = 2) then 122 | tempString2 := concat('0', tempString2); 123 | tempString := concat(tempString, ' ', tempString2); 124 | 125 | NumToString(NetEntry.Category, tempstring2); 126 | if (length(tempString2) = 1) then 127 | tempString2 := concat('000', tempstring2) 128 | else if (length(tempstring2) = 2) then 129 | tempString2 := concat('00', tempString2) 130 | else if (length(tempstring2) = 3) then 131 | tempString2 := concat('0', tempString2); 132 | tempString := concat(tempString, ' ', tempString2); 133 | 134 | NumToString(NetEntry.NumImported, tempstring2); 135 | for i := 4 downto length(tempstring2) do 136 | tempstring2 := concat(' ', tempstring2); 137 | tempstring := concat(tempstring, ' ', tempstring2); 138 | 139 | WriteNetLog(tempstring); 140 | 141 | NetEntry.Forum := 32766; 142 | NetEntry.Sub := 32766; 143 | result := SetFPos(TheFile, fsFromStart, templong * LowEntryPos); 144 | result := FSWrite(TheFile, templong, @NetEntry); 145 | end 146 | else 147 | done := true; 148 | end; 149 | result := FSClose(TheFile); 150 | end; 151 | 152 | procedure WriteToUsage (what: str255); 153 | var 154 | result: OSErr; 155 | templong, count, count2: longint; 156 | TheFile, TheFile2: integer; 157 | tempstring, tempstring2: str255; 158 | TheText: handle; 159 | begin 160 | result := FSOpen(concat(sharedPath, 'Misc:Network Usage Record'), 0, TheFile); 161 | if result <> noErr then 162 | begin 163 | result := Create(concat(sharedPath, 'Misc:Network Usage Record'), 0, 'HRMS', 'TEXT'); 164 | result := FSOpen(concat(sharedPath, 'Misc:Network Usage Record'), 0, TheFile); 165 | tempstring := concat('DATE DAY CALLS IMPORTED EXPORTED', char(13)); 166 | tempstring := concat(tempstring, '-------- --- ----- -------- --------', char(13)); 167 | templong := length(tempstring); 168 | result := FSWrite(TheFile, templong, @tempstring[1]); 169 | what := concat(what, char(13)); 170 | result := SetFPos(TheFile, fsFromLEOF, 0); 171 | templong := length(what); 172 | result := FSWrite(TheFile, templong, @what[1]); 173 | result := FSClose(TheFile); 174 | end 175 | else 176 | begin 177 | tempstring := concat('DATE DAY CALLS IMPORTED EXPORTED', char(13)); 178 | tempstring := concat(tempstring, '-------- --- ----- -------- --------', char(13)); 179 | tempstring2 := concat(tempstring, what, char(13)); 180 | templong := length(tempstring2); 181 | 182 | result := Create(concat(sharedPath, 'Misc:TNetwork Usage Record'), 0, 'HRMS', 'TEXT'); 183 | result := FSOpen(concat(sharedPath, 'Misc:TNetwork Usage Record'), 0, TheFile2); 184 | result := SetEOF(TheFile2, count); 185 | result := SetFPos(TheFile2, fsFromStart, 0); 186 | result := FSWrite(TheFile2, templong, @tempString2[1]); 187 | 188 | count := length(tempstring); 189 | result := GetEOF(TheFile, count2); 190 | count2 := count2 - count; 191 | result := SetFPos(TheFile, fsFromStart, count); 192 | TheText := NewHandle(count2); 193 | result := FSRead(TheFile, count2, pointer(TheText^)); 194 | result := FSClose(TheFile); 195 | result := FSDelete(concat(sharedPath, 'Misc:Network Usage Record'), 0); 196 | result := SetEOF(TheFile2, templong + count2); 197 | result := SetFPos(TheFile2, fsFromStart, templong); 198 | result := FSWrite(TheFile2, count2, pointer(TheText^)); 199 | DisposHandle(TheText); 200 | 201 | result := GetEOF(TheFile2, count2); 202 | count := 13549; 203 | if count2 > count then 204 | result := SetEOF(TheFile2, count); 205 | result := FSClose(TheFile2); 206 | result := Rename(concat(sharedPath, 'Misc:TNetwork Usage Record'), 0, concat(sharedPath, 'Misc:Network Usage Record')); 207 | end; 208 | end; 209 | 210 | procedure WriteNetUsageRecord; 211 | var 212 | result: OSErr; 213 | templong: longint; 214 | TheFile, i: integer; 215 | NetTotal: NetTotalRec; 216 | tempstring, tempstring2: str255; 217 | begin 218 | templong := SizeOf(NetTotalRec); 219 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, TheFile); 220 | result := FSRead(TheFile, templong, @NetTotal); 221 | result := FSClose(TheFile); 222 | NumToString(InitSystHand^^.lastmaint.month, tempString); 223 | if length(tempString) = 1 then 224 | tempString := concat('0', tempString); 225 | NumToString(InitSystHand^^.lastMaint.day, tempString2); 226 | if length(tempString2) = 1 then 227 | tempString2 := concat('0', tempString2); 228 | tempString := concat(tempString, '/', tempString2); 229 | NumToString(InitSystHand^^.lastMaint.year, tempString2); 230 | tempString2[1] := tempString2[3]; 231 | tempString2[2] := tempString2[4]; 232 | tempString2[0] := char(2); 233 | tempString := concat(tempString, '/', tempString2, ' '); 234 | whatDay(InitSystHand^^.lastmaint, tempString2); 235 | tempString2[0] := char(3); 236 | tempString := concat(tempString, tempString2, ' '); 237 | NumToString(NetTotal.Calls, tempstring2); 238 | for i := 5 downto length(tempstring2) do 239 | tempstring2 := concat(' ', tempstring2); 240 | tempstring := concat(tempstring, tempstring2, ' '); 241 | NumToString(NetTotal.NumImported, tempstring2); 242 | for i := 8 downto length(tempstring2) do 243 | tempstring2 := concat(' ', tempstring2); 244 | tempstring := concat(tempstring, tempstring2, ' '); 245 | NumToString(NetTotal.NumExported, tempstring2); 246 | for i := 8 downto length(tempstring2) do 247 | tempstring2 := concat(' ', tempstring2); 248 | tempstring := concat(tempstring, tempstring2); 249 | WriteToUsage(tempstring); 250 | 251 | result := FSDelete(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0); 252 | result := Create(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, 'HRMS', 'DATA'); 253 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, TheFile); 254 | NetTotal.Calls := 0; 255 | NetTotal.NumImported := 0; 256 | NetTotal.NumExported := 0; 257 | result := FSWrite(TheFile, templong, @NetTotal); 258 | result := FSClose(TheFile); 259 | end; 260 | 261 | procedure doDetermineZMH; 262 | var 263 | result: OSErr; 264 | tabRef: integer; 265 | templong, templong2: longint; 266 | nextTime: OSType; 267 | nextTimeFull: DateTimeRec; 268 | tempStr: str255; 269 | begin 270 | result := FSOpen(concat(Mailer^^.EventPath, 'Next Event'), 0, tabref); 271 | if result = noErr then 272 | begin 273 | templong := 4; 274 | result := FSRead(tabRef, templong, @nextTime); 275 | GetDateTime(templong); 276 | templong2 := templong; 277 | Secs2Date(templong2, nextTimeFull); 278 | tempStr := copy(nextTime, 1, 2); 279 | StringToNum(tempStr, templong2); 280 | nextTimeFull.hour := templong2; 281 | tempStr := copy(nextTime, 3, 2); 282 | StringToNum(tempStr, templong2); 283 | nextTimeFull.minute := templong2; 284 | Date2Secs(nextTimeFull, templong2); 285 | if templong2 < templong then 286 | templong2 := templong2 + 86400; 287 | dailyTabbyTime := templong2; 288 | result := FSClose(tabRef); 289 | with curglobs^ do 290 | begin 291 | end; 292 | end 293 | else 294 | dailyTabbyTime := 0; 295 | end; 296 | 297 | procedure DrawImportStatus (Increase: boolean; NumBytes: integer); 298 | var 299 | itemType, tempint, tempint2: integer; 300 | itemHandle: handle; 301 | tempRect: rect; 302 | s: str255; 303 | templong, templong2: longint; 304 | SavePort: GrafPtr; 305 | begin 306 | if ImportStatusDlg <> nil then 307 | begin 308 | GetPort(SavePort); 309 | SetPort(ImportStatusDlg); 310 | if increase then 311 | NumImported := NumImported + 1; 312 | GetDItem(ImportStatusDlg, 2, itemType, itemHandle, tempRect); 313 | NumToString(NumImported, s); 314 | SetIText(itemHandle, s); 315 | GetDItem(ImportStatusDlg, 7, itemType, itemHandle, tempRect); 316 | GetIText(itemHandle, s); 317 | StringToNum(s, templong); 318 | if NumBytes > 0 then 319 | begin 320 | templong := templong + NumBytes; 321 | if tempLong > GBytes then 322 | tempLong := GBytes; 323 | NumToString(templong, s); 324 | SetIText(itemHandle, s); 325 | end 326 | else if NumBytes = -1 then 327 | begin 328 | NumToString(GBytes, s); 329 | templong := GBytes; 330 | SetIText(itemHandle, s); 331 | end 332 | else if NumBytes = -99 then {Update} 333 | begin 334 | SetIText(itemHandle, s); 335 | SetTextBox(ImportStatusDlg, 1, 'Importing Message :'); 336 | NumToString(NumImported, s); 337 | SetTextBox(ImportStatusDlg, 2, s); 338 | SetTextBox(ImportStatusDlg, 4, 'Bytes processed :'); 339 | NumToString(GBytes, s); 340 | SetTextBox(ImportStatusDlg, 5, s); 341 | SetTextBox(ImportStatusDlg, 6, 'File size :'); 342 | if ImportLoopTime = 0 then 343 | s := 'Very Fast' 344 | else if ImportLoopTime = 8 then 345 | s := 'Fast' 346 | else if ImportLoopTime = 20 then 347 | s := 'Slow' 348 | else if ImportLoopTime = 40 then 349 | s := 'Very Slow'; 350 | SetTextBox(ImportStatusDlg, 8, concat('Import Speed: ', s)); 351 | GetDItem(ImportStatusDlg, 3, itemType, itemHandle, tempRect); 352 | ForeColor(blackColor); 353 | EraseRect(tempRect); 354 | FrameRect(tempRect); 355 | ForeColor(GreenColor); 356 | tempInt := ((tempRect.right - tempRect.left) * templong) div GBytes; 357 | if tempInt > (tempRect.right - tempRect.left) then 358 | tempint := (tempRect.right - tempRect.left); 359 | tempRect.right := tempRect.left + tempInt; 360 | if tempRect.right > temprect.left then 361 | begin 362 | InsetRect(tempRect, 1, 1); 363 | PaintRect(tempRect); 364 | end; 365 | ForeColor(blackColor); 366 | 367 | templong := -99; 368 | end; 369 | 370 | if templong > 0 then 371 | begin 372 | if ImportLoopTime = 0 then 373 | s := 'Very Fast' 374 | else if ImportLoopTime = 8 then 375 | s := 'Fast' 376 | else if ImportLoopTime = 20 then 377 | s := 'Slow' 378 | else if ImportLoopTime = 40 then 379 | s := 'Very Slow'; 380 | SetTextBox(ImportStatusDlg, 8, concat('Import Speed: ', s)); 381 | GetDItem(ImportStatusDlg, 3, itemType, itemHandle, tempRect); 382 | ForeColor(BlackColor); 383 | FrameRect(tempRect); 384 | ForeColor(GreenColor); 385 | tempInt := ((tempRect.right - tempRect.left) * templong) div GBytes; 386 | if tempInt > (tempRect.right - tempRect.left) then 387 | tempint := (tempRect.right - tempRect.left); 388 | tempRect.right := tempRect.left + tempInt; 389 | if tempRect.right > temprect.left then 390 | begin 391 | InsetRect(tempRect, 1, 1); 392 | PaintRect(tempRect); 393 | end; 394 | ForeColor(blackColor); 395 | end; 396 | SetPort(SavePort); 397 | end; 398 | end; 399 | 400 | function doCompareFileSize (theRef: integer): boolean; 401 | var 402 | result: OSErr; 403 | tempBytes: longint; 404 | begin 405 | result := GetEOF(theRef, tempBytes); 406 | if GBytes = tempBytes then 407 | doCompareFileSize := true 408 | else 409 | begin 410 | GBytes := tempBytes; 411 | doCompareFileSize := false; 412 | end; 413 | end; 414 | 415 | procedure doCheckForGeneric; 416 | var 417 | result: OSErr; 418 | i: integer; 419 | templong: longint; 420 | tempString: str255; 421 | begin 422 | lastGenericCheck := tickcount; 423 | result := FSOpen(concat(mailer^^.GenericPath, 'Generic Import'), 0, i); 424 | if result = noErr then 425 | begin 426 | if doCompareFileSize(i) then 427 | begin 428 | ImportRef := i; 429 | GenericImport := charsHandle(NewHandle(HANDLE_SIZE)); 430 | if memError = noErr then 431 | begin 432 | HLock(handle(GenericImport)); 433 | result := GetEOF(ImportRef, FileSize); 434 | if FileSize > 20 then 435 | begin 436 | PlaceInFile := 0; 437 | DataLeft := 0; 438 | NumImported := 0; 439 | BreakMessage := NoBreak; 440 | isGeneric := true; 441 | if Mailer^^.ImportSpeed = 1 then 442 | ImportLoopTime := 0 443 | else if Mailer^^.ImportSpeed = 2 then 444 | ImportLoopTime := 8 445 | else if Mailer^^.ImportSpeed = 3 then 446 | ImportLoopTime := 20 447 | else 448 | ImportLoopTime := 40; 449 | HandleEmpty := true; 450 | result := FSClose(ImportRef); 451 | result := FSDelete(concat(Mailer^^.GenericPath, 'Working GenImport'), 0); 452 | result := Rename(concat(Mailer^^.GenericPath, 'Generic Import'), 0, concat(mailer^^.GenericPath, 'Working GenImport')); 453 | result := FSDelete(concat(Mailer^^.GenericPath, 'Old GenImport'), 0); 454 | result := FSOpen(concat(Mailer^^.GenericPath, 'Working GenImport'), 0, ImportRef); 455 | result := FSOpen(concat(sharedPath, 'Logs:Network:Any File'), 0, i); 456 | if result = -120 then 457 | result := DirCreate(0, 0, concat(sharedPath, 'Logs:Network'), templong); 458 | result := FSClose(i); 459 | WriteNetLog(concat('Import started at : ', whattime(-1))); 460 | result := FSDelete(concat(sharedPath, 'Logs:Network:Temp Net'), 0); 461 | result := Create(concat(sharedPath, 'Logs:Network:Temp Net'), 0, 'HRMS', 'DATA'); 462 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Net'), 0, NetRef); 463 | NumNets := 0; 464 | ImportStatusDlg := GetNewDialog(200, nil, pointer(-1)); 465 | SetPort(ImportStatusDlg); 466 | SetGeneva(ImportStatusDlg); 467 | NumToString(GBytes, tempstring); 468 | SetTextBox(ImportStatusDlg, 5, tempstring); 469 | DrawDialog(ImportStatusDlg); 470 | DrawImportStatus(false, -99); 471 | end 472 | else 473 | begin 474 | HUnlock(handle(GenericImport)); 475 | DisposHandle(handle(GenericImport)); 476 | GenericImport := nil; 477 | result := FSClose(ImportRef); 478 | end; 479 | end 480 | else 481 | begin 482 | DisposHandle(handle(GenericImport)); 483 | GenericImport := nil; 484 | result := FSClose(ImportRef); 485 | WriteNetLog('** Unable to create Handle Generic Import **'); 486 | end; 487 | end 488 | else 489 | result := FSClose(i); 490 | end; 491 | end; 492 | 493 | procedure AddToNetRef (F, S, C: integer); 494 | var 495 | NetData, NetEntry: NetSubRec; 496 | i: integer; 497 | result: OSErr; 498 | templong: longint; 499 | begin 500 | NetData.Forum := F; 501 | NetData.Sub := S; 502 | NetData.Category := C; 503 | i := 0; 504 | result := SetFPos(NetRef, fsFromStart, 0); 505 | tempLong := SizeOf(NetSubRec); 506 | for i := 1 to NumNets do 507 | begin 508 | result := FSRead(NetRef, templong, @NetEntry); 509 | if (NetEntry.Forum = NetData.Forum) and (NetEntry.Sub = NetData.Sub) then 510 | begin 511 | NetEntry.NumImported := NetEntry.NumImported + 1; 512 | result := SetFPos(NetRef, fsFromStart, templong * (i - 1)); 513 | result := FSWrite(NetRef, templong, @NetEntry); 514 | Exit(AddToNetRef); 515 | end; 516 | end; 517 | NetData.NumImported := 1; 518 | result := SetFPos(NetRef, fsFromLEOF, 0); 519 | result := FSWrite(NetRef, templong, @NetData); 520 | NumNets := NumNets + 1; 521 | end; 522 | 523 | procedure DoAddToDailyTotal (NumIm, NumEx: integer); 524 | var 525 | result: OSErr; 526 | templong: longint; 527 | TheFile: integer; 528 | NetRec: NetTotalRec; 529 | begin 530 | templong := SizeOf(NetTotalRec); 531 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, TheFile); 532 | if result <> noErr then 533 | begin 534 | result := Create(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, 'HRMS', 'DATA'); 535 | result := FSOpen(concat(sharedPath, 'Logs:Network:Temp Usage Net'), 0, TheFile); 536 | NetRec.Calls := 1; 537 | NetRec.NumImported := NumIm; 538 | NetRec.NumExported := NumEx; 539 | end 540 | else 541 | begin 542 | result := FSRead(TheFile, templong, @NetRec); 543 | NetRec.Calls := NetRec.Calls + 1; 544 | NetRec.NumImported := NetRec.NumImported + NumIm; 545 | NetRec.NumExported := NetRec.NumExported + NumEx; 546 | result := SetFPos(TheFile, fsFromStart, 0); 547 | end; 548 | result := FSWrite(TheFile, templong, @NetRec); 549 | result := FSClose(TheFile); 550 | end; 551 | 552 | procedure doMailerImport; 553 | var 554 | i, dm, theFile, savedinForum, savedinSub: integer; 555 | tempStr, fromStr, toStr, t9, s: str255; 556 | templong, Category: longint; 557 | tempEMailRec: EMailRec; 558 | tempMessRec: MesgRec; 559 | begin 560 | with curGlobs^ do 561 | begin 562 | case MailerDo of 563 | MailerOne: (* Read Data Into GenericImport *) 564 | begin 565 | if HandleEmpty then 566 | begin 567 | NextRead := HANDLE_SIZE - dataLeft; 568 | if NextRead + PlaceInFile > FileSize then 569 | NextRead := FileSize - PlaceInFile; 570 | result := FSRead(ImportRef, NextRead, @GenericImport^^[DataLeft]); 571 | DataLeft := NextRead + DataLeft; 572 | PlaceInFile := PlaceInFile + NextRead; 573 | HandleEmpty := false; 574 | end; 575 | MailerDo := MailerTwo; 576 | end; 577 | MailerTwo: 578 | begin 579 | for i := 0 to DataLeft do 580 | if GenericImport^^[i] = char(0) then {End of Message} 581 | leave; 582 | 583 | curPlace := i + 1; 584 | if (curPlace >= 25000) and (PlaceInFile <= FileSize) and (GenericImport^^[25000] <> char(0)) then 585 | begin 586 | if (BreakMessage = NoBreak) then 587 | begin 588 | BreakMessage := FirstPass; 589 | BreakNumber := 1; 590 | end; 591 | i := 25000; 592 | if (GenericImport^^[i] <> char(13)) then 593 | for i := 25000 downto 24500 do 594 | if GenericImport^^[i] = char(13) then 595 | leave; 596 | curPlace := i; 597 | 598 | MailerDo := MailerThree; 599 | end 600 | else if (GenericImport^^[curPlace - 1] = char(0)) then 601 | begin 602 | if (BreakMessage <> NoBreak) then 603 | BreakMessage := LastPass; 604 | MailerDo := MailerThree; 605 | end 606 | else 607 | begin 608 | HandleEmpty := true; 609 | if (PlaceInFile >= FileSize) then 610 | MailerDo := MailerFive 611 | else 612 | MailerDo := MailerOne; 613 | end; 614 | end; 615 | MailerThree: 616 | begin 617 | if (BreakMessage = FirstPass) or (BreakMessage = NoBreak) then 618 | begin 619 | if GenericImport^^[1] = 'M' then 620 | if GenericImport^^[7] = char(13) then {Support for Aeouls using 000 instead of 0} 621 | i := 27 622 | else 623 | i := 24 624 | else if GenericImport^^[7] = char(13) then 625 | i := 26 626 | else 627 | i := 27; 628 | BlockMove(@GenericImport^^[0], @MessHeader[1], i); 629 | end 630 | else 631 | i := 0; 632 | 633 | MessageLen := curPlace - i; 634 | curWriting := TextHand(newHandle(MessageLen + 10)); 635 | BlockMove(@GenericImport^^[i], pointer(curWriting^), MessageLen); 636 | s := concat('--------------------------------- CUT HERE ---------------------------------', char(13)); 637 | templong := length(s); 638 | if (BreakMessage = FirstPass) or (BreakMessage = OtherPass) then 639 | begin 640 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) + templong); 641 | curWriting^^[MessageLen] := char(13); 642 | curWriting^^[MessageLen + 1] := char(13); 643 | MessageLen := MessageLen + 1; 644 | for i := 1 to templong do 645 | curWriting^^[MessageLen + i] := s[i]; 646 | MessageLen := MessageLen + tempLong + 1; 647 | end; 648 | if (BreakMessage = LastPass) or (BreakMessage = OtherPass) then 649 | begin 650 | SetHandleSize(handle(curWriting), GetHandleSize(handle(curWriting)) + (templong)); 651 | BlockMove(@curWriting^^[0], @curWriting^^[tempLong + 1], MessageLen); 652 | for i := 1 to tempLong do 653 | curWriting^^[i - 1] := s[i]; 654 | curWriting^^[templong] := char(13); 655 | MessageLen := MessageLen + tempLong + 1; 656 | end; 657 | if (BreakMessage = FirstPass) or (BreakMessage = OtherPass) then 658 | curWriting^^[MessageLen] := char(0); 659 | 660 | realLen := 0; 661 | dm := 0; 662 | for i := 0 to MessageLen do 663 | begin 664 | if (curWriting^^[i] = char(0)) then (* Is it the end of the message? *) 665 | begin 666 | realLen := i; (* Actual num of chars till char(0) *) 667 | i := MessageLen; (* to break out of while do loop *) 668 | end 669 | else (* If not the end of the message then *) 670 | begin 671 | if (curWriting^^[i] = char(1)) then (* Removing Control A's *) 672 | begin 673 | dm := i; 674 | repeat 675 | dm := dm + 1; 676 | until (curWriting^^[dm] = char(13)) or (curWriting^^[dm] = char(0)); 677 | BlockMove(@curWriting^^[dm + 1], @curWriting^^[i], MessageLen - (dm + 1)); 678 | i := i - 1; 679 | dm := 0; 680 | end; 681 | if (curWriting^^[i] <> char(13)) then (* Proper Line Length *) 682 | dm := dm + 1 683 | else 684 | dm := 0; 685 | if (dm = 80) then (* End of Line, go back and find space to word wrap *) 686 | begin 687 | for dm := 80 downto 40 do 688 | if (curWriting^^[i] = ' ') then 689 | begin 690 | curWriting^^[i] := char(13); 691 | leave; 692 | end 693 | else 694 | i := i - 1; 695 | dm := 0; 696 | end; 697 | end; 698 | end; 699 | MailerDo := MailerFour; 700 | end; 701 | MailerFour: 702 | begin 703 | curWriting^^[realLen] := char(26); (* Making Last char be Hermes end of message char *) 704 | SetHandleSize(handle(curWriting), realLen + 1); 705 | tempEMailRec := curEMailRec; 706 | tempMessRec := curMesgRec; 707 | savedinForum := inForum; 708 | savedinSub := inConf; 709 | 710 | (* Now figure out what type of message we imported M is EMail & E is Post *) 711 | if (MessHeader[2] = 'M') and (MessHeader[1] <> 'D') then 712 | begin 713 | if (BreakMessage = NoBreak) or (BreakMessage = FirstPass) then 714 | begin 715 | tempStr := TakeMsgTop; {Fido Address} 716 | fromStr := TakeMsgTop; {From Name} 717 | fromStr := concat(fromStr, ', ', tempStr); 718 | toStr := TakeMsgTop; {To Name} 719 | tempStr := takeMsgTop; {Title} 720 | if (tempstr = char(0)) or (tempstr = ' ') or (tempStr[1] = char(0)) then 721 | tempstr := ''; 722 | curEmailRec.title := tempStr; 723 | if curWriting^^[0] = char(1) then 724 | t9 := takeMsgTop; {Remove the offending characater} 725 | 726 | curEmailRec.FileAttached := false; 727 | curEmailRec.FileName := char(0); 728 | curEmailRec.anonyFrom := false; 729 | curEmailRec.anonyTo := false; 730 | curEmailRec.fromUser := TABBYTOID; 731 | if newHand^^.Handle and newHand^^.realName then 732 | s := '%' 733 | else 734 | s := ''; 735 | if FindUser(concat(s, toStr), tempUser) then 736 | curEmailRec.toUser := tempuser.userNum 737 | else 738 | begin 739 | curEmailRec.toUser := 1; 740 | if FindUser('1', tempUser) then 741 | ; 742 | end; 743 | 744 | ForwardedToNet := false; 745 | if tempUser.MailBox then 746 | begin 747 | if (pos(',', tempUser.ForwardedTo) = 0) and (pos('@', tempUser.ForwardedTo) = 0) then {Not to Net Address} 748 | begin 749 | StringToNum(tempUser.ForwardedTo, tempLong); 750 | curEMailRec.toUser := tempLong; 751 | end 752 | else 753 | begin 754 | ForwardedToNet := true; 755 | BreakToName := tempUser.ForwardedTo; 756 | end; 757 | end; 758 | 759 | GetDateTime(curEmailRec.dateSent); 760 | curEmailRec.MType := 1; 761 | curEmailRec.multiMail := false; 762 | for i := 0 to 15 do 763 | curMesgRec.reserved[i] := char(0); 764 | 765 | if BreakMessage = FirstPass then 766 | begin 767 | BreakMessage := OtherPass; 768 | BreakTitle := curEmailRec.title; 769 | curEmailRec.title := concat('[1] ', curEmailRec.title); 770 | BreakFrom := fromStr; 771 | BreakToNum := curEMailRec.toUser; 772 | end; 773 | end 774 | else 775 | begin 776 | BreakNumber := BreakNumber + 1; 777 | curEMailRec.title := StringOf('[', BreakNumber : 0, '] ', BreakTitle); 778 | curEMailRec.toUser := BreakToNum; 779 | curEmailRec.FileAttached := false; 780 | curEmailRec.FileName := char(0); 781 | curEmailRec.anonyFrom := false; 782 | curEmailRec.anonyTo := false; 783 | curEmailRec.fromUser := TABBYTOID; 784 | GetDateTime(curEmailRec.dateSent); 785 | curEmailRec.MType := 1; 786 | curEmailRec.multiMail := false; 787 | fromStr := BreakFrom; 788 | for i := 0 to 15 do 789 | curMesgRec.reserved[i] := char(0); 790 | end; 791 | 792 | AddLine(''); 793 | AddLine(fromStr); 794 | if ForwardedToNet then 795 | begin 796 | if FidoNetAccount(BreakToName) then 797 | begin 798 | NetMail := true; 799 | INetMail := false; 800 | tempStr := takeMsgTop; 801 | SaveNetMail(tempStr); 802 | DrawImportStatus(true, realLen); 803 | end 804 | else if InternetAccount(BreakToName) then 805 | begin 806 | NetMail := false; 807 | INetMail := true; 808 | tempStr := takeMsgTop; 809 | SaveNetMail(tempStr); 810 | DrawImportStatus(true, realLen); 811 | end 812 | else 813 | begin 814 | if SaveMessAsEmail then 815 | DrawImportStatus(true, realLen) 816 | else 817 | WriteNetLog('IMPORT ERROR: EMAIL DATABASE IS FULL'); 818 | end; 819 | end 820 | else 821 | begin 822 | if SaveMessAsEmail then 823 | DrawImportStatus(true, realLen) 824 | else 825 | WriteNetLog('IMPORT ERROR: EMAIL DATABASE IS FULL'); 826 | end; 827 | AddToNetRef(0, 0, 0); 828 | end 829 | else if (MessHeader[2] = 'E') and (MessHeader[1] <> 'D') then 830 | begin 831 | if (BreakMessage = NoBreak) or (BreakMessage = FirstPass) then 832 | begin 833 | if MessHeader[8] = char(13) then 834 | tempStr := copy(MessHeader, 5, 3) 835 | else 836 | tempStr := copy(MessHeader, 5, 4); 837 | StringToNum(tempStr, Category); 838 | inForum := Category div 100; 839 | inConf := (Category - (inforum * 100)); 840 | tempStr := takeMsgTop; 841 | fromStr := TakeMsgTop; 842 | if length(tempStr) > 0 then 843 | fromStr := concat(fromStr, ', ', tempStr); 844 | toStr := TakeMsgTop; 845 | if curWriting^^[0] = char(1) then 846 | t9 := takeMsgTop; 847 | tempStr := takeMsgTop; 848 | if (tempstr = char(0)) or (tempstr = ' ') or (tempStr[1] = char(0)) then 849 | tempstr := ''; 850 | if curWriting^^[0] = char(1) then 851 | t9 := takeMsgTop; 852 | if curWriting^^[0] = char(1) then 853 | t9 := takeMsgTop; 854 | 855 | curMesgRec.title := tempStr; 856 | if (pos('RE: ', tempStr) = 1) or (pos('Re: ', tempStr) = 1) then 857 | curMesgRec.title := concat(char(0), curMesgRec.title); 858 | curMesgRec.AnonyFrom := false; 859 | curMesgRec.anonyTo := false; 860 | curMesgRec.fromUserNum := TABBYTOID; 861 | curMesgRec.fromUserName := fromStr; 862 | if newHand^^.Handle and newHand^^.realName then 863 | s := '%' 864 | else 865 | s := ''; 866 | if FindUser(concat(s, toStr), editingUser) then 867 | curMesgRec.toUserNum := editingUser.userNum 868 | else 869 | curMesgRec.toUserNum := TABBYTOID; 870 | curMesgRec.touserName := toStr; 871 | curMesgRec.deletable := true; 872 | curMesgRec.FileAttached := false; 873 | curMesgRec.FileName := char(0); 874 | GetDateTime(curMesgRec.DateEn); 875 | for i := 0 to 20 do 876 | curMesgRec.reserved[i] := char(0); 877 | 878 | if MessHeader[8] = char(13) then {Date} 879 | tempStr := copy(MessHeader, 9, 17) 880 | else 881 | tempStr := copy(MessHeader, 10, 17); 882 | tempStr[9] := ' '; 883 | 884 | if (BreakMessage = FirstPass) then 885 | begin 886 | BreakMessage := OtherPass; 887 | if (curMesgRec.title[1] = char(0)) then 888 | Delete(curMesgRec.title, 1, 1); 889 | BreakTitle := curMesgRec.title; 890 | curMesgRec.title := concat('[1] ', curMesgRec.title); 891 | BreakInForum := inForum; 892 | BreakInConf := inConf; 893 | BreakFrom := curMesgRec.fromUserName; 894 | BreakToNum := curMesgRec.toUserNum; 895 | BreakToName := curMesgRec.toUserName; 896 | BreakDate := tempStr; 897 | end; 898 | end 899 | else 900 | begin 901 | BreakNumber := BreakNumber + 1; 902 | curMesgRec.title := StringOf('[', BreakNumber : 0, '] ', BreakTitle); 903 | curMesgRec.toUserNum := BreakToNum; 904 | curMesgRec.toUserName := BreakToName; 905 | curMesgRec.fromUserName := BreakFrom; 906 | curMesgRec.AnonyFrom := false; 907 | curMesgRec.anonyTo := false; 908 | curMesgRec.fromUserNum := TABBYTOID; 909 | curMesgRec.deletable := true; 910 | curMesgRec.FileAttached := false; 911 | curMesgRec.FileName := char(0); 912 | GetDateTime(curMesgRec.DateEn); 913 | for i := 0 to 20 do 914 | curMesgRec.reserved[i] := char(0); 915 | tempStr := BreakDate; 916 | inForum := BreakInForum; 917 | inConf := BreakInConf; 918 | end; 919 | 920 | if (inForum <= InitSystHand^^.numMForums) and (inConf <= MForum^^[inForum].NumConferences) then 921 | begin 922 | AddLine(''); 923 | AddLine(tempStr); 924 | if SavePost(inforum, inConf) then 925 | DrawImportStatus(true, realLen) 926 | else 927 | WriteNetLog(StringOf('IMPORT ERROR: FORUM ', inForum : 0, ', CONF ', inConf : 0, ' MESSAGE TOO LARGE.')); 928 | AddToNetRef(inForum, inConf, Category); 929 | OpenBase(inForum, inConf, false); 930 | if curNumMess > MConference[inForum]^^[inConf].MaxMessages then 931 | begin 932 | dm := 0; 933 | i := 1; 934 | while (dm = 0) and (i <= curNumMess) do 935 | begin 936 | if curBase^^[i - 1].deletable then 937 | dm := i; 938 | i := i + 1; 939 | end; 940 | if dm = 0 then 941 | dm := 1; 942 | CloseBase; 943 | DeletePost(inForum, inConf, dm, true); 944 | end; 945 | end; 946 | end; 947 | 948 | HUnlock(handle(curWriting)); 949 | HPurge(handle(curWriting)); 950 | DisposHandle(handle(curWriting)); 951 | curWriting := nil; 952 | 953 | if (BreakMessage = LastPass) then 954 | BreakMessage := NoBreak; 955 | if (BreakMessage = NoBreak) then 956 | curPlace := curPlace + 1; 957 | if dataLeft - curPlace > 0 then (* Move the block the size of the last import *) 958 | BlockMove(@GenericImport^^[curPlace], @GenericImport^^[0], dataLeft - curPlace); 959 | dataLeft := dataLeft - curPlace; (* Subtract from what was read in the size of the message imported *) 960 | 961 | SavedImport := true; 962 | curEMailRec := tempEMailRec; 963 | curMesgRec := tempMessRec; 964 | inForum := savedinForum; 965 | inConf := savedinSub; 966 | end; 967 | MailerFive: 968 | begin 969 | DrawImportStatus(false, -1); 970 | HPurge(handle(GenericImport)); 971 | HUnlock(Handle(GenericImport)); 972 | DisposHandle(handle(GenericImport)); 973 | result := FSClose(ImportRef); 974 | result := Rename(concat(Mailer^^.GenericPath, 'Working GenImport'), 0, concat(Mailer^^.GenericPath, 'Old GenImport')); 975 | result := FSClose(NetRef); 976 | NumToString(numImported, tempStr); 977 | WriteNetLog(concat('Imported ', tempStr, ' network messages.')); 978 | WriteNetLog('Imported message breakdown:'); 979 | WriteNetLog(' '); 980 | WriteNetLogTotals; 981 | DoAddToDailyTotal(numImported, 0); 982 | WriteNetLog(' '); 983 | result := FSOpen(concat(mailer^^.GenericPath, 'Old GenImport'), 0, i); 984 | result := GetEOF(i, templong); 985 | result := FSClose(i); 986 | NumToString(templong, tempStr); 987 | WriteNetLog(concat('Import file size : ', tempStr, ' bytes.')); 988 | WriteNetLog(concat('Import ended at : ', whattime(-1))); 989 | WriteNetLog(' '); 990 | doSystRec(true); 991 | isGeneric := false; 992 | savedImport := true; 993 | lastGenericCheck := tickCount + 3600; 994 | GBytes := 0; 995 | DisposDialog(ImportStatusDlg); 996 | ImportStatusDlg := nil; 997 | end; 998 | otherwise 999 | ; 1000 | end; 1001 | end; 1002 | end; 1003 | 1004 | 1005 | end. --------------------------------------------------------------------------------