mysticbbs/mystic/mutil_filesbbs.pas

184 lines
4.4 KiB
ObjectPascal

Unit mUtil_FilesBBS;
{$I M_OPS.PAS}
Interface
Procedure uImportFilesBBS;
Implementation
Uses
m_Strings,
m_FileIO,
m_DateTime,
mUtil_Common,
mUtil_Status,
BBS_Records,
BBS_DataBase;
Procedure uImportFilesBBS;
Var
FilesAdded : LongInt = 0;
BaseFile : File of RecFileBase;
ListFile : File of RecFileList;
DescFile : File;
bbsFile : Text;
bbsBuffer : Array[1..4096] of Char;
OneLine : String;
Base : RecFileBase;
List : RecFileList;
FileName : String;
FSize : Int64;
Desc : Array[1..99] of String[50];
DescLines : Byte;
DescPos : Byte;
DescChar : String[1];
DescCharPos : Byte;
ImportName : String;
UploadName : String;
EraseAfter : Boolean;
NeedWrite : Boolean = False;
Procedure SaveDescription;
Var
Count : Byte;
Begin
Assign (DescFile, bbsCfg.DataPath + Base.FileName + '.des');
If FileExist(bbsCfg.DataPath + Base.FileName + '.des') Then
Reset (DescFile, 1)
Else
ReWrite (DescFile, 1);
List.DescPtr := FileSize(DescFile);
Seek (DescFile, List.DescPtr);
For Count := 1 to List.DescLines Do
BlockWrite (DescFile, Desc[Count][0], Length(Desc[Count]) + 1);
Close (DescFile);
End;
Procedure AddFile;
Var
Found : Boolean;
Begin
NeedWrite := False;
Found := False;
FileName := JustFile(FileName);
If FSize = -1 Then Exit;
Assign (ListFile, bbsCfg.DataPath + Base.FileName + '.dir');
{$I-} Reset(ListFile); {$I+}
If IoResult <> 0 Then ReWrite(ListFile);
While Not Eof(ListFile) And Not Found Do Begin
Read (ListFile, List);
Found := strUpper(List.FileName) = strUpper(FileName);
If Found and (FSize <> List.Size) Then Begin
Inc (FilesAdded);
List.Size := FSize;
List.DateTime := CurDateDos;
SaveDescription;
Seek (ListFile, FilePos(ListFile) - 1);
Write (ListFile, List);
Close (ListFile);
Exit;
End;
End;
If Not Found Then Begin
Inc (FilesAdded);
FillChar (List, SizeOf(List), 0);
List.FileName := FileName;
List.Size := FSize;
List.DateTime := CurDateDos;
List.Uploader := UploadName;
List.DescLines := DescLines;
SaveDescription;
Write (ListFile, List);
End;
Close (ListFile);
End;
Begin
ProcessName ('Import FILES.BBS', True);
ProcessResult (rWORKING, False);
EraseAfter := INI.ReadInteger(Header_FILESBBS, 'delete_after', 0) = 1;
DescPos := INI.ReadInteger(Header_FILESBBS, 'desc_start', 14);
DescCharPos := INI.ReadInteger(Header_FILESBBS, 'desc_charpos', 1);
DescChar := INI.ReadString(Header_FILESBBS, 'desc_char', ' ');
UploadName := INI.ReadString(Header_FILESBBS, 'uploader_name', 'Mystic BBS');
If DescChar = '' Then DescChar := ' ';
Assign (BaseFile, bbsCfg.DataPath + 'fbases.dat');
{$I-} Reset (BaseFile); {$I+}
If IoResult = 0 Then Begin
While Not Eof(BaseFile) Do Begin
Read (BaseFile, Base);
ImportName := FileFind(Base.Path + 'files.bbs');
Assign (bbsFile, ImportName);
SetTextBuf (bbsFile, bbsBuffer);
{$I-} Reset(bbsFile); {$I+}
If IoResult <> 0 Then Continue;
While Not Eof(bbsFile) Do Begin
ReadLn (bbsFile, OneLine);
If strStripB(OneLine, ' ') = '' Then Continue;
If OneLine[DescCharPos] <> DescChar Then Begin
If NeedWrite Then AddFile;
NeedWrite := True;
FileName := FileFind(Base.Path + strStripB(strWordGet(1, OneLine, ' '), ' '));
FSize := FileByteSize(FileName);
DescLines := 1;
Desc[1] := strStripB(Copy(OneLine, strWordPos(2, OneLine, ' '), 255), ' ');
End Else Begin
If DescLines < bbsCfg.MaxFileDesc Then Begin
Inc (DescLines);
Desc[DescLines] := strStripB(Copy(OneLine, DescPos, 255), ' ');
End;
End;
End;
If NeedWrite Then AddFile;
Close (bbsFile);
If EraseAfter Then
FileErase(ImportName);
End;
Close (BaseFile);
End;
ProcessStatus ('Uploaded |15' + strI2S(FilesAdded) + ' |07file(s)', True);
ProcessResult (rDONE, True);
End;
End.