Unit mUtil_FilesBBS; {$I M_OPS.PAS} Interface Procedure uImportFilesBBS; Implementation Uses m_Strings, m_FileIO, m_DateTime, mUtil_Common, mUtil_Status; 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, bbsConfig.DataPath + Base.FileName + '.des'); If FileExist(bbsConfig.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, bbsConfig.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, bbsConfig.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 < bbsConfig.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)'); ProcessResult (rDONE, True); End; End.