この発言は
#00956　ぜえた          さんのJIS文字列から SJIS文字列への変換
に対するコメントです



ぜえた さんこんにちは、けんしです



このへんの関数は最近一通り作ったのでUPします

nifty:FDELPHI/MES/15/286 で瑠瓏さんが公開している HenkanJ.pas を
使用します(usesで指定しています)

TMiniStringというクラスであらかじめ大きく領域を取っておいて、
Reallocはクラス任せでやらせる、という方法を使いました

//----------------------HenkanJ2.pas ここから
unit HenkanJ2;
interface
uses
  Sysutils, HenkanJ;
type
  TMiniString=class
  private
    buf: PChar;
    buflen, len: Integer;
  public
    constructor Create(initlen: Integer);
    destructor Destroy; override;
    procedure Add(c: Char);
    procedure AddByWord(N:Word);
    procedure AddByString(s: string);
    function ToStr: string;
  end;

function SJis_Euc(SjisText:String):String;
function Euc_SJis(EUCText:String):String;
function Jis_Sjis(JisText:String):String;
function SJis_jis(SJisText:String):String;

implementation

{ TMiniString }
constructor TMiniString.Create(initlen: Integer);
begin
  inherited Create;
  len:=0;
  buflen:=0;
  if initlen>0 then
  begin
    buf:=AllocMem(initlen+1);
    buflen:=initlen+1;
  end;
end;

destructor TMiniString.Destroy;
begin
  if buflen>0 then
  begin
    FreeMem(buf, buflen);
  end;
  inherited Destroy;
end;

procedure TMiniString.Add(c: Char);
begin
  if len>=buflen then
  begin
    Inc(buflen, 16*1024); //16KB追加
    ReallocMem(buf, buflen);
  end;
  buf[len]:=c;
  Inc(len);
end;

function TMiniString.ToStr: string;
begin
  if len=0 then
  begin
    Result:='';
  end;
  if len>=buflen then
  begin
    Inc(buflen);          //#0の分追加
    ReallocMem(buf, buflen);
  end;
  buf[len]:=#0;
  Result:=string(buf);
end;

procedure TMiniString.AddByWord(N: Word);
begin
  if len+1>=buflen then
  begin
    Inc(buflen, 16*1024); //16KB追加
    ReallocMem(buf, buflen);
  end;
  buf[len]:=char(Hi(N));
  buf[len+1]:=char(Lo(N));
  Inc(len, 2);
end;

procedure TMiniString.AddByString(s: string);
var
  n, h: Integer;
begin
  n:=1;
  h:=Length(s);
  while n<=h do
  begin
    Add(s[n]);
    Inc(n);
  end;
end;

{関数はここから}

function SJis_Euc(SjisText:String):String;
var
  n,h:Integer;
  buf: TMiniString;
begin
  Result:='';
  buf:=TMiniString.Create(Length(SJisText));
  try
    n:=1;
    h:=Length(SJisText);
    while n<=h do
    begin
      if IsDBCSLeadChar(SjisText[n]) then
      begin
        buf.AddByWord(
          SJisToEUC(
            (ord(SjisText[n]) shl 8) + ord(SjisText[n+1])
          )
        );
        Inc(n,2)
      end
      else begin
        buf.Add(SjisText[n]);
        Inc(n)
      end
    end;
    Result:=buf.ToStr;
  finally
    buf.Free;
  end;
end;

function Euc_Sjis(EucText:String):String;
var
  n, h: Integer;
  buf: TMiniString;
begin
  Result:='';
  buf:=TMiniString.Create(Length(EUCText));
  try
    n:=1;
    h:=Length(EucText);
    while n<=h do
    begin
      // $A1A1 が JISの$2121,SJISの$8140になる
      if EucText[n] in [#$A1..#$FE] then
      begin
        buf.AddByWord(
          EucToSJis(
            (ord(EUCText[n]) shl 8) + ord(EUCText[n+1])
          )
        );
        Inc(n,2);
      end
      else begin
        buf.Add(EUCText[n]);
        Inc(n);
      end
    end;
    Result:=buf.ToStr;
  finally
    buf.Free;
  end;
end;

function Jis_Sjis(JisText:String):String;
var
  n, h: Integer;
  buf: TMiniString;
  k: Boolean;
begin
  Result:='';
  buf:=TMiniString.Create(Length(JisText));
  try
    k:=False;
    h:=Length(JisText);
    n:=1;
    while n<=h do
    begin           //↓ESC
      if JisText[n] = #$1B then
      begin
        Inc(n);

        if JisText[n] = #$24 then
        begin
          k:=True;
        end
        else if JisText[n] = #$28 then
        begin
          k:=False;
        end;
        Inc(n, 2);
      end;

      if k then
      begin
        buf.AddByWord(
          JisToSJis(
            (ord(JisText[n]) shl 8) + ord(JisText[n+1])
          )
        );
        Inc(n, 2);
      end
      else begin
        buf.Add(JisText[n]);
        Inc(n);
      end
    end;

    Result:=buf.ToStr;
  finally
    buf.Free;
  end;
end;

function SJis_jis(SJisText:String):String;
var
  n, h:integer;
  buf: TMiniString;
  flag,oldflag : Boolean;
begin
  n:=1;
  h:=length(SJisText);

  Result:='';

  buf:=TMiniString.Create(h+(h div 5));  //初期サイズh*1.2
  try
    oldflag := False;
    while (n<=h) do
    begin
      flag := IsDBCSLeadChar(SjisText[n]);
      if flag then
      begin
        if n<length(SjisText) then
        begin
          if oldflag = False then //前の文字が１バイト文字か？
          begin
            buf.AddByString(#$1B'$B');  //全角文字の始まり
          end;
          buf.AddByWord(
            SjisToJis(
              (ord(SJisText[n]) shl 8) + ord(SJisText[n+1])
            )
          );
          inc(n,2);
        end;
      end
      else begin
        if oldflag then //前の文字が２バイト文字か？
        begin
          buf.AddByString(#$1B'(B');  //全角文字の終わり
        end;
        buf.Add(SjisText[n]);
        inc(n);
      end;
      oldflag := flag;
    end;
    if oldflag then //前の文字が２バイト文字か？
    begin
      buf.AddByString(#$1B'(B');  //全角文字の終わり
    end;
    Result:=buf.ToStr;
  finally
    buf.Free;
  end;
end;

end.
////----------------------HenkanJ2.pas ここまで

===== 8< ===== 8< ===== 8< ===== 8< ===== 8< ===== 8< =====
99/10/13(Wed) 11:29pm
KYK01245 けんし

Original document by けんし          氏 ID:(KYK01245)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。