unit uPPMLang;
interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, {ImgList,} StdCtrls, ExtCtrls, ComCtrls, ToolWin, HexUtils;

type
    TOpenPPMDialog = class(TOpenDialog)
    private
       FMemo          : TMemo;
       FPPMPanel      : TPanel;
       FPPMLabel      : TLabel;
       FOpenFilename  : string;
       FPPMLanguage   : TStringList;
    protected
       procedure   DoClose; override;
       procedure   DoSelectionChange; override;
       procedure   DoShow; override;
    published
    public
    constructor    Create(AOwner: TComponent); override;
    function       Execute: Boolean; override;
    property       LanguageList: TStringList read FPPMLanguage;
end;

var
    OpenPPMDialog : TOpenPPMDialog;

procedure          GetPPMLanguage(FullName:string;var LangList:TStringList;var Result:Boolean);

implementation

procedure GetPPMLanguage(FullName:string;var LangList:TStringList;var Result:Boolean);
var
     HdrLen,
     Data,
     LangID,
     SectLen,
     CurrBlockLen        : Dword;
     TokenHdrLen         : Byte;
     PPMInfoFound,
     SectionDone,b       : Boolean;
     i                   : Integer;
     Lang                : String;
     fs                  : TFileStream;
     ms                  : TMemoryStream;
     buf                 : array[0..$3FFFF] of byte;
begin
     fs:=TFileStream.Create(FullName, fmOpenRead);
     fs.ReadBuffer(buf[0], 1);//Идентификатор BB5
     if buf[0]<>$B2 then
     begin
     fs.Free;
     Exit;
     end;
     fs.ReadBuffer(buf[0], 4);//Длина Flash-header'a
     HdrLen:= HexToInt(IntToHex(buf[0], 2)+IntToHex(buf[1], 2)+IntToHex(buf[2], 2)+IntToHex(buf[3], 2));

     fs.Seek(HdrLen, sofromcurrent);
     i:=0; PPMInfoFound:=false;SectionDone:=true;
     ms:=TMemoryStream.Create;

     while (fs.Position<fs.Size) and SectionDone do
     begin
          fs.ReadBuffer(buf[0], 1);
          if buf[0]<>$54 then //Header of Flash-token
          begin
               fs.free;
               ms.free;
               exit;
          end;

          fs.ReadBuffer(buf[0], $3);//Read Token SubType & Header Len
          TokenHdrLen:=buf[2];
          fs.ReadBuffer(buf[0], TokenHdrLen);

          CurrBlockLen := HexToInt(IntToHex(buf[TokenHdrLen-8], 2)+
                                   IntToHex(buf[TokenHdrLen-7], 2)+
                                   IntToHex(buf[TokenHdrLen-6], 2)+
                                   IntToHex(buf[TokenHdrLen-5], 2));

          fs.ReadBuffer(buf[0], $1);//CRC of Header Token

          if Not PPMInfoFound then
          begin
               fs.ReadBuffer(Data, 4);
               dec(CurrBlockLen,4);
               if Data<>$50504D00 then //Начало PPM - сигнатура _PPM
               begin
                    fs.Free;
                    ms.Free;
                    exit;
               end;
               fs.ReadBuffer(buf[0], CurrBlockLen);
               fs.Seek(fs.Position-CurrBlockLen, sofrombeginning);
               i:=0; b:=true;
               while (i<(CurrBlockLen-4)) and b do
               begin
                    Data:= HexToInt(IntToHex(buf[i]  , 2)+
                                    IntToHex(buf[i+1], 2)+
                                    IntToHex(buf[i+2], 2)+
                                    IntToHex(buf[i+3], 2));

                    if (Data=$54584554) or (Data=$5445854) then
                    begin
                         b:=false;
                         PPMInfoFound:=true;
                         dec(CurrBlockLen,i-8);//Расчет длины текущего блока (выше уже часть была прочитана)
                         fs.Seek(i-4, sofromcurrent);//Переход к значениям длины секции TEXT
                         fs.ReadBuffer(SectLen, 4);//Чтение длины секции
                         fs.Seek(fs.Position-8, sofrombeginning);//Переход к началу секции
                         continue;
                    end;
                    inc(i);
               end;
               if b then
               begin
                    fs.Free;
                    ms.Free;
                    exit;
               end;

          end;//end of found TEXT section

          if (ms.Size+CurrBlockLen)>SectLen then
          begin
               CurrBlockLen:=SectLen-ms.Size;
               SectionDone:=false;
          end;
          ms.CopyFrom(fs, CurrBlockLen);
     end;//end while
     fs.free;
     //ms.SaveToFile(ExtractFileDir(FullName)+'\TEXT_'+ExtractFileName(FullName));

     ms.Seek(0, sofrombeginning);

     //Поиск присутствующих языковых пакетов
     ms.ReadBuffer(Data, 4);//CRC секции
     ms.ReadBuffer(Data, 4);//Длина секции
     ms.ReadBuffer(Data, 4);//Имя секции
     ms.ReadBuffer(Data, 4);//Версия языкового пакета 1 часть
     ms.ReadBuffer(Data, 4);//Версия языкового пакета 2 часть

     b:=true;
     while (ms.Position<ms.Size) and b do
     begin
          ms.ReadBuffer(LangID, 4);//заголовок подсекции
          ms.ReadBuffer(SectLen, 4);//длина подсекции
          if (Data<>0) and (SectLen<>$10) then //Если длина подсекции = 10, то это завершающая
                                               //(конечная) подсекция в текущей текстовой секции
          begin
               ms.ReadBuffer(Data, 4);//имя подсекции
               if Data<>$4D4D4F43 then //Если это не подсекция COMM (содержит только)
               begin
                    case LangID of
                         $00000001: Lang:='English';            //EN00, EN04, EN06        Original: English
                         $00000002: Lang:='Deutsch';            //DE00, DE04, DE06        Original: Deutsch
                         $00000003: Lang:='French';             //FR00, FR04, FR06        Original: Franзais
                         $00000004: Lang:='Italiano';           //IT00, IT04              Original: Italiano
                         $00000005: Lang:='Spanish';            //ES00, ES04, ES06        Original: Espaсol
                         $00000006: Lang:='Portuguese';         //PT00, PT06              Original: Portuguкs
                         $00000007: Lang:='Dutch';              //NL00, NL04, NL06        Original: Nederlands
                         $00000008: Lang:='Danish';             //DA00                    Original: Dansk
                         $00000009: Lang:='Swedish';            //SV00                    Original: Svenska
                         $0000000A: Lang:='Finland';            //FI00                    Original: Suomi
                         $0000000B: Lang:='Greek';              //EL00                    Original: ????????
                         $0000000C: Lang:='Hungarian';          //HU00                    Original: Magyar
                         $0000000D: Lang:='Turkish';            //TR00                    Original: Tьrkзe
                         $0000000E: Lang:='Norwegian';          //NO00                    Original: Norsk
                         $0000000F: Lang:='Russian';            //RU00                    Original: ???????
                         $00000010: Lang:='Arabic';             //AR00                    Original: ???????
                         $00000011: Lang:='Bahasa Indonesia';   //IN00                    Original: Indonesia
                         $00000012: Lang:='Malaysian';          //FS00;                   Original: Malaysian
                         $00000013: Lang:='Bulgarian';          //BG00                    Original: ?????????
                         $00000014: Lang:='Hrvatski';           //HR00'                   Original: Hrvatski
                         $00000015: Lang:='Czech';              //CS00                    Original: Ceљtina
                         $00000016: Lang:='Simplified Chinese'; //ZH00                    Original: ????
                         $00000017: Lang:='Traditional Chinese';//ZH10, ZH20              Original: ????
                         $00000018: Lang:='Estonian';           //ET00                    Original: Eesti
                         $00000019: Lang:='Hebrew';             //HE00                    Original: ?????
                         $0000001A: Lang:='Latvian';            //LV00                    Original: Latvieљu
                         $0000001B: Lang:='Lithuanian';         //LT00                    Original: Lietuviu
                         $0000001C: Lang:='Polish';             //PL00                    Original: Polski
                         $0000001D: Lang:='Romanian';           //RO00                    Original: Romвna
                         $0000001E: Lang:='Serbian';            //SR00                    Original: Srpski
                         $0000001F: Lang:='Slovak';             //SK00                    Original: Slovencina
                         $00000020: Lang:='Slovenian';          //SL00, SL06              Original: Slovenљcina
                         $00000021: Lang:='Thai';               //TH00                    Original: ???????
                         $00000022: Lang:='Vietnamese';         //VI00                    Original: Tiкґng Viк?t
                         $00000023: Lang:='English';            //EN10                    Original: English
                         $00000024: Lang:='Spanish';            //ES10                    Original: Espaсol
                         $00000025: Lang:='Portuguese';         //PT10                    Original: Portuguкs
                         $00000026: Lang:='French';             //FR10                    Original: Franзais
                         $00000028: Lang:='Persian';            //FA00                    Original: ?????
                         $00000029: Lang:='Ukrainian';          //UK00                    Original: ??????????
                         $0000002A: Lang:='Icelandic';          //IS00                    Original: Нslenska
                         $0000002B: Lang:='Hindi';              //HI00                    Original: ??????
                         $0000002C: Lang:='Pilipino';           //TL00 (Tagalog)          Original:  Pilipino
                         $0000002D: Lang:='African';            //AF00                    Original: Afrikaans
                         $0000002E: Lang:='Sesotho';            //ST00                    Original: Sesotho
                         $0000002F: Lang:='Swahili';            //SW00                    Original: Kiswahili
                         $00000030: Lang:='Xhosa';              //XH00                    Original: Xhosa   ???
                         $00000031: Lang:='IsiZulu';            //ZU00                    Original: IsiZulu ???
                         $00000032: Lang:='Urdu';               //UR00                    Original: ????
                         $00000034: Lang:='Macedonian';         //MK00                    Original: ???????.
                         $00000035: Lang:='Bengali';            //BN00                    Original: ?????
                         $00000036: Lang:='Gujarati';           //GU00                    Original: ?????
                         $00000037: Lang:='Kannada';            //KN00                    Original: ?????
                         $00000038: Lang:='Malayalam';          //ML00                    Original: ??????
                         $00000039: Lang:='Marathi';            //MR00                    Original: ?????
                         $0000003A: Lang:='Punjabi';            //PA00                    Original: ??????
                         $0000003B: Lang:='Sinhalese';          //SI00                    Original: ?????
                         $0000003C: Lang:='Tamil';              //TA00                    Original: ?????
                         $0000003D: Lang:='Telugu';             //TE00                    Original: ??????
                         $0000003E: Lang:='Hausa';              //HA00                    Original: Hausa
                         $0000003F: Lang:='Yoruba';             //YO00                    Original: Yorщbб
                         $00000040: Lang:='Kazakh';             //KK00                    Original: ???????
                         $00000041: Lang:='Uzbek';              //UZ00                    Original: ?????
                         $00000042: Lang:='Azerbaijani';        //AZ00                    Original: Az?rb. dili
                         $00000043: Lang:='Catala';             //CA00                    Original: Catalа
                         $00000044: Lang:='Euskara';            //EU0                     Original: Euskara
                         $00000045: Lang:='Euskara';            //EU00                    Original: Euskara
                         $00000046: Lang:='Cambodian';          //KM00                    Original: ?????
                         $00000047: Lang:='Albanian';           //SQ00                    Original: Shqip
                         $00000048: Lang:='Amharic';            //AM00                    Original: ???? Амхарский
                         $00000049: Lang:='Galego';             //GL00                    Original: Galego  ???
                         $0000004B: Lang:='Bangladesh';         //BN10                    Original:
                         $0000004C: Lang:='Georgian';           //KA00                    Original: ??????? Грузинский
                         $0000004D: Lang:='Mongolian';          //MN00                    Original: ??????
                         $0000004E: Lang:='Armenian';           //HY00                    Original: ??????? Армянский
                         $00000050: Lang:='Turkmen';            //TK01                    Original: Tьrkmen
                         $00000051: Lang:='Uzbek';              //TG00                    Original: ??????
                         $00000052: Lang:='Kyrgyzstan';         //KY00                    Original: ??????
                         $00000054: Lang:='Oriya';              //OR00                    Original: ????
                         $00000055: Lang:='Assamese';           //AS00                    Original: ??????
                         $00000056: Lang:='Kashmiri';           //KS00                    Original: ????
                         $00000058: Lang:='Bosanski';           //BS00                    Original: Bosanski
                         $00000059: Lang:='Lingala';            //LN00                    Original: Lingala
                         $0000005A: Lang:='Belarussian';        //BE00                    Original: ????????.

                         // Список языкых пакетов, которые когда-либо мне попадались, но я их
                         // не смог повторно найти в имеющейся коллекции PPM-файлов
                         //$00000027: Lang:='Unknow';             //Unknow                    Original: Unknow
                         //$00000033: Lang:='Unknow';             //Unknow                    Original: Unknow
                         //$0000004A: Lang:='Unknow';             //Unknow                    Original: Unknow
                         //$0000004F: Lang:='Unknow';             //Unknow                    Original: Unknow
                         //$00000053: Lang:='Unknow';             //Unknow                    Original: Unknow
                         //$00000057: Lang:='Unknow';             //Unknow                    Original: Unknow

                         else //Lang:='Unknow'+' ID: '+BufToHexStr(@LangID, 4)+' '+Hex2Chr(BufToHexStr(@Data, 4));
                                Lang:='Unknow'+' ID: ('+BufToHexStr(@LangID, 4)+')';
                         end;
                         Result:=true;
                         LangList.Add(Lang);
               end;//End of Case
               //реальный размер подсекции может быть больше, т.к. он всегда
               //кратен 4 (при необходимости размер увеличивается)
               while SectLen mod 4<>0 do inc(SectLen);
               ms.Seek(SectLen-$0C, sofromcurrent);
          end
          else b:=false;
     end;//end while
end;

{ TOpenPPMDialog }
constructor TOpenPPMDialog.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
     //FPPMLanguage:= TStringList.Create;
     FPPMPanel := TPanel.Create(Self);
     with FPPMPanel do
     begin
          Name := 'PPMPanel';
          Caption := '';
          SetBounds(204, 5, 169, 200);
          Align       := alTop;
          BevelOuter  := bvNone;
          BorderWidth := 6;
          TabOrder    := 1;
          FPPMLabel   := TLabel.Create(Self);
          with FPPMLabel do
          begin
               Name := 'PPMLabel';
               Caption := '';
               SetBounds(6, 6, 157, 23);
               Align := alTop;
               Visible:=True;
               AutoSize := False;
               Parent := FPPMPanel;

               FMemo := TMemo.Create(Self);
               with FMemo do
               begin
                    Name := 'PPMMemo';
                    Caption := '';
                    SetBounds(6, 0, 157, 145);
                    Align      := alClient;
                    BevelInner := bvRaised;
                    BevelOuter := bvLowered;
                    FMemo.ScrollBars:=ssNone;
                    Visible:=True;
                    Font.Size  := 11;
                    Font.Style := [fsBold];
                    TabOrder   := 0;
                    Parent     := FPPMPanel;
               end;
          end;
     end;
end;

procedure TOpenPPMDialog.DoSelectionChange;
var
     FullName            : string;
     Res,
     ValidPPM            : Boolean;
     i                   : Integer;
     LangList            : TStringList;

function ValidFile(const FileName: string): Boolean;
var
     bt : byte;
     fs : TFileStream;
begin
     Result := false;
     try
            fs:=TFileStream.Create(FileName, fmOpenRead);
            fs.Read(bt ,1);
            if bt=$B2 then Result := true;
            fs.Free;
      except
            Result := false;
      end;
end;

begin
     FMemo.Lines.Clear;
     //FPPMLanguage.Clear;
     FPPMLanguage:= TStringList.Create;
     ValidPPM := FileExists(FileName) and ValidFile(FileName);
     if ValidPPM then
     try
           GetPPMLanguage(FileName, FPPMLanguage, Res);
           i:=0;
           if Res then
           while i<FPPMLanguage.Count do
           begin
                FMemo.Lines.Add(FPPMLanguage.Strings[i]);
                inc(i);
           end;
           if FPPMLanguage.Count>14 then FMemo.ScrollBars:=ssVertical else
                                         FMemo.ScrollBars:=ssNone;
     except
           ValidPPM := False;
     end;
     if not ValidPPM then FMemo.Lines.Clear;
     inherited DoSelectionChange;
end;

procedure TOpenPPMDialog.DoClose;
begin
     inherited DoClose;
     { Hide any hint windows left behind }
     Application.HideHint;
end;

procedure TOpenPPMDialog.DoShow;
var
     PreviewRect, StaticRect: TRect;
begin
     { Set preview area to entire dialog }
     GetClientRect(Handle, PreviewRect);
     StaticRect := GetStaticRect;
     { Move preview area to right of static area }
     PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
     Dec(PreviewRect.Bottom, 85);
     Inc(PreviewRect.Top, 5);
     FOpenFilename :='';
     FPPMPanel.BoundsRect := PreviewRect;
     FPPMPanel.ParentWindow := Handle;
     inherited DoShow;
end;

function TOpenPPMDialog.Execute;
begin
     if NewStyleControls and not (ofOldStyleDialog in Options) then
     Template := 'DLGTEMPLATE' else
     Template := nil;
     Result := inherited Execute;
end;
end.
