AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

abwärtskompatibler unit zugriff

Ein Thema von KodeZwerg · begonnen am 15. Jan 2022 · letzter Beitrag vom 17. Jan 2022
 
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: abwärtskompatibler unit zugriff

  Alt 16. Jan 2022, 17:55
Ich habe gefunden was ich benötige indem ich in der RTTI.pas gesucht habe und dies dabei rausgekommen ist.
Auch habe ich beim Testen festgestellt (wie dummzeuch schrieb) das intern anscheinend immer der volle Name genutzt wird.

Vielleicht kann es ja jemand woanders gebrauchen. (es wird keine unit im uses benötigt für diese routine)

Delphi-Quellcode:
programm Test;

uses
  System.SysUtils; // nur eingebunden für das Beispiel,
                   // die methode UnitExists() benötigt nichts.

function UnitExists(const UnitName: String): Boolean;
  function LowerCase(const S: string): string;
  var
    I, Len: Integer;
    DstP, SrcP: PChar;
    Ch: Char;
  begin
    Len := Length(S);
    SetLength(Result, Len);
    if Len > 0 then
    begin
      DstP := PChar(Pointer(Result));
      SrcP := PChar(Pointer(S));
      for I := Len downto 1 do
        begin
          Ch := SrcP^;
          case Ch of
            'A'..'Z': Ch := Char(Word(Ch) or $0020);
          end;
          DstP^ := Ch;
          Inc(DstP);
          Inc(SrcP);
        end;
    end;
  end;

  procedure PeekData(var P: PByte; var Data; Len: Integer);
  begin
    Move(P^, Data, Len);
  end;

  procedure ReadData(var P: PByte; var Data; Len: Integer);
  begin
    PeekData(P, Data, Len);
    Inc(P, Len);
 end;

  function ReadU8(var P: PByte): Byte;
  begin
    ReadData(P, Result, SizeOf(Result));
  end;

  function _UTF8ToString(P: pointer): string;
  var
    Len: Byte;
    Buf: Array of Byte;
  begin
    Result := '';
    Len := PByte(P)^;
    if Len <> 0 then
      begin
        SetLength(Buf, Len+1);
        Move(PByte(P)^, Buf[0], Len+1);
        Result := UTF8ToString(Buf);
      end;
  end;

  function ReadShortString(var P: PByte): string;
  var
    len: Integer;
  begin
    Result := _UTF8ToString(P);
    len := ReadU8(P);
    Inc(P, len);
  end;

  function IsLoaded(const UnitName: String): Boolean;
  var
    p: PByte;
    i: Integer;
    s: String;
  begin
    Result := False;
    if (UnitName = '') then
      Exit;
    s := LowerCase(UnitName);
    p := Pointer(System.LibModuleList.TypeInfo.UnitNames);
    for i := 0 to System.LibModuleList.TypeInfo.UnitCount - 1 do
      if (s = LowerCase(ReadShortString(p))) then
        begin
          Result := True;
          Break;
        end;
  end;

begin // UnitExists()
  Result := IsLoaded(UnitName);
end; // UnitExists()


// und so überlade ich es nun
// damit bekomme ich keinen "Kann Name nicht auflösen" Fehler obwohl nun beides als ausführbarer Kode enthalten ist.
procedure Sleep(const MSec: DWORD);
begin
  if UnitExists('System.SysUtils') then
    System.SysUtils.Sleep(MSec)
    else
    SysUtils.Sleep(MSec);
end;

begin
  Sleep(150);
end.
Gruß vom KodeZwerg

Geändert von KodeZwerg (16. Jan 2022 um 22:29 Uhr) Grund: Beispiel hinzugefügt.und mehrmals verbessert :-)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:18 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz