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;
//使用API进行简->繁转换(推荐)
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;
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 := #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;
//Unicode 简->繁字转换
function UnicodeChs2Cht(const Value: WideString): WideString;
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)>=FirstSTWord)and(Ord(Value)<=LastSTWord) then
Result := PARCht[Ord(Value)-FirstSTWord]
else
Result := Value;
end;
end;
//Unicode 繁->简字转换
function UnicodeCht2Chs(const Value: WideString): WideString;
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)>=FirstSTWord)and(Ord(Value)<=LastSTWord) then
Result := PARChs[Ord(Value)-FirstSTWord]
else
Result := Value;
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<=nLengdo
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<=nLengdo
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.