Homepage

unit _frmConvert_Unit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, cUnicodeReader,cUnicodeCodecs, ExtCtrls, Buttons, ActnList,
  Menus;

type
  TForm1 = class(TForm)
    panTop: TPanel;
    Read: TLabel;
    cbRead: TComboBox;
    sb_font: TSpeedButton;
    ActionList1: TActionList;
    act_OpenFile: TAction;
    act_ChangeFont: TAction;
    act_Encode: TAction;
    BitBtn1: TBitBtn;
    ScrollBox2: TScrollBox;
    MemoE: TMemo;
    MainMenu1: TMainMenu;
    miView: TMenuItem;
    miChE: TMenuItem;
    ActionList2: TActionList;
    act_create_charset_menu: TAction;
    act_change_codec: TAction;
    act_Character_Encoding_Dialog: TAction;
    ChangeCharsetDestination1: TMenuItem;
    N1: TMenuItem;
    procedure sb_fontClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure act_OpenFileExecute(Sender: TObject);
    procedure act_EncodeExecute(Sender: TObject);
    procedure act_create_charset_menuExecute(Sender: TObject);
    procedure act_change_codecExecute(Sender: TObject);
    procedure act_Character_Encoding_DialogExecute(Sender: TObject);


  private
    { Private declarations }
    MyfileName :AnsiString;
    SystemEncodingName,ksExceptionFile:AnsiString;

    SystemCodec,ActiveCodec : TUnicodeCodecClass;

    ReplaceCodecChar :char;
    CodecAction:TCodecErrorAction;

    procedure OurException(Sender: TObject; E: Exception);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses cUnicodeCodecsAliases,_frmCharacterEncoding_Unit,FileCtrl;

{$R *.DFM}
//uses cUnicodeCodecs;
procedure TForm1.FormCreate(Sender: TObject);
var   i:Integer;
      vfound:boolean;
begin
 MyfileName:='';
 ksExceptionFile := extractfiledir(application.exename) + '\logs.log';

 If GetAllCodecs(cbRead.Items)  then   cbRead.Text := '';


 SystemEncodingName := GetSystemEncodingName; vfound:=false;

 SystemCodec    := GetSystemEncodingCodecClass;
 ActiveCodec    := SystemCodec;


// miSystemEncoding.Caption := 'Default: ' + SystemEncodingName;


 act_create_charset_menu.Execute();

 //default
 ReplaceCodecChar := '?';
 CodecAction := eaReplace;

end;



procedure TForm1.act_Character_Encoding_DialogExecute(Sender: TObject);
var _frmCharacterEncoding: T_frmCharacterEncoding;
begin

 try
  _frmCharacterEncoding := T_frmCharacterEncoding.create(self,CodecAction,ReplaceCodecChar);

  if _frmCharacterEncoding.showmodal= mrOK then
    begin
     If _frmCharacterEncoding.lb.itemindex>-1 then
       ActiveCodec := TUnicodeCodecClass(_frmCharacterEncoding.lb.items.objects[_frmCharacterEncoding.lb.itemindex]);

     CodecAction        := _frmCharacterEncoding.CodecAction;
     ReplaceCodecChar   := _frmCharacterEncoding.ReplaceCodecChar;
    end;

 finally
   freeAndNil(_frmCharacterEncoding);
 end;
end;


procedure TForm1.act_create_charset_menuExecute(Sender: TObject);
var SubItem,SubCatItem : TMenuItem;
    i,pom:Integer;
    vCat:AnsiString;

begin
    vCat:='';
     for i:=0 to FireFoxCodecAliasEntries-1  do
      begin
          if FireFoxCodecAliasList[i].Category<>vCat then
           begin
            //must be twice created
            SubCatItem := TMenuItem.Create(miChE);
            SubCatItem.caption := FireFoxCodecAliasList[i].Category;
            SubCatItem.GroupIndex := 1;

            //subitem of "miChE" item
            miChE.Add(SubCatItem);

           end;

          //must be twice created
          SubItem               := TMenuItem.Create(SubCatItem);
          SubItem.caption       := FireFoxCodecAliasList[i].Location + ' (' + FireFoxCodecAliasList[i].CodecAlias + ')';
          SubItem.GroupIndex    := 10;
          SubItem.Hint          := FireFoxCodecAliasList[i].CodecAlias;
          SubItem.RadioItem     := true;
          SubItem.Tag           := integer(Pointer(FireFoxCodecAliasList[i].Codec));
          SubItem.OnClick       := act_change_codecExecute;

          //if lowercase(SystemEncodingName)=lowercase(SubItem.Hint) then SubItem.Checked:=true;
//          SubItem.OnClick := act_Style_ChangeExecute;

          //subitem of "style" item
          SubCatItem.Add(SubItem);

          vCat:= FireFoxCodecAliasList[i].Category;
     end;



end;


procedure TForm1.act_OpenFileExecute(Sender: TObject);
var oD:TOpenDialog;
    unir:TUnicodeFileReader;
    latin2:TUnicodeCodecClass;
    i:integer;
 begin
  try

   oD:=TOpenDialog.Create(application);
   oD.DefaultExt:='txt';
   oD.Filter := 'txt files (*.txt)|*.txt';
   If oD.Execute then
    begin
      MyfileName:= oD.filename;
      act_encode.execute();
    end;

  finally
   if assigned(oD) then FreeAndNil(oD);
  end;
end;

procedure TForm1.sb_fontClick(Sender: TObject);
var oD:TFontdialog;
 begin
  try
   oD:=TFontdialog.Create(application);
   OD.Font.Assign(MemoE.Font);
   If oD.Execute then
    begin
     MemoE.Font.Assign(od.font);
    end;
  finally
   if assigned(oD) then FreeAndNil(oD);
  end;

end;

procedure TForm1.act_change_codecExecute(Sender: TObject);
var i:integer;
 ws:widestring;
 ac:TUnicodeCodecClass;

begin
  If (sender is tmenuitem) then
   begin
     //check the
    //(Sender as TMenuItem).Checked := True;

    //set the codec
     ActiveCodec:= TUnicodeCodecClass(TMenuItem(Sender).tag);

    //do the encoding
    act_Encode.Execute();
  end;

  If (sender is tcombobox) then
   begin

     if tcombobox(Sender).ItemIndex>-1 then
      begin
       ActiveCodec:= TUnicodeCodecClass(tcombobox(Sender).items.objects[tcombobox(Sender).ItemIndex]);
      //do the encoding
       act_Encode.Execute();
     end;

   end;

end;

procedure TForm1.act_EncodeExecute(Sender: TObject);
const blocksize = 65535;
var i:integer;
 ws:widestring;
  fr : TUnicodeFileReader;
       PtrBuff:PChar;
       ms:integer;
       mc:TCustomUnicodeCodec;


begin
   if not FileExists(MyfileName) then exit;

  try
    //clear the memo
    MemoE.Clear();

    //create the codec
    mc := ActiveCodec.Create();
    mc.DecodeReplaceChar := widechar(ReplaceCodecChar);
    mc.ErrorAction := CodecAction;



    try
    //create the reader
    fr := TUnicodeFileReader.Create(MyfileName,mc,false);

    //read the content and decode it
    while not(fr.EOF) do
     MemoE.Lines.Add(fr.ReadWideStr(blocksize));
    except
     on e:exception do OurException(mc,E);
    end;


  finally
   //free codec
   if assigned(mc) then FreeAndNil(mc);
   //free reader
   if assigned(fr) then FreeAndNil(fr);
  end;

end;


procedure TForm1.OurException(Sender: TObject; E: Exception);
//Adding Global Exception Handler to AMS to smooth the sharp edges...!
var
  mFile : TEXTFILE;
  mFileName,  mSender, mName : Ansistring;

begin
  //if exception is on then add into txt file
    try
      assignfile(mFile, ksExceptionFile);
      if fileexists(ksExceptionFile) then Append(mFile)
      else
      begin
        ForceDirectories(ExtractFileDir(ksExceptionFile));
        rewrite(mFile);
        // Write File Header
        //
        WriteLn(mFile, '----------------------------------------');
        WriteLn(mFile, ' Application Exception Log');
        WriteLn(mFile, 'Created '+FormatDateTime('ddd dd mmmm yyyy hh:nn', Now));
        WriteLn(mFile, '----------------------------------------');
        WriteLn(mFile, '');
      end;

        try
          if Assigned(Sender) then
           begin
            mSender := Sender.ClassName;
            if Sender is TComponent then
              mName := TComponent(Sender).Name;
           end;
        except
          mSender := 'N/A';
          mName:='N/A';
        end;

      WriteLn(mFile, FormatDateTime('dd/mm/yyyy hh:nn', now)+Chr(9)+mSender+Chr(9)+'('+mName+') '+E.Message);
      CloseFile(mFile);
    except
    end;


end;


end.