　Unitになっています。コピーして「jisconv.pas」の名前で保存して下さい。

[SJis2Jis]
　かなり前に「TurboC++」で書いたのをDelphi用に焼き直した物です。ソースはかなり力任せです。引数「Str」にSHIFT-JIS文字列を入れて下さい(半角/全角混在可能)。引数「Shift_Code」は「SI/SO」を付加するかどうか設定するフラグです。このフラグがFalseならば引数「Str」には基本的に全角文字のみ入れる事になります。

[Jis2SJis]
　今回、逆変換用に新たに作成しました。漢字の判定は「SI/SO」を見ていますので、「SI/SO」の付加されていないJIS文字列は正しく変換できません。但し、全角のみの文字列であれば引数「Shift_Code」にFalseを設定すれば正しく変換できます。

...本当はヌル終端文字列でやりとりするのがいいのでしょうけれど。変更は簡単だと思いますので各自で変更してみて下さい。それから、このロジックは厳密にいうと欠陥があるのです。forでバッファをNullクリアしている所を外すと「欠陥」の意味が解ると思います。

unit jisconv;

interface

uses
　Sysutils;

function SJis2Jis(Str:String;Shift_Code:Boolean):String;
function Jis2SJis(Str:String;Shift_Code:Boolean):String;

implementation

function SJis2Jis(Str:String;Shift_Code:Boolean):String;
var
　i,
　Count:Integer;
　Code,
　Hi_Byte,
　Lo_Byte:Byte;
　Src,
　Dst:PChar;
　Sft_Flg:Boolean;
begin
　Src := StrAlloc(1024);
　Dst := StrAlloc(1024);

　for i:=0 to StrBufSize(Src) - 1 do
　　begin
　　　Src[i] := #$00;
　　　Dst[i] := #$00;
　　end;

　i := 0;
　Count := 0;
　Sft_Flg := False;

　StrPCopy(Src,Str);

　while (i<StrLen(Src)) do
　　begin
　　　Hi_Byte := Ord(Src[i]);
　　　Code := $00;

　　　if (Hi_Byte >= $81) and (Hi_Byte <= $9f) then
　　　　Code := $71;
　　　if (Hi_Byte >= $e0) and (Hi_Byte <= $fc) then
　　　　Code := $b1;

　　　{ 全角文字だったら }
　　　if(Code <> $00) then
　　　　begin
　　　　　// SHIFT IN
　　　　　if (not Sft_Flg) and Shift_Code then
　　　　　　begin
　　　　　　　Dst[Count] := #$0f;
　　　　　　　Inc(Count);
　　　　　　　Sft_Flg := True;
　　　　　　end;

　　　　　Inc(i);
　　　　　Lo_Byte := Ord(Src[i]);
　　　　　if(Lo_Byte <= $9e) then
　　　　　　begin
　　　　　　　Dst[Count] := Chr((Hi_Byte - Code) * 2+ 1);
　　　　　　　if(Lo_Byte >= $80) then
　　　　　　　　Dst[Count + 1] := Chr(Lo_Byte - $1f- 1)
　　　　　　　else
　　　　　　　　Dst[Count + 1] := Chr(Lo_Byte-$1f);
　　　　　　end
　　　　　else
　　　　　　begin
　　　　　　　Dst[Count] := Chr((Hi_Byte - (Code - 1)) * 2);
　　　　　　　Dst[Count + 1] := Chr(Lo_Byte - $7e);
　　　　　　end;
　　　　　Count := Count + 2;
　　　　end
　　　{半角文字だったら}
　　　else
　　　　begin
　　　　　// SHIFT OUT
　　　　　　if Sft_Flg and Shift_Code then
　　　　　　　begin
　　　　　　　　Dst[Count] := #$0e;
　　　　　　　　Inc(Count);
　　　　　　　　Sft_Flg := False;
　　　　　　　end;
　　　　　　Dst[Count] := Src[i];
　　　　　　Inc(Count);
　　　　end;
　　　Inc(i);
　　end;
　// 全角文字で終わっていたらSHIFT OUT
　if Sft_Flg and Shift_Code then
　　Dst[Count] := #$0e;
　result := StrPas(Dst);

　StrDispose(Dst);
　StrDispose(Src);
end;
　

function Jis2SJis(Str:String;Shift_Code:Boolean):String;
var
　i,
　Count:Integer;
　Hi_Byte,
　Lo_Byte:Byte;
　Src,
　Dst:PChar;
　Sft_Flg:Boolean;
begin
　Src := StrAlloc(1024);
　Dst := StrAlloc(1024);

　for i:=0 to StrBufSize(Src) - 1 do
　　begin
　　　Src[i] := #$00;
　　　Dst[i] := #$00;
　　end;

　i := 0;
　Count := 0;
　Sft_Flg := not Shift_Code;

　StrPCopy(Src,Str);

　while (i < StrLen(Src)) do
　　begin
　　　Hi_Byte := Ord(Src[i]);
　　　if Shift_Code then
　　　　begin
　　　　　// SHIFT IN
　　　　　if Hi_Byte = $0fthen
　　　　　　begin
　　　　　　　Sft_Flg := True;
　　　　　　　Inc(i);
　　　　　　　Hi_Byte := Ord(Src[i]);
　　　　　　end;
　　　　　// SHIFT OUT
　　　　　if Hi_Byte = $0ethen
　　　　　　begin
　　　　　　　Sft_Flg := False;
　　　　　　　Inc(i);
　　　　　　　Hi_Byte := Ord(Src[i]);
　　　　　　end;
　　　　end;
　　　{ 全角文字だったら }
　　　if Sft_Flg then
　　　　begin
　　　　　Inc(i);
　　　　　Lo_Byte := Ord(Src[i]);
　　　　　if (Hi_Byte mod 2) = 1 then
　　　　　　Lo_Byte := Lo_Byte + $1f
　　　　　else
　　　　　　Lo_Byte := Lo_Byte + $7d;
　　　　　if (Lo_Byte >= $7f) then
　　　　　　Lo_Byte := Lo_Byte + 1;
　　　　　Hi_Byte := ((Hi_Byte - $21) shr 1) + $81;
　　　　　if (Hi_Byte > $9f) then
　　　　　　Hi_Byte := Hi_Byte + $40;
　　　　　Dst[Count] := Chr(Hi_Byte);
　　　　　Dst[Count + 1] := CHr(Lo_Byte);
　　　　　Count := Count + 2;
　　　　end
　　　{半角文字だったら}
　　　else
　　　　begin
　　　　　Dst[Count] := Src[i];
　　　　　Inc(Count);
　　　　end;
　　　Inc(i);
　　end;
　result := StrPas(Dst);

　StrDispose(Dst);
　StrDispose(Src);
end;
end.