OEMToANSI platformunabhängig

Für alles, was in den übrigen Lazarusthemen keinen Platz, aber mit Lazarus zutun hat.
Antworten
shokwave
Beiträge: 438
Registriert: Do 15. Nov 2007, 16:58
OS, Lazarus, FPC: Win10 (L 1.6 FPC 3.0.0)
CPU-Target: i386,x64
Wohnort: Rudolstadt

OEMToANSI platformunabhängig

Beitrag von shokwave »

Hi,

da ich im weltweiten Netz nix dazu gefunden habe (außer die Frage nach der Funktion und ohne befriedigende Antwort), hab ich mich entschlossen selbst was zu basteln.
Bezugnehmend auf diese Seite kam dann das:

Code: Alles auswählen

procedure OEMtoANSI(var Src,Dest:String);
const
  //OEM 850 (DOS - Latin1)
  OEM  = #$80#$81#$82#$83#$84#$85#$86#$87#$88#$89#$8A#$8B#$8C#$8D#$8E#$8F+
         #$90#$91#$92#$93#$94#$95#$96#$97#$98#$99#$9A#$9B#$9C#$9D#$9E#$9F+
         #$A0#$A1#$A2#$A3#$A4#$A5#$A6#$A7#$A8#$A9#$AA#$AB#$AC#$AD#$AE#$AF+
         #$B0#$B1#$B2#$B3#$B4#$B5#$B6#$B7#$B8#$B9#$BB#$BB#$BC#$BD#$BE#$BF+
         #$C0#$C1#$C2#$C3#$C4#$C5#$C6#$C7#$C8#$C9#$CC#$CC#$CC#$CD#$CE#$CF+
         #$D0#$D1#$D2#$D3#$D4#$D5#$D6#$D7#$D8#$D9#$DD#$DB#$DC#$DD#$DE#$DF+
         #$E0#$E1#$E2#$E3#$E4#$E5#$E6#$E7#$E8#$E9#$EA#$EB#$EC#$ED#$EE#$EF+
         #$F0#$F1#$F2#$F2#$F4#$F5#$F6#$F7#$F8#$F9#$FA#$FB#$FC#$FD#$FE#$FF;
 
  //ANSI (Windows 1252 - Latin1)
  ANSI = #$C7#$FC#$E9#$E2#$E4#$E0#$E5#$E7#$EA#$EB#$E8#$EF#$EE#$EC#$C4#$C5+
         #$C9#$E6#$C6#$F4#$F6#$F2#$FB#$F9#$FF#$D6#$DC#$F8#$A3#$D8#$D7#$83+
         #$E1#$ED#$F3#$FA#$F1#$D1#$AA#$BA#$BF#$AE#$AC#$BD#$BC#$A1#$AB#$BB+
         #$00#$00#$00#$00#$00#$C1#$C2#$C0#$A9#$00#$00#$00#$00#$A2#$A5#$00+
         #$00#$00#$00#$00#$00#$00#$E3#$C3#$00#$00#$00#$00#$00#$00#$00#$A4+
         #$F0#$D0#$CA#$CB#$C8#$00#$CD#$CE#$CF#$00#$00#$00#$00#$A6#$CC#$00+
         #$D3#$DF#$D4#$D2#$F5#$D5#$B5#$FE#$DE#$DA#$DB#$D9#$FD#$DD#$AF#$B4+
         #$AD#$B1#$00#$BE#$B6#$A7#$F7#$B8#$B0#$A8#$B7#$B9#$B3#$B2#$00#$0A;
var
  i,j: integer;
  SR: string;
begin
  SR := '';
  for i := 1 to Length(Src) do
  begin
    j := Pos(Src[i], Oem);
    if j > 0 then SR := SR + ANSI[j] else SR := SR + Src[i];
  end;
  Dest := SR;
end;
bei raus.

Vielleicht braucht's ja noch jemand. :)
mfg Ingo

Roland
Beiträge: 3
Registriert: Do 31. Dez 2020, 18:19
OS, Lazarus, FPC: Windows L 2.10 fpc 3.2.0
CPU-Target: 8086

Re: OEMToANSI platformunabhängig

Beitrag von Roland »

Danke!

PascalDragon
Beiträge: 221
Registriert: Mi 3. Jun 2020, 07:18
OS, Lazarus, FPC: L 2.0.8, FPC Trunk, OS Win/Linux
CPU-Target: Aarch64 bis Z80 ;)
Wohnort: München

Re: OEMToANSI platformunabhängig

Beitrag von PascalDragon »

Alternativ kann man auch einfach die CodePage Funktionalität von FPC nutzen (diese funktioniert letztlich mit beliebigen CodePages solange die Unicode Mappings vorhanden sind):

Code: Alles auswählen

program toem;

{$mode objfpc}{$H+}

{$ifdef unix}
uses
  // unter Unix benötigen wir einen WideString Manager (Alternative: cwstrings)
  fpwidestring,
  // die Unicode Mappings für CodePage 850 (nicht nötig für cwstrings)
  cp850;
{$endif}

type
  // passende Stringtypen für beide Codepages anlegen
  TCP850String = type String(850);
  TCP1252String = type String(1252);

var
  src: TCP850String;
  dst: TCP1252String;
  c: Char;
begin
  // wir initialisieren den Quellstring mal manuell mit ® und ©
  // um Problemen mit dem Encoding der Datei aus dem Weg zu gehen
  SetLength(src, 2);
  src[1] := #$a9;
  src[2] := #$b8;

  // jetzt einfach eine Zuweisung, der WideString Manager übernimmt den Rest
  dst := src;

  // und siehe da, wir haben AE und A9 als Ausgabe ;)
  for c in dst do
    Write(HexStr(Ord(c), 2), ' ');
  Writeln;
end.
Vorteil: flexibler, da das Zielencoding auch ein ganz anderes als 1252 sein kein (zum Beispiel UTF8)

Nachteil: größere Binary, eventuell langsamer

Edit: gerade gesehen, dass der originale Post von 2009 war. Gut, damals gab es den CodePage beachtenden Stringtyp noch nicht...
FPC Compiler Entwickler

Antworten