home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-09-07 | 48.1 KB | 1,439 lines | [TEXT/PJMM] |
- program TImport (input, output);
-
- { Written by Pete Johnson for the Glassell Park BBS }
-
- { Version 2.0.3 (remember to adjust the VERSION constant) }
-
- { Date of last revision: 09/7/91 }
-
- { Change History }
-
- { 06/02/89 Changed UserPointer array from 2000 to 3000 elements }
- { 06/06/89 Changed UserPointer array to UserHandle }
- { 06/06/89 Sorting UserLog for better search speed }
- { 06/07/89 Checking 'Mail Waiting' flag in UserLog to save time }
- { 06/07/89 Cleaned up cap/decap routines }
- { 06/08/89 Cleaned up WriteLine routine and went to Toolbox file calls }
- { 06/11/89 Added more Toolbox file calls }
- { 06/12/89 All file calls now use Toolbox. }
- { Empty message lines padded with two space characters. }
- { 06/15/89 Compiled with new Hello Tabby Unit which recognizes 'BBS' }
- { alias. }
- { 06/17/89 Redefined Status and Section as arrays of Byte }
- { 06/18/89 Fixed bug mixing up Config & UserLog paths }
- { 06/25/89 Fixed bug with seek to set mail flag (wrote garbage to }
- { UserLog) }
- { 06/28/89 Added buffer for reading Import file }
- { 07/02/89 Fixed AreaFix problem }
- { 07/23/89 Strengthened error checking to handle garbage in Generic }
- { Import file (Version 1.332) }
- { 10/28/89 Reduced memory demands in default settings }
- { 11/8/89 Improved error detection & recovery for Generic Import file }
- { (version 1.5b2) }
- { 11/17/89 Added WaitNextEvent calls to improve MultiFinder }
- { compatibility (version 1.5b3) }
- { 11/18/89 Expanded error reporting into intelligible messages }
- { 11/19/89 Compiled version 1.5 }
- { 11/29/89 Added Point ^A compatibility with version 1.6 }
- { 01/30/90 Added "Tabby Log" switch to aid compatibility with E. Selberg }
- { pgms & boosted text read buffer from 16K to 32K (v. 1.7). }
- { 02/19/90 Fixed problem with not closing Config file (v. 1.8) . }
- { 02/27/90 Fixed bug with routing to AreaFix. }
- { 05/04/90 Added ability to spot ff-processed [^p] messages and send }
- { them to local private. STR 499 holds ff private flag }
- { 07/02/90 Version 1.91 fixes bug which sent messages with missing }
- { missing Subject: or To: line to local private. }
- { 07/16/90 Version 1.92 fixes bug which clipped point number from }
- { message addresses. }
- { 07/16/90 Version 1.93 no longer sets "processed by Tabby" flag }
- { which was messing up ff. }
- { 10/28/90 Version 1.94 checks dates of messages for validity, adjusts }
- { date and time to current date and time if fields are not valid. }
- { 01/08/91 Version 1.95 adds TEXT type option field and Version }
- { info in running dialog. }
- { 02/09/91 Version 1.96 breaks long Generic Import lines to user-set }
- { length. Also handles capitalization for McNames correctly. }
- { Eliminated AreaFix trapdoor since AreaTrix works differently }
- { (pre-processes). }
- { 05/26/91 V 1.97 added SIZE resource and WaitNextEvents. }
- { 06/25/91 V 1.98 added option to count imports to sections. }
- { 06/27/91 V 2.0 cleaned up Tabby Log report, added color icons. }
- { 07/05/91 V 2.0.1 fixed garbage in UNKNOWN message section name. }
- { 07/05/91 V 2.0.2 various small fixes including adding Find button to }
- { Config dialog. }
- { 09/07/91 V 2.0.3 increments mail byte for SS 2.0b11. }
-
- { This program imports messages to Second Sight using the Generic Tabby }
- { Message Format. }
-
- uses
- Globals, HelloTabby, FileUtils, ImpHostFile;
-
- const
- Dashes = '---------------------------------------------------------------------';
- MAXUSERS = 3000;
- VERSION = '2.0.3';
-
- type
- TimeRec = packed array[1..3] of char;
- DayandHour = packed array[1..6] of char;
- UserName = record
- Index: integer;
- Name: string[32];
- MailCount: byte;
- end;
- UserPointer = ^UserName;
- UserHandle = ^UserPointer;
- UserArray = array[1..MAXUSERS] of UserHandle;
- Header = record
- Status: packed array[1..2] of Byte; { Use Status[1] only }
- MsgNo: longint;
- Section: packed array[1..2] of Byte; { Use Section[1] only }
- TimeRcvd: DayandHour;
- MsgFrom: string[31];
- MsgTo: string[31];
- MsgSubject: string[41];
- Destination: string[67];
- BeginText: longint;
- LengthText: longint;
- ReplyTo: longint;
- TimeSent: DayandHour
- end;
- HeaderPtr = ^Header;
- HeaderHndl = ^HeaderPtr;
- UserEntry = packed record
- FirstName: string[15];
- LastName: string[15];
- TheRest: packed array[1..104] of char;
- end;
- UserRecordPtr = ^UserEntry;
- UserRecordHndl = ^UserRecordPtr;
- DateOrTime = (Date, Time);
- MessageSectName = array[1..255] of string[25];
- MSectPtr = ^MessageSectName;
-
- var
- ThisHeader: Header;
- UserRecord: UserEntry;
- ThisUserHandle: UserRecordHndl;
- ThisUser: UserArray;
- Unknown, MsgCount, Undeliverable, UnknownSection, LocalPrivate: integer;
- Counter, MHdrRef, MTextRef, TLogRef, GenericRef, GenImpRef, LNRefNum: integer;
- TempRefNum: integer;
- Echoes, PrivNet: packed array[1..255] of boolean;
- Done, UserExists, DeCapitalize, ErrorFlag: boolean;
- Ms, TempString, PrivNetSect, TabbyString, PrivMark, LineLengthString: STR255;
- SectionString, TheFileName, GenericPath, TheImportFile, SectionName: STR255;
- PrivCat: string[4];
- LastHiMsg, Range, EndOfFile, HowMuch, LaunchCount: longint;
- Quantity, LogicalEOF, UserCount, PrivCatNum: longint;
- DialogPointer: DialogPtr;
- TheRect: rect;
- TByte: SignedByte;
- TabbyLog: boolean;
- NextChar: char;
- MNamePtr: MSectPtr;
-
- { ------------------------------------------------------ }
-
- function WriteChars (FileRefNum: integer; TheMessage: string): OSErr;
-
- { Function writes string to text file, returns error code }
-
- var
- TheLength: longint;
-
- begin
- TheLength := length(TheMessage);
- WriteChars := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1));
- end;
-
- {----------------------------------------------------------------- }
-
- function WrLn (fRef: integer; theString: str255): OSErr;
-
- begin
- Err := WriteChars(fRef, concat(theString, ENDLINE));
- end;
-
- {----------------------------------------------------------------- }
-
- function ReadChars (FileRefNum, TheLength: longint): string;
-
- { Function reads packed array of chars from text file, returns error code }
-
- type
- TheChars = packed array[1..255] of char;
- TheCharsPtr = ^TheChars;
- TheCharsHdl = ^TheCharsPtr;
-
- var
- Counter: integer;
- TheCharsHandle: TheCharsHdl;
-
- begin
- TempString := '';
- TheCharsHandle := TheCharsHdl(NewHandle(sizeOf(TheChars)));
- Err := FSRead(FileRefNum, TheLength, Ptr(TheCharsHandle^));
- for Counter := 1 to TheLength do
- TempString := concat(TempString, TheCharsHandle^^[Counter]);
- ReadChars := TempString;
- DisposHandle(Handle(TheCharsHandle));
- end;
-
- {----------------------------------------------------------------- }
- function Int2Char (Number: integer): char;
-
- { Function changes integer to character. }
-
- begin
- Int2Char := chr(Number + ord('0'));
- end;
-
- { ------------------------------------------------------ }
- function TwoDigit (Number: integer): string;
-
- { Function changes two-digit number to a two-character string. }
-
- begin
- TwoDigit := concat(Int2Char(Number div 10), Int2Char(Number mod 10));
- end;
-
- { ------------------------------------------------------ }
-
- procedure TimeStamp;
-
- var
- Today: DateTimeRec;
- ASCIIHour: string;
-
- begin
- GetTime(Today);
-
- { The TwoDigit function in the following section turns a two-digit integer }
- { into a two-character string. If there are fewer than two digits, the string }
- { contains a leading '0'. }
-
- ASCIIHour := TwoDigit(Today.Hour); { This bit of nonsense is to get the Tabby Log output }
- if length(ASCIIHour) > 1 then { to match a Tabby convention: single-digit hours do }
- if (copy(ASCIIHour, 1, 1) = '0') then { not have leading zeroes, even though all other single }
- ASCIIHour := copy(ASCIIHour, 2, 1); { digit numbers do. }
-
- DateString := concat(TwoDigit(Today.Month), '/', TwoDigit(Today.Day), '/', TwoDigit(Today.Year - 1900));
- TimeString := concat(ASCIIHour, ':', TwoDigit(Today.Minute), ':', TwoDigit(Today.Second));
- DateString := concat(DateString, ' ', TimeString, ' ');
- end;
-
- { ------------------------------------------------------ }
-
- function GetWidth (number: integer): integer;
-
- begin
- if number > 999 then
- GetWidth := 4
- else if number > 99 then
- GetWidth := 3
- else if number > 9 then
- GetWidth := 2
- else
- GetWidth := 1
- end;
-
- {----------------------------------------------------------------- }
-
- function ButtonSelected (whichDialog: DialogPtr; whichItem: integer): boolean;
-
- var
- whichType: integer;
- whichHandle: handle;
- whichRect, displayRect: rect;
- mouseLoc: point;
- DelayTime: longint;
- nowInverted: boolean;
-
- begin
- getDItem(whichDialog, whichItem, whichType, whichHandle, whichRect);
- displayRect := whichRect;
- InsetRect(displayRect, 1, 1);
- InvertRect(displayRect);
- nowInverted := true;
- if StillDown then
- repeat
- GetMouse(mouseLoc);
- if PtInRect(mouseLoc, whichRect) then
- begin
- if not nowInverted then
- begin
- InvertRect(displayRect);
- nowInverted := true
- end
- end
- else
- begin
- if nowInverted then
- begin
- InvertRect(displayRect);
- nowInverted := false
- end
- end
- until not StillDown;
- if nowInverted then
- begin
- Delay(4, DelayTime);
- InvertRect(displayRect);
- end;
- ButtonSelected := nowInverted
- end;
-
- {----------------------------------------------------------------- }
-
- procedure HandleError;
-
- { Creates a dialog with a numeric error code }
-
- var
- theDialog: DialogPtr;
- ItemHit, itemType: integer;
- itemHandle: Handle;
- dispRect: Rect;
- ErrMessage: STR255;
-
- begin
- DisposDialog(DialogPointer);
- InitCursor;
- theDialog := GetNewDialog(1003, nil, POINTER(-1));
- SetPort(theDialog);
- FrameDItem(theDialog, OK);
- DrawDialog(theDialog);
-
- NumToString(ErrorCode, ErrMessage);
- ErrMessage := concat('Error #', ErrMessage);
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), ErrMessage);
-
- case ErrorCode of
- 1:
- ErrMessage := 'Bad Private category number';
- 2:
- ErrMessage := 'Bad DeCapitalize option';
- 3:
- ErrMessage := 'Bad AreaFix name';
- 4:
- ErrMessage := 'Couldn''t open Tabby Log';
- 5:
- ErrMessage := 'Couldn''t close Tabby Log';
- 6:
- ErrMessage := 'Problem with Generic file';
- 8:
- ErrMessage := 'Problem with Generic Import file';
- 85, 500..507:
- ErrMessage := 'Problem with Config file';
- 9:
- ErrMessage := 'Problem with UserLog file';
- 10:
- ErrMessage := 'Problem with UserLog';
- 11:
- ErrMessage := 'Problem reading MESSAGES file';
- 12:
- ErrMessage := 'Couldn''t process import file';
- 13:
- ErrMessage := 'Problem reading MSGHDR or MSGTXT';
-
- otherwise
- ErrMessage := 'Undefined error';
- end;
-
- ErrMessage := concat('Type: ', ErrMessage, '.');
- getDItem(theDialog, 6, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), ErrMessage);
-
- repeat
- ModalDialog(nil, ItemHit);
- until (ItemHit = 1);
-
- DisposDialog(theDialog);
- ExitToShell;
- end;
-
- { ------------------------------------------------------ }
-
- procedure MemorizeUL;
-
- { Reads names from UserLog into an array of handles. UserCount holds number of users. }
-
- var
- HowBig, WhereNow, UserRecSize: longint;
- Advance, ULogRef, Count: integer;
-
- procedure QuickSort (Start, Finish: integer; var TheArray: UserArray);
-
- { Sorts UserArray by name using QuickSort }
-
- var
- Left, Right: integer;
- StarterValue: string[32];
- Temp: UserHandle;
-
- begin
- Left := Start;
- Right := Finish;
- StarterValue := TheArray[(Start + Finish) div 2]^^.Name; { Pick a starter }
- repeat
- while TheArray[Left]^^.Name < StarterValue do
- Left := Left + 1; { Find a bigger value on the left }
- while StarterValue < TheArray[Right]^^.Name do
- Right := Right - 1; { Find a smaller value on the right }
- if Left <= Right then
- begin {If we haven't gone too far... }
- Temp := TheArray[Left];
- TheArray[Left] := TheArray[Right];
- TheArray[Right] := Temp;
- Left := Left + 1;
- Right := Right - 1
- end; { then }
- until Right <= Left;
- if Start < Right then
- QuickSort(Start, Right, TheArray);
- if Left < Finish then
- QuickSort(Left, Finish, TheArray);
- end; { QuickSort }
-
- begin
- UserRecSize := 136; { Each UserLog entry is 136 bytes }
- ThisUserHandle := UserRecordHndl(NewHandle(sizeOf(UserEntry)));
- Err := FSOpen(ULPath, vRefNum, ULogRef);
- if Err = NoErr then
- begin
- Err := GetEOF(ULogRef, HowBig);
- if Err = NoErr then
- begin
- UserCount := HowBig div UserRecSize;
- if UserCount > MAXUSERS then
- begin
- Err := FSClose(ULogRef);
- HandleError;
- end;
- Advance := HowBig div 5;
- if Advance = 0 then
- Advance := 1;
- Err := SetFPos(ULogRef, fsFromStart, 0);
- for Count := 1 to UserCount do
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := FSRead(ULogRef, UserRecSize, Ptr(ThisUserHandle^));
- with ThisUserHandle^^ do
- begin
- ThisUser[Count] := UserHandle(NewHandle(SizeOf(UserRecord)));
- ThisUser[Count]^^.Index := Count;
- ThisUser[Count]^^.Name := concat(FirstName, ' ', LastName);
- ThisUser[Count]^^.MailCount := ord(TheRest[63]);
- end; { with ThisUserHandle^^ do }
- if (Count mod Advance = 0) then
- begin
- TheRect.right := 26 + (Count div Advance);
- PaintRect(TheRect)
- end { if (Count mod Advance = 0) }
- end; { for Count := 1 to UserCount }
- Err := FSClose(ULogRef);
- TheRect.right := 31;
- PaintRect(TheRect);
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- QuickSort(1, UserCount, ThisUser);
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- DisposHandle(Handle(ThisUserHandle));
- end; { if Err = NoErr }
- end; { if Err = NoErr }
- end;
-
- {----------------------------------------------------------------- }
-
- function Pad (PadLength: integer): string;
-
- var
- PadTemp: string;
- PadCount: integer;
-
- begin
- PadTemp := '';
- for PadCount := 1 to PadLength do { line o' nulls }
- PadTemp := concat(PadTemp, chr(0));
- Pad := PadTemp;
- end;
-
- {----------------------------------------------------------------- }
-
- procedure UpdateUL (ToLine: STR255);
-
- var
- Position, LoBound, HiBound, ULRef: integer;
- ULRecSize, WhereToGo: longint;
-
- begin
- ThisUserHandle := UserRecordHndl(NewHandle(sizeOf(UserEntry)));
- UprString(ToLine, false);
-
- LoBound := 1;
- HiBound := UserCount;
-
- repeat
- Position := (LoBound + HiBound) div 2;
- if (ToLine > ThisUser[Position]^^.Name) then
- LoBound := Position + 1
- else
- HiBound := Position - 1
- until (ToLine = ThisUser[Position]^^.Name) or (LoBound > HiBound);
-
- if (ToLine = ThisUser[Position]^^.Name) then
- begin
- UserExists := true;
- if (ThisUser[Position]^^.MailCount < 255) then
- begin
- ThisUser[Position]^^.MailCount := succ(ThisUser[Position]^^.MailCount);
- ULRecSize := sizeOf(UserRecord);
- WhereToGo := ULRecSize * (ThisUser[Position]^^.Index - 1);
- Err := FSOpen(ULPath, vRefNum, ULRef);
- Err := SetFPos(ULRef, fsFromStart, WhereToGo);
- Err := FSRead(ULRef, ULRecSize, Ptr(ThisUserHandle^));
- ThisUserHandle^^.TheRest[63] := chr(ThisUser[Position]^^.MailCount mod 255);
- Err := SetFPos(ULRef, fsFromStart, WhereToGo);
- Err := FSWrite(ULRef, ULRecSize, Ptr(ThisUserHandle^));
- Err := FSClose(ULRef)
- end { if (ThisUser[Position]^^.MailCount < 255) }
- end; { ToLine = ThisUser[Position]^^.Name }
- DisposHandle(Handle(ThisUserHandle));
- end;
-
- { ------------------------------------------------------ }
-
- function DTRToTime (DTR: TimeRec; separator: char): string;
-
- { Function changes three chars of DateTimeRecord to formatted time or date string }
-
- var
- MakeTimeString, LocalTemp: STR255;
-
- begin
- LocalTemp := '';
- NumToString(ord(DTR[1]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- MakeTimeString := concat(LocalTemp, Separator);
- NumToString(ord(DTR[2]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- MakeTimeString := concat(MakeTimeString, LocalTemp, Separator);
- NumToString(ord(DTR[3]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- DTRToTime := concat(MakeTimeString, LocalTemp)
- end;
-
- {----------------------------------------------------------------- }
-
- function MakeTime (TimeString: STR255; Mode: DateOrTime): TimeRec;
-
- { Function changes formatted time or date string to three chars of WK DateTimeRecord }
- { TimeString format is MM/DD/YY or HH:MM:SS }
-
- var
- Value: longint;
- ACharacter, BCharacter, CCharacter, Separator: str255;
- Today: DateTimeRec;
- BadDate: boolean;
-
- begin
- BadDate := false;
- if Mode = Date then
- Separator := '/'
- else
- Separator := ':';
- if (length(TimeString) = 8) & (TimeString[3] = Separator) & (TimeString[6] = Separator) then
- begin
- StringToNum(copy(TimeString, 1, 2), Value); {Value is either Month or Hour}
- if (Mode = Date) then
- if ((Value < 1) | (Value > 12)) then
- BadDate := true;
- if (Mode = Time) then
- if ((Value < 0) | (Value > 23)) then
- BadDate := true;
- if not BadDate then
- begin
- ACharacter := chr(Value);
- StringToNum(copy(TimeString, 4, 2), Value); {Value is either Day or Minute}
- if (Mode = Date) then
- if ((Value < 1) | (Value > 31)) then
- BadDate := true;
- if (Mode = Time) then
- if ((Value < 0) | (Value > 59)) then
- BadDate := true;
- if not BadDate then
- begin
- BCharacter := chr(Value);
- StringToNum(copy(TimeString, 7, 2), Value); {Value is either Year or Second}
- if (Mode = Date) then
- if ((Value < 0) | (Value > 99)) then
- BadDate := true;
- if (Mode = Time) then
- if ((Value < 0) | (Value > 59)) then
- BadDate := true;
- if not BadDate then
- begin
- CCharacter := chr(Value);
- MakeTime := concat(ACharacter, BCharacter, CCharacter)
- end { if CCharater was within range }
- end { if BCharater was within range }
- end { if ACharater was within range }
- end { if separators and length were OK }
- else
- BadDate := true;
- if BadDate then
- begin
- GetTime(Today);
- if (Mode = Date) then
- begin
- ACharacter := chr(Today.Month);
- BCharacter := chr(Today.Day);
- CCharacter := chr(Today.Year mod 100);
- MakeTime := concat(ACharacter, BCharacter, CCharacter)
- end { (Mode = Date) }
- else { (Mode = Time) }
- begin
- ACharacter := chr(Today.Hour);
- BCharacter := chr(Today.Minute);
- CCharacter := chr(Today.Second);
- MakeTime := concat(ACharacter, BCharacter, CCharacter)
- end; { (Mode = Time) }
- end; { if BadDate }
- end;
-
- {----------------------------------------------------------------- }
-
- procedure DeCap (var TheName: str255);
-
- var
- NameCount: integer;
-
- procedure HandleMcName (var McN: str255); {Adjusts caps in names such as McNamara}
-
- var
- i: integer;
-
- begin
- if (length(McN) > 2) then
- for i := 3 to length(McN) do
- if ((McN[i - 1] = 'c') & (McN[i - 2] = 'M') & (McN[i] in ['a'..'z'])) & ((i = 3) | (McN[i - 3] = ' ')) then
- McN[i] := chr(ord(McN[i]) - 32);
- end;
-
- begin
- UprString(TheName, false);
- for NameCount := 2 to length(TheName) do { Convert name to caps & lower case }
- if (TheName[NameCount]) in ['A'..'Z'] then
- if (TheName[NameCount - 1] in ['A'..'Z', 'a'..'z']) then
- TheName[NameCount] := chr(ord(TheName[NameCount]) + 32);
-
- HandleMcName(TheName)
- end;
-
- {----------------------------------------------------------------- }
-
- procedure CheckSysop (var ToString: string);
-
- { Procedure converts 'Sysop' and 'System Operator' to local name for private NetMail }
-
- var
- SysopCount: integer;
- TempName: STR255;
-
- begin
- TempName := ToString;
- UprString(TempName, false);
- while copy(TempName, 1, 1) = ' ' do { Strip leading blanks }
- TempName := copy(TempName, 2, length(TempName) - 1);
- while copy(TempName, length(TempName), 1) = ' ' do { Skip trailing blanks }
- TempName := copy(TempName, 1, length(TempName) - 1);
-
- if (TempName = 'SYSTEM OPERATOR') or (TempName = 'SYSOP') or (TempName = 'ALL') then
- ToString := SysopName
- end;
-
- { ------------------------------------------------------ }
-
- procedure WriteMText (TheString: string);
-
- { Procedure writes a message line to MSGTXT }
-
- var
- HowLong: longint;
-
- begin
- HowLong := length(TheString) + 1; { include its length byte }
- Err := FSWrite(MTextRef, HowLong, @TheString);
- end;
-
- { ------------------------------------------------------ }
-
- function Make2Digits (ConvertFrom: string): integer;
-
- { Converts two-character string into an ascii value }
-
- var
- Num1, Num2: integer;
-
- begin
- Num1 := ord(ConvertFrom[1]) - ord('0');
- Num2 := ord(ConvertFrom[2]) - ord('0');
- Make2Digits := Num2 + (Num1 * 10)
- end;
-
- { ------------------------------------------------------ }
-
- procedure TReadMESSAGES;
-
- { Procedure reads the MESSAGES file }
-
- var
- MSCount, MSGRefNum: integer;
- MsgByte: Byte;
- MsgString: STR255;
- CharsToSend: longint;
-
- begin
- MNamePtr := MSectPtr(NewPtr(SizeOf(MessageSectName)));
- MsgPath := '';
- LocalPrivate := 0;
- CharsToSend := 255;
- Err := FSOpen(MESSAGESPath, vRefNum, MSGRefNum);
- if Err = NoErr then
- begin
- Err := FSRead(MSGRefNum, CharsToSend, @MsgString);
- if Err = NoErr then
- begin
- if (length(MsgString) > 0) then
- MsgPath := concat(MsgString, ':');
- CharsToSend := 4;
- Err := SetFPos(MSGRefNum, fsFromStart, 50);
- if Err = NoErr then
- begin
- Err := FSRead(MSGRefNum, CharsToSend, @LowMsg);
- Err := FSRead(MSGRefNum, CharsToSend, @HiMsg);
-
- Unknown := 255;
- for MSCount := 1 to 255 do
- begin
- Err := SetFPos(MSGRefNum, fsFromStart, (62 + (MSCount - 1) * 36));
- CharsToSend := 255;
- Err := FSRead(MSGRefNum, CharsToSend, @SectionName);
- MNamePtr^[MSCount] := SectionName;
- UprString(SectionName, false);
- if EqualString(SectionName, 'UNKNOWN', false, false) then
- Unknown := MSCount;
-
- Err := SetFPos(MSGRefNum, fsFromStart, (97 + (MSCount - 1) * 36));
- CharsToSend := 1;
- Err := FSRead(MSGRefNum, CharsToSend, @MsgByte);
-
- MsgByte := MsgByte div 256;
-
- Echoes[MSCount] := false;
- PrivNet[MSCount] := false;
-
- case MsgByte of
- 4:
- Echoes[MSCount] := true;
-
- 3:
- PrivNet[MSCount] := true;
-
- 1:
- if LocalPrivate = 0 then
- LocalPrivate := MSCount;
-
- otherwise
- ;
-
- end; { case statement }
-
- end; { for MSCount := 1 to 255 do }
-
- Err := FSClose(MSGRefNum);
- end
- end
- end
- end;
-
- { ------------------------------------------------------ }
-
- procedure ProcessImports;
-
- { Procedure translates Generic Import contents to message files }
-
- var
- FlagCount, Count1, Count2, TextLineLength, BlankPos, LineCounter, ThisStatus, MESSAGESRef: integer;
- ThisSection, MsgStart, TextLength, NewMsg, HowLong, CharsToSend, FlagPos: longint;
- FlagLine, CatLine, OriginLine, FromLine, ToLine, SubjectLine, TextLine, TempTime1, TempTime2: STR255;
- TempLine, Temp1, Temp2, Temp3, TempOriginLine: STR255;
- SentDateLine, SentTimeLine, RcvdDateLine, RcvdTimeLine: TimeRec;
- Today: DateTimeRec;
- AFixRef, PMLength, OriginCount, ArrayCount: integer;
- ALongInt: longint;
- ImportArray: array[1..255] of integer;
-
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- for ArrayCount := 1 to 255 do
- ImportArray[ArrayCount] := 0;
- TheFileName := concat(MsgPath, 'MSGHDR');
- Err := FSOpen(concat(MsgPath, 'MSGHDR'), vRefNum, MHdrRef);
- if Err = noErr then
- begin
- Err := SetFPos(MHdrRef, fsFromLEOF, 0); { Set file position to logical end of file }
- if Err = noErr then
- begin
- Err := FSOpen(concat(MsgPath, 'MSGTXT'), vRefNum, MTextRef);
- if Err = noErr then
- begin
- Err := SetFPos(MTextRef, fsFromLEOF, 0); { Set file position to logical end of file }
- if Err = noErr then
- begin
- GetTime(Today);
- RcvdDateLine := concat(chr(Today.Month), chr(Today.Day), chr(Today.Year - 1900));
- RcvdTimeLine := concat(chr(Today.Hour), chr(Today.Minute), chr(Today.Second));
-
- Err := FSOpen(TheImportFile, vRefNum, GenImpRef);
- if Err = NoErr then
- Err := GetEOF(GenImpRef, InFileLength);
- if (InFileLength > 0) & (Err = NoErr) then
- begin
- Leftover := '';
- Range := InFileLength;
- Err := SetFPos(GenImpRef, fsFromStart, 0);
- BufferFilePos := 0;
- ImportPos := 0;
- InBuffHndl := BuffHndl(NewHandle(sizeOf(FileBuffer)));
- FillBuffer(GenImpRef);
-
- while (ImportPos < InFileLength) do
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- MsgBody := false;
- TheRect.right := trunc(((100 * (ImportPos + 0.5)) / Range) + 31);
- PaintRect(TheRect);
- FlagPos := ImportPos;
- FlagLine := TReadALine(GenImpRef);
- if length(FlagLine) <> 3 then
- begin
- repeat
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- TextLine := TReadALine(GenImpRef);
- until (ImportPos >= (InFileLength - 1)) | (pos(chr(0), TextLine) > 0);
- if pos(chr(0), TextLine) > 0 then
- repeat
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := GetFPos(GenImpRef, FlagPos);
- FlagLine := TReadALine(GenImpRef);
- until (length(FlagLine) = 3) | (ImportPos >= (InFileLength - 1));
- end
- else if (FlagLine[1] <> 'D') & (ImportPos < InFileLength) then
- begin
- MsgCount := succ(MsgCount);
- Err := SetFPos(GenImpRef, fsFromStart, FlagPos);
- FlagLine[1] := 'D';
- Err := WriteChars(GenImpRef, concat(FlagLine, ENDLINE));
- HiMsg := HiMsg + 1;
- ThisStatus := 0; { Originated on another system }
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- CatLine := TReadALine(GenImpRef);
- StringToNum(CatLine, ThisSection);
- if (ThisSection < 1) or (ThisSection > 255) then
- ThisSection := Unknown;
- if FlagLine[2] = 'M' then { Private NetMail message, otherwise it's an Echo }
- begin
- ThisStatus := BitOr(ThisStatus, 4);
- ThisSection := PrivCatNum; { Make sure it goes to Net Private }
- end
- else if FlagLine[2] = 'E' then
- begin
- if not Echoes[ThisSection] then
- ThisSection := Unknown; { Not a defined Echo -- send it to Unknown }
- end
- else
- ThisSection := Unknown; { Wasn't 'E' or 'M' -- send it to Unknown }
- ImportArray[ThisSection] := succ(ImportArray[ThisSection]);
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- TempTime1 := TReadALine(GenImpRef);
- SentDateLine := MakeTime(TempTime1, Date);
- TempTime2 := TReadALine(GenImpRef);
- SentTimeLine := MakeTime(TempTime2, Time);
- OriginLine := TReadALine(GenImpRef);
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- FromLine := TReadALine(GenImpRef);
- if length(FromLine) > 30 then
- FromLine := copy(FromLine, 1, 30);
- DeCap(FromLine);
- ToLine := TReadALine(GenImpRef);
- if length(ToLine) > 30 then
- ToLine := copy(ToLine, 1, 30);
- DeCap(ToLine);
- if (FlagLine[2] = 'M') then { Private NetMail message }
- CheckSysop(ToLine);
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- SubjectLine := TReadALine(GenImpRef);
- if length(SubjectLine) > 40 then
- SubjectLine := copy(SubjectLine, 1, 40);
- { if Subject or To line ends in PrivMark, it's a local private message marked by ff }
- PMLength := length(PrivMark);
- if (pos(PrivMark, SubjectLine) > 0) | (pos(PrivMark, ToLine) > 0) then
- if (pos(PrivMark, SubjectLine) = length(SubjectLine) - PMLength + 1) | (pos(PrivMark, ToLine) = length(ToLine) - PMLength + 1) then
- begin
- ThisStatus := BitXor(ThisStatus, 64); {Don't say it originated elsewhere}
- ThisSection := LocalPrivate; { Make sure it goes to Local Private }
- if (pos(PrivMark, SubjectLine) = length(SubjectLine) - PMLength + 1) then
- SubjectLine := copy(SubjectLine, 1, length(SubjectLine) - PMLength);
- if (pos(PrivMark, ToLine) = length(ToLine) - PMLength + 1) then
- ToLine := copy(ToLine, 1, length(ToLine) - PMLength)
- end;
- UserExists := false;
- if ToLine <> 'All' then
- UpdateUL(ToLine); { Let addressee know there's mail waiting }
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := GetFPos(MTextRef, MsgStart); { Use for pointer in MSGHDR and to compute length of text }
- if (not UserExists) and (FlagLine[2] = 'M') then { Undeliverable private NetMail }
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Temp1 := ToLine;
- Temp2 := FromLine;
- Temp3 := SubjectLine;
- ThisSection := PrivCatNum; { Change section to Net Private }
- ToLine := SysopName;
- FromLine := 'That Darned TImport';
- SubjectLine := 'Undelivered NetMail';
- WriteMText(' ');
- WriteMText(Dashes);
- WriteMText(' The following private NetMail message could not be delivered.');
- WriteMText(Dashes);
- WriteMText(' ');
- WriteMText(concat('To: ', Temp1, ' From: ', Temp2));
- WriteMText(concat('Subject: ', Temp3));
- Temp1 := DTRToTime(SentDateLine, '/');
- Temp2 := DTRToTime(SentTimeLine, ':');
- WriteMText(concat('Date Sent: ', Temp1, ' at ', Temp2, ' Origin: ', OriginLine));
- WriteMText(' ');
- SentDateLine := RcvdDateLine; { Change date of this message to *now* }
- SentTimeLine := RcvdTimeLine;
- LineCounter := 9
- end
- else
- LineCounter := 0;
- MsgBody := true;
- repeat
- TextLine := TReadALine(GenImpRef);
- if (FlagLine[2] = 'M') & (pos(concat(CTLA, 'FMPT '), TextLine) = 1) then { Origin is a point }
- begin
- TempOriginLine := concat(OriginLine, '.', copy(TextLine, 7, length(TextLine)));
- OriginLine := '';
- for OriginCount := 1 to length(TempOriginLine) do
- if TempOriginLine[OriginCount] in ['.', ':', '/', '0'..'9'] then
- OriginLine := concat(OriginLine, TempOriginLine[OriginCount])
- end
- else if (pos(NULL, TextLine) = 0) then
- begin
- if length(TextLine) < 2 then
- TextLine := concat(TextLine, ' ');
- WriteMText(TextLine);
- LineCounter := LineCounter + 1
- end; { if (pos(chr(0), TextLine) = 0) }
- until (ImportPos >= (InFileLength - 1)) | (pos(chr(0), TextLine) > 0) | (LineCounter = 400);
- MsgBody := false;
- if (pos(chr(0), TextLine) = 0) & (ImportPos < InFileLength - 1) then
- repeat
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- TextLine := TReadALine(GenImpRef);
- until (ImportPos >= (InFileLength - 1)) or (pos(chr(0), TextLine) > 0);
-
- if (LineCounter = 0) then
- WriteMText(' *** No message text ***');
-
- Err := GetFPos(MTextRef, NewMsg);
- TextLength := NewMsg - MsgStart;
-
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- with ThisHeader do
- begin
- MsgFrom := Pad(31); { write nulls to the name fields for easier viewing }
- MsgTo := Pad(31); { with FEdit }
- MsgSubject := Pad(41);
- Destination := Pad(67);
- HowLong := 206; { length of MSGHDR }
- Err := FSWrite(MHdrRef, HowLong, @ThisHeader);
- Err := SetFPos(MHdrRef, fsFromLEOF, -206);
- Status[1] := ThisStatus;
- Status[2] := 0;
- MsgNo := HiMsg;
- Section[1] := ThisSection;
- Section[2] := 0;
- MsgFrom := FromLine;
- MsgTo := ToLine;
- MsgSubject := SubjectLine;
- Destination := OriginLine;
- BeginText := MsgStart;
- LengthText := TextLength;
- ReplyTo := 0;
- TimeSent := concat(SentDateLine, SentTimeLine);
- TimeRcvd := concat(RcvdDateLine, RcvdTimeLine);
- end; { with ThisHeader }
- Err := FSWrite(MHdrRef, HowLong, @ThisHeader);
-
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := FSOpen(MESSAGESPath, vRefNum, MESSAGESRef);
- Err := SetFPos(MESSAGESRef, fsFromStart, 54);
- CharsToSend := 4;
- Err := FSWrite(MESSAGESRef, CharsToSend, @HiMsg);
- Err := GetFPos(MTextRef, MSGTXTLength);
- CharsToSend := 4;
- Err := FSWrite(MESSAGESRef, CharsToSend, @MSGTXTLength);
- Err := FSClose(MESSAGESRef)
- end { (FlagLine[1] <> 'D') & (ImportPos < InFileLength) }
- else if (ImportPos < InFileLength) then
- repeat
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- TextLine := TReadALine(GenImpRef);
- until (ImportPos >= (InFileLength - 1)) or (pos(chr(0), TextLine) > 0);
- end; { while not eof(TabbyGeneric) }
- DisposHandle(Handle(InBuffHndl));
- if SectCount then
- begin
- TimeStamp;
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- for ArrayCount := 1 to 255 do
- if ImportArray[ArrayCount] > 0 then
- begin
- if ImportArray[ArrayCount] = 1 then
- Err := WrLn(TLogRef, concat(DateString, 'TImport - ', StringOf(ImportArray[ArrayCount] : GetWidth(MsgCount)), ' Message for ', MNamePtr^[ArrayCount], ' #', StringOf(ArrayCount : 1)))
- else
- Err := WrLn(TLogRef, concat(DateString, 'TImport - ', StringOf(ImportArray[ArrayCount] : GetWidth(MsgCount)), ' Messages for ', MNamePtr^[ArrayCount], ' #', StringOf(ArrayCount : 1)));
- end;
- Err := FSClose(TLogRef);
- end; {if SectionCount}
- end; { InFileLength > 0 }
- Err := FSClose(GenImpRef);
- Err := FSDelete(TheImportFile, vRefNum);
- TheRect.right := 131;
- PaintRect(TheRect);
- end; { no error on SetFPos for MSGTXT }
- end; { no error on open MSGTXT }
- Err := FSClose(MTextRef);
- end; { no error on SetFPos for MSGHDR }
- end; { no error on open MSGHDR }
- Err := FSClose(MHdrRef);
- if MNamePtr <> nil then
- begin
- DisposPtr(Pointer(MNamePtr));
- MNamePtr := nil
- end
- end;
-
- { ------------------------------------------------------ }
-
- procedure HandleDialog;
-
- var
- theDialog: DialogPtr;
- ItemHit, itemType, whichItem, CheckCount: integer;
- itemHandle: Handle;
- dispRect: Rect;
- thisButton: ControlHandle;
- JustChecking: longint;
- ValidNumber: boolean;
- where: point;
- fileReply: SFReply;
- whatToFind: SFTypeList;
-
- begin
- InitCursor;
- theDialog := GetNewDialog(1002, nil, POINTER(-1)); {IM I-413}
- SetPort(theDialog);
- FrameDItem(theDialog, Ok);
- DrawDialog(theDialog);
-
- NextLaunch := GetString(500)^^; { Get next launch string from resource }
- getDItem(theDialog, 3, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), NextLaunch);
-
- getDItem(theDialog, 4, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), PrivCat);
-
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeCapitalize then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 6, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), LineLengthString);
-
- getDItem(theDialog, 17, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if TabbyLog then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 20, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), CreatorType);
-
- getDItem(theDialog, 23, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SectCount then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- TextFont(Geneva);
- TextSize(9);
- ForeColor(redColor);
- getDItem(theDialog, 14, itemType, itemHandle, dispRect);
- SetIText(Handle(itemHandle), VERSION);
- ForeColor(blackColor);
- SetDAFont(0);
- TextFont(0);
- TextSize(0);
-
- if StillDown then
- repeat
- until not Button;
- repeat
- ModalDialog(nil, ItemHit); {IM I-415}
- ;
- case ItemHit of
-
- 1: { OK button hit -- save resources }
- begin
- getDItem(theDialog, 3, itemType, itemHandle, dispRect);
- GetIText(Handle(itemHandle), NextLaunch);
- RmveResource(GetResource('STR ', 500));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(NextLaunch)), 'STR ', 500, 'Next Launch');
-
- getDItem(theDialog, 4, itemType, itemHandle, dispRect);
- GetIText(Handle(itemHandle), PrivNetSect);
- ValidNumber := true;
- for CheckCount := 1 to length(PrivNetSect) do
- if not (PrivNetSect[CheckCount] in ['0'..'9', ' ']) then
- ValidNumber := false;
- StringToNum(PrivNetSect, JustChecking);
- if (JustChecking > 0) and (JustChecking < 256) and ValidNumber then
- begin
- RmveResource(GetResource('STR ', 501));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(PrivNetSect)), 'STR ', 501, 'PrivNetMail')
- end
- else
- sysbeep(10); { Non-valid message section entered -- do nothing }
-
- tempString := 'NN';
- if DeCapitalize then
- TempString[1] := 'Y';
- if SectCount then
- TempString[2] := 'Y';
- RmveResource(GetResource('STR ', 502));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(TempString)), 'STR ', 502, 'Defaults');
-
- getDItem(theDialog, 6, itemType, itemHandle, dispRect);
- GetIText(Handle(itemHandle), LineLengthString);
- RmveResource(GetResource('STR ', 503));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(LineLengthString)), 'STR ', 503, 'Line Length');
-
- if TabbyLog then
- TempString := 'Y'
- else
- TempString := 'N';
- RmveResource(GetResource('STR ', 504));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(TempString)), 'STR ', 504, 'Tabby Log? (Y/N)');
-
- getDItem(theDialog, 20, itemType, itemHandle, dispRect);
- GetIText(Handle(itemHandle), CreatorType);
- RmveResource(GetResource('STR ', 505));
- UpdateResFile(CurrentResFile);
- AddResource(Handle(NewString(CreatorType)), 'STR ', 505, 'TEXT Creator');
-
- end;
-
- 2:
- ; { Cancel button hit—do nothing }
-
- 5:
- begin { DeCapitalize switch }
- DeCapitalize := not DeCapitalize;
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeCapitalize then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 17:
- begin { Tabby switch }
- TabbyLog := not TabbyLog;
- getDItem(theDialog, 17, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if TabbyLog then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 23:
- begin { SectionCount switch }
- SectCount := not SectCount;
- getDItem(theDialog, 23, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SectCount then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 24: { Choose Next Launch }
- if ButtonSelected(theDialog, 24) then
- begin
- where.h := 60;
- where.v := 80;
- whatToFind[0] := 'APPL';
- ParamText('next application to launch', '', '', '');
- SFGetFile(where, '', nil, 1, whatToFind, nil, fileReply);
- if fileReply.good then
- begin
- getDItem(theDialog, 3, itemType, itemHandle, dispRect);
- NextLaunch := fileReply.fName;
- SetIText(Handle(itemHandle), NextLaunch)
- end;
- FrameDItem(theDialog, Ok);
- end;
-
- otherwise
- ; { do nothing }
-
- end;
- until (ItemHit = 1) or (ItemHit = 2);
-
- DisposDialog(theDialog)
- end;
-
- { ------------------------------------------------------ }
-
- var
- itemType: integer;
- itemHandle: handle;
- dispRect: rect;
- oldPort: GrafPtr;
-
- begin
- MaxApplZone;
- GetPort(oldPort);
- ErrorFlag := false;
- ErrorCode := 0;
- CurrentResFile := CurResFile;
- PrivMark := GetString(499)^^;
- PrivCat := GetString(501)^^;
- StringToNum(PrivCat, PrivCatNum);
- ErrorCode := 1;
- TempString := GetString(502)^^;
- ErrorCode := 2;
- UprString(TempString, false);
- if TempString[1] = 'Y' then
- DeCapitalize := true
- else
- DeCapitalize := false;
- if TempString[2] = 'Y' then
- SectCount := true
- else
- SectCount := false;
- LineLengthString := GetString(503)^^;
- StringToNum(LineLengthString, MaxMsgLine);
- if (MaxMsgLine < 50) | (MaxMsgLine > 90) then
- MaxMsgLine := 75;
- ErrorCode := 3;
- TabbyString := GetString(504)^^;
- if TabbyString[1] = 'Y' then
- TabbyLog := true
- else
- TabbyLog := false;
- CreatorType := GetString(505)^^;
- while length(CreatorType) < 4 do
- CreatorType := concat(CreatorType, ' ');
- CreatorType := copy(CreatorType, 1, 4);
-
- if Button then
- HandleDialog { If user is holding down the mouse button, reconfigure and end }
- else
- begin
- ErrorCode := 4;
- MsgCount := 0;
- UnknownSection := 0;
- Undeliverable := 0;
- DialogPointer := GetNewDialog(1001, nil, POINTER(-1));
- DrawDialog(DialogPointer);
- SetPort(DialogPointer);
- ShowWindow(DialogPointer);
- TextFont(Geneva);
- TextSize(9);
- ForeColor(redColor);
- getDItem(DialogPointer, 2, itemType, itemHandle, dispRect);
- SetIText(itemHandle, VERSION);
- SetRect(TheRect, 26, 49, 131, 54);
- FrameRect(TheRect);
- HelloTabby; { find out what's next on the launchpad }
- TimeStamp;
-
- if TabbyLog then
- begin
- Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- if (Err <> NoErr) then
- HandleError;
- ErrorCode := 5;
-
- if not ErrorFlag then
- begin
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- if (Err <> NoErr) then
- HandleError;
- TempString := concat(concat(DateString, 'TImport - Program Starting (v ', VERSION, ')', ENDLINE));
- Err := WriteChars(TLogRef, TempString);
- if (Err <> NoErr) then
- HandleError;
- Err := FSClose(TLogRef);
- if (Err <> NoErr) then
- HandleError;
- end; { if not ErrorFlag }
- end; { if TabbyLog }
-
- ErrorCode := 6;
-
- if (Err <> NoErr) then
- HandleError;
-
- Err := FSOpen(concat(gDefaultpath, 'Generic'), vRefNum, GenericRef);
- if (Err <> NoErr) then
- HandleError;
- if not ErrorFlag then
- begin
- Err := GetEOF(GenericRef, logicalEOF);
- if (Err <> NoErr) then
- HandleError;
- if (logicalEOF > 0) & (ErrorFlag = false) then
- begin
- GenericPath := ReadChars(GenericRef, logicalEOF - 1); { subtract 1 to avoid LF }
- Err := FSClose(GenericRef);
- if (Err <> NoErr) then
- HandleError
- end
- else
- HandleError
- end; { if not ErrorFlag }
- ErrorCode := 7;
-
- if (Err <> NoErr) then
- HandleError;
-
- if GenericPath[length(GenericPath)] <> ':' then
- GenericPath := concat(GenericPath, ':');
- TheImportFile := concat(GenericPath, 'Generic Import');
- Err := FSOpen(TheImportFile, vRefNum, GenImpRef);
- ErrorCode := 8;
-
- if (Err = NoErr) then
- begin
- Err := GetEOF(GenImpRef, logicalEOF);
- if (Err = NoErr) then
- begin
- Err := FSClose(GenImpRef);
- if (Err = NoErr) | (logicalEOF > 0) then
- begin
- ErrorCode := 85;
- ReadConfig;
-
- if (Err <> NoErr) then
- HandleError;
-
- ErrorCode := 9;
-
- if DeCapitalize then
- DeCap(SysopName);
- MemorizeUL;
- ErrorCode := 10;
- if (Err <> NoErr) then
- HandleError;
- TReadMESSAGES;
- ErrorCode := 11;
- if (Err <> NoErr) then
- HandleError;
- ProcessImports;
- ErrorCode := 12;
- if (Err <> NoErr) then
- HandleError;
- for Counter := 1 to UserCount do
- DisposHandle(Handle(ThisUser[Counter]));
- ErrorCode := 13
- end { Closed Generic Import OK }
- end { Got EOF of Generic Import OK }
- end; { Opened Generic Import OK }
- TimeStamp;
- if TabbyLog then
- begin
- Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- NumToString(MsgCount, TempString);
- if MsgCount > 0 then
- begin
- if MsgCount = 1 then
- TempString := concat(DateString, 'TImport - ', StringOf(MsgCount : GetWidth(MsgCount)), ' Message Total')
- else
- TempString := concat(DateString, 'TImport - ', StringOf(MsgCount : GetWidth(MsgCount)), ' Messages Total');
- Err := WrLn(TLogRef, TempString)
- end;
- if Undeliverable > 0 then
- begin
- NumToString(Undeliverable, TempString);
- TempString := concat(DateString, 'TImport - Error: ', TempString, ' Private Net Messages were Undeliverable');
- Err := WrLn(TLogRef, TempString)
- end;
- if UnknownSection > 0 then
- begin
- NumToString(UnknownSection, TempString);
- TempString := concat(DateString, 'TImport - Error: ', TempString, ' Public Net Messages sent to Unknown Section');
- Err := WrLn(TLogRef, TempString);
- end;
- Err := WrLn(TLogRef, concat(DateString, 'TImport - Program Ending'));
- Err := FSClose(TLogRef)
- end; { if TabbyLog }
-
- DisposDialog(DialogPointer);
- SetPort(oldPort);
- if NextLaunch <> '' then
- LaunchNextAppl
- end { if not Button }
- end. { procedure }