☆PortableApps Platformに登録する。

今度、某勉強会でUSBメモリの活用方法について話をすることになったので、いろいろ調べている内にPortableApps.comに辿り着きました。 みなさん既にご存知かも知れませんがFirefoxやOpenOfficeのPortable版が用意されており、簡単にインストールできます。 又、専用のメニューからアクセスできて、とても便利です。

ならば自作アプリもこのメニューから利用してみようと思い、試してみました。 フォルダ構成等きちんとした決め事があるのかも知れませんが、動作さえすればOKな私は、 次のような処理でメニューから利用することにしました。

まず、次のようなフォルダを作成します。
[USBDrive名]:\PortableApps\[自作アプリ名]

そのフォルダにファイルをコピーし、実行してみました。きちんとメニューに表示されます。
(ファイル名:project1.exe、製品名:なし)

Portableapps1



実行ファイル名を日本語にして試してみました。今度は拡張子まで表示されています。
(ファイル名:アプリケーション.exe、製品名:なし)

Portableapps2



試しにバージョン情報の製品名に入力してみました。

Portableapps4



実行してみると、きちんと表示されました。
(ファイル名:project1.exe、製品名:アプリケーション) 

Portableapps3



ということで、結局、製品名が表示されているようです。
自作以外のアプリケーションを登録する場合には、単純に起動させるプログラムを作ってそこに製品名を登録しておけば、好きな名前で表示できますね。

※本当は設定ファイルとかで簡単にできるのかも??


Portable Apps.com
http://portableapps.com/

|

☆Docuworksで「ファイル名に日付を付加する」プラグイン

Docuworksは、設定すればスキャン時に日時をファイル名に自動的に付加してくれますが、 印刷した場合等には自分で付ける必要があります。(と思います。)
そこで、作成日時か最終更新日時の内、古い方の日時をファイル名に付加する機能を 持つプラグインを作ってみます。(実は仕事で必要だったりします。)

前回のプラグインのコードと同様なので、PLG_ExecuteCommand関数のみ書きますね。
// ExecuteCommand Entry
function PLG_ExecuteCommand(pPlgStruct: PLUGGEDIN_STRUCT): LongInt; stdcall;

  function GetFileDateTime(const FileName: String; var CreateYMD, LastWriteYMD,
    LastAccessYMD: TDateTime): Boolean;
  var
    Handle: Integer;
    Time1, Time2, Time3: TFILETIME;
    SysTime: TSYSTEMTIME;
    SECURITYATTRIBUTES: TSECURITYATTRIBUTES;
  begin
    Result := False;
    with SECURITYATTRIBUTES do
    begin
      nLength := SizeOf(TSECURITYATTRIBUTES);
      lpSecurityDescriptor := nil;
      bInheritHandle := False;
    end;

    Handle := CreateFile(PChar(FileName),GENERIC_READ,0,@SECURITYATTRIBUTES,
                          OPEN_EXISTING,FILE_ATTRIBUTE_READONLY,0);

    if Handle = 0 then Exit;
    try
      GetFileTime(Handle, @Time1, @Time2, @Time3);

      FileTimeToLocalFileTime(Time1,Time1);
      FileTimeToSystemTime(Time1, SysTime);
      CreateYMD := SystemTimeToDateTime(SysTime);

      FileTimeToLocalFileTime(Time2,Time2);
      FileTimeToSystemTime(Time2, SysTime);
      LastAccessYMD := SystemTimeToDateTime(SysTime);

      FileTimeToLocalFileTime(Time3,Time3);
      FileTimeToSystemTime(Time3, SysTime);
      LastWriteYMD := SystemTimeToDateTime(SysTime);

      Result := True;
    finally
      CloseHandle(Handle);
    end;
  end;

var
  I: Integer;
  S: String;
  InputFile: String;
  CreateYMD, LastWriteYMD, LastAccessYMD: TDateTime;
begin
  S := '';
  for I := 0 to pPlgStruct^.ps_nFiles-1 do
  begin
    InputFile := pPlgStruct^.ps_pszFiles^[I];
    if GetFileDateTime(InputFile, CreateYMD, LastWriteYMD, LastAccessYMD) then
    begin
      if CreateYMD <= LastWriteYMD then
        S := FormatDateTime('yyyymmdd', CreateYMD)
      else
        S := FormatDateTime('yyyymmdd', LastWriteYMD);
      S := ExtractFilePath(InputFile) + S + ExtractFileName(InputFile);
      RenameFile(InputFile, S);
    end;
  end;
  Result := 1;
end;

上記のコードで、きちんとファイル名を修正してくれるのですが、Docuworks Deskでのファイル位置が 一番最後に移動してしまいます。DocuworksのAPIには、ファイル名の変更をするものがなさそうなので、 解決できずにいます。メッセージでメニューとクリップボードを使って処理する方法もありますが、 スマートじゃないですよね。

|

☆特殊フォルダのパス名を取得する。

SHGetFolderPathを使って特殊フォルダのパス名を取得してみます。
この関数は、SHFolder名前空間に定義されていますが、なぜか第4パラメーターdwFlagsのフラグが定義されていません。 又、SHFolder.dllからの呼び出しになっていますが、MSDNによると現在は、shell32.dllで実装されているとのことです。 但し、下位互換のためSHFolder.dllは含まれているとのことで特に問題はなさそうです。

下記のコードでMy Documentsフォルダが取得できました。
uses SHFolder;

const
  // dwFlags用フラグ
  SHGFP_TYPE_CURRENT = 0;
  SHGFP_TYPE_DEFAULT = 1;

procedure TForm1.Button1Click(Sender: TObject);
var
  Path: String;
begin
  SetLength(Path, MAX_PATH);
  if Succeeded(SHGetFolderPath(0, CSIDL_PERSONAL, 0,
    SHGFP_TYPE_CURRENT,PChar(Path))) then
  begin
    SetLength(Path, Pred(Pos(#0, Path)));
    ShowMessage(Path);
  end;
end;



MSDN
SHGetFolderPath Function
http://msdn2.microsoft.com/en-us/library/bb762181.aspx

|

☆ファイルを扱うときのテンプレート?

ファイルを開いたり、保存したりという処理の中で、ファイルの内容が変更されている場合は、その処理をユーザーに選択させますよね。 今回、その一連の流れをまとめてみました。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList;

type
  TForm1 = class(TForm)
    ActionList1: TActionList;
    acNew: TAction;
    acSaveAs: TAction;
    acOpen: TAction;
    acSave: TAction;
    procedure FormCreate(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acOpenExecute(Sender: TObject);
    procedure acSaveAsExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure acSaveExecute(Sender: TObject);
  private
    FN: String;        // 作業中のファイル名
    Modified: Boolean; // データが更新されたときにTrueに設定する。
    function ConfirmingDialog : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 現在作業中のファイルをどうするのかをユーザーに示して処理させます。
function TForm1.ConfirmingDialog : Boolean;
var
  I: Integer;
begin
  Result := True;
  if not Modified then Exit;

  Result := False;

  // 現在のデータが変更されている場合の確認
  I := MessageDlg(Format('%sは変更されています。保存しますか?', [FN]),
          mtConfirmation, [mbYes, mbNo, mbCancel], 0);

  case I of
    id_Yes: begin
              acSaveExecute(Self);
              if Modified then Exit; // 保存されなかった場合
            end;
    id_Cancel: Exit;
    id_No: ;  // id_Noは保存しないという選択なので処理不要です。
  end;
  Modified := False;
  Result := True;
end;



// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
begin
  FN := '';
  Modified := False;
end;



// 新規作成
procedure TForm1.acNewExecute(Sender: TObject);
begin
  if not ConfirmingDialog then Exit;
  FN := '';
  { 処理 }
end;



// 開く
procedure TForm1.acOpenExecute(Sender: TObject);
begin
  if not ConfirmingDialog then Exit;
  FN := '開いたファイル名';
  { 処理 }
end;



// 名前を付けて保存
procedure TForm1.acSaveAsExecute(Sender: TObject);
begin
  if not ConfirmingDialog then Exit;
  FN := '名前を付けたファイル名';
  { 処理 }
end;



// 保存
procedure TForm1.acSaveExecute(Sender: TObject);
begin
  if FN = '' then
  begin
    acSaveAsExecute(Self);
    Exit;
  end;

  { 処理 }
  Modified := False;
end;



// 終了してもよいかどうか
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := ConfirmingDialog;
end;

end.



確認ダイアログが表示されるかどうか確かめるために、次の処理をします。
procedure TForm1.Button1Click(Sender: TObject);
begin
  Modified := True;
  Close;
end;


よく見るこんなダイアログです。

Save

デフォルトのファイル名が空白のため、ファイル名部分が表示されていませんが、 実際のアプリケーションでは「Untitled」や「無題」を設定しています。

|

その他のカテゴリー

ADO | ADT | API | ArrayList | ASP.NET | BDE | BDP.NET | BdpConnection | Borland Developer Studio 2006 | CAPICOM | class | ClipBoard | CodeEditor | Convert.ToString | Custom component | DBExpress | Delphi 2005 | Delphi 2006 | Delphi 2007 | Delphi XE2 | Delphi7 | Delphi8 | Device Driver | Dialog | Docking | DocuWorks | Docuworks SDK | Drag&Drop | Evernote | EXCEL | Firebird | FireMonkey | Game | General | Generics | Google Earth COM API | Google Maps | Google SketchUp | Graphic | IDE | Imm | Indy | InstallAware Express6 | InterBase Admin | JWW | Microsoft SQL Server | MyBase | OnMouseDown | Oracle XE | Paradox | PreviewHandler | PrintDialog | PrintPreviewDialog | PropertyGrid | PSDファイル | Ribbon Controls | RichTextBox | Servers | SubClass | TAction | TActionList | TAnimate | TButton | TCategoryButtons | TClientDataSet | TComboBox | TComboBoxEx | TCustomEdit | TDBGrid | TDockTabSet | TDrawGrid | TEdit | TExcelApplication | TFont | TForm | third party | TImage | TLabel | TList | TListBox | TListView | TMemo | TOpenDialog | TOutlookApplication | TPageControl | TPanel | TRichEdit | TShellResources | TStringGrid | TTabControl | TToolBar | TToolButton | TTreeView | TWebBrowser | Update | VCL Styles | WinInet | XE2 | XPman | オープン配列パラメータ | グループ化 | トランスレーションマネージャー | ファイル処理 | ファイル名処理 | 動的配列 | 投票 | 文字列処理 | 日本語入力 | 暗号 | | 音声合成利用