1 { $O+,F+,I-,S-,R-,V-}
2 Unit MKMsgJam; {JAM Msg Object Unit}
3
4 {$IfDef FPC}
5 {$PackRecords 1}
6 {$EndIf}
7
8 Interface
9
10 Uses DOS, GeneralP, MKGlobT, MKMsgAbs, MKMisc;
11
12 Type JamHdrType = Record
13 Signature: Array[1..4] of Char;
14 Created: LongInt;
15 ModCounter: LongInt;
16 ActiveMsgs: LongInt;
17 PwdCRC: LongInt;
18 BaseMsgNum: LongInt;
19 Extra: Array[1..1000] of Char;
20 End;
21
22
23 Type JamMsgHdrType = Record
24 Signature: Array[1..4] of Char;
25 Rev: Word;
26 Resvd: Word;
27 SubFieldLen: LongInt;
28 TimesRead: LongInt;
29 MsgIdCrc: LongInt;
30 ReplyCrc: LongInt;
31 ReplyTo: LongInt;
32 ReplyFirst: LongInt;
33 ReplyNext: LongInt;
34 DateWritten: LongInt;
35 DateRcvd: LongInt;
36 DateArrived: LongInt;
37 MsgNum: LongInt;
38 Attr1: LongInt;
39 Attr2: LongInt;
40 TextOfs: LongInt;
41 TextLen: LongInt;
42 PwdCrc: LongInt;
43 Cost: LongInt;
44 End;
45
46
47 Type JamIdxType = Record
48 MsgToCrc: LongInt;
49 HdrLoc: LongInt;
50 End;
51
52
53 Type JamLastType = Record
54 NameCrc: LongInt;
55 UserNum: LongInt;
56 LastRead: LongInt;
57 HighRead: LongInt;
58 End;
59
60
61 Const
62 JamIdxBufSize = 500;
63 JamSubBufSize = 4000;
64 JamTxtBufSize = 4000;
65 TxtSubBufSize = 2000; {Note actual size is one greater}
66
67
68 type
69 JamIdxArrayType = Array[0..JamIdxBufSize] of JamIdxType;
70 JamSubBuffer = Array[1..JamSubBufSize] of Char;
71 JamTxtBufType = Array[0..JamTxtBufSize] Of Char;
72
73 HdrType = record
74 JamHdr: JamMsgHdrType;
75 SubBuf: JamSubBuffer;
76 end;
77
78
79 Type JamMsgType = Record
80 HdrFile: File;
81 TxtFile: File;
82 IdxFile: File;
83 MsgPath: String[128];
84 BaseHdr: JamHdrType;
85 Dest: AddrType;
86 Orig: AddrType;
87 MsgFrom: String[65];
88 MsgTo: String[65];
89 MsgSubj: String[100];
90 MsgDate: String[8];
91 MsgTime: String[5];
92 CurrMsgNum: LongInt;
93 NameCrc: LongInt;
94 HdlCrc: LongInt;
95 TxtPos: LongInt; {TxtPos < 0 means get from sub text}
96 TxtEnd: LongInt;
97 TxtBufStart: LongInt;
98 {$IFDEF VirtualPascal}
99 TxtRead: LongInt;
100 {$ELSE}
101 TxtRead: Word;
102 {$ENDIF}
103 MailType: MsgMailType;
104 BufFile: File;
105 LockCount: LongInt;
106 IdxStart: LongInt;
107 {$IFDEF VirtualPascal}
108 IdxRead: LongInt;
109 {$ELSE}
110 IdxRead: Word;
111 {$ENDIF}
112 TxtSubBuf: Array[0..TxtSubBufSize] of Char; {temp storage for text on subfields}
113 TxtSubChars: Integer;
114 End;
115
116
117 Type JamMsgObj = Object (AbsMsgObj)
118 JM: ^JamMsgType;
119 MsgHdr: ^HdrType;
120 JamIdx: ^JamIdxArrayType;
121 TxtBuf: ^JamTxtBufType;
122 Error: Word;
123 Constructor Init; {Initialize}
124 Destructor Done; Virtual; {Done}
SetReadnull125 function SetRead(RS: Boolean): boolean; virtual;
IsReadnull126 Function IsRead: Boolean; Virtual; {Is current msg received}
127 Procedure SetMsgPath(St: String); Virtual; {Set netmail path}
GetHighMsgNumnull128 Function GetHighMsgNum: LongInt; Virtual; {Get highest netmail msg number in area}
LockMsgBasenull129 Function LockMsgBase: Boolean; Virtual; {Lock the message base}
UnLockMsgBasenull130 Function UnLockMsgBase: Boolean; Virtual; {Unlock the message base}
131 Procedure SetDest(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Dest}
132 Procedure SetOrig(Var Addr: AddrType); Virtual; {Set Zone/Net/Node/Point for Orig}
133 Procedure SetFrom(Name: String); Virtual; {Set message from}
134 Procedure SetTo(Name: String); Virtual; {Set message to}
135 Procedure SetSubj(Str: String); Virtual; {Set message subject}
136 Procedure SetCost(SCost: Word); Virtual; {Set message cost}
137 Procedure SetRefer(SRefer: LongInt); Virtual; {Set message reference}
138 Procedure SetSeeAlso(SAlso: LongInt); Virtual; {Set message see also}
GetNextSeeAlsonull139 Function GetNextSeeAlso: LongInt; Virtual;
140 Procedure SetNextSeeAlso(SAlso: LongInt); Virtual;
141 Procedure SetDate(SDate: String); Virtual; {Set message date}
142 Procedure SetTime(STime: String); Virtual; {Set message time}
143 Procedure SetLocal(LS: Boolean); Virtual; {Set local status}
144 Procedure SetRcvd(RS: Boolean); Virtual; {Set received status}
145 Procedure SetPriv(PS: Boolean); Virtual; {Set priveledge vs public status}
146 Procedure SetCrash(SS: Boolean); Virtual; {Set crash netmail status}
147 Procedure SetKillSent(SS: Boolean); Virtual; {Set kill/sent netmail status}
148 Procedure SetSent(SS: Boolean); Virtual; {Set sent netmail status}
149 Procedure SetFAttach(SS: Boolean); Virtual; {Set file attach status}
150 Procedure SetReqRct(SS: Boolean); Virtual; {Set request receipt status}
151 Procedure SetReqAud(SS: Boolean); Virtual; {Set request audit status}
152 Procedure SetRetRct(SS: Boolean); Virtual; {Set return receipt status}
153 Procedure SetFileReq(SS: Boolean); Virtual; {Set file request status}
154 procedure setHold(sh : Boolean); virtual; {Set hold status}
155 Procedure DoString(Str: String); Virtual; {Add string to message text}
156 Procedure DoChar(Ch: Char); Virtual; {Add character to message text}
157 Procedure DoStringLn(Str: String); Virtual; {Add string and newline to msg text}
158 Procedure DoKludgeLn(Str: String); Virtual; {Add ^AKludge line to msg}
WriteMsgnull159 Function WriteMsg: Word; Virtual;
GetCharnull160 Function GetChar: Char; Virtual;
161 Procedure AddTxtSub(St: String);
162 Procedure InitMsgHdr; Virtual; {set up msg for reading}
GetStringnull163 Function GetString: String; Virtual; {Get wordwrapped string}
164 Procedure SeekFirst(MsgNum: LongInt); Virtual; {Seek msg number}
165 Procedure SeekNext; Virtual; {Find next matching msg}
166 Procedure SeekPrior; Virtual; {Seek prior matching msg}
GetFromnull167 Function GetFrom: String; Virtual; {Get from name on current msg}
GetTonull168 Function GetTo: String; Virtual; {Get to name on current msg}
GetSubjnull169 Function GetSubj: String; Virtual; {Get subject on current msg}
GetCostnull170 Function GetCost: Word; Virtual; {Get cost of current msg}
GetDatenull171 Function GetDate: String; Virtual; {Get date of current msg}
GetTimenull172 Function GetTime: String; Virtual; {Get time of current msg}
GetRefernull173 Function GetRefer: LongInt; Virtual; {Get reply to of current msg}
GetSeeAlsonull174 Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg}
GetMsgNumnull175 Function GetMsgNum: LongInt; Virtual; {Get message number}
176 Procedure GetOrig(Var Addr: AddrType); Virtual; {Get origin address}
177 Procedure GetDest(Var Addr: AddrType); Virtual; {Get destination address}
IsLocalnull178 Function IsLocal: Boolean; Virtual; {Is current msg local}
IsCrashnull179 Function IsCrash: Boolean; Virtual; {Is current msg crash}
IsKillSentnull180 Function IsKillSent: Boolean; Virtual; {Is current msg kill sent}
IsSentnull181 Function IsSent: Boolean; Virtual; {Is current msg sent}
IsFAttachnull182 Function IsFAttach: Boolean; Virtual; {Is current msg file attach}
IsReqRctnull183 Function IsReqRct: Boolean; Virtual; {Is current msg request receipt}
IsReqAudnull184 Function IsReqAud: Boolean; Virtual; {Is current msg request audit}
IsRetRctnull185 Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
IsFileReqnull186 Function IsFileReq: Boolean; Virtual; {Is current msg a file request}
IsRcvdnull187 Function IsRcvd: Boolean; Virtual; {Is current msg received}
IsPrivnull188 Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private}
IsHoldnull189 Function IsHold: Boolean; Virtual; {Is current msg hold}
IsDeletednull190 Function IsDeleted: Boolean; Virtual; {Is current msg deleted}
191 Procedure SetDeleted(tr: boolean); virtual;
IsEchoednull192 Function IsEchoed: Boolean; Virtual; {Msg should be echoed}
GetMsgLocnull193 Function GetMsgLoc: LongInt; Virtual; {Msg location}
194 Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location}
195 Procedure StartNewMsg; Virtual;
OpenMsgBasenull196 Function OpenMsgBase: Word; Virtual;
CloseMsgBasenull197 Function CloseMsgBase: Word; Virtual;
MsgBaseExistsnull198 Function MsgBaseExists: Boolean; Virtual; {Does msg base exist}
CreateMsgBasenull199 Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word; Virtual;
SeekFoundnull200 Function SeekFound: Boolean; Virtual;
201 Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
GetSubAreanull202 Function GetSubArea: Word; Virtual; {Get sub area number}
203 Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
204 Procedure DeleteMsg; Virtual; {Delete current message}
NumberOfMsgsnull205 Function NumberOfMsgs: LongInt; Virtual; {Number of messages}
GetLastReadnull206 Function GetLastRead: LongInt; Virtual; {Get last read for user num}
207 Procedure SetLastRead(LR: LongInt); Virtual; {Set last read}
208 Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks}
GetTxtPosnull209 Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position}
210 Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position}
211 Procedure SetAttr1(Mask: LongInt; St: Boolean); {Set attribute 1}
ReadIdxnull212 Function ReadIdx: Word;
WriteIdxnull213 Function WriteIdx: Word;
214 Procedure AddSubField(id: Word; Data: String);
FindLastReadnull215 Function FindLastRead(Var LastFile: File; UNum: LongInt): LongInt;
ReReadIdxnull216 Function ReReadIdx(Var IdxLoc : LongInt) : Word;
GetRealMsgNumnull217 Function GetRealMsgNum: LongInt; Virtual;
GetIDnull218 function GetID: Byte; virtual;
219 End;
220
221
222 Type JamMsgPtr = ^JamMsgObj;
223
224
JamStrCrcnull225 Function JamStrCrc(St: String): LongInt;
226
227
228 Implementation
229
230 Uses MKFile, MKString, MKDos, Crc32;
231
232 Const
233 Jam_Local = $00000001;
234 Jam_InTransit = $00000002;
235 Jam_Priv = $00000004;
236 Jam_Rcvd = $00000008;
237 Jam_Sent = $00000010;
238 Jam_KillSent = $00000020;
239 Jam_AchvSent = $00000040;
240 Jam_Hold = $00000080;
241 Jam_Crash = $00000100;
242 Jam_Imm = $00000200;
243 Jam_Direct = $00000400;
244 Jam_Gate = $00000800;
245 Jam_Freq = $00001000;
246 Jam_FAttch = $00002000;
247 Jam_TruncFile = $00004000;
248 Jam_KillFile = $00008000;
249 Jam_RcptReq = $00010000;
250 Jam_ConfmReq = $00020000;
251 Jam_Orphan = $00040000;
252 Jam_Encrypt = $00080000;
253 Jam_Compress = $00100000;
254 Jam_Escaped = $00200000;
255 Jam_FPU = $00400000;
256 Jam_TypeLocal = $00800000;
257 Jam_TypeEcho = $01000000;
258 Jam_TypeNet = $02000000;
259 Jam_NoDisp = $20000000;
260 Jam_Locked = $40000000;
261 Jam_Deleted = $80000000;
262
263
264 Type SubFieldType = Record
265 LoId: Word;
266 HiId: Word;
267 DataLen: LongInt;
268 Data: Array[1..1000] of Char;
269 End;
270
271
JamMsgObj.GetIDnull272 function JamMsgObj.GetID: Byte;
273 begin
274 GetID:=msgJAM;
275 end;
276
277 Constructor JamMsgObj.Init;
278 Begin
279 New(JM);
280 New(JamIdx);
281 New(MsgHdr);
282 New(TxtBuf);
283 If ((JM = Nil) Or (JamIdx = Nil) or (MsgHdr = Nil) or (TxtBuf = Nil)) Then
284 Begin
285 If JM <> Nil Then
286 Dispose(JM);
287 If JamIdx <> Nil Then
288 Dispose(JamIdx);
289 If MsgHdr <> Nil Then
290 Dispose(MsgHdr);
291 If TxtBuf <> Nil Then
292 Dispose(TxtBuf);
293 Fail;
294 Exit;
295 End
296 Else
297 Begin;
298 FillChar(JM^, SizeOf(JM^), #0);
299 JM^.MsgPath := '';
300 JM^.IdxStart := -30;
301 JM^.IdxRead := 0;
302 Error := 0;
303 End;
304 End;
305
306
307 Destructor JamMsgObj.Done;
308 Begin
309 If JM <> Nil Then Dispose(JM);
310 If JamIdx <> Nil Then Dispose(JamIdx);
311 If MsgHdr <> Nil Then Dispose(MsgHdr);
312 If TxtBuf <> Nil Then Dispose(TxtBuf);
313 End;
314
315
JamStrCrcnull316 Function JamStrCrc(St: String): LongInt;
317 Var
318 i: Word;
319 crc: LongInt;
320
321 Begin
322 Crc := -1;
323 For i := 1 to Length(St) Do
324 Crc := Updc32(Ord(LoCase(St[i])), Crc);
325 JamStrCrc := Crc;
326 End;
327
328
329 Procedure JamMsgObj.SetMsgPath(St: String);
330 Begin
331 JM^.MsgPath := Copy(St, 1, 124);
332 End;
333
334
JamMsgObj.GetHighMsgNumnull335 Function JamMsgObj.GetHighMsgNum: LongInt;
336 Begin
337 GetHighMsgNum := JM^.BaseHdr.BaseMsgNum + FileSize(JM^.IdxFile) - 1;
338 End;
339
340
341 Procedure JamMsgObj.SetDest(Var Addr: AddrType);
342 Begin
343 JM^.Dest := Addr;
344 End;
345
346
347 Procedure JamMsgObj.SetOrig(Var Addr: AddrType);
348 Begin
349 JM^.Orig := Addr;
350 End;
351
352
353 Procedure JamMsgObj.SetFrom(Name: String);
354 Begin
355 JM^.MsgFrom := Name;
356 End;
357
358
359 Procedure JamMsgObj.SetTo(Name: String);
360 Begin
361 JM^.MsgTo := Name;
362 End;
363
364
365 Procedure JamMsgObj.SetSubj(Str: String);
366 Begin
367 JM^.MsgSubj := Str;
368 End;
369
370
371 Procedure JamMsgObj.SetCost(SCost: Word);
372 Begin
373 MsgHdr^.JamHdr.Cost := SCost;
374 End;
375
376
377 Procedure JamMsgObj.SetRefer(SRefer: LongInt);
378 Begin
379 MsgHdr^.JamHdr.ReplyTo := SRefer;
380 End;
381
382
383 Procedure JamMsgObj.SetSeeAlso(SAlso: LongInt);
384 Begin
385 MsgHdr^.JamHdr.ReplyFirst := SAlso;
386 End;
387
388
389 Procedure JamMsgObj.SetDate(SDate: String);
390 Begin
391 JM^.MsgDate := SDate;
392 End;
393
394
395 Procedure JamMsgObj.SetTime(STime: String);
396 Begin
397 JM^.MsgTime := STime;
398 End;
399
400
401 Procedure JamMsgObj.SetAttr1(Mask: LongInt; St: Boolean);
402 Begin
403 If St Then
404 MsgHdr^.JamHdr.Attr1 := MsgHdr^.JamHdr.Attr1 Or Mask
405 Else
406 MsgHdr^.JamHdr.Attr1 := MsgHdr^.JamHdr.Attr1 And (Not Mask);
407 End;
408
409
410
411 Procedure JamMsgObj.SetLocal(LS: Boolean);
412 Begin
413 SetAttr1(Jam_Local, LS);
414 End;
415
416
417 Procedure JamMsgObj.SetRcvd(RS: Boolean);
418 Begin
419 SetAttr1(Jam_Rcvd, RS);
420 End;
421
422
423 Procedure JamMsgObj.SetPriv(PS: Boolean);
424 Begin
425 SetAttr1(Jam_Priv, PS);
426 End;
427
428
429 Procedure JamMsgObj.SetCrash(SS: Boolean);
430 Begin
431 SetAttr1(Jam_Crash, SS);
432 End;
433
434
435 Procedure JamMsgObj.SetKillSent(SS: Boolean);
436 Begin
437 SetAttr1(Jam_KillSent, SS);
438 End;
439
440
441 Procedure JamMsgObj.SetSent(SS: Boolean);
442 Begin
443 SetAttr1(Jam_Sent, SS);
444 End;
445
446
447 Procedure JamMsgObj.SetFAttach(SS: Boolean);
448 Begin
449 SetAttr1(Jam_FAttch, SS);
450 End;
451
452
453 Procedure JamMsgObj.SetReqRct(SS: Boolean);
454 Begin
455 SetAttr1(Jam_RcptReq, SS);
456 End;
457
458
459 Procedure JamMsgObj.SetReqAud(SS: Boolean);
460 Begin
461 SetAttr1(Jam_ConfmReq, SS);
462 End;
463
464
465 Procedure JamMsgObj.SetRetRct(SS: Boolean);
466 Begin
467 End;
468
469
470 Procedure JamMsgObj.SetFileReq(SS: Boolean);
471 Begin
472 SetAttr1(Jam_Freq, SS);
473 End;
474
475 procedure JamMsgObj.SetHold(sh : Boolean);
476
477 begin
478 SetAttr1(Jam_Hold, sh);
479 end;
480
481 Procedure JamMsgObj.DoString(Str: String);
482 Var
483 i: Word;
484
485 Begin
486 i := 1;
487 While i <= Length(Str) Do
488 Begin
489 DoChar(Str[i]);
490 Inc(i);
491 End;
492 End;
493
494
495 Procedure JamMsgObj.DoChar(Ch: Char);
496 Var
497 TmpStr: String;
498 NumWrite: Word;
499
500 Begin
501 Case ch of
502 #13: Wrapped := False;
503 #10:;
504 Else
505 Wrapped := True;
506 End;
507 If (JM^.TxtPos - JM^.TxtBufStart) >= JamTxtBufSize Then
508 Begin
509 If JM^.TxtBufStart = 0 Then
510 Begin
511 GetDir(0, TmpStr);
512 TmpStr := GetTempName(TmpStr);
513 Assign(JM^.BufFile, TmpStr);
514 FileMode := fmReadWrite + fmDenyNone;
515 ReWrite(JM^.BufFile, 1);
516 End;
517 NumWrite := JM^.TxtPos - JM^.TxtBufStart;
518 BlockWrite(JM^.BufFile, TxtBuf^, NumWrite);
519 Error := IoResult;
520 JM^.TxtBufStart := FileSize(JM^.BufFile);
521 End;
522 TxtBuf^[JM^.TxtPos - JM^.TxtBufStart] := Ch;
523 Inc(JM^.TxtPos);
524 End;
525
526
527 Procedure JamMsgObj.DoStringLn(Str: String);
528 Begin
529 DoString(Str);
530 DoChar(#13);
531 End;
532
533
534 Procedure JamMsgObj.DoKludgeLn(Str: String);
535 Var
536 TmpStr: String;
537
538 Begin
539 If Str[1] = #1 Then
540 Str := Copy(Str,2,255);
541 If Copy(Str,1,3) = 'PID' Then
542 Begin
543 TmpStr := StripLead(Copy(Str,4,255),':');
544 TmpStr := Copy(StripBoth(TmpStr, ' '),1,40);
545 AddSubField(7, TmpStr);
546 End
547 Else If Copy(Str,1,5) = 'MSGID' Then
548 Begin
549 TmpStr := StripLead(Copy(Str,6,255),':');
550 TmpStr := Copy(StripBoth(TmpStr,' '),1,100);
551 AddSubField(4, TmpStr);
552 MsgHdr^.JamHdr.MsgIdCrc := JamStrCrc(TmpStr);
553 End
554 Else If Copy(Str,1,4) = 'INTL' Then {ignore}
555 Begin
556 End
557 Else If Copy(Str,1,4) = 'TOPT' Then {ignore}
558 Begin
559 End
560 Else If Copy(Str,1,4) = 'FMPT' Then {ignore}
561 Begin
562 End
563 Else If Copy(Str,1,5) = 'REPLY' Then
564 Begin
565 TmpStr := StripLead(Copy(Str,8,255),':');
566 TmpStr := Copy(StripBoth(TmpStr,' '),1,100);
567 AddSubField(5, TmpStr);
568 MsgHdr^.JamHdr.ReplyCrc := JamStrCrc(TmpStr);
569 End
570 Else If Copy(Str,1,4) = 'PATH' Then
571 Begin
572 TmpStr := StripLead(Copy(Str,5,255),':');
573 TmpStr := StripBoth(TmpStr,' ');
574 AddSubField(2002, TmpStr);
575 End
576 Else
577 Begin
578 AddSubField(2000, StripBoth(Str,' '));
579 End;
580 End;
581
582
583 Procedure JamMsgObj.AddSubField(id: Word; Data: String);
584 Type SubFieldType = Record
585 LoId: Word;
586 HiId: Word;
587 DataLen: LongInt;
588 Data: Array[1..256] of Char;
589 End;
590
591 Var
592 SubField: ^SubFieldType;
593
594 Begin
595 SubField := @MsgHdr^.SubBuf[MsgHdr^.JamHdr.SubFieldLen + 1];
596 If (MsgHdr^.JamHdr.SubFieldLen + 8 + Length(Data) < JamSubBufSize) Then
597 Begin
598 Inc(MsgHdr^.JamHdr.SubFieldLen, 8 + Length(Data));
599 SubField^.LoId := Id;
600 SubField^.HiId := 0;
601 SubField^.DataLen := Length(Data);
602 Move(Data[1], SubField^.Data[1], Length(Data));
603 End;
604 End;
605
606
JamMsgObj.WriteMsgnull607 Function JamMsgObj.WriteMsg: Word;
608 Var
609 {$IFDEF WINDOWS}
610 DT: TDateTime;
611 {$ELSE}
612 DT: DateTime;
613 {$ENDIF}
614 WriteError: Word;
615 {$IFDEF VirtualPascal}
616 i: LongInt;
617 {$ELSE}
618 {$IfDef SPEED}
619 i: LongWord;
620 {$Else}
621 i: Word;
622 {$EndIf}
623 {$ENDIF}
624 TmpIdx: JamIdxType;
625
626 Begin
627 WriteError := 0;
628 If Wrapped Then
629 Begin
630 DoChar(#13);
631 DoChar(#10);
632 End;
633 If WriteError = 0 Then
634 Begin
635 MsgHdr^.JamHdr.Signature[1] := 'J';{Set signature}
636 MsgHdr^.JamHdr.Signature[2] := 'A';
637 MsgHdr^.JamHdr.Signature[3] := 'M';
638 MsgHdr^.JamHdr.Signature[4] := #0;
639 Case JM^.MailType of
640 mmtNormal: SetAttr1(Jam_TypeLocal, True);
641 mmtEchoMail: SetAttr1(Jam_TypeEcho, True);
642 mmtNetMail: SetAttr1(Jam_TypeNet, True);
643 End;
644 MsgHdr^.JamHdr.Rev := 1;
645 MsgHdr^.JamHdr.DateArrived := ToUnixDate(GetDosDate); {Get date processed}
646 DT.Year := Str2Long(Copy(JM^.MsgDate, 7, 2)); {Convert date written}
647 DT.Month := Str2Long(Copy(JM^.MsgDate, 1, 2));
648 DT.Day := Str2Long(Copy(JM^.MsgDate, 4, 2));
649 If DT.Year < 80 Then
650 Inc(DT.Year, 2000)
651 Else
652 Inc(DT.Year, 1900);
653 DT.Sec := 0;
654 DT.Hour := Str2Long(Copy(JM^.MsgTime, 1, 2));
655 DT.Min := Str2Long(Copy(JM^.MsgTime, 4, 2));
656 MsgHdr^.JamHdr.DateWritten := DTToUnixDate(DT);
657 End;
658 If WriteError = 0 Then
659 Begin {Lock message base for update}
660 If Not LockMsgBase Then
661 WriteError := 5;
662 End;
663 If WriteError = 0 Then
664 Begin {Handle message text}
665 MsgHdr^.JamHdr.TextOfs := FileSize(JM^.TxtFile);
666 MsgHdr^.JamHdr.MsgNum := GetHighMsgNum + 1;
667 MsgHdr^.Jamhdr.TextLen := JM^.TxtPos;
668 If JM^.TxtBufStart > 0 Then
669 Begin {Write text using buffer file}
670 i := JM^.TxtPos - JM^.TxtBufStart;
671 BlockWrite(JM^.BufFile, TxtBuf^, i); {write buffer to file}
672 WriteError := IoResult;
673 If WriteError = 0 Then {seek start of buffer file}
674 Begin
675 Seek(JM^.BufFile, 0);
676 WriteError := IoResult;
677 End;
678 If WriteError = 0 Then {seek end of text file}
679 Begin
680 Seek(JM^.TxtFile, FileSize(JM^.TxtFile));
681 WriteError := IoResult;
682 End;
683 While ((Not Eof(JM^.BufFile)) and (WriteError = 0)) Do
684 Begin {copy buffer file to text file}
685 BlockRead(JM^.BufFile, TxtBuf^, SizeOf(TxtBuf^), i);
686 WriteError := IoResult;
687 If WriteError = 0 Then
688 Begin
689 JM^.TxtBufStart := FilePos(JM^.TxtFile);
690 JM^.TxtRead := i;
691 BlockWrite(JM^.TxtFile, TxtBuf^, i);
692 Error := IoResult;
693 End;
694 End;
695 Close(JM^.BufFile);
696 Error := IoResult;
697 Erase(JM^.BufFile);
698 Error := IoResult;
699 End
700 Else
701 Begin {Write text using TxtBuf only}
702 Seek(JM^.Txtfile, FileSize(JM^.TxtFile));
703 WriteError := IoResult;
704 If WriteError = 0 Then
705 Begin
706 BlockWrite(JM^.TxtFile, TxtBuf^, JM^.TxtPos);
707 WriteError := IoResult;
708 JM^.TxtRead := JM^.TxtPos;
709 End;
710 End;
711 If WriteError = 0 Then {Add index record}
712 Begin
713 TmpIdx.HdrLoc := FileSize(JM^.HdrFile);
714 TmpIdx.MsgToCrc := JamStrCrc(JM^.MsgTo);
715 Seek(JM^.IdxFile, FileSize(JM^.IdxFile));
716 WriteError := IoResult;
717 End;
718 If WriteError = 0 Then {write index record}
719 Begin
720 BlockWrite(JM^.IdxFile, TmpIdx, 1);
721 WriteError := IoResult;
722 End;
723 If WriteError = 0 Then
724 Begin {Add subfields as needed}
725 If Length(JM^.MsgTo) > 0 Then
726 AddSubField(3, JM^.MsgTo);
727 If Length(JM^.MsgFrom) > 0 Then
728 AddSubField(2, JM^.MsgFrom);
729 If Length(JM^.MsgSubj) > 0 Then
730 Begin
731 If IsFileReq Then
732 AddSubField(11, JM^.MsgSubj)
733 Else
734 AddSubField(6, JM^.MsgSubj);
735 End;
736 If ((JM^.Dest.Zone <> 0) or (JM^.Dest.Net <> 0) or
737 (JM^.Dest.Node <> 0) or (JM^.Dest.Point <> 0)) Then
738 AddSubField(1, AddrStr(JM^.Dest));
739 If ((JM^.Orig.Zone <> 0) or (JM^.Orig.Net <> 0) or
740 (JM^.Orig.Node <> 0) or (JM^.Orig.Point <> 0)) Then
741 AddSubField(0, AddrStr(JM^.Orig));
742 Seek(JM^.HdrFile, FileSize(JM^.HdrFile)); {Seek to end of .jhr file}
743 WriteError := IoResult;
744 End;
745 If WriteError = 0 Then
746 Begin {write msg header}
747 BlockWrite(JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^.JamHdr) +
748 MsgHdr^.JamHdr.SubFieldLen);
749 WriteError := IoResult;
750 End;
751 If WriteError = 0 Then
752 Begin {update msg base header}
753 Inc(JM^.BaseHdr.ActiveMsgs);
754 Inc(JM^.BaseHdr.ModCounter);
755 End;
756 If UnLockMsgBase Then; {unlock msg base}
757 End;
758 WriteMsg := WriteError; {return result of writing msg}
759 End;
760
761
JamMsgObj.GetCharnull762 Function JamMsgObj.GetChar: Char;
763 {$IfDef SPEED}
764 Var
765 NR: LongWord;
766 {$EndIf}
767
768 Begin
769 If JM^.TxtPos < 0 Then
770 Begin
771 GetChar := JM^.TxtSubBuf[JM^.TxtSubChars + JM^.TxtPos];
772 Inc(JM^.TxtPos);
773 If JM^.TxtPos >= 0 Then
774 JM^.TxtPos := MsgHdr^.JamHdr.TextOfs;
775 End
776 Else
777 Begin
778 If ((JM^.TxtPos < JM^.TxtBufStart) Or
779 (JM^.TxtPos >= JM^.TxtBufStart + JM^.TxtRead)) Then
780 Begin
781 JM^.TxtBufStart := JM^.TxtPos - 80;
782 If JM^.TxtBufStart < 0 Then
783 JM^.TxtBufStart := 0;
784 Seek(JM^.TxtFile, JM^.TxtBufStart);
785 Error := IoResult;
786 If Error = 0 Then
787 Begin
788 {$IfDef SPEED}
789 BlockRead(JM^.TxtFile, TxtBuf^, SizeOf(TxtBuf^), NR);
790 JM^.TxtRead := NR;
791 {$Else}
792 BlockRead(JM^.TxtFile, TxtBuf^, SizeOf(TxtBuf^), JM^.TxtRead);
793 {$EndIf}
794 Error := IoResult;
795 End;
796 End;
797 GetChar := TxtBuf^[JM^.TxtPos - JM^.TxtBufStart];
798 Inc(JM^.TxtPos);
799 End;
800 EOM := (((JM^.TxtPos < MsgHdr^.JamHdr.TextOfs) Or
801 (JM^.TxtPos > JM^.TxtEnd)) And (JM^.TxtPos >= 0));
802 End;
803
804
805
806 Procedure JamMsgObj.AddTxtSub(St: String);
807 Var
808 i: Word;
809
810 Begin
811 For i := 1 to Length(St) Do
812 Begin
813 If JM^.TxtSubChars <= TxtSubBufSize Then
814 Begin
815 JM^.TxtSubBuf[JM^.TxtSubChars] := St[i];
816 Inc(JM^.TxtSubChars);
817 End;
818 End;
819 If JM^.TxtSubChars <= TxtSubBufSize Then
820 Begin
821 JM^.TxtSubBuf[JM^.TxtSubChars] := #13;
822 Inc(JM^.TxtSubChars);
823 End;
824 End;
825
826
827 Procedure JamMsgObj.InitMsgHdr;
828 Var
829 SubCtr: LongInt;
830 SubPtr: ^SubFieldType;
831 {$IFDEF VirtualPascal}
832 NumRead: LongInt;
833 {$ELSE}
834 {$IfDef SPEED}
835 NumRead: LongWord;
836 {$Else}
837 NumRead: Word;
838 {$EndIf}
839 {$ENDIF}
840 {$IFDEF WINDOWS}
841 DT: TDateTime;
842 {$ELSE}
843 DT: DateTime;
844 {$ENDIF}
845 IdxLoc: LongInt;
846 TmpStr: String;
847 TmpAddr: AddrType;
848
849 Begin
850 Error := 0;
851 Wrapped := False;
852 JM^.MsgFrom := '';
853 JM^.MsgTo := '';
854 JM^.MsgSubj := '';
855 JM^.TxtSubChars := 0;
856 If SeekFound Then begin
857 ReReadIdx(IdxLoc);
858 Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc);
859 BlockRead(JM^.HdrFile, MsgHdr^, SizeOf(MsgHdr^), NumRead);
860 Error := IoResult;
861 If Error = 0 Then begin
862 UnixToDt(MsgHdr^.JamHdr.DateWritten, DT);
863 JM^.MsgDate := FormattedDate(Dt, 'MM-DD-YY');
864 JM^.MsgTime := FormattedDate(Dt, 'HH:II');
865 SubCtr := 1;
866 While ((SubCtr <= MsgHdr^.JamHdr.SubFieldLen) and
867 (SubCtr < JamSubBufSize)) Do begin
868 SubPtr := @MsgHdr^.SubBuf[SubCtr];
869 Inc(SubCtr, SubPtr^.DataLen + 8);
870 Case(SubPtr^.LoId) Of
871 0: Begin {Orig}
872 FillChar(TmpAddr, SizeOf(TmpAddr), #0);
873 FillChar(JM^.Orig, SizeOf(JM^.Orig), #0);
874 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
875 If Ord(TmpStr[0]) > 128 Then
876 TmpStr[0] := #128;
877 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
878 ParseAddr(TmpStr, JM^.Orig);
879 End;
880 1: Begin {Dest}
881 FillChar(TmpAddr, SizeOf(TmpAddr), #0);
882 FillChar(JM^.Dest, SizeOf(JM^.Dest), #0);
883 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
884 If Ord(TmpStr[0]) > 128 Then
885 TmpStr[0] := #128;
886 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
887 ParseAddr(TmpStr, JM^.Dest);
888 End;
889 2: Begin {MsgFrom}
890 JM^.MsgFrom[0] := Chr(SubPtr^.DataLen and $ff);
891 If Ord(JM^.MsgFrom[0]) > 65 Then
892 JM^.MsgFrom[0] := #65;
893 Move(SubPtr^.Data, JM^.MsgFrom[1], Ord(JM^.MsgFrom[0]));
894 End;
895 3: Begin {MsgTo}
896 JM^.MsgTo[0] := Chr(SubPtr^.DataLen and $ff);
897 If Ord(JM^.MsgTo[0]) > 65 Then
898 JM^.MsgTo[0] := #65;
899 Move(SubPtr^.Data, JM^.MsgTo[1], Ord(JM^.MsgTo[0]));
900 End;
901 4: Begin {MsgId}
902 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
903 If Ord(TmpStr[0]) > 240 Then
904 TmpSTr[0] := #240;
905 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
906 AddTxtSub(#1'MSGID: ' + TmpStr);
907 End;
908 5: Begin {Reply}
909 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
910 If Ord(TmpStr[0]) > 240 Then
911 TmpSTr[0] := #240;
912 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
913 AddTxtSub(#1'REPLY: ' + TmpStr);
914 End;
915 6: Begin {MsgSubj}
916 JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff);
917 If Ord(JM^.MsgSubj[0]) > 100 Then
918 JM^.MsgSubj[0] := #100;
919 Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0]));
920 End;
921 7: Begin {PID}
922 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
923 If Ord(TmpStr[0]) > 240 Then
924 TmpSTr[0] := #240;
925 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
926 AddTxtSub(#1'PID: ' + TmpStr);
927 End;
928 8: Begin {VIA}
929 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
930 If Ord(TmpStr[0]) > 240 Then
931 TmpSTr[0] := #240;
932 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
933 AddTxtSub(#1'Via ' + TmpStr);
934 End;
935 9: Begin {File attached}
936 If IsFAttach Then
937 Begin
938 JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff);
939 If Ord(JM^.MsgSubj[0]) > 100 Then
940 JM^.MsgSubj[0] := #100;
941 Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0]));
942 End
943 End;
944 11: Begin {File request}
945 If IsFileReq Then
946 Begin
947 JM^.MsgSubj[0] := Chr(SubPtr^.DataLen and $ff);
948 If Ord(JM^.MsgSubj[0]) > 100 Then
949 JM^.MsgSubj[0] := #100;
950 Move(SubPtr^.Data, JM^.MsgSubj[1], Ord(JM^.MsgSubj[0]));
951 End
952 End;
953 2000: Begin {Unknown kludge}
954 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
955 If Ord(TmpStr[0]) > 240 Then
956 TmpSTr[0] := #240;
957 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
958 AddTxtSub(#1 + TmpStr);
959 End;
960 2001: Begin {SEEN-BY}
961 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
962 If Ord(TmpStr[0]) > 240 Then
963 TmpSTr[0] := #240;
964 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
965 AddTxtSub(#1'SEEN-BY: ' + TmpStr);
966 End;
967 2002: Begin {PATH}
968 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
969 If Ord(TmpStr[0]) > 240 Then
970 TmpSTr[0] := #240;
971 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
972 AddTxtSub(#1'PATH: ' + TmpStr);
973 End;
974 2003: Begin {FLAGS}
975 TmpStr[0] := Chr(SubPtr^.DataLen and $ff);
976 If Ord(TmpStr[0]) > 240 Then
977 TmpSTr[0] := #240;
978 Move(SubPtr^.Data, TmpStr[1], Ord(TmpStr[0]));
979 AddTxtSub(#1'FLAGS: ' + TmpStr);
980 End;
981 End;
982 End;
983 End;
984 End;
985 End;
986
987
988 Procedure JamMsgObj.MsgTxtStartUp;
989 Begin
990 Wrapped := False;
991 EOM:=False;
992 JM^.TxtEnd := MsgHdr^.JamHdr.TextOfs + MsgHdr^.JamHdr.TextLen - 1;
993 If JM^.TxtSubChars > 0 Then
994 JM^.TxtPos := - JM^.TxtSubChars
995 Else
996 JM^.TxtPos := MsgHdr^.JamHdr.TextOfs;
997 End;
998
999
JamMsgObj.GetStringnull1000 Function JamMsgObj.GetString: String;
1001 Var
1002 WPos: LongInt;
1003 WLen: Byte;
1004 StrDone: Boolean;
1005 TxtOver: Boolean;
1006 StartSoft: Boolean;
1007 CurrLen: Word;
1008 PPos: LongInt;
1009 TmpCh: Char;
1010
1011 Begin
1012 StrDone := False;
1013 CurrLen := 0;
1014 PPos := JM^.TxtPos;
1015 WPos := 0;
1016 WLen := 0;
1017 StartSoft := Wrapped;
1018 Wrapped := True;
1019 TmpCh := GetChar;
1020 While ((Not StrDone) And (CurrLen < MaxLen) And (Not EOM)) Do
1021 Begin
1022 Case TmpCh of
1023 #$00:;
1024 #$0d: Begin
1025 StrDone := True;
1026 Wrapped := False;
1027 End;
1028 #$8d:;
1029 #$0a:;
1030 #$20: Begin
1031 If ((CurrLen <> 0) or (Not StartSoft)) Then
1032 Begin
1033 Inc(CurrLen);
1034 WLen := CurrLen;
1035 GetString[CurrLen] := TmpCh;
1036 WPos := JM^.TxtPos;
1037 End
1038 Else
1039 StartSoft := False;
1040 End;
1041 Else
1042 Begin
1043 Inc(CurrLen);
1044 GetString[CurrLen] := TmpCh;
1045 End;
1046 End;
1047 If Not StrDone Then
1048 TmpCh := GetChar;
1049 End;
1050 If StrDone Then
1051 Begin
1052 GetString[0] := Chr(CurrLen);
1053 End
1054 Else
1055 If EOM Then Begin
1056 GetString[0] := Chr(CurrLen);
1057 End
1058 Else
1059 Begin
1060 If WLen = 0 Then Begin
1061 GetString[0] := Chr(CurrLen);
1062 Dec(JM^.TxtPos);
1063 End
1064 Else
1065 Begin
1066 GetString[0] := Chr(WLen);
1067 JM^.TxtPos := WPos;
1068 End;
1069 End;
1070 EOM := (((JM^.TxtPos < MsgHdr^.JamHdr.TextOfs) Or
1071 (JM^.TxtPos > JM^.TxtEnd)) And (JM^.TxtPos >= 0));
1072 End;
1073
1074
1075
JamMsgObj.GetFromnull1076 Function JamMsgObj.GetFrom: String; {Get from name on current msg}
1077 Begin
1078 GetFrom := JM^.MsgFrom;
1079 End;
1080
1081
JamMsgObj.GetTonull1082 Function JamMsgObj.GetTo: String; {Get to name on current msg}
1083 Begin
1084 GetTo := JM^.MsgTo;
1085 End;
1086
1087
JamMsgObj.GetSubjnull1088 Function JamMsgObj.GetSubj: String; {Get subject on current msg}
1089 Begin
1090 GetSubj := JM^.MsgSubj;
1091 End;
1092
1093
JamMsgObj.GetCostnull1094 Function JamMsgObj.GetCost: Word; {Get cost of current msg}
1095 Begin
1096 GetCost := MsgHdr^.JamHdr.Cost;
1097 End;
1098
1099
JamMsgObj.GetDatenull1100 Function JamMsgObj.GetDate: String; {Get date of current msg}
1101 Begin
1102 GetDate := JM^.MsgDate;
1103 End;
1104
1105
JamMsgObj.GetTimenull1106 Function JamMsgObj.GetTime: String; {Get time of current msg}
1107 Begin
1108 GetTime := JM^.MsgTime;
1109 End;
1110
1111
JamMsgObj.GetRefernull1112 Function JamMsgObj.GetRefer: LongInt; {Get reply to of current msg}
1113 Begin
1114 GetRefer := MsgHdr^.JamHdr.ReplyTo;
1115 End;
1116
1117
JamMsgObj.GetSeeAlsonull1118 Function JamMsgObj.GetSeeAlso: LongInt; {Get see also of current msg}
1119 Begin
1120 GetSeeAlso := MsgHdr^.JamHdr.ReplyFirst;
1121 End;
1122
1123
JamMsgObj.GetMsgNumnull1124 Function JamMsgObj.GetMsgNum: LongInt; {Get message number}
1125 var
1126 IdxLoc: Longint;
1127 Begin
1128 If SeekFound Then begin
1129 ReReadIdx(IdxLoc);
1130 Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc);
1131 BlockRead(JM^.HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr));
1132 GetMsgNum := MsgHdr^.JamHdr.MsgNum;
1133 end else
1134 GetMsgNum := 0;
1135 End;
1136
1137
1138 Procedure JamMsgObj.GetOrig(Var Addr: AddrType); {Get origin address}
1139 Begin
1140 Addr := JM^.Orig;
1141 End;
1142
1143
1144 Procedure JamMsgObj.GetDest(Var Addr: AddrType); {Get destination address}
1145 Begin
1146 Addr := JM^.Dest;
1147 End;
1148
1149
JamMsgObj.IsLocalnull1150 Function JamMsgObj.IsLocal: Boolean; {Is current msg local}
1151 Begin
1152 IsLocal := (MsgHdr^.JamHdr.Attr1 and Jam_Local) <> 0;
1153 End;
1154
1155
JamMsgObj.IsCrashnull1156 Function JamMsgObj.IsCrash: Boolean; {Is current msg crash}
1157 Begin
1158 IsCrash := (MsgHdr^.JamHdr.Attr1 and Jam_Crash) <> 0;
1159 End;
1160
1161
JamMsgObj.IsKillSentnull1162 Function JamMsgObj.IsKillSent: Boolean; {Is current msg kill sent}
1163 Begin
1164 IsKillSent := (MsgHdr^.JamHdr.Attr1 and Jam_KillSent) <> 0;
1165 End;
1166
1167
JamMsgObj.IsSentnull1168 Function JamMsgObj.IsSent: Boolean; {Is current msg sent}
1169 Begin
1170 IsSent := (MsgHdr^.JamHdr.Attr1 and Jam_Sent) <> 0;
1171 End;
1172
1173
JamMsgObj.IsFAttachnull1174 Function JamMsgObj.IsFAttach: Boolean; {Is current msg file attach}
1175 Begin
1176 IsFAttach := (MsgHdr^.JamHdr.Attr1 and Jam_FAttch) <> 0;
1177 End;
1178
1179
JamMsgObj.IsReqRctnull1180 Function JamMsgObj.IsReqRct: Boolean; {Is current msg request receipt}
1181 Begin
1182 IsReqRct := (MsgHdr^.JamHdr.Attr1 and Jam_RcptReq) <> 0;
1183 End;
1184
1185
JamMsgObj.IsReqAudnull1186 Function JamMsgObj.IsReqAud: Boolean; {Is current msg request audit}
1187 Begin
1188 IsReqAud := (MsgHdr^.JamHdr.Attr1 and Jam_ConfmReq) <> 0;
1189 End;
1190
1191
JamMsgObj.IsRetRctnull1192 Function JamMsgObj.IsRetRct: Boolean; {Is current msg a return receipt}
1193 Begin
1194 IsRetRct := False;
1195 End;
1196
1197
JamMsgObj.IsFileReqnull1198 Function JamMsgObj.IsFileReq: Boolean; {Is current msg a file request}
1199 Begin
1200 IsFileReq := (MsgHdr^.JamHdr.Attr1 and Jam_Freq) <> 0;
1201 End;
1202
1203
JamMsgObj.IsRcvdnull1204 Function JamMsgObj.IsRcvd: Boolean; {Is current msg received}
1205 Begin
1206 IsRcvd := (MsgHdr^.JamHdr.Attr1 and Jam_Rcvd) <> 0;
1207 End;
1208
1209
JamMsgObj.IsPrivnull1210 Function JamMsgObj.IsPriv: Boolean; {Is current msg priviledged/private}
1211 Begin
1212 IsPriv := (MsgHdr^.JamHdr.Attr1 and Jam_Priv) <> 0;
1213 End;
1214
JamMsgObj.IsHoldnull1215 Function JamMsgObj.IsHold: Boolean; {Is current msg hold}
1216 Begin
1217 IsHold := (MsgHdr^.JamHdr.Attr1 and Jam_Hold) <> 0;
1218 End;
1219
JamMsgObj.IsDeletednull1220 Function JamMsgObj.IsDeleted: Boolean; {Is current msg deleted}
1221 Begin
1222 IsDeleted := (MsgHdr^.JamHdr.Attr1 and Jam_Deleted) <> 0;
1223 End;
1224
1225
1226 procedure JamMsgObj.SetDeleted(tr: boolean);
1227 begin
1228 if tr then
1229 MsgHdr^.JamHdr.Attr1:=MsgHdr^.JamHdr.Attr1 or Jam_Deleted
1230 else
1231 MsgHdr^.JamHdr.Attr1:=MsgHdr^.JamHdr.Attr1 and not Jam_Deleted;
1232 end;
1233
1234
JamMsgObj.IsEchoednull1235 Function JamMsgObj.IsEchoed: Boolean; {Is current msg echoed}
1236 Begin
1237 IsEchoed := True;
1238 End;
1239
1240
1241 Procedure JamMsgObj.SeekFirst(MsgNum: LongInt); {Start msg seek}
1242 Begin
1243 JM^.CurrMsgNum := MsgNum - 1;
1244 If JM^.CurrMsgNum < (JM^.BaseHdr.BaseMsgNum - 1) Then JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1;
1245 SeekNext;
1246 End;
1247
1248
1249 Procedure JamMsgObj.SeekNext; {Find next matching msg}
1250 Var
1251 IdxLoc: LongInt;
1252 Begin
1253 If JM^.CurrMsgNum <= GetHighMsgNum Then Inc(JM^.CurrMsgNum);
1254 Error := ReReadIdx(IdxLoc);
1255 While ((JM^.CurrMsgNum <= GetHighMsgNum) and
1256 ((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or
1257 (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1))) Do Begin
1258 Inc(JM^.CurrMsgNum);
1259 Error := ReReadIdx(IdxLoc);
1260 End;
1261 End;
1262
1263
1264 Procedure JamMsgObj.SeekPrior;
1265 Var
1266 IdxLoc: LongInt;
1267 Begin
1268 If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then Dec(JM^.CurrMsgNum);
1269 Error := ReReadIdx(IdxLoc);
1270 If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then Begin
1271 While (JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and
1272 ((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or
1273 (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) Do Begin
1274 Dec(JM^.CurrMsgNum);
1275 Error := ReReadIdx(IdxLoc);
1276 End;
1277 End;
1278 End;
1279
1280
JamMsgObj.SeekFoundnull1281 Function JamMsgObj.SeekFound: Boolean;
1282 Begin
1283 SeekFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and
1284 (JM^.CurrMsgNum <= GetHighMsgNum));
1285 End;
1286
1287
JamMsgObj.GetMsgLocnull1288 Function JamMsgObj.GetMsgLoc: LongInt; {Msg location}
1289 Begin
1290 GetMsgLoc := GetMsgNum;
1291 End;
1292
1293
1294 Procedure JamMsgObj.SetMsgLoc(ML: LongInt); {Msg location}
1295 Begin
1296 JM^.CurrMsgNum := ML;
1297 End;
1298
1299
1300 Procedure JamMsgObj.StartNewMsg;
1301 Begin
1302 JM^.TxtBufStart := 0;
1303 JM^.TxtPos := 0;
1304 FillChar(MsgHdr^, SizeOf(MsgHdr^), #0);
1305 MsgHdr^.JamHdr.SubFieldLen := 0;
1306 MsgHdr^.JamHdr.MsgIdCrc := -1;
1307 MsgHdr^.JamHdr.ReplyCrc := -1;
1308 MsgHdr^.JamHdr.PwdCrc := -1;
1309 JM^.MsgTo := '';
1310 JM^.MsgFrom := '';
1311 JM^.MsgSubj := '';
1312 FillChar(JM^.Orig, SizeOf(JM^.Orig), #0);
1313 FillChar(JM^.Dest, SizeOf(JM^.Dest), #0);
1314 JM^.MsgDate := DateStr(GetDosDate);
1315 JM^.MsgTime := TimeStr(GetDosDate);
1316 End;
1317
1318
JamMsgObj.MsgBaseExistsnull1319 Function JamMsgObj.MsgBaseExists: Boolean;
1320 Begin
1321 MsgBaseExists := (FileExist(JM^.MsgPath + '.jhr'));
1322 End;
1323
1324
JamMsgObj.ReadIdxnull1325 function JamMsgObj.ReadIdx: Word;
1326 {$IfDef SPEED}
1327 Var
1328 NR: LongWord;
1329 {$EndIf}
1330
1331 begin
1332 If JM^.IdxStart < 0 Then JM^.IdxStart := 0;
1333 Seek(JM^.IdxFile, JM^.IdxStart);
1334 {$IfDef SPEED}
1335 BlockRead(JM^.IdxFile, JamIdx^, JamIdxBufSize, NR);
1336 JM^.IdxRead := NR;
1337 {$Else}
1338 BlockRead(JM^.IdxFile, JamIdx^, JamIdxBufSize, JM^.IdxRead);
1339 {$EndIf}
1340 ReadIdx := IoResult;
1341 end;
1342
JamMsgObj.WriteIdxnull1343 function JamMsgObj.WriteIdx: Word;
1344 begin
1345 Seek(JM^.IdxFile, JM^.IdxStart);
1346 BlockWrite(JM^.IdxFile, JamIdx^, JM^.IdxRead);
1347 WriteIdx := IoResult;
1348 end;
1349
JamMsgObj.OpenMsgBasenull1350 Function JamMsgObj.OpenMsgBase: Word;
1351 Var
1352 OpenError: Word;
1353
1354 Begin
1355 OpenError := 0;
1356 JM^.LockCount := 0;
1357 Assign(JM^.HdrFile, JM^.MsgPath + '.jhr');
1358 Assign(JM^.TxtFile, JM^.MsgPath + '.jdt');
1359 Assign(JM^.IdxFile, JM^.MsgPath + '.jdx');
1360 FileMode := fmReadWrite + fmDenyNone;
1361 Reset(JM^.HdrFile, 1);
1362 OpenError := IoResult;
1363 If OpenError = 0 Then
1364 Begin
1365 { Seek(JM^.HdrFile, 1);}
1366 BlockRead(JM^.HdrFile, JM^.BaseHdr.Signature{[2]} , SizeOf(JM^.BaseHdr){ - 1});
1367 OpenError := IoResult;
1368 End;
1369 If OpenError = 0 Then
1370 Begin
1371 FileMode := fmReadWrite + fmDenyNone;
1372 Reset(JM^.TxtFile, 1);
1373 OpenError := IoResult;
1374 End;
1375 If OpenError = 0 Then
1376 Begin
1377 FileMode := fmReadWrite + fmDenyNone;
1378 Reset(JM^.IdxFile, SizeOf(JamIdxType));
1379 OpenError := IoResult;
1380 End;
1381 JM^.IdxStart := -10;
1382 JM^.IdxRead := 0;
1383 JM^.TxtBufStart := - 10;
1384 JM^.TxtRead := 0;
1385 OpenMsgBase := OpenError;
1386 End;
1387
1388
JamMsgObj.CloseMsgBasenull1389 Function JamMsgObj.CloseMsgBase: Word;
1390 Var
1391 w, CloseError: Word;
1392
1393 Begin
1394 Close(JM^.HdrFile);
1395 CloseError := IoResult;
1396 Close(JM^.TxtFile);
1397 If CloseError = 0 Then
1398 CloseError := IoResult;
1399 Close(JM^.IdxFile);
1400 If CloseError = 0 Then
1401 CloseError := IoResult;
1402 w := IoResult;
1403 CloseMsgBase := CloseError;
1404 End;
1405
1406
JamMsgObj.CreateMsgBasenull1407 Function JamMsgObj.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Word;
1408 Var
1409 TmpHdr: ^JamHdrType;
1410 CreateError: Word;
1411 i: Word;
1412
1413 Begin
1414 CreateError := 0;
1415 i := PosLastChar(DirSep, JM^.MsgPath);
1416 If i > 0 Then Begin
1417 If Not MakePath(Copy(JM^.MsgPath, 1, i)) Then
1418 CreateError := 0;
1419 End;
1420 New(TmpHdr);
1421 If TmpHdr = Nil Then
1422 CreateError := 500
1423 Else Begin;
1424 FillChar(TmpHdr^, SizeOf(TmpHdr^), #0);
1425 TmpHdr^.Signature[1] := 'J';
1426 TmpHdr^.Signature[2] := 'A';
1427 TmpHdr^.Signature[3] := 'M';
1428 TmpHdr^.BaseMsgNum := 1;
1429 TmpHdr^.Created := ToUnixDate(GetDosDate);
1430 TmpHdr^.PwdCrc := -1;
1431 CreateError := SaveFile(JM^.MsgPath + '.jhr', TmpHdr^, SizeOf(TmpHdr^));
1432 Dispose(TmpHdr);
1433 If CreateError = 0 Then CreateError := SaveFile(JM^.MsgPath + '.jlr', CreateError, 0);
1434 If CreateError = 0 Then CreateError := SaveFile(JM^.MsgPath + '.jdt', CreateError, 0);
1435 If CreateError = 0 Then CreateError := SaveFile(JM^.MsgPath + '.jdx', CreateError , 0);
1436 If IoResult <> 0 Then;
1437 End;
1438 CreateMsgBase := CreateError;
1439 End;
1440
1441
1442 Procedure JamMsgObj.SetMailType(MT: MsgMailType);
1443 Begin
1444 JM^.MailType := MT;
1445 End;
1446
1447
JamMsgObj.GetSubAreanull1448 Function JamMsgObj.GetSubArea: Word;
1449 Begin
1450 GetSubArea := 0;
1451 End;
1452
1453
1454 Procedure JamMsgObj.ReWriteHdr;
1455 Var
1456 IdxLoc: LongInt;
1457
1458 Begin
1459 If LockMsgBase Then
1460 Error := 0
1461 Else
1462 Error := 5;
1463 Error := ReReadIdx(IdxLoc);
1464 If Error = 0 Then
1465 Begin
1466 Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc);
1467 Error := IoResult;
1468 End;
1469 If Error = 0 Then
1470 Begin
1471 BlockWrite(JM^.HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr));
1472 Error := IoResult;
1473 End;
1474 If UnLockMsgBase Then;
1475 End;
1476
1477
1478 Procedure JamMsgObj.DeleteMsg;
1479 Var
1480 DelError: Word;
1481 IdxLoc: LongInt;
1482 Begin
1483 If Not IsDeleted Then Begin
1484 If LockMsgBase Then DelError := 0 Else DelError := 5;
1485 If DelError = 0 Then Begin
1486 SetAttr1(Jam_Deleted, True);
1487 Dec(JM^.BaseHdr.ActiveMsgs);
1488 DelError := ReReadIdx(IdxLoc);
1489 End;
1490 If DelError = 0 Then ReWriteHdr;
1491 If DelError = 0 Then Begin
1492 Inc(JM^.BaseHdr.ModCounter);
1493 JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := -1;
1494 JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := -1;
1495 If WriteIdx=0 Then;
1496 End;
1497 If UnLockMsgBase Then;
1498 End;
1499 End;
1500
1501
JamMsgObj.FindLastReadnull1502 function JamMsgObj.FindLastRead(Var LastFile: File; UNum: LongInt): LongInt;
1503 const
1504 LastSize = 50;
1505 type
1506 LastArray = Array[1..LastSize] of JamLastType;
1507 var
1508 LastBuf: ^LastArray;
1509 LastError: Word;
1510 {$IFDEF VirtualPascal}
1511 NumRead: LongInt;
1512 {$ELSE}
1513 {$IfDef SPEED}
1514 NumRead: LongWord;
1515 {$Else}
1516 NumRead: Word;
1517 {$EndIf}
1518 {$ENDIF}
1519 Found: Boolean;
1520 i: Word;
1521 LastStart: LongInt;
1522 begin
1523 FindLastRead := -1;
1524 Found := False;
1525 New(LastBuf);
1526 Seek(LastFile, 0);
1527 LastError := IoResult;
1528 while ((not Eof(LastFile)) and (LastError = 0) and (not Found)) do begin
1529 LastStart := FilePos(LastFile);
1530 BlockRead(LastFile, LastBuf^, LastSize, NumRead);
1531 LastError := IoResult;
1532 for i := 1 to NumRead do begin
1533 if LastBuf^[i].UserNum = UNum then begin
1534 Found := True;
1535 FindLastRead := LastStart + i - 1;
1536 end;
1537 end;
1538 end;
1539 Dispose(LastBuf);
1540 end;
1541
1542
JamMsgObj.GetLastReadnull1543 Function JamMsgObj.GetLastRead: LongInt;
1544 Var
1545 UNum, RecNum: LongInt;
1546 LastFile: File;
1547 TmpLast: JamLastType;
1548
1549 Begin
1550 UNum:={JamStrCrc(Cfg.Username)}0;
1551 Assign(LastFile, JM^.MsgPath + '.jlr');
1552 FileMode := fmReadWrite + fmDenyNone;
1553 Reset(LastFile, SizeOf(JamLastType));
1554 Error := IoResult;
1555 RecNum := FindLastRead(LastFile, UNum);
1556 If RecNum >= 0 Then Begin
1557 Seek(LastFile, RecNum);
1558 If Error = 0 Then Begin
1559 BlockRead(LastFile, TmpLast, 1);
1560 Error := IoResult;
1561 GetLastRead := TmpLast.LastRead;
1562 End;
1563 End Else
1564 GetLastRead := 0;
1565 Close(LastFile);
1566 Error := IoResult;
1567 End;
1568
1569
1570 Procedure JamMsgObj.SetLastRead(LR: LongInt);
1571 Var
1572 UNum, RecNum: LongInt;
1573 LastFile: File;
1574 TmpLast: JamLastType;
1575
1576 Begin
1577 UNum:={JamStrCrc(Cfg.Username)}0;
1578 Assign(LastFile, JM^.MsgPath + '.jlr');
1579 FileMode := fmReadWrite + fmDenyNone;
1580 Reset(LastFile, SizeOf(JamLastType));
1581 if ioresult<>0 then
1582 Rewrite(LastFile, SizeOf(JamLastType));
1583 Error := IoResult;
1584 RecNum := FindLastRead(LastFile, UNum);
1585 If RecNum >= 0 Then
1586 Begin
1587 Seek(LastFile, RecNum);
1588 If Error = 0 Then
1589 Begin
1590 BlockRead(LastFile, TmpLast, 1);
1591 Error := IoResult;
1592 TmpLast.HighRead := JM^.BaseHdr.ActiveMsgs;
1593 TmpLast.LastRead := LR;
1594 If Error = 0 Then
1595 Begin
1596 Seek(LastFile, RecNum);
1597 Error := IoResult;
1598 End;
1599 If Error = 0 Then
1600 Begin
1601 BlockWrite(LastFile, TmpLast, 1);
1602 Error := IoResult;
1603 End;
1604 End;
1605 End
1606 Else
1607 Begin
1608 TmpLast.UserNum := UNum;
1609 TmpLast.HighRead := Lr;
1610 TmpLast.NameCrc := UNum;
1611 TmpLast.LastRead := Lr;
1612 Seek(LastFile, FileSize(LastFile));
1613 Error := IoResult;
1614 If Error = 0 Then
1615 Begin
1616 BlockWrite(LastFile, TmpLast, 1);
1617 Error := IoResult;
1618 End;
1619 End;
1620 Close(LastFile);
1621 Error := IoResult;
1622 End;
1623
1624
JamMsgObj.GetTxtPosnull1625 Function JamMsgObj.GetTxtPos: LongInt;
1626 Begin
1627 GetTxtPos := JM^.TxtPos;
1628 End;
1629
1630
1631 Procedure JamMsgObj.SetTxtPos(TP: LongInt);
1632 Begin
1633 JM^.TxtPos := TP;
1634 End;
1635
1636
JamMsgObj.LockMsgBasenull1637 function JamMsgObj.LockMsgBase: Boolean;
1638 var
1639 LockError: Word;
1640 begin
1641 LockError := 0;
1642 If JM^.LockCount = 0 Then
1643 Begin
1644 If LockError = 0 Then
1645 Begin
1646 LockError := shLock(JM^.HdrFile, 0, 1);
1647 End;
1648 If LockError = 0 Then
1649 Begin
1650 Seek(JM^.HdrFile, 0);
1651 LockError := IoResult;
1652 End;
1653 If LockError = 0 Then
1654 Begin
1655 BlockRead(JM^.HdrFile, JM^.BaseHdr , SizeOf(JM^.BaseHdr));
1656 LockError := IoResult;
1657 End;
1658 End;
1659 Inc(JM^.LockCount);
1660 LockMsgBase := (LockError = 0);
1661 end;
1662
JamMsgObj.UnLockMsgBasenull1663 function JamMsgObj.UnLockMsgBase: Boolean;
1664 var
1665 LockError: Word;
1666 begin
1667 LockError := 0;
1668 if JM^.LockCount > 0 then Dec(JM^.LockCount);
1669 if JM^.LockCount = 0 then begin
1670 If LockError = 0 then begin
1671 LockError := UnLockFile(JM^.HdrFile, 0, 1);
1672 end;
1673 If LockError = 0 Then Begin
1674 Seek(JM^.HdrFile, 0);
1675 LockError := IoResult;
1676 End;
1677 If LockError = 0 Then Begin
1678 BlockWrite(JM^.HdrFile, JM^.BaseHdr, SizeOf(JM^.BaseHdr));
1679 LockError := IoResult;
1680 End;
1681 End;
1682 UnLockMsgBase := (LockError = 0);
1683 end;
1684
1685 procedure JamMsgObj.SetNextSeeAlso(SAlso: LongInt);
1686 begin
1687 MsgHdr^.JamHdr.ReplyNext := SAlso;
1688 end;
1689
JamMsgObj.GetNextSeeAlsonull1690 function JamMsgObj.GetNextSeeAlso: LongInt; {Get next see also of current msg}
1691 begin
1692 GetNextSeeAlso := MsgHdr^.JamHdr.ReplyNext;
1693 end;
1694
JamMsgObj.ReReadIdxnull1695 function JamMsgObj.ReReadIdx(Var IdxLoc : LongInt) : Word;
1696 begin
1697 ReReadIdx := 0;
1698 IdxLoc := JM^.CurrMsgNum - JM^.BaseHdr.BaseMsgNum;
1699 if ((IdxLoc < JM^.IdxStart) or (IdxLoc >= (JM^.IdxStart+JM^.IdxRead))) then begin
1700 JM^.IdxStart := IdxLoc - 100;
1701 ReReadIdx := ReadIdx;
1702 end;
1703 end;
1704
1705
JamMsgObj.NumberOfMsgsnull1706 Function JamMsgObj.NumberOfMsgs: LongInt;
1707 Begin
1708 NumberOfMsgs := {JM^.BaseHdr.ActiveMsgs}GetHighMsgNum;
1709 End;
1710
1711
JamMsgObj.GetRealMsgNumnull1712 function JamMsgObj.GetRealMsgNum: LongInt;
1713 begin
1714 GetRealMsgNum:=GetMsgNum;
1715 end;
1716
JamMsgObj.SetReadnull1717 function JamMsgObj.SetRead(RS: Boolean): boolean;
1718 begin
1719 if IsRead=false then begin
1720 if RS then
1721 inc(MsgHdr^.JamHdr.TimesRead)
1722 else
1723 MsgHdr^.JamHdr.TimesRead:=0;
1724 SetRead:=true;
1725 end else
1726 SetRead:=false;
1727 end;
1728
JamMsgObj.IsReadnull1729 function JamMsgObj.IsRead: Boolean;
1730 begin
1731 IsRead:=(MsgHdr^.JamHdr.TimesRead>0);
1732 end;
1733
1734 end.
1735