2012年11月10日土曜日

AnsiExtractQotedStr

QuotedStr関数の存在は、知ってたけど、AnsiExtrctQuotedStrの存在は知らなかった。(^^ゞ
ってことで、使ってみた。
以下ソース


program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s :String;
  src : PWideChar;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
    s := 'ミリアリア';
    Writeln(s);
    s := QuotedStr(s);
    Writeln(s);
    src := PwideChar(s);
    s := AnsiExtractQuotedStr(src,'''');
    Writeln(s);

    readln;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


AnsiExtractQuitedStr内のsrcのとこで、直接キャストしようとすると コンパイルエラーが出るので、一度変数受けでキャスト。
で実行結果は、


2012年11月8日木曜日

指定したフォルダの特定のファイルをSJISからUTF8に変更する

今の仕事で使用した、SJIS→UTF8のチャラツール。
ファイル数がすくなければ、手作業でするけど、ファイル数が多いのファイルが
サブディレクトリにわたるので、作ってみた。
諸般の事情により、Delphi2007で作ったので、UTF8への変換にはjclUnicodeの
TWideStringList、ファイルの走査にはJclFileUtilsのTJclFileEnumeratorを利用した。
(変換元ファイルのディレクトリ、変換先のディレクトリの指定にJvclの TJvDirectoryEdit
を使用した。)

以下ソースコード。


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,JclStrings, JclFileUtils, StdCtrls, Mask, JvExMask, JvToolEdit,jclUnicode;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    JvDirectoryEdit1: TJvDirectoryEdit;
    JvDirectoryEdit2: TJvDirectoryEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    FFileEnumerator: TJclFileEnumerator;
    FDirCount: Integer;
    FTaskID: TFileSearchTaskID;
    FT0: TDateTime;
    procedure DirectoryEntered(const Directory: string);
    procedure AddFile(const Directory: string; const FileInfo: TSearchRec);
    procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses Types,StrUtils, VBLikeString;
{$R *.dfm}

{ TForm1 }

procedure TForm1.AddFile(const Directory: string; const FileInfo: TSearchRec);
var
  SourceFileName,TargetFileName : String;
  TargetDir : String;
  SourceText : TStringList;
  TargetText : TWideStringList;
  LineCount : Integer;
  WorkStrings : TStringDynArray;
  //RevArray : Array of String;
  RevisionString : String;
  IsHeaderArea : Boolean;
begin
  SourceFileName := Directory + FileInfo.Name;

  //変換後ファイルの書き込み先フォルダは、元ファイルのフルパスの変換元フォルダに指定した
  //文字列を変換後に指定したフォルダに置換すれば良い
  TargetFileName := ReplaceText(SourceFileName,JvDirectoryEdit1.Text,JvDirectoryEdit2.Text);
  TargetDir := ExtractFileDir(TargetFileName);

  //ディレクトリがなければ作成する
  if not(DirectoryExists(TargetDir)) then ForceDirectories(TargetDir);

  SourceText := TStringList.Create;
  try
    SourceText.LoadFromFile(SourceFileName);
    TargetText := TWideStringList.Create;
    try
      //TargetText.Text := ReplaceStr(SourceText.Text,'@CRLF',sLineBreak);
      TargetText.Text := SourceText.Text;
      TargetText.SaveUnicode := true;
      TargetText.SaveFormat := sfUTF8;
      TargetText.SaveToFile(TargetFileName);
    finally
      TargetText.Free;
    end;
  finally
    SourceText.Free;
  end;
  Memo1.Lines.Add(SourceFileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  RootDirectories: TStrings;
begin

  FFileEnumerator.SearchOption[fsLastChangeAfter] := false;
  FFileEnumerator.SearchOption[fsLastChangeBefore] := false;

  RootDirectories := TStringList.Create;
  try
    StrToStrings(JvDirectoryEdit1.Text, DirSeparator, RootDirectories, False);
    FFileEnumerator.RootDirectories := RootDirectories;
  finally
    RootDirectories.Free;
  end;
  FFileEnumerator.FileMask := '*.c;*.h';
  FFileEnumerator.SearchOption[fsMinSize] := false;
  FFileEnumerator.SearchOption[fsMaxSize] := false;
  FFileEnumerator.IncludeSubDirectories := true;
  FFileEnumerator.IncludeHiddenSubDirectories := true;
  FFileEnumerator.CaseSensitiveSearch := false;
  FDirCount := 0;

  FT0 := Now;
  FTaskID := FFileEnumerator.ForEach(AddFile);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FFileEnumerator.StopTask(FTaskID);
end;

procedure TForm1.DirectoryEntered(const Directory: string);
begin
  Inc(FDirCount);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FFileEnumerator.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileEnumerator := TJclFileEnumerator.Create;
  FFileEnumerator.OnEnterDirectory := DirectoryEntered;
  FFileEnumerator.OnTerminateTask := TaskDone;

end;

procedure TForm1.TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
begin
  //
end;

end.

TJclFileEnumeratorは、ファイル検索の条件を設定したうえで、検索条件に該当するファイルが
見つかった場合に呼び出すメソッドを指定してForEcahメソッドを実行すれば、都度、指定した
メソッドを呼び出してくれるので、ForEachに指定しメソッドにSJIS→UTF8の変換処理を
書けばよい。(ソース上ではAddFile)

TStringListを使ってファイルを読み込み、そのテキストをTWideStringListに
渡して、 をTWideStringListでUTF-8を指定して保存することにより、UTF-8変換を
実施した。(このへんは、Delphi 2009以降ならもっとスマートにできる思う。)


2012年9月11日火曜日

Joinのオーバーロード

Joinのオーバーロードを試してみた。
但し、
class function Join(const Separator: string; const Values: IEnumerable): string; overload; static;
以外です。
詳細はプログラム中のコメントに記述しました。
以下、プログラム



program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Variants;


var
  s : string;
  a,b : single;
  s1,S2: string;
  elm : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper

   //オーバーロードの1つ目
   //オープン配列を使用した形です。
   writeln('overload1:オープン配列');
   s := s.Join(',',['ミリー','ハイネ']);
   write('OK:');
   writeln(s);
   writeln;

   s1 := '2.17'; s2 := '9.19';
   s := s.Join(',',[s1,s2]);
   write('OK:');
   writeln(s);
   writeln;

   //文字列以外の型だとうまく出力できないようです。
   //空文字が出力されます。
   a := 2.17; b := 9.19;
   s := s.Join(',',[a,b]);
   write('NG');
   writeln(s);
   writeln;


   //オーバーロードの2つ目
   //文字列配列の結合開始位置(0基数)と数を指定
   //この例では、ニーナ,ベルト・サタンと表示します。
   //文字列配列作成の為にとりあえず分割
   s := 'ドッペ,パックン,ニーナ,ベルト・サタン,キノッピー';
   elm := s.Split([',']);
   writeln('overload2:開始位置と数を指定');
   writeln('元の文字列配列');
   for s1 in elm do
   begin
     writeln(s1);
   end;
   writeln('0基数で2番目の文字列から2個の文字列を結合');
   s := s.Join(',',elm,2,2);
   writeln(s);
   writeln;

   readln;



  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


実行結果は

です。

2012年9月10日月曜日

Splitのオーバーロード

Delphi XE3のオーバーロードを試してみた。
各オーバーロードの内容はプログラム中のコメントに
記載しました。

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s,s1 : string;
  elm : TArray;
  elm2 : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper
   s := 'ドッペ,パックン,ニーナ,,ベルト・サタン,,キノッピー';
   //Writeln(s);

   //カンマで分割
   //オーバーロードの1つ目、第二引数に正の整数を入れると
   //先頭から指定した個数だけ分割します。
   //分割できる数以上の数を指定すると無視します。
   //この場合は、ドッペとパックンだけを切り出します。
   elm := s.Split([','],2);
   write('overload1:');writeln(s);
   //分割した要素を表示
   for s1 in elm do
   begin
     writeln(s1);
   end;

   writeln;

   //結合(念のため文字列を初期化)
   //s := '';
   //Writeln(s);

   //s := s.Join(',',elm);
   //Writeln(s);


   //オーバーロードの2つ目、第二引数に
   //TStringSplitOptions.ExcludeEmptyを指定すると
   //空文字を無視して切り出します。
   //TStringSplitOptionsを指定しない場合、あるいは
   //TStringSplitOptions.Noneを指定した場合は
   //空文字も1つとして切り出します。
   elm2 := s.Split([','],TStringSplitOptions.None);
   write('overload2-1:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;

   elm2 := s.Split([','],TStringSplitOptions.ExcludeEmpty);
   write('overload2-2:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   //オーバーロードの3つ目、第二引数に正の整数を入れると
   //先頭から指定した個数だけ分割します。
   //このときTStringSplitOptions.ExcludeEmptyを指定すると
   //空文字を無視して切り出します。
   //TStringSplitOptionsを指定しない場合、あるいは
   //TStringSplitOptions.Noneを指定した場合は
   //空文字も1つとして切り出します。
   //この場合はベルト・サタンも切り出します。
   elm2 := s.Split([','],4,TStringSplitOptions.ExcludeEmpty);
   write('overload3:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;

   //オーバーロードの4つ目、セパレータに文字列を指定する
   //こともできます。
   //この場合は、ドッペ,パッと,ニーナ,,ベルト・サタン,,キノッピー
   //に分割されます。
   //(セパレータにCRLFを指定することが可能です。)
   elm2 := s.Split(['クン'],TStringSplitOptions.None);
   write('overload4:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   //オーバーロードの5つ目、セパレータに文字列を指定したうえで
   //分割した結果を取り出すことも可能です。
   //この場合は、ドッペ,パッだけを取り出します。
   //に分割されます。
   elm2 := s.Split(['クン'],1,TStringSplitOptions.None);
   write('overload5:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   readln;


  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

で実際に実行した結果のビットマップが


です。

追伸:サンプルに使用した文字列がマイナーすぎたようなので、ちょっとだけわかりやすい
ものにしました。

2012年9月5日水曜日

SplitとJoin

Delphi XE3で新たに導入されたStringHelperを使ってみた。 使ったのはJoinとSplit。
それぞれ一番簡単な呼び出し形式です。
以下、プログラム



unit Unit1;
program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s : string;
  elm : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper
   s := 'キャサリン,さをり,ツネアキ,ハゲミーナ,ヒデオ';
   Writeln(s);

   //カンマで分割
   elm := s.Split([',']);

   //分割した要素を表示
   for s in elm do
   begin
     writeln(s);
   end;

   //結合(念のため文字列を初期化)
   s := '';
   s := s.Join(',',elm);

   Writeln(s);
   readln;



  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

で実際に実行した結果が、

です。

2012年6月7日木曜日

DelphiでExcelブック内のシート一覧を取得し表示する(dbGo経由)

前のブログで、ExcelのTypeライブラリーを使ってシート一覧を取得しましたが
ついでといっては、なんですが、dbGo(Ado)を使って、シート一覧を取得してみます。

TAdoQueryを使ってSQL文で、テーブル一覧を取得できないか、ちょっと調べたましたが
無理そうだったので、ここでは、

TADOConnection.OpenSchema (
         const Schema: TSchemaInfo;  
        const Restrictions: OleVariant;
         const SchemaID: OleVariant;
                 DataSet: TADODataSet);

メソッドを使ってテーブルを取得します。

方法は、簡単で、

OpenSchema関数のパラメータ

     Schemaに TSchemaInfo.siTables
     DataSetに スキーマ取得結果の書き込み先のレコードセットを指定します。

      
     また、今回は、RestrictionsとSchemaIDは使用しませんのでEmptyParamを指定します。


さて、やってみます。

フォームにTADOConnectionを配置し、ConnectionStringの

   ProviderにMicrosoft.ACE.OLEDB.12.0
   Data SourceにExcelのワークブックのパス
   Extended PropertiesにExcel 12.0(Excel2010の場合)

を指定します。

(ConnectionStringについては、http://connectionstrings.com/ が参考になります。)


次に結果格納先としての TADODataSetコンポーネントを配置し、Connectionプロパティに
上記の TADOConnectionコンポーネントを指定します。

あとは、通常の操作で、DataSource,DbGridを配置し、それぞれ接続します。

あとはボタンなどを配置しそのイベントハンドラに

  ADOConnection1.Connected := true;
  ADOConnection1.OpenSchema(siTables, EmptyParam, EmptyParam,ADODataSet1);
 

のようなコードを書きます。

で実行すれば、





のように結果が得られます(右側)

 
 
なお、torry's Delphiのページにもうちょっと詳しいサンプルがあります。http://www.swissdelphicenter.ch/torry/showcode.php?id=1433

また、AdoでのExcelのSchema,については、MSのHELP
http://support.microsoft.com/kb/257819/ja


が参考になります。

2012年6月3日日曜日

DelphiでExcelブック内のシート一覧を取得し表示する

先日、DelphiでExcelのWorkSheetを列挙しながらSheetを編集する処理を作成したとき、
思いもよらずはまったので、自分メモとして保存。

DelphiからExcelを操作する方法としては、

  1. Excelのタイプライブラリーをインポート
  2. dbGoを使用する
  3. サードパーティのコンポーネントを使用する
  4. ・・・
などの方法があげらるが、

今回は、1.タイプタイプライブラリーをインポートしてExcelを操作しシート名を一覧表示する
処理をつかった。

以下、ソース

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Excel_TLB,System.Win.ComObj;
const
  LCID = LOCALE_SYSTEM_DEFAULT;


procedure TForm1.Button1Click(Sender: TObject);
Var
  ExcelApp : Excel_TLB.ExcelApplication;
  ExcelBook : Excel_TLB.ExcelWorkbook;
  ExcelSheet : Excel_TLB.ExcelWorksheet;
  BookPath : String;
  i : integer;
begin
  ListBox1.Clear;
  ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;
  ExcelApp.DisplayAlerts[LCID] := false;

  BookPath := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test.xlsx';

  ExcelBook := ExcelApp.Workbooks.Add(BookPath, LCID);

  (* このように書きたいが
    'GetEnumerator' のメンバが含まれていないかアクセスできないため)
      通常では使用不可   
  for  ExcelSheet in  ExcelBook.Worksheets do
  begin
     ListBox1.Items.Add(ExcelSheet.Name);
  end;
  *)


  // Excelのコレクションは1基数なので1からカウントを始める。
  for i := 1 to ExcelBook.Worksheets.Count do
  begin
    ExcelSheet := ExcelBook.Worksheets.Item[i] As  Excel_TLB.ExcelWorksheet;
    ListBox1.Items.Add(ExcelSheet.Name);
  end;

  ExcelSheet := nil;
  ExcelBook.Close(false,BookPath,false,LCID);
  ExcelBook := nil;

  if Assigned(ExcelApp) then
  begin
    ExcelApp.Quit;
    ExcelApp := nil;
  end;


end;

end. 
for ~ in doの構文が使えると、基数のこと意識しなくても良いが、コンパイルすると

 E2431 for-in ステートメントはコレクション型 'Sheets' で動作できません('Sheets' に 'GetEnumerator' のメンバが含まれていないかアクセスできないため)

のメッセージが、出てEXEが作れないため、従来のfor文で列挙している。

  Excelのコレクションが1基数なので、for 文は、1からシート数まででにしていのが
 ポイントです。(ポイントというもののものではありませんが・・・)

 まあ、Excelに限らず、Win32版のVisual Basic(VB6,VB5)とか、VBAのコレクションInterface
 は基本1基数なのですが・・・

 下図のようなブックに対して





 上のような処理を実行すると

 のような結果がえられます。


以下は、余談ですが、

自分 、Excelのコレクションが1基数だということをすっかり忘れていて、結果、午前中つぶしちゃいました。