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$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.Position0) 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 i14 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.