unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FNlsOldPath : string;
    FNlsNewPath : string;
    FIsWinXP    : Boolean;
    procedure AddEraInfo(AEraName: string; AYear, AMonth, ADay: Word;
      ANlsOldFilePath, ANlsNewFilePath: string);
    procedure ListGengo(ANlsFilePath: string);
  end;

var
  Form1: TForm1;

implementation

uses
  System.IOUtils;

{$R *.dfm}

type
  TEraNameInfoXP = record
    Month   : Word;
    Day     : Word;
    Year    : Word;
    DataLen : Word;
    YearStr : array [0..4] of char;
    Name    : array [0..2] of Char;
  end;
  pEraNameInfoXP = ^TEraNameInfoXP;

  TOffsetTable = record
    TableNo : DWORD;
    Reserv  : Word;
    Offset  : array [0..5] of Word;
    digChar : array [0..4] of Char;
  end;
  pOffsetTable = ^TOffsetTable;

  TJumpTable = record
    Offset : array [0..8] of DWORD;
  end;
  pJumpTable = ^TJumpTable;

const
  FInfoStartPos = $3F8D4;
  FJumpOffsetStart = $3F5B2;
  FEraNameStart = FInfoStartPos + SizeOf(TOffsetTable);

//============================================================================
//  フォーム生成時の処理
//
//  元の locale.nls は System32 フォルダからコピーしてくる
//  情報を追加した locale.nls はこの EXE があるフォルダに保存
//============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LFileVer  : Cardinal;
  LMajorVer : Cardinal;
  LMinorVer : Cardinal;
begin
  FNlsOldPath := ExtractFilePath(Application.ExeName) + 'Origin\locale.nls';
  FNlsNewPath := ExtractFilePath(Application.ExeName) + 'locale.nls';

  Button1.Enabled := FileExists(FNlsOldPath);
  Button2.Enabled := FileExists(FNlsOldPath);
  Button3.Enabled := FileExists(FNlsNewPath);

  // Windows のバージョン判定
  LFileVer := GetFileVersion('C:\Windows\System32\Kernel32.dll');
  LMajorVer := LFileVer shr 16;
  LMinorVer := LFileVer and $FFFF;
  FIsWinXP := (LMajorVer = 5) and (LMinorVer = 1);
  Button4.Enabled := FIsWinXP and FileExists(FNlsNewPath);
end;

//============================================================================
//  locale.nls に令和の情報を追加
//============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;

  AddEraInfo('令和', 2019,  5,  1, FNlsOldPath, FNlsNewPath);

  Button3.Enabled := FileExists(FNlsNewPath);
  Button4.Enabled := FIsWinXP and FileExists(FNlsNewPath);
  Memo1.Lines.Add('locale.nls に元号を追加しました');
end;

//============================================================================
//  変換前の locale.nls の元号関係の情報を表示
//============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  ListGengo(FNlsOldPath);
end;

//============================================================================
//  変換後の locale.nls の元号関係の情報を表示
//============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  ListGengo(FNlsNewPath);
end;

//============================================================================
//  ファイルの置き換え
//============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  if not FIsWinXP then begin
    MessageBox(0, 'Windows XP のドライブではありません　　', '結果', MB_ICONWARNING);
    Exit;
  end;

  try
    TFile.Copy(FNlsNewPath,'C:\Windows\System32\locale.nls', True);
    MessageBox(0, 'ファイルを置き換えました　　', '結果', MB_ICONINFORMATION);
  except
    MessageBox(0, 'ファイルの置き換えに失敗しました　　','結果', MB_ICONWARNING);
  end;
end;

//----------------------------------------------------------------------------
//  Locale.nls ファイルに元号の情報を追加するルーチン
//
//  ANlsOldFilePath  : 元号追加前の locale.nls のフルパス
//  ANlsNewFilePath  : 元号追加後の locale.nls の保存先のフルパス
//
//  FInfoStartPos, FEraNameStart はグローバル変数
//----------------------------------------------------------------------------
procedure TForm1.AddEraInfo(AEraName: string; AYear, AMonth, ADay: Word;
  ANlsOldFilePath, ANlsNewFilePath: string);
var
  LSrcStream   : TBytesStream;
  LDstStream   : TBytesStream;
  LEraNameInfo : TEraNameInfoXP;
  LOffsetTable : TOffsetTable;
  LJmpTable    : TJumpTable;
  LEraWordSize : Word;
  LIndex       : Integer;
begin
  LSrcStream := TBytesStream.Create;
  LDstStream := TBytesStream.Create;
  try
    // locale.nls ファイルを読み込む
    LSrcStream.LoadFromFile(ANlsOldFilePath);

    // レコード型の初期化
    LEraNameInfo := System.Default(TEraNameInfoXP);
    // 令和の情報をレコード型のメンバにセット
    LEraWordSize := SizeOf(LEraNameInfo) div 2;
    LEraNameInfo.Year    := AYear;
    LEraNameInfo.Month   := AMonth;
    LEraNameInfo.Day     := ADay;
    LEraNameInfo.DataLen := LEraWordSize;
    StrPCopy(LEraNameInfo.Name, AEraName);
    StrPCopy(LEraNameInfo.YearStr, IntToStr(LEraNameInfo.Year));

    LDstStream.Size := LSrcStream.Size + SizeOf(LEraNameInfo);

    LDstStream.CopyFrom(LSrcStream, FEraNameStart);
    LDstStream.WriteBuffer(LEraNameInfo, SizeOf(LEraNameInfo));

    Move(LSrcStream.Bytes[FEraNameStart],
         LDstStream.Bytes[FEraNameStart + SizeOf(LEraNameInfo)],
         LSrcStream.Size - FEraNameStart);

    // 元号情報の最終位置のオフセットとその他のオフセット値を更新
    LDstStream.Seek(FInfoStartPos, soBeginning);
    LDstStream.ReadBuffer(LOffsetTable, SizeOf(LOffsetTable));
    for LIndex := 2 to 5 do begin
      LOffsetTable.Offset[LIndex] := LOffsetTable.Offset[LIndex] + LEraWordSize;
    end;
    LDstStream.Seek(FInfoStartPos, soBeginning);
    LDstStream.WriteBuffer(LOffsetTable, SizeOf(LOffsetTable));

    // もう 1 つのオフセット関係の値を更新
    LDstStream.Seek(FJumpOffsetStart, soBeginning);
    LDstStream.ReadBuffer(LJmpTable, SizeOf(LJmpTable));
    for LIndex := 0 to High(LJmpTable.Offset) do begin
      LJmpTable.Offset[LIndex] := LJmpTable.Offset[LIndex] + SizeOf(TEraNameInfoXP)
    end;
    LDstStream.Seek(FJumpOffsetStart, soBeginning);
    LDstStream.WriteBuffer(LJmpTable, SizeOf(LJmpTable));

    // 保存
    // System32 フォルダ内の locale.nls を,ここで保存したファイルに置き換える
    LDstStream.Position := 0;
    LDstStream.SaveToFile(ANlsNewFilePath);
  finally
    FreeAndNil(LSrcStream);
    FreeAndNil(LDstStream);
  end;
end;

//----------------------------------------------------------------------------
//  locale.nls の元号関係の情報を表示
//  FInfoStartPos, FEraNameStart はグローバル変数
//----------------------------------------------------------------------------
procedure TForm1.ListGengo(ANlsFilePath: string);
var
  LStream       : TBytesStream;
  LEraInfoStart : Word;
  LEraInfoEnd   : Word;
  LEraWordSize  : Word;
  LEraCount     : Integer;
  LEraNameInfo  : TEraNameInfoXP;
  LYear         : Integer;
  LMonth        : Integer;
  LDay          : Integer;
  LIndex        : Integer;
begin
  Memo1.Lines.Clear;

  LStream := TBytesStream.Create;
  try
    LStream.LoadFromFile(ANlsFilePath);

    LStream.Seek(FInfoStartPos + SizeOf(Word) * 4, soBeginning);
    LStream.ReadBuffer(LEraInfoStart, SizeOf(Word));
    LStream.ReadBuffer(LEraInfoEnd, SizeOf(Word));

    LEraWordSize := SizeOf(LEraNameInfo) div 2;
    LEraCount := (LEraInfoEnd - LEraInfoStart) div LEraWordSize;

    LStream.Seek(FEraNameStart, soBeginning);
    for LIndex := 0 to LEraCount - 1 do begin
      LStream.ReadBuffer(LEraNameInfo, SizeOf(LEraNameInfo));

      Memo1.Lines.Add(LEraNameInfo.Name);

      LYear  := LEraNameInfo.Year;
      LMonth := LEraNameInfo.Month;
      LDay   := LEraNameInfo.Day;

      Memo1.Lines.Add(IntToStr(LYear) + ' 年 '
                    + IntToStr(LMonth) + ' 月 '
                    + IntToStr(LDay) + ' 日 ～');
    end;
  finally
    FreeAndNil(LStream);
  end;
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Clear;

  AddEraInfo('令和', 2019,  5,  1, FNlsOldPath, FNlsNewPath);
  AddEraInfo('正明', 2025,  6, 15, FNlsNewPath, FNlsNewPath);
  AddEraInfo('仁和', 2032, 10, 10, FNlsNewPath, FNlsNewPath);

  Button3.Enabled := FileExists(FNlsNewPath);
  Button4.Enabled := FIsWinXP and FileExists(FNlsNewPath);
  Memo1.Lines.Add('locale.nls に元号を追加しました');
end;

//============================================================================
//  元号名のリストを取得するサンプルコード
//  Delphi XE 用
//  Delphi XE では最大 7 つまで元号が使用可能
//============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LEraName : string;
  LIndex   : Integer;
begin
  Memo1.Lines.Clear;

  Memo1.Lines.Add('元号格納配列要素数 : ' + IntToStr(MaxEraCount));

  for LIndex := 1 to High(EraNames) do begin
    Memo1.Lines.Add(IntToStr(LIndex) + ' : ' + EraNames[LIndex]);
  end;
end;

//============================================================================
//  元号名のリストを取得するサンプルコード
//  Delphi XE5 以降用
//============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFmtSettings : TFormatSettings;
  LEraCount    : Integer;
  LEraName     : string;
  LIndex       : Integer;
begin
  Memo1.Lines.Clear;

  LFmtSettings := TFormatSettings.Create;
  LEraCount := Length(FormatSettings.EraInfo);

  Memo1.Lines.Add('元号格納配列要素数 : ' + IntToStr(LEraCount));

  for LIndex := 0 to LEraCount - 1 do begin
    LEraName := FormatSettings.EraInfo[LIndex].EraName;
    Memo1.Lines.Add(IntToStr(LIndex + 1) + ' : ' + LEraName);
  end;
end;

//============================================================================
//  西暦から和暦名に変換するテスト
//  EXE は Delphi XE5 で作成
//============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText : string;
begin
  Memo1.Lines.Clear;

  LText := FormatDateTime('gg e 年 m 月 d 日', StrToDate('2019/5/10'));
  Memo1.Lines.Add(LText);

  LText := FormatDateTime('gg e 年 m 月 d 日', StrToDate('1912/7/30'));
  Memo1.Lines.Add(LText);

  LText := FormatDateTime('gg e 年 m 月 d 日', StrToDate('1890/5/10'));
  Memo1.Lines.Add(LText);
end;

const
  FInfoStartPos  = $2D8DA;