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.