1 { $O+,F+,I-,S-,R-,V-}
2 Unit MKMsgFid; {Fido *.Msg Unit}
3
4 {$IfDef FPC}
5 {$PackRecords 1}
6 {$EndIf}
7
8 Interface
9
10 Uses MKGlobT, MKMsgAbs, MKFFile, Dos, GeneralP;
11
12 Const
13 MaxFidMsgArray = 8192;
14 MaxFidMsgNum = (MaxFidMsgArray * 8) - 1;
15
16 Type FMsgType = Record
17 MsgFile: FFileObj;
18 TextCtr: LongInt;
19 MsgName: String[13];
20 TmpName: String[130];
21 TmpOpen: Boolean;
22 MsgOpen: Boolean;
23 Error: Word;
24 NetMailPath: String[128];
25 Dest: AddrType;
26 Orig: AddrType;
27 MsgStart: LongInt;
28 MsgEnd: LongInt;
29 MsgSize: LongInt;
30 DefaultZone: Word;
31 QDate: String[8];
32 QTime: String[5];
33 CurrMsg: LongInt;
34 SeekOver: Boolean;
35 {$IFDEF WINDOWS}
36 SR: TSearchRec;
37 {$ELSE}
38 SR: SearchRec;
39 {$ENDIF}
40 MailType: MsgMailType;
41 MsgPresent: Array[0..MaxFidMsgArray] of Byte;
42 End;
43
44
45 Type FidoMsgObj = Object (AbsMsgObj)
46 FM: ^FMsgType;
47 Constructor Init; {Initialize FidoMsgOut}
48 Destructor Done; Virtual; {Done FidoMsgOut}
49 Procedure RemoveTmp; {remove temporary file}
50 Procedure PutLong(L: LongInt; Position: LongInt); {Put long into msg}
51 Procedure PutWord(W: Word; Position: LongInt); {Put word into msg}
52 Procedure PutByte(B: Byte; Position: LongInt); {Put byte into msg}
GetBytenull53 Function GetByte(Position: LongInt): Byte; {Get byte from msg}
54 Procedure PutNullStr(St: String; Position: LongInt); {Put string & null into msg}
55 Procedure SetMsgPath(St: String); Virtual; {Set netmail path}
GetHighMsgNumnull56 Function GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area}
SetReadnull57 function SetRead(RS: Boolean): boolean; virtual;
IsReadnull58 Function IsRead: Boolean; Virtual; {Is current msg received}
59 Procedure SetDest(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Dest}
60 Procedure SetOrig(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Orig}
61 Procedure SetFrom(Name: String); Virtual; {Set message from}
62 Procedure SetTo(Name: String); Virtual; {Set message to}
63 Procedure SetSubj(Str: String); Virtual; {Set message subject}
64 Procedure SetCost(SCost: Word); Virtual; {Set message cost}
65 Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference}
66 Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also}
67 Procedure SetDate(SDate: String); Virtual; {Set message date}
68 Procedure SetTime(STime: String); Virtual; {Set message time}
69 Procedure SetLocal(LS: Boolean); Virtual; {Set local status}
70 Procedure SetRcvd(RS: Boolean); Virtual; {Set received status}
71 Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status}
72 Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status}
73 Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status}
74 Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status}
75 Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status}
76 Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status}
77 Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status}
78 Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status}
79 Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status}
80 procedure SetHold(sh : BOOlean); virtual; {set hold status}
81 Procedure DoString(Str: String); Virtual; {Add string to message text}
82 Procedure DoChar(Ch: Char); Virtual; {Add character to message text}
83 Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text}
WriteMsgnull84 Function WriteMsg: Word; Virtual;
85 Procedure SetDefaultZone(DZ: Word); Virtual; {Set default zone to use}
86 Procedure LineStart; Virtual; {Internal use to skip LF, ^A}
GetCharnull87 Function GetChar: Char; Virtual;
88 Procedure CheckZone(ZoneStr: String); Virtual;
89 Procedure CheckPoint(PointStr: String); Virtual;
90 Procedure CheckLine(TStr: String); Virtual;
CvtDatenull91 Function CvtDate: Boolean; Virtual;
BufferWordnull92 Function BufferWord(i: Word):Word; Virtual;
BufferBytenull93 Function BufferByte(i: Word):Byte; Virtual;
BufferNullStringnull94 Function BufferNullString(i: Word; Max: Word): String; Virtual;
95 Procedure InitMsgHdr; Virtual; {set up msg for reading}
GetStringnull96 Function GetString: String; Virtual; {Get wordwrapped string}
97 Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seek msg number}
98 Procedure SeekNext; Virtual; {Find next matching msg}
99 Procedure SeekPrior; Virtual; {Seek prior matching msg}
GetFromnull100 Function GetFrom: String; Virtual; {Get from name on current msg}
GetTonull101 Function GetTo: String; Virtual; {Get to name on current msg}
GetSubjnull102 Function GetSubj: String; Virtual; {Get subject on current msg}
GetCostnull103 Function GetCost: Word; Virtual; {Get cost of current msg}
GetDatenull104 Function GetDate: String; Virtual; {Get date of current msg}
GetTimenull105 Function GetTime: String; Virtual; {Get time of current msg}
GetRefernull106 Function GetRefer: LongInt; Virtual; {Get reply to of current msg}
GetSeeAlsonull107 Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
GetMsgNumnull108 Function GetMsgNum: LongInt; Virtual; {Get message number}
109 Procedure GetOrig(Var Addr: AddrType); Virtual; {Get origin address}
110 Procedure GetDest(Var Addr: AddrType); Virtual; {Get destination address}
IsLocalnull111 Function IsLocal: Boolean; Virtual; {Is current msg local}
IsCrashnull112 Function IsCrash: Boolean; Virtual; {Is current msg crash}
IsKillSentnull113 Function IsKillSent: Boolean; Virtual; {Is current msg kill sent}
IsSentnull114 Function IsSent: Boolean; Virtual; {Is current msg sent}
IsFAttachnull115 Function IsFAttach: Boolean; Virtual; {Is current msg file attach}
IsReqRctnull116 Function IsReqRct: Boolean; Virtual; {Is current msg request receipt}
IsReqAudnull117 Function IsReqAud: Boolean; Virtual; {Is current msg request audit}
IsRetRctnull118 Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
IsFileReqnull119 Function IsFileReq: Boolean; Virtual; {Is current msg a file request}
IsRcvdnull120 Function IsRcvd: Boolean; Virtual; {Is current msg received}
IsPrivnull121 Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
IsHoldnull122 Function IsHold: Boolean; Virtual; {Is current msg hold}
IsDeletednull123 Function IsDeleted: Boolean; Virtual; {Is current msg deleted}
IsEchoednull124 Function IsEchoed: Boolean; Virtual; {Msg should be echoed}
GetMsgLocnull125 Function GetMsgLoc: LongInt; Virtual; {Msg location}
126 Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location}
127 Procedure StartNewMsg; Virtual;
OpenMsgBasenull128 Function OpenMsgBase: Word; Virtual;
CloseMsgBasenull129 Function CloseMsgBase: Word; Virtual;
CreateMsgBasenull130 Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;
SeekFoundnull131 Function SeekFound: Boolean; Virtual;
132 Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
GetSubAreanull133 Function GetSubArea: Word; Virtual; {Get sub area number}
134 Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
135 Procedure DeleteMsg; Virtual; {Delete current message}
NumberOfMsgsnull136 Function NumberOfMsgs: LongInt; Virtual; {Number of messages}
GetLastReadnull137 Function GetLastRead: LongInt; Virtual; {Get last read for user num}
138 Procedure SetLastRead(LR: LongInt); Virtual; {Set last read}
139 Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks}
GetTxtPosnull140 Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position}
141 Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position}
MsgBaseExistsnull142 Function MsgBaseExists: Boolean; Virtual;
143 Procedure Rescan;
MsgExistsnull144 Function MsgExists(MsgNum: LongInt): Boolean;
GetRealMsgNumnull145 Function GetRealMsgNum: LongInt; Virtual;
GetIDnull146 function GetID: Byte; Virtual;
147 End;
148
149
150 Type FidoMsgPtr = ^FidoMsgObj;
151
MonthStrnull152 Function MonthStr(MoNo: Byte): String; {Return 3 char month name for month num}
MonthNumnull153 Function MonthNum(St: String):Word;
154
155
156 Implementation
157
158 Uses MKFile, MKString, MKDos {, Global};
159
160
161 Const
162 PosArray: Array[0..7] of Byte = (1, 2, 4, 8, 16, 32, 64, 128);
163
164
FidoMsgObj.GetIDnull165 function FidoMsgObj.GetID: Byte;
166 begin
167 GetID:=msgFido;
168 end;
169
170
171 Constructor FidoMsgObj.Init;
172 Begin
173 New(FM);
174 If FM = Nil Then Begin
175 Fail;
176 Exit;
177 End;
178 FM^.NetMailPath := '';
179 FM^.TextCtr := 190;
180 FM^.Dest.Zone := 0;
181 FM^.Orig.Zone := 0;
182 FM^.SeekOver := False;
183 FM^.DefaultZone := 1;
184 FM^.MsgFile.Init(1024);
185 FM^.TmpOpen := False;
186 FM^.MsgOpen := False;
187 End;
188
189
190 Destructor FidoMsgObj.Done;
191 Begin
192 If FM^.MsgOpen Then FM^.MsgFile.CloseFile;
193 If FM^.TmpOpen Then RemoveTmp;
194 FM^.MsgFile.Done;
195 Dispose(FM);
196 End;
197
198
199 Procedure FidoMsgObj.RemoveTmp;
200 Var
201 TmpFile: File;
202
203 Begin
204 If FM^.MsgFile.CloseFile Then;
205 Assign(TmpFile, FM^.TmpName);
206 Erase(TmpFile);
207 If IoResult <> 0 Then;
208 FM^.TmpOpen := False;
209 End;
210
211
212 Procedure FidoMsgObj.PutLong(L: LongInt; Position: LongInt);
213 Var
214 i: Integer;
215
216 Begin
217 If FM^.MsgFile.SeekFile(Position) Then
218 FM^.MsgFile.BlkWrite(L, SizeOf(LongInt));
219 End;
220
221
222 Procedure FidoMsgObj.PutWord(W: Word; Position: LongInt);
223 Begin
224 If FM^.MsgFile.SeekFile(Position) Then
225 FM^.MsgFile.BlkWrite(W, SizeOf(Word));
226 End;
227
228
229 Procedure FidoMsgObj.PutByte(B: Byte; Position: LongInt);
230 Begin
231 If FM^.MsgFile.SeekFile(Position) Then
232 FM^.MsgFile.BlkWrite(B, SizeOf(Byte));
233 End;
234
235
FidoMsgObj.GetBytenull236 Function FidoMsgObj.GetByte(Position: LongInt): Byte;
237 Var
238 B: Byte;
239 NumRead: Word;
240
241 Begin
242 If FM^.MsgFile.SeekFile(Position) Then
243 FM^.MsgFile.BlkRead(B, SizeOf(Byte), NumRead);
244 GetByte := b;
245 End;
246
247
248 Procedure FidoMsgObj.PutNullStr(St: String; Position: LongInt);
249 Var
250 i: Byte;
251 Begin
252 i := 0;
253 If FM^.MsgFile.SeekFile(Position) Then Begin
254 FM^.MsgFile.BlkWrite(St[1], Length(St));
255 FM^.MsgFile.BlkWrite(i, 1);
256 End;
257 End;
258
259
260 Procedure FidoMsgObj.SetMsgPath(St: String);
261 Begin
262 FM^.NetMailPath := AddDirSep(Copy(St, 1, 110));
263 End;
264
265
FidoMsgObj.GetHighMsgNumnull266 Function FidoMsgObj.GetHighMsgNum: LongInt;
267 Var
268 Highest: LongInt;
269 Cnt: LongInt;
270
271 Begin
272 Cnt := MaxFidMsgArray;
273 While (Cnt > 0) and (FM^.MsgPresent[Cnt] = 0) Do
274 Dec(Cnt);
275 If Cnt < 0 Then
276 Highest := 0
277 Else
278 Begin
279 Highest := Cnt * 8;
280 If (FM^.MsgPresent[Cnt] and $80) <> 0 Then
281 Inc(Highest, 7)
282 Else If (FM^.MsgPresent[Cnt] and $40) <> 0 Then
283 Inc(Highest, 6)
284 Else If (FM^.MsgPresent[Cnt] and $20) <> 0 Then
285 Inc(Highest, 5)
286 Else If (FM^.MsgPresent[Cnt] and $10) <> 0 Then
287 Inc(Highest, 4)
288 Else If (FM^.MsgPresent[Cnt] and $08) <> 0 Then
289 Inc(Highest, 3)
290 Else If (FM^.MsgPresent[Cnt] and $04) <> 0 Then
291 Inc(Highest, 2)
292 Else If (FM^.MsgPresent[Cnt] and $02) <> 0 Then
293 Inc(Highest, 1)
294 End;
295 GetHighMsgNum := Highest;
296 End;
297
298
MonthStrnull299 Function MonthStr(MoNo: Byte): String;
300 Begin
301 Case MoNo of
302 01: MonthStr := 'Jan';
303 02: MonthStr := 'Feb';
304 03: MonthStr := 'Mar';
305 04: MonthStr := 'Apr';
306 05: MonthStr := 'May';
307 06: MonthStr := 'Jun';
308 07: MonthStr := 'Jul';
309 08: MonthStr := 'Aug';
310 09: MonthStr := 'Sep';
311 10: MonthStr := 'Oct';
312 11: MonthStr := 'Nov';
313 12: MonthStr := 'Dec';
314 Else
315 MonthStr := '???';
316 End;
317 End;
318
319
320 Procedure FidoMsgObj.SetDest(Var Addr: AddrType);
321 Var
322 TmpChr: Char;
323
324 Begin
325 FM^.Dest := Addr;
326 PutWord(Addr.Net, 174);
327 PutWord(Addr.Node, 166);
328 If ((Addr.Point <> 0) and (FM^.MailType = mmtNetmail)) Then
329 Begin
330 If ((FM^.TextCtr <> 190) And
331 (GetByte(FM^.TextCtr - 1) <> 13)) Then
332 DoChar(#13);
333 DoStringLn(#1 + 'TOPT ' + Long2Str(Addr.Point));
334 End;
335 If ((FM^.Orig.Zone <> 0) and (FM^.MailTYpe = mmtNetMail)) Then
336 Begin
337 If ((FM^.TextCtr <> 190) And
338 (GetByte(FM^.TextCtr - 1) <> 13)) Then
339 DoChar(#13);
340 End;
341 End;
342
343
344 Procedure FidoMsgObj.SetOrig(Var Addr: AddrType);
345 Begin
346 FM^.Orig := Addr;
347 PutWord(Addr.Net, 172);
348 PutWord(Addr.Node, 168);
349 If ((Addr.Point <> 0) and (FM^.MailType = mmtNetmail)) Then
350 Begin
351 If ((FM^.TextCtr <> 190) And
352 (GetByte(FM^.TextCtr - 1) <> 13)) Then
353 DoChar(#13);
354 DoStringLn(#1 + 'FMPT ' + Long2Str(Addr.Point));
355 End;
356 If ((FM^.Dest.Zone <> 0) and (FM^.MailType = mmtNetmail)) Then
357 Begin
358 If ((FM^.TextCtr <> 190) And
359 (GetByte(FM^.TextCtr - 1) <> 13)) Then
360 DoChar(#13);
361 DoStringLn(#1 + 'INTL ' + PointlessAddrStr(FM^.Dest) + ' ' +
362 PointlessAddrStr(FM^.Orig));
363 End;
364 End;
365
366
367 Procedure FidoMsgObj.SetFrom(Name: String);
368 Begin
369 PutNullStr(Copy(Name, 1, 35),0);
370 End;
371
372
373 Procedure FidoMsgObj.SetTo(Name: String);
374 Begin
375 PutNullStr(Copy(Name, 1, 35), 36);
376 End;
377
378
379 Procedure FidoMsgObj.SetSubj(Str: String);
380 Begin
381 PutNullStr(Copy(Str, 1, 71), 72);
382 End;
383
384
385 Procedure FidoMsgObj.SetCost(SCost: Word);
386 Begin
387 PutWord(SCost, 170);
388 End;
389
390
391 Procedure FidoMsgObj.SetRefer(SRefer: LongInt);
392 Begin
393 PutWord(SRefer, 184);
394 End;
395
396
397 Procedure FidoMsgObj.SetSeeAlso(SAlso: LongInt);
398 Begin
399 PutWord(SAlso, 188);
400 End;
401
402
403 Procedure FidoMsgObj.SetDate(SDate: String);
404 Var
405 TempNum: Word;
406 {$IFDEF VirtualPascal}
407 Code: LongInt;
408 {$ELSE}
409 Code: Word;
410 {$ENDIF}
411 TmpStr: String[20];
412
413 Begin
414 FM^.QDate := Copy(SDate,1,8);
415 Val(Copy(SDate,1,2),TempNum, Code);
416 TmpStr := Copy(SDate,4,2) + ' ' + MonthStr(TempNum) + ' ' +
417 Copy(SDate,7,2) + ' ';
418 For TempNum := 1 to 11 Do
419 PutByte(Ord(TmpStr[TempNum]), TempNum + 143);
420 End;
421
422
423 Procedure FidoMsgObj.SetTime(STime: String);
424 Begin
425 FM^.QTime := Copy(STime,1,5);
426 PutNullStr(Copy(STime + ':00', 1, 8), 155);
427 End;
428
429
430 Procedure FidoMsgObj.SetLocal(LS: Boolean);
431 Begin
432 If LS Then
433 PutByte(GetByte(187) or 1, 187)
434 Else
435 PutByte(GetByte(187) and (Not 1), 187);
436 End;
437
438
439 Procedure FidoMsgObj.SetRcvd(RS: Boolean);
440 Begin
441 If RS Then
442 PutByte(GetByte(186) or 4, 186)
443 Else
444 PutByte(GetByte(186) and (not 4), 186);
445 End;
446
447
448 Procedure FidoMsgObj.SetPriv(PS: Boolean);
449 Begin
450 If PS Then
451 PutByte(GetByte(186) or 1, 186)
452 Else
453 PutByte(GetByte(186) and (not 1), 186);
454 End;
455
456
457 Procedure FidoMsgObj.SetCrash(SS: Boolean);
458 Begin
459 If SS Then
460 PutByte(GetByte(186) or 2, 186)
461 Else
462 PutByte(GetByte(186) and (not 2), 186);
463 End;
464
465
466 Procedure FidoMsgObj.SetKillSent(SS: Boolean);
467 Begin
468 If SS Then
469 PutByte(GetByte(186) or 128, 186)
470 Else
471 PutByte(GetByte(186) and (Not 128), 186);
472 End;
473
474
475 Procedure FidoMsgObj.SetSent(SS: Boolean);
476 Begin
477 If SS Then
478 PutByte(GetByte(186) or 8, 186)
479 Else
480 PutByte(GetByte(186) and (not 8), 186);
481 End;
482
483
484 Procedure FidoMsgObj.SetFAttach(SS: Boolean);
485 Begin
486 If SS Then
487 PutByte(GetByte(186) or 16, 186)
488 Else
489 PutByte(GetByte(186) and (not 16), 186);
490 End;
491
492
493 Procedure FidoMsgObj.SetReqRct(SS: Boolean);
494 Begin
495 If SS Then
496 PutByte(GetByte(187) or 16, 187)
497 Else
498 PutByte(GetByte(187) and (not 16), 187);
499 End;
500
501
502 Procedure FidoMsgObj.SetReqAud(SS: Boolean);
503 Begin
504 If SS Then
505 PutByte(GetByte(187) or 64, 187)
506 Else
507 PutByte(GetByte(187) and (not 64), 187);
508 End;
509
510
511 Procedure FidoMsgObj.SetRetRct(SS: Boolean);
512 Begin
513 If SS Then
514 PutByte(GetByte(187) or 32, 187)
515 Else
516 PutByte(GetByte(187) and (not 32), 187);
517 End;
518
519
520 Procedure FidoMsgObj.SetFileReq(SS: Boolean);
521 Begin
522 If SS Then
523 PutByte(GetByte(187) or 8, 187)
524 Else
525 PutByte(GetByte(187) and (not 8), 187);
526 End;
527
528 procedure FidoMsgObj.SetHold(sh : Boolean);
529
530 begin
531 if sh then putByte(getByte(187) or 2, 187)
532 else PutByte(getByte(187) and (not 2), 187);
533 end;
534
535
536 Procedure FidoMsgObj.DoString(Str: String);
537 Var
538 i: Word;
539
540 Begin
541 i := 1;
542 While i <= Length(Str) Do
543 Begin
544 DoChar(Str[i]);
545 Inc(i);
546 End;
547 End;
548
549
550 Procedure FidoMsgObj.DoChar(Ch: Char);
551 Begin
552 PutByte(Ord(Ch), FM^.TextCtr);
553 Inc(FM^.TextCtr);
554 End;
555
556
557 Procedure FidoMsgObj.DoStringLn(Str: String);
558 Begin
559 DoString(Str);
560 DoChar(#13);
561 End;
562
563
FidoMsgObj.WriteMsgnull564 Function FidoMsgObj.WriteMsg: Word;
565 Var
566 NetNum: Word;
567 TmpDate: LongInt;
568 {$IFDEF WINDOWS}
569 TmpDT: TDateTime;
570 {$ELSE}
571 TmpDT: DateTime;
572 {$ENDIF}
573 TmpFile: File;
574 Code: LongInt;
575
576 Begin
577 DoChar(#0);
578 PutLong(GetDosDate, 180);
579 TmpDT.Year := Str2Long(Copy(FM^.QDate,7,2));
580 If TmpDT.Year > 79 Then
581 Inc(TmpDT.Year, 1900)
582 Else
583 Inc(TmpDT.Year, 2000);
584 TmpDT.Month := Str2Long(Copy(FM^.QDate,1,2));
585 TmpDT.Day := Str2Long(Copy(FM^.QDate,4,2));
586 TmpDt.Hour := Str2Long(Copy(FM^.QTime,1,2));
587 TmpDt.Min := Str2Long(Copy(FM^.QTime, 4,2));
588 TmpDt.Sec := 0;
589 PackTime(TmpDT, TmpDate);
590 PutLong(TmpDate, 176);
591 NetNum := GetHighMsgNum + 1;
592 If FileExist(FM^.NetMailPath + Long2Str(NetNum) + '.msg') Then
593 Begin
594 Rescan;
595 NetNum := GetHighMsgNum + 1;
596 End;
597 Code := NetNum shr 3; {div by 8 to get byte position}
598 FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[NetNum and 7];
599 If FM^.TmpOpen Then
600 Begin
601 If FM^.MsgFile.CloseFile Then
602 Begin
603 Assign(TmpFile, FM^.TmpName);
604 Rename(TmpFile, FM^.NetMailPath + Long2Str(NetNum) + '.msg')
605 End;
606 FM^.TmpOpen := False;
607 End;
608 WriteMsg := IoResult;
609 FM^.CurrMsg := NetNum;
610 End;
611
612
613 Procedure FidoMsgObj.SetDefaultZone(DZ: Word); {Set default zone to use}
614 Begin
615 FM^.DefaultZone := DZ;
616 End;
617
618
619 Procedure FidoMsgObj.LineStart;
620 Begin
621 If GetByte(FM^.TextCtr) = 10 Then
622 Inc(FM^.TextCtr);
623 If GetByte(FM^.TextCtr) = 1 Then
624 Inc(FM^.TextCtr);
625 End;
626
627
FidoMsgObj.GetCharnull628 Function FidoMsgObj.GetChar: Char;
629 Begin
630 If ((FM^.TextCtr >= FM^.MsgSize) Or (GetByte(FM^.TextCtr) = 0)) Then
631 Begin
632 GetChar := #0;
633 EOM := True;
634 End
635 Else
636 Begin
637 GetChar := Chr(GetByte(FM^.TextCtr));
638 Inc(FM^.TextCtr);
639 End;
640 End;
641
642
643 Procedure FidoMsgObj.CheckZone(ZoneStr: String);
644 Var
645 DestZoneStr: String;
646 {$IFDEF VirtualPascal}
647 Code: LongInt;
648 {$ELSE}
649 Code: Word;
650 {$ENDIF}
651
652 Begin
653 If (Upper(Copy(ZoneStr,1,4)) = 'INTL') Then
654 Begin
655 DestZoneStr := ExtractWord(ZoneStr, 2);
656 DestZoneStr := StripBoth(DestZoneStr, ' ');
657 DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
658 {$R-} Val(DestZoneStr, FM^.Dest.Zone, Code); {$R+}
659 DestZoneStr := ExtractWord(ZoneStr,3);
660 DestZoneStr := StripBoth(DestZoneStr, ' ');
661 DestZoneStr := Copy(DestZoneStr, 1, Pos(':', DestZoneStr) - 1);
662 {$R-} Val(DestZoneStr, FM^.Orig.Zone, Code); {$R+}
663 End;
664 End;
665
666
667 Procedure FidoMsgObj.CheckPoint(PointStr: String);
668 Var
669 DestPointStr: String;
670 {$IFDEF VirtualPascal}
671 Code: LongInt;
672 {$ELSE}
673 Code: Word;
674 {$ENDIF}
675 Temp: Word;
676
677 Begin
678 If (Upper(Copy(PointStr,1,4)) = 'TOPT') Then
679 Begin
680 DestPointStr := ExtractWord(PointStr, 2);
681 DestPointStr := StripBoth(DestPointStr, ' ');
682 {$R-} Val(DestPointStr, Temp, Code); {$R+}
683 If Code = 0 Then
684 FM^.Dest.Point := Temp;
685 End;
686 If (Upper(Copy(PointStr,1,5)) = 'MSGID') Then
687 Begin
688 DestPointStr := Copy(PointStr, Pos('.', PointStr) + 1, Length(PointStr) - (Pos('.', PointStr) + 1));
689 Code := Pos('@', DestPointStr);
690 If (Code > 1) and (Code < Pos(' ', DestPointStr)) then
691 DestPointStr := Copy(DestPointStr, 1, Pos('@', DestPointStr) - 1)
692 Else
693 DestPointStr := Copy(DestPointStr, 1, Pos(' ', DestPointStr) - 1);
694 {$R-} Val(DestPointStr, Temp, Code); {$R+}
695 If Code = 0 Then
696 FM^.Orig.Point := Temp;
697 End;
698 If (Upper(Copy(PointStr,1,4)) = 'FMPT') Then
699 Begin
700 DestPointStr := ExtractWord(PointStr, 2);
701 DestPointStr := StripBoth(DestPointStr, ' ');
702 {$R-} Val(DestPointStr, Temp, Code); {$R+}
703 If Code = 0 Then
704 FM^.Orig.Point := Temp;
705 End;
706 End;
707
708
MonthNumnull709 Function MonthNum(St: String):Word;
710 Begin
711 ST := Upper(St);
712 MonthNum := 0;
713 If St = 'JAN' Then MonthNum := 01;
714 If St = 'FEB' Then MonthNum := 02;
715 If St = 'MAR' Then MonthNum := 03;
716 If St = 'APR' Then MonthNum := 04;
717 If St = 'MAY' Then MonthNum := 05;
718 If St = 'JUN' Then MonthNum := 06;
719 If St = 'JUL' Then MonthNum := 07;
720 If St = 'AUG' Then MonthNum := 08;
721 If St = 'SEP' Then MonthNum := 09;
722 If St = 'OCT' Then MonthNum := 10;
723 If St = 'NOV' Then MonthNum := 11;
724 If St = 'DEC' Then MonthNum := 12;
725 End;
726
727
FidoMsgObj.CvtDatenull728 Function FidoMsgObj.CvtDate: Boolean;
729 Var
730 MoNo: Word;
731 TmpStr: String;
732 i: Word;
733 MsgDt: String[25];
734
735 Begin
736 MsgDt := BufferNullString(144, 20);
737 MsgDt := PadRight(MsgDt,' ', 20);
738 CvtDate := True;
739 If MsgDt[3] = ' ' Then
740 Begin {Fido or Opus}
741 If MsgDt[11] = ' ' Then
742 Begin {Fido DD MON YY HH:MM:SSZ}
743 FM^.QTime := Copy (MsgDT,12,5);
744 TmpStr := Long2Str(MonthNum(Copy(MsgDt,4,3)));
745 If Length(TmpStr) = 1 Then
746 TmpStr := '0' + TmpStr;
747 FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
748 End
749 Else
750 Begin {Opus DD MON YY HH:MM:SS}
751 FM^.QTime := Copy(MsgDT,11,5);
752 TmpStr := Long2Str(MonthNum(Copy(MsgDt,4,3)));
753 If Length(TmpStr) = 1 Then
754 TmpStr := '0' + TmpStr;
755 FM^.QDate := TmpStr + '-' + Copy(MsgDT,1,2) + '-' + Copy (MsgDt,8,2);
756 End;
757 End
758 Else
759 Begin
760 If MsgDT[4] = ' ' Then
761 Begin {SeaDog format DOW DD MON YY HH:MM}
762 FM^.QTime := Copy(MsgDT,15,5);
763 TmpStr := Long2Str(MonthNum(Copy(MsgDT,8,3)));
764 If Length(TmpStr) = 1 Then
765 TmpStr := '0' + TmpStr;
766 FM^.QDate := TmpStr + '-' + Copy(MsgDT,5,2) + '-' + Copy (MsgDt,12,2);
767 End
768 Else
769 Begin
770 If MsgDT[3] = '-' Then
771 Begin {Wierd format DD-MM-YYYY HH:MM:SS}
772 FM^.QTime := Copy(MsgDt,12,5);
773 FM^.QDate := Copy(MsgDt,4,3) + Copy (MsgDt,1,3) + Copy (MsgDt,9,2);
774 End
775 Else
776 Begin {Bad Date}
777 CvtDate := False;
778 End;
779 End;
780 End;
781 For i := 1 to 5 Do
782 If FM^.QTime[i] = ' ' Then
783 FM^.QTime[i] := '0';
784 For i := 1 to 8 Do
785 If FM^.QDate[i] = ' ' Then
786 FM^.QDate[i] := '0';
787 If Length(FM^.QDate) <> 8 Then
788 CvtDate := False;
789 If Length(FM^.QTime) <> 5 Then
790 CvtDate := False;
791 End;
792
793
FidoMsgObj.BufferWordnull794 Function FidoMsgObj.BufferWord(i: Word):Word;
795 Begin
796 BufferWord := BufferByte(i) + (BufferByte(i + 1) shl 8);
797 End;
798
799
FidoMsgObj.BufferBytenull800 Function FidoMsgObj.BufferByte(i: Word):Byte;
801 Begin
802 BufferByte := GetByte(i);
803 End;
804
805
FidoMsgObj.BufferNullStringnull806 Function FidoMsgObj.BufferNullString(i: Word; Max: Word): String;
807 Var
808 Ctr: Word;
809 CurrPos: Word;
810
811 Begin
812 BufferNullString := '';
813 Ctr := i;
814 CurrPos := 0;
815 While ((CurrPos < Max) and (GetByte(Ctr) <> 0)) Do
816 Begin
817 Inc(CurrPos);
818 BufferNullString[CurrPos] := Chr(GetByte(Ctr));
819 Inc(Ctr);
820 End;
821 BufferNullString[0] := Chr(CurrPos);
822 End;
823
824
825 Procedure FidoMsgObj.CheckLine(TStr: String);
826 Begin
827 If TStr[1] = #10 Then
828 TStr := Copy(TStr,2,255);
829 If TStr[1] = #01 Then
830 TStr := Copy(TStr,2,255);
831 CheckZone(TStr);
832 CheckPoint(TStr);
833 End;
834
835
836 procedure FidoMsgObj.InitMsgHdr;
837 var
838 NumRead: Word;
839 TStr: String;
840 TmpChr: Char;
841
842 begin
843 If FM^.MsgOpen Then If FM^.MsgFile.CloseFile Then FM^.MsgOpen := False;
844 If FM^.TmpOpen Then RemoveTmp;
845 Wrapped := False;
846 if FileExist (FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.msg') Then
847 FM^.Error := 0 else FM^.Error := 200;
848 if FM^.Error = 0 Then begin
849 If Not FM^.MsgFile.OpenFile(FM^.NetMailPath + Long2Str(FM^.CurrMsg) +
850 '.msg', fmReadWrite + fmDenyNone) Then FM^.Error := 1000;
851 end;
852 If FM^.Error = 0 Then FM^.MsgOpen := True;
853 EOM := False;
854 FM^.MsgSize := FM^.MsgFile.RawSize;
855 FM^.MsgEnd := 0;
856 FM^.MsgStart := 190;
857 FM^.Dest.Zone := FM^.DefaultZone;
858 FM^.Dest.Point := 0;
859 FM^.Orig.Zone := FM^.DefaultZone;
860 FM^.Orig.Point := 0;
861 FM^.Orig.Net := BufferWord(172);
862 FM^.Orig.Node := BufferWord(168);
863 FM^.Dest.Net := BufferWord(174);
864 FM^.Dest.Node := BufferWord(166);
865 FM^.TextCtr := FM^.MsgStart;
866 if FM^.Error = 0 then begin
867 if not CvtDate then begin
868 FM^.QDate := '09-06-89';
869 FM^.QTime := '19:76';
870 end;
871 TStr := GetString;
872 CheckLine(TStr);
873 FM^.MsgFile.SeekFile(FM^.TextCtr);
874 FM^.MsgFile.BlkRead(TmpChr, 1, NumRead);
875 while ((FM^.MsgEnd = 0) and (FM^.TextCtr <= FM^.MsgSize)) Do begin
876 Case TmpChr of
877 #0: FM^.MsgEnd := FM^.TextCtr;
878 #13: begin
879 Inc(FM^.TextCtr);
880 TStr := GetString;
881 CheckLine(TStr);
882 If Length(TStr) > 0 Then Dec(FM^.TextCtr);
883 end;
884 else begin
885 Inc(FM^.TextCtr);
886 FM^.MsgFile.BlkRead(TmpChr, 1, NumRead);
887 end;
888 end;
889 end;
890 If FM^.MsgEnd = 0 Then FM^.MsgEnd := FM^.MsgSize;
891 FM^.MsgSize := FM^.MsgEnd;
892 FM^.MsgStart := 190;
893 FM^.TextCtr := FM^.MsgStart;
894 EOM := False;
895 Wrapped := False;
896 end;
897 end;
898
899
900 procedure FidoMsgObj.MsgTxtStartUp;
901 begin
902 FM^.MsgStart := 190;
903 FM^.TextCtr := FM^.MsgStart;
904 EOM := False;
905 Wrapped := False;
906 end;
907
908
FidoMsgObj.GetStringnull909 Function FidoMsgObj.GetString: String;
910 Var
911 WPos: LongInt;
912 WLen: Byte;
913 StrDone: Boolean;
914 TxtOver: Boolean;
915 StartSoft: Boolean;
916 CurrLen: LongInt;
917 PPos: LongInt;
918 TmpCh: Char;
919 TmpStr: String;
920 NumRead: Word;
921 StrCtr: LongInt;
922
923 Begin
924 StrDone := False;
925 CurrLen := 0;
926 PPos := FM^.TextCtr;
927 WPos := 0;
928 WLen := 0;
929 StartSoft := Wrapped;
930 Wrapped := True;
931 If (FM^.TextCtr >= FM^.MsgSize) Then begin
932 TmpStr := #0;
933 TmpCh := #0;
934 EOM := True;
935 end else begin
936 If FM^.MsgFile.SeekFile(FM^.TextCtr) Then
937 If FM^.MsgFile.BlkRead(TmpStr[1], 255, NumRead) Then;
938 TmpStr[0] := Chr(NumRead);
939 TmpCh := TmpStr[1];
940 end;
941 StrCtr := 1;
942 { **1 TmpCh := GetChar; }
943 While ((Not StrDone) And (CurrLen < MaxLen) And (Not EOM)) Do
944 Begin
945 Case TmpCh of
946 #$00:;
947 #$0d: begin
948 StrDone := True;
949 Wrapped := False;
950 end;
951 #$8d:;
952 #$0a:;
953 #$20: Begin
954 If ((CurrLen <> 0) or (Not StartSoft)) Then
955 Begin
956 Inc(CurrLen);
957 WLen := CurrLen;
958 GetString[CurrLen] := TmpCh;
959 WPos := FM^.TextCtr + StrCtr;
960 End
961 Else
962 StartSoft := False;
963 End;
964 Else
965 Begin
966 Inc(CurrLen);
967 GetString[CurrLen] := TmpCh;
968 End;
969 End;
970 If Not StrDone Then
971 Begin
972 Inc(StrCtr);
973 TmpCh := TmpStr[StrCtr];
974 If StrCtr > Length(TmpStr) Then
975 Begin
976 TmpCh := #0;
977 StrDone := True;
978 End
979 {** 1 TmpCh := GetChar;}
980 End;
981 End;
982 FM^.TextCtr := FM^.TextCtr + StrCtr;
983 If StrDone Then
984 Begin
985 GetString[0] := Chr(CurrLen);
986 End
987 Else
988 If EOM Then
989 Begin
990 GetString[0] := Chr(CurrLen);
991 End
992 Else
993 Begin
994 If WLen = 0 Then
995 Begin
996 GetString[0] := Chr(CurrLen);
997 Dec(FM^.TextCtr);
998 End
999 Else
1000 Begin
1001 GetString[0] := Chr(WLen);
1002 FM^.TextCtr := WPos;
1003 End;
1004 End;
1005 End;
1006
1007
FidoMsgObj.GetFromnull1008 Function FidoMsgObj.GetFrom: String; {Get from name on current msg}
1009 Begin
1010 GetFrom := BufferNullString(0, 35);
1011 End;
1012
1013
FidoMsgObj.GetTonull1014 Function FidoMsgObj.GetTo: String; {Get to name on current msg}
1015 Begin
1016 GetTo := BufferNullString(36,35);
1017 End;
1018
1019
FidoMsgObj.GetSubjnull1020 Function FidoMsgObj.GetSubj: String; {Get subject on current msg}
1021 Begin
1022 GetSubj := BufferNullString(72,71);
1023 End;
1024
1025
FidoMsgObj.GetCostnull1026 Function FidoMsgObj.GetCost: Word; {Get cost of current msg}
1027 Begin
1028 GetCost := BufferWord(170);
1029 End;
1030
1031
FidoMsgObj.GetDatenull1032 Function FidoMsgObj.GetDate: String; {Get date of current msg}
1033 Begin
1034 GetDate := FM^.QDate;
1035 End;
1036
1037
FidoMsgObj.GetTimenull1038 Function FidoMsgObj.GetTime: String; {Get time of current msg}
1039 Begin
1040 GetTime := FM^.QTime;
1041 End;
1042
1043
FidoMsgObj.GetRefernull1044 Function FidoMsgObj.GetRefer: LongInt; {Get reply to of current msg}
1045 Begin
1046 GetRefer := BufferWord(184);
1047 End;
1048
1049
FidoMsgObj.GetSeeAlsonull1050 Function FidoMsgObj.GetSeeAlso: LongInt; {Get see also of current msg}
1051 Begin
1052 GetSeeAlso := BufferWord(188);
1053 End;
1054
1055
FidoMsgObj.GetMsgNumnull1056 Function FidoMsgObj.GetMsgNum: LongInt; {Get message number}
1057 Begin
1058 GetMsgNum := FM^.CurrMsg;
1059 End;
1060
1061
1062 Procedure FidoMsgObj.GetOrig(Var Addr: AddrType); {Get origin address}
1063 Begin
1064 Addr := FM^.Orig;
1065 Addr.Domain := '';
1066 End;
1067
1068
1069 Procedure FidoMsgObj.GetDest(Var Addr: AddrType); {Get destination address}
1070 Begin
1071 Addr := FM^.Dest;
1072 Addr.Domain := '';
1073 End;
1074
1075
FidoMsgObj.IsLocalnull1076 Function FidoMsgObj.IsLocal: Boolean; {Is current msg local}
1077 Begin
1078 IsLocal := ((GetByte(187) and 001) <> 0);
1079 End;
1080
1081
FidoMsgObj.IsCrashnull1082 Function FidoMsgObj.IsCrash: Boolean; {Is current msg crash}
1083 Begin
1084 IsCrash := ((GetByte(186) and 002) <> 0);
1085 End;
1086
1087
FidoMsgObj.IsKillSentnull1088 Function FidoMsgObj.IsKillSent: Boolean; {Is current msg kill sent}
1089 Begin
1090 IsKillSent := ((GetByte(186) and 128) <> 0);
1091 End;
1092
1093
FidoMsgObj.IsSentnull1094 Function FidoMsgObj.IsSent: Boolean; {Is current msg sent}
1095 Begin
1096 IsSent := ((GetByte(186) and 008) <> 0);
1097 End;
1098
1099
FidoMsgObj.IsFAttachnull1100 Function FidoMsgObj.IsFAttach: Boolean; {Is current msg file attach}
1101 Begin
1102 IsFAttach := ((GetByte(186) and 016) <> 0);
1103 End;
1104
1105
FidoMsgObj.IsReqRctnull1106 Function FidoMsgObj.IsReqRct: Boolean; {Is current msg request receipt}
1107 Begin
1108 IsReqRct := ((GetByte(187) and 016) <> 0);
1109 End;
1110
1111
FidoMsgObj.IsReqAudnull1112 Function FidoMsgObj.IsReqAud: Boolean; {Is current msg request audit}
1113 Begin
1114 IsReqAud := ((GetByte(187) and 064) <> 0);
1115 End;
1116
1117
FidoMsgObj.IsRetRctnull1118 Function FidoMsgObj.IsRetRct: Boolean; {Is current msg a return receipt}
1119 Begin
1120 IsRetRct := ((GetByte(187) and 032) <> 0);
1121 End;
1122
1123
FidoMsgObj.IsFileReqnull1124 Function FidoMsgObj.IsFileReq: Boolean; {Is current msg a file request}
1125 Begin
1126 IsFileReq := ((GetByte(187) and 008) <> 0);
1127 End;
1128
1129
FidoMsgObj.IsRcvdnull1130 Function FidoMsgObj.IsRcvd: Boolean; {Is current msg received}
1131 Begin
1132 IsRcvd := ((GetByte(186) and 004) <> 0);
1133 End;
1134
1135
FidoMsgObj.IsPrivnull1136 Function FidoMsgObj.IsPriv: Boolean; {Is current msg priviledged/private}
1137 Begin
1138 IsPriv := ((GetByte(186) and 001) <> 0);
1139 End;
1140
FidoMsgObj.IsHoldnull1141 Function FidoMsgObj.IsHold: Boolean; {Is current msg hold}
1142 Begin
1143 IsHold := ((GetByte(187) and 002) <> 0);
1144 End;
1145
FidoMsgObj.IsDeletednull1146 Function FidoMsgObj.IsDeleted: Boolean; {Is current msg deleted}
1147 Begin
1148 IsDeleted := Not FileExist (FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.msg');
1149 End;
1150
1151
FidoMsgObj.IsEchoednull1152 Function FidoMsgObj.IsEchoed: Boolean; {Is current msg echoed}
1153 Begin
1154 IsEchoed := True;
1155 End;
1156
1157
1158 Procedure FidoMsgObj.SeekFirst(MsgNum: LongInt); {Start msg seek}
1159 Begin
1160 FM^.CurrMsg := MsgNum - 1;
1161 SeekNext;
1162 End;
1163
1164
1165 Procedure FidoMsgObj.SeekNext; {Find next matching msg}
1166 Begin
1167 Inc(FM^.CurrMsg);
1168 While ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg <= MaxFidMsgNum)) Do
1169 Inc(FM^.CurrMsg);
1170 If Not MsgExists(FM^.CurrMsg) Then
1171 FM^.CurrMsg := 0;
1172 End;
1173
1174
1175 Procedure FidoMsgObj.SeekPrior;
1176 Begin
1177 Dec(FM^.CurrMsg);
1178 While ((Not MsgExists(FM^.CurrMsg)) and (FM^.CurrMsg > 0)) Do
1179 Dec(FM^.CurrMsg);
1180 End;
1181
1182
FidoMsgObj.SeekFoundnull1183 Function FidoMsgObj.SeekFound: Boolean;
1184 Begin
1185 SeekFound := FM^.CurrMsg > 0;
1186 End;
1187
1188
FidoMsgObj.GetMsgLocnull1189 Function FidoMsgObj.GetMsgLoc: LongInt; {Msg location}
1190 Begin
1191 GetMsgLoc := GetMsgNum;
1192 End;
1193
1194
1195 Procedure FidoMsgObj.SetMsgLoc(ML: LongInt); {Msg location}
1196 Begin
1197 FM^.CurrMsg := ML;
1198 End;
1199
1200
1201 Procedure FidoMsgObj.StartNewMsg;
1202 Var
1203 Tmp: Array[0..189] of Char;
1204
1205 Begin
1206 FM^.Error := 0;
1207 FM^.TextCtr := 190;
1208 FM^.Dest.Zone := 0;
1209 FM^.Orig.Zone := 0;
1210 FM^.Dest.Point := 0;
1211 FM^.Orig.Point := 0;
1212 If FM^.TmpOpen Then
1213 RemoveTmp
1214 Else
1215 Begin
1216 If FM^.MsgOpen Then
1217 Begin
1218 If FM^.MsgFile.CloseFile Then
1219 FM^.MsgOpen := False;
1220 End;
1221 End;
1222 FM^.TmpName := GetTempName(FM^.NetMailPath);
1223 If Length(FM^.TmpName) > 0 Then
1224 Begin
1225 If FM^.MsgFile.OpenFile(FM^.TmpName, fmReadWrite + fmDenyNone) Then
1226 Begin
1227 FM^.TmpOpen := True;
1228 End
1229 Else
1230 FM^.Error := 1002;
1231 End
1232 Else
1233 FM^.Error := 1001;
1234 FillChar(Tmp, SizeOf(Tmp), #0);
1235 If FM^.MsgFile.SeekFile(0) Then;
1236 If FM^.MsgFile.BlkWrite(Tmp, SizeOf(Tmp)) Then;
1237 End;
1238
1239
FidoMsgObj.OpenMsgBasenull1240 Function FidoMsgObj.OpenMsgBase: Word;
1241 Begin
1242 Rescan;
1243 If MsgBaseExists Then
1244 OpenMsgBase := 0
1245 Else
1246 OpenMsgBase := 500;
1247 End;
1248
1249
FidoMsgObj.CloseMsgBasenull1250 Function FidoMsgObj.CloseMsgBase: Word;
1251 Begin
1252 CloseMsgBase := 0;
1253 End;
1254
1255
FidoMsgObj.CreateMsgBasenull1256 Function FidoMsgObj.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
1257 Begin
1258 If MakePath(FM^.NetMailPath) Then
1259 CreateMsgBase := 0
1260 Else
1261 CreateMsgBase := 1;
1262 End;
1263
1264
1265 Procedure FidoMsgObj.SetMailType(MT: MsgMailType);
1266 Begin
1267 FM^.MailType := Mt;
1268 End;
1269
1270
FidoMsgObj.GetSubAreanull1271 Function FidoMsgObj.GetSubArea: Word;
1272 Begin
1273 GetSubArea := 0;
1274 End;
1275
1276
1277 Procedure FidoMsgObj.ReWriteHdr;
1278 Begin
1279 { Not needed, rewrite is automatic when updates are done }
1280 End;
1281
1282
1283 Procedure FidoMsgObj.DeleteMsg;
1284 Var
1285 TmpFile: File;
1286 Code: LongInt;
1287
1288 Begin
1289 If FM^.MsgOpen Then
1290 If FM^.MsgFile.CloseFile Then
1291 FM^.MsgOpen := False;
1292 Assign(TmpFile, FM^.NetMailPath + Long2Str(FM^.CurrMsg) + '.msg');
1293 Erase(TmpFile);
1294 Code := FM^.CurrMsg shr 3; {div by 8 to get byte position}
1295 FM^.MsgPresent[Code] := FM^.MsgPresent[Code] and
1296 Not (PosArray[FM^.CurrMsg and 7]);
1297 If IoResult <> 0 Then;
1298 End;
1299
1300
FidoMsgObj.NumberOfMsgsnull1301 Function FidoMsgObj.NumberOfMsgs: LongInt;
1302 Var
1303 Cnt: Word;
1304 Active: LongInt;
1305
1306 Begin
1307 Active := 0;
1308 For Cnt := 0 To MaxFidMsgArray Do Begin
1309 If FM^.MsgPresent[Cnt] <> 0 Then Begin
1310 If (FM^.MsgPresent[Cnt] and $80) <> 0 Then Inc(Active);
1311 If (FM^.MsgPresent[Cnt] and $40) <> 0 Then Inc(Active);
1312 If (FM^.MsgPresent[Cnt] and $20) <> 0 Then Inc(Active);
1313 If (FM^.MsgPresent[Cnt] and $10) <> 0 Then Inc(Active);
1314 If (FM^.MsgPresent[Cnt] and $08) <> 0 Then Inc(Active);
1315 If (FM^.MsgPresent[Cnt] and $04) <> 0 Then Inc(Active);
1316 If (FM^.MsgPresent[Cnt] and $02) <> 0 Then Inc(Active);
1317 If (FM^.MsgPresent[Cnt] and $01) <> 0 Then Inc(Active);
1318 End;
1319 End;
1320 NumberOfMsgs := Active;
1321 End;
1322
FidoMsgObj.GetLastReadnull1323 function FidoMsgObj.GetLastRead: LongInt;
1324 var
1325 LRec : Word;
1326 f : File;
1327 begin
1328 FileMode := fmReadOnly or fmDenyNone;
1329 if ioresult <> 0 then;
1330 Assign(f, FM^.NetMailPath + 'lastread.bbs');
1331 Reset(f, 1);
1332 { Seek(f, SizeOf(LRec));}
1333 Blockread(f, LRec, Sizeof(LRec));
1334 Close(f);
1335 if ioresult <> 0 then
1336 GetLastRead := 0
1337 else
1338 GetLastRead := LRec;
1339 end;
1340
1341 procedure FidoMsgObj.SetLastRead(LR: LongInt);
1342 type
1343 TBuf = array[1..4000] of byte;
1344 var
1345 LRec : Word;
1346 Num : LongInt;
1347 Buf : ^TBuf;
1348 f : File;
1349 begin
1350 New(Buf);
1351 fillchar(Buf^, sizeof(Buf^), 0);
1352 LRec:=LR;
1353 FileMode := fmReadWrite or fmDenyNone;
1354 if ioresult <> 0 then;
1355 Assign(f, FM^.NetMailPath + 'lastread.bbs');
1356 Reset(f, 1);
1357 if ioresult <> 0 then Rewrite(f, 1);
1358 if Sizeof(LRec) > FileSize(f) then
1359 begin
1360 Seek(f, Filesize(f));
1361 while (Sizeof(LRec) > FileSize(f)) and (ioresult = 0) do
1362 begin
1363 Num := Sizeof(LRec) - FileSize(f);
1364 if Num > 4000 then Num := 4000;
1365 Blockwrite(f, Buf^, Num);
1366 end;
1367 end;
1368 { Seek(f, Sizeof(LRec));}
1369 Blockwrite(f, LRec, Sizeof(LRec));
1370 Close(f);
1371 if ioresult <> 0 then;
1372 Dispose(Buf);
1373 end;
1374
FidoMsgObj.GetTxtPosnull1375 Function FidoMsgObj.GetTxtPos: LongInt;
1376 Begin
1377 GetTxtPos := FM^.TextCtr;
1378 End;
1379
1380
1381 Procedure FidoMsgObj.SetTxtPos(TP: LongInt);
1382 Begin
1383 FM^.TextCtr := TP;
1384 End;
1385
1386
FidoMsgObj.MsgBaseExistsnull1387 Function FidoMsgObj.MsgBaseExists: Boolean;
1388 Begin
1389 MsgBaseExists := mkfile.FileExist(FM^.NetMailPath + '.');
1390 End;
1391
1392
1393 Procedure FidoMsgObj.Rescan;
1394 Var
1395 SR: SearchRec;
1396 TmpName: String[13];
1397 TmpNum: Word;
1398 {$IFDEF VirtualPascal}
1399 Code: LongInt;
1400 {$ELSE}
1401 Code: Word;
1402 {$ENDIF}
1403
1404 Begin
1405 FillChar(FM^.MsgPresent, SizeOf(FM^.MsgPresent), 0);
1406 FindFirst(FM^.NetMailPath + '*.msg', ReadOnly + Archive, SR);
1407 While DosError = 0 Do Begin
1408 TmpName := SR.Name;
1409 Val(Copy(TmpName, 1, Pos('.', TmpName) - 1), TmpNum, Code);
1410 If ((Code = 0) And (TmpNum > 0)) Then Begin
1411 If TmpNum <= MaxFidMsgNum Then Begin
1412 Code := TmpNum shr 3; {div by 8 to get byte position}
1413 FM^.MsgPresent[Code] := FM^.MsgPresent[Code] or PosArray[TmpNum and 7];
1414 End;
1415 End;
1416 FindNext(SR);
1417 End;
1418 End;
1419
1420
FidoMsgObj.MsgExistsnull1421 Function FidoMsgObj.MsgExists(MsgNum: LongInt): Boolean;
1422 Var
1423 Code: LongInt;
1424
1425 Begin
1426 If ((MsgNum > 0) and (MsgNum <= MaxFidMsgNum)) Then
1427 Begin
1428 Code := MsgNum shr 3;
1429 MsgExists := (FM^.MsgPresent[Code] and PosArray[MsgNum and 7]) <> 0;
1430 End
1431 Else
1432 MsgExists := False;
1433 End;
1434
1435
FidoMsgObj.GetRealMsgNumnull1436 Function FidoMsgObj.GetRealMsgNum: LongInt;
1437 var
1438 Active: Longint;
1439 Cnt: Word;
1440 begin
1441 Active:=0;
1442 For Cnt := 0 To FM^.CurrMsg Do
1443 If (FM^.MsgPresent[Cnt shr 3] and PosArray[Cnt mod 8]) <> 0 Then
1444 Inc(Active);
1445 GetRealMsgNum := active;
1446 end;
1447
FidoMsgObj.SetReadnull1448 function FidoMsgObj.SetRead(RS: Boolean): boolean;
1449 var
1450 num: word;
1451 begin
1452 if IsRead=false then begin
1453 seek(FM^.MsgFile.BufFile,164);
1454 if RS then begin
1455 Blockread(FM^.MsgFile.BufFile,num,2);
1456 inc(num);
1457 end else
1458 Num:=0;
1459 seek(FM^.MsgFile.BufFile,164);
1460 Blockwrite(FM^.MsgFile.BufFile,num,2);
1461 SetRead:=true;
1462 end else
1463 SetRead:=false;
1464 end;
1465
FidoMsgObj.IsReadnull1466 function FidoMsgObj.IsRead: Boolean;
1467 var
1468 num: word;
1469 begin
1470 seek(FM^.MsgFile.BufFile,164);
1471 Blockread(FM^.MsgFile.BufFile,num,2);
1472 IsRead:=(num>0);
1473 end;
1474
1475 End.
1476