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.