csvget.exe Delphiソース(Delphi5)


program csvget;

uses
  Forms,
  csvgetu in 'csvgetu.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
unit csvgetu;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
//  hmytool: hwnd;

function StrRight(S: string; Size: integer): string;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  filename,tof,tofile:string[255];
  inidir:string[255];
  csv,t        : textfile;
  f            : array[1..100] of shortint;
  data         : array[1..32000] of string;
  k,fn,dn      : integer;
  s            : string;
  c,c7,c8,i,ii,j,jj  : integer;
  n,nn,ns,nt   : integer;
  m,mt,kslong         : integer;
  head,title,fstr,line : string;
  titlename    : string;
  ks,gyo : string;
  ckei,psize,ps1,ps2:integer;
  knn:integer;
  kn : extended;
begin
  tof    := extractfilepath(application.exename); //アプリの場所
  inidir := tof + 'myfilex\';                     //開くデフォルトフォルダ
  tofile := tof + 'myfilex\temp.myx';             //書き込みファイル
  opendialog1.initialdir := inidir;
    form1.top := -200; form1.Left := -250;        //フォームを画面外に

if opendialog1.execute then begin     //ファイルopen
    filename:=opendialog1.FileName;   //選択ファイル
  assignfile(csv,filename);           //ファイル関連付け
  reset(csv);                         //csvファイル 読み込み
    dn := 1;
    while not eof(csv) do begin       //ファイル端末検出
      readln(csv,data[dn]);
      inc(dn);
    end;
  closefile(csv);                     //ファイル関連付け解除

  for i:=1 to 100 do f[i]:=0 ;        //配列初期化

    c := dn - 1;                      //データ行数
    mt := 0;                          //配列数量初期化
  for i:=1 to c do begin              //初行から最終行のループ
      s := data[i];
      nt:=length(s);
      ns:=0;
      fn:=1;n:=1;

    while n<=nt do begin              //行の列分解
      if n = nt then begin
        k  := n - ns ;
        if k > f[fn] then f[fn] := k;
        break;
      end;
      if s[n]=',' then begin
        nn:=n;
        if s[ns+1]='"' then begin
          while nn<=nt do begin
            if s[nn]=',' then begin
                if s[nn-1]='"' then begin n:=nn;break;end;end;
            if nn=nt   then begin
                if s[nt]='"' then begin n:=nn+1;break;end;end;
            inc(nn);
          end;
        end;

       ks := '';

        for j:=(ns+1) to n-1 do begin ks:=ks + s[j];end;
            
          kslong := length(ks);
          if kslong>2 then if ks[1]='"' then if ks[kslong]='"' then begin
               ks:=copy(ks,2,kslong-2);
               end;          
          k := length(ks);
       // k  := n - ns - 1;
        ns := n;
        if k > f[fn] then f[fn] := k;
        inc(fn);
      end;
      inc(n);
    end;
      if mt<fn then mt:=fn;
  end;

  fstr:= 'F='; ckei:= 0;              //F行作成
  for m:=1 to mt do begin
    fstr := fstr + inttostr(f[m]) + ',' ;
    ckei := ckei + f[m];
  end;
    if ckei mod 2 =1 then psize:=ckei+1 else psize := ckei;

  assignfile(t,tofile);               //ファイル関連付け
  rewrite(t);                         //書き込みファイル
//*ヘッダー
  head := '';
    ps1 := psize mod 256; ps2 := psize div 256;
  head := chr(ps1) + chr(ps2) + #04 + #00 + chr(mt) + #00;
    c7 := (c+5) mod 256; c8 := (c+5) div 256;
  head := head + chr(c7) + chr(c8) + stringofchar(#0,6) + stringofchar(#32,16);
  head := head + #1 + stringofchar(#0,35);
  head := head + #1 + #0 + chr(c7) + chr(c8) + stringofchar(#0,40);
  head := head + stringofchar(#32,20) + stringofchar(#0,16);
  write(t,head);
//*タイトル行
  titlename := extractfilename(filename);
  setlength(titlename,length(titlename) - 4);
  titlename := #91 + titlename + #93 + stringofchar(#32,psize);
  setlength(titlename,psize);
  title := #1 + #0 + titlename + #0 + #7 + stringofchar(#0, 106);
  write(t,title);
//* F行とラインの書き込み
  fstr := fstr + stringofchar(' ',psize);
  setlength(fstr, psize);
  fstr := #2 + #0 + fstr + #0 + #3 + stringofchar(#0, 106);
  line := #128 + stringofchar(#126, psize) + #0 + #7 + stringofchar(#0, 106);
  write(t,fstr + #3 + line);

//*データ行
  for i:=1 to c do begin    // 初行から最終行のループ
      s := data[i];
      nt:=length(s);
      fn:=1;
      gyo:='';
      ns:=0;n:=1;

    while n<=nt do begin      //行文字データの解析(列分解)
      if s[n]=',' then begin
        nn:=n;
        if s[ns+1]='"' then begin
          while nn<=nt do begin
            if s[nn]=',' then begin
                if s[nn-1]='"' then begin n:=nn;break;end;end;
            if nn=nt   then begin
                if s[nt]='"' then begin n:=nn+1;break;end;end;
            inc(nn);
          end;
        end;
        ks := '';          //セルデータの読み込み
        if n>ns+1 then
         for j:=(ns+1) to n-1 do begin ks:=ks + s[j];
        end else ks :='';
          kslong := length(ks);
        if kslong>2 then if ks[1]='"' then if ks[kslong]='"' then begin
               ks:=copy(ks,2,kslong-2);
               end;
     {     try
            kn := strtoint(ks);           //ksが数字の時
            ks:=strright(ks,f[fn]);      //右寄せ
          except
            on E: EConvertError do
            ks := ks + stringofchar(' ',f[fn]);    //エラーの時そのまま
          end;  }
          knn:=length(ks);
          if knn=0 then ks := ks + stringofchar(' ',f[fn]) else begin
          for ii:=1 to knn do begin
            jj:= ord(ks[ii]);  // showmessage(ks + inttostr(jj));
//            if (jj=44)or(jj=46)or(jj=48)or(jj=49)or(jj=50)or(jj=51)or
  //             (jj=52)or(jj=53)or(jj=54)or(jj=55)or(jj=56)or(jj=57) then begin
            if ((jj>42)and(jj<47))or((jj>47)and(jj<58)) then begin
              if ii=knn then ks := strright(ks,f[fn])
                        else continue;
            end else begin ks := ks + stringofchar(' ',f[fn]);
                           break;end;
           end;
           end;
        setlength(ks,f[fn]);                  //データをセルの大きさに
        gyo :=gyo + ks;
        inc(fn);
        ns := n;
      end;
      if n = nt then begin
        ks := '';
        for j:=ns+1 to n do ks:=ks + s[j];
        if s[n]='"' then                     //行末の”を抜く
          if s[ns+1]='"' then begin ks:='';
                                    for j:=ns+2 to n-1 do ks:=ks + s[j];end;
    {      try
            kn := strtofloat(ks);           //ksが数字の時
            ks:=strright(ks,f[fn]);      //右寄せ
          except
            on E: EConvertError do
            ks := ks + stringofchar(' ',f[fn]);    //エラーの時そのまま
          end; }
          knn:=length(ks);
          if knn=0 then ks := ks + stringofchar(' ',f[fn]) else begin
          for ii:=1 to knn do begin
            jj:= ord(ks[ii]);  // showmessage(ks + inttostr(jj));
//            if (jj=44)or(jj=46)or(jj=48)or(jj=49)or(jj=50)or(jj=51)or
  //             (jj=52)or(jj=53)or(jj=54)or(jj=55)or(jj=56)or(jj=57) then begin
            if ((jj>42)and(jj<47))or((jj>47)and(jj<58)) then begin
              if ii=knn then ks := strright(ks,f[fn])
                        else               continue;
            end else begin ks := ks + stringofchar(' ',f[fn]);
                           break;end;
           end;
           end;
        setlength(ks,f[fn]);             //ksをセルの大きさに
          gyo := gyo + ks;

          break;
      end;
        inc(n);
    end;
        gyo := gyo + stringofchar(' ', psize);
        setlength(gyo,psize);
        if i=1 then begin
          gyo := #3 + #0 +gyo +#0 + #7 + stringofchar(#0, 106); 
          write(t,gyo + #3 +line);         //項目行とライン
        end else begin
         gyo := #4 + #0 +gyo +#0 + #7 + stringofchar(#0, 106); 
         write(t, gyo);                    //データ行
        end;

  end;
//*最終ライン
  write(t,#0 + line );

  closefile(t);                            //書き込みファイル解除

end else begin
    deletefile(tofile);
    timer1.enabled := true;
end;


end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   close;
end;

function StrRight(S: string; Size: integer): string;
var
  i: integer;
begin
  for i:=1 to size - length(s) do
      s:= ' ' + s;
  strright := s;
end;

end.