1 { $O+,F+,I-,S-,R-,V-}
2 Unit MKMsgHud; {Hudson/QuickBbs-style Message Base}
3
4 {$IfDef FPC}
5 {$PackRecords 1}
6 {$EndIf}
7
8 Interface
9
10
11 Uses MKMsgAbs, MKGlobT, GeneralP;
12
13 Type MsgTxtType = String[255]; {MsgTxt.Bbs file}
14
15 Type MsgToIdxType = String[35]; {MsgToIdx.Bbs file}
16
17 Type MsgInfoType = Record {MsgInfo.Bbs file}
18 LowMsg: Word; {Low message number in file}
19 HighMsg: Word; {High message number in file}
20 Active: Word; {Number of active messages}
21 AreaActive: Array[1..200] of Word; {Number active in each area}
22 End;
23
24 Type MsgIdxType = Record {MsgIdx.Bbs file}
25 MsgNum: Word; {Message number}
26 Area: Byte; {Message area}
27 End;
28
29 Type MsgHdrType = Record {MsgHdr.Bbs file}
30 MsgNum: Word; {Message number}
31 ReplyTo: Word; {Message is reply to this number}
32 SeeAlso: Word; {Message has replies}
33 Extra: Word; {No longer used}
34 StartRec: Word; {starting seek offset in MsgTxt.Bbs}
35 NumRecs: Word; {number of MsgTxt.Bbs records}
36 DestNet: Integer; {NetMail Destination Net}
37 DestNode: Integer; {NetMail Destination Node}
38 OrigNet: Integer; {NetMail Originating Net}
39 OrigNode: Integer; {NetMail Originating Node}
40 DestZone: Byte; {NetMail Destination Zone}
41 OrigZone: Byte; {NetMail Originating Zone}
42 Cost: Word; {NetMail Cost}
43 MsgAttr: Byte; {Message attribute - see constants}
44 NetAttr: Byte; {Netmail attribute - see constants}
45 Area: Byte; {Message area}
46 Time: String[5]; {Message time in HH:MM}
47 Date: String[8]; {Message date in MM-DD-YY}
48 MsgTo: String[35]; {Message is intended for}
49 MsgFrom: String[35]; {Message was written by}
50 Subj: String[72]; {Message subject}
51 End;
52
53
54 Type LastReadType = Array[1..200] Of Word; {LASTREAD.BBS file}
55
56
57 Const {MsgHdr.MsgAttr}
58 maDeleted = 1; {Message is deleted}
59 maUnmovedNet = 2; {Unexported Netmail message}
60 maNetMail = 4; {Message is netmail message}
61 maPriv = 8; {Message is private}
62 maRcvd = 16; {Message is received}
63 maUnmovedEcho = 32; {Unexported Echomail message}
64 maLocal = 64; {"Locally" entered message}
65
66
67 Const {MsgHdr.NetAttr}
68 naKillSent = 1; {Delete after exporting}
69 naSent = 2; {Msg has been sent}
70 naFAttach = 4; {Msg has file attached}
71 naCrash = 8; {Msg is crash}
72 naReqRcpt = 16; {Msg requests receipt}
73 naReqAudit = 32; {Msg requests audit}
74 naRetRcpt = 64; {Msg is a return receipt}
75 naFileReq = 128; {Msg is a file request}
76
77
78
79 {$IfDef SPEED}
80 Uses
81 BseDOS;
82
83 Const
84 fmReadOnly = Open_Access_ReadOnly;
85 fmReadWrite = Open_Access_ReadWrite;
86 fmDenyNone = Open_Share_DenyNone;
87
88 {$Else}
89
90 Const
91 fmReadOnly = 0; {FileMode constants}
92 fmWriteOnly = 1;
93 fmReadWrite = 2;
94 fmDenyAll = 16;
95 fmDenyWrite = 32;
96 fmDenyRead = 48;
97 fmDenyNone = 64;
98 fmNoInherit = 128;
99
100 {$EndIf}
101
102 Const
103 TxtSize = 64;
104 SeekSize = 1000;
105
106 HudsonFlushing: Boolean = True;
107
108 HudsonLastRead : String[12] = 'LASTREAD.BBS';
109
110 Type
111 TxtRecsType = Array[1..TxtSize] of MsgTxtType;
112 SeekArrayType = Array[1..SeekSize] of MsgIdxType;
113
114 Type HudsonMsgType = Record
115 MsgPath: String[50]; {Message base directory}
116 MsgInfoFile: File;
117 MsgTxtFile: File;
118 MsgHdrFile: File;
119 MsgToIdxFile: File;
120 MsgIdxFile: File;
121 Opened: Boolean;
122 Locked: Boolean;
123 Error: Word; {0=no error}
124 RealMsgNum: Word;
125 MsgHdr: MsgHdrType; {Current message header}
126 MsgInfo: MsgInfoType; {MsgInfo record}
127 MsgPos: Word; {MsgHdr seek position of current rec}
128 {$IFDEF VirtualPascal}
129 SeekNumRead: LongInt;
130 {$ELSE}
131 SeekNumRead: Word; {Number of records in the array}
132 {$ENDIF}
133 SeekPos: Integer; {Current position in array}
134 SeekStart: Word; {File Pos of 1st record in Idx Array}
135 SeekOver: Boolean; {More idx records?}
136 CurrMsgNum: Word; {Current Seek Msg number}
137 CurrTxtRec: Word; {Current txtrec in current msg}
138 CurrTxtPos: Word; {Current position in current txtrec}
139 OrigPoint: Word; {Point Addr orig}
140 DestPoint: Word; {Point Addr destination}
141 Echo: Boolean; {Should message be exported}
142 CRLast: Boolean; {Last char was CR #13}
143 Area: Word;
144 MT: MsgMailType;
145 End;
146
147
148 Type HudsonMsgObj = Object(AbsMsgObj) {Message Export Object}
149 MsgRec: ^HudsonMsgType;
150 MsgChars: ^TxtRecsType;
151 SeekArray: ^SeekArrayType;
152 Constructor Init; {Initialize}
153 Destructor Done; Virtual; {Done}
154 Procedure InitMsgHdr; Virtual; {Setup message/read header}
155 Procedure MsgTxtStartUp; Virtual; {Setup message text}
GetCharnull156 Function GetChar: Char; Virtual; {Get msg text character}
NextCharnull157 Function NextChar(Var Rec: Word; Var PPos: Word): Boolean;{internal to position for char}
GetStringnull158 Function GetString: String; Virtual; {Get wordwrapped string}
159 Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seek msg number}
160 Procedure SeekNext; Virtual; {Find next matching msg}
161 Procedure SeekPrior; Virtual; {Find prior matching msg}
162 Procedure SeekRead(NumToRead: Word); {Refill seek array}
SetReadnull163 Function SetRead(RS: Boolean): boolean; Virtual; {Set read status}
IsReadnull164 Function IsRead: Boolean; Virtual; {Is current msg received}
GetFromnull165 Function GetFrom: String; Virtual; {Get from name on current msg}
GetTonull166 Function GetTo: String;Virtual; {Get to name on current msg}
GetSubjnull167 Function GetSubj: String; Virtual; {Get subject on current msg}
GetCostnull168 Function GetCost: Word; Virtual; {Get cost of current msg}
GetDatenull169 Function GetDate: String; Virtual; {Get date of current msg}
GetTimenull170 Function GetTime: String; Virtual; {Get time of current msg}
GetRefernull171 Function GetRefer: LongInt; Virtual; {Get reply to of current msg}
GetSeeAlsonull172 Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
GetMsgNumnull173 Function GetMsgNum: LongInt; Virtual; {Get message number}
174 Procedure GetOrig(Var Addr: AddrType); Virtual; {Get origin address}
175 Procedure GetDest(Var Addr: AddrType); Virtual; {Get destination address}
IsLocalnull176 Function IsLocal: Boolean; Virtual; {Is current msg local}
IsCrashnull177 Function IsCrash: Boolean; Virtual; {Is current msg crash}
IsKillSentnull178 Function IsKillSent: Boolean; Virtual; {Is current msg kill sent}
IsSentnull179 Function IsSent: Boolean; Virtual; {Is current msg sent}
IsFAttachnull180 Function IsFAttach: Boolean; Virtual; {Is current msg file attach}
IsReqRctnull181 Function IsReqRct: Boolean; Virtual; {Is current msg request receipt}
IsReqAudnull182 Function IsReqAud: Boolean; Virtual; {Is current msg request audit}
IsRetRctnull183 Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
IsFileReqnull184 Function IsFileReq: Boolean; Virtual; {Is current msg a file request}
IsRcvdnull185 Function IsRcvd: Boolean; Virtual; {Is current msg received}
IsPrivnull186 Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
IsDeletednull187 Function IsDeleted: Boolean; Virtual; {Is current msg deleted}
IsEchoednull188 Function IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg}
189 Procedure SetDest(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Dest}
190 Procedure SetOrig(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Orig}
191 Procedure SetFrom(Name: String); Virtual; {Set message from}
192 Procedure SetTo(Name: String); Virtual; {Set message to}
193 Procedure SetSubj(Str: String); Virtual; {Set message subject}
194 Procedure SetCost(SCost: Word); Virtual; {Set message cost}
195 Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference}
196 Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also}
197 Procedure SetDate(SDate: String); Virtual; {Set message date}
198 Procedure SetTime(STime: String); Virtual; {Set message time}
199 Procedure SetEcho(ES: Boolean); Virtual; {Set echo status}
200 Procedure SetMsgAttr(Setting: Boolean; Mask: Word);
201 Procedure SetNetAttr(Setting: Boolean; Mask: Word);
202 Procedure SetLocal(LS: Boolean); Virtual; {Set local status}
203 Procedure SetRcvd(RS: Boolean); Virtual; {Set received status}
204 Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status}
205 Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status}
206 Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status}
207 Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status}
208 Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status}
209 Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status}
210 Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status}
211 Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status}
212 Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status}
213 Procedure DoString(Str: String); Virtual; {Add string to message text}
214 Procedure DoChar(Ch: Char); Virtual; {Add character to message text}
215 Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text}
WriteMsgnull216 Function WriteMsg: Word; Virtual; {Write msg to message base}
OpenMsgBasenull217 Function OpenMsgBase: Word; Virtual; {Individual msg open}
CloseMsgBasenull218 Function CloseMsgBase: Word; Virtual; {Individual msg close}
SeekEndnull219 Function SeekEnd: Word; Virtual; {Seek to eof for msg base files}
SeekMsgBasePosnull220 Function SeekMsgBasePos(Position: Word): Word; Virtual; {Seek to pos of Msg Base File}
Checknull221 Function Check: Word; Virtual; {Check if msg base is ok}
CreateMsgBasenull222 Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;{Create initial msg base files}
LockMsgBasenull223 Function LockMsgBase: Boolean; Virtual; {Lock msg base for updating}
UnlockMsgBasenull224 Function UnlockMsgBase: Boolean; Virtual; {Unlock msg base after updating}
225 (* Function WriteMailIdx(FN: String; MsgPos: Word): Word; Virtual;
226 {Write Netmail or EchoMail.Bbs} *)
MsgBaseSizenull227 Function MsgBaseSize: Word; Virtual; {Number of msg base index records}
GetNumActivenull228 Function GetNumActive: Word; Virtual; {Get number of active messages}
GetHighMsgNumnull229 Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number}
GetLowMsgNumnull230 Function GetLowMsgNum: LongInt; Virtual; {Get lowest msg number}
231 Procedure StartNewMsg; Virtual; {Initialize message}
232 Procedure SetMsgPath(MP: String); Virtual;
SeekFoundnull233 Function SeekFound:Boolean; Virtual; {Seek msg found}
234 Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
GetSubAreanull235 Function GetSubArea: Word; Virtual; {Get sub area number}
236 Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
237 Procedure DeleteMsg; Virtual; {Delete current message}
GetMsgLocnull238 Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message}
239 Procedure SetMsgLoc(ML: LongInt); Virtual; {Reseek to message}
NumberOfMsgsnull240 Function NumberOfMsgs: LongInt; Virtual; {Number of messages}
GetLastReadnull241 Function GetLastRead: LongInt; Virtual; {Get last read for user num}
242 Procedure SetLastRead(LR: LongInt); Virtual; {Set last read}
243 Procedure GetHighest(Var LR: LastReadType); Virtual; {Get highest all areas}
GetTxtPosnull244 Function GetTxtPos: LongInt; Virtual;
245 Procedure SetTxtPos(TP: LongInt); Virtual;
MsgBaseExistsnull246 Function MsgBaseExists: Boolean; Virtual;
GetRealMsgNumnull247 Function GetRealMsgNum: LongInt; Virtual;
GetIDnull248 function GetID: Byte; virtual;
249 End;
250
251 Type HudsonMsgPtr = ^HudsonMsgObj;
252
253 Implementation
254
255 Uses
256 MKFile, MKString {, Global};
257
258
HudsonMsgObj.GetIDnull259 function HudsonMsgObj.GetID: Byte;
260 begin
261 GetID:=msgHudson;
262 end;
263
264 Constructor HudsonMsgObj.Init;
265 Begin
266 New(MsgRec);
267 New(MsgChars);
268 New(SeekArray);
269 If ((MsgRec = Nil) Or (MsgChars = Nil) or (SeekArray = Nil)) Then
270 Begin
271 If MsgRec <> Nil Then
272 Dispose(MsgRec);
273 If MsgChars <> Nil Then
274 Dispose(MsgChars);
275 If SeekArray <> Nil Then
276 Dispose(SeekArray);
277 Fail;
278 Exit;
279 End;
280 MsgRec^.MsgPath := '';
281 MsgRec^.Opened := False;
282 MsgRec^.Locked := False;
283 MsgRec^.Error := 0;
284 End;
285
286
287 Destructor HudsonMsgObj.Done;
288 Begin
289 Dispose(MsgRec);
290 Dispose(MsgChars);
291 Dispose(SeekArray);
292 End;
293
294
295 procedure HudsonMsgObj.InitMsgHdr;
296 begin
297 Seek(MsgRec^.MsgHdrFile, MsgRec^.MsgPos);
298 MsgRec^.OrigPoint := 0;
299 MsgRec^.DestPoint := 0;
300 BlockRead(MsgRec^.MsgHdrFile, MsgRec^.MsgHdr, 1);
301 MsgRec^.Error := IOResult;
302 end;
303
304
305 Procedure HudsonMsgObj.SetMsgAttr(Setting: Boolean; Mask: Word);
306 Begin
307 If Setting Then
308 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr or Mask
309 Else
310 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr and (Not Mask);
311 End;
312
313
314
315 Procedure HudsonMsgObj.SetRcvd(RS: Boolean);
316 Begin
317 SetMsgAttr(RS, maRcvd);
318 End;
319
320
321 Procedure HudsonMsgObj.SetPriv(PS: Boolean);
322 Begin
323 SetMsgAttr(PS, maPriv);
324 End;
325
326
327 Procedure HudsonMsgObj.SetNetAttr(Setting: Boolean; Mask: Word);
328 Begin
329 If Setting Then
330 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr Or Mask
331 Else
332 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr And (Not Mask);
333 End;
334
335
336 Procedure HudsonMsgObj.SetSeeAlso(SAlso: LongInt);
337 Begin
338 MsgRec^.MsgHdr.SeeAlso := SAlso;
339 End;
340
341
342 Procedure HudsonMsgObj.SetFrom(Name: String); {Set msg from}
343 Begin
344 MsgRec^.MsgHdr.MsgFrom := Name;
345 End;
346
347
348 Procedure HudsonMsgObj.SetTo(Name: String); {Set msg to}
349 Begin
350 MsgRec^.MsgHdr.MsgTo := Name;
351 End;
352
353
354 Procedure HudsonMsgObj.SetSubj(Str: String); {Set msg subject}
355 Begin
356 MsgRec^.MsgHdr.Subj := Str;
357 End;
358
359
HudsonMsgObj.GetFromnull360 Function HudsonMsgObj.GetFrom: String;
361 Begin
362 GetFrom := MsgRec^.MsgHdr.MsgFrom;
363 End;
364
365
HudsonMsgObj.GetTonull366 Function HudsonMsgObj.GetTo: String;
367 Begin
368 GetTo := MsgRec^.MsgHdr.MsgTo;
369 End;
370
371
HudsonMsgObj.GetSubjnull372 Function HudsonMsgObj.GetSubj: String;
373 Begin
374 GetSubj := MsgRec^.MsgHdr.Subj;
375 End;
376
377
HudsonMsgObj.GetCostnull378 Function HudsonMsgObj.GetCost: Word;
379 Begin
380 GetCost := MsgRec^.MsgHdr.Cost;
381 End;
382
383
HudsonMsgObj.GetDatenull384 Function HudsonMsgObj.GetDate: String; {Get date of current msg}
385 Begin
386 GetDate := MsgRec^.MsgHdr.Date;
387 End;
388
389
HudsonMsgObj.GetTimenull390 Function HudsonMsgObj.GetTime: String; {Get time of current msg}
391 Begin
392 GetTime := MsgRec^.MsgHdr.Time;
393 End;
394
395
HudsonMsgObj.GetRefernull396 Function HudsonMsgObj.GetRefer: LongInt;
397 Begin
398 GetRefer := MsgRec^.MsgHdr.ReplyTo;
399 End;
400
401
HudsonMsgObj.GetSeeAlsonull402 Function HudsonMsgObj.GetSeeAlso: LongInt;
403 Begin
404 GetSeeAlso := MsgRec^.MsgHdr.SeeAlso;
405 End;
406
407
HudsonMsgObj.GetMsgNumnull408 Function HudsonMsgObj.GetMsgNum: LongInt;
409 Begin
410 InitMsgHdr;
411 GetMsgNum := MsgRec^.MsgHdr.MsgNum;
412 End;
413
414
415 Procedure HudsonMsgObj.GetOrig(Var Addr: AddrType);
416 Begin
417 Addr.Zone := MsgRec^.MsgHdr.OrigZone;
418 Addr.Net := MsgRec^.MsgHdr.OrigNet;
419 Addr.Node := MsgRec^.MsgHdr.OrigNode;
420 Addr.Point := MsgRec^.OrigPoint;
421 Addr.Domain := '';
422 End;
423
424
425 Procedure HudsonMsgObj.GetDest(Var Addr: AddrType);
426 Begin
427 Addr.Zone := MsgRec^.MsgHdr.DestZone;
428 Addr.Net := MsgRec^.MsgHdr.DestNet;
429 Addr.Node := MsgRec^.MsgHdr.DestNode;
430 Addr.Point := MsgRec^.DestPoint;
431 Addr.Domain := '';
432 End;
433
434
HudsonMsgObj.IsLocalnull435 Function HudsonMsgObj.IsLocal: Boolean;
436 Begin
437 IsLocal := ((MsgRec^.MsgHdr.MsgAttr and maLocal) <> 0);
438 End;
439
440
HudsonMsgObj.IsCrashnull441 Function HudsonMsgObj.IsCrash: Boolean;
442 Begin
443 IsCrash := ((MsgRec^.MsgHdr.NetAttr and naCrash) <> 0);
444 End;
445
446
HudsonMsgObj.IsKillSentnull447 Function HudsonMsgObj.IsKillSent: Boolean;
448 Begin
449 IsKillSent := ((MsgRec^.MsgHdr.NetAttr and naKillSent) <> 0);
450 End;
451
452
HudsonMsgObj.IsSentnull453 Function HudsonMsgObj.IsSent: Boolean;
454 Begin
455 IsSent := ((MsgRec^.MsgHdr.NetAttr and naSent) <> 0);
456 End;
457
458
HudsonMsgObj.IsFAttachnull459 Function HudsonMsgObj.IsFAttach: Boolean;
460 Begin
461 IsFAttach := ((MsgRec^.MsgHdr.NetAttr and naFAttach) <> 0);
462 End;
463
464
HudsonMsgObj.IsReqRctnull465 Function HudsonMsgObj.IsReqRct: Boolean;
466 Begin
467 IsReqRct := ((MsgRec^.MsgHdr.NetAttr and naReqRcpt) <> 0);
468 End;
469
470
HudsonMsgObj.IsReqAudnull471 Function HudsonMsgObj.IsReqAud: Boolean;
472 Begin
473 IsReqAud := ((MsgRec^.MsgHdr.NetAttr and naReqAudit) <> 0);
474 End;
475
476
HudsonMsgObj.IsRetRctnull477 Function HudsonMsgObj.IsRetRct: Boolean;
478 Begin
479 IsRetRct := ((MsgRec^.MsgHdr.NetAttr and naRetRcpt) <> 0);
480 End;
481
482
HudsonMsgObj.IsFileReqnull483 Function HudsonMsgObj.IsFileReq: Boolean;
484 Begin
485 IsFileReq := ((MsgRec^.MsgHdr.NetAttr and naFileReq) <> 0);
486 End;
487
488
HudsonMsgObj.IsRcvdnull489 Function HudsonMsgObj.IsRcvd: Boolean;
490 Begin
491 IsRcvd := ((MsgRec^.MsgHdr.MsgAttr and maRcvd) <> 0);
492 End;
493
494
HudsonMsgObj.IsPrivnull495 Function HudsonMsgObj.IsPriv: Boolean;
496 Begin
497 IsPriv := ((MsgRec^.MsgHdr.MsgAttr and maPriv) <> 0);
498 End;
499
500
HudsonMsgObj.IsDeletednull501 Function HudsonMsgObj.IsDeleted: Boolean;
502 Begin
503 IsDeleted := ((MsgRec^.MsgHdr.MsgAttr and maDeleted) <> 0);
504 End;
505
506
HudsonMsgObj.IsEchoednull507 Function HudsonMsgObj.IsEchoed: Boolean;
508 Begin
509 IsEchoed := MsgRec^.Echo;
510 { IsEchoed := ((MsgRec^.MsgHdr.MsgAttr and maUnmovedEcho) <> 0); }
511 { IsUnmovedNet := ((MsgRec^.MsgHdr.MsgAttr and maUnmovedNet) <> 0);}
512 End;
513
514
515 Procedure HudsonMsgObj.MsgTxtStartUp;
516 Var
517 {$IFDEF VirtualPascal}
518 NumRead: LongInt;
519 {$ELSE}
520 NumRead: Word;
521 {$ENDIF}
522 MaxTxt: Word;
523
524 Begin
525 Wrapped := False;
526 If MsgRec^.MsgHdr.NumRecs > TxtSize Then
527 MaxTxt := TxtSize
528 Else
529 MaxTxt := MsgRec^.MsgHdr.NumRecs;
530 Seek(MsgRec^.MsgTxtFile, MsgRec^.MsgHdr.StartRec);
531 If IoResult <> 0 Then
532 MsgRec^.Error := 2222;
533 If not shRead(MsgRec^.MsgTxtFile, MsgChars^, MaxTxt, NumRead) Then
534 MsgRec^.Error := MKFileError;
535 If NumRead <> MaxTxt Then
536 MsgRec^.Error := 1111;
537 MsgRec^.CurrTxtRec := 1;
538 MsgRec^.CurrTxtPos := 1;
539 EOM := False;
540 End;
541
542
HudsonMsgObj.NextCharnull543 Function HudsonMsgObj.NextChar(Var Rec: Word; Var PPos: Word): Boolean;
544 Var
545 MoreNext: Boolean;
546
547 Begin
548 MoreNext := True;
549 NextChar := True;
550 While MoreNext Do
551 Begin
552 If ((Rec > MsgRec^.MsgHdr.NumRecs) or (Rec > TxtSize)) Then
553 MoreNext := False
554 Else
555 Begin
556 If (PPos > Length(MsgChars^[Rec])) Then
557 Begin
558 Inc(Rec);
559 PPos := 1;
560 End
561 Else
562 MoreNext := False;
563 End;
564 End;
565 If ((Rec > MsgRec^.MsgHdr.NumRecs) or (Rec > TxtSize)) Then
566 NextChar := False;
567 End;
568
569
HudsonMsgObj.GetCharnull570 Function HudsonMsgObj.GetChar: Char;
571 Var
572 MoreNext: Boolean;
573
574 Begin
575 MoreNext := True;
576 If ((MsgRec^.CurrTxtRec <= MsgRec^.MsgHdr.NumRecs) and
577 (MsgRec^.CurrTxtRec <= TxtSize)) Then
578 Begin
579 While MoreNext Do
580 Begin
581 If ((MsgRec^.CurrTxtRec > MsgRec^.MsgHdr.NumRecs) Or
582 (MsgRec^.CurrTxtRec > TxtSize)) Then
583 MoreNext := False
584 Else
585 Begin
586 If (MsgRec^.CurrTxtPos > Length(MsgChars^[MsgRec^.CurrTxtRec])) Then
587 Begin
588 Inc(MsgRec^.CurrTxtRec);
589 MsgRec^.CurrTxtPos := 1;
590 End
591 Else
592 MoreNext := False;
593 End;
594 End;
595 If ((MsgRec^.CurrTxtRec > MsgRec^.MsgHdr.NumRecs) Or
596 (MsgRec^.CurrTxtRec > TxtSize)) Then
597 EOM := True;
598 End
599 Else
600 EOM := True;
601 If EOM Then
602 Begin
603 GetChar := #0;
604 End
605 Else
606 GetChar := MsgChars^[MsgRec^.CurrTxtRec][MsgRec^.CurrTxtPos];
607 Inc(MsgRec^.CurrTxtPos);
608 End;
609
610
611 Procedure HudsonMsgObj.StartNewMsg; {Initialize message}
612 Const
613 Blank = '* Blank *';
614
615 Begin
616 MsgRec^.CurrTxtRec := 1;
617 MsgRec^.CurrTxtPos := 0;
618 FillChar(MsgRec^.MsgHdr, SizeOf(MsgRec^.MsgHdr), #0);
619 MsgRec^.Echo := False;
620 MsgRec^.MsgHdr.Time := '00:00';
621 MsgRec^.MsgHdr.Date := '00-00-00';
622 MsgRec^.MsgHdr.MsgTo := Blank;
623 MsgRec^.MsgHdr.MsgFrom := Blank;
624 MsgRec^.MsgHdr.Subj := Blank;
625 MsgRec^.CRLast := True;
626 End;
627
628
629 Procedure HudsonMsgObj.SetEcho(ES: Boolean); {Set echo status}
630 Begin
631 MsgRec^.Echo := ES;
632 End;
633
634
635 Procedure HudsonMsgObj.SetLocal(LS: Boolean); {Set local status}
636 Begin
637 If LS Then
638 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr or maLocal
639 Else
640 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.Msgattr and (Not maLocal);
641 End;
642
643
644 Procedure HudsonMsgObj.SetCrash(SS: Boolean); {Set crash netmail status}
645 Begin
646 If SS Then
647 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naCrash
648 Else
649 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naCrash);
650 End;
651
652
653 Procedure HudsonMsgObj.SetKillSent(SS: Boolean); {Set kill/sent netmail status}
654 Begin
655 If SS Then
656 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naKillSent
657 Else
658 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naKillSent);
659 End;
660
661
662
663 Procedure HudsonMsgObj.SetSent(SS: Boolean); {Set sent netmail status}
664 Begin
665 If SS Then
666 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naSent
667 Else
668 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naSent);
669 End;
670
671
672
673 Procedure HudsonMsgObj.SetFAttach(SS: Boolean); {Set file attach status}
674 Begin
675 If SS Then
676 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naFAttach
677 Else
678 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naFAttach);
679 End;
680
681
682
683 Procedure HudsonMsgObj.SetReqRct(SS: Boolean); {Set request receipt status}
684 Begin
685 If SS Then
686 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naReqRcpt
687 Else
688 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naReqRcpt);
689 End;
690
691
692
693 Procedure HudsonMsgObj.SetReqAud(SS: Boolean); {Set request audit status}
694 Begin
695 If SS Then
696 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naReqAudit
697 Else
698 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naReqAudit);
699 End;
700
701
702
703 Procedure HudsonMsgObj.SetRetRct(SS: Boolean); {Set return receipt status}
704 Begin
705 If SS Then
706 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naRetRcpt
707 Else
708 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naRetRcpt);
709 End;
710
711
712
713 Procedure HudsonMsgObj.SetFileReq(SS: Boolean); {Set file request status}
714 Begin
715 If SS Then
716 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr or naFileReq
717 Else
718 MsgRec^.MsgHdr.NetAttr := MsgRec^.MsgHdr.NetAttr and (Not naFileReq);
719 End;
720
721
722 Procedure HudsonMsgObj.SetCost(SCost: Word); {Set message cost}
723 Begin
724 MsgRec^.MsgHdr.Cost := SCost;
725 End;
726
727
728 Procedure HudsonMsgObj.SetRefer(SRefer: LongInt); {Set message reference}
729 Begin
730 MsgRec^.MsgHdr.ReplyTo := SRefer;
731 End;
732
733
734 Procedure HudsonMsgObj.SetDate(SDate: String); {Set message date}
735 Begin
736 MsgRec^.MsgHdr.Date := Copy(PadLeft(SDate,'0',8),1,8);
737 MsgRec^.MsgHdr.Date[3] := '-';
738 MsgRec^.MsgHdr.Date[6] := '-';
739 End;
740
741
742 Procedure HudsonMsgObj.SetTime(STime: String); {Set message time}
743 Begin
744 MsgRec^.MsgHdr.Time := Copy(PadLeft(STime,'0',5),1,5);
745 MsgRec^.MsgHdr.Time[3] := ':';
746 End;
747
748
749
750 Procedure HudsonMsgObj.DoString(Str: String); {Add string to message text}
751 Var
752 i: Word;
753
754 Begin
755 i := 1;
756 While i <= Length(Str) Do
757 Begin
758 DoChar(Str[i]);
759 Inc(i);
760 End;
761 End;
762
763
764 Procedure HudsonMsgObj.DoChar(Ch: Char); {Add character to message text}
765 Begin
766 If (MsgRec^.CurrTxtRec < TxtSize) or (MsgRec^.CurrTxtPos < 255) Then
767 Begin
768 If MsgRec^.CurrTxtPos = 255 Then
769 Begin
770 MsgChars^[MsgRec^.CurrTxtRec][0] := Chr(255);
771 Inc(MsgRec^.CurrTxtRec);
772 MsgRec^.CurrTxtPos := 0;
773 End;
774 Case CH of
775 #$0D: MsgRec^.CRLast := True;
776 #$0A:;
777 #$8D:;
778 Else
779 MsgRec^.CRLast := False;
780 End;
781 Inc(MsgRec^.CurrTxtPos);
782 MsgChars^[MsgRec^.CurrTxtRec][MsgRec^.CurrTxtPos] := Ch;
783 End;
784 End;
785
786
787
788 Procedure HudsonMsgObj.DoStringLn(Str: String); {Add string and newline to msg text}
789 Begin
790 DoString(Str);
791 DoChar(#13);
792 End;
793
794
HudsonMsgObj.WriteMsgnull795 Function HudsonMsgObj.WriteMsg: Word;
796 Var
797 WriteError: Word;
798 MsgPos: Word;
799 MsgIdx: MsgIdxType;
800 FN: String[13];
801 AlreadyLocked: Boolean;
802
803 Begin
804 If FileSize(MsgRec^.MsgTxtFile) > $ff00 Then
805 WriteError := 99
806 Else
807 WriteError := 0;
808 If Not MsgRec^.CRLast Then
809 DoChar(#$0D);
810 MsgRec^.MsgHdr.NumRecs := MsgRec^.CurrTxtRec;
811 MsgChars^[MsgRec^.CurrTxtRec][0] := Chr(MsgRec^.CurrTxtPos);
812 Case MsgRec^.MT of
813 mmtNormal: Begin
814 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr and
815 Not(maNetMail + maUnmovedNet + maUnmovedEcho);
816 End;
817 mmtEchoMail: Begin
818 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr and
819 Not(maNetMail + maUnmovedNet);
820 If MsgRec^.Echo Then
821 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr or maUnmovedEcho;
822 End;
823 mmtNetMail: Begin
824 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr and Not(maUnmovedEcho);
825 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr or maNetMail;
826 If MsgRec^.Echo Then
827 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr or maUnmovedNet;
828 End;
829 End;
830 MsgRec^.MsgHdr.Area := MsgRec^.Area;
831 AlreadyLocked := MsgRec^.Locked;
832 If Not AlreadyLocked Then
833 If Not LockMsgBase Then
834 WriteError := 5;
835 If WriteError = 0 Then
836 WriteError := SeekEnd;
837 If WriteError = 0 Then {Write MsgHdr}
838 Begin
839 MsgRec^.MsgHdr.StartRec := FileSize(MsgRec^.MsgTxtFile);
840 MsgPos := FileSize(MsgRec^.MsgHdrFile);
841 Inc(MsgRec^.MsgInfo.HighMsg);
842 MsgRec^.MsgHdr.MsgNum := MsgRec^.MsgInfo.HighMsg;
843 Inc(MsgRec^.MsgInfo.Active);
844 Inc(MsgRec^.MsgInfo.AreaActive[MsgRec^.MsgHdr.Area]);
845 If Not shWrite(MsgRec^.MsgHdrFile, MsgRec^.MsgHdr, 1)
846 Then WriteError := MKFileError;
847 End;
848 If WriteError = 0 Then
849 If Not shWrite(MsgRec^.MsgToIdxFile, MsgRec^.MsgHdr.MsgTo, 1) Then
850 WriteError := MKFileError;
851 If WriteError = 0 Then {Write MsgIdx}
852 Begin
853 MsgIdx.MsgNum := MsgRec^.MsgHdr.MsgNum;
854 MsgIdx.Area := MsgRec^.MsgHdr.Area;
855 If Not shWrite(MsgRec^.MsgIdxFile, MsgIdx, 1) Then
856 WriteError := MKFileError;
857 End;
858 If WriteError = 0 Then {Write MsgTxt}
859 Begin
860 If Not shWrite(MsgRec^.MsgTxtFile, MsgChars^, MsgRec^.MsgHdr.NumRecs) Then
861 WriteError := MKFileError;
862 End;
863 If WriteError = 0 Then
864 Begin
865 Case MsgRec^.MT of
866 mmtEchoMail: FN := 'ECHOMAIL.BBS';
867 mmtNetMail: FN := 'NETMAIL.BBS';
868 Else
869 FN := '';
870 End; {Case MsgType}
871 (* If ((Length(FN) > 0) and MsgRec^.Echo) Then
872 WriteError := WriteMailIdx(Cfg.JAMPath+FN, MsgPos); *)
873 End;
874 If WriteError = 0 Then
875 If Not AlreadyLocked Then
876 If Not UnlockMsgBase Then
877 WriteError := 5;
878 If ((WriteError = 0) and (HudsonFlushing)) Then
879 Begin
880 FlushFile(MsgRec^.MsgInfoFile);
881 FlushFile(MsgRec^.MsgTxtFile);
882 FlushFile(MsgRec^.MsgHdrFile);
883 FlushFile(MsgRec^.MsgInfoFile);
884 FlushFile(MsgRec^.MsgToIdxFile);
885 FlushFile(MsgRec^.MsgIdxFile);
886 End;
887 MsgRec^.MsgPos := MsgPos;;
888 WriteMsg := WriteError;
889 End;
890
891
892 Procedure HudsonMsgObj.SetDest(Var Addr: AddrType); {Set Zone/Net/Node/Point for Dest}
893 Begin
894 MsgRec^.MsgHdr.DestZone := Lo(Addr.Zone);
895 MsgRec^.MsgHdr.DestNet := Addr.Net;
896 MsgRec^.MsgHdr.DestNode := Addr.Node;
897 MsgRec^.DestPoint := Addr.Point;
898 If ((MsgRec^.DestPoint <> 0) and (MsgRec^.Mt = mmtNetMail)) Then
899 DoStringLn(#1 + 'TOPT ' + Long2Str(MsgRec^.DestPoint));
900 End;
901
902
903 Procedure HudsonMsgObj.SetOrig(Var Addr: AddrType); {Set Zone/Net/Node/Point for Orig}
904 Begin
905 MsgRec^.MsgHdr.OrigZone := Lo(Addr.Zone);
906 MsgRec^.MsgHdr.OrigNet := Addr.Net;
907 MsgRec^.MsgHdr.OrigNode := Addr.Node;
908 MsgRec^.OrigPoint := Addr.Point;
909 If ((MsgRec^.OrigPoint <> 0) and (MsgRec^.Mt = mmtNetmail)) Then
910 DoStringLn(#1 + 'FMPT ' + Long2Str(MsgRec^.OrigPoint));
911 End;
912
913
914
915 Procedure HudsonMsgObj.SetMsgPath(MP: String);
916 Var
917 s: String;
918
919 Begin
920 MsgRec^.Area := Str2Long(Copy(MP,1,3));
921 s := Copy(MP,4,60);
922 s := AddDirSep(s);
923 MsgRec^.MsgPath := s;
924 shAssign(MsgRec^.MsgIdxFile, MsgRec^.MsgPath + 'MSGIDX.BBS');
925 shAssign(MsgRec^.MsgToIdxFile, MsgRec^.MsgPath + 'MSGTOIDX.BBS');
926 shAssign(MsgRec^.MsgHdrFile, MsgRec^.MsgPath + 'MSGHDR.BBS');
927 shAssign(MsgRec^.MsgTxtFile, MsgRec^.MsgPath + 'MSGTXT.BBS');
928 shAssign(MsgRec^.MsgInfoFile, MsgRec^.MsgPath + 'MSGINFO.BBS');
929 End;
930
931
HudsonMsgObj.LockMsgBasenull932 Function HudsonMsgObj.LockMsgBase: Boolean; {Lock msg base prior to adding message}
933 Var
934 LockError: Word;
935 {$IFDEF VirtualPascal}
936 NumRead: LongInt;
937 {$ELSE}
938 NumRead: Word;
939 {$ENDIF}
940
941 Begin
942 LockError := 0;
943 If Not MsgRec^.Locked Then
944 Begin
945 LockError := shLock(MsgRec^.MsgInfoFile,406,1);
946 If LockError = 1 Then
947 LockError := 0; {No Locking if share not loaded}
948 If LockError = 0 Then
949 Begin
950 Seek(MsgRec^.MsgInfoFile,0);
951 LockError := IoResult;
952 End;
953 If LockError = 0 Then
954 Begin
955 If Not shRead(MsgRec^.MsgInfoFile, MsgRec^.MsgInfo,1,NumRead) Then
956 LockError := MKFileError;
957 End;
958 End;
959 MsgRec^.Locked := (LockError = 0);
960 LockMsgBase := LockError = 0;
961 End;
962
963
HudsonMsgObj.UnlockMsgBasenull964 Function HudsonMsgObj.UnlockMsgBase: Boolean; {Unlock msg base after adding message}
965 Var
966 LockError: Word;
967
968 Begin
969 LockError := 0;
970 If MsgRec^.Locked Then
971 Begin
972 Seek(MsgRec^.MsgInfoFile,0);
973 LockError := IoResult;
974 shWrite(MsgRec^.MsgInfoFile, MsgRec^.MsgInfo,1);
975 If LockError = 0 Then
976 LockError := IoResult;
977 LockError := UnLockFile(MsgRec^.MsgInfoFile,406,1);
978 If LockError = 1 Then
979 LockError := 0; {No locking if share not loaded}
980 End;
981 MsgRec^.Locked := False;
982 UnlockMsgBase := LockError = 0;
983 End;
984
985
HudsonMsgObj.GetNumActivenull986 Function HudsonMsgObj.GetNumActive: Word;
987 Begin
988 GetNumActive := MsgRec^.MsgInfo.Active;
989 End;
990
991
HudsonMsgObj.GetHighMsgNumnull992 Function HudsonMsgObj.GetHighMsgNum: LongInt;
993 Begin
994 GetHighMsgNum := MsgRec^.MsgInfo.HighMsg;
995 End;
996
997
HudsonMsgObj.GetLowMsgNumnull998 Function HudsonMsgObj.GetLowMsgNum: LongInt;
999 Begin
1000 GetLowMsgNum := MsgRec^.MsgInfo.LowMsg;
1001 End;
1002
1003
HudsonMsgObj.CreateMsgBasenull1004 Function HudsonMsgObj.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
1005 Var
1006 CreateError: Word;
1007 i: Word;
1008
1009 Begin
1010 CreateError := 0;
1011 If Not MakePath(MsgRec^.MsgPath) Then
1012 CreateError := 1;
1013 ReWrite(MsgRec^.MsgIdxFile, SizeOf(MsgIdxType));
1014 If CreateError = 0 Then
1015 CreateError := IoResult;
1016 ReWrite(MsgRec^.MsgToIdxFile, SizeOf(MsgToIdxType));
1017 If CreateError = 0 Then
1018 CreateError := IoResult;
1019 ReWrite(MsgRec^.MsgHdrFile, SizeOf(MsgHdrType));
1020 If CreateError = 0 Then
1021 CreateError := IoResult;
1022 ReWrite(MsgRec^.MsgTxtFile, SizeOf(MsgTxtType));
1023 If CreateError = 0 Then
1024 CreateError := IoResult;
1025 ReWrite(MsgRec^.MsgInfoFile, SizeOf(MsgInfoType));
1026 If CreateError = 0 Then
1027 CreateError := IoResult;
1028 MsgRec^.MsgInfo.LowMsg := 1;
1029 MsgRec^.MsgInfo.HighMsg := 0;
1030 MsgRec^.MsgInfo.Active := 0;
1031 For i := 1 to 200 Do
1032 MsgRec^.MsgInfo.AreaActive[i] := 0;
1033 If Not shWrite(MsgRec^.MsgInfoFile, MsgRec^.MsgInfo, 1) Then
1034 CreateError := MKFileError;
1035 Close(MsgRec^.MsgInfoFile);
1036 If CreateError = 0 Then
1037 CreateError := IoResult;
1038 Close(MsgRec^.MsgIdxFile);
1039 If CreateError = 0 Then
1040 CreateError := IoResult;
1041 Close(MsgRec^.MsgToIdxFile);
1042 If CreateError = 0 Then
1043 CreateError := IoResult;
1044 Close(MsgRec^.MsgTxtFile);
1045 If CreateError = 0 Then
1046 CreateError := IoResult;
1047 Close(MsgRec^.MsgHdrFile);
1048 If CreateError = 0 Then
1049 CreateError := IoResult;
1050 CreateMsgBase := CreateError;
1051 End;
1052
1053
HudsonMsgObj.MsgBaseExistsnull1054 Function HudsonMsgObj.MsgBaseExists: Boolean;
1055 Begin
1056 MsgBaseExists := (Check <> 1);
1057 End;
1058
1059
1060
HudsonMsgObj.Checknull1061 Function HudsonMsgObj.Check: Word; {Check if msg base is Ok}
1062 { 0 = ok, 1 = not there (create), 2 = corrupted}
1063 Var
1064 BaseSize: LongInt;
1065 Status: Word;
1066
1067 Begin
1068 Status := 0;
1069 If (Not FileExist(MsgRec^.MsgPath + 'MSGINFO.BBS')) Then
1070 Status := 1;
1071 If (Not FileExist(MsgRec^.MsgPath + 'MSGHDR.BBS')) Then
1072 Begin
1073 If Status = 0 Then
1074 Status := 2;
1075 End
1076 Else
1077 Begin
1078 If Status = 1 Then
1079 Status := 2;
1080 End;
1081 If (Not FileExist(MsgRec^.MsgPath + 'MSGTXT.BBS')) Then
1082 Begin
1083 If Status = 0 Then
1084 Status := 2;
1085 End
1086 Else
1087 Begin
1088 If Status = 1 Then
1089 Status := 2;
1090 End;
1091 If (Not FileExist(MsgRec^.MsgPath + 'MSGIDX.BBS')) Then
1092 Begin
1093 If Status = 0 Then
1094 Status := 2;
1095 End
1096 Else
1097 Begin
1098 If Status = 1 Then
1099 Status := 2;
1100 End;
1101 If (Not FileExist(MsgRec^.MsgPath + 'MSGTOIDX.BBS')) Then
1102 Begin
1103 If Status = 0 Then
1104 Status := 2;
1105 End
1106 Else
1107 Begin
1108 If Status = 1 Then
1109 Status := 2;
1110 End;
1111 If Status = 0 Then
1112 Begin
1113 If SizeFile(MsgRec^.MsgPath + 'MSGINFO.BBS') <> SizeOf(MsgInfoType) Then
1114 Status := 2;
1115 End;
1116 If Status = 0 Then
1117 Begin
1118 BaseSize := SizeFile(MsgRec^.MsgPath + 'MSGHDR.BBS') Div SizeOf(MsgHdrType);
1119 If BaseSize <> (SizeFile(MsgRec^.MsgPath + 'MSGIDX.BBS') Div SizeOf(MsgIdxType)) Then
1120 Status := 2;
1121 If BaseSize <> (SizeFile(MsgRec^.MsgPath + 'MSGTOIDX.BBS') Div SizeOf(MsgToIdxType)) Then
1122 Status := 2;
1123 End;
1124 Check := Status;
1125 End;
1126
1127
1128
HudsonMsgObj.MsgBaseSizenull1129 Function HudsonMsgObj.MsgBaseSize:Word;
1130 Begin
1131 If Length(MsgRec^.MsgPath) > 0 Then
1132 Begin
1133 MsgBaseSize := FileSize(MsgRec^.MsgIdxFile);
1134 End
1135 Else
1136 MsgBaseSize := 0;
1137 End;
1138
1139
HudsonMsgObj.SeekEndnull1140 Function HudsonMsgObj.SeekEnd: Word; {Seek to end of Msg Base Files}
1141 Var
1142 SeekError: Word;
1143
1144 Begin
1145 SeekError := 0;
1146 Seek(MsgRec^.MsgIdxFile, FileSize(MsgRec^.MsgIdxFile));
1147 If SeekError = 0 Then
1148 SeekError := IoResult;
1149 Seek(MsgRec^.MsgToIdxFile, FileSize(MsgRec^.MsgToIdxFile));
1150 If SeekError = 0 Then
1151 SeekError := IoResult;
1152 Seek(MsgRec^.MsgTxtFile, FileSize(MsgRec^.MsgTxtFile));
1153 If SeekError = 0 Then
1154 SeekError := IoResult;
1155 Seek(MsgRec^.MsgHdrFile, FileSize(MsgRec^.MsgHdrFile));
1156 If SeekError = 0 Then
1157 SeekError := IoResult;
1158 SeekEnd := SeekError;
1159 End;
1160
1161
HudsonMsgObj.SeekMsgBasePosnull1162 Function HudsonMsgObj.SeekMsgBasePos(Position: Word): Word; {Seek to pos of Msg Base File}
1163 Var
1164 SeekError: Word;
1165 Begin
1166 Seek(MsgRec^.MsgIdxFile, Position);
1167 SeekError := IoResult;
1168 Seek(MsgRec^.MsgToIdxFile, Position);
1169 If SeekError = 0 Then
1170 SeekError := IoResult;
1171 Seek(MsgRec^.MsgHdrFile, Position);
1172 If SeekError = 0 Then
1173 SeekError := IoResult;
1174 SeekMsgBasePos := SeekError;
1175 End;
1176
1177
1178 (* Function HudsonMsgObj.WriteMailIdx(FN: String; MsgPos: Word): Word; {Write Netmail or EchoMail.Bbs}
1179 Var
1180 IdxFile: File;
1181 WriteError: Word;
1182 Begin
1183 WriteError := 0;
1184 shAssign(IdxFile, FN);
1185 FileMode := fmReadWrite + fmDenyNone;
1186 If FileExist(FN) Then Begin
1187 If Not shReset(IdxFile, SizeOf(MsgPos)) Then
1188 WriteError := MKFileError;
1189 End Else Begin
1190 ReWrite(IdxFile, SizeOf(MsgPos));
1191 WriteError := IoResult;
1192 End;
1193 If WriteError = 0 Then Begin
1194 Seek(IdxFile, FileSize(IdxFile));
1195 WriteError := IoResult;
1196 End;
1197 If WriteError = 0 Then Begin
1198 BlockWrite(IdxFile, MsgPos, 1);
1199 WriteError := IoResult;
1200 End;
1201 If WriteError = 0 Then Begin
1202 Close(IdxFile);
1203 WriteError := IoResult;
1204 End;
1205 WriteMailIdx := WriteError;
1206 End; *)
1207
HudsonMsgObj.OpenMsgBasenull1208 Function HudsonMsgObj.OpenMsgBase: Word; {Set path and initialize}
1209 Var
1210 OpenError: Word;
1211 CheckMode: Word;
1212 {$IFDEF VirtualPascal}
1213 NumRead: LongInt;
1214 {$ELSE}
1215 NumRead: Word;
1216 {$ENDIF}
1217
1218 Begin
1219 OpenError := 0;
1220 If Not MsgRec^.Opened Then
1221 Begin
1222 CheckMode := Check;
1223 If CheckMode = 1 Then
1224 Begin
1225 OpenError := CreateMsgBase(100,100);
1226 If OpenError = 0 Then
1227 CheckMode := 0;
1228 End;
1229 If CheckMode = 2 Then
1230 OpenError := 5000;
1231 If CheckMode = 0 Then
1232 Begin
1233 FileMode := fmReadWrite + fmDenyNone;
1234 If Not ShReset(MsgRec^.MsgIdxFile, SizeOf(MsgIdxType)) Then
1235 OpenError := MKFileError;
1236 FileMode := fmReadWrite + fmDenyNone;
1237 If Not shReset(MsgRec^.MsgToIdxFile, SizeOf(MsgToIdxType)) Then
1238 OpenError := MKFileError;
1239 FileMode := fmReadWrite + fmDenyNone;
1240 If Not shReset(MsgRec^.MsgTxtFile, SizeOf(MsgTxtType)) Then
1241 OpenError := MKFileError;
1242 FileMode := fmReadWrite + fmDenyNone;
1243 If Not shReset(MsgRec^.MsgHdrFile, SizeOf(MsgHdrType)) Then
1244 OpenError := MKFileError;
1245 FileMode := fmReadWrite + fmDenyNone;
1246 If Not shReset(MsgRec^.MsgInfoFile, SizeOf(MsgInfoType)) Then
1247 OpenError := MKFileError;
1248 End;
1249 End;
1250 If OpenError = 0 Then
1251 Begin
1252 If Not shRead(MsgRec^.MsgInfoFile, MsgRec^.MsgInfo,1,NumRead) Then
1253 OpenError := 1;
1254 End;
1255 MsgRec^.Opened := (OpenError = 0);
1256 OpenMsgBase := OpenError;
1257 End;
1258
1259
HudsonMsgObj.CloseMsgBasenull1260 Function HudsonMsgObj.CloseMsgBase: Word; {Close Msg Base Files}
1261 Var
1262 w, CloseError: Word;
1263
1264 Begin
1265 CloseError := 0;
1266 If MsgRec^.Opened Then
1267 Begin
1268 Close(MsgRec^.MsgIdxFile);
1269 If CloseError = 0 Then
1270 CloseError := IoResult;
1271 Close(MsgRec^.MsgToIdxFile);
1272 If CloseError = 0 Then
1273 CloseError := IoResult;
1274 Close(MsgRec^.MsgTxtFile);
1275 If CloseError = 0 Then
1276 CloseError := IoResult;
1277 Close(MsgRec^.MsgHdrFile);
1278 If CloseError = 0 Then
1279 CloseError := IoResult;
1280 Close(MsgRec^.MsgInfoFile);
1281 If CloseError = 0 Then
1282 CloseError := IoResult;
1283 End;
1284 w := IoResult;
1285 CloseMsgBase := CloseError;
1286 End;
1287
1288
1289 Procedure HudsonMsgObj.SeekRead(NumToRead: Word);
1290 Begin
1291 If NumToRead > SeekSize Then
1292 NumToRead := SeekSize;
1293 Seek(MsgRec^.MsgIdxFile, MsgRec^.SeekStart);
1294 If IoResult <> 0 Then;
1295 If Not shRead(MsgRec^.MsgIdxFile, SeekArray^, NumToRead , MsgRec^.SeekNumRead) Then
1296 MsgRec^.Error := 1000;
1297 End;
1298
1299
1300 Procedure HudsonMsgObj.SeekNext;
1301 begin
1302 repeat
1303 Inc(MsgRec^.SeekPos);
1304 if (MsgRec^.SeekPos > MsgRec^.SeekNumRead) then begin
1305 Inc(MsgRec^.SeekStart, MsgRec^.SeekNumRead);
1306 SeekRead(SeekSize);
1307 MsgRec^.SeekPos := 1;
1308 end;
1309 if MsgRec^.SeekNumRead = 0 then begin
1310 MsgRec^.SeekOver := True;
1311 break;
1312 end else begin
1313 if (MsgRec^.SeekPos > 0) And (MsgRec^.SeekPos <= MsgRec^.SeekNumRead) and
1314 (SeekArray^[MsgRec^.SeekPos].MsgNum <> $ffff) and
1315 (SeekArray^[MsgRec^.SeekPos].Area = MsgRec^.Area) then Inc(MsgRec^.RealMsgNum);
1316 if ((MsgRec^.SeekPos > 0) And (MsgRec^.SeekPos <= MsgRec^.SeekNumRead)) and
1317 (SeekArray^[MsgRec^.SeekPos].MsgNum > MsgRec^.CurrMsgNum) and
1318 (SeekArray^[MsgRec^.SeekPos].MsgNum <> $ffff) and
1319 (SeekArray^[MsgRec^.SeekPos].Area = MsgRec^.Area) then
1320 begin
1321 MsgRec^.CurrMsgNum := SeekArray^[MsgRec^.SeekPos].MsgNum;
1322 break;
1323 end;
1324 end;
1325 until false;
1326 MsgRec^.MsgPos := Word(MsgRec^.SeekStart + MsgRec^.SeekPos - 1);
1327 end;
1328
1329
1330 procedure HudsonMsgObj.SeekPrior;
1331 var
1332 SeekDec: Word;
1333 begin
1334 MsgRec^.SeekOver := False;
1335 repeat
1336 Dec(MsgRec^.SeekPos);
1337 if (MsgRec^.SeekPos < 1) then begin
1338 if MsgRec^.SeekStart = 0 then begin
1339 MsgRec^.SeekOver := True;
1340 break;
1341 end;
1342 if (MsgRec^.SeekStart < SeekSize) then
1343 SeekDec := MsgRec^.SeekStart
1344 else
1345 SeekDec := SeekSize;
1346 Dec(MsgRec^.SeekStart, SeekDec);
1347 if MsgRec^.SeekStart < 0 then MsgRec^.SeekStart := 0;
1348 SeekRead(SeekDec);
1349 MsgRec^.SeekPos := MsgRec^.SeekNumRead;
1350 end;
1351 if not MsgRec^.SeekOver then begin
1352 if (MsgRec^.SeekPos > 0) And (MsgRec^.SeekPos <= MsgRec^.SeekNumRead) and
1353 (SeekArray^[MsgRec^.SeekPos].MsgNum <> $ffff) and
1354 (SeekArray^[MsgRec^.SeekPos].Area = MsgRec^.Area) then Dec(MsgRec^.RealMsgNum);
1355 if ((SeekArray^[MsgRec^.SeekPos].MsgNum < MsgRec^.CurrMsgNum) and
1356 (SeekArray^[MsgRec^.SeekPos].MsgNum <> $ffff) and
1357 (SeekArray^[MsgRec^.SeekPos].Area = MsgRec^.Area) and
1358 (MsgRec^.SeekPos > 0) and (MsgRec^.SeekPos <= MsgRec^.SeekNumRead)) then begin
1359 MsgRec^.CurrMsgNum := SeekArray^[MsgRec^.SeekPos].MsgNum;
1360 break;
1361 end;
1362 end;
1363 until false;
1364 MsgRec^.MsgPos := Word(MsgRec^.SeekStart + MsgRec^.SeekPos);
1365 if MsgRec^.MsgPos>0 then dec(MsgRec^.MsgPos);
1366 end;
1367
1368
HudsonMsgObj.SeekFoundnull1369 Function HudsonMsgObj.SeekFound:Boolean; {Seek has been completed}
1370 Begin
1371 SeekFound := Not MsgRec^.SeekOver;
1372 End;
1373
1374
1375 Procedure HudsonMsgObj.SeekFirst(MsgNum: LongInt);
1376 Begin
1377 MsgRec^.SeekStart := 0;
1378 MsgRec^.SeekNumRead := 0;
1379 MsgRec^.SeekPos := 0;
1380 MsgRec^.SeekOver := False;
1381 MsgRec^.RealMsgNum := 0;
1382 SeekRead(SeekSize);
1383 if msgnum=0 then
1384 MsgRec^.CurrMsgNum := 0
1385 else
1386 MsgRec^.CurrMsgNum := MsgNum - 1;
1387 SeekNext;
1388 End;
1389
1390
1391 Procedure HudsonMsgObj.SetMailType(MT: MsgMailType);
1392 Begin
1393 MsgRec^.MT := MT;
1394 End;
1395
1396
HudsonMsgObj.GetSubAreanull1397 Function HudsonMsgObj.GetSubArea: Word;
1398 Begin
1399 GetSubArea := MsgRec^.MsgHdr.Area;
1400 End;
1401
1402
1403 Procedure HudsonMsgObj.ReWriteHdr;
1404 Var
1405 NumRead: Word;
1406 RcvdName: String[35];
1407 MsgError: Word;
1408 MsgIdx: MsgIdxType;
1409
1410 Begin
1411 MsgError := SeekMsgBasePos(MsgRec^.MsgPos);
1412 If IsRcvd Then
1413 RcvdName := '* Received *'
1414 Else
1415 RcvdName := MsgRec^.MsgHdr.MsgTo;
1416 If IsDeleted Then
1417 Begin
1418 RcvdName := '* Deleted *';
1419 MsgIdx.MsgNum := $ffff;
1420 End
1421 Else
1422 MsgIdx.MsgNum := MsgRec^.MsgHdr.MsgNum;
1423 If MsgError = 0 Then
1424 Begin
1425 If not shWrite(MsgRec^.MsgHdrFile, MsgRec^.MsgHdr,1) Then
1426 MsgError := MKFileError;
1427 End;
1428 If MsgError = 0 Then
1429 Begin
1430 If Not shWrite(MsgRec^.MsgToIdxFile, RcvdName, 1) Then
1431 MsgError := MKFileError;
1432 End;
1433 MsgIdx.Area := MsgRec^.MsgHdr.Area;
1434 If MsgError = 0 Then
1435 Begin
1436 If not shWrite(MsgRec^.MsgIdxFile, MsgIdx,1) Then
1437 MsgError := MKFileError;
1438 End;
1439 End;
1440
1441
1442 Procedure HudsonMsgObj.DeleteMsg;
1443 Var
1444 {$IFDEF VirtualPascal}
1445 NumRead: LongInt;
1446 {$ELSE}
1447 NumRead: Word;
1448 {$ENDIF}
1449 RcvdName: String[35];
1450 MsgIdx: MsgIdxType;
1451 MsgError: Word;
1452
1453 Begin
1454 MsgIdx.Area := MsgRec^.MsgHdr.Area;
1455 If LockMsgBase Then
1456 MsgError := 0
1457 Else
1458 MsgError := 5;
1459 If MsgError = 0 Then
1460 MsgError := SeekMsgBasePos(MsgRec^.MsgPos);
1461 If MsgError = 0 Then
1462 Begin
1463 If not shRead(MsgRec^.MsgHdrFile, MsgRec^.MsgHdr,1, NumRead) Then
1464 MsgError := MKFileError;
1465 End;
1466 If ((MsgRec^.MsgHdr.MsgAttr and maDeleted) = 0) Then
1467 Begin
1468 Dec(MsgRec^.MsgInfo.Active);
1469 Dec(MsgRec^.MsgInfo.AreaActive[MsgRec^.MsgHdr.Area]);
1470 End;
1471 MsgRec^.MsgHdr.MsgAttr := MsgRec^.MsgHdr.MsgAttr Or maDeleted;
1472 RcvdName := '* Deleted *';
1473 MsgIdx.MsgNum := $ffff;
1474 If MsgError = 0 Then
1475 MsgError := SeekMsgBasePos(MsgRec^.MsgPos);
1476 If MsgError = 0 Then
1477 Begin
1478 If not shWrite(MsgRec^.MsgHdrFile, MsgRec^.MsgHdr,1) Then
1479 MsgError := MKFileError;
1480 End;
1481 If MsgError = 0 Then
1482 If Not shWrite(MsgRec^.MsgToIdxFile, RcvdName, 1) Then
1483 MsgError := MKFileError;
1484 If MsgError = 0 Then
1485 If Not shWrite(MsgRec^.MsgIdxFile, MsgIdx, 1) Then
1486 MsgError := MKFileError;
1487 If MsgError = 0 Then
1488 If Not UnLockMsgBase Then
1489 MsgError := 5;
1490 End;
1491
1492
HudsonMsgObj.GetMsgLocnull1493 Function HudsonMsgObj.GetMsgLoc: LongInt;
1494 Begin
1495 GetMsgLoc := MsgRec^.MsgPos;
1496 End;
1497
1498
1499 Procedure HudsonMsgObj.SetMsgLoc(ML: LongInt);
1500 Begin
1501 MsgRec^.MsgPos := ML;
1502 End;
1503
1504
HudsonMsgObj.NumberOfMsgsnull1505 Function HudsonMsgObj.NumberOfMsgs: LongInt;
1506 Var
1507 TmpInfo : Word;
1508 f: file;
1509
1510 Begin
1511 if ioresult<>0 then;
1512 assign(f,MsgRec^.MsgPath+'MsgInfo.Bbs');
1513 FileMode := fmReadOnly + fmDenyNone;
1514 reset(f,1);
1515 FileMode:=fmReadWrite;
1516 seek(f,6+pred(MsgRec^.Area)*sizeof(TmpInfo));
1517 blockread(f,TmpInfo,Sizeof(TmpInfo));
1518 close(f);
1519 if ioresult<>0 then NumberOfMsgs:=0 else NumberOfMsgs:=TmpInfo;
1520 End;
1521
1522
HudsonMsgObj.GetLastReadnull1523 function HudsonMsgObj.GetLastRead: LongInt;
1524 var
1525 LRec : Word;
1526 f : file;
1527 begin
1528 if ioresult <> 0 then;
1529 FileMode := fmReadOnly or fmDenyNone;
1530 Assign(f, MsgRec^.MsgPath + HudsonLastRead);
1531 Reset(f, 1);
1532 Seek(f, ((MsgRec^.Area - 1) * Sizeof(LRec)));
1533 Blockread(f, LRec, Sizeof(LRec));
1534 close(f);
1535 if ioresult <> 0 then
1536 GetLastRead := 0
1537 else
1538 GetLastRead := LRec;
1539 end;
1540
1541 procedure HudsonMsgObj.SetLastRead(LR: LongInt);
1542 type
1543 TBuf = array[1..4000] of byte;
1544 var
1545 LRec : Word;
1546 Num : Word;
1547 Buf : ^TBuf;
1548 f : file;
1549 begin
1550 if ioresult <> 0 then;
1551 New(Buf);
1552 fillchar(Buf^, sizeof(Buf^), 0);
1553 LRec := LR;
1554 FileMode := fmReadWrite or fmDenyNone;
1555 Assign(f, MsgRec^.MsgPath + HudsonLastRead);
1556 Reset(f, 1);
1557 if ioresult <> 0 then Rewrite(f, 1);
1558 if 1 * Sizeof(LastReadType) > FileSize(f) then
1559 begin
1560 Seek(f, Filesize(f));
1561 while (Sizeof(LastReadType) > FileSize(f)) and (ioresult = 0) do
1562 begin
1563 Num := (Sizeof(LastReadType)) - FileSize(f);
1564 if Num > 4000 then Num := 4000;
1565 Blockwrite(f, Buf^, Num);
1566 end;
1567 end;
1568 Seek(f, ((MsgRec^.Area - 1) * Sizeof(LRec)));
1569 Blockwrite(f, LRec, Sizeof(LRec));
1570 Close(f);
1571 if ioresult <> 0 then;
1572 Dispose(Buf);
1573 end;
1574
1575 Procedure HudsonMsgObj.GetHighest(Var LR: LastReadType);
1576 Var
1577 i: Word;
1578 IdxFile: File;
1579 MIdx: ^SeekArrayType;
1580 {$IFDEF VirtualPascal}
1581 NumRead: LongInt;
1582 {$ELSE}
1583 NumRead: Word;
1584 {$ENDIF}
1585
1586 Begin
1587 New(MIdx);
1588 For i := 1 to 200 Do
1589 LR[i] := 0;
1590 Assign(IdxFile, MsgRec^.MsgPath + 'MsgIdx.Bbs');
1591 FileMode := fmReadOnly + fmDenyNone;
1592 If shReset(IdxFile, SizeOf(MsgIdxType)) Then;
1593 While Not(Eof(IdxFile)) Do
1594 Begin
1595 If shRead(IdxFile, MIdx^, SeekSize, NumRead) Then;
1596 i := 1;
1597 While i <= NumRead Do
1598 Begin
1599 If MIdx^[i].MsgNum <> $ffff Then
1600 Begin
1601 If MIdx^[i].MsgNum > LR[MIdx^[i].Area] Then
1602 LR[MIdx^[i].Area] := MIdx^[i].MsgNum;
1603 End;
1604 Inc(i);
1605 End;
1606 End;
1607 Close(IdxFile);
1608 If IoResult <> 0 Then;
1609 Dispose(MIdx);
1610 End;
1611
1612
HudsonMsgObj.GetTxtPosnull1613 Function HudsonMsgObj.GetTxtPos: LongInt;
1614 Var
1615 Tmp: LongInt;
1616
1617 Begin
1618 Tmp := MsgRec^.CurrTxtRec;
1619 GetTxtPos := MsgRec^.CurrTxtPos + Tmp shl 16;
1620 End;
1621
1622
1623 Procedure HudsonMsgObj.SetTxtPos(TP: LongInt);
1624 Begin
1625 MsgRec^.CurrTxtRec := TP shr 16;
1626 MsgRec^.CurrTxtPos := TP and $ffff;
1627 End;
1628
1629
HudsonMsgObj.GetStringnull1630 Function HudsonMsgObj.GetString: String;
1631 Var
1632 Rec: Word;
1633 PPos: Word;
1634 CurrLen: Byte;
1635 WRec: Word;
1636 WPos: Word;
1637 WLen: Byte;
1638 StrDone: Boolean;
1639 TxtOver: Boolean;
1640 StartSoft: Boolean;
1641
1642 Begin
1643 StrDone := False;
1644 CurrLen := 0;
1645 Rec := MsgRec^.CurrTxtRec;
1646 PPos := MsgRec^.CurrTxtPos;
1647 TxtOver := Not NextChar(Rec, PPos);
1648 If TxtOver Then
1649 EOM := True;
1650 WLen := 0;
1651 WRec := Rec;
1652 WPos := PPos;
1653 StartSoft := Wrapped;
1654 Wrapped := True;
1655 While ((Not StrDone) And (CurrLen < MaxLen) And (Not TxtOver)) Do
1656 Begin
1657 Case MsgChars^[Rec][PPos] of
1658 #$0d: Begin
1659 StrDone := True;
1660 Wrapped := False;
1661 End;
1662 #$8d:;
1663 #$0a:;
1664 #$20: Begin
1665 If ((CurrLen <> 0) or (Not StartSoft)) Then
1666 Begin
1667 Inc(CurrLen);
1668 GetString[CurrLen] := MsgChars^[Rec][PPos];
1669 WLen := CurrLen;
1670 WRec := Rec;
1671 WPos := PPos;
1672 End
1673 Else
1674 StartSoft := False;
1675 End;
1676 Else
1677 Begin
1678 Inc(CurrLen);
1679 GetString[CurrLen] := MsgChars^[Rec][PPos];
1680 End;
1681 End;
1682 Inc(PPos);
1683 TxtOver := Not NextChar(Rec, PPos);
1684 End;
1685 If StrDone Then
1686 Begin
1687 GetString[0] := Chr(CurrLen);
1688 MsgRec^.CurrTxtRec := Rec;
1689 MsgRec^.CurrTxtPos := PPos;
1690 End
1691 Else
1692 If TxtOver Then
1693 Begin
1694 GetString[0] := Chr(CurrLen);
1695 MsgRec^.CurrTxtRec := Rec;
1696 MsgRec^.CurrTxtPos := PPos;
1697 If CurrLen = 0 Then EOM := True;
1698 End
1699 Else
1700 Begin
1701 If WLen = 0 Then
1702 Begin
1703 GetString[0] := Chr(CurrLen);
1704 MsgRec^.CurrTxtRec := Rec;
1705 MsgRec^.CurrTxtPos := PPos;
1706 End
1707 Else
1708 Begin
1709 GetString[0] := Chr(WLen);
1710 Inc(WPos);
1711 NextChar(WRec, WPos);
1712 MsgRec^.CurrTxtPos := WPos;
1713 MsgRec^.CurrTxtRec := WRec;
1714 End;
1715 End;
1716 End;
1717
HudsonMsgObj.GetRealMsgNumnull1718 Function HudsonMsgObj.GetRealMsgNum: LongInt;
1719 begin
1720 GetRealMsgNum:=MsgRec^.RealMsgNum;
1721 end;
1722
HudsonMsgObj.SetReadnull1723 function HudsonMsgObj.SetRead(RS: Boolean): boolean;
1724 begin
1725 (* if IsRead=false then begin
1726 if RS then
1727 inc(MsgRec^.MsgHdr.TimesRead)
1728 else
1729 MsgRec^.MsgHdr.TimesRead:=0;
1730 SetRead:=true;
1731 end else
1732 SetRead:=false; *)
1733 SetRead := True;
1734 end;
1735
HudsonMsgObj.IsReadnull1736 function HudsonMsgObj.IsRead: Boolean;
1737 begin
1738 { IsRead:=(MsgRec^.MsgHdr.TimesRead>0);}
1739 IsRead := False;
1740 end;
1741
1742 end.
1743