mysticbbs/mystic/mutil_common.pas

265 lines
5.7 KiB
ObjectPascal

Unit MUTIL_Common;
{$I M_OPS.PAS}
Interface
Uses
m_Output,
m_IniReader,
mutil_Status;
{$I RECORDS.PAS}
Var
Console : TOutput;
INI : TINIReader;
BarOne : TStatusBar;
BarAll : TStatusBar;
ProcessTotal : Byte = 0;
ProcessPos : Byte = 0;
bbsConfig : RecConfig;
TempPath : String;
StartPath : String;
Const
Header_GENERAL = 'General';
Header_IMPORTNA = 'Import_FIDONET.NA';
Header_FILEBONE = 'Import_FILEBONE.NA';
Header_FILESBBS = 'Import_FILES.BBS';
Header_UPLOAD = 'MassUpload';
Header_TOPLISTS = 'GenerateTopLists';
Header_ALLFILES = 'GenerateAllFiles';
Header_MSGPURGE = 'PurgeMessageBases';
Header_MSGPACK = 'PackMessageBases';
Function strAddr2Str (Addr : RecEchoMailAddr) : String;
Function GenerateMBaseIndex : LongInt;
Function GenerateFBaseIndex : LongInt;
Function IsDupeMBase (FN: String) : Boolean;
Function IsDupeFBase (FN: String) : Boolean;
Procedure AddMessageBase (Var MBase: RecMessageBase);
Procedure AddFileBase (Var FBase: RecFileBase);
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
Procedure ExecuteArchive (FName: String; Temp: String; Mask: String; Mode: Byte);
Implementation
Uses
{$IFDEF UNIX}
Unix,
{$ENDIF}
DOS,
m_Types,
m_Strings,
m_FileIO;
Function strAddr2Str (Addr : RecEchoMailAddr) : String;
Var
Temp : String[20];
Begin
Temp := strI2S(Addr.Zone) + ':' + strI2S(Addr.Net) + '/' +
strI2S(Addr.Node);
If Addr.Point <> 0 Then Temp := Temp + '.' + strI2S(Addr.Point);
Result := Temp;
End;
Function IsDupeMBase (FN: String) : Boolean;
Var
MBaseFile : File of RecMessageBase;
MBase : RecMessageBase;
Begin
Result := False;
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
{$I-} Reset (MBaseFile); {$I+}
If IoResult <> 0 Then Exit;
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If strUpper(MBase.FileName) = strUpper(FN) Then Begin
Result := True;
Break;
End;
End;
Close (MBaseFile);
End;
Function IsDupeFBase (FN: String) : Boolean;
Var
FBaseFile : File of RecFileBase;
FBase : RecFileBase;
Begin
Result := False;
Assign (FBaseFile, bbsConfig.DataPath + 'fbases.dat');
{$I-} Reset (FBaseFile); {$I+}
If IoResult <> 0 Then Exit;
While Not Eof(FBaseFile) Do Begin
Read (FBaseFile, FBase);
If strUpper(FBase.FileName) = strUpper(FN) Then Begin
Result := True;
Break;
End;
End;
Close (FBaseFile);
End;
Function GenerateMBaseIndex : LongInt;
Var
MBaseFile : File of RecMessageBase;
MBase : RecMessageBase;
Begin
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
Reset (MBaseFile);
Result := FileSize(MBaseFile);
While Not Eof(MBaseFile) Do Begin
Read (MBaseFile, MBase);
If MBase.Index = Result Then Begin
Inc (Result);
Reset (MBaseFile);
End;
End;
Close (MBaseFile);
End;
Function GenerateFBaseIndex : LongInt;
Var
FBaseFile : File of RecFileBase;
FBase : RecFileBase;
Begin
Assign (FBaseFile, bbsConfig.DataPath + 'fbases.dat');
Reset (FBaseFile);
Result := FileSize(FBaseFile);
While Not Eof(FBaseFile) Do Begin
Read (FBaseFile, FBase);
If FBase.Index = Result Then Begin
Inc (Result);
Reset (FBaseFile);
End;
End;
Close (FBaseFile);
End;
Procedure AddMessageBase (Var MBase: RecMessageBase);
Var
MBaseFile : File of RecMessageBase;
Begin
Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat');
Reset (MBaseFile);
Seek (MBaseFile, FileSize(MBaseFile));
Write (MBaseFile, MBase);
Close (MBaseFile);
End;
Procedure AddFileBase (Var FBase: RecFileBase);
Var
FBaseFile : File of RecFileBase;
Begin
Assign (FBaseFile, bbsConfig.DataPath + 'fbases.dat');
Reset (FBaseFile);
Seek (FBaseFile, FileSize(FBaseFile));
Write (FBaseFile, FBase);
Close (FBaseFile);
End;
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
Var
Image : TConsoleImageRec;
Begin
Console.GetScreenImage(1, 1, 80, 25, Image);
If ExecPath <> '' Then DirChange(ExecPath);
{$IFDEF UNIX}
Result := Shell(Command);
{$ENDIF}
{$IFDEF WINDOWS}
If Command <> '' Then Command := '/C' + Command;
Exec (GetEnv('COMSPEC'), Command);
Result := DosExitCode;
{$ENDIF}
DirChange(StartPath);
Console.PutScreenImage(Image);
End;
Procedure ExecuteArchive (FName: String; Temp: String; Mask: String; Mode: Byte);
Var
ArcFile : File of RecArchive;
Arc : RecArchive;
Count : LongInt;
Str : String;
Begin
Temp := strUpper(JustFileExt(FName));
Assign (ArcFile, bbsConfig.DataPath + 'archive.dat');
{$I-} Reset (ArcFile); {$I+}
If IoResult <> 0 Then Exit;
Repeat
If Eof(ArcFile) Then Begin
Close (ArcFile);
Exit;
End;
Read (ArcFile, Arc);
If (Not Arc.Active) or ((Arc.OSType <> OSType) and (Arc.OSType <> 3)) Then Continue;
If strUpper(Arc.Ext) = Temp Then Break;
Until False;
Close (ArcFile);
Case Mode of
1 : Str := Arc.Pack;
2 : Str := Arc.Unpack;
End;
If Str = '' Then Exit;
Temp := '';
Count := 1;
While Count <= Length(Str) Do Begin
If Str[Count] = '%' Then Begin
Inc (Count);
If Str[Count] = '1' Then Temp := Temp + FName Else
If Str[Count] = '2' Then Temp := Temp + Mask Else
If Str[Count] = '3' Then Temp := Temp + TempPath;
End Else
Temp := Temp + Str[Count];
Inc (Count);
End;
ShellDOS ('', Temp);
End;
End.