Mit diesem Script können Gruppennamen auf verschienene Weise gekürtzt oder nach eigenem Wunsch umbenannt werden. Desweiteren können alle oder nur ein Server(-name) ausgeblendet werden.
Dieses Script ist (noch) nicht als INCLUDE-File erhältlich und ersetzt das originale OnNewsgroupListPaint.
{*******************************************************************************
* OnNewsgroupListPaint 3.4.7 *
* OnNewsgroupListPaint *
*******************************************************************************}
Program OnNewsgroupListPaint;
Const
{------------------------------------------------------------------------------}
{ Anwenderspezifische Einstellungen }
{------------------------------------------------------------------------------}
//--[ GRUPPEN ]-----------------------------------------------------------------
RenameGroups = False; // Setze die Einstellung auf "True", wenn du die Gruppen umbenennen möchtest
ShortenGroupNames = False; // Setze die Einstellung auf "True", wenn du die Gruppennamen kürzen möchtest
// z.B. de.comm.software.40tude-dialog -> d.c.s.40tude-dialog
// Folgende Einstellungen sind nur gültig, wenn ShortenGroupNames auf "True" gesetzt ist
GroupsExclude = 'hamster,dialog'; // Wenn du Gruppen von der Umbenennung ausschließen möchtest
// gib hier die Gruppen oder auch Namensteile davon ein
// Mehrere Einträge werden nur durch einen ',' getrennt
// sonst nichts!
CompleteShort = False; // Setze die Einstellung auf "True", wenn die Gruppennamen total gekürtzt werden sollen
// z.B: de.comm.software.40tude-dialog -> d.c.s.4-d
DotCount = 2; // Gib die Anzahl der Punke an, nach denen gekürtzt werden soll (1 oder 2)
// Funktioniert nur, wenn RenameGroups oder ShortenGroupNames auf "True" gesetzt wurden
WithPoints = True; // Setze die Einstellung auf "False", wenn du keine Punke zwischen den Zeichen möchtest
// z.B. de.comm.software.40tude-dialog -> dcs.40tude-dialog
//--[ SERVER ]------------------------------------------------------------------
HideServer = True; // Setze die Einstellung auf "True", wenn du die Servernamen ausblenden möchtest
// Mit folgender Einstellung wird nur ein Servername ausgeblendet
// HideServer muß dabei auf "True" gesetzt werden
HideOnlyOne = True; // Setze die Einstellung auf "False", wenn du alle Servernamen ausblenden möchtest
ServerName = 'hamster'; // Gib hier den Servernamen an, der ausgeblendet werden soll
{------------------------------------------------------------------------------}
{ Ende der Einstellungen }
{------------------------------------------------------------------------------}
{==============================================================================}
{ !!! Ab hier bitte nichts mehr ändern !!! }
{==============================================================================}
MaxInt = 2147483647;
Var NGConstantDots : TstringList;
NGConstantNoDots : TstringList;
NGShortDots : TstringList;
NGShortNoDots : TstringList;
GExtmp : String;
//--[ Procedure InitArrays ]----------------------------------------------------
Procedure InitArrays();
Begin
NGConstantDots := TstringList.Create;
NGConstantNoDots := TstringList.Create;
NGShortDots := TstringList.Create;
NGShortNoDots := TstringList.Create;
// Wenn du spezielle Namen für NGs vergeben möchtest, dann gib diese bitte unterhalb ein,
// mit dem vollständigen NG-Namen (Zeile kopieren und Einträge ändern).
// Gruppennamen ohne Punkte -> wenn WithPoints auf "False" gesetzt ist
With NGConstantNoDots Do
Begin
Add('de.comm.software.40tude-dialog=Dialog - der beste Newsreader');
End;
// Gruppennamen mit Punkten -> wenn WithPoints auf "True" gesetzt ist
With NGConstantDots Do
Begin
Add('de.comm.software.40tude-dialog=Dialog . der beste Newsreader');
End;
// Wenn du speziellen Teilen von Gruppennamen eine eigene Abkürzung geben möchtest, dann gib diese
// bitte unterhalb ein. (Zeile kopieren und Einträge ändern).
// Spezialnamen (ohne Punkte) -> wenn WithPoints auf "False" gesetzt ist
With NGShortNoDots Do
Begin
Add('MICROSOFT=ms_');
Add('NGFOLDER=ng_');
Add('FEUERWEHRMANN=fm_');
End;
// Spezialnamen (mit Punkten) -> wenn WithPoints auf "True" gesetzt ist
With NGShortDots Do
Begin
Add('MICROSOFT=ms');
Add('NGFOLDER=ng');
Add('FEUERWEHRMANN=fm');
End;
End;
//--[ Function SingleTerm ]-----------------------------------------------------
Function SingleTerm : String;
Var
tmpa : String;
cp : Integer;
Begin
tmpa := '';
cp := Pos(',', GExtmp);
If cp > 0 Then
Begin
tmpa := Copy(GExtmp, 1, cp - 1);
GExtmp := Copy(GExtmp, cp + 1, Length(GExtmp));
End
Else
If Length(GExtmp) > 0 Then
Begin
tmpa := GExtmp;
GExtmp := '';
End;
Result := tmpa;
End;
//--[ Function NameConstants ]--------------------------------------------------
Function NameConstants(NGName : String) : String;
Begin
Result := '';
If WithPoints = False Then
Begin
If NGConstantNoDots.IndexOfName(NGName) <> -1 Then
Result := NGConstantNoDots.Values[NGName];
End
Else
If NGConstantDots.IndexOfName(NGName) <> -1 Then
Result := NGConstantDots.Values[NGName];
End;
//--[ Function IsGroupExclude ]-------------------------------------------------
Function IsGroupExclude(NGName : String) : Boolean;
Var
tmp : String;
Begin
Result := False;
Repeat
tmp := SingleTerm;
If Pos(tmp, NGName) > 0 Then
Begin
Result := True;
Break;
End;
Until tmp = '';
End;
//--[ Function GetShort ]-------------------------------------------------------
Function GetShort(NGName : String) : String;
Var
chkStr : String;
Index : Integer;
Begin
Result := NGName[1];
If WithPoints = False Then
Begin
With NGShortNoDots Do
Begin
For Index := 0 To Count - 1 Do
Begin
chkStr := Names[Index];
If Names[Index] = Copy(UpperCase(NGName), 1, Length(chkStr)) Then
Result := Values[Names[Index]];
End;
End;
End
Else
Begin
With NGShortDots Do
Begin
For Index := 0 TO Count - 1 Do
Begin
chkStr := Names[Index];
IF Names[Index] = Copy(UpperCase(NGName), 1, Length(chkStr)) Then
Result := Values[Names[Index]];
End;
End;
End
End;
//--[ Function CutGenerations ]-------------------------------------------------
Function CutGenerations(NGName : String) : String;
Var
Posi,
KlammerPos : Integer;
Temp,
Temp2,
Temp3,
SName : String;
Begin
// Server
SName := '';
If KlammerPos <= 0 Then KlammerPos := AnsiPos('(', NGName);
If KlammerPos > 0 Then
Begin
If (HideServer = False) Or
(Pos('Inbox', NGName) = 1) Or
(HideOnlyOne = True) And
(Copy(NGName, KlammerPos + 1, Length(ServerName)) <> ServerName) Then
SName := Copy(NGName, KlammerPos, MaxInt);
NGName := Trim(Copy(NGName, 1, KlammerPos - 1));
End;
// Gruppen
If RenameGroups = False Then Temp3 := ''
Else Temp3 := NameConstants(UpperCase(NGName));
If Temp3 = '' Then
Begin
Posi := AnsiPos('.', NGName);
If (Posi > 0 ) And
(ShortenGroupNames = True ) And
(IsGroupExclude(NGName) = False) Then
Begin
Temp2 := Copy(NGName, Posi + 1, MaxInt);
Posi := AnsiPos('.', Temp2);
If (Posi > 0) Or (DotCount < 2) Then
Begin
Temp2 := NGName;
Posi := AnsiPos('.', Temp2);
Repeat
If WithPoints = True Then Temp := Temp + '.' + GetShort(Temp2)
Else Temp := Temp + GetShort(Temp2);
Temp2 := Copy(Temp2, Posi + 1, MaxInt);
Posi := AnsiPos('.', Temp2);
Until Posi <= 0;
If CompleteShort = False Then
Begin
Temp := Temp + '.' + Temp2;
If WithPoints = True Then Temp := Copy(Temp, 2, MaxInt);
End
Else
Begin
If WithPoints = True Then
Temp := Copy(Temp + '.' + GetShort(Temp2), 2, MaxInt)
Else Temp := Temp + GetShort(Temp2);
End
End
Else Temp := NGName;
End
Else Temp := NGName;
End
Else Temp := Temp3;
// Ergebnis
// Servername wird eingefügt, wenn er vorher bereits angezeigt wurde
If SName <> '' Then result := Temp + ' ' + SName
Else result := Temp;
End;
//--[ Function OnNewsgroupListPaint ]-------------------------------------------
Function OnNewsgroupListPaint(
PaintString : WideString;
ColumnIndex : Integer
) : WideString;
Var
ShortString : String;
NewWide : WideString;
Begin
InitArrays;
GExtmp := GroupsExclude;
ShortString := PaintString;
ShortString := CutGenerations(ShortString);
NewWide := ShortString;
Result := NewWide;
NGConstantDots.Free;
NGConstantNoDots.Free;
NGShortDots.Free;
NGShortNoDots.Free;
End;
//------------------------------------------------------------------------------
Begin
End.
Download
 OnNewsgroupListPaint v.3.4.7  |
 |
|
 27.12.2008  2.41 KB  3984 |
||
