unit GB2Big5;

interface

uses Windows, SysUtils, Classes;

  //Unicode 簡->繁字轉換
function UnicodeChs2Cht(const Value: WideString): WideString;
  //Unicode 繁->簡字轉換
function UnicodeCht2Chs(const Value: WideString): WideString;
  //代碼碼轉換(經過Unicode中轉)

function LocaleToUnicode(const Value: string; SrcCP: Cardinal): WideString;
function UnicodeToLocale(const Value: WideString; DestCP: Cardinal; DefaultChar: Char='?'): string;

function GBToBIG5(const Value: string): string; //使用API進行簡->繁轉換(推薦)
function BIG5ToGB(const Value: string): string; //使用API進行繁->簡轉換(推薦)
function QuickGBToBig5(const Value: string): string; //直接簡->繁體轉換(不使用API,但可能轉換不完全)
function QuickBIG5ToGB(const Value: string): string; //直接繁->簡體轉換(不使用API,但可能轉換不完全)
function ConvertCodePage(const Value: string; SrcCP, DestCP: Cardinal; DefaultChar: Char='?'): string;
function isGB(Value: Word): Boolean;
function IsGBK(Value: Word): Boolean;
function isBIG5(Value: Word): Boolean;

implementation
{$R CodePage.res}
const
  FirstSTWord: WORD=$4E00;
  LastSTWord: WORD=$9FA5;

var
  GBStream: TResourceStream;
  Big5Stream: TResourceStream;
  rsCHS: TResourceStream;
  rsCHT: TResourceStream;

  BIG5Order: PWordArray;
  GBOrder: PWordArray;
  PARChs: PWideChar;
  PARCht: PWideChar;

function ConvertCodePage(const Value: string; SrcCP, DestCP: Cardinal; DefaultChar: Char): string;
begin
  if (DestCP=SrcCP) then
  begin
    Result := Value;
  end
  else
  begin
    Result := UnicodeToLocale(LocaleToUnicode(Value, SrcCP), DestCP, DefaultChar);
  end;
end;

function LocaleToUnicode(const Value: string; SrcCP: Cardinal): WideString;
var
  i: Integer;
begin
  Result := '';
  if (SrcCP=CP_ACP)and(not IsValidCodePage(SrcCP)) then
  begin
    Result := Value;
  end
  else
  begin
    i := MultiByteToWideChar(SrcCP, 0, PChar(Value), Length(Value), nil, 0);
    SetLength(Result, i);
    MultiByteToWideChar(SrcCP, 0, PChar(Value), Length(Value), PWideChar(Result), i);
  end;
end;

function UnicodeToLocale(const Value: WideString; DestCP: Cardinal; DefaultChar: Char): string;
var
  B: BOOL;
  i: Integer;
  abuff: array of char;
begin
  Result := '';
  if (DestCP=CP_ACP)and(not IsValidCodePage(DestCP)) then
  begin
    Result := Value;
  end
  else if Value<>'' then
  begin
    i := Length(Value);
    SetLength(abuff, i*2+1);
    B := DefaultChar<>#0;
    i := WideCharToMultiByte(DestCP, 0, PWideChar(Value), i, @abuff[0], i*2+1, @DefaultChar, @B);
    if i>0 then
    begin
      abuff[i] := #0;
      SetString(Result, PChar(@abuff[0]), i);
    end;
  end;
end;

function GBToBIG5(const Value: string): string;
begin
  if IsValidCodePage(936)and IsValidCodePage(950) then
    Result := UnicodeToLocale(UnicodeChs2Cht(LocaleToUnicode(Value, 936)), 950, '?')
  else
    Result := QuickGBToBig5(Value);
end;

function BIG5ToGB(const Value: string): string;
begin
  if IsValidCodePage(936)and IsValidCodePage(950) then
    Result := UnicodeToLocale(UnicodeCht2Chs(LocaleToUnicode(Value, 950)), 936, '?')
  else
    Result := QuickBig5ToGB(Value);
end;

function UnicodeChs2Cht(const Value: WideString): WideString;
//Unicode 簡->繁字轉換
var
  i: Integer;
begin
  if rsCht=nil then
  begin
    rsCht := TResourceStream.Create(hInstance, 'CHT', 'CODEPAGE');
    PARCht := PWideChar(@PChar(rsCht.Memory)[2]);
  end;
  Result := '';
  SetLength(Result, Length(Value));
  for i := 1 to Length(Value) do
  begin
    if (Ord(Value[i])>=FirstSTWord)and(Ord(Value[i])<=LastSTWord) then
      Result[i] := PARCht[Ord(Value[i])-FirstSTWord]
    else
      Result[i] := Value[i];
  end;
end;

function UnicodeCht2Chs(const Value: WideString): WideString;
//Unicode 繁->簡字轉換
var
  i: Integer;
begin
  if rsChs=nil then
  begin
    rsChs := TResourceStream.Create(hInstance, 'CHS', 'CODEPAGE');
    PARChs := PWideChar(@PChar(rsChs.Memory)[2]);
  end;
  Result := '';
  SetLength(Result, Length(Value));
  for i := 1 to Length(Value) do
  begin
    if (Ord(Value[i])>=FirstSTWord)and(Ord(Value[i])<=LastSTWord) then
      Result[i] := PARChs[Ord(Value[i])-FirstSTWord]
    else
      Result[i] := Value[i];
  end;
end;

function GBOffset(Value: Word): integer;
begin
  Result := (Hi(Value)-161)*94 + Lo(Value)-161;
end;

function BIG5Offset(Value: Word): integer;
begin
  if Lo(Value)<=126 then
    Result := (Hi(Value)-161)*157+Lo(Value)-64
  else
    Result := (Hi(Value)-161)*157+Lo(Value)-98;
end;

function IsGB(Value: Word): Boolean;
begin
  Result:=False;
  if IsDBCSLeadByteEx(936, Hi(Value)) then
  begin
    Result :=
        (Hi(Value)>=161) and (Hi(Value)<247)
    and (Lo(Value)>=161) and (Lo(Value)<=254);
  end;
end;

function IsGBK(Value: Word): Boolean;
begin
  Result:=False;
  if IsDBCSLeadByteEx(936, Hi(Value)) then
  begin
    Result := ((Hi(Value)>=$81)and(Hi(Value)<$FE))and
              ((Lo(Value)>=$40)and(Lo(Value)<=$FE));
  end;
end;

function IsBIG5(Value: Word): Boolean;
begin
  Result:=False;
  if IsDBCSLeadByteEx(950, Hi(Value)) then
  begin
    Result := ((Hi(Value)>=129) and (Hi(Value)<=254))
          and (((Lo(Value)>=64) and (Lo(Value)<=126))or((Lo(Value)>=161)and(Lo(Value)<=254)));
  end;
end;

function QuickGBToBIG5(const Value: string): string;
var
  nLeng, nIndex: integer;
  tempWord: Word;
  nOffset: integer;
begin
  if GBOrder=nil then
  begin
    GBStream := TResourceStream.Create(hInstance, 'GBORDER', 'CODEPAGE');
    GBOrder := GBStream.Memory;
  end;

  Result := '';
  nLeng := Length(Value);
  SetLength(Result, nLeng);
  nIndex := 1;

  while nIndex<=nLeng do
  begin
    if nIndex+1>nLeng then
    begin
      Result[nIndex] := Value[nIndex];
      break;
    end;

    TempWord := Ord(Value[nIndex]) shl 8 + Ord(Value[nIndex+1]);

    if IsGB(TempWord) then
    begin
      nOffset := GBOffset(TempWord);
      if (nOffset>=0)and(nOffset<=8177) then
      begin
        TempWord := GBOrder[nOffset];
        Result[nIndex]:=Chr(Hi(TempWord));
        Result[nIndex+1]:=Chr(Lo(TempWord));
        inc(nIndex);
      end else
        Result[nIndex]:=Chr(Hi(TempWord));
    end
    else
      Result[nIndex] := Chr(Hi(TempWord));

    inc(nIndex);
  end;
end;

function QuickBIG5ToGB(const Value: string): string;
var
  nLeng, nIndex: integer;
  tempWord: Word;
  nOffset: integer;
begin
  if Big5Order=nil then
  begin
    Big5Stream := TResourceStream.Create(hInstance, 'BIG5ORDER', 'CODEPAGE');
    Big5Order := Big5Stream.Memory;
  end;

  Result := '';
  nLeng := Length(Value);
  SetLength(Result, nLeng);
  nIndex := 1;

  while nIndex<=nLeng do
  begin
    if nIndex+1>nLeng then
    begin
      Result[nIndex] := Value[nIndex];
      break;
    end;

    TempWord := Ord(Value[nIndex]) shl 8 + Ord(Value[nIndex+1]);
    if isBIG5(TempWord) then
    begin
      nOffset := BIG5Offset(TempWord);
      if (nOffset>=0)and(nOffset<=14757) then
      begin
        tempWord := BIG5Order[nOffset];
        Result[nIndex]:=Chr(Hi(TempWord));
        Result[nIndex+1]:=Chr(Lo(TempWord));
        inc(nIndex);
      end
      else
        Result[nIndex] := Chr(Hi(TempWord));
    end
    else
      Result[nIndex] := Chr(Hi(TempWord));

    inc(nIndex);
  end;
end;

initialization
  PARChs := nil;
  PARCht := nil;
  rsChs := nil;
  rsCht := nil;
  GBStream := nil;
  Big5Stream := nil;
  GBOrder := nil;
  Big5Order := nil;

finalization
  PARChs := nil;
  PARCht := nil;
  if Assigned(rsCHS) then FreeAndNil(rsChs);
  if Assigned(rsCHT) then FreeAndNil(rsCht);
  GBOrder := nil;
  Big5Order := nil;
  if Assigned(GBStream) then FreeAndNil(GBStream);
  if Assigned(Big5Stream) then FreeAndNil(Big5Stream);

end.