Windows Codepages - Kernel32.dll - EnumSystemCodePages

[arcticwolf]

Hallo,

ich verwende folgenden Code um die Codepages aufzulisten, die Windows installiert hat.

Delphi-Quellcode:

Var CodePageNumbers : TArray<Cardinal>;

procedure GetCodepageList(Var CodePageList:TStringList);

  function GetCPName(CP:Cardinal) : String;
  var CpInfoEx : TCPInfoEx;
  begin
    Result := '';
    if IsValidCodePage(Cp) then
    begin
      GetCPInfoEx(Cp, 0, CpInfoEx);
      Result := Format('%s', [CpInfoEx.CodePageName]);
      Result := ReplaceStr(Result,CP.ToString+' ','').TrimLeft;
      Result := Copy(Result,2,length(Result)-2);
    end;
  end;

  function EnumCodePagesProc(CodePage:PWideChar) : Cardinal; stdcall;
  Var Cp : cardinal;
  begin
    Result := 0;
    if (CodePage<>Nil) then
    begin
      if (Length(Codepage)>0) then
      begin
        Cp := StrToIntDef(CodePage,0);
        if (cp>0) then
        begin
          SetLength(CodePageNumbers,Length(CodePageNumbers)+1);
          CodePageNumbers[High(CodePageNumbers)] := CP;
          Result := 1;
        end;
      end;
    end;
  end;

var I : Integer;
begin
  SetLength(CodePageNumbers,0);
  CodePageList.Clear;
  EnumSystemCodePagesW(@EnumCodePagesProc, CP_SUPPORTED);
  for I := 0 to High(CodePageNumbers) do
  begin
    if CodePageNumbers[i]>0 then
    begin
      CodepageList.Add(IntToString(CodePageNumbers[i],5) + ': '
        + GetCPName(CodePageNumbers[i]));
    end;
  end;
  SetLength(CodePageNumbers,0);
end;

Das funktioniert und Win32 problemlos, wenn ich jedoch auf Zielplattform Win64 umstelle kommt in der EnumCodePagesProc nichts mehr an. Ein Microsoft Bug, oder stelle ich mich nur zu blöd an? Oder gibt es dafür eine elegantere Lösung, ohne EnumSystemCodePages / EnumSystemCodePagesA / EnumSystemCodePagesW?

[himitsu]

Zitat:

Delphi-Quellcode:

function EnumCodePagesProc(CodePage:PWideChar) : Cardinal; stdcall;

Das darf keine SubMethode sein.
Auch schon in Win32 war das schon immer so falsch. (es ist Zufall, dass es hier grade so geht ... weil der Optimimierer mal gute eine Arbeit machte und du darin nicht auf Self oder CodePageList zugegriffen hattest,
bzw. eigentlich sollte jemand für die globale Variable paar auf die Finger bekommen, aber hier ist es einer der Gründe, warum es zufällig ging)

Sie muß eine "alleinstehene" Function sein, oder eine "static" Class-Function.



stdcall; ist unter Win64 egal (es gibt nur noch eine einzige Aufrufkonvention),
aber als Kompatibilität zu Win32 schadet es nicht das dran zu lassen. (wird einfach vom Compiler ignoriert)

[arcticwolf]

Danke himitsu!

Zitat:

Sie muß eine "alleinstehene" Function sein

Da hätte ich auch selber drauf kommen können.

Das mit der globalen Variable ist mir auch ein Dorn im Auge, aber ich wusste nicht wie ich das anders lösen kann. Kannst Du mir das Konzept mit der

Zitat:

"static" Class-Function

bitte erläutern? Wie genau muss ich so eine Klasse deklarieren? Ich habe mal soetwas versucht, aber nicht zum laufen bekommen.

Delphi-Quellcode:

Type TWindowsCodepages = class
     strict private
       class var IList : TArray<String>;
       class function GetCodepageName(Codepage:Cardinal) : String;
       class function EnumCodePagesProc(CodePage:PWideChar) : Boolean; static;
     strict protected
       class function GetEntry(Index:integer) : String; static;
       class procedure SetEntry(Index:Integer; uString:String); static;
       class function GetCount : Integer; static;
     public
       class property List[Index:Integer]:String Read GetEntry Write SetEntry;
       class property Count:Integer Read GetCount;
       class function Get_Supported : TArray<String>;
     end;

[peterbelow]

Wenn man eine Klassenmethode als "class procedure" oder "class function" deklariert hat die Methode einen verborgenen Parameter (self), der im Unterschied zu einer non-class Methode aber die Referenz auf die Klasse selbst enthält und nicht die auf eine Instanz (Objekt) der Klasse.

Definiert man eine Methode dagegen als "static class function" bzw. "static class procedure" hat sie diesen verborgenen Parameter nicht, ihre Signatur ist dann identisch mit einer außerhalb der Klasse deklarierten function oder procedure mit der gleichen Parameterliste und calling convention. Deshalb kann man sie als API callback verwenden.

Der Nachteil: man kann aus einer static class Method nur auf ebenfalls als static deklarierten Elemente der Klasse zugreifen, da der Compiler das beim kompilieren auflösen kann. Innerhalb der Methode gibt es ja keine Referenz auf die Klasse...

[himitsu]

Zitat:

Delphi-Quellcode:

class function GetEntry(Index:integer) : String; static;

jupp, genau so ... dieses "static".

Eine Funktion oder Class-Function in einer Klasse oder Record besitzen einen impliziten/unsichtbaren Parameter "Self". (der steht immer als Erstes in der Parameterliste)
Eine statische Class-Function besitzt dieses Self nicht.
Auch diese eingebetteten Methoden besitzen "normalerweise" so eine versteckte Variable (hier der StackPointer auf den Speicherberech der übergeordneten Funktion, mit dessen Self, dessen Parametern und den lokalen Variablen ... nur von Denen vor der eingebetteten Methode)

Funktion : Self = der Instanzzeiger
Class-Function: Self = der "aktuelle" Klassentyp -> von der Instanz aus der Variable (Variable.MyFunction) oder der benutzte Klassenname (TMyClass.MyFunction)
static Class-Function: besitzen kein Self und gehen immer "hart" auf den Typ der zugehörigen Klasse

Drum muß man auch aufpassen, ob man Class-Functions über eine Variable oder über den Typ aufruft.
Denn mit NIL oder schlimmer einem ungültigen Instanzzeiger, würde versucht daraus den "aktuellen" ClassTyp für das "Self" auszulesen, was dann wunderschön knallt.

PS:
Class-Funktions in Records müssen leider immer static sein (k.A. warum der Compiler das nicht implizit macht, selbst wenn man es nicht explizit angibt :wall:)
MethodenZeigern (z.B. TNotifyEvent) kann man sowohl normale Methoden zuweisen, als auch KlassenMethoden.

[arcticwolf]

Vielen Dank für die Erklärungen. Ich denke ich habe das Prinzip von statischen Klassen beziehungsweise von statischen Funktionen einer Klasse verstanden.
Hier eine verkürzte Version meines Codes:

Delphi-Quellcode:

Type TWindowsCodepages = class
     private
       class var FList : TStrings;
     protected
       class function GetCodepageName(Codepage:Cardinal) : String; static;
       class function EnumCodePagesProc(CodePage:PWideChar) : Boolean; static; stdcall;
       class function GetList : String; static;
       class procedure SetList(Const Value:String); static;
     public
       class constructor CreateClass;
       class destructor DestroyClass;
       class property List:String Read GetList Write SetList;
       class function RetrieveSupported : Boolean; static;
     end;

class function TWindowsCodepages.GetCodepageName(Codepage:Cardinal) : String;
var CpInfoEx : TCPInfoEx;
begin
  Result := '';
  if IsValidCodePage(Codepage) then
  begin
    GetCPInfoEx(Codepage, 0, CpInfoEx);
    Result := Format('%s', [CpInfoEx.CodePageName]);
  end;
end;

class function TWindowsCodepages.EnumCodePagesProc(CodePage:PWideChar) : Boolean;
Var CP : cardinal;
begin
  Result := False;
  if (CodePage<>Nil) then
  begin
    if (Length(Codepage)>0) then
    begin
      CP := StrToIntDef(CodePage,0);
      if (CP>0) then
      begin
        FList.Text := FList.Text + GetCodepageName(CP);
        Result := True;
      end;
    end;
  end;
end;

class function TWindowsCodepages.GetList : String;
begin
  Result := FList.Text;
end;

class procedure TWindowsCodepages.SetList(Const Value:String);
begin
  FList.Text := Value;
end;

class constructor TWindowsCodepages.CreateClass;
begin
  FList := TStringList.Create;
  FList.Delimiter := ';';
end;

class destructor TWindowsCodepages.DestroyClass;
begin
  FList.Free;
end;

class function TWindowsCodepages.RetrieveSupported : Boolean;
begin
  Result := EnumSystemCodePagesW(@EnumCodePagesProc,CP_SUPPORTED);
end;

Procedure DoSomething;
begin
  TWindowsCodepages.RetrieveSupported;
  Writeln(TWindowsCodepage.List);
end;

Da ich die Unit mit dem Code sowohl unter Win32, als auch unter Win64 nutzen möchte, ist noch wichtig zu erwähnen, dass dann auch bei der Callback-Funktion (EnumCodePagesProc) das "stdcall" dahinter stehen muss, sonst knallt es bei der Win32-Version.

Trotzdem stellt sich mir die Frage, wo der Vorteil ist? Die statische Klasse erstellt auch eine "globale" Variable, ja OK, nicht wirklich global, weil ich nur über die Klasse darauf zugreifen kann. Aber sie wird beim Start des Programmes über CreateClass erzeugt und erst beim Beenden des Programmes über DestroyClass wieder freigegeben und belegt somit für die komplette Laufzeit Speicher. Auch dann wenn die Klasse nur in irgendeinem Modul benötigt wird, das vielleicht gar nicht vom User verwendet wird. Gibt es da nicht eine elegantere Lösung für API Callback-Funktionen, die nur dann Speicher belegen wenn sie aufgerufen werden, also ohne globale Variable?

[Uwe Raabe]

Zitat:

Zitat von arcticwolf (Beitrag 1523667)

Trotzdem stellt sich mir die Frage, wo der Vorteil ist? Die statische Klasse erstellt auch eine "globale" Variable, ja OK, nicht wirklich global, weil ich nur über die Klasse darauf zugreifen kann. Aber sie wird beim Start des Programmes über CreateClass erzeugt und erst beim Beenden des Programmes über DestroyClass wieder freigegeben und belegt somit für die komplette Laufzeit Speicher. Auch dann wenn die Klasse nur in irgendeinem Modul benötigt wird, das vielleicht gar nicht vom User verwendet wird. Gibt es da nicht eine elegantere Lösung für API Callback-Funktionen, die nur dann Speicher belegen wenn sie aufgerufen werden, also ohne globale Variable?

Also, es wird ja lediglich der Speicher für ein dynamisches Array - also ein Pointer - verwendet. Das sind in 64-Bit gerade mal 8 Byte. Ich glaube kaum, dass das ins Gewicht fällt.

Hier ein alternativer Ansatz, der auch mehrere Threads berücksichtig. Basiert noch auf deinem ursprünglichen Code für die Formatierung. (Vermutlich nicht relevant, aber der Form halber: StrToUIntDef)

Delphi-Quellcode:

type
  TCodePageEnumerator = class
  strict private
  class threadvar
    CodePageNumbers: TList<Cardinal>;
    class function EnumCodePagesProc(CodePage: PWideChar): Cardinal; static; stdcall;
  strict protected
    class function FormatCodePageName(AValue: Cardinal; const AName: string): string; virtual;
    class function GetCodePageName(CP:Cardinal): String;
  public
    class procedure GetCodepageList(CodePageList: TStrings);
  end;

class procedure TCodePageEnumerator.GetCodepageList(CodePageList: TStrings);
begin
  CodePageNumbers := TList<Cardinal>.Create;
  try
    CodePageList.Clear;
    EnumSystemCodePages(@EnumCodePagesProc, CP_SUPPORTED);
    for var codePageNumber in CodePageNumbers do
    begin
      if codePageNumber > 0 then
        CodepageList.Add(Format('%.5d: %s', [codePageNumber, GetCodePageName(codePageNumber)]));
    end;
  finally
    CodePageNumbers.Free;
    CodePageNumbers := nil;
  end;
end;

class function TCodePageEnumerator.EnumCodePagesProc(CodePage: PWideChar): Cardinal;
Var
  Cp: Cardinal;
begin
  Result := 0;
  if CodePageNumbers = nil then Exit;
  if (CodePage <> Nil) then
  begin
    if (Length(CodePage) > 0) then
    begin
      Cp := StrToUIntDef(CodePage, 0);
      if (Cp > 0) then
      begin
        CodePageNumbers.Add(Cp);
        Result := 1;
      end;
    end;
  end;
end;

class function TCodePageEnumerator.FormatCodePageName(AValue: Cardinal; const AName: string): string;
begin
  Result := AName.Remove(0, AValue.ToString.Length + 1).TrimLeft.Trim(['(', ')']);
end;

class function TCodePageEnumerator.GetCodePageName(CP:Cardinal): String;
var CpInfoEx : TCPInfoEx;
begin
  Result := '';
  if IsValidCodePage(Cp) then
  begin
    GetCPInfoEx(Cp, 0, CpInfoEx);
    Result := FormatCodePageName(CP, CpInfoEx.CodePageName);
  end;
end;

[TiGü]

Sollte die EnumCodePagesProc nicht ein BOOL als Rückgabewert haben?
https://learn.microsoft.com/en-us/pr...317809(v=vs.85)

[Uwe Raabe]

Deklariert ist sie als TFarProc = Pointer. Solange der Rückgabewert binär dem erwarteten True oder False entspricht, sollte das kein Problem sein. Aber formal hast du recht.

[himitsu]

Njaaaaaaaaaa, ...

Boolean und auch ByteBool sind Beide bloß je 1 Byte groß (das Eine mit $01 und das Andere mit -1 aka $FF standardmäßig als "True"),
aber wenn EnumSystemCodePages das aber als BOOL aka LongBool auswertet, dann könnte es passieren, dass es eine Fehlerkennung gibt.

Wenn die Rückgabe wirklich nur das erste Byte (AL) und nicht das komplette Register (EAX) auf 0 setzt.
z.B. in den höheren Bytes steht irgendwas mit <> 0, es wird nur das erste Byte auf False (0) gesetzt, dann bliebe es insgesamt dennoch auf True (<>0) :shock:





PS: Da hier die ganze Klasse "statisch" ist und es praktisch nie eine Instanz gibt,
könnte man sich überlegen, eine Warnung vom Compiler zu benutzen, falls doch irgendwo im Code versucht wird eine Instanz zu erstellen.
"class static" oder Sowas gibt es nicht, aber "class abstract" sollte auch helfen. (WOBEI es das grade irgendwie nicht macht :gruebel:)

* class abstract = diese Klasse muß erst abgeleitet werden, bevor man davon eine Instanz erstellen darf
* class sealed = ich bin der Letzte ... von mir das niemand mehr ableiten
https://docwiki.embarcadero.com/RADS...jekte_(Delphi)

Wie wenn man ausversehn versucht ein TStream.Create oder TStrings.Create zu machen, anstatt z.B. TFileSteam oder TStringList,
wo der Compiler dir eine Abstract-Warnun um die Ohren haut.

Delphi-Quellcode:

type
  TTest = class abstract
  private
    class var Abc: Integer;
  public
    class procedure Test; {mit oder ohne static}
  end;

procedure TForm25.FormCreate(Sender: TObject);
begin
  TTest.Test;  // geht
  {var X :=} TTest.Create;  // hier sollte der Compiler eigentlich meckern (dachte ich)
end;

Für reine "statischen" Klassen verwende ich inzwischen auch stattdessen gern Records.

Delphi-Quellcode:

type
  TTest = record
  private {PS: protected und published gibt es hier nicht}
    class var FAbc: Integer;
  public
    class procedure Test; static;
  end;

Und die "class var" mache ich bei mir als eigenständigen "Block" (finde es für mich so übersichtlicher)

Delphi-Quellcode:

  TTest = record {aber auch bei class}
  private class var 
    FAbc: Integer;
  private {"private var" wäre hier auch bmöglich}
    FDef: Integer;
  public
    class procedure Test; static;
  end;