1 Program ProTick;
2 {$I-}{$Q-}
3 {$ifdef SPEED}
4 {$Else}
5 {$ifdef VIRTUALPASCAL}
6 {$Define VP}
7 {$M 65520}
8 {$Else}
9 {$M 65520, 0, 655360}
10 {$endif}
11 {$endif}
12 {$ifdef FPC}
13 {$PackRecords 1}
14 {$endif}
15
16 Uses
17 {$ifdef SPEED}
18 BseDOS, BseDev,
19 {$endif}
20 {$ifdef UNIX}
21 {$ifdef FPC}
22 linux,
23 {$endif}
24 {$endif}
25 {$ifndef __GPC__}
26 DOS,
27 {$endif}
28 {$ifndef __GPC__}
29 strings,
30 {$endif}
31 MKGlobT, MKMisc, MKMsgAbs, MKMsgFid, MKMsgEzy, MKMsgJam, MKMsgHud, MKMsgSqu,
32 Types, GeneralP,
33 CRC, Log, IniFile,
34 PTRegKey,
35 TickCons, TickType, PTProcs, PTVar, PTMsg, PTOut,
36 {$ifdef FIDOCONF}
37 smapi, fidoconf, PTFConf;
38 {$Else}
39 PTCfg;
40 {$endif}
41 {$ifdef VP}
42 {$ifdef VPDEMO}
43 {$Dynamic VP11DEMO.LIB}
44 {$endif}
45 {$endif}
46
47 Procedure Toss; Forward;
48 Procedure Hatch; Forward;
49 Procedure NewFilesHatch; Forward;
50 Procedure Scan; Forward;
51 Procedure Maint; Forward;
52 Procedure _Pack; Forward;
53
54 Procedure CheckBsy; Forward;
55 Procedure Init; Forward;
56 Procedure DispAnnList; Forward;
57 Procedure Syntax; Forward;
58 Procedure SendTic(Usr: PUser; Tic: PTick; FName: String); Forward;
59 Function CheckForDupe(Tic:PTick):Boolean; Forward;
60 Procedure WriteDupe(Tic:PTick); Forward;
61 Procedure WriteLName(Path: DirStr; SName: String12; LName: String40); Forward;
62 Procedure AddAnnFile(ar: String; fn: String; desc: PChar2; From: TNetAddr); Forward;
63 Procedure DoAnnounce; Forward;
64 Procedure DoNMAnn; Forward;
65
66 Procedure Done; Far;
67 Var
68 f: Text;
69
70 Begin
71 WriteLn('MemAvail: ', MemAvail);
72 If Debug then
73 Begin
74 WriteLn('<Return>');
75 ReadLn;
76 End;
77 FreeMem(HDesc, 65535);
78 Ini.WriteIni;
79 Ini.Done;
80 If CreatedBsy then
81 Begin
82 Assign(f, Cfg^.FlagDir + DirSep+'protick.bsy');
83 {$I-} Erase(f); {$I+}
84 If (IOResult <> 0) then
85 Begin
86 LogSetCurLevel(LogHandle, 1);
87 LogWriteLn(LogHandle, 'Couldn''t delete '+Cfg^.FlagDir+DirSep+
88 'protick.bsy');
89 End;
90 End;
91 CloseLog(LogHandle);
92 LogDone;
93 DispAnnList;
94 If (Cfg^.Areas <> Nil) then
95 Begin
96 CurArea := Cfg^.Areas;
97 Repeat
98 If CurArea^.Next <> Nil then CurArea := CurArea^.Next
99 Else If CurArea^.Prev <> Nil then
100 Begin
101 CurArea := CurArea^.Prev;
102 If CurArea^.Next^.Users <> Nil then
103 Begin
104 CurConnUser:= CurArea^.Next^.Users;
105 Repeat
106 If CurConnUser^.Next <> Nil then CurConnUser := CurConnUser^.Next
107 Else If CurConnUser^.Prev <> Nil then
108 Begin
109 CurConnUser := CurConnUser^.Prev;
110 Dispose(CurConnUser^.Next);
111 CurConnUser^.Next := Nil;
112 End;
113 Until (CurConnUser = CurArea^.Next^.Users);
114 Dispose(CurArea^.Next^.Users);
115 CurArea^.Next^.Users := Nil;
116 End;
117 Dispose(CurArea^.Next);
118 CurArea^.Next := Nil;
119 End;
120 Until (CurArea = Cfg^.Areas);
121 If CurArea^.Users <> Nil then
122 Begin
123 CurConnUser:=CurArea^.Users;
124 Repeat
125 If CurConnUser^.Next <> Nil then CurConnUser := CurConnUser^.Next
126 Else If CurConnUser^.Prev <> Nil then
127 Begin
128 CurConnUser := CurConnUser^.Prev;
129 Dispose(CurConnUser^.Next);
130 CurConnUser^.Next := Nil;
131 End;
132 Until (CurConnUser = CurArea^.Users);
133 Dispose(CurArea^.Users);
134 CurArea^.Users := Nil;
135 End;
136 Dispose(Cfg^.Areas);
137 Cfg^.Areas := Nil;
138 End;
139 If (Cfg^.Users <> Nil) then
140 Begin
141 CurUser := Cfg^.Users;
142 Repeat
143 If CurUser^.Next <> Nil then CurUser := CurUser^.Next
144 Else If CurUser^.Prev <> Nil then
145 Begin
146 CurUser := CurUser^.Prev;
147 Dispose(CurUser^.Next);
148 CurUser^.Next := Nil;
149 End;
150 Until (CurUser = Cfg^.Users);
151 Dispose(Cfg^.Users);
152 Cfg^.Users := Nil;
153 End;
154 If (Cfg^.UpLinks <> Nil) then
155 Begin
156 CurUpLink := Cfg^.UpLinks;
157 Repeat
158 If CurUpLink^.Next <> Nil then CurUpLink := CurUpLink^.Next
159 Else If CurUpLink^.Prev <> Nil then
160 Begin
161 CurUpLink := CurUpLink^.Prev;
162 Dispose(CurUpLink^.Next);
163 CurUpLink^.Next := Nil;
164 End;
165 Until (CurUpLink = Cfg^.UpLinks);
166 Dispose(Cfg^.UpLinks);
167 Cfg^.UpLinks := Nil;
168 End;
169 If (AutoAddList <> Nil) then
170 Begin
171 CurAutoAddList := AutoAddList;
172 Repeat
173 If CurAutoAddList^.Next <> Nil then CurAutoAddList := CurAutoAddList^.Next
174 Else If CurAutoAddList^.Prev <> Nil then
175 Begin
176 CurAutoAddList := CurAutoAddList^.Prev;
177 Dispose(CurAutoAddList^.Next);
178 CurAutoAddList^.Next := Nil;
179 End;
180 Until (CurAutoAddList = AutoAddList);
181 Dispose(AutoAddList);
182 AutoAddList := Nil;
183 End;
184 If (TossList <> Nil) then
185 Begin
186 CurTossList := TossList;
187 Repeat
188 If CurTossList^.Next <> Nil then CurTossList := CurTossList^.Next
189 Else If CurTossList^.Prev <> Nil then
190 Begin
191 CurTossList := CurTossList^.Prev;
192 Dispose(CurTossList^.Next);
193 CurTossList^.Next := Nil;
194 End;
195 Until (CurTossList = TossList);
196 Dispose(TossList);
197 TossList := Nil;
198 End;
199 Dispose(Cfg);
200 Dispose(Outbound, Done);
201 Cfg := Nil;
202 WriteLn('MemAvail: ', MemAvail);
203 End;
204
205 Procedure CheckBsy;
206 Var
207 f: File;
208 s: String;
209
210 Begin
211 s := Cfg^.FlagDir; {FPC doesn't like "Cfg^.FlagDir+DirSep+'ProTick.BSY'" :( }
212 Assign(f, s + DirSep+'protick.bsy');
213 {$I-} ReSet(f); {$I+}
214 If (IOResult = 0) then
215 Begin
216 WriteLn('protick.bsy found - aborting');
217 LogSetCurLevel(LogHandle, 1);
218 LogWriteLn(LogHandle, 'protick.bsy found - aborting');
219 Close(f);
220 Done;
221 Halt(Err_Bsy);
222 End
223 Else
224 Begin
225 {$I-} ReWrite(f); {$I+}
226 If (IOResult <> 0) then
227 Begin
228 LogSetCurLevel(LogHandle, 1);
229 LogWriteLn(LogHandle, 'Couldn''t create '+Cfg^.FlagDir+DirSep+
230 'protick.bsy!');
231 Done;
232 Halt(Err_Bsy);
233 End;
234 Close(f);
235 End;
236 CreatedBsy := True;
237 End;
238
239
240 Procedure Syntax;
241 Begin
242 WriteLn('Syntax: ProTick <Command> [options]');
243 WriteLn;
244 WriteLn('Valid commands:');
245 WriteLn('TOSS - Process TICs');
246 WriteLn('SCAN - Scan for Mails');
247 WriteLn('HATCH - Hatch file');
248 WriteLn('NEWFILESHATCH / NFH - Hatch new files');
249 WriteLn('MAINT - daily maintenance');
250 WriteLn('PACK - create archives');
251 WriteLn('CHECK - check config');
252 WriteLn;
253 WriteLn('Valid options:');
254 WriteLn('-D[ebug] - debug mode');
255 WriteLn('-C<Config> - use <Config> as config');
256 WriteLn('-nodupe - do not perform dupechecking');
257 WriteLn('File=<File> - [H] file');
258 WriteLn('Area=<Area> - [H] area');
259 WriteLn('Desc=<Desc> - [H] description');
260 WriteLn('Replace=<FileMask> - [H] files to replace');
261 WriteLn('Move=<Yes|No|0|1|True|False> - [H] delete files after hatching');
262 WriteLn('PW=<PassWord> - [H] password');
263 WriteLn('H = Hatch');
264 WriteLn;
265 End;
266
267
268 Procedure Init;
269 Var
270 i: ULong;
271 Error: Integer;
272 s, s1: String;
273 f: Text;
274
275 Begin
276 WriteLn('MemAvail: ', MemAvail);
277 Version := _Version;
278 CurAnnArea := NIL;
279 CurAnnFile := NIL;
280 AnnAreas := NIL;
281 AnnFiles := NIL;
282 MainDone := ProTick.Done;
283 HArea := '';
284 HFile := '';
285 HFrom := EmptyAddr;
286 HTo := EmptyAddr;
287 HOrigin := EmptyAddr;
288 HReplace := '';
289 HMove := False;
290 HPW := '';
291 AutoAddList := NIL;
292 TossList := NIL;
293 CurAutoAddList := NIL;
294 CurTossList := NIL;
295 CreatedBsy := False;
296 Randomize;
297 {$ifdef SPEED}
298 ExecViaSession := False;
299 AsynchExec := False;
300 {$endif}
301 GetMem(HDesc, 65535);
302 HDesc^[0] := #0;
303 If (RegInfo.Ver <> 0) then
304 Begin
305 Version := _Version + '+ #' + IntToStr(RegInfo.Serial);
306 WriteLn('ProTick'+Version);
307 With RegInfo do WriteLn('Registered to '+Name+' ('+Addr2Str(Addr)+')');
308 Case RegInfo.Ver of
309 1: Write('noncommercial version, ');
310 2: Write('commercial version, ');
311 3: Write('author version, ');
312 End;
313 If (RegInfo.Copies = 0) then WriteLn('unlimited copies')
314 Else WriteLn(RegInfo.Copies, ' copies');
315 End
316 Else
317 Begin
318 Version := _Version + ' unreg';
319 WriteLn('ProTick'+Version);
320 End;
321 Debug := False;
322 DupeCheck := True;
323 Command := '';
324 FSplit(ParamStr(0), s1, s, s);
325 s := GetEnv('PT');
326 {$ifdef UNIX}
327 s := FSearch('protick.cfg', '.;'+s+';/etc/fido');
328 {$Else}
329 s := FSearch('protick.cfg', '.;'+s+';c:\fido;'+s1);
330 {$endif}
331 CfgName := s;
332 If (ParamCount < 1) then
333 Begin
334 Syntax;
335 Halt(Err_NoParams);
336 End;
337 For i := 1 to ParamCount do
338 Begin
339 s := RepEnv(UpStr(ParamStr(i)));
340 If (Pos('-D', s) = 1) then Debug := True
341 Else If (Pos('-C', s) = 1) then CfgName := RepEnv(Copy(ParamStr(i), 3, Length(s) - 2))
342 Else If (s = '-NODUPE') then DupeCheck := False
343 Else If (s = 'SCAN') then Command := s
344 Else If (s = 'TOSS') then Command := s
345 Else If (s = 'HATCH') then Command := s
346 Else If (s = 'NEWFILESHATCH') then Command := s
347 Else If (s = 'NFH') then Command := 'NEWFILESHATCH'
348 Else If (s = 'MAINT') then Command := s
349 Else If (s = 'PACK') then Command := s
350 Else If (s = 'CHECK') then Command := s
351 Else If (Pos('AREA', s) = 1) then HArea := RepEnv(Copy(ParamStr(i), 6, Length(s) - 5))
352 Else If (Pos('FILE', s) = 1) then HFile := RepEnv(Copy(ParamStr(i), 6, Length(s) - 5))
353 Else If (Pos('DESC', s) = 1) then StrPCopy(Pointer(HDesc),
354 Translate(RepEnv(Copy(ParamStr(i), 6, Length(s) - 5)), '_', ' '))
355 Else If (Pos('PASSWORD', s) = 1) then HPW := RepEnv(Copy(ParamStr(i), 10, Length(s) - 9))
356 Else If (Pos('PWD', s) = 1) then HPW := RepEnv(Copy(ParamStr(i), 5, Length(s) - 4))
357 Else If (Pos('PW', s) = 1) then HPW := RepEnv(Copy(ParamStr(i), 4, Length(s) - 3))
358 Else If (Pos('REPLACE', s) = 1) then HReplace := RepEnv(Copy(ParamStr(i), 9, Length(s) - 8))
359 Else If (Pos('MOVE', s) = 1) then
360 Begin
361 s := UpStr(RepEnv(Copy(s, 6, Length(s) - 5)));
362 HMove := (s = 'TRUE') or (s = 'ON') or (s = '1') or (s[1] = 'Y') or (s[1] = 'J');
363 End
364 Else
365 Begin
366 WriteLn('Unknown command "'+s+'"');
367 Syntax;
368 Halt(Err_UnknownCommand);
369 End;
370 End;
371 If (CfgName = '') then
372 Begin
373 WriteLn('Could not locate config!');
374 Halt(Err_NoCfg);
375 End
376 Else If not FileExist(CfgName) then
377 Begin
378 WriteLn('Couldn''t open "'+CfgName+'"!');
379 Halt(Err_NoCfg);
380 End;
381 WriteLn;
382 ParseCfg;
383 Case Cfg^.OBType of
384 OB_BT: Outbound := New(pBTOutbound, Init(Cfg, LogHandle, Cfg^.Outbound, Cfg^.Addrs[1]));
385 OB_FD: Outbound := New(pFDOutbound, Init(Copy(Cfg^.Outbound, 1,
386 Pos(',', Cfg^.Outbound)-1), Copy(Cfg^.Outbound, Pos(',', Cfg^.Outbound)+1,
387 Length(Cfg^.Outbound)), LogHandle, Cfg^.TicOut, Cfg^.FlagDir));
388 {OB_TMail: Outbound := New(pTMailOutbound, Init); }
389 Else
390 Begin
391 LogSetCurLevel(LogHandle, 1);
392 LogWriteLn(LogHandle, 'Invalid outbound type!');
393 Done;
394 Halt(Err_Internal);
395 End;
396 End;
397 CheckBsy;
398 End;
399
400 Procedure Toss;
401 Var
402 FName: String;
403 {$ifdef SPEED}
404 SRec: TSearchRec;
405 {$Else}
406 SRec: SearchRec;
407 {$endif}
408 f: Text;
409 Line: String;
410 Tic: PTick;
411 {$ifdef VIRTUALPASCAL}
412 Error: LongInt;
413 {$Else}
414 Error: Integer;
415 {$endif}
416 s: String;
417 s1: String;
418 i: LongInt;
419 DT: TimeTyp;
420 ACArea: PArea;
421 ACCUser: PConnectedUser;
422 a: TNetAddr;
423 bo: Boolean;
424 Local: Boolean;
425 PPos, j: Word;
426 PT: Boolean;
427
428 Procedure ParseTIC;
429 Begin
430 While not EOF(f) do
431 Begin
432 {$I-} ReadLn(f, Line); {$I+}
433 If (Line[Byte(Line[0])] = #13) then Line[0] := Char(Byte(Line[0])-1);
434 If (IOResult <> 0) then
435 Begin
436 LogSetCurLevel(LogHandle, 1);
437 LogWriteLn(LogHandle, 'Error reading "' + Cfg^.InBound+DirSep+
438 SRec.Name+'"!');
439 End;
440 If (Line = '') then
441 Else If (Pos('AREA ', UpStr(Line)) = 1) or (Pos('AREA:', UpStr(Line)) = 1) then
442 Begin
443 Delete(Line, 1, 5);
444 Tic^.Area := UpStr(KillLeadingSpcs(Line));
445 LogSetCurLevel(LogHandle, 3);
446 LogWriteLn(LogHandle, 'Area '+Tic^.Area);
447 End
448 Else If (Pos('AREADESC ', UpStr(Line)) = 1) or (Pos('AREADESC:', UpStr(Line)) = 1) then
449 Begin
450 Delete(Line, 1, 9);
451 Tic^.AreaDesc := KillLeadingSpcs(Line);
452 LogSetCurLevel(LogHandle, 5);
453 LogWriteLn(LogHandle, 'AreaDesc '+ Tic^.AreaDesc);
454 End
455 Else If (Pos('RELEASE ', UpStr(Line)) = 1) or (Pos('RELEASE:', UpStr(Line)) = 1) then
456 Begin
457 Delete(Line, 1, 8);
458 Val('$' + KillLeadingSpcs(Line), Tic^.ReleaseTime, Error);
459 LogSetCurLevel(LogHandle, 3);
460 LogWriteLn(LogHandle, 'Release '+ IntToStr(Tic^.ReleaseTime));
461 End
462 Else If (Pos('REPLACES ', UpStr(Line)) = 1) or (Pos('REPLACES:', UpStr(Line)) = 1) then
463 Begin
464 Delete(Line, 1, 9);
465 Tic^.Replaces := LowStr(KillLeadingSpcs(Line));
466 LogSetCurLevel(LogHandle, 3);
467 LogWriteLn(LogHandle, 'Replaces '+Tic^.Replaces);
468 End
469 Else If (Pos('FILE ', UpStr(Line)) = 1) or (Pos('FILE:', UpStr(Line)) = 1) then
470 Begin
471 Delete(Line, 1, 5);
472 LogSetCurLevel(LogHandle, 3);
473 Tic^.Name := LowStr(KillLeadingSpcs(Line));
474 LogWriteLn(LogHandle, 'File "'+Tic^.Name+'"');
475 End
476 Else If (Pos('SIZE ', UpStr(Line)) = 1) or (Pos('SIZE:', UpStr(Line)) = 1) then
477 Begin
478 Delete(Line, 1, 5);
479 Val(KillLeadingSpcs(Line), Tic^.Size, Error);
480 LogSetCurLevel(LogHandle, 4);
481 LogWriteLn(LogHandle, 'Size '+IntToStr(Tic^.Size));
482 End
483 Else If (Pos('DATE ', UpStr(Line)) = 1) or (Pos('DATE:', UpStr(Line)) = 1) then
484 Begin
485 Delete(Line, 1, 5);
486 Val('$' + KillLeadingSpcs(Line), Tic^.Date, Error);
487 LogSetCurLevel(LogHandle, 4);
488 LogWriteLn(LogHandle, 'Date '+ IntToStr(Tic^.Date));
489 End
490 Else If (Pos('CREATED ', UpStr(Line)) = 1) or (Pos('CREATED:', UpStr(Line)) = 1) then
491 Begin
492 Delete(Line, 1, 8);
493 Tic^.CreatedBy := KillLeadingSpcs(Line);
494 LogSetCurLevel(LogHandle, 5);
495 LogWriteLn(LogHandle, 'Created '+Tic^.CreatedBy);
496 End
497 Else If (Pos('CRC ', UpStr(Line)) = 1) or (Pos('CRC:', UpStr(Line)) = 1) then
498 Begin
499 Delete(Line, 1, 4);
500 Val('$' + KillLeadingSpcs(Line), Tic^.CRC, Error);
501 LogSetCurLevel(LogHandle, 3);
502 LogWriteLn(LogHandle, 'CRC '+WordToHex(word(Tic^.CRC SHR 16))+ WordToHex(word(Tic^.CRC mod 65536)));
503 End
504 Else If (Pos('ORIGIN ', UpStr(Line)) = 1) or (Pos('ORIGIN:', UpStr(Line)) = 1) then
505 Begin
506 Delete(Line, 1, 7);
507 Str2Addr(Line, Tic^.Origin);
508 LogSetCurLevel(LogHandle, 4);
509 LogWriteLn(LogHandle, 'Origin '+Addr2Str(Tic^.Origin));
510 End
511 Else If (Pos('FROM ', UpStr(Line)) = 1) or (Pos('FROM:', UpStr(Line)) = 1) then
512 Begin
513 Delete(Line, 1, 5);
514 Str2Addr(Line, Tic^.From);
515 LogSetCurLevel(LogHandle, 3);
516 LogWriteLn(LogHandle, 'From '+Addr2Str(Tic^.From));
517 End
518 Else If (Pos('TO ', UpStr(Line)) = 1) or (Pos('TO:', UpStr(Line)) = 1) then
519 Begin
520 Delete(Line, 1, 3);
521 If (Pos(',', Line) = 0) then
522 Begin
523 LogSetCurLevel(LogHandle, 4);
524 If (Pos(':', Line) <> 0) and (Pos('/', Line) <> 0) then
525 Begin
526 Str2Addr(Line, Tic^._To);
527 LogWriteLn(LogHandle, 'To '+Addr2Str(Tic^._To));
528 End
529 Else
530 Begin
531 Tic^.ToName := Line;
532 LogWriteLn(LogHandle, 'To '+Tic^.ToName);
533 End;
534 End
535 Else
536 Begin
537 Tic^.ToName := Copy(Line, 1, Pos(',', Line) - 1);
538 Str2Addr(Copy(Line, Pos(',', Line) + 1, Length(Line) - Pos(',', Line)), Tic^._To);
539 LogSetCurLevel(LogHandle, 4);
540 LogWriteLn(LogHandle, 'To '+Tic^.ToName+', '+Addr2Str(Tic^._To));
541 End;
542 End
543 Else If (Pos('TONAME ', UpStr(Line)) = 1) or (Pos('TONAME:', UpStr(Line)) = 1) then
544 Begin
545 Delete(Line, 1, 7);
546 Tic^.ToName := Line;
547 LogSetCurLevel(LogHandle, 4);
548 LogWriteLn(LogHandle, 'ToName '+Tic^.ToName);
549 End
550 Else If (Pos('DEST ', UpStr(Line)) = 1) or (Pos('DEST:', UpStr(Line)) = 1) then
551 Begin
552 Delete(Line, 1, 5);
553 Str2Addr(Line, Tic^._To);
554 LogSetCurLevel(LogHandle, 4);
555 LogWriteLn(LogHandle, 'Dest '+Addr2Str(Tic^._to));
556 End
557 Else If (Pos('DESTINATION ', UpStr(Line)) = 1) or (Pos('DESTINATION:', UpStr(Line)) = 1) then
558 Begin
559 Delete(Line, 1, 12);
560 Str2Addr(Copy(Line, 1, Pos(',', Line) - 1), Tic^._To );
561 Delete(Line, 1, Pos(',', Line));
562 Tic^.ToName := Line;
563 LogSetCurLevel(LogHandle, 4);
564 LogWriteLn(LogHandle, 'Dest '+Addr2Str(Tic^._to));
565 End
566 Else If (Pos('DESC ', UpStr(Line)) = 1) or (Pos('DESC:', UpStr(Line)) = 1) then
567 Begin
568 Delete(Line, 1, 5);
569 Tic^.Desc := KillLeadingSpcs(Line);
570 LogSetCurLevel(LogHandle, 3);
571 LogWriteLn(LogHandle, 'Desc '+ Tic^.Desc);
572 End
573 Else If (Pos('LDESC ', UpStr(Line)) = 1) or (Pos('LDESC:', UpStr(Line)) = 1) then
574 Begin
575 Delete(Line, 1, 6);
576 Inc(Tic^.NumLDesc);
577 Tic^.LDesc[Tic^.NumLDesc] := KillLeadingSpcs(Line);
578 LogSetCurLevel(LogHandle, 3);
579 LogWriteLn(LogHandle, 'LDesc '+Tic^.LDesc[Tic^.NumLDesc]);
580 End
581 Else If (Pos('ERROR ', UpStr(Line)) = 1) or (Pos('ERROR:', UpStr(Line)) = 1) then
582 Begin
583 Delete(Line, 1, 6);
584 LogSetCurLevel(LogHandle, 3);
585 LogWriteLn(LogHandle, 'Previous error '+Line);
586 End
587 Else If (Pos('SEENBY ', UpStr(Line)) = 1) or (Pos('SEENBY:', UpStr(Line)) = 1) then
588 Begin
589 Delete(Line, 1, 7);
590 s := KillLeadingSpcs(Line);
591 While (Pos(' ', s) <> 0) do
592 Begin
593 Inc(Tic^.NumSB);
594 Str2Addr(Copy(s, 1, Pos(' ', s) - 1), Tic^.SeenBy[Tic^.NumSB]);
595 With Tic^ do If NumSB > 1 then
596 Begin
597 if SeenBy[NumSB].Zone = 0 then SeenBy[NumSB].Zone := SeenBy[NumSB-1].Zone;
598 if SeenBy[NumSB].Net = 0 then SeenBy[NumSB].Net := SeenBy[NumSB-1].Net;
599 end;
600 LogSetCurLevel(LogHandle, 5);
601 LogWriteLn(LogHandle, 'SeenBy '+ Addr2Str(Tic^.SeenBy[Tic^.NumSB]));
602 Delete(s, 1, Pos(' ', s));
603 End;
604 Inc(Tic^.NumSB);
605 Str2Addr(s, Tic^.SeenBy[Tic^.NumSB]);
606 With Tic^ do If NumSB > 1 then
607 Begin
608 if SeenBy[NumSB].Zone = 0 then SeenBy[NumSB].Zone := SeenBy[NumSB-1].Zone;
609 if SeenBy[NumSB].Net = 0 then SeenBy[NumSB].Net := SeenBy[NumSB-1].Net;
610 if SeenBy[NumSB].Node = 0 then SeenBy[NumSB].Node := SeenBy[NumSB-1].Node;
611 end;
612 LogSetCurLevel(LogHandle, 5);
613 LogWriteLn(LogHandle, 'SeenBy '+ Addr2Str(Tic^.SeenBy[Tic^.NumSB]));
614 End
615 Else If (Pos('PATH ', UpStr(Line)) = 1) or (Pos('PATH:', UpStr(Line)) = 1) then
616 Begin
617 Delete(Line, 1, 5);
618 Inc(Tic^.NumPath);
619 Tic^.Path[Tic^.NumPath] := KillLeadingSpcs(Line);
620 LogSetCurLevel(LogHandle, 4);
621 LogWriteLn(LogHandle, 'Path '+ Tic^.Path[Tic^.NumPath]);
622 End
623 Else If (Pos('PW ', UpStr(Line)) = 1) or (Pos('PW:', UpStr(Line)) = 1) then
624 Begin
625 Delete(Line, 1, 3);
626 Tic^.Pwd := UpStr(KillSpcs(Line));
627 {LogSetCurLevel(LogHandle, 5);
628 LogWriteLn(LogHandle, 'PassWord '+Tic^.Pwd);}
629 End
630 Else
631 Begin
632 Inc(Tic^.NumApp);
633 Tic^.App[Tic^.NumApp] := Line;
634 LogSetCurLevel(LogHandle, 4);
635 LogWriteLn(LogHandle, 'App '+Tic^.App[Tic^.NumApp]);
636 End;
637 End;
638
639 If (Pos('BY FILESCAN', UpStr(Tic^.CreatedBy)) = 1) then
640 Begin
641 Tic^.Date := 0;
642 LogSetCurLevel(LogHandle, 3);
643 LogWriteLn(LogHandle, 'Tic created by FileScan - ignoring date');
644 End;
645 End; {ParseTIC}
646
647 Begin {Toss}
648 LogSetCurLevel(LogHandle, 3);
649 LogWriteLn(LogHandle, 'Toss');
650 FSplit(CfgName, s, s1, s1);
651 Assign(ArcList, Cfg^.ArcLst);
652 {$ifdef SPEED}
653 {$I-} Append(ArcList); {$I+}
654 If (IOResult <> 0) then
655 Begin
656 {$I-} ReWrite(ArcList); {$I+}
657 If (IOResult <> 0) then
658 Begin
659 LogSetCurLevel(LogHandle, 1);
660 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.arcLst+'"!');
661 Done;
662 Halt(Err_ArcList);
663 End;
664 End;
665 {$Else}
666 {$ifdef FPC}
667 If (DosAppend(ArcList) <> 0) then
668 Begin
669 LogSetCurLevel(LogHandle, 1);
670 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.arcLst+'"!');
671 Done;
672 Halt(Err_ArcList);
673 End;
674 {$Else}
675 If (DosAppend(File(ArcList)) <> 0) then
676 Begin
677 LogSetCurLevel(LogHandle, 1);
678 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.ArcLst+'"!');
679 Done;
680 Halt(Err_ArcList);
681 End;
682 {$endif}
683 {$endif}
684 Assign(PTList, Cfg^.PTLst);
685 {$ifdef SPEED}
686 {$I-} Append(PTList); {$I+}
687 If (IOResult <> 0) then
688 Begin
689 {$I-} ReWrite(PTList); {$I+}
690 If (IOResult <> 0) then
691 Begin
692 LogSetCurLevel(LogHandle, 1);
693 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
694 Done;
695 Halt(Err_PTList);
696 End;
697 End;
698 {$Else}
699 {$ifdef FPC}
700 If (DosAppend(PTList) <> 0) then
701 Begin
702 LogSetCurLevel(LogHandle, 1);
703 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
704 Done;
705 Halt(Err_PTList);
706 End;
707 {$Else}
708 If (DosAppend(File(PTList)) <> 0) then
709 Begin
710 LogSetCurLevel(LogHandle, 1);
711 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
712 Done;
713 Halt(Err_PTList);
714 End;
715 {$endif}
716 {$endif}
717 If (Cfg^.NumArcNames > 0) then
718 Begin
719 LogSetCurLevel(LogHandle, 5);
720 LogWriteLn(LogHandle, 'Searching for ARCs');
721 For i := 1 to Cfg^.NumArcNames do
722 Begin
723 FName := Cfg^.InBound + DirSep + Cfg^.ArcNames[i].FileName;
724 SRec.Name := FName;
725 FindFirst(FName, AnyFile, SRec);
726 While (DosError = 0) Do
727 Begin
728 LogSetCurLevel(LogHandle, 3);
729 LogWriteLn(LogHandle, 'Processing '+Cfg^.InBound+DirSep+SRec.Name);
730 If not UnPack(Cfg^.ArcNames[i].UnPacker, Cfg^.InBound+DirSep+
731 SRec.Name, Cfg^.InBound) then
732 Begin
733 LogSetCurLevel(LogHandle, 2);
734 LogWriteLn(LogHandle, 'Could not unpack "'+Cfg^.InBound+DirSep+
735 SRec.Name+'"!');
736 End
737 Else
738 Begin
739 Assign(f, Cfg^.InBound+DirSep+SRec.Name);
740 {$I-} Erase(f); {$I+}
741 If IOResult <> 0 then
742 Begin
743 LogSetCurLevel(LogHandle, 1);
744 LogWriteLn(LogHandle, 'Couldn''t erase "'+Cfg^.InBound+DirSep+
745 SRec.Name+'"');
746 End;
747 End;
748 FindNext(SRec);
749 End;
750 {$ifdef OS2}
751 FindClose(SRec);
752 {$endif}
753 End;
754 If Debug then
755 Begin
756 WriteLn('<Return>');
757 ReadLn(s);
758 If (UpStr(s) = 'BREAK') then
759 Begin
760 Exit;
761 End;
762 End;
763 End;
764 LogSetCurLevel(LogHandle, 5);
765 LogWriteLn(LogHandle, 'Searching for TICs');
766 New(Tic);
767 FName := Cfg^.InBound + DirSep+'*.tic';
768 SRec.Name := FName;
769 FindFirst(FName, AnyFile, SRec);
770 While (DosError = 0) Do
771 Begin
772 LogSetCurLevel(LogHandle, 3);
773 LogWriteLn(LogHandle, '');
774 LogWriteLn(LogHandle, 'Processing '+ Cfg^.InBound+DirSep+SRec.Name);
775 Assign(f, Cfg^.InBound+DirSep+SRec.Name);
776 {$I-} ReSet(f); {$I+}
777 If IOResult <> 0 then
778 Begin
779 LogSetCurLevel(LogHandle, 1);
780 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.InBound+DirSep+SRec.Name+'"');
781 FindNext(SRec);
782 Continue;
783 End;
784 FillChar(Tic^, SizeOf(TTick), 0);
785 ParseTIC;
786 WriteLn;
787 {$I-} Close(f); {$I+}
788 If IOResult <> 0 then
789 Begin
790 LogSetCurLevel(LogHandle, 1);
791 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.InBound+DirSep+
792 SRec.Name+'"');
793 End;
794 If Debug then
795 Begin
796 WriteLn('<Return>');
797 ReadLn(s);
798 If (UpStr(s) = 'BREAK') then
799 Begin
800 {$ifdef OS2}
801 FindClose(SRec);
802 {$endif}
803 Dispose(Tic);
804 Tic := Nil;
805 Exit;
806 End;
807 End;
808 {TIC read, now process it...}
809 With Tic^._To do bo := (Zone = 0) and (Net = 0) and (Node = 0) and (Point = 0) and (Domain = '');
810 bo := bo or (Not Cfg^.CheckDest);
811 For i := 1 to Cfg^.NumAddrs do bo := bo or CompAddr(Tic^._To, Cfg^.Addrs[i]);
812 If not bo then
813 Begin
814 LogSetCurLevel(LogHandle, 2);
815 LogWriteLn(LogHandle, 'Tic is not for us but for '+Addr2Str(Tic^._To));
816 Tic^.Bad := bt_NotForUs;
817 End
818 Else
819 Begin
820 Local := False;
821 For i := 1 to Cfg^.NumAddrs do Local := Local or CompAddr(Tic^.From, Cfg^.Addrs[i]);
822 CurArea := Cfg^.Areas;
823 While ((CurArea^.Next <> Nil) and (UpStr(CurArea^.Name) <> Tic^.Area)) do
824 Begin
825 CurArea := CurArea^.Next;
826 End;
827 If (UpStr(CurArea^.Name) <> Tic^.Area) then
828 Begin
829 CurUser := Cfg^.Users;
830 While ((not CompAddr(CurUser^.Addr, Tic^.From)) or
831 ((CurUser^.Addr.Zone = 0) and (CurUser^.Addr.Net = 0))) and
832 (CurUser^.Next <> Nil) do CurUser := CurUser^.Next;
833 If not (CompAddr(CurUser^.Addr, Tic^.From) or local) then
834 Begin
835 LogSetCurLevel(LogHandle, 2);
836 LogWriteLn(LogHandle, 'Unlisted sender: '+Addr2Str(Tic^.From));
837 Tic^.Bad := bt_Unlisted;
838 End
839 Else
840 Begin
841 If (not Local) then s := CurUser^.Pwd Else s := Cfg^.LocalPwd;
842 If (Tic^.Pwd <> UpStr(s)) then
843 Begin
844 Tic^.Bad := bt_WrongPwd;
845 LogSetCurLevel(LogHandle, 2);
846 LogWriteLn(LogHandle, 'Wrong password! Tic: "'+Tic^.Pwd+'", User: "'+s+'"');
847 End
848 Else
849 Begin
850 If ((CurUser^.Flags and uf_AutoCreate) <> uf_AutoCreate) or (Tic^.Area = '') then
851 Begin
852 LogSetCurLevel(LogHandle, 2);
853 LogWriteLn(LogHandle, 'Unknown area: "'+ Tic^.Area+ '"');
854 Tic^.Bad := bt_UnknownArea;
855 End
856 Else
857 Begin
858 ACArea := Cfg^.Areas;
859 While ((UpStr(ACArea^.Name) <>
860 ('AUTOCREATE:'+IntToStr(CurUser^.ACGroup))) and (ACArea^.Next <> Nil)) do
861 Begin
862 ACArea := ACArea^.Next;
863 End;
864 If (UpStr(ACArea^.Name) <> 'AUTOCREATE:'+IntToStr(CurUser^.ACGroup)) then
865 Begin
866 LogSetCurLevel(LogHandle, 1);
867 LogWriteLn(LogHandle, 'No AutoCreate defaults for group '+IntToStr(CurUser^.ACGroup)+' found!');
868 Tic^.Bad := bt_UnknownArea;
869 End
870 Else
871 Begin
872 New(CurArea^.Next);
873 CurArea^.Next^.Prev := CurArea;
874 CurArea := CurArea^.Next;
875 CurArea^.Next := Nil;
876
877 CurArea^.Path := ACArea^.Path;
878 CurArea^.Desc := ACArea^.Desc;
879 CurArea^.BBSArea := ACArea^.BBSArea;
880 CurArea^.MoveTo := ACArea^.MoveTo;
881 CurArea^.ReplaceExt := ACArea^.ReplaceExt;
882 CurArea^.Group := ACArea^.Group;
883 CurArea^.Level := ACArea^.Level;
884 CurArea^.Addr := ACArea^.Addr;
885 CurArea^.Flags := ACArea^.Flags;
886 CurArea^.CostPerMB := ACArea^.CostPerMB;
887 CurArea^.AnnGroups := ACArea^.AnnGroups;
888 If (ACArea^.Users <> NIL) then
889 Begin
890 ACCUser := ACArea^.Users;
891 New(CurArea^.Users);
892 CurConnUser := CurArea^.Users;
893 CurConnUser^.User := ACCUser^.User;
894 CurConnUser^.Receive := ACCUser^.Receive;
895 CurConnUser^.Send := ACCUser^.Send;
896 If (ACCUser^.Next <> NIL) Then
897 Repeat
898 ACCUser := ACCUser^.Next;
899 New(CurConnUser^.Next);
900 CurConnUser^.Next^.Prev := CurConnUser;
901 CurConnUser := CurConnUser^.Next;
902 CurConnUser^.Next := Nil;
903 CurConnUser^.User := ACCUser^.User;
904 CurConnUser^.Receive := ACCUser^.Receive;
905 CurConnUser^.Send := ACCUser^.Send;
906 Until (ACCUser^.Next = NIL);
907 End;
908
909 CurArea^.Name := Tic^.Area;
910 If (Tic^.AreaDesc <> '') then CurArea^.Desc := Tic^.AreaDesc;
911 Today(DT);
912 Now(DT);
913 CurArea^.LastHatch := DTToUnixDate(DT);
914 s1 := Lowstr(CurArea^.Name);
915 If Cfg^.SplitDirs then
916 Begin
917 s1 := Translate(s1, ' ', DirSep);
918 s1 := Translate(s1, '.', DirSep);
919 s1 := Translate(s1, '_', DirSep);
920 s1 := Translate(s1, '/', DirSep);
921 s1 := Translate(s1, '-', DirSep);
922 End
923 Else
924 Begin
925 s1 := Translate(s1, ' ', '_');
926 s1 := Translate(s1, '/', '_');
927 End;
928 s := '';
929 If not Cfg^.LongDirNames then
930 Begin
931 If (Length(s1) > 8) then
932 Begin
933 While (Length(s1) > 8) do
934 Begin
935 If (Pos(DirSep, s1) > 8) or (Pos(DirSep, s1) = 0) then
936 Begin
937 s := s + Copy(s1, 1, 8) + DirSep;
938 Delete(s1, 1, 8);
939 End
940 Else
941 Begin
942 s := s + Copy(s1, 1, Pos(DirSep, s1));
943 Delete(s1, 1, Pos(DirSep, s1));
944 End;
945 End;
946 s := s + s1;
947 End
948 Else s := s1;
949 End
950 Else s := s1;
951 CurArea^.Path := CurArea^.Path + DirSep + s;
952
953 If (not MakeDir(CurArea^.Path)) then
954 Begin
955 LogSetCurLevel(LogHandle, 1);
956 LogWriteLn(LogHandle, 'Couldn''t create directory "'+CurArea^.Path+'"!');
957 End
958 Else
959 Begin
960 LogSetCurLevel(LogHandle, 3);
961 LogWriteLn(LogHandle, 'Created directory "'+CurArea^.Path+'"');
962 End;
963 If (CurArea^.Users = Nil) then
964 Begin
965 New(CurArea^.Users);
966 CurArea^.Users^.Next := Nil;
967 CurArea^.Users^.Prev := Nil;
968 CurArea^.Users^.User := CurUser;
969 CurArea^.Users^.Send := True;
970 CurArea^.Users^.Receive := CurUser^.Receives;
971 End
972 Else
973 Begin
974 CurConnUser := CurArea^.Users;
975 While (CurConnUser^.Next <> Nil) do CurConnUser := CurConnUser^.Next;
976 New(CurConnUser^.Next);
977 CurConnUser^.Next^.Prev := CurConnUser;
978 CurConnUser := CurConnUser^.Next;
979 CurConnUser^.Next := Nil;
980 CurConnUser^.User := CurUser;
981 CurConnUser^.Send := True;
982 CurConnUser^.Receive := CurUser^.Receives;
983 End;
984 CurConnUser := CurArea^.Users;
985 Ini.SetSection('USER');
986 Repeat
987 While ((UpStr(Ini.ReSecEnName) <> 'ADDR') and Ini.SetNextOpt) do ;
988 Str2Addr(Ini.ReSecEnValue, A);
989 Until (CompAddr(A, CurConnUser^.User^.Addr) or (not Ini.SetNextOpt));
990 s := '';
991 If CurConnUser^.Receive then s := 'R';
992 If CurConnUser^.Send then s := s + 'S';
993 If CompAddr(A, CurConnUser^.User^.Addr) Then Ini.InsertSecEntry('Area', CurArea^.Name+', '+s, '');
994 While (CurConnUser^.Next <> Nil) do
995 Begin
996 CurConnUser := CurConnUser^.Next;
997 Ini.SetSection('USER');
998 Repeat
999 While ((UpStr(Ini.ReSecEnName) <> 'ADDR') and Ini.SetNextOpt) do ;
1000 Str2Addr(Ini.ReSecEnValue, A);
1001 Until (CompAddr(A, CurConnUser^.User^.Addr) or (not Ini.SetNextOpt));
1002 s := '';
1003 If CurConnUser^.Receive then s := 'R';
1004 If CurConnUser^.Send then s := s + 'S';
1005 If CompAddr(A, CurConnUser^.User^.Addr) Then Ini.InsertSecEntry('Area', CurArea^.Name+', '+s, '');
1006 End;
1007 With Ini do With CurArea^ do
1008 Begin
1009 SetSection('FILEAREAS');
1010 While SetNextOpt do ;
1011 AddSecEntry('Area', Name, '');
1012 If (Desc <> '') then AddSecEntry('Desc', Desc, '');
1013 If (BBSArea <> '') then AddSecEntry('BBSArea', BBSArea, '');
1014 AddSecEntry('Path', Path, '');
1015 If (MoveTo <> '') Then AddSecEntry('MoveTo', MoveTo, '');
1016 If (ReplaceExt <> '') Then AddSecEntry('ReplaceExt', ReplaceExt, '');
1017 AddSecEntry('Group', IntToStr(Group), '');
1018 AddSecEntry('Level', IntToStr(Level), '');
1019 AddSecEntry('Addr', Addr2Str(Addr), '');
1020 AddSecEntry('LastHatch', WordToHex(word(LastHatch SHR 16))+
1021 WordToHex(word(LastHatch mod 65536)), '');
1022 If (CostPerMB <> 0) Then AddSecEntry('CostPerMB', IntToStr(CostPerMB), '');
1023 s := '';
1024 For i := 1 to 255 do If i in AnnGroups then s := s + IntToStr(i) + ',';
1025 Delete(s, Length(s), 1);
1026 If (s <> '') Then AddSecEntry('Announce', s, '');
1027 s := '';
1028 If (Flags and fa_PT) > 0 then If (s <> '') then s := s +', PT' Else s := 'PT';
1029 If (Flags and fa_Dupe) > 0 then If (s <> '') then s := s + ', Dupe' Else s := 'Dupe';
1030 If (Flags and fa_CRC) > 0 then If (s <> '') then s := s + ', CRC' Else s := 'CRC';
1031 If (Flags and fa_Touch) > 0 then If (s <> '') then s := s + ', Touch' Else s := 'Touch';
1032 If (Flags and fa_Mandatory) > 0 then If (s <> '') then s := s + ', Man' Else s := 'Man';
1033 If (Flags and fa_NoPause) > 0 then If (s <> '') then s := s + ', NoPause' Else s := 'NoPause';
1034 If (Flags and fa_NewFilesHatch) > 0 then If (s <> '') then s := s + ', Hatch' Else s := 'New';
1035 If (Flags and fa_CS) > 0 then If (s <> '') then s := s + ', CS' Else s := 'CS';
1036 If (Flags and fa_RemoteChange) > 0 then If (s <> '') then s := s + ', Rem' Else s := 'Rem';
1037 If (Flags and fa_Hidden) > 0 then If (s <> '') then s := s + ', Hid' Else s := 'Hid';
1038 If (s <> '') Then AddSecEntry('Flags', s, '');
1039 AddSecEntry(';', '', ' ');
1040 WriteIni;
1041 LogSetCurLevel(LogHandle, 2);
1042 LogWriteLn(LogHandle, 'autocreated area "'+CurArea^.Name+'"');
1043 AddAutoArea(CurArea^.Name);
1044 End;
1045 End;
1046 End;
1047 End;
1048 End;
1049 End;
1050 CurArea := Cfg^.Areas;
1051 While ((CurArea^.Next <> Nil) and (UpStr(CurArea^.Name) <> Tic^.Area)) do
1052 Begin
1053 CurArea := CurArea^.Next;
1054 End;
1055 If (UpStr(CurArea^.Name) <> Tic^.Area) then
1056 Else
1057 Begin
1058 CurConnUser := CurArea^.Users;
1059 If (CurConnUser <> Nil) then While (not CompAddr(CurConnUser^.User^.Addr, Tic^.From)) and (CurConnUser^.Next <> Nil) do
1060 CurConnUser := CurConnUser^.Next;
1061 If (not Local) and ((CurConnUser = Nil) or (not CompAddr(CurConnUser^.User^.Addr, Tic^.From))) then
1062 Begin
1063 Tic^.Bad := bt_NotConnected;
1064 LogSetCurLevel(LogHandle, 2);
1065 LogWriteLn(LogHandle, Addr2Str(Tic^.From)+' not connected to Area '+ Tic^.Area);
1066 End
1067 Else
1068 Begin
1069 If not (Local or CurConnUser^.Send) then
1070 Begin
1071 Tic^.Bad := bt_NoSend;
1072 LogSetCurLevel(LogHandle, 2);
1073 LogWriteLn(LogHandle, Addr2Str(CurConnUser^.User^.Addr)+ ' not SEND-connected to '+CurArea^.Name);
1074 End
1075 Else
1076 Begin
1077 If (Tic^.CRC <> 0) and ((CurArea^.Flags and fa_CRC) = fa_CRC) Then
1078 Begin
1079 Write('Checking CRC...');
1080 i := GetCRC(Cfg^.InBound + DirSep + Tic^.Name);
1081 End
1082 Else i := 0;
1083 If (i = $FFFFFFFF) then
1084 Begin
1085 WriteLn;
1086 LogSetCurLevel(LogHandle, 2);
1087 LogWriteLn(LogHandle, 'File "'+Cfg^.InBound+DirSep+Tic^.Name+'" locked or not in InBound');
1088 Tic^.Bad := bt_NoFile;
1089 End
1090 Else If (i <> Tic^.CRC) and ((CurArea^.Flags and fa_CRC) = fa_CRC) then
1091 Begin
1092 WriteLn;
1093 LogSetCurLevel(LogHandle, 2);
1094 LogWriteLn(LogHandle, 'Incorrect CRC! File: '+ WordToHex(word(i SHR 16))+
1095 WordToHex(word(i mod 65536))+', TIC: '+ WordToHex(word(Tic^.CRC SHR 16))+
1096 WordToHex(word(Tic^.CRC mod 65536)));
1097 Tic^.Bad := bt_CRC;
1098 End
1099 Else
1100 Begin
1101 If (Tic^.CRC <> 0) and ((CurArea^.Flags and fa_CRC) = fa_CRC) then WriteLn(' OK');
1102 If (((CurArea^.Flags and fa_Dupe) = fa_Dupe) and CheckForDupe(Tic) and DupeCheck) then
1103 Begin
1104 Tic^.Bad := bt_Dupe;
1105 LogSetCurLevel(LogHandle, 2);
1106 LogWriteLn(LogHandle, 'Dupe!');
1107 End
1108 Else
1109 Begin
1110 {Tic is OK, process it...}
1111 PT := (CurArea^.Flags and fa_PT) <> 0;
1112 If not PT and (Tic^.Replaces <> '') then ReplaceFiles(CurArea^.Path +
1113 DirSep + Tic^.Replaces);
1114 If not PT then ReplaceFiles(CurArea^.Path + DirSep +
1115 Tic^.Name);
1116 If PT then
1117 Begin
1118 If not MoveFile(Cfg^.InBound + DirSep + Tic^.Name,
1119 Cfg^.PT + DirSep + Tic^.Name) then
1120 Begin
1121 LogSetCurLevel(LogHandle, 1);
1122 LogWriteLn(LogHandle, 'Couldn''t move "'+Cfg^.InBound +
1123 DirSep + Tic^.Name+'" to "'+ Cfg^.PT + DirSep +
1124 Tic^.Name+'"!');
1125 End;
1126 End;
1127 If not PT and (not RepFile(Cfg^.InBound + DirSep +
1128 Tic^.Name, CurArea^.Path + DirSep + Tic^.Name)) then
1129 Begin
1130 Tic^.Bad := bt_CouldntMove;
1131 LogSetCurLevel(LogHandle, 1);
1132 LogWriteLn(LogHandle, 'Couldn''t move "'+Cfg^.InBound +
1133 DirSep + Tic^.Name+'" to "'+ CurArea^.Path + DirSep +
1134 Tic^.Name+'"!');
1135 End
1136 Else
1137 Begin
1138 If DupeCheck then WriteDupe(Tic);
1139 s := UpStr(Tic^.Desc);
1140 If (Pos('LONGNAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1141 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 10, Length(Tic^.Desc)-9))))
1142 Else If (Pos('ORIGINAL NAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1143 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 15, Length(Tic^.Desc)-14))))
1144 Else
1145 Begin
1146 s := UpStr(Tic^.LDesc[1]);
1147 If (Pos('LONGNAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1148 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 10, Length(Tic^.Desc)-9))))
1149 Else If (Pos('ORIGINAL NAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1150 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 15, Length(Tic^.Desc)-14))))
1151 Else
1152 Begin
1153 s := UpStr(Tic^.LDesc[2]);
1154 If (Pos('LONGNAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1155 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 10, Length(Tic^.Desc)-9))))
1156 Else If (Pos('ORIGINAL NAME:', s) = 1) then WriteLName(CurArea^.Path, Tic^.Name,
1157 KillLeadingSpcs(KillTrailingSpcs(Copy(Tic^.Desc, 15, Length(Tic^.Desc)-14))));
1158 End;
1159 End;
1160 HDesc^[0] := #0;
1161 PPos := 0;
1162 If (Tic^.NumLDesc > 0) then
1163 Begin
1164 If (Tic^.Desc <> Tic^.LDesc[1]) then
1165 Begin
1166 For j := 0 to Length(Tic^.Desc)-1 do
1167 HDesc^[PPos+j] := Tic^.Desc[j+1];
1168 PPos := PPos + Length(Tic^.Desc) + 2;
1169 HDesc^[PPos-2] := #13;
1170 HDesc^[PPos-1] := #10;
1171 End;
1172 For i := 1 to Tic^.NumLDesc do
1173 Begin
1174 If (Length(Tic^.LDesc[i]) = 0) then j := 0
1175 Else For j := 0 to Byte(Tic^.LDesc[i][0])-1 do
1176 HDesc^[PPos+j] := Tic^.LDesc[i][j+1];
1177 PPos := PPos+Length(Tic^.LDesc[i])+2;
1178 HDesc^[PPos-2] := #13;
1179 HDesc^[PPos-1] := #10;
1180 End;
1181 HDesc^[PPos] := #0;
1182 End
1183 Else
1184 Begin
1185 StrPCopy(Pointer(HDesc), Tic^.Desc);
1186 HDesc^[Length(Tic^.Desc)] := #0;
1187 End;
1188 If not PT then SetFileDesc(CurArea^.Path + DirSep +
1189 Tic^.Name, HDesc);
1190 AddAnnFile(Tic^.Area, Tic^.Name, HDesc, Tic^.From);
1191 If not PT then AddTossArea(CurArea^.Name, CurArea^.BBSArea);
1192 Today(DT);
1193 Now(DT);
1194 With Tic^._To do If ((Zone <> 0) or (Net <> 0) or (Node <> 0) or (Point <> 0)) then
1195 Begin
1196 Inc(Tic^.NumPath);
1197 s := Addr2Str(Tic^._To) + ' ' + DTToUnixHexStr(DT) +
1198 ' ' + WkDays3Eng[DT.DayOfWeek] + ' ' + Months3Eng[DT.Month] + ' ' +
1199 IntToStr(DT.Day) + ' ' + Time2Str(DT) + ' ' + IntToStr(DT.Year) +
1200 ' ProTick' + Version;
1201 Tic^.Path[Tic^.NumPath] := s;
1202 LogSetCurLevel(LogHandle, 5);
1203 LogWriteLn(LogHandle, 'Added Path "'+ Tic^.Path[Tic^.NumPath]+ '"');
1204 Inc(Tic^.NumSB);
1205 Tic^.SeenBy[Tic^.NumSB] := Tic^._To;
1206 LogSetCurLevel(LogHandle, 5);
1207 LogWriteLn(LogHandle, 'Added SeenBy "'+Addr2Str(Tic^._To)+'"');
1208 End;
1209 {$ifdef FPC}
1210 With Tic^._To do If (not CompAddr(Tic^._To, CurArea^.Addr)) or
1211 {$Else}
1212 With Tic^._To do If (not CompAddr(Tic^._To, CurArea^.Addr)) XOR
1213 {$endif}
1214 ((Zone = 0) and (Net = 0) and (Node = 0) and (Point = 0)) then
1215 Begin
1216 Inc(Tic^.NumPath);
1217 s := Addr2Str(CurArea^.Addr) + ' ' + DTToUnixHexStr(DT) +
1218 ' ' + WkDays3Eng[DT.DayOfWeek] + ' ' + Months3Eng[DT.Month] + ' ' +
1219 IntToStr(DT.Day) + ' ' + Time2Str(DT) + ' ' + IntToStr(DT.Year) +
1220 ' ProTick' + Version;
1221 Tic^.Path[Tic^.NumPath] := s;
1222 LogSetCurLevel(LogHandle, 5);
1223 LogWriteLn(LogHandle, 'Added Path "'+ Tic^.Path[Tic^.NumPath]+ '"');
1224 Inc(Tic^.NumSB);
1225 Tic^.SeenBy[Tic^.NumSB] := CurArea^.Addr;
1226 LogSetCurLevel(LogHandle, 5);
1227 LogWriteLn(LogHandle, 'Added SeenBy "'+Addr2Str(CurArea^.Addr)+'"');
1228 End;
1229 CurConnUser := CurArea^.Users;
1230 If (CurConnUser <> NIL) then
1231 Begin
1232 Repeat
1233 While (not CurConnUser^.Receive) and (CurConnUser^.Next <> Nil) do
1234 CurConnUser := CurConnUser^.Next;
1235 If CurConnUser^.Receive then
1236 Begin
1237 If (not CompAddr(Tic^.From, CurConnUser^.User^.Addr)) then
1238 Begin
1239 If (CurConnUser^.User^.Active or
1240 ((CurArea^.Flags and fa_NoPause) > 0)) and
1241 (not CompAddr(Tic^.From, CurConnUser^.User^.Addr)) then
1242 Begin
1243 CurUser := CurConnUser^.User;
1244 Inc(Tic^.NumSB);
1245 Tic^.SeenBy[Tic^.NumSB] := CurUser^.Addr;
1246 LogSetCurLevel(LogHandle, 5);
1247 LogWriteLn(LogHandle, 'Added SeenBy '+ Addr2Str(Tic^.SeenBy[Tic^.NumSB]));
1248 End;
1249 End;
1250 If (CurConnUser^.Next <> Nil) then CurConnUser := CurConnUser^.Next
1251 Else Break;
1252 End;
1253 Until ((CurConnUser^.Next = Nil) and (not CurConnUser^.Receive));
1254 CurConnUser := CurArea^.Users;
1255 Repeat
1256 While (not CurConnUser^.Receive) and (CurConnUser^.Next <> Nil) do
1257 CurConnUser := CurConnUser^.Next;
1258 If CurConnUser^.Receive Then
1259 Begin
1260 If (CurConnUser^.User^.Active or
1261 ((CurArea^.Flags and fa_NoPause) > 0)) and
1262 (not CompAddr(Tic^.From, CurConnUser^.User^.Addr)) then
1263 Begin
1264 CurUser := CurConnUser^.User;
1265 LogSetCurLevel(LogHandle, 3);
1266 LogWriteLn(LogHandle, 'Forwarding to '+CurUser^.Name+' ('+Addr2Str(CurUser^.Addr)+')');
1267 If not PT then SendTIC(CurUser, Tic, CurArea^.Path +
1268 DirSep + Tic^.Name)
1269 Else SendTIC(CurUser, Tic, Cfg^.PT + DirSep +
1270 Tic^.Name);
1271 WriteLn;
1272 End;
1273 If (CurConnUser^.Next <> Nil) then CurConnUser := CurConnUser^.Next
1274 Else Break;
1275 End;
1276 Until ((CurConnUser^.Next = Nil) and (not CurConnUser^.Receive));
1277 End;
1278 End;
1279 End;
1280 End;
1281 End;
1282 End;
1283 End;
1284 End;
1285 If (Tic^.Bad <> 0) then
1286 Begin
1287 WriteLn;
1288 If (Tic^.Bad <> bt_NotForUs) then
1289 Begin
1290 Assign(f, Cfg^.InBound+DirSep+SRec.Name);
1291 {$I-} Append(f); {$I+}
1292 If (IOResult <> 0) then
1293 Begin
1294 LogSetCurLevel(LogHandle, 1);
1295 LogWriteLn(LogHandle, 'Couldn''t append to "'+Cfg^.InBound +
1296 DirSep + SRec.Name+'"!');
1297 End
1298 Else
1299 Begin
1300 {$I-}
1301 WriteLn(f, 'ERROR #'+IntToStr(Tic^.Bad)+': '+TicErrorStr(Tic^.Bad));
1302 If (IOResult <> 0) then
1303 Begin
1304 LogSetCurLevel(LogHandle, 1);
1305 LogWriteLn(LogHandle, 'Error writing "'+Cfg^.InBound + DirSep +
1306 SRec.Name+'"!');
1307 End;
1308 Close(f); {$I+}
1309 If (IOResult <> 0) then
1310 Begin
1311 LogSetCurLevel(LogHandle, 1);
1312 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.InBound +
1313 DirSep + SRec.Name+'"!');
1314 End;
1315 End;
1316 If not MoveFile(Cfg^.InBound + DirSep + Tic^.Name, Cfg^.Bad +
1317 DirSep + Tic^.Name) Then
1318 Begin
1319 LogSetCurLevel(LogHandle, 1);
1320 LogWriteLn(LogHandle, 'Couldn''t move "'+Cfg^.InBound + DirSep +
1321 Tic^.Name+'" to "'+Cfg^.Bad + DirSep + Tic^.Name+'"!');
1322 End;
1323 If not MoveFile(Cfg^.InBound + DirSep + SRec.Name, Cfg^.Bad +
1324 DirSep + SRec.Name) Then
1325 Begin
1326 LogSetCurLevel(LogHandle, 1);
1327 LogWriteLn(LogHandle, 'Couldn''t move "'+Cfg^.InBound + DirSep +
1328 SRec.Name+'" to "'+Cfg^.Bad + DirSep + SRec.Name+'"!');
1329 End;
1330 End;
1331 End
1332 Else
1333 Begin
1334 {$I-} Erase(f); {$I+}
1335 If (IOResult <> 0) then
1336 Begin
1337 LogSetCurLevel(LogHandle, 1);
1338 LogWriteLn(LogHandle, 'Couldn''t erase "'+Cfg^.InBound + DirSep +
1339 SRec.Name+'"!');
1340 End;
1341 End;
1342 If Debug then
1343 Begin
1344 WriteLn('<Return>');
1345 ReadLn(s);
1346 If (UpStr(s) = 'BREAK') then
1347 Begin
1348 {$ifdef OS2}
1349 FindClose(SRec);
1350 {$endif}
1351 Dispose(Tic);
1352 Tic := Nil;
1353 Exit;
1354 End;
1355 End;
1356 FindNext(SRec);
1357 End;
1358 {$ifdef OS2}
1359 FindClose(SRec);
1360 {$endif}
1361 Dispose(Tic);
1362 Tic := Nil;
1363 {$I-} Close(ArcList); {$I+}
1364 If (IOResult <> 0) then
1365 Begin
1366 LogSetCurLevel(LogHandle, 1);
1367 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.ArcLst+'"!');
1368 End
1369 Else
1370 Begin
1371 {$ifdef UNIX}
1372 ChMod(Cfg^.ArcLst, FilePerm);
1373 {$endif}
1374 End;
1375 {$I-} Close(PTList); {$I+}
1376 If (IOResult <> 0) then
1377 Begin
1378 LogSetCurLevel(LogHandle, 1);
1379 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.PTLst+'"!');
1380 End
1381 Else
1382 Begin
1383 {$ifdef UNIX}
1384 ChMod(Cfg^.PTLst, FilePerm);
1385 {$endif}
1386 End;
1387 WriteTossArea;
1388 WriteBBSArea;
1389 WriteAutoArea;
1390 DoAnnounce;
1391 DoNMAnn;
1392 End;
1393
1394 Procedure SendTic(Usr: PUser; Tic: PTick; FName: String);
1395 Var
1396 f: Text;
1397 f1: File;
1398 fn: String;
1399 fn1: FileStr;
1400 Ext: FileStr;
1401 Line: String;
1402 Error: Integer;
1403 s: String;
1404 i: LongInt;
1405 DT: TimeTyp;
1406
1407 Begin
1408 FSplit(FName, s, fn1, Ext);
1409 fn1 := fn1 + Ext;
1410 With Tic^ do
1411 If ((Usr^.Flags and uf_SendTIC) = uf_SendTIC) then
1412 Begin
1413 i := 0;
1414 Repeat
1415 fn := Cfg^.TicOut + DirSep + 'pt' + Copy(RandName, 1, 6) + '.tic';
1416 Assign(f, fn);
1417 {$I-} ReSet(f); {$I+}
1418 Error := IOResult;
1419 If (Error = 0) then {$I-} Close(f); {$I+}
1420 Error := Error+IOResult;
1421 Inc(i);
1422 Until (Error <> 0) or (i >= 10000);
1423 LogSetCurLevel(LogHandle, 4);
1424 LogWriteLn(LogHandle, 'creating TIC: '+fn);
1425 {$I-} ReWrite(f); {$I+}
1426 If (IOResult <> 0) then
1427 Begin
1428 LogSetCurLevel(LogHandle, 1);
1429 LogWriteLn(LogHandle, 'Couldn''t create "'+fn+'"!');
1430 End
1431 Else
1432 Begin
1433 {$I-}
1434 Write(f, 'Area '+Area+#13#10);
1435 If (IOResult <> 0) then
1436 Begin
1437 LogSetCurLevel(LogHandle, 1);
1438 LogWriteLn(LogHandle, 'Error writing "'+fn+'"!');
1439 Close(f);
1440 If (IOResult <> 0) then
1441 Begin
1442 LogSetCurLevel(LogHandle, 1);
1443 LogWriteLn(LogHandle, 'Couldn''t close "'+fn+'"!');
1444 End;
1445 Exit;
1446 End;
1447 If (AreaDesc <> '') then Write(f, 'AreaDesc '+AreaDesc+#13#10);
1448 {$ifdef SPEED}
1449 If (Origin <> EmptyAddr) then Write(f, 'Origin ' + Addr2Str(Origin)+#13#10);
1450 If (Usr^.OwnAddr <> EmptyAddr) then Write(f, 'From '+Addr2Str(Usr^.OwnAddr)+#13#10)
1451 Else If (CurArea^.Addr <> EmptyAddr) then Write(f, 'From '+Addr2Str(CurArea^.Addr)+#13#10)
1452 Else If (_To <> EmptyAddr) then Write(f, 'From ' + Addr2Str(_To)+#13#10);
1453 {$Else}
1454 With Origin do If ((Zone<>0) or (Net<>0) or (Node<>0) or (Point<>0)
1455 or (Domain<>'')) then Write(f, 'Origin ' + Addr2Str(Origin)+#13#10);
1456 If ((Usr^.OwnAddr.Zone<>0) or (Usr^.OwnAddr.Net<>0) or (Usr^.OwnAddr.Node<>0)
1457 or (Usr^.OwnAddr.Point<>0) or (Usr^.OwnAddr.Domain<>'')) then
1458 Write(f, 'From ' + Addr2Str(Usr^.OwnAddr)+#13#10)
1459 Else If ((CurArea^.Addr.Zone<>0) or (CurArea^.Addr.Net<>0)
1460 or (CurArea^.Addr.Node<>0) or (CurArea^.Addr.Point<>0)
1461 or (CurArea^.Addr.Domain<>'')) then Write(f, 'From ' + Addr2Str(CurArea^.Addr)+#13#10)
1462 Else If ((_To.Zone<>0) or (_To.Net<>0) or (_To.Node<>0) or (_To.Point<>0)
1463 or (_To.Domain<>'')) then Write(f, 'From ' + Addr2Str(_To)+#13#10);
1464 {$endif}
1465 Write(f, 'To ' + Usr^.Name + ', ' + Addr2Str(Usr^.Addr)+#13#10);
1466 Write(f, 'File '+ Name+#13#10);
1467 If (Desc <> '') then Write(f, 'Desc '+Desc+#13#10);
1468 If (NumLDesc > 0) then For i := 1 to NumLDesc do Write(f, 'LDesc '+LDesc[i]+#13#10);
1469 If (CRC <> 0) then Write(f, 'CRC '+WordToHex(word(CRC SHR 16))+
1470 WordToHex(word(CRC mod 65536))+#13#10);
1471 Write(f, 'Created by ProTick'+Version+#13#10);
1472 For i := 1 to NumPath do Write(f, 'Path '+Path[i]+#13#10);
1473 For i := 1 to NumSB do Write(f, 'SeenBy '+Addr2Str(SeenBy[i])+#13#10);
1474 If (Usr^.Pwd <> '') then Write(f, 'PW ' + Usr^.Pwd+#13#10);
1475 If (ReleaseTime > 0) then Write(f, 'ReleaseTime '+
1476 WordToHex(word(ReleaseTime SHR 16))+WordToHex(word(ReleaseTime mod 65536))+#13#10);
1477 If (Replaces <> '') then Write(f, 'Replaces ' + Replaces+#13#10);
1478 If (Size > 0) then Write(f, 'Size '+IntToStr(Size)+#13#10);
1479 If (Date > 0) then Write(f, 'Date '+WordToHex(word(Date SHR 16))+
1480 WordToHex(word(Date mod 65536))+#13#10);
1481 If (NumApp > 0) then For i := 1 to NumApp do Write(f, App[i]+#13#10);
1482 If (IOResult <> 0) then
1483 Begin
1484 LogSetCurLevel(LogHandle, 1);
1485 LogWriteLn(LogHandle, 'Error writing "'+fn+'"!');
1486 End;
1487 Close(f); {$I+}
1488 If (IOResult <> 0) then
1489 Begin
1490 LogSetCurLevel(LogHandle, 1);
1491 LogWriteLn(LogHandle, 'Couldn''t close "'+fn+'"!');
1492 End;
1493 {$ifdef UNIX}
1494 ChMod(fn, FilePerm);
1495 {$endif}
1496 If (Usr^.PackTICs or Usr^.PackFiles) then
1497 Begin
1498 If Usr^.PackFiles then
1499 Begin
1500 ALE.Addr.Zone := Usr^.Addr.Zone;
1501 ALE.Addr.Net := Usr^.Addr.Net;
1502 ALE.Addr.Node := Usr^.Addr.Node;
1503 ALE.Addr.Point := Usr^.Addr.Point;
1504 ALE.Addr.Domain := Usr^.Addr.Domain;
1505 ALE.FileName := FName;
1506 ALE.Del := False;
1507 ALE.PTFN := '';
1508 Write(ArcList, ALE);
1509 End
1510 Else Outbound^.SendFile(Usr, FName, ac_Nothing);
1511 If Usr^.PackTICs then
1512 Begin
1513 ALE.Addr.Zone := Usr^.Addr.Zone;
1514 ALE.Addr.Net := Usr^.Addr.Net;
1515 ALE.Addr.Node := Usr^.Addr.Node;
1516 ALE.Addr.Point := Usr^.Addr.Point;
1517 ALE.Addr.Domain := Usr^.Addr.Domain;
1518 ALE.FileName := fn;
1519 ALE.Del := True;
1520 ALE.PTFN := '';
1521 If ((CurArea^.Flags and fa_PT) <> 0) and not Usr^.PackFiles then
1522 Begin
1523 ALE.PTFN := fn1;
1524 End;
1525 Write(ArcList, ALE);
1526 End
1527 Else
1528 Begin
1529 Outbound^.SendFile(Usr, fn, ac_Del);
1530 If (CurArea^.Flags and fa_PT) <> 0 then
1531 Begin
1532 PTLE.TICName := fn; {TIC}
1533 PTLE.FileName := fn1; {passthrough file}
1534 Write(PTList, PTLE);
1535 End;
1536 End;
1537 End
1538 Else
1539 Begin
1540 Outbound^.SendFile(Usr, FName, ac_Nothing);
1541 Outbound^.SendFile(Usr, fn, ac_Del);
1542 If (CurArea^.Flags and fa_PT) <> 0 then
1543 Begin
1544 PTLE.TICName := fn; {TIC}
1545 PTLE.FileName := fn1; {passthrough file}
1546 Write(PTList, PTLE);
1547 End;
1548 End;
1549 End;
1550 End
1551 Else
1552 Begin
1553 If Usr^.PackFiles then
1554 Begin
1555 ALE.Addr.Zone := Usr^.Addr.Zone;
1556 ALE.Addr.Net := Usr^.Addr.Net;
1557 ALE.Addr.Node := Usr^.Addr.Node;
1558 ALE.Addr.Point := Usr^.Addr.Point;
1559 ALE.Addr.Domain := Usr^.Addr.Domain;
1560 ALE.FileName := FName;
1561 ALE.Del := False;
1562 Write(ArcList, ALE);
1563 End
1564 Else
1565 Begin
1566 Outbound^.SendFile(Usr, FName, ac_Nothing);
1567 If (CurArea^.Flags and fa_PT) <> 0 then
1568 Begin
1569 PTLE.TICName := '!'+Addr2Str(Usr^.Addr);
1570 PTLE.FileName := fn1;
1571 Write(PTList, PTLE);
1572 End;
1573 End;
1574 End;
1575 End;
1576
CheckForDupenull1577 Function CheckForDupe(Tic:PTick):Boolean;
1578 Var
1579 f: File of TDupeEntry;
1580 s: String;
1581 CurEntry: TDupeEntry;
1582 CFDupe: Boolean;
1583 i: LongInt;
1584 j: Byte;
1585 A1: TNetAddr;
1586
1587 Begin
1588 CFDupe := False;
1589 For i := 1 to Tic^.NumPath do For j := 1 to Cfg^.NumAddrs do
1590 Begin
1591 If (Pos(' ', Tic^.Path[i]) > 0) then Str2Addr(Copy(Tic^.Path[i], 1, Pos(' ', Tic^.Path[i])), A1)
1592 Else Str2Addr(Tic^.Path[i], A1);
1593 CFDupe := CFDupe or (CompAddr(A1, Cfg^.Addrs[j]) and not (A1.Zone=0));
1594 End;
1595 CheckForDupe := CFDupe;
1596 If CFDupe then Exit;
1597 Assign(f, Cfg^.DupeFile);
1598 {$I-} ReSet(f); {$I+}
1599 If (IOResult = 0) then
1600 Begin
1601 While not EOF(f) do
1602 Begin
1603 {$I-} Read(f, CurEntry); {$I+}
1604 If (IOResult <> 0) then
1605 Begin
1606 LogSetCurLevel(LogHandle, 1);
1607 LogWriteLn(LogHandle, 'Error reading "'+Cfg^.DupeFile+'"!');
1608 Break;
1609 End;
1610 If (UpStr(Tic^.Area) = UpStr(CurEntry.Area)) Then
1611 If (UpStr(Tic^.Name) = UpStr(CurEntry.Name)) Then
1612 If (Tic^.CRC = CurEntry.CRC) then CFDupe := True;
1613 End;
1614 CheckForDupe := CFDupe;
1615 {$I-} Close(f); {$I+}
1616 If (IOResult <> 0) then
1617 Begin
1618 LogSetCurLevel(LogHandle, 1);
1619 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.DupeFile+'"!');
1620 Exit;
1621 End;
1622 End;
1623 End;
1624
1625 Procedure WriteDupe(Tic:PTick);
1626 Var
1627 f: File of TDupeEntry;
1628 s: String;
1629 CurEntry: TDupeEntry;
1630 DT: TimeTyp;
1631
1632 Begin
1633 Today(DT); Now(DT);
1634 Assign(f, Cfg^.DupeFile);
1635 {$ifdef SPEED}
1636 {$I-} Append(f); {$I+}
1637 If (IOResult <> 0) then
1638 Begin
1639 {$I-} ReWrite(f); {$I+}
1640 If (IOResult <> 0) then
1641 Begin
1642 LogSetCurLevel(LogHandle, 1);
1643 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.DupeFile+'"!');
1644 Exit;
1645 End;
1646 End;
1647 {$Else}
1648 {$ifdef FPC}
1649 If (DosAppend(f) <> 0) then
1650 Begin
1651 LogSetCurLevel(LogHandle, 1);
1652 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.DupeFile+'"!');
1653 Exit;
1654 End;
1655 {$Else}
1656 If (DosAppend(File(f)) <> 0) then
1657 Begin
1658 LogSetCurLevel(LogHandle, 1);
1659 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.DupeFile+'"!');
1660 Exit;
1661 End;
1662 {$endif}
1663 {$endif}
1664 CurEntry.Area := Tic^.Area;
1665 CurEntry.Name := Tic^.Name;
1666 CurEntry.CRC := Tic^.CRC;
1667 CurEntry.Date := DTToUnixDate(DT);
1668 {$I-} Write(f, CurEntry); {$I+}
1669 If (IOResult <> 0) then
1670 Begin
1671 LogSetCurLevel(LogHandle, 1);
1672 LogWriteLn(LogHandle, 'Error writing to "'+Cfg^.DupeFile+'"!');
1673 End;
1674 {$I-} Close(f); {$I+}
1675 If (IOResult <> 0) then
1676 Begin
1677 LogSetCurLevel(LogHandle, 1);
1678 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.DupeFile+'"!');
1679 End
1680 Else
1681 Begin
1682 {$ifdef UNIX}
1683 ChMod(Cfg^.DupeFile, FilePerm);
1684 {$endif}
1685 End;
1686 End;
1687
1688 Procedure WriteLName(Path: DirStr; SName: String12; LName: String40);
1689 Var
1690 f: Text;
1691 s, Dir: String;
1692
1693 Begin
1694 LogSetCurLevel(LogHandle, 4);
1695 LogWriteLn(LogHandle, 'Longname: '+LName);
1696 SetLongName(Path, SName, LName);
1697 FSplit(CfgName, Dir, s, s);
1698 Assign(f, Cfg^.LNameLst);
1699 {$I-} Append(f); {$I+}
1700 If (IOResult <> 0) then
1701 Begin
1702 Assign(f, Cfg^.LNameLst);
1703 {$I-} ReWrite(f); {$I+}
1704 If (IOResult <> 0) then
1705 Begin
1706 LogSetCurLevel(LogHandle, 1);
1707 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.LNameLst+'"!');
1708 Exit;
1709 End;
1710 End;
1711 {$I-} WriteLn(f, Path + ',' + SName + ',' + LName); {$I+}
1712 If (IOResult <> 0) then
1713 Begin
1714 LogSetCurLevel(LogHandle, 1);
1715 LogWriteLn(LogHandle, 'Error writing to "'+Cfg^.LNameLst+'"!');
1716 End;
1717 {$I-} Close(f); {$I+}
1718 If (IOResult <> 0) then
1719 Begin
1720 LogSetCurLevel(LogHandle, 1);
1721 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.LNameLst+'"!');
1722 End
1723 Else
1724 Begin
1725 {$ifdef UNIX}
1726 ChMod(Cfg^.LNameLst, FilePerm);
1727 {$endif}
1728 End;
1729 End;
1730
1731
1732 Procedure Hatch;
1733 Var
1734 s, Dir, Name, Ext: String;
1735 i: LongInt;
1736 f: Text;
1737 f1: File of Byte;
1738 CRC, FSize: ULong;
1739 crlf: PChar2;
1740 PPos: PChar2;
1741 pc : PChar2;
1742
1743 Begin
1744 PPos := HDesc;
1745 GetMem(crlf, 3);
1746 GetMem(pc, 256);
1747 crlf^[0] := #13; crlf^[1] := #10; crlf^[2] := #0;
1748 LogSetCurLevel(LogHandle, 3);
1749 LogWriteLn(LogHandle, 'Hatch');
1750 If (HFile = '') then
1751 Begin
1752 Write('File: ');
1753 ReadLn(HFile);
1754 Write('Area: ');
1755 ReadLn(HArea);
1756 Write('Replaces: ');
1757 ReadLn(HReplace);
1758 Write('Desc: ');
1759 ReadLn(s);
1760 StrPCopy(Pointer(HDesc), s);
1761 Write('Delete files after hatching? ');
1762 ReadLn(s);
1763 s := UpStr(s);
1764 HMove := (s = 'TRUE') or (s = 'ON') or (s = '1') or (s[1] = 'Y') or (s[1] = 'J');
1765 End;
1766 If (HArea = '') then
1767 Begin
1768 WriteLn('No Area specified');
1769 Exit;
1770 End;
1771 HArea := UpStr(HArea);
1772 CurArea := Cfg^.Areas;
1773 While ((CurArea <> NIL) and (UpStr(CurArea^.Name) <> HArea)) do CurArea := CurArea^.Next;
1774 If (CurArea = NIL) then
1775 Begin
1776 LogSetCurLevel(LogHandle, 1);
1777 LogWriteLn(LogHandle, 'Area "'+HArea+'" for hatching not found in config!');
1778 Exit;
1779 End;
1780 CopyAddr(HFrom, CurArea^.Addr);
1781 CopyAddr(HTo, CurArea^.Addr);
1782 CopyAddr(HOrigin, CurArea^.Addr);
1783 HPW := Cfg^.LocalPwd;
1784 FSplit(HFile, Dir, Name, Ext);
1785 Name := LowStr(Name);
1786 Ext := LowStr(Ext);
1787 If (Dir <> Cfg^.InBound) then
1788 Begin
1789 If HMove then
1790 Begin
1791 If not MoveFile(HFile, Cfg^.InBound + DirSep + Name + Ext) then
1792 Begin
1793 LogSetCurLevel(LogHandle, 1);
1794 LogWriteLn(LogHandle, 'Couldn''t move file "'+HFile+'" to "'+
1795 Cfg^.InBound + DirSep + Name + Ext+'"');
1796 If not FileExist(Cfg^.InBound + Name + Ext) then Exit;
1797 End;
1798 End
1799 Else
1800 Begin
1801 If FileExist(Cfg^.InBound + DirSep + Name + Ext) then
1802 Begin
1803 Assign(f1, HFile);
1804 {$I-} i := FileSize(f1); {$I+}
1805 If (IOResult <> 0) then
1806 Begin
1807 LogSetCurLevel(LogHandle, 1);
1808 LogWriteLn(LogHandle, 'Couldn''t determine size of "'+HFile+'"!');
1809 End;
1810 Assign(f1, Cfg^.InBound + DirSep + Name + Ext);
1811 {$I-} If (i <> FileSize(f1)) then {$I+}
1812 Begin
1813 If (IOResult <> 0) then
1814 Begin
1815 LogSetCurLevel(LogHandle, 1);
1816 LogWriteLn(LogHandle, 'Couldn''t determine size of "'+
1817 Cfg^.InBound+DirSep+Name+Ext+'"!');
1818 End;
1819 LogSetCurLevel(LogHandle, 1);
1820 LogWriteLn(LogHandle, 'Another file named "'+ Name + Ext +
1821 '" already in InBound');
1822 FreeMem(crlf, 2);
1823 Exit;
1824 End;
1825 If (IOResult <> 0) then
1826 Begin
1827 LogSetCurLevel(LogHandle, 1);
1828 LogWriteLn(LogHandle, 'Couldn''t determine size of "'+Cfg^.InBound+
1829 DirSep+Name+Ext+'"!');
1830 End;
1831 End
1832 Else
1833 Begin
1834 If not CopyFile(HFile, Cfg^.InBound + DirSep + Name + Ext) then
1835 Begin
1836 LogSetCurLevel(LogHandle, 1);
1837 LogWriteLn(LogHandle, 'Couldn''t copy file "'+HFile+'" to inbound');
1838 FreeMem(crlf, 2);
1839 Exit;
1840 End;
1841 End;
1842 End;
1843 End;
1844 If not FileExist(Cfg^.InBound + DirSep + Name + Ext) then Exit;
1845 i := 0;
1846 Repeat
1847 Inc(i);
1848 s := Cfg^.InBound + DirSep + 'pt' + Copy(RandName, 1, 6) + '.tic';
1849 Until (not FileExist(s)) or (i = $FFFF);
1850 If (i >= $FFFF) then
1851 Begin
1852 LogSetCurLevel(LogHandle, 1);
1853 LogWriteLn(LogHandle, 'Couldn''t find unused filename for TIC!');
1854 FreeMem(crlf, 3);
1855 Exit;
1856 End;
1857 Assign(f1, Cfg^.InBound + DirSep + Name + Ext);
1858 {$I-} ReSet(f1);
1859 FSize := FileSize(f1); {$I+}
1860 i := IOResult;
1861 If (i <> 0) then
1862 Begin
1863 FSize := 0;
1864 LogSetCurLevel(LogHandle, 1);
1865 LogWriteLn(LogHandle, 'Couldn''t determine filesize: Error #'+IntToStr(i)+'!');
1866 End
1867 Else
1868 Begin
1869 {$I-} Close(f1); {$I+}
1870 i := IOResult;
1871 End;
1872 CRC := GetCRC(Cfg^.InBound + DirSep + Name + Ext);
1873 Assign(f, s);
1874 {$I-} ReWrite(f); {$I+}
1875 If (IOResult <> 0) then
1876 Begin
1877 LogSetCurLevel(LogHandle, 1);
1878 LogWriteLn(LogHandle, 'Couldn''t create "'+s+'"');
1879 FreeMem(crlf, 3);
1880 Exit;
1881 End;
1882 WriteLn(f, 'File '+Name+Ext);
1883 WriteLn(f, 'Area '+HArea);
1884 {$ifdef SPEED}
1885 If (HFrom <> EmptyAddr) then WriteLn(f, 'From '+Addr2Str(HFrom));
1886 If (HTo <> EmptyAddr) then WriteLn(f, 'To '+Addr2Str(HTo));
1887 If (HOrigin <> EmptyAddr) then WriteLn(f, 'Origin '+Addr2Str(HOrigin));
1888 {$Else}
1889 With HFrom do If ((Zone<>0) or (Net<>0) or (Node<>0) or (Point<>0)
1890 or (Domain<>'')) then WriteLn(f, 'From '+Addr2Str(HFrom));
1891 With HTo do If ((Zone<>0) or (Net<>0) or (Node<>0) or (Point<>0)
1892 or (Domain<>'')) then WriteLn(f, 'To '+Addr2Str(HTo));
1893 With HOrigin do If ((Zone<>0) or (Net<>0) or (Node<>0) or (Point<>0)
1894 or (Domain<>'')) then WriteLn(f, 'Origin '+Addr2Str(HOrigin));
1895 {$endif}
1896 If (HDesc^[0] > #0) then
1897 Begin
1898 If (StrPos(Pointer(HDesc), Pointer(crlf)) = NIL) then WriteLn(f, 'Desc '+StrPas(Pointer(HDesc)))
1899 Else
1900 Begin
1901 Write(f, 'Desc ');
1902 i := 0;
1903 While (HDesc^[i] <> #13) or (HDesc^[i+1] <> #10) Do
1904 Begin
1905 Write(f, HDesc^[i]);
1906 Inc(i);
1907 End;
1908 WriteLn(f);
1909 While (StrPos(Pointer(HDesc), Pointer(crlf)) <> NIL) do
1910 Begin
1911 Write(f, 'LDesc ');
1912 i := 0;
1913 While (HDesc^[i] <> #13) or (HDesc^[i+1] <> #10) do
1914 Begin
1915 Write(f, HDesc^[i]);
1916 Inc(i);
1917 End;
1918 WriteLn(f);
1919 {$ifdef OS2}
1920 HDesc := Pointer(StrPos(Pointer(HDesc), Pointer(crlf))+2);
1921 {$Else}
1922 {$ifdef FPC}
1923 HDesc := Pointer(StrPos(Pointer(HDesc), Pointer(crlf))+2);
1924 {$Else}
1925 HDesc := Pointer(StrPos(Pointer(HDesc), Pointer(crlf)));
1926 MemW[Seg(HDesc):Ofs(HDesc)+2] := MemW[Seg(HDesc):Ofs(HDesc)+2] + 2;
1927 {$endif}
1928 {$endif}
1929 End;
1930 If (HDesc^[i] > #0) then
1931 Begin
1932 Write(f, 'LDesc ');
1933 i := 0;
1934 Repeat
1935 Write(f, HDesc^[i]);
1936 Inc(i);
1937 Until (HDesc^[i] = #0);
1938 WriteLn(f);
1939 End;
1940 End;
1941 End;
1942 If (HReplace <> '') then WriteLn(f, 'Replaces '+HReplace);
1943 If (FSize <> 0) then WriteLn(f, 'Size '+IntToStr(FSize));
1944 WriteLn(f, 'CRC '+ WordToHex(word(CRC SHR 16)) + WordToHex(word(CRC mod 65536)));
1945 If (HPW <> '') then WriteLn(f, 'PW ' + HPW);
1946 WriteLn(f, 'Created by ProTick'+Version);
1947 {$I-} Close(f); {$I+}
1948 If (IOResult <> 0) then
1949 Begin
1950 LogSetCurLevel(LogHandle, 1);
1951 LogWriteLn(LogHandle, 'Couldn''t close "'+s+'"');
1952 End
1953 Else
1954 Begin
1955 {$ifdef UNIX}
1956 ChMod(s, FilePerm);
1957 {$endif}
1958 End;
1959 FreeMem(crlf, 3);
1960 FreeMem(pc, 256);
1961 HDesc := PPos;
1962 End;
1963
1964 Procedure NewFilesHatch;
1965 Var
1966 FName: String;
1967 {$ifdef SPEED}
1968 SRec: TSearchRec;
1969 {$Else}
1970 SRec: SearchRec;
1971 {$endif}
1972 f: Text;
1973 DT: TimeTyp;
1974 DOW: Word;
1975 s: String;
1976
1977 Begin
1978 LogSetCurLevel(LogHandle, 3);
1979 LogWriteLn(LogHandle, 'NewFilesHatch');
1980 CurArea := Cfg^.Areas;
1981 While (CurArea^.Next <> NIL) do
1982 Begin
1983 While ((CurArea^.Next <> NIL) and ((CurArea^.Flags and fa_NewFilesHatch) = 0)) do
1984 Begin
1985 CurArea := CurArea^.Next;
1986 End;
1987 If ((CurArea^.Flags and fa_NewFilesHatch) = 0) then Break;
1988 With Ini do With CurArea^ do
1989 Begin
1990 SetSection('FILEAREAS');
1991 While (UpStr(ReSecEnName) <> 'AREA') or (UpStr(ReSecEnValue) <> UpStr(Name)) do
1992 If not SetNextOpt then Break;
1993 If (UpStr(ReSecEnName) <> 'AREA') or (UpStr(ReSecEnValue) <> UpStr(Name)) then
1994 Begin
1995 LogSetCurLevel(LogHandle, 3);
1996 LogWriteLn(LogHandle, 'Couldn''t find area "'+Name+'" in ConfigFile!');
1997 End
1998 Else
1999 Begin
2000 SetNextOpt;
2001 s := UpStr(ReSecEnName);
2002 While ((s <> 'LASTHATCH') and (s <> 'AREA')) do
2003 Begin
2004 If not SetNextOpt then Break;
2005 s := UpStr(ReSecEnName);
2006 End;
2007 Today(DT);
2008 Now(DT);
2009 If UpStr(ReSecEnName) <> 'LASTHATCH' then
2010 Begin
2011 SetPrevOpt;
2012 InsertSecEntry('LastHatch',
2013 WordToHex(word(DTToUnixDate(DT) SHR 16))+ WordToHex(word(DTToUnixDate(DT))), '')
2014 End
2015 Else WriteSecEntry('LastHatch',
2016 WordToHex(word(DTToUnixDate(DT) SHR 16))+ WordToHex(word(DTToUnixDate(DT))), '')
2017 End;
2018 End;
2019 FName := CurArea^.Path + DirSep + '*.*';
2020 SRec.Name := FName;
2021 FindFirst(FName, AnyFile and (not Directory), SRec);
2022 While (DosError = 0) Do
2023 Begin
2024 If (Pos('FILES.', UpStr(SRec.Name)) = 1) then
2025 Begin
2026 FindNext(SRec);
2027 Continue;
2028 End;
2029 Assign(f, CurArea^.Path + DirSep + SRec.Name);
2030 {$I-} ReSet(f); {$I+}
2031 If (IOResult <> 0) then
2032 Begin
2033 LogSetCurLevel(LogHandle, 1);
2034 LogWriteLn(LogHandle, 'Couldn''t open "'+ CurArea^.Path + DirSep +
2035 SRec.Name + '"!');
2036 FindNext(SRec);
2037 Continue;
2038 End;
2039 With DT do GetFTime2(f, Year, Month, Day, Hour, Min, Sec);
2040 {$I-} Close(f); {$I+}
2041 If (IOResult <> 0) then
2042 Begin
2043 LogSetCurLevel(LogHandle, 1);
2044 LogWriteLn(LogHandle, 'Couldn''t close "'+ CurArea^.Path + DirSep
2045 + SRec.Name + '"!');
2046 End;
2047 If (DTToUnixDate(DT) > CurArea^.LastHatch) then
2048 Begin
2049 LogSetCurLevel(LogHandle, 3);
2050 LogWriteLn(LogHandle, 'Processing '+CurArea^.Path+DirSep+SRec.Name);
2051 HArea := CurArea^.Name;
2052 HFrom := CurArea^.Addr;
2053 HTo := CurArea^.Addr;
2054 HOrigin := CurArea^.Addr;
2055 HFile:= CurArea^.Path+DirSep+SRec.Name;
2056 HMove:= True;
2057 HReplace:= '';
2058 HDesc^[0] := #0;
2059 GetFileDesc(CurArea^.Path+DirSep+SRec.Name, HDesc);
2060 Hatch;
2061 End;
2062 FindNext(SRec);
2063 End;
2064 {$ifdef OS2}
2065 FindClose(SRec);
2066 {$endif}
2067 If (CurArea^.Next <> NIL) then CurArea := CurArea^.Next;
2068 End;
2069 End;
2070
2071 Procedure Scan;
2072 Var
2073 A1: TNetAddr;
2074 MKAddr: AddrType;
2075 bo: Boolean;
2076 i,j: LongInt;
2077 s1: String;
2078
2079 Begin
2080 LogSetCurLevel(LogHandle, 3);
2081 LogWriteLn(LogHandle, 'Scan');
2082 Case UpCase(Cfg^.NetMail[1]) of
2083 'H': NM := New(HudsonMsgPtr, Init);
2084 'S': NM := New(SqMsgPtr, Init);
2085 'F': NM := New(FidoMsgPtr, Init);
2086 'E': NM := New(EzyMsgPtr, Init);
2087 'J': NM := New(JamMsgPtr, Init);
2088 Else
2089 Begin
2090 LogSetCurLevel(LogHandle, 1);
2091 LogWriteLn(LogHandle, 'Invalid type for netmail area!');
2092 Exit;
2093 End;
2094 End;
2095 NM^.SetMsgPath(Copy(Cfg^.NetMail, 2, Length(Cfg^.NetMail) - 1));
2096 If (NM^.OpenMsgBase <> 0) then
2097 Begin
2098 LogSetCurLevel(LogHandle, 1);
2099 LogWriteLn(LogHandle, 'Couldn''t open netmail area!');
2100 Dispose(NM, Done);
2101 Exit;
2102 End;
2103 Case UpCase(Cfg^.NetMail[1]) of
2104 'H': NM2 := New(HudsonMsgPtr, Init);
2105 'S': NM2 := New(SqMsgPtr, Init);
2106 'F': NM2 := New(FidoMsgPtr, Init);
2107 'E': NM2 := New(EzyMsgPtr, Init);
2108 'J': NM2 := New(JamMsgPtr, Init);
2109 Else
2110 Begin
2111 LogSetCurLevel(LogHandle, 1);
2112 LogWriteLn(LogHandle, 'Invalid type for netmail area!');
2113 Dispose(NM, Done);
2114 Exit;
2115 End;
2116 End;
2117 NM2^.SetMsgPath(Copy(Cfg^.NetMail, 2, Length(Cfg^.NetMail) - 1));
2118 If (NM2^.OpenMsgBase <> 0) then
2119 Begin
2120 LogSetCurLevel(LogHandle, 1);
2121 LogWriteLn(LogHandle, 'Couldn''t open netmail area!');
2122 If (NM^.CloseMsgBase <> 0) then
2123 Begin
2124 LogSetCurLevel(LogHandle, 1);
2125 LogWriteLn(LogHandle, 'Couldn''t close netmail area!');
2126 End;
2127 Dispose(NM, Done);
2128 Dispose(NM2, Done);
2129 Exit;
2130 End;
2131 If (UpCase(Cfg^.NetMail[1]) = 'F') then FidoMsgPtr(NM)^.SetDefaultZone(0);
2132 If (UpCase(Cfg^.NetMail[1]) = 'F') then FidoMsgPtr(NM2)^.SetDefaultZone(0);
2133 NM^.SetMailType(mmtNetMail);
2134 NM2^.SetMailType(mmtNetMail);
2135 With NM^ do
2136 Begin
2137 SeekFirst(1);
2138 While SeekFound do
2139 Begin
2140 InitMsgHdr;
2141 {$ifdef UNIX}
2142 WriteLn('Msg #', GetMsgDisplayNum);
2143 {$Else}
2144 Write(#13'Msg #', GetMsgDisplayNum, ' ');
2145 {$endif}
2146 GetDest(MKAddr);
2147 MKAddr2TNetAddr(MKAddr, A1);
2148 bo := False;
2149 For i := 1 to Cfg^.NumAddrs do bo := bo or CompAddr(A1, Cfg^.Addrs[i]);
2150 If bo then
2151 Begin
2152 s1 := UpStr(GetTo);
2153 bo := False;
2154 For i := 1 to Cfg^.NumMgrNames do
2155 Begin
2156 j := Pos(UpStr(Cfg^.MgrNames[i]), s1);
2157 bo := bo or ((j > 0) and ((Length(s1) = (j+Length(Cfg^.MgrNames[i])-1))
2158 or (s1[j+Length(Cfg^.MgrNames[i])] = ' ')));
2159 End;
2160 If (bo and (not IsRcvd)) then
2161 Begin
2162 WriteLn;
2163 ProcessMail;
2164 End;
2165 End;
2166 SeekNext;
2167 End;
2168 WriteLn;
2169 If (NM^.CloseMsgBase <> 0) then
2170 Begin
2171 LogSetCurLevel(LogHandle, 1);
2172 LogWriteLn(LogHandle, 'Couldn''t close netmail area!');
2173 End;
2174 If (NM2^.CloseMsgBase <> 0) then
2175 Begin
2176 LogSetCurLevel(LogHandle, 1);
2177 LogWriteLn(LogHandle, 'Couldn''t close netmail area!');
2178 End;
2179 End;
2180 Dispose(NM, Done);
2181 Dispose(NM2, Done);
2182 End;
2183
2184 Procedure Maint;
2185 Begin
2186 WriteLn('Maint');
2187 WriteLn;
2188 LogSetCurLevel(loghandle, 5);
2189 LogWriteLn(loghandle, 'Calling PurgeArchs');
2190 Outbound^.PurgeArchs;
2191 LogSetCurLevel(loghandle, 5);
2192 LogWriteLn(loghandle, 'Calling DelPT');
2193 DelPT;
2194 LogWriteLn(loghandle, 'Calling PurgeDupes');
2195 PurgeDupes;
2196 LogSetCurLevel(loghandle, 5);
2197 LogWriteLn(loghandle, 'Done');
2198 End;
2199
2200 Procedure _Pack;
2201 Var
2202 s, s1: String;
2203 A1: TNetAddr;
2204 PackName: String;
2205 f1: File of Byte;
2206 Error: Integer;
2207 IsRead: Boolean;
2208 DoEnd: Boolean;
2209 AC, ACC: PArcList;
2210 f: Text;
2211 ListName: String;
2212 Dir: String;
2213 p: Pointer;
2214 i: Byte;
2215 NewArc: Boolean;
2216
2217 Procedure ReadList;
2218 Begin
2219 New(AC);
2220 ACC := AC;
2221 ACC^.Prev := NIL;
2222 ACC^.Next := NIL;
2223 Read(ArcList, ACC^.a);
2224 While not EOF(ArcList) Do
2225 Begin
2226 New(ACC^.Next);
2227 ACC^.Next^.Prev := ACC;
2228 ACC := ACC^.Next;
2229 ACC^.Next := NIL;
2230 Read(ArcList, ACC^.a);
2231 If (Byte(Acc^.a.Addr.Domain[0]) > 20) then Acc^.a.Addr.Domain[0] := #20;
2232 End;
2233 {$I-} Close(ArcList); {$I+}
2234 If (IOResult <> 0) then
2235 Begin
2236 LogSetCurLevel(LogHandle, 1);
2237 LogWriteLn(LogHandle, 'Couldn''t close ArcList!');
2238 End;
2239 End;
2240
2241 Procedure Sort; {Bubblesort}
2242 Var
2243 Swapped: Boolean;
2244
2245 Procedure Swap(var a, b: TArcListEntry);
2246 Var
2247 c: TArcListEntry;
2248
2249 Begin
2250 c := a;
2251 a := b;
2252 b := c;
2253 End;
2254
2255 Begin
2256 Repeat
2257 ACC := AC;
2258 Swapped := False;
2259 While (ACC^.Next <> NIL) do
2260 Begin
2261 If Addr2Str(ACC^.a.Addr) > Addr2Str(ACC^.Next^.a.Addr) then
2262 Begin
2263 Swap(ACC^.a, ACC^.Next^.a);
2264 Swapped := True;
2265 End;
2266 ACC := ACC^.Next;
2267 End;
2268 Until not Swapped;
2269 End;
2270
2271 Procedure DelFiles;
2272 Var
2273 OldAddr: TNetAddr;
2274 DoDel: Boolean;
2275
2276 Begin
2277 ACC := AC;
2278 While (ACC^.Next <> NIL) do ACC := ACC^.Next;
2279 Repeat
2280 OldAddr := ACC^.a.Addr;
2281 DoDel := ACC^.IsDone;
2282 Repeat
2283 If DoDel then
2284 Begin
2285 If ACC^.a.Del then
2286 Begin
2287 LogSetCurLevel(LogHandle, 4);
2288 LogWriteLn(LogHandle, 'deleting '+ACC^.a.FileName);
2289 DelFile(ACC^.a.FileName);
2290 End;
2291 ACC := ACC^.Prev;
2292 End
2293 Else
2294 Begin
2295 ACC := ACC^.Prev;
2296 End;
2297 Until (ACC = NIL) or (not CompAddr(OldAddr, ACC^.a.Addr));
2298 Until (ACC = NIL);
2299 End;
2300
2301 Procedure DispList;
2302 Var
2303 OldAddr: TNetAddr;
2304 DoDel: Boolean;
2305
2306 Begin
2307 ACC := AC;
2308 While (ACC^.Next <> NIL) do ACC := ACC^.Next;
2309 Repeat
2310 OldAddr := ACC^.a.Addr;
2311 DoDel := ACC^.IsDone;
2312 Repeat
2313 If DoDel then
2314 Begin
2315 If (ACC^.Prev <> NIL) then
2316 Begin
2317 ACC^.Prev^.Next := ACC^.Next;
2318 If (ACC^.Next <> NIL) then ACC^.Next^.Prev := ACC^.Prev;
2319 End
2320 Else
2321 Begin
2322 If (ACC^.Next <> NIL) then ACC^.Next^.Prev := NIL;
2323 AC := ACC^.Next;
2324 End;
2325 p := ACC^.Prev;
2326 Dispose(ACC);
2327 ACC := p;
2328 End
2329 Else
2330 Begin
2331 ACC := ACC^.Prev;
2332 End;
2333 Until (ACC = NIL) or (not CompAddr(OldAddr, ACC^.a.Addr));
2334 Until (ACC = NIL);
2335 End;
2336
2337
2338 Begin
2339 LogSetCurLevel(LogHandle, 3);
2340 LogWriteLn(LogHandle, 'Pack');
2341 FSplit(CfgName, s, s1, s1);
2342 ListName := s + 'files.lst';
2343 Assign(ArcList, Cfg^.ArcLst);
2344 Assign(PTList, Cfg^.PTLst);
2345 Assign(f, ListName);
2346 {$ifdef SPEED}
2347 {$I-} Append(PTList); {$I+}
2348 If (IOResult <> 0) then
2349 Begin
2350 {$I-} ReWrite(PTList); {$I+}
2351 If (IOResult <> 0) then
2352 Begin
2353 LogSetCurLevel(LogHandle, 1);
2354 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
2355 Done;
2356 Halt(Err_PTList);
2357 End;
2358 End;
2359 {$Else}
2360 {$ifdef FPC}
2361 If (DosAppend(PTList) <> 0) then
2362 Begin
2363 LogSetCurLevel(LogHandle, 1);
2364 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
2365 Done;
2366 Halt(Err_PTList);
2367 End;
2368 {$Else}
2369 If (DosAppend(File(PTList)) <> 0) then
2370 Begin
2371 LogSetCurLevel(LogHandle, 1);
2372 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.PTLst+'"!');
2373 Done;
2374 Halt(Err_PTList);
2375 End;
2376 {$endif}
2377 {$endif}
2378 {$I-} ReSet(ArcList); {$I+}
2379 If (IOResult <> 0) then Exit;
2380 If EOF(ArcList) then
2381 Begin
2382 Close(ArcList);
2383 Exit;
2384 End;
2385 ReadList;
2386 Sort;
2387 DoEnd := False;
2388 ACC := AC;
2389 Repeat
2390 CurUser := Cfg^.Users;
2391 While ((CurUser^.Next <> Nil) and (not CompAddr(ACC^.a.Addr, CurUser^.Addr))) do CurUser := CurUser^.Next;
2392 If not CompAddr(ACC^.a.Addr, CurUser^.Addr) then
2393 Begin
2394 LogSetCurLevel(LogHandle, 1);
2395 LogWriteLn(LogHandle, 'User '+Addr2Str(ACC^.a.Addr)+' in ArcList but not found in Config!');
2396 End
2397 Else
2398 Begin
2399 PackName := Outbound^.ArchiveName(CurUser);
2400 NewArc := not FileExist(PackName);
2401 LogSetCurLevel(LogHandle, 4);
2402 LogWriteLn(LogHandle, 'Processing '+PackName);
2403
2404 Assign(f, ListName);
2405 ReWrite(f);
2406 If (IOResult <> 0) then
2407 Begin
2408 LogSetCurLevel(LogHandle, 1);
2409 LogWriteLn(LogHandle, 'Couldn''t create "'+ListName+'"!');
2410 DispList;
2411 Exit;
2412 End;
2413
2414 Repeat
2415 LogSetCurLevel(LogHandle, 4);
2416 LogWriteLn(LogHandle, 'adding '+ACC^.a.FileName);
2417 WriteLn(f, ACC^.a.FileName);
2418 If (ACC^.a.PTFN <> '') then
2419 Begin
2420 LogSetCurLevel(LogHandle, 4);
2421 LogWriteLn(LogHandle, 'adding '+ACC^.a.PTFN+' to pt.lst');
2422 PTLE.TICName := PackName; {archive}
2423 PTLE.FileName := ACC^.a.PTFN; {passthrough file}
2424 Write(PTList, PTLE);
2425 End;
2426 If (ACC^.Next <> Nil) then ACC := ACC^.Next Else DoEnd := True;
2427 Until (not CompAddr(CurUser^.Addr, ACC^.a.Addr)) or DoEnd;
2428 {$I-} Close(f); {$I+}
2429 If (IOResult <> 0) then
2430 Begin
2431 LogSetCurLevel(LogHandle, 1);
2432 LogWriteLn(LogHandle, 'Couldn''t close "'+ListName+'"!');
2433 End
2434 Else
2435 Begin
2436 {$ifdef UNIX}
2437 ChMod(ListName, FilePerm);
2438 {$endif}
2439 End;
2440 If not Pack(CurUser^.Packer, PackName, ListName) then
2441 Begin
2442 LogSetCurLevel(LogHandle, 2);
2443 LogWriteLn(LogHandle, 'skipping user "'+CurUser^.Name+'" ('+Addr2Str(CurUser^.Addr)+')');
2444 If DoEnd then ACC^.IsDone := False Else ACC^.Prev^.IsDone := False;
2445 End
2446 Else If DoEnd then ACC^.IsDone := True Else ACC^.Prev^.IsDone := True;
2447 If NewArc then
2448 Begin
2449 LogSetCurLevel(LogHandle, 4);
2450 LogWriteLn(LogHandle, 'sending '+PackName);
2451 Outbound^.SendFile(CurUser, PackName, ac_Trunc);
2452 End;
2453 End;
2454 Until DoEnd;
2455 DelFiles;
2456 If FileExist(ListName) then
2457 Begin
2458 {$I-} Erase(f); {$I+}
2459 If (IOResult <> 0) then
2460 Begin
2461 LogSetCurLevel(LogHandle, 1);
2462 LogWriteLn(LogHandle, 'Couldn''t delete "'+ListName+'"!');
2463 End;
2464 End;
2465 DispList;
2466 {$I-} ReWrite(ArcList); {$I+}
2467 If (IOResult <> 0) then
2468 Begin
2469 LogSetCurLevel(LogHandle, 1);
2470 LogWriteLn(LogHandle, 'Couldn''t open "'+Cfg^.ArcLst+'"!');
2471 End;
2472 ACC := AC;
2473 While (ACC <> NIL) do
2474 Begin
2475 Write(ArcList, ACC^.a);
2476 ACC := ACC^.Next;
2477 End;
2478 {$I-} Close(ArcList); {$I+}
2479 If (IOResult <> 0) then
2480 Begin
2481 LogSetCurLevel(LogHandle, 1);
2482 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.ArcLst+'"!');
2483 End
2484 Else
2485 Begin
2486 {$ifdef UNIX}
2487 ChMod(Cfg^.ArcLst, FilePerm);
2488 {$endif}
2489 End;
2490 {$I-} Close(PTList); {$I+}
2491 If (IOResult <> 0) then
2492 Begin
2493 LogSetCurLevel(LogHandle, 1);
2494 LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.PTLst+'"!');
2495 End
2496 Else
2497 Begin
2498 {$ifdef UNIX}
2499 ChMod(Cfg^.PTLst, FilePerm);
2500 {$endif}
2501 End;
2502 ACC := AC;
2503 While (ACC <> NIL) do
2504 Begin
2505 p := ACC^.Next;
2506 Dispose(ACC);
2507 ACC := p;
2508 End;
2509 AC := NIL;
2510 End;
2511
2512 Procedure AddAnnFile(ar: String; fn: String; desc: PChar2; From: TNetAddr);
2513 Var
2514 s: String;
2515 pc: PChar2;
2516
2517 Begin
2518 s := UpStr(ar);
2519 CurAnnArea := AnnAreas;
2520 If (AnnAreas = NIL) then
2521 Begin
2522 New(AnnAreas);
2523 CurAnnArea := AnnAreas;
2524 CurAnnArea^.Prev := NIL;
2525 CurAnnArea^.Next := NIL;
2526 CurAnnArea^.Files := NIL;
2527 CurAnnArea^.Area := s;
2528 CurAnnArea^.Desc := '';
2529 CurAnnArea^.AnnGroups := CurArea^.AnnGroups;
2530 End
2531 Else If (UpStr(CurAnnArea^.Area) <> s) then
2532 Begin
2533 While (CurAnnArea^.Next <> NIL) and (UpStr(CurAnnArea^.Area) <> s) do
2534 CurAnnArea := CurAnnArea^.Next;
2535 If (UpStr(CurAnnArea^.Area) <> s) then
2536 Begin
2537 New(CurAnnArea^.Next);
2538 CurAnnArea^.Next^.Prev := CurAnnArea;
2539 CurAnnArea := CurAnnArea^.Next;
2540 CurAnnArea^.Next := NIL;
2541 CurAnnArea^.Files := NIL;
2542 CurAnnArea^.Area := s;
2543 CurAnnArea^.Desc := '';
2544 CurAnnArea^.AnnGroups := CurArea^.AnnGroups;
2545 End;
2546 End;
2547 CurAnnFile := CurAnnArea^.Files;
2548 If (CurAnnArea^.Files = NIL) then
2549 Begin
2550 New(CurAnnArea^.Files);
2551 CurAnnFile := CurAnnArea^.Files;
2552 CurAnnFile^.Prev := NIL;
2553 CurAnnFile^.Next := NIL;
2554 End
2555 Else
2556 Begin
2557 While (CurAnnFile^.Next <> NIL) do CurAnnFile := CurAnnFile^.Next;
2558 New(CurAnnFile^.Next);
2559 CurAnnFile^.Next^.Prev := CurAnnFile;
2560 CurAnnFile := CurAnnFile^.Next;
2561 CurAnnFile^.Next := NIL;
2562 End;
2563 CurAnnFile^.Name := fn;
2564 CurAnnFile^.Sender := From;
2565 If (Desc <> NIL) then
2566 Begin
2567 If (Desc^[0] = #0) then CurAnnFile^.Desc := NIL
2568 Else
2569 Begin
2570 GetMem(CurAnnFile^.Desc, 65535);
2571 StrCopy(Pointer(CurAnnFile^.Desc), Pointer(Desc));
2572 pc := Pointer(StrNew(Pointer(CurAnnFile^.Desc)));
2573 { StrDispose(Pointer(CurAnnFile^.Desc)); }
2574 CurAnnFile^.Desc := pc;
2575 End;
2576 End
2577 Else CurAnnFile^.Desc := NIL;
2578 CurAnnFile^.Size := GetFSize(CurArea^.Path + DirSep + fn);
2579 With CurAnnFile^.Date do GetFileTime(CurArea^.Path+DirSep+fn, Year, Month, Day, Hour, Min, Sec);
2580 End;
2581
2582 Procedure DispAnnList;
2583 Begin
2584 If (Cfg^.AnnGroups <> Nil) then
2585 Begin
2586 CurAnnGroup := Cfg^.AnnGroups;
2587 Repeat
2588 If (CurAnnGroup^.Next <> NIL) then CurAnnGroup := CurAnnGroup^.Next
2589 Else If (CurAnnGroup^.Prev <> NIL) then
2590 Begin
2591 CurAnnGroup := CurAnnGroup^.Prev;
2592 Dispose(CurAnnGroup^.Next);
2593 CurAnnGroup^.Next := NIL;
2594 End;
2595 Until (CurAnnGroup = Cfg^.AnnGroups);
2596 Dispose(CurAnnGroup);
2597 CurAnnGroup := NIL;
2598 Cfg^.AnnGroups := NIL;
2599 End;
2600 If (AnnAreas <> Nil) then
2601 Begin
2602 CurAnnArea := AnnAreas;
2603 Repeat
2604 If CurAnnArea^.Next <> NIL then CurAnnArea := CurAnnArea^.Next
2605 Else If CurAnnArea^.Prev <> NIL then
2606 Begin
2607 If CurAnnArea^.Files <> NIL then
2608 Begin
2609 AnnFiles := CurAnnArea^.Files;
2610 CurAnnFile := AnnFiles;
2611 Repeat
2612 If CurAnnFile^.Next <> NIL then CurAnnFile := CurAnnFile^.Next
2613 Else If CurAnnFile^.Prev <> NIL then
2614 Begin
2615 If (CurAnnFile^.Desc <> NIL) then
2616 StrDispose(Pointer(CurAnnFile^.Desc));
2617 CurAnnFile := CurAnnFile^.Prev;
2618 Dispose(CurAnnFile^.Next);
2619 CurAnnFile^.Next := NIL;
2620 End;
2621 Until (CurAnnFile = AnnFiles);
2622 StrDispose(Pointer(AnnFiles^.Desc));
2623 Dispose(AnnFiles);
2624 AnnFiles := NIL;
2625 CurAnnFile := NIL;
2626 CurAnnArea^.Files := NIL;
2627 End;
2628 CurAnnArea := CurAnnArea^.Prev;
2629 Dispose(CurAnnArea^.Next);
2630 CurAnnArea^.Next := NIL;
2631 End;
2632 Until (CurAnnArea = AnnAreas);
2633 Dispose(AnnAreas);
2634 AnnAreas := NIL;
2635 CurAnnArea := NIL;
2636 End;
2637 End;
2638
2639 Procedure MsgCopyFile(Msg: AbsMsgPtr; FName: String);
2640 Var
2641 f: Text;
2642 Error: Integer;
2643 Line: String;
2644
2645 Begin
2646 {sanity check}
2647 If (FName = '') then exit;
2648
2649 Assign(f, FName);
2650 {$I-} ReSet(f); {$I+}
2651 Error := IOResult;
2652 If (Error <> 0) then
2653 Begin
2654 LogSetCurLevel(LogHandle, 1);
2655 LogWriteLn(LogHandle, 'Could not open file "'+FName+'"!');
2656 Exit;
2657 End;
2658
2659 While (not EOF(f)) do
2660 Begin
2661 ReadLn(f, Line);
2662 {strip CR/LF}
2663 While (Line[Length(Line)] in [#10, #13]) do Line[0] := Char(Byte(Line[0]) - 1);
2664 Msg^.DoStringLn(Line);
2665 End;
2666
2667 Close(f);
2668 End;
2669
2670 Procedure DoAnnounce;
2671 Var
2672 DoEndArea, DoEndFile: Boolean;
2673 s, s2: String;
2674 crlf: PChar2;
2675 ODesc: PChar2;
2676 MKAddr: AddrType;
2677 DT: TimeTyp;
2678 i: LongInt;
2679 CurAG: LongInt;
2680 b: Boolean;
2681 p: Pointer;
2682 Error: Integer;
2683
2684 Begin
2685 If AnnAreas = NIL then Exit;
2686 GetMem(crlf, 3);
2687 crlf^[0] := #13; crlf^[1] := #10; crlf^[2] := #0;
2688 CurAnnArea := AnnAreas;
2689 DoEndArea := False;
2690 LogSetCurLevel(LogHandle, 3);
2691 LogWriteLn(LogHandle, 'Announce');
2692 WriteLn;
2693 Repeat
2694 For CurAG := 1 to 255 do If (CurAG in CurAnnArea^.AnnGroups) then
2695 Begin
2696 CurAnnGroup := Cfg^.AnnGroups;
2697 While ((CurAnnGroup^.Next <> NIL) and (CurAnnGroup^.Index <> CurAG)) do
2698 CurAnnGroup := CurAnnGroup^.Next;
2699 If (CurAnnGroup^.Index <> CurAG) then
2700 Begin
2701 LogSetCurLevel(LogHandle, 1);
2702 LogWriteLn(LogHandle, 'Unknown announcegroup: #'+IntToStr(CurAG)+'!');
2703 If CurAnnArea^.Next = NIL then
2704 Begin
2705 DoEndArea := True;
2706 Break;
2707 End
2708 Else
2709 Begin
2710 CurAnnArea := CurAnnArea^.Next;
2711 Continue;
2712 End;
2713 End;
2714 Case UpCase(CurAnnGroup^.Area[1]) of
2715 'H': AnnMsg := New(HudsonMsgPtr, Init);
2716 'S': AnnMsg := New(SqMsgPtr, Init);
2717 'F': AnnMsg := New(FidoMsgPtr, Init);
2718 'E': AnnMsg := New(EzyMsgPtr, Init);
2719 'J': AnnMsg := New(JamMsgPtr, Init);
2720 Else
2721 Begin
2722 LogSetCurLevel(LogHandle, 1);
2723 LogWriteLn(LogHandle, 'Invalid type for announce area: '+CurAnnGroup^.Area[1]+'!');
2724 If CurAnnArea^.Next = NIL then
2725 Begin
2726 DoEndArea := True;
2727 Break;
2728 End
2729 Else
2730 Begin
2731 CurAnnArea := CurAnnArea^.Next;
2732 Continue;
2733 End;
2734 End;
2735 End;
2736 AnnMsg^.SetMsgPath(Copy(CurAnnGroup^.Area, 2, Length(CurAnnGroup^.Area) - 1));
2737 {$I-} Error := AnnMsg^.OpenMsgBase; {$I+}
2738 If (Error <> 0) then
2739 Begin
2740 LogSetCurLevel(LogHandle, 1);
2741 LogWriteLn(LogHandle, 'Couldn''t open announce area "'+CurAnnGroup^.Area+
2742 '": Error '+IntToStr(Error)+'!');
2743 Dispose(AnnMsg, Done);
2744 If CurAnnArea^.Next = NIL then
2745 Begin
2746 DoEndArea := True;
2747 Break;
2748 End
2749 Else
2750 Begin
2751 CurAnnArea := CurAnnArea^.Next;
2752 Continue;
2753 End;
2754 End;
2755 WriteLn('Announcing to area "'+CurAnnGroup^.Area+'"');
2756 Case CurAnnGroup^.Typ of
2757 at_EchoMail: AnnMsg^.SetMailType(mmtEchoMail);
2758 at_Netmail: AnnMsg^.SetMailType(mmtNetMail);
2759 End;
2760 With AnnMsg^ do
2761 Begin
2762 StartNewMsg;
2763 SetTo(CurAnnGroup^.ToName);
2764 TNetAddr2MKAddr(CurAnnGroup^.ToAddr, MKAddr);
2765 SetDest(MKAddr);
2766 SetFrom(CurAnnGroup^.FromName);
2767 TNetAddr2MKAddr(CurAnnGroup^.FromAddr, MKAddr);
2768 SetOrig(MKAddr);
2769 SetSubj(CurAnnGroup^.Subj);
2770 SetLocal(True);
2771 If (CurAnnGroup^.Typ = at_Netmail) then SetPriv(True);
2772 Today(DT);
2773 If (DT.Year > 100) then DT.Year := DT.Year mod 100;
2774 Now(DT);
2775 If (DT.Month > 9) then s := IntToStr(DT.Month) + '-'
2776 Else s := '0' + IntToStr(DT.Month) + '-';
2777 If (DT.Day > 9) then s := s + IntToStr(DT.Day) + '-'
2778 Else s := s + '0' + IntToStr(DT.Day) + '-';
2779 If (DT.Year > 9) then s := s + IntToStr(DT.Year)
2780 Else s := s + '0' + IntToStr(DT.Year);
2781 SetDate(s);
2782 If (DT.Hour > 9) then s := IntToStr(DT.Hour) + ':'
2783 Else s := '0' + IntToStr(DT.Hour) + ':';
2784 If (DT.Min > 9) then s := s + IntToStr(DT.Min)
2785 Else s := s + '0' + IntToStr(DT.Min);
2786 SetTime(s);
2787 DoKludgeLn(#01'MSGID: '+Addr2Str(CurAnnGroup^.FromAddr)+' '+GetMsgID);
2788 MsgCopyFile(AnnMsg, CurAnnGroup^.HeaderFile);
2789 DoString('Area: '+CurAnnArea^.Area);
2790 If (CurAnnArea^.Desc <> '') then DoStringLn(' ('+CurAnnArea^.Desc+')')
2791 Else DoStringLn('');
2792 DoStringLn('-------------------------------------------------------------------------------');
2793
2794 CurAnnFile := CurAnnArea^.Files;
2795 DoEndFile := False;
2796 Repeat
2797 With CurAnnFile^ do
2798 Begin
2799 s := Name;
2800 If (Length(s) < 12) then s := s + Copy(Leer, 1, 12 - Length(s));
2801 DoString(s+' ');
2802 If (Date.Year > 100) then Date.Year := Date.Year mod 100;
2803 Now(DT);
2804 If (Date.Day > 9) then s := IntToStr(Date.Day) + '.'
2805 Else s := '0' + IntToStr(Date.Day) + '.';
2806 If (Date.Month > 9) then s := s + IntToStr(Date.Month) + '.'
2807 Else s := s + '0' + IntToStr(Date.Month) + '.';
2808 If (Date.Year > 9) then s := s + IntToStr(Date.Year)
2809 Else s := s + '0' + IntToStr(Date.Year);
2810 DoString(s+' ');
2811 If (Size > 10000000) then
2812 Begin
2813 s := IntToStr(Size div 1000000);
2814 If (Length(s) < 9) then s := Copy(Leer, 1, 9 - Length(s))+ s;
2815 s := s + 'mb';
2816 End
2817 Else If (Size > 100000) then
2818 Begin
2819 s := IntToStr(Size div 1000);
2820 If (Length(s) < 9) then s := Copy(Leer, 1, 9 - Length(s))+ s;
2821 s := s + 'kb';
2822 End
2823 Else
2824 Begin
2825 s := IntToStr(Size);
2826 If (Length(s) < 10) then s := Copy(Leer, 1, 10 - Length(s))+ s;
2827 s := s + 'b';
2828 End;
2829 DoString(s+' ');
2830 If (Desc <> NIL) then
2831 Begin
2832 ODesc := Desc;
2833 b := False;
2834 p := StrPos(Pointer(Desc), Pointer(crlf));
2835 {$ifdef OS2}
2836 While (p <> NIL) and (p < StrEnd(Pointer(Desc))) do
2837 {$Else}
2838 While (p <> NIL) do
2839 {$endif}
2840 Begin
2841 If not b then b := True Else DoString(Copy(Leer, 1, 34));
2842 i := 0;
2843 Repeat
2844 DoString(Desc^[i]);
2845 Inc(i);
2846 Until (Desc^[i] = #13) and (Desc^[i+1] = #10);
2847 DoStringLn('');
2848 {$ifdef OS2}
2849 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf))+2);
2850 {$Else}
2851 {$ifdef FPC}
2852 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf))+2);
2853 {$Else}
2854 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf)));
2855 MemW[Seg(Desc):Ofs(Desc)+2] := MemW[Seg(Desc):Ofs(Desc)+2] + 2;
2856 {$endif}
2857 {$endif}
2858 p := StrPos(Pointer(Desc), Pointer(crlf));
2859 End;
2860 If (Desc^[0] <> #0) then
2861 Begin
2862 i := 0;
2863 Repeat
2864 DoString(Desc^[i]);
2865 Inc(i);
2866 Until (Desc^[i] = #0);
2867 End;
2868 Desc := ODesc;
2869 End;
2870 DoStringLn('');
2871 End;
2872
2873 If CurAnnFile^.Next = NIL then DoEndFile := True Else CurAnnFile := CurAnnFile^.Next;
2874 Until DoEndFile;
2875
2876 DoStringLn('');
2877 MsgCopyFile(AnnMsg, CurAnnGroup^.FooterFile);
2878 DoStringLn('');
2879 DoStringLn('--- ProTick'+Version);
2880 If (CurAnnGroup^.Typ = at_EchoMail) then
2881 DoStringLn(' * Origin: '+Cfg^.BBS+' ('+
2882 Addr2StrND(CurAnnGroup^.FromAddr)+')');
2883 Error := WriteMsg;
2884 If (Error <> 0) then
2885 Begin
2886 LogSetCurLevel(LogHandle, 1);
2887 LogWriteLn(LogHandle, 'Couldn''t write announce to area "'+
2888 CurAnnGroup^.Area+'": Error '+IntToStr(Error)+'!');
2889 End;
2890 If (CloseMsgBase <> 0) then
2891 Begin
2892 LogSetCurLevel(LogHandle, 1);
2893 LogWriteLn(LogHandle, 'Couldn''t close announce area "'+CurAnnGroup^.Area+'"!');
2894 End;
2895 End;
2896 Dispose(AnnMsg, Done);
2897 End;
2898 If CurAnnArea^.Next = NIL then DoEndArea := True Else CurAnnArea := CurAnnArea^.Next;
2899 Until DoEndArea;
2900
2901 FreeMem(crlf, 3);
2902 End;
2903
2904 Procedure DoNMAnn;
2905 Var
2906 DoEndArea, DoEndFile: Boolean;
2907 s, s2: String;
2908 crlf: PChar2;
2909 ODesc: PChar2;
2910 MKAddr: AddrType;
2911 DT: TimeTyp;
2912 i: LongInt;
2913 b: Boolean;
2914 p: Pointer;
2915 Error: Integer;
2916
2917 Begin
2918 If AnnAreas = NIL then Exit;
2919 GetMem(crlf, 3);
2920 crlf^[0] := #13; crlf^[1] := #10; crlf^[2] := #0;
2921 CurAnnArea := AnnAreas;
2922 DoEndArea := False;
2923 Repeat
2924 Case UpCase(Cfg^.Netmail[1]) of
2925 'H': NM := New(HudsonMsgPtr, Init);
2926 'S': NM := New(SqMsgPtr, Init);
2927 'F': NM := New(FidoMsgPtr, Init);
2928 'E': NM := New(EzyMsgPtr, Init);
2929 'J': NM := New(JamMsgPtr, Init);
2930 Else
2931 Begin
2932 LogSetCurLevel(LogHandle, 1);
2933 LogWriteLn(LogHandle, 'Invalid type for netmail area: "'+Cfg^.Netmail[1]+'"!');
2934 Exit;
2935 End;
2936 End;
2937 NM^.SetMsgPath(Copy(Cfg^.Netmail, 2, Length(Cfg^.Netmail) - 1));
2938 {$I-} Error := NM^.OpenMsgBase; {$I+}
2939 If (Error <> 0) then
2940 Begin
2941 LogSetCurLevel(LogHandle, 1);
2942 LogWriteLn(LogHandle, 'Couldn''t open netmail area "'+Cfg^.Netmail+
2943 '": Error '+IntToStr(Error)+'!');
2944 Dispose(NM, Done);
2945 Exit;
2946 End;
2947 NM^.SetMailType(mmtNetMail);
2948 CurArea := Cfg^.Areas;
2949 While (CurArea^.Next <> NIL) and (UpStr(CurAnnArea^.Area) <>
2950 UpStr(CurArea^.Name)) do CurArea := CurArea^.Next;
2951 CurConnUser := CurArea^.Users;
2952
2953 While (CurConnUser <> NIL) do
2954 Begin
2955 {could the current user get files from us?}
2956 If (((CurConnUser^.User^.Flags and uf_NMAnn) > 0) and
2957 CurConnUser^.Receive and (CurConnUser^.User^.Active or
2958 ((CurArea^.Flags and fa_NoPause) > 0))) then
2959 Begin
2960 {check if there is any file which was not sent by the current user}
2961 CurAnnFile := CurAnnArea^.Files;
2962 While ((CurAnnFile^.Next <> NIL) and
2963 CompAddr(CurAnnFile^.Sender, CurConnUser^.User^.Addr)) do
2964 CurAnnFile := CurAnnFile^.Next;
2965 {only send announce if he really got files from us}
2966 If not CompAddr(CurAnnFile^.Sender, CurConnUser^.User^.Addr) then
2967 With NM^ do
2968 Begin
2969 LogSetCurLevel(LogHandle, 4);
2970 LogWriteLn(LogHandle, 'sending netmail announce to "'+
2971 CurConnUser^.User^.Name+'" ('+Addr2Str(CurConnUser^.User^.Addr)+')');
2972 StartNewMsg;
2973 SetTo(CurConnUser^.User^.Name);
2974 TNetAddr2MKAddr(CurConnUser^.User^.Addr, MKAddr);
2975 SetDest(MKAddr);
2976 s := 'ProTick'+Version;
2977 SetFrom(s);
2978 If not CompAddr(CurConnUser^.User^.OwnAddr, EmptyAddr) then
2979 TNetAddr2MKAddr(CurConnUser^.User^.OwnAddr, MKAddr)
2980 Else TNetAddr2MKAddr(CurArea^.Addr, MKAddr);
2981 SetOrig(MKAddr);
2982 SetSubj('new files arrived in Area '+CurAnnArea^.Area);
2983 SetLocal(True);
2984 SetPriv(True);
2985 SetKillSent(Cfg^.DelRsp);
2986 Today(DT);
2987 If (DT.Year > 100) then DT.Year := DT.Year mod 100;
2988 Now(DT);
2989 If (DT.Month > 9) then s := IntToStr(DT.Month) + '-'
2990 Else s := '0' + IntToStr(DT.Month) + '-';
2991 If (DT.Day > 9) then s := s + IntToStr(DT.Day) + '-'
2992 Else s := s + '0' + IntToStr(DT.Day) + '-';
2993 If (DT.Year > 9) then s := s + IntToStr(DT.Year)
2994 Else s := s + '0' + IntToStr(DT.Year);
2995 SetDate(s);
2996 If (DT.Hour > 9) then s := IntToStr(DT.Hour) + ':'
2997 Else s := '0' + IntToStr(DT.Hour) + ':';
2998 If (DT.Min > 9) then s := s + IntToStr(DT.Min)
2999 Else s := s + '0' + IntToStr(DT.Min);
3000 SetTime(s);
3001 If not CompAddr(CurConnUser^.User^.OwnAddr, EmptyAddr) then
3002 DoKludgeLn(#01'MSGID: '+Addr2Str(CurConnUser^.User^.OwnAddr)+' '+GetMsgID)
3003 Else DoKludgeLn(#01'MSGID: '+Addr2Str(CurArea^.Addr)+' '+GetMsgID);
3004 DoStringLn('The following files were sent to you today:');
3005 DoStringLn('');
3006 DoString('Area: '+CurAnnArea^.Area);
3007 If (CurAnnArea^.Desc <> '') then DoStringLn(' ('+CurAnnArea^.Desc+')')
3008 Else DoStringLn('');
3009 DoStringLn('-------------------------------------------------------------------------------');
3010
3011 CurAnnFile := CurAnnArea^.Files;
3012 DoEndFile := False;
3013 Repeat
3014 With CurAnnFile^ do
3015 Begin
3016 s := Name;
3017 If (Length(s) < 12) then s := s + Copy(Leer, 1, 12 - Length(s));
3018 DoString(s+' ');
3019 If (Date.Year > 100) then Date.Year := Date.Year mod 100;
3020 Now(DT);
3021 If (Date.Day > 9) then s := IntToStr(Date.Day) + '.'
3022 Else s := '0' + IntToStr(Date.Day) + '.';
3023 If (Date.Month > 9) then s := s + IntToStr(Date.Month) + '.'
3024 Else s := s + '0' + IntToStr(Date.Month) + '.';
3025 If (Date.Year > 9) then s := s + IntToStr(Date.Year)
3026 Else s := s + '0' + IntToStr(Date.Year);
3027 DoString(s+' ');
3028 If (Size > 10000000) then
3029 Begin
3030 s := IntToStr(Size div 1000000);
3031 If (Length(s) < 9) then s := Copy(Leer, 1, 9 - Length(s))+ s;
3032 s := s + 'mb';
3033 End
3034 Else If (Size > 100000) then
3035 Begin
3036 s := IntToStr(Size div 1000);
3037 If (Length(s) < 9) then s := Copy(Leer, 1, 9 - Length(s))+ s;
3038 s := s + 'kb';
3039 End
3040 Else
3041 Begin
3042 s := IntToStr(Size);
3043 If (Length(s) < 10) then s := Copy(Leer, 1, 10 - Length(s))+ s;
3044 s := s + 'b';
3045 End;
3046 DoString(s+' ');
3047 If (Desc <> NIL) then
3048 Begin
3049 ODesc := Desc;
3050 b := False;
3051 p := StrPos(Pointer(Desc), Pointer(crlf));
3052 {$ifdef OS2}
3053 While (p <> NIL) and (p < StrEnd(Pointer(Desc))) do
3054 {$Else}
3055 While (p <> NIL) do
3056 {$endif}
3057 Begin
3058 If not b then b := True Else DoString(Copy(Leer, 1, 34));
3059 i := 0;
3060 Repeat
3061 DoString(Desc^[i]);
3062 Inc(i);
3063 Until (Desc^[i] = #13) and (Desc^[i+1] = #10);
3064 DoStringLn('');
3065 {$ifdef OS2}
3066 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf))+2);
3067 {$Else}
3068 {$ifdef FPC}
3069 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf))+2);
3070 {$Else}
3071 Desc := Pointer(StrPos(Pointer(Desc), Pointer(crlf)));
3072 MemW[Seg(Desc):Ofs(Desc)+2] := MemW[Seg(Desc):Ofs(Desc)+2] + 2;
3073 {$endif}
3074 {$endif}
3075 p := StrPos(Pointer(Desc), Pointer(crlf));
3076 End;
3077 If (Desc^[0] <> #0) then
3078 Begin
3079 i := 0;
3080 Repeat
3081 DoString(Desc^[i]);
3082 Inc(i);
3083 Until (Desc^[i] = #0);
3084 End;
3085 Desc := ODesc;
3086 End;
3087 DoStringLn('');
3088 End;
3089
3090 If CurAnnFile^.Next = NIL then DoEndFile := True Else CurAnnFile := CurAnnFile^.Next;
3091 Until DoEndFile;
3092
3093 DoStringLn('');
3094 DoStringLn('--- ProTick'+Version);
3095 Error := WriteMsg;
3096 If (Error <> 0) then
3097 Begin
3098 LogSetCurLevel(LogHandle, 1);
3099 LogWriteLn(LogHandle, 'Couldn''t write announce to netmail area "'+
3100 Cfg^.Netmail+'": Error '+IntToStr(Error)+'!');
3101 End;
3102 End;
3103 End;
3104 CurConnUser := CurConnUser^.Next;
3105 End;
3106 If (NM^.CloseMsgBase <> 0) then
3107 Begin
3108 LogSetCurLevel(LogHandle, 1);
3109 LogWriteLn(LogHandle, 'Couldn''t close netmail area!');
3110 End;
3111 Dispose(NM, Done);
3112 If CurAnnArea^.Next = NIL then DoEndArea := True
3113 Else CurAnnArea := CurAnnArea^.Next;
3114 Until DoEndArea;
3115
3116 FreeMem(crlf, 3);
3117 End;
3118
3119
3120 Begin
3121 Init;
3122 If Command = 'TOSS' Then Toss
3123 Else If Command = 'HATCH' Then Hatch
3124 Else If Command = 'SCAN' Then Scan
3125 Else If Command = 'NEWFILESHATCH' then NewFilesHatch
3126 Else If Command = 'MAINT' Then Maint
3127 Else If Command = 'PACK' Then _Pack
3128 Else If Command = 'CHECK' Then {do nothing}
3129 Else Syntax;
3130 Done;
3131 End.
3132