Message base sorting in configuration editor

This commit is contained in:
mysticbbs 2013-01-17 17:13:12 -05:00
parent 773741ea84
commit 95cf05cf53
2 changed files with 118 additions and 2 deletions

View File

@ -4,15 +4,20 @@ Unit bbs_cfg_Common;
Interface
Uses
bbs_Ansi_MenuBox;
Const
cfgCommandList = 'Press / for command list';
Function GetCommandOption (StartY: Byte; CmdStr: String) : Char;
Function GetSortRange (List: TAnsiMenuList; Var First, Last: Word) : Boolean;
Implementation
Uses
bbs_ansi_MenuBox,
m_Strings,
m_QuickSort,
bbs_ansi_MenuForm;
Function GetCommandOption (StartY: Byte; CmdStr: String) : Char;
@ -54,4 +59,39 @@ Begin
Box.Free;
End;
Function GetSortRange (List: TAnsiMenuList; Var First, Last: Word) : Boolean;
Var
Count : Word;
Str : String;
Tagged : Boolean;
Begin
First := 0;
Last := 0;
Result := False;
For Count := 1 to List.ListMax Do Begin
List.Get (Count, Str, Tagged);
If Tagged Then Begin
If First = 0 Then First := Count Else
If Last > 0 Then Break;
End Else
If (First > 0) and (Last = 0) Then Last := Count - 1;
End;
If (First > 0) and (Last = 0) Then Last := List.ListMax - 1;
If First = 0 Then Begin
ShowMsgBox (0, 'Use TAB to tag a range first');
Exit;
End;
If Last - First > mdlMaxSortSize Then Begin
ShowMsgBox(0, 'Cannot sort more than ' + strI2S(mdlMaxSortSize) + ' items');
Exit;
End;
Result := True;
End;
End.

View File

@ -12,12 +12,87 @@ Uses
m_Strings,
m_FileIO,
m_Bits,
m_QuickSort,
bbs_Ansi_MenuBox,
bbs_Ansi_MenuForm,
bbs_Cfg_Common,
bbs_Cfg_SysCfg,
bbs_Common;
Type
RecMessageBaseFile = File of RecMessageBase;
Procedure SortMessageBases (Var List: TAnsiMenuList; Var MBaseFile: RecMessageBaseFile);
Var
TempBase : RecMessageBase;
TempFile : File of RecMessageBase;
Sort : TQuickSort;
SortFirst : Word;
SortLast : Word;
SortType : Byte;
Count : Word;
Str : String;
Tagged : Boolean;
Begin
If Not GetSortRange(List, SortFirst, SortLast) Then Exit;
Case GetCommandOption(10, 'B-Base Name|F-File Name|N-Network|A-Abort|') of
'B' : SortType := 1;
'F' : SortType := 2;
'N' : SortType := 3;
'A' : Exit;
End;
ShowMsgBox (3, ' Sorting... ');
Sort := TQuickSort.Create;
For Count := SortFirst to SortLast Do Begin
Seek (MBaseFile, Count - 1);
Read (MBaseFile, TempBase);
Case SortType of
1 : Sort.Add (strUpper(strStripPipe(TempBase.Name)), Count - 1);
2 : Sort.Add (strUpper(TempBase.FileName), Count - 1);
3 : Sort.Add (strI2S(TempBase.NetAddr), Count - 1);
End;
End;
Sort.Sort (1, Sort.Total, qAscending);
Close (MBaseFile);
ReName (MBaseFile, Config.DataPath + 'mbases.sortbak');
Assign (TempFile, Config.DataPath + 'mbases.sortbak');
Reset (TempFile);
Assign (MBaseFile, Config.DataPath + 'mbases.dat');
ReWrite (MBaseFile);
While FilePos(TempFile) < SortFirst - 1 Do Begin
Read (TempFile, TempBase);
Write (MBaseFile, TempBase);
End;
For Count := 1 to Sort.Total Do Begin
Seek (TempFile, Sort.Data[Count]^.Ptr);
Read (TempFile, TempBase);
Write (MBaseFile, TempBase);
End;
Seek (TempFile, SortLast);
While Not Eof(TempFile) Do Begin
Read (TempFile, TempBase);
Write (MBaseFile, TempBase);
End;
Close (TempFile);
Erase (TempFile);
Sort.Free;
End;
Procedure EditMessageBase (Var MBase: RecMessageBase);
Var
Box : TAnsiMenuBox;
@ -310,7 +385,7 @@ Begin
List.Close;
Case List.ExitCode of
'/' : Case GetCommandOption(10, 'I-Insert|D-Delete|C-Copy|P-Paste|G-Global|') of
'/' : Case GetCommandOption(10, 'I-Insert|D-Delete|C-Copy|P-Paste|G-Global|S-Sort|') of
'I' : If List.Picked > 1 Then Begin
AssignRecord(False);
MakeList;
@ -358,6 +433,7 @@ Begin
GlobalEdit (MBase);
End;
'S' : SortMessageBases (List, MBaseFile);
End;
#13 : If List.Picked < List.ListMax Then Begin
Seek (MBaseFile, List.Picked - 1);