COBOL3のﾌｧｲﾙのﾃﾞｰﾀ部を 他のﾌｧｲﾙ形式(Paradox等)に変換する場合の
数値ﾃﾞｰﾀの取扱い例 です。
ｺｰﾄﾞは JIS8 を想定していますので ｺｰﾄﾞ変換処理は 行っていません。

Main処理では 適当に Try... Except... を使用して下さい。
出力ﾌｧｲﾙは おまかせです。(^^)

{*------------------------------------------------*}
{* 使用例 Main処理                                *}
{*------------------------------------------------*} 
//COBOL3のﾚｺｰﾄﾞ定義例
type
  TABCRec = record                   // ****ﾏｽﾀｰ
    Check:   array[1..2]   of Char;  // X(2)
    Name1:   array[1..8]   of Char;  // X(8)
    Name2:   array[1..4]   of Char;  // S9(5)v9(2) comp-3
    Name3:   array[1..5]   of Char;  // S9(9)      comp-3
    Name4:   array[1..4]   of Char;  // S9(4)
    dummey:  array[1..1]   of Char;  // ﾀﾞﾐｰ 
  end;

//COBOL3のﾌｧｲﾙREAD(Streamを使用しています。) 
  Const
    ABCSize = SizeOf(TABCRec);   //2+21+1
  var
    SrName: String;              //変換対象Cobolﾌｧｲﾙ名
    ABCRec: TABCRec;
    FileEnd: Boolean;
    RLen: Integer;

  FileEnd := False;
  Stream  := TFileStream.Create(SrName,fmOpenRead);
  try
    Stream.Seek(128, soFromBeginning);    //Head部読み飛ばし
    while not FileEnd do
      begin
        RLen := Stream.Read(ABCRec,ABCSize);
        if RLen = ABCSize then
          begin
            if IsAliveData(ABCRec.Check[1]) then
              begin
                ***** := Trim(ABCRec.Name1);
                ***** := CBLNumChange(ABCRec.Name2,2,True);
                ***** := CBLNumChange(ABCRec.Name3,0,True);
                ***** := CBLNumChange(ABCRec.Name4,0,False);
                {ﾌｧｲﾙ出力}
              end;
          end
        else
          FileEnd := True;
      end;
  finally
    Stream.Free;
  end;

{*----------------------------*}      
{* Cobol3用 削除ﾃﾞｰﾀの判定    *}
{*----------------------------*}
function IsAliveData(Check: Char): Boolean;
begin
  Result := (ord(Check) shr 4) = 4;
             {先頭ﾊﾞｲﾄ= $4X は正常ﾃﾞｰﾀ}
end;

{*-----------------------------------------*}
{*  COBOL形式.数値変換ﾙｰﾁﾝ                 *}
{*-----------------------------------------*}
{*    TgStr:    COBOL数値ﾃﾞｰﾀ => Char形式  *}
{*    Prec :    小数以下桁数               *}
{*    IsPacked: Comp-3形式の場合 True      *}
{*-----------------------------------------*}
function CBLNumChange(TgtStr: String; Prec:Integer;
                      IsPacked: Boolean): Extended;
var
  N,M: Integer;
  S: String;
  Keta: Extended;
begin
  Result := 0;
  for N := 1 to Length(TgtStr) do        //16進文字列に変換
    S := S + Format('%.2x',[Ord(TgtStr[N])]);
  M    := Length(S);
  Keta := 0.1;

  if IsPacked then
    begin
      for N := M-1 downto 1 do
        begin
          Keta   := Keta * 10;
          Result := Result + StrToIntDef(S[N],0) * Keta;
        end;
      if Upcase(S[M]) = 'D' then
        Result := - Result;
    end
  else
    begin
      N := M;
      while N > 0 do
        begin
          Keta   := Keta * 10;
          Result := Result + StrToIntDef(S[N],0) * Keta;
          N := N - 2;
        end;
      if Upcase(S[M-1]) = '7' then
        Result := - Result;
    end;

  N := 0;
  if Prec <> 0 then
    repeat
      Result := Result / 10;
      Inc(N);
    until N = Prec;
end;
=================================================================
                       草薙いっぺい(GBE02547)  00/07/19 20:40
 


Original document by 草薙いっぺい    氏 ID:(GBE02547)

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