Code and function cleanup

This commit is contained in:
mysticbbs 2012-02-24 09:04:34 -05:00
parent 1a566d3748
commit 4ce629c839
9 changed files with 111 additions and 89 deletions

View File

@ -33,6 +33,10 @@ Function JustFile (Str: String) : String;
Function JustFileExt (Str: String) : String;
Function JustPath (Str: String) : String;
Function DirSlash (Str: String) : String;
Function DirChange (Dir: String) : Boolean;
Procedure DirClean (Path: String; Exempt: String);
Function FileRename (OldFN, NewFN: String) : Boolean;
Function FileCopy (Source, Target: String) : Boolean;
{ GLOBAL FILEIO VARIABLES AND CONSTANTS }
@ -106,6 +110,7 @@ Implementation
Uses
DOS,
m_Types,
m_Strings,
m_DateTime;
Const
@ -233,6 +238,77 @@ Begin
ioWrite := (ioCode = 0);
End;
Function FileCopy (Source, Target: String) : Boolean;
Var
SF : File;
TF : File;
BRead : LongInt;
BWrite : LongInt;
FileBuf : Array[1..4096] of Char;
Begin
Result := False;
Assign (SF, Source);
{$I-} Reset(SF, 1); {$I+}
If IOResult <> 0 Then Exit;
Assign (TF, Target);
{$I-} ReWrite(TF, 1); {$I+}
If IOResult <> 0 then Exit;
Repeat
BlockRead (SF, FileBuf, SizeOf(FileBuf), BRead);
BlockWrite (TF, FileBuf, BRead, BWrite);
Until (BRead = 0) or (BRead <> BWrite);
Close(SF);
Close(TF);
Result := BRead = BWrite;
End;
Function FileRename (OldFN, NewFN: String) : Boolean;
Var
OldF : File;
Begin
Assign (OldF, NewFN);
{$I-} Erase (OldF); {$I+}
If IoResult = 0 Then;
Assign (OldF, OldFN);
{$I-} ReName (OldF, NewFN); {$I+}
Result := (IoResult = 0);
End;
Procedure DirClean (Path: String; Exempt: String);
Var
DirInfo: SearchRec;
Begin
FindFirst(Path + '*', Archive, DirInfo);
While DosError = 0 Do Begin
If strUpper(Exempt) <> strUpper(DirInfo.Name) Then
FileErase(Path + DirInfo.Name);
FindNext(DirInfo);
End;
FindClose(DirInfo);
End;
Function DirChange (Dir: String) : Boolean;
Begin
While Dir[Length(Dir)] = PathSep Do Dec(Dir[0]);
Dir := Dir + PathSep;
{$I-} ChDir(Dir); {$I+}
Result := IoResult = 0;
End;
Function DirSlash (Str: String) : String;
Begin
If Copy(Str, Length(Str), 1) <> PathSep Then

View File

@ -62,9 +62,6 @@ Procedure AddRecord (var dFile; RecNum: LongInt; RecSize: Word);
Function Bool_Search (Mask: String; Str: String) : Boolean;
Function strAddr2Str (Addr: RecEchoMailAddr) : String;
Function strStr2Addr (S : String; Var Addr: RecEchoMailAddr) : Boolean;
Procedure CleanDirectory (Path: String; Exempt: String);
Function ChangeDir (Dir : String) : Boolean;
Function CopyFile (Source, Target : String): Boolean;
Function CheckPath (Str: String) : String;
Function ShellDOS (ExecPath: String; Command: String) : LongInt;
@ -235,65 +232,6 @@ Begin
Result := False;
End;
Function CopyFile (Source, Target : String): Boolean;
Var
SF,
TF : File;
BRead,
BWrite : LongInt;
FileBuf : Array[1..4096] of Char;
begin
CopyFile := False;
Assign(SF, Source);
{$I-} Reset(SF, 1); {$I+}
If IOResult <> 0 Then Exit;
Assign(TF, Target);
{$I-} ReWrite(TF, 1); {$I+}
If IOResult <> 0 then Exit;
Repeat
BlockRead (SF, FileBuf, SizeOf(FileBuf), BRead);
BlockWrite (TF, FileBuf, Bread, BWrite);
Until (BRead = 0) or (BRead <> BWrite);
Close(SF);
Close(TF);
If BRead = BWrite Then CopyFile := True;
End;
Procedure CleanDirectory (Path: String; Exempt: String);
Var
DirInfo: SearchRec;
Begin
FindFirst(Path + '*.*', Archive, DirInfo);
While DosError = 0 Do Begin
If strUpper(Exempt) <> strUpper(DirInfo.Name) Then
FileErase(Path + DirInfo.Name);
FindNext(DirInfo);
End;
FindClose(DirInfo);
End;
Function ChangeDir (Dir : String) : Boolean;
Begin
{ fpc linux needs trailing backslash}
{ fpc and vp windows doesnt matter}
{ tpx cannot have trailing backslash }
While Dir[Length(Dir)] = PathChar Do Dec(Dir[0]);
Dir := Dir + PathChar;
{$I-} ChDir(Dir); {$I+}
ChangeDir := IoResult = 0;
End;
Function CheckPath (Str: String) : String;
Begin
While Str[Length(Str)] = PathChar Do Dec(Str[0]);
@ -340,7 +278,7 @@ Begin
Screen.SetRawMode(False);
{$ENDIF}
If ExecPath <> '' Then ChangeDir(ExecPath);
If ExecPath <> '' Then DirChange(ExecPath);
{$IFDEF UNIX}
RetVal := Shell (Command);
@ -360,7 +298,7 @@ Begin
Screen.SetWindowTitle (WinConsoleTitle + strI2S(Session.NodeNum));
{$ENDIF}
ChangeDir(Config.SystemPath);
DirChange(Config.SystemPath);
If Session.User.UserNum <> -1 Then Begin
Reset (Session.User.UserFile);

View File

@ -15,6 +15,7 @@ Uses
m_Types,
m_Strings,
m_DateTime,
m_FileIO,
bbs_Common,
bbs_Core,
bbs_User;
@ -250,7 +251,7 @@ Begin
PI) Then
WaitForSingleObject (PI.hProcess, INFINITE);
ChangeDir(Config.SystemPath);
DirChange(Config.SystemPath);
If Session.User.UserNum <> -1 Then Begin
Reset (Session.User.UserFile);

View File

@ -242,7 +242,7 @@ Begin
ShellDOS (Path, Session.TempPath + 'xfer.bat');
{$ENDIF}
ChangeDir(Config.SystemPath);
DirChange(Config.SystemPath);
End;
Procedure TFileBase.GetTransferTime (Size: Longint; Var Mins : Integer; Var Secs: Byte);
@ -413,7 +413,7 @@ Begin
End Else
Session.io.OutFullLn (Session.GetPrompt(386));
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
End;
Procedure TFileBase.DownloadFileList (Data: String);
@ -443,7 +443,7 @@ Begin
SendFile (Session.TempPath + FileName);
End;
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
Session.User.IgnoreGroup := False;
End;
@ -703,9 +703,12 @@ Begin
Case Session.io.OneKey('DQRV', True) of
'D' : Begin
Session.io.OutFull (Session.GetPrompt(384));
Mask := Session.io.GetInput (70, 70, 11, '');
If Mask <> '' Then Begin
ExecuteArchive (FName, '', Mask, 2);
If FileExist(Session.TempPath + Mask) Then Begin
Case CheckFileLimits (1, GetFileSize(Session.TempPath + Mask) DIV 1024) of
0 : If SendFile (Session.TempPath + Mask) Then Begin;
@ -734,11 +737,13 @@ Begin
Mask := Session.io.GetInput (70, 70, 11, '');
If Mask <> '' Then Begin
ExecuteArchive (FName, '', Mask, 2);
Session.io.PromptInfo[1] := Mask;
Session.io.OutFullLn(Session.GetPrompt(306));
Session.io.AllowMCI := False;
Session.io.OutFile (Session.TempPath + Mask, True, 0);
Session.io.AllowMCI := True;
If Session.io.NoFile Then
Session.io.OutFullLn (Session.GetPrompt(305))
Else
@ -993,6 +998,8 @@ Begin
3 : Temp2 := Arc.View;
End;
If Temp2 = '' Then Exit;
Temp := '';
A := 1;
@ -2633,7 +2640,7 @@ Begin
FBase := OLD;
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
If Found Then
Session.io.OutFullLn (Session.GetPrompt(75))
@ -2660,7 +2667,7 @@ Begin
Session.io.PromptInfo[1] := FName;
Session.io.OutFullLn (Session.GetPrompt(82));
Copied := CopyFile(FBase.Path + FName, Session.TempPath + FName)
Copied := FileCopy(FBase.Path + FName, Session.TempPath + FName)
End;
End;
@ -2848,7 +2855,7 @@ Begin
BatchNum := 0;
CleanDirectory (Session.TempPath, '');
DirClean (Session.TempPath, '');
End;
Procedure TFileBase.FileSearch;
@ -3186,7 +3193,7 @@ Begin
Seek (FBaseFile, B - 1);
Read (FBaseFile, FBase);
If Not CopyFile (Old.Path + FDir.FileName, FBase.Path + FDir.FileName) Then Begin
If Not FileCopy (Old.Path + FDir.FileName, FBase.Path + FDir.FileName) Then Begin
Session.io.OutFull ('ERROR|CR|CR|PA');
FBase := Old;

View File

@ -1060,7 +1060,7 @@ Begin
If Not Session.LocalMode Then FileErase(FN);
CleanDirectory(Session.TempPath, 'msgtmp');
DirClean(Session.TempPath, 'msgtmp');
Session.io.PromptInfo[1] := T1;
Session.io.PromptInfo[2] := T2;
@ -3133,7 +3133,7 @@ Begin
{$I-} Reset (DataFile, 1); {$I+}
If IoResult <> 0 Then Begin
Session.io.OutFull (Session.GetPrompt(238));
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
Exit;
End;
@ -3143,7 +3143,7 @@ Begin
If Pos(strUpper(Config.qwkBBSID), strUpper(Temp)) = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(239));
Close (DataFile);
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
Exit;
End;
@ -3213,7 +3213,7 @@ Begin
End;
Close (DataFile);
CleanDirectory (Session.TempPath, '');
DirClean (Session.TempPath, '');
MBase := OldMBase;
End;
@ -3281,9 +3281,9 @@ Begin
Session.io.PromptInfo[1] := Temp;
If FileExist(Config.QwkWelcome) Then CopyFile(Config.qwkWelcome, Session.TempPath + JustFile(Config.qwkWelcome));
If FileExist(Config.QwkNews) Then CopyFile(Config.qwkNews, Session.TempPath + JustFile(Config.qwkNews));
If FileExist(Config.QwkGoodbye) Then CopyFile(Config.qwkGoodbye, Session.TempPath + JustFile(Config.qwkGoodbye));
If FileExist(Config.QwkWelcome) Then FileCopy(Config.qwkWelcome, Session.TempPath + JustFile(Config.qwkWelcome));
If FileExist(Config.QwkNews) Then FileCopy(Config.qwkNews, Session.TempPath + JustFile(Config.qwkNews));
If FileExist(Config.QwkGoodbye) Then FileCopy(Config.qwkGoodbye, Session.TempPath + JustFile(Config.qwkGoodbye));
If Session.LocalMode Then Begin
Session.FileBase.ExecuteArchive (Config.QWKPath + Temp, Session.User.ThisUser.Archive, Session.TempPath + FileMask, 1);
@ -3327,7 +3327,7 @@ Begin
MBase := Old;
CleanDirectory (Session.TempPath, '');
DirClean (Session.TempPath, '');
End;
(*

View File

@ -90,10 +90,12 @@ Begin
End;
Prompt := '';
For A := 0 to mysMaxLanguageStr Do Begin
Done[A] := False;
Write (PromptFile, Prompt);
End;
Reset (PromptFile);
While Not Eof(tFile) Do Begin

View File

@ -1568,7 +1568,7 @@ Begin
Store (TempBool, 1);
End;
507 : Begin
TempBool := CopyFile(Param[1].S, Param[2].S);
TempBool := FileCopy(Param[1].S, Param[2].S);
Store (TempBool, 1);
End;
508 : Begin

View File

@ -117,7 +117,7 @@ Begin
If Session.ExitLevel <> 0 Then ExitCode := Session.ExitLevel;
If Session.EventRunAfter Then ExitCode := Session.NextEvent.ErrLevel;
CleanDirectory (Session.TempPath, '');
DirClean (Session.TempPath, '');
{$IFNDEF UNIX}
Screen.TextAttr := 14;
@ -371,7 +371,7 @@ Begin
Session.TempPath := Config.SystemPath + 'temp' + strI2S(Session.NodeNum) + PathChar;
CleanDirectory(Session.TempPath, '');
DirClean(Session.TempPath, '');
Randomize;
End;
@ -387,7 +387,7 @@ Begin
SetHeapTraceOutput('mystic.mem');
{$ENDIF}
ChangeDir(JustPath(ParamStr(0)));
DirChange(JustPath(ParamStr(0)));
InitClasses;
@ -499,4 +499,4 @@ Begin
Repeat
Session.Menu.ExecuteMenu(True, True, False);
Until False;
End.
End.

View File

@ -253,10 +253,6 @@ Const
//LASTON needs optional1-10 compare to Mystic2
//FBASE
// ACS to comment on file
//FDIR
// pointer to comments record
// rating moved here from comment record
// file deletes and mbbsutil need updating to deal with comments
//MBASES
// expand header filename[20]
// add template[20]
@ -284,6 +280,8 @@ Const
// compare to mystic 2 for fallback stuff?
// rename to THEME
// horizontal/vertical percent bars
// default prot into users
// default prot into new user options
Type
RecUser = Record { USERS.DAT }