/** 主程序,包含幾個轉碼的函數

*   作者:劉昆

*   最后修改日期:  2004-11-18 

*   以上代碼免費,若直接引用一下代碼請告知,并保留此注釋

*   作為一名程序員應該有最基本的職業道德*/

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TFormMain = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    Button1: TButton;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    function StrToUTF8(str: WideString): string;
    function StrToASC(Str: string): string;
    function GB2Unicode(Str: WideString): string; overload;
    //function GB2Unicode(Str: string): string; overload;
    function U2GB(Str: string): string;
    function UTF8ToStr(const str: UTF8String): string;
    function HexToInt(const Str: string): integer;
    function HexIndex(const c: Char): Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

{ TFormMain }

function TFormMain.StrToASC(Str: string): string;
var
  TmpStr: string;
  TmpPchar: Pchar;
  i: integer;
begin
  result := '';
  TmpStr := '';
  TmpPchar := pchar(Str);
  for i := 0 to length(TmpPchar) - 1 do
    TmpStr := TmpStr + format('%2.2x', [ord(TmpPchar[i])]);

  result := TmpStr;
end;

function TFormMain.StrToUTF8(str: WideString): string;
var
  s: pchar;
  i: integer;
  tmp: string;
begin
  tmp := '';
  result := '';
  s := pchar(Utf8encode(str));
  for i := 0 to strlen(s) do begin
    tmp := tmp + format('%2.2x', [ord(s[i])]);
  end;
  result := tmp;
end;

function TFormMain.UTF8ToStr(const str: UTF8String): string;
var
  s: pchar;
  i: integer;
  tmp: string;
begin
  tmp := '';
  result := '';
  s := PChar(str);
  i := 0;
  while i < length(s) do begin
    tmp := tmp + chr(HexToInt(s[i] + s[i + 1]));
    inc(i, 2);
  end;
  result := Utf8Decode(tmp);
end;

function TFormMain.GB2Unicode(Str: WideString): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Str) do
    Result := Result + Format('%4.4x', [ord(Str[i])]);
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  case ComboBox1.ItemIndex of
    0: memo2.Lines.Add(GB2Unicode(memo1.Lines.Text));
    1: memo2.Lines.Add(StrToUTF8(memo1.Lines.Text));
    2: memo2.Lines.Add(UTF8ToStr(memo1.Lines.Text));
    3: memo2.Lines.Add(U2GB(StringReplace(memo1.Lines.Text, '\u', '', [rfReplaceAll])));
    4: memo2.Lines.Add(StrToASC(memo1.Lines.Text));
  end;
end;

function TFormMain.HexToInt(const Str: string): integer;
var p: pchar;

begin
  result := -1;
  if length(str) > 2 then exit;
  p := pchar(str);

  if (HexIndex(p[0]) <> -1) and (HexIndex(p[1]) <> -1) then
    result := HexIndex(p[0]) * $10 + HexIndex(p[1]);
end;

function TFormMain.HexIndex(const c: Char): Integer;
const Digits: array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
var i: integer;
begin
  result := -1;
  if (not (UpCase(c) in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'])) then
    exit;

  for i := 0 to high(digits) do
    if Digits[i] = UpCase(c) then begin
      result := i;
      break;
    end;
end;

function TFormMain.U2GB(Str: string): string;
var s: pchar;
  i: integer;
  tmp: string;
begin
  tmp := '';
  result := '';
  s := PChar(str);
  i := 0;
  while i < length(s) do begin
    tmp := tmp + chr(HexToInt(s[i + 2] + s[i + 3])) + chr(HexToInt(s[i] + s[i + 1]));//unicode轉換時,高低位互換
    inc(i, 4);
  end;
  result := widechartostring(pWideChar(tmp + #0#0#0#0));
end;

end.