unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Edit2: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function Encode1(s:String):String;
var i,j,len:Integer;
cur:Integer;
t:String;
begin
Result:='';
len:= Length(s); //j 用于移位計數
i:=1;
j:=0;
while i<=len do
begin
if i<len then //數據變換
cur:=(ord(s[i]) shr j) or ((ord(s[i+1]) shl (7-j)) and $ff)
else
cur:=(ord(s[i]) shr j) and $7f;
FmtStr(t,'%2.2X',[cur]);
Result:=Result+t;
inc(i); //移位計數達到7位的特別處理
j:=(j+1) mod 7;
if j=0 then
inc(i);
end;
end;   

function Encode2(s:WideString):String;
var i,len:Integer;
cur:Integer;
t:String;
begin
Result:='';
len:=Length(s);
i:=1;
while i<=len do
begin
cur:=ord(s[i]); //BCD轉換
FmtStr(t,'％4.4X',[cur]);
Result:= Result+t;
inc(i);
end;
end;


function HextoInt(s: string): Integer;
begin           //$代表16進制
  Result:=StrToInt('$'+s);
end;

function Ucs2ToGBK(const InValue: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to length(InValue) div 2 - 1 do
    Result := Result + WideChar(StrToInt('$' + IntToHex(Ord(InValue[2 * I - 1]), 2)
                                             + IntToHex(Ord(InValue[2 * I]), 2)));
end;

function EncodeUniCode(s:WideString):String; //字符串－>PDU
var
i,len:Integer;
cur:Integer;
t:String;
begin
Result:='';
len:=Length(s);
i:=1;
while i<=len do
begin
cur:=ord(s[i]);
Result:=Result+IntToHex(Cur,4);
inc(i);
end;

end;

function GBKToUcs2(const InValue: WideString): string;
var
  I,len,cur: Integer;
  S: string;
  T:WideString;
begin
  Result := '';
  S:='';
  T:=InValue+#0#0#0#0;
  len:=Length(T);
  I:=1;
  while I<=len do
  begin
  cur:=ord(T[I]);
  S:=S+IntToHex(Cur,4);
  inc(I);
  end;
  for I := 1 to length(S) div 2 do
    Result := Result +Char(strtoint('$'+(S[2 * I -1]+S[2 * I])));
end;

function DecodeUniCode(s:String):WideString; //PDU－>字符串
var
p:PWord;
i,len:Integer;
cur:Integer;
TempChar:WideChar;
t:String;
begin
New(p);

Result:='';
len:=Length(s) div 4;
i:=1;

for i:=0 to Len-1 do
begin
t:=Copy(s,4*i+1,4);
p^:=HexToInt(t);

Move(p^,TempChar,2);
Result:=Result+TempChar;
end;
Dispose(p);
end;

function DeCodeUnicodes(s:String):String;//PDU－>字符串
var
Buf:array[0..100] of widechar;     //[1..70]
len,i:integer;
begin
  len := round(Length(s)/4)-1;
  for i:=0 to Len do
  begin
    buf[i] := widechar(StrToint('$'+copy(s,4*i+1,4)));
  end;
  buf[Len+1] := #0;
  result := WideCharToString(Buf);
end;

function EnCodeGB(s:widestring):string; //字符串－>PDU
var
  sLen:integer;
  cur:integer;
  i:integer;
  strTmp:string;
begin
  result := '';
  sLen := length(s);
  i := 1;
  while i <= sLen do
  begin
    cur := ord(s[i]);                                                           //先返回序數值
    FmtStr(strTmp,'%4.4X',[cur]);                                               //格式化序數值（BCD轉換）
    result := result + strTmp;
    inc(i);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Text:= EncodeUniCode(edit1.text)
//memo1.Lines.Add(EnCodeGB(edit1.text));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
edit2.Text:=DecodeUniCode(memo1.Text);
//edit2.Text:=Ucs2ToGBK(memo1.Text)
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
memo1.Text:= Ucs2ToGBK(GBKToUcs2(edit1.Text))
end;

end.