1 Unit PTProcs;
2 InterFace
3 
4 Uses
5 {$IfDef UNIX}
6   linux,
7 {$EndIf}
8   DOS, Strings,
9   Types, GeneralP, Log,
10   TickType, TickCons, PTVar;
11 
12 
13 Procedure WriteTime;
Packnull14 Function Pack(Packer: Byte; Arc: String; fn: String): Boolean;
UnPacknull15 Function UnPack(UnPacker: Byte; Arc: String; Dir: String): Boolean;
16 Procedure ReplaceFiles(FSpec: String);
RandNamenull17 Function RandName: String8;
TicErrorStrnull18 Function TicErrorStr(ErrNum: Byte): String;
19 Procedure GetFileDesc(FName: String; Desc: PChar2);
20 Procedure SetFileDesc(FName: String; Desc: PChar2);
21 Procedure SetLongName(Path: DirStr; SName: String12; LName: String40);
Matchnull22 Function Match(s1, s2: String): Boolean;
23 Procedure AddAutoArea(Name: String);
24 Procedure AddTossArea(Name, BBSArea: String);
25 Procedure WriteAutoArea;
26 Procedure WriteTossArea;
27 Procedure WriteBBSArea;
28 Procedure DelPT;
29 Procedure PurgeDupes;
GetMsgIDnull30 Function GetMsgID : String;
31 
32 Implementation
33 
34 Procedure WriteTime;
35 Var
36   Date: TimeTyp;
37 
38   Begin
39   Now(Date);
40   With Date do WriteLn('Time: ', Hour, ':', Min, ':', Sec, '.', Sec100);
41   End;
42 
RandNamenull43 Function RandName: String8;
44   Begin
45   RandName := WordToHex(word(Random($FFFF)))+WordToHex(word(Random($FFFF)));
46   End;
47 
UnPacknull48 Function UnPack(UnPacker: Byte; Arc: String; Dir: String): Boolean;
49 Var
50   CurUnPacker : TUnPacker;
51   i: LongInt;
52   UPNum: Byte;
53   s: String;
54   Error: Integer;
55   DidUnpack: Boolean;
56   Found: LongInt;
57 
58   Begin
59   UPNum := 0;
60   CurUnPacker.Index := 255;
61   DidUnpack := False;
62   Found := 0;
63   For i := 1 to Cfg^.NumUnPacker do If (Cfg^.UnPacker[i].Index = UnPacker) then
64     Begin
65     CurUnPacker := Cfg^.UnPacker[i];
66     Found := i;
67     i := Cfg^.NumUnPacker + 1;
68     End;
69   If ((Found = 0) and (UnPacker <> 0)) then
70     Begin
71     LogSetCurLevel(LogHandle, 1);
72     LogWriteLn(LogHandle, 'Unknown UnPacker: #'+IntToStr(UnPacker));
73     Exit;
74     End;
75     Repeat
76     If ((UnPacker = 0) and (CurUnPacker.Index <> 0)) then
77       Begin
78       Inc(UPNum);
79       CurUnPacker := Cfg^.UnPacker[UPNum];
80       End;
81     s := CurUnPacker.Cmd;
82     i := Pos('%A', s);
83     While (i <> 0) do
84       Begin
85       Delete(s, i, 2);
86       Insert(Arc, s, i);
87       i := Pos('%A', s);
88       End;
89     i := Pos('%s', s);
90     While (i <> 0) do
91       Begin
92       Delete(s, i, 2);
93       Insert(Arc, s, i);
94       i := Pos('%s', s);
95       End;
96     i := Pos('%D', s);
97     While (i <> 0) do
98       Begin
99       Delete(s, i, 2);
100       Insert(Dir, s, i);
101       i := Pos('%D', s);
102       End;
103     ChDir(Dir);
104 {$IfDef OS2}
105  {$IfDef VIRTUALPASCAL}
106     Exec(GetEnv('COMSPEC'), '/C '+s);
107     Error := DOSExitCode;
108  {$Else}
109   {$IfDef FPC}
110     Exec(GetEnv('COMSPEC'), '/C '+s);
111     Error := DOSExitCode;
112   {$Else}
113     Error := DOSExitCode(Exec(GetEnv('COMSPEC'), '/C '+s));
114   {$EndIf}
115  {$EndIf}
116 {$Else}
117  {$IfDef UNIX}
118     Shell(s);
119     Error := DOSExitCode;
120  {$Else}
121     SwapVectors;
122     Exec(GetEnv('COMSPEC'), '/C '+s);
123     Error := DOSExitCode;
124     SwapVectors;
125  {$EndIf}
126 {$EndIf}
127     WriteLn('Exitcode ', Error);
128     DidUnPack := DidUnPack or (Error = 0);
129     If (Unpacker <> 0) and (Error > 0) then If (Error = 1) then
130      Begin
131      LogSetCurLevel(LogHandle, 3);
132      LogWriteLn(LogHandle, 'Called "'+s+'"');
133      LogWriteLn(LogHandle, 'UnPacker returned warning (errorlevel 1)');
134      End
135     Else
136      Begin
137      LogSetCurLevel(LogHandle, 2);
138      LogWriteLn(LogHandle, 'Called "'+s+'"');
139      LogWriteLn(LogHandle, 'UnPacker returned error (errorlevel '+IntToStr(Error)+')');
140      End;
141     Until ((UnPacker <> 0) or (CurUnPacker.Index = 0) or (UPNum = Cfg^.NumUnPacker));
142   UnPack := DidUnPack;
143   End;
144 
Packnull145 Function Pack(Packer: Byte; Arc: String; fn: String): Boolean;
146 Var
147   CurPacker : TPacker;
148   i: LongInt;
149   s: String;
150   s1: String;
151   Error: Integer;
152   Found: LongInt;
153 
154   Begin
155   Found := 0;
156   For i := 1 to Cfg^.NumPacker do If (Cfg^.Packer[i].Index = Packer) then
157     Begin
158     CurPacker := Cfg^.Packer[i];
159     Found := i;
160     End;
161   If (Found = 0) then
162     Begin
163     LogSetCurLevel(LogHandle, 1);
164     LogWriteLn(LogHandle, 'Unknown Packer: #'+IntToStr(Packer));
165     Exit;
166     End;
167   s := CurPacker.Cmd;
168   i := Pos('%A', s);
169   While (i <> 0) do
170     Begin
171     Delete(s, i, 2);
172     Insert(Arc, s, i);
173     i := Pos('%A', s);
174     End;
175   i := Pos('%F', s);
176   While (i <> 0) do
177     Begin
178     Delete(s, i, 2);
179     Insert(fn, s, i);
180     i := Pos('%F', s);
181     End;
182   i := Pos('$a', s);
183   While (i <> 0) do
184     Begin
185     Delete(s, i, 2);
186     Insert(Arc, s, i);
187     i := Pos('$a', s);
188     End;
189   i := Pos('$f', s);
190   While (i <> 0) do
191     Begin
192     Delete(s, i, 2);
193     Insert(fn, s, i);
194     i := Pos('$f', s);
195     End;
196   i := Pos('%', s);
197   While (i <> 0) do
198     Begin
199     Delete(s, i, 1);
200     s1 := Copy(s, i, Pos('%', s) - i);
201     Delete(s, i, (Pos('%', s) - i)+1);
202     Insert(GetEnv(UpStr(s1)), s, i);
203     i := Pos('%', s);
204     End;
205 {$IfDef OS2}
206  {$IfDef VIRTUALPASCAL}
207   Exec(GetEnv('COMSPEC'), '/C '+s);
208   Error := DosExitCode;
209  {$Else}
210   {$IfDef FPC}
211     Exec(GetEnv('COMSPEC'), '/C '+s);
212     Error := DOSExitCode;
213   {$Else}
214   Error := DosExitCode(Exec(GetEnv('COMSPEC'), '/C '+s));
215   {$EndIf}
216  {$EndIf}
217 {$Else}
218  {$IfDef UNIX}
219   Shell(s);
220   Error := DOSExitCode;
221  {$Else}
222   SwapVectors;
223   Exec(GetEnv('COMSPEC'), '/C '+s);
224   Error := DosExitCode;
225   SwapVectors;
226  {$EndIf}
227 {$EndIf}
228   If (Error > 0) then If (Error = 1) then
229    Begin
230    LogSetCurLevel(LogHandle, 3);
231    LogWriteLn(LogHandle, 'Called "'+s+'"');
232    LogWriteLn(LogHandle, 'Packer returned warning (errorlevel 1)');
233    End
234   Else
235    Begin
236    LogSetCurLevel(LogHandle, 2);
237    LogWriteLn(LogHandle, 'Called "'+s+'"');
238    LogWriteLn(LogHandle, 'Packer returned error (errorlevel '+IntToStr(Error)+')');
239    End;
240   Pack := (Error < 1);
241   End;
242 
243 Procedure ReplaceFiles(FSpec: String);
244 Var
245 {$IfDef SPEED}
246   SRec: TSearchRec;
247 {$Else}
248   SRec: SearchRec;
249 {$EndIf}
250   f: File;
251   Dir: String;
252   Name: String;
253   Ext: String;
254 
255   Begin
256   If (Pos('.', FSpec) = 0) then SRec.Name := FSpec + '.*'
257   Else SRec.Name := FSpec;
258   FindFirst(FSpec, AnyFile, SRec);
259   While (DosError = 0) Do
260     Begin
261     FSplit(FSpec, Dir, Name, Ext);
262     If (CurArea^.MoveTo <> '') then
263       Begin
264       DelFile(CurArea^.MoveTo + DirSep + SRec.Name);
265       If not MoveFile(Dir + SRec.Name, CurArea^.MoveTo + DirSep + SRec.Name) then
266         Begin
267         LogSetCurLevel(LogHandle, 1);
268         LogWriteLn(LogHandle, 'Couldn''t move "'+Dir + SRec.Name+'" to "'+CurArea^.MoveTo + DirSep+ SRec.Name +'"!');
269         End;
270       End
271     Else
272       Begin
273       If not DelFile(Dir + SRec.Name) then
274         Begin
275         LogSetCurLevel(LogHandle, 1);
276         LogWriteLn(LogHandle, 'Couldn''t delete "'+Dir + SRec.Name+'"!');
277         End;
278       End;
279     FindNext(SRec);
280     End;
281 {$IfDef OS2}
282   FindClose(SRec);
283 {$EndIf}
284   End;
285 
TicErrorStrnull286 Function TicErrorStr(ErrNum: Byte): String;
287   Begin
288   Case ErrNum of
289     bt_NoFile: TicErrorStr := 'File locked or not in InBound';
290     bt_CRC: TicErrorStr := 'CRC-Error';
291     bt_UnKnownArea: TicErrorStr := 'Unknown area';
292     bt_NotConnected: TicErrorStr := 'Sender not connected to area';
293     bt_NoSend: TicErrorStr := 'Sender not SEND-connected to area';
294     bt_WrongPwd: TicErrorStr := 'Wrong password';
295     bt_CouldntMove: TicErrorStr := 'Couldn''t move file';
296     bt_Dupe: TicErrorStr := 'Dupe';
297     bt_NotForUs: TicErrorStr := 'Not for us';
298     bt_Unlisted: TicErrorStr := 'Unlisted sender';
299     Else TicErrorStr := 'Unknown error';
300     End;
301   End;
302 
303 Procedure GetFileDesc(FName: String; Desc: PChar2);
304 Var
305   s: String;
306   f: Text;
307   Dir, Name, Ext: String;
308   ppos: word;
309   i: word;
310 
311   Begin
312   PPos := 0;
313   Desc^[0] := #0;
314   FSplit(FName, Dir, Name, Ext);
315 {$IfNDef UNIX}
316   Name := UpStr(Name);
317   Ext := UpStr(Ext);
318 {$EndIf}
319   Assign(f, Dir + 'files.bbs');
320   {$I-} ReSet(f); {$I+}
321   If (IOResult = 0) then
322     Begin
323     While (not EOF(f)) do
324       Begin
325       ReadLn(f, s);
326       If (s[Byte(s[0])] = #13) then s[0] := Char(Byte(s[0])-1);
327 {$IfDef UNIX}
328       If (Pos(Name+Ext, s) = 1) then Break;
329 {$Else}
330       If (Pos(Name+Ext, UpStr(s)) = 1) then Break;
331 {$EndIf}
332       End;
333 {$IfDef UNIX}
334     If (Pos(Name+Ext, s) = 1) then
335 {$Else}
336     If (Pos(Name+Ext, UpStr(s)) = 1) then
337 {$EndIf}
338       Begin
339       Delete(s, 1, Length(Name)+Length(Ext));
340       s := KillSpcs(s);
341       If ((s[1] = '[') and (s[2] in Digits)) then
342        Begin
343        While (s[1] <> ']') do Delete(s, 1, 1);
344        Delete(s, 1, 1);
345        End;
346       s := KillSpcs(s);
347       For i := 1 to Byte(s[0]) do Desc^[PPos + i - 1] := s[i];
348       PPos := Byte(s[0]) + 3;
349       Desc^[PPos-2] := #13;
350       Desc^[PPos-1] := #10;
351       While (not EOF(f)) do
352         Begin
353         ReadLn(f, s);
354         If (s[Byte(s[0])] = #13) then s[0] := Char(Byte(s[0])-1);
355         If (s[2] = ' ') then
356           Begin
357           KillLeadingSpcs(s);
358           For i := 1 to Byte(s[0]) do Desc^[PPos + i - 1] := s[i];
359           PPos := Byte(s[0]) + 3;
360           Desc^[PPos-2] := #13;
361           Desc^[PPos-1] := #10;
362           End
363         Else Break;
364         End;
365       Desc^[PPos] := #0;
366       End;
367     {$I-} Close(f); {$I+}
368     If (IOResult <> 0) then
369      Begin
370      LogSetCurLevel(LogHandle, 1);
371      LogWriteLn(LogHandle, 'Couldn''t close "'+Dir+'files.bbs"!');
372      End;
373     End;
374   End;
375 
376 Procedure SetFileDesc(FName: String; Desc: PChar2);
377 Var
378  FilesBBS: Text;
379  FilesTMP: Text;
380  Dir: DirStr;
381  Name: NameStr;
382  Ext: ExtStr;
383  Error: Integer;
384  NewFilesBBS: Boolean;
385  Line: String;
386  FoundOldDesc: Boolean;
387  i: Byte;
388  CRLF: PChar2;
389  FirstLine: Boolean;
390  CurDesc: PChar2;
391  CRLFPos: Pointer;
392 
393  Begin
394  {init vars}
395  FoundOldDesc := False;
396 
397  {get names of files.bbs and files.tmp, open them}
398  FSplit(FName, Dir, Name, Ext);
399 {$IfNDef UNIX}
400  Name := UpStr(Name) + UpStr(Ext);
401 {$Else}
402  Name := Name + Ext;
403 {$EndIf}
404  Assign(FilesBBS, Dir + 'files.bbs');
405  Assign(FilesTMP, Dir + 'files.tmp');
406  {$I-} ReSet(FilesBBS); {$I+}
407  NewFilesBBS := (IOResult <> 0);
408  {$I-} ReWrite(FilesTMP); {$I+}
409  Error := IOResult;
410  If (Error <> 0) then
411   Begin
412   LogSetCurLevel(LogHandle, 1);
413   LogWriteLn(LogHandle, 'Could not open "'+Dir+'files.tmp" for writing!');
414   If (not NewFilesBBS) then Close(FilesBBS);
415   Exit;
416   End;
417 
418  {if files.bbs existed, copy it to files.tmp and look for the filename}
419  If not NewFilesBBS then
420   Begin
421   While not EOF(FilesBBS) do
422    Begin
423    ReadLn(FilesBBS, Line);
424    {filenames begin at first char of line}
425 {$IfDef UNIX}
426    If (Pos(Name, Line) = 1) then
427 {$Else}
428    If (Pos(Name, UpStr(Line)) = 1) then
429 {$EndIf}
430     Begin
431     FoundOldDesc := True;
432     {skip old description}
433     If (not EOF(FilesBBS)) then ReadLn(FilesBBS, Line)
434     Else Line := '';
435     While (Line[2] = ' ') and (not EOF(FilesBBS)) do
436      Begin
437      ReadLn(FilesBBS, Line);
438      {descriptions have a space at the second char of line}
439      End;
440     If (Line[2] = ' ') then Line := '';
441     Break;
442     End;
443    WriteLn(FilesTMP, Line);
444    End;
445   End;
446 
447  {write (new) entry}
448  Write(FilesTMP, Name+' ');
449  {add DownLoadCounter}
450  If (Cfg^.AddDLC) then
451   Begin
452   Write(FilesTMP, '['+Copy('0000000000', 1, Cfg^.DLCDig)+'] ');
453   End;
454  {write description}
455  If (Desc <> NIL) and (Desc^[0] > #0) then
456   Begin
457   GetMem(CRLF, 3); CRLF^[0] := #13; CRLF^[1] := #10; CRLF^[2] := #0;
458   FirstLine := True;
459   CurDesc := Desc;
460 
461   While (StrPos(Pointer(CurDesc), Pointer(CRLF)) <> NIL) do
462    Begin
463    CRLFPos := StrPos(Pointer(CurDesc), Pointer(CRLF));
464    If FirstLine then
465     Begin
466     FirstLine := False;
467 
468     While (CurDesc <> CRLFPos) do
469      Begin
470      Write(filesTMP, CurDesc^[0]);
471      CurDesc := @CurDesc^[1];
472      End;
473     If not Cfg^.SingleDescLine then WriteLn(FilesTMP);
474     End
475    Else
476     Begin
477     {add LongDescChar + Spaces}
478     If not Cfg^.SingleDescLine then
479      Begin
480      Write(FilesTMP, Cfg^.LDescString);
481      If (Cfg^.DescPos > 2) then Write(FilesTMP, Copy(Leer, 1, Cfg^.DescPos-1));
482      End
483     Else Write(FilesTMP, ' ');
484 
485     While (CurDesc <> CRLFPos) do
486      Begin
487      Write(filesTMP, CurDesc^[0]);
488      CurDesc := @CurDesc^[1];
489      End;
490     If not Cfg^.SingleDescLine then WriteLn(FilesTMP);
491     End;
492    CurDesc := @CurDesc^[2]; {skip CR/LF}
493    End;
494 
495   {add last line}
496   If (CurDesc^[0] <> #0) then
497    Begin
498    If FirstLine then
499     Begin
500     FirstLine := False;
501 
502     While (CurDesc^[0] <> #0) do
503      Begin
504      Write(filesTMP, CurDesc^[0]);
505      CurDesc := @CurDesc^[1];
506      End;
507     If not Cfg^.SingleDescLine then WriteLn(FilesTMP);
508     End
509    Else
510     Begin
511     {add LongDescChar + Spaces}
512     If not Cfg^.SingleDescLine then
513      Begin
514      Write(FilesTMP, Cfg^.LDescString);
515      If (Cfg^.DescPos > 2) then Write(FilesTMP, Copy(Leer, 1, Cfg^.DescPos-1));
516      End
517     Else Write(FilesTMP, ' ');
518 
519     While (CurDesc^[0] <> #0) do
520      Begin
521      Write(filesTMP, CurDesc^[0]);
522      CurDesc := @CurDesc^[1];
523      End;
524     If not Cfg^.SingleDescLine then WriteLn(FilesTMP);
525     End;
526    End;
527 
528   FreeMem(CRLF, 3);
529   End
530  Else
531   Begin
532   WriteLn(FilesTMP, '<no description available>');
533   End;
534 
535  {copy remaining entries of files.bbs if any}
536  If (not NewFilesBBS) and (FoundOldDesc) then
537   Begin
538   {check if EOF occured while skipping old description}
539   If (Line <> '') then
540    Begin
541    WriteLn(FilesTMP, Line);
542 
543    While not EOF(FilesBBS) do
544     Begin
545     ReadLn(FilesBBS, Line);
546     WriteLn(FilesTMP, Line);
547     End;
548    End;
549   End;
550 
551  {close files, replace files.bbs by files.tmp}
552  If not NewFilesBBS then Close(FilesBBS);
553  Close(FilesTMP);
554 {$IfDef UNIX}
555  ChMod(Dir+'files.tmp', FilePerm);
556 {$EndIf}
557  If not RepFile(Dir+'files.tmp', Dir+'files.bbs') then
558   Begin
559   LogSetCurLevel(LogHandle, 1);
560   LogWriteLn(LogHandle, 'Couldn''t replace "'+Dir+'files.bbs"!');
561   End;
562  End;
563 
564 
565 Procedure SetLongName(Path: DirStr; SName: String12; LName: String40);
566 Var
567  f1, f2: Text;
568  Found: Boolean;
569  s, SNameU: String;
570 
571  Begin
572 {$IfNDef UNIX}
573  SNameU := UpStr(SName);
574 {$EndIf}
575  Found := False;
576  Assign(f1, Path+DirSep+'files.lng');
577  Assign(f2, Path+DirSep+'files.tmp');
578  {$I-} ReWrite(f2); {$I+}
579  If (IOResult <> 0) then
580   Begin
581   LogSetCurLevel(LogHandle, 1);
582   LogWriteLn(LogHandle, 'Could not open "'+Path+DirSep+'files.tmp"!');
583   Exit;
584   End;
585  {$I-} ReSet(f1); {$I+}
586  If (IOResult = 0) then {copy file}
587   Begin
588   While not EOF(f1) do
589    Begin
590    ReadLn(f1, s);
591    If (s[Byte(s[0])] = #13) then s[0] := Char(Byte(s[0])-1);
592 {$IfDef UNIX}
593    If (copy(s, 1, Pos(' ', s)-1) = SName) then {replace entry}
594 {$Else}
595    If (UpStr(copy(s, 1, Pos(' ', s)-1)) = SNameU) then {replace entry}
596 {$EndIf}
597     Begin
598     Found := True;
599 {$IfDef UNIX}
600     WriteLn(f2, SName + ' ' + LName);
601 {$Else}
602     WriteLn(f2, SNameU + ' ' + LName);
603 {$EndIf}
604     End
605    Else WriteLn(f2, s);
606    End;
607   {$I-} Close(f1); {$I+}
608   If (IOResult <> 0) then
609    Begin
610    LogSetCurLevel(LogHandle, 1);
611    LogWriteLn(LogHandle, 'Could not close "'+Path+DirSep+'files.lng"!');
612    End;
613   {$I-} Erase(f1); {$I+}
614   If (IOResult <> 0) then
615    Begin
616    LogSetCurLevel(LogHandle, 1);
617    LogWriteLn(LogHandle, 'Could not delete "'+Path+DirSep+'files.lng"!');
618    End;
619   End;
620 {$IfDef UNIX}
621  If not Found then WriteLn(f2, SName + ' ' + LName); {append entry}
622 {$Else}
623  If not Found then WriteLn(f2, SNameU + ' ' + LName); {append entry}
624 {$EndIf}
625  {$I-} Close(f2); {$I+}
626  If (IOResult <> 0) then
627   Begin
628   LogSetCurLevel(LogHandle, 1);
629   LogWriteLn(LogHandle, 'Could not close "'+Path+DirSep+'files.tmp"!');
630   End
631  Else
632   Begin
633 {$IfDef UNIX}
634   ChMod(Path+DirSep+'files.tmp', FilePerm);
635 {$EndIf}
636   End;
637  {$I-} Rename(f2, Path+DirSep+'files.lng'); {$I+}
638  If (IOResult <> 0) then
639   Begin
640   LogSetCurLevel(LogHandle, 1);
641   LogWriteLn(LogHandle, 'Could not rename "'+Path+DirSep+'files.tmp" to "'+Path+DirSep+'files.lng"!');
642   End;
643  End;
644 
Matchnull645 Function Match(s1, s2: String): Boolean;
646 Var
647   i: Byte;
648 
649   Begin
650   If (s2 = '') or (s1 = '') then
651     Begin
652     Match := False;
653     Exit;
654     End;
655   If (Pos('*', s2) = 0) and (Pos('?', s2) = 0) then Match := (s1 = s2)
656   Else
657     Begin
658     For i := 1 to Length(s2) do
659       Begin
660       If (s2[i] = '*') then
661         Begin
662         Match := True;
663         Exit;
664         End
665       Else If (s2[i] = '?') then Continue
666       Else If (s1[i] <> s2[i]) then
667         Begin
668         Match := False;
669         Exit;
670         End;
671       End;
672     Match := True;
673     End;
674   End;
675 
676 Procedure WriteAutoArea;
677 Var
678   f: Text;
679 
680   Begin
681   If (AutoAddList = NIL) then exit;
682   If (Cfg^.NewAreasLst = '') then exit;
683   WriteLn('writing newareas.pt');
684   Assign(f, Cfg^.NewAreasLst);
685   {$I-} Append(f); {$I+}
686   If (IOResult <> 0) then
687     Begin
688     Assign(f, Cfg^.NewAreasLst);
689     {$I-} ReWrite(f); {$I+}
690     If (IOResult <> 0) then
691       Begin
692       LogSetCurLevel(LogHandle, 1);
693       LogWriteLn(LogHandle, 'Couldn''t open "'+ Cfg^.NewAreasLst+'"!');
694       Exit;
695       End;
696     End;
697   CurAutoAddList := AutoAddList;
698   While (CurAutoAddList <> NIL) do
699     Begin
700     WriteLn(f, CurAutoAddList^.Name);
701     CurAutoAddList := CurAutoAddList^.Next;
702     End;
703   Close(f);
704   If (IOResult <> 0) then
705    Begin
706    LogSetCurLevel(LogHandle, 1);
707    LogWriteLn(LogHandle, 'Couldn''t close "'+ Cfg^.NewAreasLst+'"!');
708    End
709   Else
710    Begin
711 {$IfDef UNIX}
712    ChMod(Cfg^.NewAreasLst, FilePerm);
713 {$EndIf}
714    End;
715   End;
716 
717 Procedure WriteTossArea;
718 Var
719   f: Text;
720   Error1, Error2: Integer;
721 
722   Begin
723   If (TossList = NIL) then exit;
724   If (Cfg^.AreasLog = '') then exit;
725   Assign(f, Cfg^.AreasLog);
726   {$I-} Append(f); {$I+}
727   Error1 := IOResult;
728   If (Error1 <> 0) then
729     Begin
730     Assign(f, Cfg^.AreasLog);
731     {$I-} ReWrite(f); {$I+}
732     Error2 := IOResult;
733     If (Error2 <> 0) then
734       Begin
735       LogSetCurLevel(LogHandle, 1);
736       LogWriteLn(LogHandle, 'Couldn''t open '+ Cfg^.AreasLog +
737       ': Error '+IntToStr(Error1)+', '+IntToStr(Error2)+'!');
738       Exit;
739       End;
740     End;
741   CurTossList := TossList;
742   While (CurTossList <> NIL) do
743     Begin
744     WriteLn(f, CurTossList^.Name);
745     CurTossList := CurTossList^.Next;
746     End;
747   Close(f);
748   If (IOResult <> 0) then
749    Begin
750    LogSetCurLevel(LogHandle, 1);
751    LogWriteLn(LogHandle, 'Couldn''t close '+ Cfg^.AreasLog+ '!');
752    End
753   Else
754    Begin
755 {$IfDef UNIX}
756    ChMod(Cfg^.AreasLog, FilePerm);
757 {$EndIf}
758    End;
759   End;
760 
761 Procedure WriteBBSArea;
762 Var
763   f: Text;
764   Error1, Error2: Integer;
765 
766   Begin
767   If (TossList = NIL) then exit;
768   If (Cfg^.BBSAreaLog = '') then exit;
769   Assign(f, Cfg^.BBSAreaLog);
770   {$I-} Append(f); {$I+}
771   Error1 := IOResult;
772   If (Error1 <> 0) then
773     Begin
774     Assign(f, Cfg^.BBSAreaLog);
775     {$I-} ReWrite(f); {$I+}
776     Error2 := IOResult;
777     If (Error2 <> 0) then
778       Begin
779       LogSetCurLevel(LogHandle, 1);
780       LogWriteLn(LogHandle, 'Couldn''t open '+ Cfg^.BBSAreaLog +
781         ': Error '+IntToStr(Error1)+', '+IntToStr(Error2)+'!');
782       Exit;
783       End;
784     End;
785   CurTossList := TossList;
786   While (CurTossList <> NIL) do
787     Begin
788     If (CurTossList^.BBSArea = '') then WriteLn(f, CurTossList^.Name)
789     Else WriteLn(f, CurTossList^.BBSArea);
790     CurTossList := CurTossList^.Next;
791     End;
792   Close(f);
793   If (IOResult <> 0) then
794    Begin
795    LogSetCurLevel(LogHandle, 1);
796    LogWriteLn(LogHandle, 'Couldn''t close '+ Cfg^.BBSAreaLog + '!');
797    End
798   Else
799    Begin
800 {$IfDef UNIX}
801    ChMod(Cfg^.BBSAreaLog, FilePerm);
802 {$EndIf}
803    End;
804   End;
805 
806 Procedure AddAutoArea(Name: String);
807   Begin
808   If (AutoAddList = NIL) then
809     Begin
810     New(AutoAddList);
811     CurAutoAddList := AutoAddList;
812     CurAutoAddList^.Next := NIL;
813     CurAutoAddList^.Prev := NIL;
814     CurAutoAddList^.Name := Name;
815     End
816   Else
817     Begin
818     CurAutoAddList := AutoAddList;
819       Repeat
820       If CurAutoAddList^.Name = Name then Break;
821       If CurAutoAddList^.Next <> NIL then CurAutoAddList := CurAutoAddList^.Next
822       Else Break;
823       Until False;
824     If (CurAutoAddList^.Name <> Name) then
825       Begin
826       New(CurAutoAddList^.Next);
827       CurAutoAddList^.Next^.Prev := CurAutoAddList;
828       CurAutoAddList := CurAutoAddList^.Next;
829       CurAutoAddList^.Next := NIL;
830       CurAutoAddList^.Name := Name;
831       End;
832     End;
833   End;
834 
835 Procedure AddTossArea(Name, BBSArea: String);
836   Begin
837   If (TossList = NIL) then
838     Begin
839     New(TossList);
840     CurTossList := TossList;
841     CurTossList^.Next := NIL;
842     CurTossList^.Prev := NIL;
843     CurTossList^.Name := Name;
844     CurTossList^.BBSArea := BBSArea;
845     End
846   Else
847     Begin
848     CurTossList := TossList;
849       Repeat
850       If CurTossList^.Name = Name then Break;
851       If CurTossList^.Next <> NIL then CurTossList := CurTossList^.Next
852       Else Break;
853       Until False;
854     If (CurTossList^.Name <> Name) then
855       Begin
856       New(CurTossList^.Next);
857       CurTossList^.Next^.Prev := CurTossList;
858       CurTossList := CurTossList^.Next;
859       CurTossList^.Next := NIL;
860       CurTossList^.Name := Name;
861       CurTossList^.BBSArea := BBSArea;
862       End;
863     End;
864   End;
865 
866 Procedure DelAll(Dir: String);
867 Var
868  f: File;
869 {$IfDef SPEED}
870  SRec: TSearchRec;
871 {$Else}
872  SRec: SearchRec;
873 {$EndIf}
874 
875  Begin
876 {$IfDef VER70}
877  FindFirst(Dir + DirSep + '*.*', AnyFile - Directory, SRec);
878 {$Else}
879  FindFirst(Dir + DirSep + '*', AnyFile - Directory, SRec);
880 {$EndIf}
881  While (DOSError = 0) do
882   Begin
883   WriteLn('deleting "'+Dir+DirSep+SRec.Name+'"');
884   Assign(f, Dir+DirSep+SRec.Name);
885   {$I-} Erase(f); {$I+}
886   If (IOResult <> 0) then
887    Begin
888    LogSetCurLevel(LogHandle, 1);
889    LogWriteLn(LogHandle, 'Could not delete "'+Dir+DirSep+SRec.Name+'"!');
890    End;
891   FindNext(SRec);
892   End;
893 {$IfDef OS2}
894  FindClose(SRec);
895 {$EndIf}
896  End;
897 
898 Procedure DelPT;
899 Var
900  f: File;
901  Error: Integer;
902  DoEnd: Boolean;
903  PTC, PTCC: PPTList;
904 {$IfDef SPEED}
905  SRec: TSearchRec;
906 {$Else}
907  SRec: SearchRec;
908 {$EndIf}
909 
910   Procedure ReadList;
911     Begin
912     New(PTC);
913     PTCC := PTC;
914     PTCC^.Prev := NIL;
915     PTCC^.Next := NIL;
916     Read(PTList, PTCC^.a);
917     While not EOF(PTList) Do
918       Begin
919       New(PTCC^.Next);
920       PTCC^.Next^.Prev := PTCC;
921       PTCC := PTCC^.Next;
922       PTCC^.Next := NIL;
923       Read(PTList, PTCC^.a);
924       End;
925     {$I-} Close(PTList); {$I+}
926     If (IOResult <> 0) then
927       Begin
928       LogSetCurLevel(LogHandle, 1);
929       LogWriteLn(LogHandle, 'Couldn''t close PTList!');
930       End;
931     End;
932 
933   Procedure Sort; {Bubblesort}
934   Var
935     Swapped: Boolean;
936 
937     Procedure Swap(var a, b: TPTListEntry);
938     Var
939       c: TPTListEntry;
940 
941       Begin
942       c := a;
943       a := b;
944       b := c;
945       End;
946 
947     Begin
948       Repeat
949       PTCC := PTC;
950       Swapped := False;
951       While (PTCC^.Next <> NIL) do With PTCC^ do
952         Begin
953         If a.FileName > PTCC^.Next^.a.FileName then
954           Begin
955           Swap(PTCC^.a, PTCC^.Next^.a);
956           Swapped := True;
957           End;
958         PTCC := PTCC^.Next;
959         End;
960       Until not Swapped;
961     End;
962 
963   Procedure DispList;
964     Begin
965     If PTC = NIL then Exit;
966     PTCC := PTC;
967       Repeat
968       If PTCC^.Next <> Nil then PTCC := PTCC^.Next
969       Else If PTCC^.Prev <> Nil then
970         Begin
971         PTCC := PTCC^.Prev;
972         Dispose(PTCC^.Next);
973         PTCC^.Next := Nil;
974         End;
975       Until (PTCC = PTC);
976     Dispose(PTC);
977     PTC := NIL;
978     PTCC := NIL;
979     End;
980 
Searchnull981  Function Search(fn: String):Boolean;
982  Var
983   p: Pointer;
984   a1: TNetAddr;
985 
986   Begin
987   Search := False;
988   PTCC := PTC;
989   While (PTCC <> NIL) and (PTCC^.Next <> NIL) do
990    Begin
991 {$IfDef UNIX}
992    If (PTCC^.a.FileName = fn) then
993 {$Else}
994    If (UpStr(PTCC^.a.FileName) = UpStr(fn)) then
995 {$EndIf}
996     Begin
997     If (PTCC^.a.TICName[1] = '!') then
998      Begin
999      CurUser := Cfg^.Users;
1000      Str2Addr(Copy(PTCC^.a.TICName, 2, Length(PTCC^.a.TICName)-1), a1);
1001      While ((CurUser^.Next <> NIL) and (not CompAddr(CurUser^.Addr, a1))) do
1002       CurUser := CurUser^.Next;
1003      If (not CompAddr(CurUser^.Addr, a1)) then
1004       Begin
1005       LogSetCurLevel(LogHandle, 1);
1006       LogWriteLn(LogHandle, 'Could not find user with address "'+
1007        Copy(PTCC^.a.TICName, 2, Length(PTCC^.a.TICName)-1)+'" used in PTList!');
1008       PTCC := PTCC^.Next;
1009       Continue;
1010       End;
1011      If not Outbound^.CheckFileSent(CurUser, fn) then
1012       Begin
1013       Search := True;
1014       Exit;
1015       End
1016      Else
1017       Begin
1018       If (PTCC^.Prev <> NIL) then
1019        Begin
1020        PTCC^.Prev^.Next := PTCC^.Next;
1021        If (PTCC^.Next <> NIL) then PTCC^.Next^.Prev := PTCC^.Prev;
1022        End
1023       Else
1024        Begin
1025        PTC := PTCC^.Next;
1026        If (PTCC^.Next <> NIL) then PTCC^.Next^.Prev := NIL;
1027        End;
1028       Dispose(PTCC);
1029       PTCC := PTCC^.Next;
1030       End;
1031      End
1032     Else
1033      Begin
1034      If FileExist(PTCC^.a.TICName) then
1035       Begin
1036       Search := True;
1037       Exit;
1038       End
1039      Else
1040       Begin
1041       If (PTCC^.Prev <> NIL) then
1042        Begin
1043        PTCC^.Prev^.Next := PTCC^.Next;
1044        If (PTCC^.Next <> NIL) then PTCC^.Next^.Prev := PTCC^.Prev;
1045        End
1046       Else
1047        Begin
1048        PTC := PTCC^.Next;
1049        If (PTCC^.Next <> NIL) then PTCC^.Next^.Prev := NIL;
1050        End;
1051       Dispose(PTCC);
1052       PTCC := PTCC^.Next;
1053       End;
1054      End
1055     End
1056    Else PTCC := PTCC^.Next;
1057    End;
1058   End;
1059 
1060  Procedure WriteList;
1061   Begin
1062   Assign(PTList, Cfg^.PTLst);
1063   {$I-} ReWrite(PTList); {$I+}
1064   If (IOResult <> 0) then
1065    Begin
1066    LogSetCurLevel(LogHandle, 1);
1067    LogWriteLn(LogHandle, 'Could not open "'+Cfg^.PTLst+'"!');
1068    Exit;
1069    End;
1070   If (PTCC <> NIL) then
1071    Begin
1072    While (PTCC^.Next <> NIL) do
1073     Begin
1074     Write(PTList, PTCC^.a);
1075     PTCC := PTCC^.Next;
1076     End;
1077    Write(PTList, PTCC^.a);
1078    End;
1079   {$I-} Close(PTList); {$I+}
1080   If (IOResult <> 0) then
1081    Begin
1082    LogSetCurLevel(LogHandle, 1);
1083    LogWriteLn(LogHandle, 'Could not close "'+Cfg^.PTLst+'"!');
1084    Exit;
1085    End;
1086 {$IfDef UNIX}
1087   ChMod(Cfg^.PTLst, FilePerm);
1088 {$EndIf}
1089   PTCC := PTC;
1090   End;
1091 
1092 
1093  Begin
1094  If (Cfg^.PT = '') then
1095   Begin
1096   LogSetCurLevel(LogHandle, 3);
1097   LogWriteLn(LogHandle, 'No passthrough path set, won''t delete passthrough files');
1098   Exit;
1099   End;
1100  Assign(PTList, Cfg^.PTLst);
1101  {$I-} ReSet(PTList); {$I+}
1102  If (IOResult <> 0) or EOF(PTList) then
1103   Begin
1104   DelAll(Cfg^.PT);
1105   Exit;
1106   End;
1107  ReadList;
1108  Sort;
1109  {search for files to be deleted}
1110 {$IfDef VER70}
1111  FindFirst(Cfg^.PT+DirSep+'*.*', AnyFile-Directory-VolumeID, SRec);
1112 {$Else}
1113  FindFirst(Cfg^.PT+DirSep+'*', AnyFile-Directory-VolumeID, SRec);
1114 {$EndIf}
1115  While (DOSError = 0) do
1116   Begin
1117   If not Search(SRec.Name) then
1118    Begin
1119    Assign(f, Cfg^.PT+DirSep+SRec.Name);
1120    WriteLn('deleting "'+Cfg^.PT+DirSep+SRec.Name+'"');
1121    {$I-} Erase(f); {$I+}
1122    If (IOResult <> 0) then
1123     Begin
1124     LogSetCurLevel(LogHandle, 1);
1125     LogWriteLn(LogHandle, 'Could not delete "'+Cfg^.PT+DirSep+SRec.Name+'"!');
1126     End;
1127    End;
1128   FindNext(SRec);
1129   End;
1130 {$IfDef OS2}
1131  FindClose(SRec);
1132 {$EndIf}
1133  WriteList;
1134  DispList;
1135  End;
1136 
1137 Procedure PurgeDupes;
1138 Var
1139   f1,f2: File of TDupeEntry;
1140   CurEntry: TDupeEntry;
1141   i: LongInt;
1142   DidPurge: Boolean;
1143   MaxDate: LongInt;
1144   DT: TimeTyp;
1145   TmpName: String;
1146 
1147   Begin
1148   Assign(f1, Cfg^.DupeFile);
1149   TmpName := Cfg^.DupeFile;
1150   TmpName[Byte(TmpName[0])] := '$';
1151   Assign(f2, TmpName);
1152   {$I-} ReSet(f1); {$I+}
1153   If (IOResult <> 0) then Exit;
1154   {$I-} ReWrite(f2); {$I+}
1155   If (IOResult <> 0) then
1156     Begin
1157     LogSetCurLevel(LogHandle, 1);
1158     LogWriteLn(LogHandle, 'Error opening "'+TmpName+'"!');
1159     Close(f1);
1160     Exit;
1161     End;
1162   DidPurge := False;
1163   Today(DT); Now(DT);
1164   MaxDate := DTToUnixDate(DT) + (Cfg^.MaxDupeAge * 86400);
1165   While not EOF(f1) do
1166     Begin
1167     Read(f1, CurEntry);
1168     If (CurEntry.Date < MaxDate) then Write(f2, CurEntry)
1169     Else DidPurge := True;
1170     End;
1171   If DidPurge then
1172     Begin
1173     LogSetCurLevel(LogHandle, 3);
1174     LogWriteLn(LogHandle, 'Purged DupeBase');
1175     End;
1176   {$I-} Close(f1); {$I+}
1177   If (IOResult <> 0) then
1178    Begin
1179    LogSetCurLevel(LogHandle, 1);
1180    LogWriteLn(LogHandle, 'Couldn''t close "'+Cfg^.DupeFile+'"!');
1181    End;
1182   {$I-} Close(f2); {$I+}
1183   If (IOResult <> 0) then
1184    Begin
1185    LogSetCurLevel(LogHandle, 1);
1186    LogWriteLn(LogHandle, 'Couldn''t close "'+TmpName+'"!');
1187    End
1188   Else
1189    Begin
1190 {$IfDef UNIX}
1191    ChMod(TmpName, FilePerm);
1192 {$EndIf}
1193    End;
1194   {$I-} Erase(f1); {$I+}
1195   If (IOResult <> 0) then
1196     Begin
1197     LogSetCurLevel(LogHandle, 1);
1198     LogWriteLn(LogHandle, 'Couldn''t delete "'+Cfg^.DupeFile+'"!');
1199     End;
1200   {$I-} Rename(f2, Cfg^.DupeFile); {$I+}
1201   If (IOResult <> 0) then
1202     Begin
1203     LogSetCurLevel(LogHandle, 1);
1204     LogWriteLn(LogHandle, 'Couldn''t rename "'+TmpName+
1205      '" to "'+Cfg^.DupeFile+'"!');
1206     End;
1207  End;
1208 
1209 
GetMsgIDnull1210 Function GetMsgID : String;
1211 Var
1212  MsgIDFile: Text;
1213  CurMsgID: ULong;
1214  Dir: String;
1215  s: String;
1216 {$IfDef VIRTUALPASCAL}
1217  Error: LongInt;
1218 {$Else}
1219  Error: Integer;
1220 {$EndIf}
1221 
1222  begin
1223  Assign(MsgIDFile, Cfg^.MsgIDFile);
1224  {$I-} ReSet(MsgIDFile); {$I+}
1225  If (IOResult = 0) then
1226   begin
1227   ReadLn(MsgIDFile, s);
1228   While (s[Byte(s[0])] = #10) or (s[Byte(s[0])] = #13) do Dec(s[0]);
1229   Val(s, CurMsgID, Error);
1230   If (Error <> 0) or (CurMsgID = 0) then CurMsgID := 1;
1231   Close(MsgIDFile);
1232   end
1233  Else CurMsgID := 1; {Reset MsgID if no MSGID.DAT is found}
1234  GetMsgID := WordToHex(word(CurMsgID SHR 16)) + WordToHex(word(CurMsgID));
1235  Inc(CurMsgID);
1236  {$I-} ReWrite(MsgIDFile); {$I+}
1237  If (IOResult = 0) then
1238   Begin
1239   Write(MsgIDFile, CurMsgID, #13#10);
1240   Close(MsgIDFile);
1241 {$IfDef UNIX}
1242   ChMod(Cfg^.MsgIDFile, FilePerm);
1243 {$EndIf}
1244   End;
1245  end;
1246 
1247 
1248 Begin
1249 End.
1250 
1251