FMX事始め

１．FMXでMessageDialogを表示する
２．TMsgDlgTypeに指定できる値はVCLと同じ
３．表示できるボタン
４．表示できないボタン
５．ダイアログ右上の閉じるボタンの挙動
６．まとめ
７．お願いとお断り

１．FMXでMessageDialogを表示する

いろいろな事情からFMXプラットフォームで、あるプログラムを書くことになった。使い慣れたVCLと違って、FireMonkeyはずっと以前に一度だけWAVファイルの再生プログラムを作った時触れたことがあるだけで、まともに触るのは今回が初めて。

最初にいちばん困ったのはユーザーへのメッセージの出し方。なんでかわからないけれど、普通にShowMessageすると、その直後、FMXプラットフォームでは、結構な頻度でエラーが発生する気が･･･。

だから、最初に書いたデータベース接続のプログラムは、極力ShowMessageを使わない方向で書いたんだけど、２作目のテキスト入力練習プログラムではそうも行かず、良い機会だと思ってShowMessageより見た目が華やかなMessageDialogの正しい使い方を調べてみた。

思った以上に情報が少ない気がしたので、学んだことを備忘録として、まとめておく。

まずは、ｉマーク付きのMessageDialogの出し方。

implementation

uses
  FMX.Platform, FMX.DialogService;

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  //mtConfirmationだとBeep音が鳴らないが、mtInformationだとBeep音が鳴る
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync,
    IInterface(ASyncService)) then
  begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0,
      procedure(const AResult: TModalResult)
      begin
        if AResult = mrOK then
        begin

        end;
      end);
  end;
end;

実行すると･･･

調べてわかったことは･･･

var
  ASyncService:IFMXDialogServiceASync;

･･･と宣言するためには、

uses
  FMX.Platform;

uses に FMX.Platform が必要で、さらに、サポートの有無を調査するif文の･･･

if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync,
    IInterface(ASyncService)) then

TPlatformServices も FMX.Platform を参照している。

で、本命の MessageDialog を表示するには、さらに･･･

uses
  FMX.Platform, FMX.DialogService;

uses に FMX.DialogService も追加しなければならない。

２．TMsgDlgTypeに指定できる値はVCLと同じ

上のユーザーへの情報提供（Info）に加えて、ユーザーに確認する場合は、

TMsgDlgType.mtConfirmation

ユーザーに警告。

TMsgDlgType.mtWarning

ユーザーにエラーを報告。

TMsgDlgType.mtError

mtCustomってのもあったけど･･･

TMsgDlgType.mtCustom

実質、「情報提供・確認・警告・エラー」の４つ型があり、これはVCLと変わらない。

３．表示できるボタン

ユーザーの応答が「OKボタン押し下げのみ」であれば、MessageDialogの最後の引数を別手続きにして、それを呼び出す形にすればいいのかと･･･

  private
    { private 宣言 }
    procedure MsgDlgProc(const AResult: TModalResult);

として、Shift＋Ctrl＋Cで手続きを作成。

procedure TForm1.MsgDlgProc(const AResult: TModalResult);
begin
  //何もしない手続き

end;

応答が「OK」のみの場合は、これを呼び出し。

procedure TForm1.Button2Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation, 
      [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, MsgDlgProc);
  end;
end;

コードが短くなって、なんとなくすっきりした。

でも、「はい」・「いいえ」・「キャンセル」のようにボタンを複数表示するとそうもいかない。

procedure TForm1.Button3Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
  begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbYes, 0,
      procedure(const AResult: TModalResult)
      begin
        if AResult = mrYes then
        begin
          ShowMessage('Goooooooood!');
        end;
        if AResult = mrNo then
        begin
          ShowMessage('No Good!');
        end;
        if AResult = mrCancel then
        begin
          ShowMessage('Cancel');
        end;
      end);
  end;
end;

case文でもよいようだ。

procedure TForm1.Button3Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
  begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbYes, 0,
      procedure(const AResult: TModalResult)
      begin
        case AResult of
          mrYes:ShowMessage('Goooooooood!');
          mrNo:ShowMessage('No Good!');
          mrCancel:ShowMessage('Cancel');
        end;
      end);
  end;
end;

caseのリストが表す値は、case文内で一意、部分範囲またはリストの重複がなければ昇順とかリストの並びは関係ないようだ。また、このようによく使用されるボタン値は、セットになった定数として用意されていて、例えば上の場合は次のように指定できる。

TMsgDlgType.mtInformation, mbYesNoCancel, TMsgDlgBtn.mbYes, 0,

embarcaderoさんのWebサイトでは、TMsgDlgBtnは種類がたくさん紹介されていて、

定数	値	意味
mrNone	0	結果なし。ユーザーがフォームを終了するまでのデフォルト値として使用されます。
mrOk	idOK = 1	ユーザーは［OK］ボタンでフォームを終了しました。
mrCancel	idCancel = 2	ユーザーは［キャンセル］ボタンでフォームを終了しました。
mrAbort	idAbort = 3	ユーザーは［中止］ボタンでフォームを終了しました。
mrRetry	idRetry = 4	ユーザーは［再試行］ボタンでフォームを終了しました。
mrIgnore	idIgnore = 5	ユーザーは［無視］ボタンでフォームを終了しました。
mrYes	idYes = 6	ユーザーは［はい］ボタンでフォームを終了しました。
mrNo	idNo = 7	ユーザーは［いいえ］ボタンでフォームを終了しました。
mrClose	idClose = 8	ユーザーは［閉じる］ボタンでフォームを終了しました。
mrHelp	idHelp = 9	ユーザーは［ヘルプ］ボタンでフォームを終了しました。
mrTryAgain	idTryAgain = 10	ユーザーは［やり直し］ボタンでフォームを終了しました。
mrContinue	idContinue = 11	ユーザーは［続行］ボタンでフォームを終了しました。
mrAll	mrContinue + 1（12 つまり $C）	ユーザーは［すべて］ボタンでフォームを終了しました。
mrNoToAll	mrAll + 1（13 つまり $D）	ユーザーは［すべていいえ］ボタンでフォームを終了しました。
mrYesToAll	mrNoToAll + 1（14 つまり $E）	ユーザーは［すべてはい］ボタンでフォームを終了しました。

さらに、セットになった定数が５つあるとのこと。

定数	意味
mbYesNoCancel	mbYes、mbNo、および mbCancel
mbYesAllNoAllCancel	mbYes、mbYesToAll、mbNo、mbNoToAll、および mbCancel
mbOKCancel	mbOK および mbCancel
mbAbortRetryIgnore	mbAbort、mbRetry、および mbIgnore
mbAbortIgnore	mbAbort、mbIgnore

４．表示できないボタン

僕のPCだけ、そうなのかもしれないけど。中には表示できないボタンが･･･。例えば、

procedure TForm1.Button7Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
  begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation,[TMsgDlgBtn.mbRetry],TMsgDlgBtn.mbRetry,0,
      procedure(const AResult: TModalResult)
      begin
        case AResult of
          mrOK:ShowMessage('OK!：了解');
          mrCancel:ShowMessage('Cancel：取消');
          mrAbort:ShowMessage('Abort：中止');
          mrRetry:ShowMessage('Retry：再試行');
          mrIgnore:ShowMessage('Ignore：無視');
          mrYes:ShowMessage('Yes：はい');
          mrNo:ShowMessage('No：いいえ');
          mrClose:ShowMessage('Close：閉じる');
          mrHelp:ShowMessage('Help：要援助');
          mrAll:ShowMessage('All：すべて');
          mrNoToAll:ShowMessage('NoToAll：すべていいえ');
          mrYesToAll:ShowMessage('YesToAll：すべてはい');
        else
          //ないと思うけど、
          ShowMessage(IntToStr(AResult));
        end;
      end);
  end;
end;

ボタンに mbRetry を指定しても、上の手続きを実行すると表示されたダイアログは･･･

で、OKを押し下げ。･･･ると

なんでかなー？

でも、次のように指定すると、

TMsgDlgType.mtInformation, [TMsgDlgBtn.mbCancel,TMsgDlgBtn.mbRetry]

で、「再試行(R)」を押し下げ。･･･ると

表示できる場合とできない場合があるらしい。つまり、これはダイアログに表示可能なボタンの設定（組み合わせ）を FMX の MessageDialog は内部的に持っているということ？ それから、キャンセルボタンは必ず右側へ設置される？･･･から、ボタンの表示される順番もまた、決まっているという理解でいいのかな？･･･みたいな。

他にも、mbAbortRetryIgnore を指定して、デフォルトで選択状態にするボタンに mbRetry を指定しても･･･

TMsgDlgType.mtInformation, mbAbortRetryIgnore, TMsgDlgBtn.mbRetry, 0,

しかも、ダイアログ右上の「閉じる」ボタンが押せなくなってる（勝手にEnabled？がFalseに設定されてしまう）。これは、キャンセルがないから、閉じるボタンはその必要がないという意味に思えてくる･･･。だから、閉じるボタンの無効化も、VCLならその方法が紹介されているんだけど、FMXでの情報は見当たらないのか･･･

実は、この記事を書こうと思ったのは、この閉じるボタンをクリックした時の戻り値が何なのか、どんなに調べても（僕が調べた範囲では）見つけることが出来なかったので、実験してみた結果を記録しておこうと思ったことがきっかけというか、はじまり。

FMX の MessageDialog を設計した人の気持ちがだんだん、わかってきた！

５．ダイアログ右上の閉じるボタンの挙動

実験結果から見えてきたこと。それは MessageDialog の閉じるボタンは、そのクリックの可否がダイアログに表示するボタンの組み合わせによって、内部的に制御されているんじゃないか？ってこと。

まず、OKボタンのみの場合、

procedure TForm1.Button9Click(Sender: TObject);
var
  ASyncService:IFMXDialogServiceASync;
begin
  if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
  begin
    TDialogService.MessageDialog('Do you know Delphi?',
      TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0,
      procedure(const AResult: TModalResult)
      begin
        case AResult of
          mrOK:ShowMessage('OK!：了解');
          mrCancel:ShowMessage('Cancel：取消');
          mrAbort:ShowMessage('Abort：中止');
          mrRetry:ShowMessage('Retry：再試行');
          mrIgnore:ShowMessage('Ignore：無視');
          mrYes:ShowMessage('Yes：はい');
          mrNo:ShowMessage('No：いいえ');
          mrClose:ShowMessage('Close：閉じる');
          mrHelp:ShowMessage('Help：要援助');
          mrAll:ShowMessage('All：すべて');
          mrNoToAll:ShowMessage('NoToAll：すべていいえ');
          mrYesToAll:ShowMessage('YesToAll：すべてはい');
        else
          ShowMessage(IntToStr(AResult));
        end;
      end);
  end;
end;

ダイアログ右上の「×」をクリックすると表示されたのは･･･

つまり、OKをクリックするしか、選択肢がない（未来をプログラマ自身が選択した）のだから、閉じるボタンが押された時の戻り値もmrOKでよい･･･ということか！

次に、表示するボタンを「OK」と「キャンセル」にして、デフォルト選択ボタンは「キャンセル」に指定して、再度実行。

TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbCancel, 0,

右上の「×」をクリックすると･･･

思った通り、mrCancel が設定されていた！　プログラマが「キャンセルという選択肢を未来に与えた」んだから、閉じるボタンが押された時は「キャンセル」と判断してよい･･･ということ？

デフォルト選択ボタンをOKに変えてみた･･･

TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbOK, 0,

右上の「×」をクリックすると･･･

思った通りだ。

ボタンを「はい」・「いいえ」・「キャンセル」の３つにし、デフォルト選択を「はい」に指定して実験･･･

TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbYes, 0,

右上の「×」をクリックすると･･･

やっぱり、mrCancelが戻り値に設定されている！

ならば、ボタンを「はい」・「いいえ」の２つだけにすると、閉じるボタンは使用不可になるはずだ･･･。だって、プログラマの意向として、未来に「キャンセル」という選択肢は与えられていないから！

実際に動かして確認。

TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], TMsgDlgBtn.mbYes, 0,

僕の中に生まれた予測は、ここで「確信」に変わった！

これはVCLのMessageDlgでも同じなんだろうか？
今度、実験だ。

６．まとめ

（１）OKボタンのみ設置したダイアログでは、閉じるボタンクリックでmrOKが返る。
（２）ダイアログにキャンセルボタンを設置した場合は、閉じるボタンもクリック可能。
（３）キャンセルボタンがある場合、閉じるボタンクリックで返る値はmrCancelになる。
（４）キャンセルボタンがない場合、閉じるボタンはクリックできない。
（５）ボタンの組み合わせは内部的に不可もある（不可でもエラーにはならない）。

７．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

今までのアルゴリズムで僕の矩形検出器がユーザーに提示する「次に採点する解答欄候補」の順番は、だいたい、こんなイメージ･･･

今回、ほぼ採点する順番の通りに「次の採点候補」の解答欄を赤枠で囲んでユーザーに提示できるよう、解答欄矩形の座標を採点順に並べ替えるアルゴリズムを改良。その結果、矢印キー押し下げ時の「次の採点候補とする解答欄座標」を示す赤枠矩形の動きのイメージは次のようになった。

こんな僕の書いた稚拙で、頼りないプログラムでも、喜んで使ってくださる方がいる。
こんなに重たい事実はない。

プログラムが良くなることは、きっと･･･、僕自身が良くなることだ。
そう思いつつ、遅ればせながら、矩形検出器のアルゴリズムをようやく改良できた。

（矩形検出の成功率は100％で、OpenCVの性能は最高！です）

解答用紙の様式パターンの研究がまったく足りていなかったことが今回の改良が必要になったいちばんの原因。

開発の最初の段階で、解答欄矩形を余すところなく認識出来て、舞い上がってしまった自分が、幼かったんだなー。

【もくじ】

１．僕のアルゴリズムの問題点
２．解答欄をブロック化して認識処理を実行
　【間違えポイント①：範囲を指定して画像を切り出す】
　【間違えポイント②：OpenCVのfilenameはPAnsiChar型】
３．まとめ
４．お願いとお断り

１．僕のアルゴリズムの問題点

手書き答案をスキャンして得た画像データから同一設問の解答欄のみを抽出して一覧表示し、採点後、返却用答案画像に採点結果を書き戻すプログラムを書いた。

その際、スキャンした答案画像の解答欄を自動認識する矩形検出器も作成。採点プログラムに同梱して配布。同僚に使ってもらったのだけれど･･･。

解答用紙の解答欄が複数列（？）存在するような形式の解答用紙では、問題が発生。

それは、どんな問題かと言うと･･･

例えば、次のような横書き形式の解答用紙であった場合に、Myプログラムで矩形検出を実行すると･･･

検出した矩形データ（座標群）のうち、最も左上の矩形を最初に赤枠（ラバーバンドで囲って）表示、ユーザーが解答欄であるか・どうかを判定（選択）、座標自体はMemoに数値で一覧表示してあるから ↓ 矢印キーで次の矩形へ･･･という流れで、採点に必要な解答欄座標のみを取得するように設定。

解答欄と、その座標をGUIで表示する（実際の画像）。

ところが、次のような解答用紙の場合･･･

･･･のですが、矩形検出を実行後、検出された座標群から、僕のアルゴリズムで解答欄の選択を実行すると･･･

解答欄矩形の座標自体は、確実に取得できているから、矢印キーを駆使して、採点したい向きに解答欄の座標が並ぶように、座標を選択していけばいいだけの話なんだけれど。

これが･･･

超絶。すーぱーめんどくさい！

さらに、どんなにまっすぐ解答用紙をセットしても、必ず右肩上がり（画像が左に0.05度くらい傾いた状態で）でスキャンしてくれるという、メインで使用しているスキャナーならではのヘンなクセもあり、しかも、その画像に対して「Y座標の小さい順に赤枠で囲む」という僕のアルゴリズムは「正しく」機能するから、解答欄を上から下へ、行単位では左から右へという夢見た処理の流れは完全に逆転。採点候補の解答欄は左右に飛び、行単位でも右から左へ、想定とは真逆の順番で次の採点候補矩形が延々と表示される結果に･･･。こんな状態で、提示（表示）された解答欄矩形の座標を、採点順に正しく選択することは、年配の同僚にはほぼ不可能･･･

解答欄矩形、それ自体は 100％ 正しく検出できているのですが･･･
あまりにも、こちらの気持ちを無視したプログラムの挙動を目の当たりにして･･･

責任者を出せ！って
怒鳴りたくなるんだけど･･･

ちょっと･･･、待って。

責任者。オレじゃん、
みたいな･･･

解答用紙によっては、さらに･･･

もっと･･･、発展（？）して

もぉ　T_T

２．解答欄をブロック化して認識処理を実行

どうすればいいか？

答えはひとつしかありません。そうです！

解答用紙の解答欄を、採点順になるよう「まとまりのブロック」に分けて、ブロックごとに解答欄座標の取得手続きを行えばいいのです。

これで「一部がCutされた解答欄」は、矩形として認識されないので、最後に手動で座標データを追加すれば、なんとかなります（手動設定のプログラムは期待通りに動作しているから安心だし、上の図のような特殊な解答欄は最後の方にある場合が多い）。

この新方針のもとで、プログラムを見直してみると･･･

もともとのアルゴリズムは画像全体を１ブロックとして扱って、解答欄の矩形座標を検出しているから･･･

procedure TForm1.btnGetSquareClick(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する -> グローバル変数化
  //strAnsList:TStringList;
  //Sort
  i,j:integer;
  //strFileName:string;
  strList:TStringList;
begin

  //画像分割処理なし（初期状態）

  //初期化
  Memo1.Clear;
  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try
    //Python Script
    strScrList.Add('import cv2');
    strScrList.Add('import numpy as np');
    strScrList.Add('from PIL import Image');
    //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
    //strScrList.Add('img = cv2.imread(r"'+StatusBar1.SimpleText+'")');
    strScrList.Add('pil_img = Image.open(r"'+StatusBar1.SimpleText+'")');
    strScrList.Add('img = np.array(pil_img)');
    strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
    strScrList.Add('gray = 255 - gray');
    strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
    strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
    strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
    strScrList.Add('for i in range(len(contours)):');
    strScrList.Add('    im_con = img.copy()');
    strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
    strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //「０による浮動小数点数除算」のエラーを出ないようにするおまじない
    MaskFPUExceptions(True);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;

end;

･･･という感じで、かなりシンプル！

このあと、横書き・縦書きという解答欄の書き方に応じて、解答欄座標の並べ替えを行っている。どちらかというと、解答欄矩形の検出作業はOpenCVにおまかせで、並べ替えのアルゴリズムの方を工夫した記憶が･･･。

とりあえず･･･

横書き解答用紙が選択された時のみ、解答欄を何ブロックに分割して処理するか、GUIで選択できるようにして･･･

ブロック数分Loopを廻す中で、OpenCVのcvSetImageROI関数を用いて答案画像を分割、結果を一時Memoに書き込んで、２ブロック以降の座標値に対しては、そのｘ座標を答案画像上での値に修正（←実はコレを忘れていて、動作確認の際 ？？？ なことになり、初めて取得した座標値の修正作業の必要性に気づく）、で、最後に採点する順番になるよう座標を並べ替えてユーザーに提示する準備を実行。さらに、横書き解答用紙の場合は、一時Memoから座標データ提示用Memoへデータを移動して終了。･･･みたいな手続きのカタチにプログラムを半日程度かけて修正。

【間違えポイント①：範囲を指定して画像を切り出す】

cvSetImageROI関数の使い方は、その内部に入れてるcvRect関数の第１引数が切り出し位置の左上ｘ座標、第２引数が切り出し位置左上のｙ座標、第３引数が切り出す幅、第４引数が切り出す高さとなっている。

最初、よく考えずにcvRect関数の第３、４引数を切り出し位置右下のｘ、ｙ座標だと思い込んで設定し、切り出した画像の幅が変化することから、設定の誤りに気づく。前にマークシートリーダーを開発した時（Python環境を導入する前の段階で）、Windows用のOpenCVで画像処理していたときに、この関数のお世話になったはずなんだけど、もぉすっかり忘れてしまっていたようです。

  //指定範囲の画像を切り出して保存
  //cvRect(x, y, Width, Height)
  cvSetImageROI(sourceImage, cvRect(top_x, top_y, xWidth, yHeight));

【間違えポイント②：OpenCVのfilenameはPAnsiChar型】

それから、画像データへのPathとファイル名を入れる変数p1が PAnsiChar 型であることを、こちらもすっかり忘れていて、String型で引数を指定してエラーになって初めてそれを思い出す。変数に値を代入する際、いったん AnsiString 型でキャストして更に PAnsiChar でキャスト。

  //画像データのファイル名
  p1:PAnsiChar;

begin

  ･･･

  //String 型の文字列を PAnsiChar 型の文字列に変換
  //AnsiString 型でキャストして更に PAnsiChar でキャスト
  p1:=PAnsiChar(AnsiString('CutImage0'+IntToStr(i)+'.jpg'));

  //画像を保存する
  cvSaveImage(p1, sourceImage);

  ･･･

end;

完成した手続きがこちら（変数名等は思いつくまま、意図した通りに動けば 可 とした）

procedure TForm1.btnGetSquareClick(Sender: TObject);
var
  //PythonのScriptを入れる
  strScrList:TStringList;
  //Pythonから送られたデータを保存する -> グローバル変数化
  //strAnsList:TStringList;
  //Sort
  i,j:integer;
  //strFileName:string;
  strList:TStringList;

  //画像の等幅分割
  //切り出し領域
  top_x, top_y:integer;
  yHeight:integer;
  //xの増分
  xWidth, iMax:integer;
  //for Imageの読み込み
  sourceImage: PIplImage;
  //画像データのファイル名
  p1:PAnsiChar;

  //x座標の補正
  str1, str2, str3, str4:string;

begin

  //画像分割処理なし（初期状態）
  {
  //初期化
  Memo1.Clear;
  //Scriptを入れるStringList
  strScrList:=TStringList.Create;
  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  try
    //Python Script
    strScrList.Add('import cv2');
    strScrList.Add('import numpy as np');
    strScrList.Add('from PIL import Image');
    //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
    //strScrList.Add('img = cv2.imread(r"'+StatusBar1.SimpleText+'")');
    strScrList.Add('pil_img = Image.open(r"'+StatusBar1.SimpleText+'")');
    strScrList.Add('img = np.array(pil_img)');
    strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
    strScrList.Add('gray = 255 - gray');
    strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
    strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
    strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
    strScrList.Add('for i in range(len(contours)):');
    strScrList.Add('    im_con = img.copy()');
    strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
    strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
    //Scriptを表示
    Memo1.Lines.Assign(strScrList);
    //「０による浮動小数点数除算」のエラーを出ないようにするおまじない
    MaskFPUExceptions(True);
    //Execute
    PythonEngine1.ExecStrings(Memo1.Lines);
    //結果を表示
    Memo2.Lines.Assign(strAnsList);
  finally
    //StringListの解放
    strAnsList.Free;
    strScrList.Free;
  end;
  }

  //画像分割処理ここから

  //初期化
  //Memo1.Clear;
  Memo2.Clear;
  MemoTemp.Clear;

  //初期化（定数的に利用する）
  top_y:=0;

  //分割数
  iMax:=StrToInt(cmbPartition.Text);

  //結果を保存するStringList
  strAnsList:=TStringList.Create;

  //初期化
  xWidth:=0;

  try

    for i := 0 to iMax-1 do
    begin

      //画像を読み込む(Bitmap・JPEGどちらも読み込み可能)
      p1:=PAnsiChar(AnsiString(StatusBar1.SimpleText));
      sourceImage := cvLoadImage(p1, CV_LOAD_IMAGE_ANYDEPTH or CV_LOAD_IMAGE_ANYCOLOR);

      //intとTruncは小数点以下を切り捨て。異なるのは、戻り値がintは実数、Truncは整数になること
      xWidth:=Trunc(SimpleRoundTo(sourceImage.Width/iMax,0));
      yHeight:=sourceImage.Height;

      //切り出す座標を指定
      top_x:= xWidth * i;

      try

        //指定範囲の画像を切り出して保存
        //cvRect(x, y, Width, Height)
        cvSetImageROI(sourceImage,cvRect(top_x, top_y, xWidth, yHeight));

        //String 型の文字列を PAnsiChar 型の文字列に変換
        //AnsiString 型でキャストして更に PAnsiChar でキャスト
        p1:=PAnsiChar(AnsiString('CutImage0'+IntToStr(i)+'.jpg'));
        //画像を保存する
        cvSaveImage(p1, sourceImage);

      finally
        //イメージの解放
        cvReleaseImage(sourceImage);
      end;

    end;

    for i := 0 to iMax-1 do
    begin

      //Scriptを入れるStringList
      strScrList:=TStringList.Create;

      //x座標の補正値を計算
      top_x:= xWidth * i;

      try
        //Python Script
        strScrList.Add('import cv2');
        strScrList.Add('import numpy as np');
        strScrList.Add('from PIL import Image');
        //strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
        //strScrList.Add('img = cv2.imread(r"'+StatusBar1.SimpleText+'")');
        //strScrList.Add('pil_img = Image.open(r"'+StatusBar1.SimpleText+'")');
        strScrList.Add('pil_img = Image.open(r"'+'CutImage0'+IntToStr(i)+'.jpg'+'")');
        strScrList.Add('img = np.array(pil_img)');
        strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
        strScrList.Add('gray = 255 - gray');
        strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
        strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
        strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
        strScrList.Add('for i in range(len(contours)):');
        strScrList.Add('    im_con = img.copy()');
        strScrList.Add('    x, y, w, h = cv2.boundingRect(contours[i])');
        strScrList.Add('    var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
        //Scriptを表示
        Memo1.Clear;
        Memo1.Lines.Assign(strScrList);
        //「０による浮動小数点数除算」のエラーを出ないようにするおまじない
        MaskFPUExceptions(True);
        //Execute
        PythonEngine1.ExecStrings(Memo1.Lines);
        //結果を表示
        if RadioButton1.Checked then
        begin
          //x座標を補正する
          MemoTemp.Lines.Assign(strAnsList);
          if i<>0 then
          begin
            for j := 0 to MemoTemp.Lines.Count-1 do
            begin
              //値を取得
              str1:=GetTokenIndex(MemoTemp.Lines[j],',',0);
              str2:=GetTokenIndex(MemoTemp.Lines[j],',',1);
              str3:=GetTokenIndex(MemoTemp.Lines[j],',',2);
              str4:=GetTokenIndex(MemoTemp.Lines[j],',',3);
              //カンマ区切りの文字列の1,3番目にtop_x値を加える（座標を修正）
              str1:=IntToStr(StrToInt(str1)+top_x);
              str3:=IntToStr(StrToInt(str3)+top_x);
              //書き戻し
              MemoTemp.Lines[j]:=str1+','+str2+','+str3+','+str4;
            end;
          end;
        end else begin
          Memo2.Lines.Assign(strAnsList);
        end;
      finally
        //StringListの解放
        //strAnsList.Free;
        strAnsList.Clear;
        strScrList.Free;
      end;

      //横書きの場合のみ実行
      if RadioButton1.Checked then
      begin

        //strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
        //MemoTemp.Lines.SaveToFile(strFileName);

        strList := TStringList.Create;
        try
          for j := 0 to MemoTemp.Lines.Count-1 do
          begin
            strList.Add(MemoTemp.Lines[j]);
          end;
          //並び替え 降順 -> True
          //if RadioButton1.Checked then
          //begin
            fAscending := False;
            fIndex := 1; //２番目の項目を
            fStyle := ssInteger; //整数型でソート
            strList.CustomSort(MyCustomSort); //ソート開始
          //end else begin
          //  fAscending := True;
          //  fIndex := 0; //１番目の項目を
          //  fStyle := ssInteger; //整数型でソート
          //  strList.CustomSort(MyCustomSort); //ソート開始
          //end;

          //データ抽出
          //Memo2.Clear;
          for j := 0 to strList.Count - 1 do
          begin
            Memo2.Lines.Add(strList[j]);
          end;
        finally
          MemoTemp.Clear;
          strList.Free;
        end;
      end;
    end;

  finally
    //StringListの解放
    strAnsList.Free;
  end;

  //画像分割処理ここまで

  //縦書きの場合のみ実行
  if RadioButton2.Checked then
  begin

    //strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
    //Memo2.Lines.SaveToFile(strFileName);

    strList := TStringList.Create;
    try
      for i := 0 to Memo2.Lines.Count-1 do
      begin
        strList.Add(Memo2.Lines[i]);
      end;
      //並び替え 降順 -> True
      //if RadioButton2.Checked then
      //begin
      //  fAscending := False;
      //  fIndex := 1; //２番目の項目を
      //  fStyle := ssInteger; //整数型でソート
      //  strList.CustomSort(MyCustomSort); //ソート開始
      //end else begin
        fAscending := True;
        fIndex := 0; //１番目の項目を
        fStyle := ssInteger; //整数型でソート
        strList.CustomSort(MyCustomSort); //ソート開始
      //end;

      //データ抽出
      Memo2.Clear;
      for i := 0 to strList.Count - 1 do
      begin
        //Memo2.Lines.Add(GetCommaText(strList.Strings[i],fIndex));
        Memo2.Lines.Add(strList[i]);
      end;
    finally
      strList.Free;
    end;

  end;

  if RadioButton2.Checked then
  begin
    ScrollBox1.HorzScrollBar.Position:=ScrollBox1.HorzScrollBar.Range;
  end else begin
    //ScrollBarが表示されていなくてもエラーにならない
    ScrollBox1.HorzScrollBar.Position:=0;
  end;

  //表示
  LBRow.Visible:=True;
  LBRow2.Visible:=True;

  //操作可能に設定
  btnOpen.Enabled:=True;
  btnSave.Enabled:=True;

  //操作不可に設定
  btnGetSquare.Enabled:=False;

  //先頭へスクロール
  Memo2.Perform(WM_VSCROLL,SB_TOP,0);

  //先頭行へ
  Memo2.SelStart:=SendMessage(Memo2.Handle, EM_LineIndex, 0, 0);
  Memo2.Perform(EM_SCROLLCARET, 0, 0);  //キャレット位置までスクロール
  Memo2.SetFocus;

  GetLinePos;

  //矩形を表示
  Memo2Click(Sender);

end;

ちなみに、最後の解答欄矩形を表示する処理は･･･

procedure TForm1.Memo2Click(Sender: TObject);
var
  i:integer;
  //x1,x2,x3,x4:integer;
  //y1,y2,y3,y4:integer;
  p1,p2:TPoint;
  //文字列切り分け///////////////////////////////////////////////////////////////
  function RemoveToken(var s:string;delimiter:string):string;
  var
    p:Integer;
  begin
    p:=Pos(delimiter,s);
    if p=0 then Result:=s
    else Result:=Copy(s,1,p-1);
    s:=Copy(s,Length(Result)+Length(delimiter)+1,Length(s));
  end;

  function GetTokenIndex(s:string;delimiter:string;index:Integer):string;
  var
    i:Integer;
  begin
    Result:='';
    for i:=0 to index do
      Result:=RemoveToken(s,delimiter);
  end;

begin

  if not EditTF then
  begin

    //座標を取得
    i:=Memo2.Perform(EM_LINEFROMCHAR, Memo2.SelStart, 0);
    //ShowMessage(IntToStr(i));

    //エラー対策
    if Memo2.Lines[i]='' then Exit;

    x1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',0));
    y1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',1));
    x2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',2));
    y2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',3));

    if Assigned(plImage1) then begin
      FreeAndNil(plImage1);
    end;

    //コンポーネントを生成し，イベントを定義し，位置を指定して画像を表示
    plImage1:=TplResizeImage.Create(Self);
    plImage1.Parent:=ScrollBox1;
    plImage1.TransEvent:=True;
    //クライアント座標をスクリーン座標へ変換
    //GetSystemMetrics(SM_CYCAPTION) -> タイトルバーの高さ
    //GetSystemMetrics(SM_CYFRAME) -> ウィンドウの枠幅
    p1.X:=x1-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1.Y:=y1-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.X:=x2-(GetSystemMetrics(SM_CYFRAME) div 2);
    p2.Y:=y2-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
    p1:=Image1.ClientToScreen(p1);
    p2:=Image1.ClientToScreen(p2);
    plImage1.SetBounds(p1.X, p1.Y, p2.X-p1.X, p2.Y-p1.Y);

    //SelectedプロパティをTrueにするとラバーバンドとグラブハンドルが表示される
    plImage1.Selected := True;
    plImage1.BringToFront;

  end;

end;

最終的に完成したコードはまわりくどくて、汚いけど、動きは期待したとおり、例えば３ブロックある解答用紙での処理は･･･

１ブロックめの最初。

このまま、下方向へ解答欄矩形の座標データを選択して、いちばん下の座標まで移動すると、次の矢印キー押し下げと同時に赤枠は２ブロックめの先頭へ移動。

２ブロックめは上の例だと２列分あるので、ちょっと処理が面倒だけど、実際の解答用紙ではこんな例はまずないので大丈夫ということにしておいて、とりあえず、いちばん下の座標まで移動したところで次の矢印キー押し下げ、同時に赤枠は３ブロックめの先頭へ移動。

で、３ブロックめの解答欄矩形も余すところなく、選択。実に、イイかんじ。

コレだ！　コレだ！！
コレを実現したかったんだ☆

やったー！！
できた！！！

３．まとめ

複数ブロックからなる解答用紙の解答欄矩形検出は（考えてみれば当たり前ですが）、次のように処理するとうまく行きます。

（１）解答用紙の画像を予め複数ブロックに分割して別画像として保存
（２）それぞれのブロックごとに解答欄の矩形を検出＆採点する順番に並べ替え
（３）ブロックごとに取得した座標値を解答用紙画像全体の中での座標値に変換
（４）全座標値を結合して定義ファイル等に保存

今回は、上の（３）の処理を失念してプログラミングしていたので、必要だった修正は、ブロックごとの値として取得したｘ座標を、解答用紙画像全体の中でのｘ座標に変換する処理を追加するだけという、この修正わずか１回で期待したとおりに動作するプログラムを完成できました。これは僕的には極めて稀有な例で、言うのも恥ずかしい事実ですが、いつも七転八倒状態を延々と繰り返してなんとか思ったとおりの動作を実現しているので、たまにはこんなコトがあってもいいかなー。みたいな♪

４．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

･･･って言えるのかな？

正直、レジストリは汚したくない。でも、プログラムの動作に必要なユーザーの情報や設定は保存して再利用したい･･･そんな時、役立つのが定義ファイル。

今時、レジストリを使わずに定義ファイル（iniファイル）を使うなんて、完全に時代遅れなのかもしれないが、２つか、３つの設定内容を記録して利用するには、すごく便利なのは事実。ただ、ひとつだけ問題があるとすれば、exeファイルの周辺にユーザーの知らないファイルが生成されること。

【参考】
以前、この問題の解決方法として、パブリックのドキュメント（C:\Users\Public\Documents）に定義ファイル他を保存して、プログラムから利用したこともあった。それがスマートか、どうか、は別にして、それなりに目的は実現できたけど･･･なんか、どこか、すっきりしない感じが残って（毎回コレで行こう！みたいな気持ちになれなかった）。ユーザーに意識させたくない部分を意図的に「隠した」って、自分的には、どうしても思っちゃうからかなー。

今回は、その「困ったこと」を僕なりにどう解決したか？ ･･･というお話。

【目次】

１．困ったこと
２．自分的解決策はただ一つ
３．作ってみた①（全自動）
４．作ってみた②（マニュアル）
５．まとめ
６．お願いとお断り

１．困ったこと

iniファイルを使用したり、リソースに埋め込んだDLL、もしくは画像やデータベースその他のファイルをプログラムからexeの周辺に生成して利用する場合、例えばデスクトップにexeファイルを置くと、プログラムの起動と同時に、ユーザーから見て「何、コレ？」みたいなファイル（or フォルダ）が EXE の周辺に出来てしまう。

例えば、次のようにリソースに埋め込んだDLLがインストール先フォルダになければ、それを EXE のある場所に生成する場合がそうだ。

procedure TForm1.FormCreate(Sender: TObject);
var
  dllFileName:string;
begin
  //リソースからDLLを（なければ）生成
  dllFileName:=ExtractFilePath(Application.ExeName)+'XXX.dll';
  //ファイルの存在を確認
  if not FileExists(dllFilename) then
  begin
    //リソースを再生
    with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
    begin
      try
        SaveToFile(dllFileName);
      finally
        Free;
      end;
    end;
  end;
end;

プログラムを終了しても、当然、それらはexeの周辺に残っている。これらはユーザーから見れば、突然生まれた不審なファイル（or フォルダ）としか思えなくても不思議はない。

特にデスクトップにiniファイルやDLLを生成するEXEを置いた場合には、キレイ好きなユーザーから見れば、「この画面を汚すEXE、なに？」ってことにもなりかねない。

２．自分的解決策はただ一つ

ユーザーに対して、このような不安を与えないようにするなら、プログラム配布専用のインストールプログラムを作り、まず、そのリソースに配布したいプログラム（EXE）を埋め込む。で、このインストール専用のプログラムを起動したら、例えばユーザーのマイドキュメント内に適切な名前のフォルダを作成して、そこにexeをリソースから生成してコピー。最後に、そのEXEへのショートカットをデスクトップに自動的に作る･･･みたいなインストール専用のプログラム（＝Installer）を書けばいいのかな？ ･･･って。

こうしておけば、ユーザーはデスクトップのショートカットをダブルクリックするだけでプログラムを使えるし、ユーザーに見せたくないプログラムの動作に必要な情報も、その存在を隠しながら、マイドキュメント等に作った専用フォルダ内に生成できるはず。

３．作ってみた①（全自動）

予め、リソースにインストールしたい完成した配布用EXEを埋め込んでおく。DelphiのIDEの「プロジェクト」→「リソースと画像」の順にクリックして、埋め込むEXEを指定。

埋め込むEXEは、後の混乱を避ける意味でも、このインストールプログラムのプロジェクトフォルダに「Resource」等の専用フォルダを作成して、そこに完成した配布用EXEをコピーしておき、それを指定するのが方法的には Best かと。

GUIは、こんな感じで作成（実行時の画面）。

わかりやすい、とか、わかりにくい、とか、そういう問題とは別に、Enterキーひと押しで完全に動作すれば、インストールプログラムのインターフェイスの良し悪しは、特に問題にならないはず。

で、「マイドキュメントに専用～」ボタンをクリックした時の手続きは次の通り。

  private
    { Private 宣言 }
    Setup_FolderPath:string;
    Setup_ExeName:string;

implementation

{$R *.dfm}

uses
  Winapi.ShlObj, Vcl.FileCtrl, System.UITypes, plShortcutUtils;

  //ShlObjはSHGetKnownFolderPath関数を使用するために追加
  //ShellExecute関数を使用してフォルダを開いて表示する場合はWinapi.ShellAPIも追加する

  //Vcl.FileCtrlは、新しいフォルダ作成ボタン付きフォルダの選択ダイアログの表示に必要

procedure TForm1.btnAutoClick(Sender: TObject);
var
  FolderID:TGUID;
  FolderPath:PChar;
  rsFileName:string;
  LDir:String;
begin

  //マイドキュメントフォルダへのPathを取得する
  FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');
  if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
  begin
    Setup_FolderPath := FolderPath;
  end;

  //インストール先フォルダの有無を調査->なければ作成
  if not System.SysUtils.DirectoryExists(ExtractFileDir(Setup_FolderPath+'\'+Setup_ExeName+'\')) then
  begin
    //フォルダ階層を作成
    System.SysUtils.ForceDirectories(ExtractFileDir(Setup_FolderPath+
      '\'+Setup_ExeName+'\'));
  end;

  //Path
  rsFileName:=Setup_FolderPath+'\'+Setup_ExeName+'\'+Setup_ExeName+'.exe';

  //ファイルがある場合は削除
  if FileExists(rsFilename) then
  begin
　  //ファイルが存在したときの処理
    DeleteFile(rsfileName);
  end;

  //リソースを再生
  with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
  begin
    try
      SaveToFile(rsFileName);
    finally
      Free;
    end;
  end;

  //デスクトップにこのプログラムのショートカットを作成
  if CheckCreateShortCut.Checked then
  begin
    //plShortcutUtilsユニット内の関数類を使用
    //CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
    //CSIDLの値からフルパスを取得
    //ショートカットを作成する場所
    LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

    if CreateShortCutLink(rsFileName, LDir, Setup_ExeName) then begin
      //ショートカットの作成場所によっては，以下のコードで更新が必要
      //SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
    end;

    MessageDlg('Done!', mtInformation, [mbOk] , 0);
  end;

end;

ショートカットの作成方法は、Mr.XRAYさんのWebページにある方法をコピペしました。

880_ショートカットの作成と削除

http://mrxray.on.coocan.jp/Delphi/plSamples/880_CreateShortcut.htm

Private 宣言した Setup_FolderPath には、FormCreate手続きで次のようにして（初期表示のため、取り敢えず）マイドキュメントフォルダへのPathを入れておきます･･･。

procedure TForm1.FormCreate(Sender: TObject);
var
  FolderID:TGUID;
  FolderPath:PChar;
begin

  //インストールするEXEの名前
  Setup_ExeName:=EditExeName.Text;

  //マイドキュメントフォルダへのPathを取得する
  FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');

  if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
  begin
    Setup_FolderPath := FolderPath;
    EditPath.Text:= Setup_FolderPath;
  end;

end;

それから、インストールするExeの名前はForm上で非表示のGUI（EditExeName.Text）に設定しています（FormCreate時にグローバル変数に名称を読み込んで利用）。

こうしておけば、リソースに組み込むExeファイルを変更した時も、InstallするExeの名称を変更するだけで、このインストールプログラムを使えます。

設計時の画面左下に、実行時には非表示のLabelとEditコントロールを配置。このEditコントロールのTextプロパティにインストールするExeの名称を設定。

動作を検証した結果、プログラムは期待通りに動作しました。
ただ、32bitバージョンを作成した際に、実行形式ファイルを作成出来なくなるエラーが何回かありましたが･･･（原因がよくわかりません）。

４．作ってみた②（マニュアル）

もし、ユーザーが「おまかせインストール」ではなく、「フォルダを指定してインストール」の方を選択した場合の「ルートディレクトリの指定」に関する手続きは･･･

procedure TForm1.RadioGroup1Click(Sender: TObject);
var
  FolderID:TGUID;
  FolderPath:PChar;
begin

  case RadioGroup1.ItemIndex of
    0:begin
      //マイドキュメントフォルダへのPathを取得する
      FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');
      if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
      begin
        Setup_FolderPath := FolderPath;
        EditPath.Text:= Setup_FolderPath;
      end;
    end;
    1:begin
      //マイコンピュータへのPathを取得する
      Setup_FolderPath := 'C:\';
      EditPath.Text:= Setup_FolderPath;
    end;
  end;

end;

ちなみに、PCを選択した場合に表示される「フォルダーの参照」ダイアログは･･･

で、インストール先を選ぶ「変更」ボタンをクリックした際の挙動は･･･

procedure TForm1.btnGetPathClick(Sender: TObject);
var
  SelectDir: String;
begin

  case RadioGroup1.ItemIndex of
    0:begin
      //フォルダを選択 -> MyDocumentsを指定
      //if SelectDirectory('', '::' + GUIDToString(CLSID_MyDocuments), SelectDir) then

      //MyDocumentsを指定 -> MyDocumentsを指定 & 新しいフォルダ作成ボタン付き
      if SelectDirectory('', '::' + GUIDToString(CLSID_MyDocuments), SelectDir,
        [sdNewUI, sdNewFolder, sdShowEdit], Self) then
      begin
        EditPath.Text:=SelectDir;
        Setup_FolderPath:=EditPath.Text;
      end;
    end;
    1:begin
      //フォルダを選択 -> を指定
      //if SelectDirectory('', '::' + GUIDToString(CLSID_MyComputer), SelectDir) then

      //MyMyComputerを指定 -> MyMyComputerを指定 & 新しいフォルダ作成ボタン付き
      if SelectDirectory('', '::' + GUIDToString(CLSID_MyComputer), SelectDir,
        [sdNewUI, sdNewFolder, sdShowEdit], Self) then
      begin
        EditPath.Text:=SelectDir;
        Setup_FolderPath:=EditPath.Text;
      end;
    end;
  end;

end;

上の手続きで使用しているGUIDToString関数の引数CLSID_XXXには、その種類に制限があるようです。ShlObj.pas内のGUID定義を見てみると･･･

const
  CLSID_NetworkDomain: TGUID     = '{46E06680-4BF0-11D1-83EE-00A0C90DC849}';
  {$EXTERNALSYM CLSID_NetworkDomain}
  CLSID_NetworkServer: TGUID     = '{C0542A90-4BF0-11D1-83EE-00A0C90DC849}';
  {$EXTERNALSYM CLSID_NetworkServer}
  CLSID_NetworkShare: TGUID      = '{54A754C0-4BF0-11D1-83EE-00A0C90DC849}';
  {$EXTERNALSYM CLSID_NetworkShare}
  CLSID_MyComputer: TGUID        = '{20D04FE0-3AEA-1069-A2D8-08002B30309D}';
  {$EXTERNALSYM CLSID_MyComputer}
  CLSID_Internet: TGUID          = '{871C5380-42A0-1069-A2EA-08002B30309D}';
  {$EXTERNALSYM CLSID_Internet}
  CLSID_RecycleBin: TGUID        = '{645FF040-5081-101B-9F08-00AA002F954E}';
  {$EXTERNALSYM CLSID_RecycleBin}
  CLSID_ControlPanel: TGUID      = '{21EC2020-3AEA-1069-A2DD-08002B30309D}';
  {$EXTERNALSYM CLSID_ControlPanel}
  CLSID_Printers: TGUID          = '{2227A280-3AEA-1069-A2DE-08002B30309D}';
  {$EXTERNALSYM CLSID_Printers}
  CLSID_MyDocuments: TGUID       = '{450D8FBA-AD25-11D0-98A8-0800361B1103}';
  {$EXTERNALSYM CLSID_MyDocuments}

自分的に使いたいなーって思う定義は、MyComputerとMyDocumentsぐらいしかありません（Desktopがない！）。まぁ、ない袖は振れない･･･ということでしょう。

どうしてもデスクトップを指定したい場合は、上で使用した GetDirectoryFromCSIDL(CSIDL_DESKTOP) のように、CLSID_XXX ではなく、CSIDL_XXX を使える形式に書き直す必要がありそうです（今回は、書き換えずに進めることにします）。

で、「実行」ボタンの挙動は、ほとんど再掲ですが･･･

procedure TForm1.btnOKClick(Sender: TObject);
var
  rsFileName:string;
  LDir:String;
begin

  //Path
  rsFileName:=Setup_FolderPath+'\'+Setup_ExeName+'.exe';

  //ファイルがある場合は削除
  if FileExists(rsFilename) then
  begin
　  //ファイルが存在したときの処理
    DeleteFile(rsfileName);
  end;

  //リソースを再生
  with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
  begin
    try
      SaveToFile(rsFileName);
      //MessageDlg('Generate!', mtInformation, [mbOk] , 0);
    finally
      Free;
    end;
  end;

  //デスクトップにこのプログラムのショートカットを作成
  if CheckCreateShortCut.Checked then
  begin
    //plShortcutUtilsユニット内の関数類を使用
    //CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
    //CSIDLの値からフルパスを取得
    //ショートカットを作成する場所
    LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

    if CreateShortCutLink(rsFileName, LDir, Setup_ExeName) then begin
      //ショートカットの作成場所によっては，以下のコードで更新が必要
      //SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
    end;

    MessageDlg('Done!', mtInformation, [mbOk] , 0);
  end;

end;

案外簡単に、思った通りのインストールプログラムが作れました！

ふと疑問に思い、今回、調べて初めて知ったのですが、「インストール」と「セットアップ」は意味的に異なるようです。

セットアップはよく、「インストール」と同義語として解説されることもありますが、インストールは、ソフトウェアを動かすためのプログラムやデータなどの各種ファイルをコンピュータにコピーすることであり、セットアップは、インストール後に自分のコンピュータに合わせて必要な設定をすることまでを指す言葉です。

ネット用語辞典（https://bb-navi.jp/netjiten/sa25.html）より引用

５．まとめ

iniファイルを使用したり、リソースに埋め込んだDLLその他のファイルをインストール先フォルダ等に生成して使うようなプログラムを配布する場合、ユーザーに優しいプログラムとするため、必要のないファイルその他を見せない工夫があった方がよいのではないか？ と思い、マイドキュメントフォルダ等に専用フォルダを作成して、そこへExeをインストールするプログラムを書いてみた。

これまでユーザーのPCに手作業でEXEのインストール作業を行ってきたが、このようなインストーラにExeを埋め込んで配布すれば、その作業がいらなくなる？

取り敢えず、現場で運用して見ます！

６．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

これまで「サインイン」と題して、オンラインのOneDriveへ、いかに楽してサインインするか･･･という内容の記事を３つ書いた。

それはアプリのOneDriveから、簡単にオンラインのOneDriveを表示する方法がわからなかったから。で、ことここに至ってようやく、その方法を発見。

結局、これまでの全ては、オンラインのOneDriveへ「いかに苦労してサインインするか」に変わった気が･･･。

【目次】

１．アプリからオンラインのOneDriveを表示
２．アカウントの切り替えも簡単
３．まとめ
４．お願いとお断り

１．アプリからオンラインのOneDriveを表示

なんで今まで気がつかなかったんだろう･･･。アプリのOneDriveの「フォルダーを開く」の右隣にオンラインのOneDriveを表示する「オンラインで表示」があった！

さらに、アプリのOneDriveの「フォルダーを開く」で表示されるエクスプローラーの右上の「同期しています」をクリックすると表示されるサブメニューの右下にも「オンラインで表示」が存在！（ここのキャプションは、その時々の状況を伝えるほかの文字列「例：エラー」等になることもあるようだ）

いずれもクリックすると、Webブラウザが起動してオンラインのOneDriveが表示される。

データ交換用のUSBメモリのようにオンラインのOneDriveを使用したい時は、このWebブラウザに表示されたオンラインのOneDriveへ、必要なデータをアップロードして、別のPCで同様にオンラインのOneDriveにサインインして、必要なデータをダウンロードすればいい。

追記（20230829）

回線速度とは別に、使用するWebブラウザによりダウンロード速度に違いが生じることがあるのだろうか？　昨日、150MB程度のZipファイルをOneDriveからダウンロードしたのだが、Myプログラムから実行したそれは「あまりにも」遅く、耐え難かったので、ChromeからOneDriveに接続してダウンロードしてみたら「ものすごく」速かった･･･です。

遅かったのはTWebBroeserを使ったプログラムだったので、TEdgeBrowserに変更した新しいプログラムで試してみたら、ChromeでOneDriveに接続した場合と変わらないダウンロード速度で快適に作業できました！

２．アカウントの切り替えも簡単

個人のアカウントから、組織のアカウントへ（もちろん、その逆も）の切り替えも簡単でした。オンラインで表示したOneDrive画面右上のアカウントマネージャーをクリックして切り替えたいアカウントを選択するだけです。

３．まとめ

（１）アプリのOneDriveからオンライン表示への切り替えは走召簡単（泣）
（２）複数のアカウントがある場合、アカウントマネージャーで切り替え可能
（３）間違った思い込みは無駄な苦労の元。アプリの使い方をよく勉強しよう！

４．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

追記（20230827 OneDriveアプリからオンライン表示へ切り替え）

サインイン ４　アプリからオンラインのOneDriveを表示

以下、『いかに苦労してOneDriveにサインインするか』という、上記サインイン ４に辿り着くまでの、長いながいまわり道の記録です。なので、お読みいただく価値がないことを最初に申し添えます。m(__)m

この記事は、アプリとして実行（タスクトレイに常駐）するOneDriveではなく、Web上のOneDriveへ直接データをアップロードし、別のPCでそのデータをダウンロードする、言わばデータ交換用USBメモリのようにOneDriveを使用する方法の一例です。PC内のOneDriveフォルダにあるデータと、クラウド上のOneDriveにあるデータの同期などは、まったく考慮しておりませんので、その点にはどうかご注意願います。

プロローグ

2023年８月のある日を境に、OneDriveの挙動が変わったことに気づいた。組織アカウントと個人アカウントの両方で同一ID（メールアドレス）を使用している場合、個人アカウントとしてサインインしようとすると、個人アカウント用のサインイン画面が新たに表示され、その都度、パスワードの入力が必須になったようだ･･･。

１．あれは夢だったのか･･･？
２．IDの入力を２回求められるようになった･･･
３．イロイロ調べてみた！
４．パスワードも自動入力！
５．画面の表示設定
６．まとめ
７．お願いとお断り

１．あれは夢だったのか･･･？

これまでに、過去の記事として「サインイン」、「サインイン ２」と題し、クラウド上のOneDriveへ、いかに「楽して入るか」ということについて自分なりに工夫した点のまとめの記事を（プログラミングの一つの区切りでもあったし）掲載した。

実行形式ファイルを配布していないから、動作の確認のしようがないじゃないか･･･という声が聞こえてくるような気もするけど、exeの配布が僕の目的ではなく、夢中になったことのプログラミング記録を残すことがこのBlogを書く目的なので、そこは悪しからずご了解ください（バグに満ちた？実行形式ファイルを配って、多くの方にご迷惑をおかけしたくないという思いも当然あります）。

「サインイン ２」で思った通りのプログラムが完成して、「使うぞー！」という段階に入った８月中旬、これまでと異なる挙動をWebブラウザが示すことに僕は気づいた。

サインイン２で作成した接続専用プログラムを起動し、IDを自動入力して「次へ」をクリックして「個人用アカウント」をクリックしてもOneDriveに素直に入れないのだ･･･。例外なく新しい画面でIDの入力を再度求められ、さらに毎回パスワードも入力しなければならない。

今まではこんなことなかったのに･･･
IDを入力するだけで入れた、あのOneDriveは夢だったのか･･･？

２．IDの入力を２回求められるようになった･･･

具体的にはどうなるのか、画面をつけて説明すると以下の通り。
FormCreate手続きの最後で、次のようにOneDriveのサインイン画面を呼び出して･･･IDとして利用しているメールアドレスを自動入力。

  //Navigate
  EdgeBrowser1.Navigate('https://onedrive.live.com/about/ja-jp/signin/');

すると、次の画面が表示されて、これまでなら「個人用アカウント」をクリックするだけでOneDriveにサインインできた（過去にパスワードを入力してサインインに成功していればそのCookieが残っているから？）。

ところが、2023年８月中旬（頃？）からは、「個人用アカウント」をクリックすると、なんと･･･（おそらく、ここでサインインするアカウントが「個人用アカウント」であることがユーザーによって確定されたということで、Microsoftさん的には、今度は安心して･･･再度、個人アカウント専用のOneDriveへのサインイン画面を表示して、サインインしてください･･･という意味なのだと思いますが）

「戻ってしまう･･･」と書いたが、正確にはカーソルのキャレットの点滅位置（スクリーン座標）が異なっていることと、その下に「サインイン オプション」なる最初の画面にはない表示があることから気づいたのだが、（最初に表示されたのとは）「別」の（＝個人用アカウントの？）サインイン画面が表示されるのだ（サインイン画面のURLも確認したが、当然最初のサインイン画面とは異なっている）。

IDとして利用するメールアドレスは、この段階では疑似クリック＆貼り付け失敗に備えてクリップボード上に送ってあるから、キャレットの点滅を確認し、Ctrl＋Vして入力欄に貼り付けて「次へ」をクリックすると、さらに、これまでは出てこなかったパスワードの入力画面が表示される･･･。

これまで利用していたはずのCookieは何処へ消えたのか･･･不思議に思いながら、パスワードを入力してサインインボタンをクリックすると、やっとOneDriveに入れる･･･。

しかも、最後に表示される画面で、「今後このメッセージを表示しない」をチェックして「はい」を選択（クリック）しても、このメッセージは毎回必ず表示される･･･つまり、個人用アカウントでサインインした場合は、「サインインの状態は維持されない」。

拝啓 マイクロソフト様

オレみたいな輩がいるから、こんな仕様になったんですか？

Webブラウザが見えないところでやってることなんて、何にもわかりません。わからないけど･･･

「ボクのお父さんは、桃太郎というやつに殺されました。」

あの手紙を読んだときと同じくらいショックでした。

悪いことをするつもりはまったくありません。

いつも使ってるID（＝メールアドレス）で、

OneDriveに楽して入りたいだけなんです。

「それが大きな間違いだ･･･」と言われたら、素直に「はい」と言うしかありませんが･･･

３．イロイロ調べてみた！

（期待したことなど一度もないが）これまで通りの七転八倒の結末に、今回も大いに落ち込む。が、唯一の救いは「OneDriveにサインインできなくなったわけではない」という部分だ。設定が変わって、セキュリティがより厳しくなった･･･というか、組織アカウントと個人アカウントの区分がより厳密になった･･･と言えばいいのかな？ この問題の全体像は、多分、僕には把握できないだろうけれど、とりあえず、僕がわかるところまでOneDriveへサインインする仕組みについて調べてみることにした。

その結果、いちばんわかりやすかったのが、こちらの記事。

『サインインの状態を維持しますか ?』のオン/オフをユーザーごとに制御する

https://itbeginner.tech/2020/07/25/keep-me-signed-in/

上記Webサイト様の記事によれば、「有効期限が切れるシナリオ以外に、サインイン画面が表示される代表的な例」は次の５つがあるとのこと。

• ユーザーのパスワードが変更されている
• サインインの際に prompt=login パラメーターが付与されている
• 多要素認証 (MFA) を実施する必要がある
• inPrivate モードのブラウザでサインインしている
• ブラウザが Cookie を保存できない、送信できない … など。

https://itbeginner.tech/2020/07/25/keep-me-signed-in/より引用

パスワードは変更してないから、それ以外の４つのうち、個人用アカウントでサインインする場合には、どの理由が該当するのか（自分的には、組織アカウントと個人のアカウントの両方に登録されているIDが使用された場合に、どちらのアカウントでのサインインであるかを確定することがサインイン画面が２回表示される最大の目的だと思うのだけれど）、いずれにしても原因がはっきりわかっても、そこから先が独力では解決できそうにありません。

おそらく、組織アカウントと個人アカウントを明確に切り分けない限り、現段階でこの問題の解決策はないように思えてきました。

また、上記Webサイト様の記事では『Fiddler』（フィドラー？）というHTTPS通信を解析するソフトが紹介されており、記事を読んで（僕には絶対に結果を上手く扱えない･･･）と直感的に思ったけれど、取り敢えずLink先へ飛んでプログラムをダウンロードしてMy PCにインストール。動かしてみた結果が次の通り。

『Fiddler』のインストールと使い方は、次の記事を参照して行いました！

HTTPS パケット キャプチャ ツール Fiddler のインストールから使用開始まで。

https://qiita.com/Shinya-Yamaguchi/items/37347ec532824c2dccad

で、せっかくインストールして動かしてみた『Fiddler』ですが、この『Fiddler』が表示してくれているHTTPS通信の内容を、Delphi の Object Pascal で書く OneDrive への接続プログラムで活用する方法がわかりません･･･。残念ながら僕には、現時点でそれだけのプログラミングスキルが･･･悔しいけれどありません。それをイチから学ぶには、とんでもない時間がかかりそうです･･･

もはやこれまで･･･
あきらめるしかないかぁ･･･

っと、思ったところで気がつきました！

何をあきらめるというのだろう？
Cookieを利用した形でのパスワード入力を回避できないなら、
パスワードも自前で暗号化して定義ファイルに保存しといて、
半自動入力すればイイだけのことじゃないか･･･

サインイン画面が再び表示されたらCtrl＋Vで、クリップボードにあるIDのデータを貼ればいいだけだし、さらに続けてパスワード入力が要求される場面があっても、僕のプログラム側で対応して、ID入力同様にパスワード入力を半自動化してしまえばいい。

負け惜しみじゃなく、すべてを手入力するよりか、はるかにラクだ！
貼り付けのショートカットだって、Ctrl＋Vだけなら覚えて貰えるはず･･･
目の前に見えてるボタンのクリックなら、なんの問題もない。

要は、困った時のサポートと、「慣れ」だ。

OneDriveにサインインする「敷居」さえ、もっと低くできれば･･･
みんなに やさしい プログラムになる。

風邪などのウイルス性疾患全般に効く特効薬はないみたいだけれど、たとえウイルスは退治できなくでも、ウイルスの引き起こす様々な症状への対症療法ならたくさんある。

それと同じように、Windows Hello や Cookie を利用してパスワード入力そのものを回避するというような根本的な問題解決は（今の僕には）出来ないけれど、サインインのID入力画面が表示されたら、IDを自動入力、クリックで進めるところは素直にクリックして次へ進み、もしパスワード入力画面が表示されたら、そこでまたパスワードを半自動入力するという、いわば対症療法的な方法で少しでも「楽に」サインインする方法が実現できるよう頑張ればいい。それだって、IDやパスワードを毎回全部手入力するよりは、ずっとラクなはずだ･･･。

繰り返せば、やがて「慣れ」という免疫ができる･･･。

それに、実験してて気がついたんだけど、自動的にCookieが適用？されて、パスワード入力を求められない（パスワード入力の画面が表示されない）IDもあるようだ。

詳しくは書かないけど、サインイン後の画面そのものがIDによって･･･違う。

なんでIDにより、Webブラウザの挙動が異なるのか？

おそらく、僕がOneDriveへのサインイン時に、IDとして使用しているメールアドレスは、Office 365の申し込み時にもその登録に使用したから当然Azure ADアカウント（＝職場や学校のアカウント：組織アカウント）になっていて、さらに、同じメールアドレスが昔のLive IDつながりのMicrosoftアカウント（＝個人のアカウント）としても登録されているから、このアカウントの二重登録状態をなんとか解消したい（させたい）Microsoft社の意向があって、こういうことになっているんだと思うんだけど･･･。

そうか、組織アカウントなら･･･。

ただ、僕のように、個人のアカウントのメールアドレスをどうしても変更したくない場合は、どうしたらよいのだろう？

そのへんの違いと仕組みは、これからの成長課題としておいて･･･、今は、今の僕に出来るいちばんイイことをしよう！

４．パスワードも自動入力！

さっそく、次のようにGUIを修正。

上のGUIの「待ち時間：1500（ﾐﾘ秒）」ComboBoxの右隣りに下のGUIを追加。

上のように、パスワードをマスクするには、次のように設定。

パスワードを入力させるとき、入力した文字が他人に見られないように＊などを表示（現在は黒丸●が標準？）するには、PasswordCharプロパティに * を設定するだけでOK！

//Password入力用文字列に'*'を設定
Edit1.PasswordChar:='*';

//Password入力用文字列設定を解除（''で#0を囲まないこと！）
Edit1.PasswordChar := #0;

【注意】
Editコントロールのプロパティで直接指定する場合は、アスタリスクをシングルクオートで囲んで ‘*’ としないこと！ 「プロパティ値が違います」と即エラーになる。

シングルクオート囲みなし、単に #0 or * を入力すればOK！

パスワードのマスクを、CheckBoxのチェックと連動させるのであれば･･･

procedure TForm1.chkPWClick(Sender: TObject);
begin
  if chkPW.Checked then
  begin
    EditPW.PasswordChar := #0;
  end else begin
    EditPW.PasswordChar := '*';
  end;
end;

【再掲：マウスカーソルの現在位置座標の取得方法】

座標チェックに☑すると、マウスカーソルの現在位置のスクリーン座標がリアルタイムで表示される。その方法は前回も示しましたが、次の通り。

マウスのカーソルが現在置かれている位置のスクリーン座標を取得してLabelに表示。

procedure TForm1.chkZahyoClick(Sender: TObject);
begin
  if chkZahyo.Checked then
  begin
    //Enabled
    Timer1.Enabled:=True;
  end else begin
    //Enabled
    Timer1.Enabled:=False;
    LabelXY.Caption:='[X座標, Y座標]';
  end;
end;

Timer1のOnTimerプロパティをダブルクリックして作成されたTimer1Timer手続きに次のコードを記述。これでほぼリアルタイムにカーソルの位置座標を取得して表示できる。

procedure TForm1.Timer1Timer(Sender: TObject);
var
  lh_Handle:  HWND;
  lpt_Pos:    TPoint;
  lrc_Rect:   TRect;
  lrg_Region: HRGN;
  li_Ret:     Integer;
begin
  if chkZahyo.Checked then
  begin
    //マウスカーソル位置をスクリーン座標で取得
    GetCursorPos(lpt_Pos);
    //自身のウィンドウリージョンを調べる
    lh_Handle := Self.Handle;

    //ウィンドウリージョン取得のため空のリージョンを作っておく
    lrg_Region := CreateRectRgn(0,0,0,0);
    try
      //ウィンドウリージョン取得
      li_Ret := GetWindowRgn(lh_Handle, lrg_Region);
      if (li_Ret <> ERROR) then begin
        //ウィンドウのRectを取得
        GetWindowRect(lh_Handle, lrc_Rect);
        //スクリーン座標からウィンドウの左上を原点とした座標に変換
        lpt_Pos.X := lpt_Pos.X - lrc_Rect.Left;
        lpt_Pos.Y := lpt_Pos.Y - lrc_Rect.Top;
        //ウィンドウリージョン内にマウスカーソルがあるかテスト
        if (PtInRegion(lrg_Region, lpt_Pos.X, lpt_Pos.Y)) then begin
          LabelXY.Caption:=Format('OK %d (%d-%d)', [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end else begin
          LabelXY.Caption:=Format('NG %d (%d-%d)', [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end;
      end else begin
        LabelXY.Caption:=Format('[X:%d, Y:%d]', [lpt_Pos.X, lpt_Pos.Y]);
      end;
    finally
      DeleteObject(lrg_Region);
    end;
  end;
end;

これでパスワード入力欄のスクリーン座標を取得・保存しておいて、実際はパスワード入力画面が表示されたら、「入力」ボタンをクリック（パスワード入力画面が表示されなければ、GUIそのものを表示する必要もないので、接続環境に合わせてGUIそのものの表示もON／OFFできるようにした）。もちろん、GUIの表示状態そのものを保存可能。

パスワードはクリップボードに送信せず、Editコントロールにマスクをかけて表示しておき、入力が必要であればボタンクリックで実行できるように設定。

パスワードの半自動入力は、次のコードで実行（前回のID入力用コードを修正）。

procedure TForm1.btnCopyClick(Sender: TObject);
var
  dwFlags : DWORD;
  X,Y : Integer;
  LKeyByte : Byte;
begin

  boolInput:=False;

  //Information
  if chkInfo.Checked then
  begin
    if MessageDlg('パスワード入力画面が見えていて、入力欄は空欄ですか？', mtInformation, [mbYes, mbNo], 0) = mrYes then
    begin

      try

        //クリップボードを初期化
        Clipboard.Clear;
        //文字列をクリップボードへ
        Clipboard.AsText:=EditPW.Text;

        dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;
        X:=Trunc(StrToInt(EditPWX.Text)/Screen.Width*65537);
        Y:=Trunc(StrToInt(EditPWY.Text)/Screen.Height*65535);

        //移動
        Mouse_Event(dwFlags,X,Y,0,0);
        //クリック
        Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
        //Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        Application.ProcessMessages;

        WaitTime(StrToInt(cmbWaitTime.Text));

        Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
        Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        Application.ProcessMessages;

        // [Ctrl] + [V] のキー操作
        LKeyByte := Ord('V');
        keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
        keybd_event(LKeyByte, MapVirtualKey(LKeyByte, 0), 0, 0);
        keybd_event(LKeyByte, MapVirtualKey(LKeyByte, 0), KEYEVENTF_KEYUP, 0);
        keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP, 0);

        boolInput:=True;


      except

        boolInput:=False;

      end;

      end else begin

        MessageDlg('パスワード入力画面を表示し、入力欄が空欄の状態で、再度実行してください。', mtInformation, [mbOk] , 0);

    end;

  end else begin

    try

      //クリップボードを初期化
      Clipboard.Clear;
      //文字列をクリップボードへ
      Clipboard.AsText:=EditPW.Text;

      dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;
      X:=Trunc(StrToInt(EditPWX.Text)/Screen.Width*65537);
      Y:=Trunc(StrToInt(EditPWY.Text)/Screen.Height*65535);

      //移動
      Mouse_Event(dwFlags,X,Y,0,0);
      //クリック
      Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
      //Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
      Application.ProcessMessages;

      WaitTime(StrToInt(cmbWaitTime.Text));

      Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
      Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
      Application.ProcessMessages;

      // [Ctrl] + [V] のキー操作
      LKeyByte := Ord('V');
      keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
      keybd_event(LKeyByte, MapVirtualKey(LKeyByte, 0), 0, 0);
      keybd_event(LKeyByte, MapVirtualKey(LKeyByte, 0), KEYEVENTF_KEYUP,0);
      keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);

      boolInput:=True;

    except

      boolInput:=False;

    end;
  end;
end;

５．画面の表示設定

IDのみの入力でOneDriveにサインイン可能な場合は、不要なGUIは表示せずに運用。

ID＆パスワードの入力が必要な場合は、画面左上の設定ボタンをクリックしてGUIを表示。初回のみ、ID＆パスワード入力欄のスクリーン座標を計測＆保存して、次回以降は半自動入力でサインイン。

現実世界に追従するカタチでのプログラミングは、夢を追いかけて･･･ではなくて、正直、必要に追われて･･･って感じで、書いていて楽しくはないけど。

でも、もし、これが誰かの役に立つなら･･･

OneDriveが使えなくて、すごく困っている人の役に立つなら･･･

僕のしたことに、ほんの少しだけ

意味や価値を見出せる気がします。

そうだ･･･。今、思い出せた･･･。

プロが書いた、見た目も美しい、あらゆる要求に対応した高価なプログラムではなく、
こんな僕の書いた、みすぼらしい、しかも機能限定のプログラムがいいと･･･

二者択一の場面で、僕のプログラムを選んでくださる人がいることを。

うん。そうだ。
きみも言ってくれたね。

「生きていれば必ず前進できます。
　もっとよくなれるんです。

　･･･

　お互い 夢の実現に向けて、自分らしく歩きましょう。」

今、信じなくて、いつ、信じるんだ。
１ミリでもかまわない。
前へ行くんだ。

僕に今できる、唯一、確かなことをするんだ･･･

６．まとめ

（１）OneDriveへのサインインはIDによりその挙動が異なる。
（２）対症療法的にプログラミングすれば半自動ログインはできる。
（３）全自動ログインには、Cookieの利用を含めたさらなる学習が必要。

７．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

追記（20230827 OneDriveアプリからオンライン表示へ切り替え）

サインイン ４　アプリからオンラインのOneDriveを表示

以下、『いかに苦労してOneDriveにサインインするか』という、上記サインイン ４に辿り着くまでの、長いながいまわり道の記録です。なので、お読みいただく価値がないことを最初に申し添えます。m(__)m

この記事は、アプリとして実行（タスクトレイに常駐）するOneDriveではなく、Web上のOneDriveへ直接データをアップロードし、別のPCでそのデータをダウンロードする、言わばデータ交換用USBメモリのようにOneDriveを使用する方法の一例です。PC内のOneDriveフォルダにあるデータと、クラウド上のOneDriveにあるデータの同期などは、まったく考慮しておりませんので、その点にはどうかご注意願います。

また、サインイン画面でのID（Microsoftアカウントに登録したメールアドレス）入力後のOneDriveの応答について、いろいろ調べたのですが、起こり得る個々の問題一つ一つについては、僕のプログラミングスキルでは到底対応できないと感じました。そこで、ID入力後にパスワード入力が必要になった場合の処理について、後日、自分なりのスーパー・ローレベル対応方法として「サインイン３」というタイトルで書きたいと思います。

コンピューターと同期する OneDrive フォルダーを選択する

クラウド上のOneDriveとPCのデータの同期については上のリンク先記事をご参照ください。

OneDriveのサインイン画面に、IDとして利用するメールアドレスを自動入力するプログラムを前回、作成した。目的通りのプログラムが出来たことは出来たが、WebView4Delphiコンポーネント（MITライセンス）のdemoフォルダにあったSampleをそのまま使わせてもらったため、「ID（メールアドレス）を自動入力する」以外にも様々な機能が実装（Sampleなんだから当然と言えば当然）されており、ただプログラムを起動するだけで、exeを置いたフォルダ内に容量がおよそ200MBくらいある「CustomCache」という名前のフォルダが出来てしまう。無視すればイイと言ってしまえば･･･それまでかもしれないけど･･･。

WebView4Delphi

https://github.com/salvadordf/WebView4Delphi

とりあえず、自分的には使わない機能をカットしようと思い、プログラムソースを読んでみたんだけれど･･･、コードどうしの関連がよくわからない。ヘタにいじって不具合とバグの山を築くより、「IDの自動入力」という初心に帰って、プログラムをイチから作り直した方がいい気がしてきた。

で、作ったのがコレ。

【作成の手順】

１．TEdgeBrowserを使う
２．GUIの設計とプログラムコード
（１）GUIの設計
（２）VCLコントロールの表示／非表示を切り替え
（３）入力値の保存／読み込みと暗号化
（４）カーソル位置の座標を取得
（５）プログラムコードから指定位置をクリック
（６）ダウンロードフォルダを開く
（７）リソースにDLLを埋め込む
（８）操作方法の案内
３．まとめ
４．お願いとお断り

１．TEdgeBrowserを使う

Delphiで、Web コンテンツやローカルに置いたhtmlファイルの読み込みと表示を行うためのビジュアル コンポーネントには、TEdgeBrowser や TWebBrowser があるけれど、表示したいWebページがJavaScript のダイアログ ボックス、パネル、その他要素を使用しているとTWebBrowser では Web ページを正しく表示できないことがあるようだ。

正直に言うと、Edge には印刷その他の不具合でかつて悩まされた記憶があり、個人的にあまり良いイメージを持っていなかったので、新しい TEdgeBrowser コンポーネントではなく、古い TWebBrowser コンポーネントの方を使いたかった。だから、最初は、次のリンク先にあるような情報を参考にして、TWebBrowser コンポーネントで OneDrive のサインイン画面を表示するプログラムを書いてみたのだが･･･

Delphi / C++Builder Starter Edition の VCL で WebBrowser コンポーネントを使う

https://qiita.com/ht_deko/items/c69902d644ea03f61deb

上のリンク先記事のおしまいの部分でも述べられている通り、TWebBrowser コンポーネントを使って OneDrive のサインイン画面を表示するコードを書くと、結構盛大にスクリプトエラー発生のメッセージが表示される。

なんとかならないか･･･と思い、Google先生にお伺いをたてると、FMX版の TWebBrowser の記事ではあるが、本家本元embarcaderoさん提供のスクリプトエラー発生回避策を発見。

FMX.WebBrowser.TWebBrowser

https://docwiki.embarcadero.com/Libraries/Sydney/ja/FMX.WebBrowser.TWebBrowser

それによれば「この問題を回避するには、アプリケーションは、Internet Explorer の FEATURE_BROWSER_EMULATION 機能を使用して、Web ページを IE11 エッジ モードで表示しなければなりません。」と説明があり、具体的な回避策として「FormCreate イベント ハンドラで、TForm1.SetPermissions メソッドを呼び出す」方法がソースコード付きで掲載されていた。

早速、スクリプトエラー回避策なるそのコードをコピペして実行してみたが、ナニがよくないのか、スクリプトエラーは発生状況に変化は見られなかった。

上のリンク先ページでは、スクリプトエラー回避策コードの下に「メモ： レジストリに対するこれらの変更は、アプリケーションが開始する前に適宜行わなければなりません。最初にアプリケーションを開始した際には、それを一度閉じ、再度開始します。」という説明があるので、プログラム起動時にレジストリに対する変更を行って、いったんプログラムを終了し、再度実行すればOKなのか？ とも思ったが、原因の究明に時間を割くより、新しいTEdgeBrowserコンポーネントでOneDriveのサインイン画面を表示する方法を試した方が賢い気がして、ここで方針を変更。素直にTEdgeBrowserコンポーネントを使うことにする。その際、参考にさせていただいた記事がこちら。

TEdgeBrowserでWebView2を使う ～Delphiソースコード集

https://mam-mam.net/delphi/tedgebrowser.html

OSがWindows11であれば、動作に必要なMicrosoft WebView2 ランタイムは、既に入っているので、インストール不要とのこと。作成するプログラムを動かす予定のPCのOSはすべてWindows11なので、その点は心配ないが、いちおうReadme.txtファイルを用意して、OSがWindows10の場合にはMicrosoft WebView2 ランタイムのインストールが必要であることを案内した方がよさそうだ。

２．GUIの設計とプログラムコード

（１）GUIの設計

Delphiを起動し、「ファイル」→「新規作成」→「Windows VCLアプリケーション」と辿って、表示されたFormにPanelを３つ図のように配置する。

Panel1が階層構造的にはいちばん下にあり、AlignプロパティはalTopを指定。その上にPanel2及び 3 を乗せて、Panel2のAlignプロパティはalLeft、Panel3のAlignプロパティはalClientをそれぞれ指定する。このようにプロパティを設定しておけば、Formの大きさが変化しても、Panel2の大きさ（幅と高さ）は変わらず、Panel3の高さはそのままで幅がFormの大きさ（幅）に合わせて自動的にサイズが変化し、各VCLコントロールの位置はFormの左上を原点とした設計時の位置に固定されて表示される。

この後、Panel2の上には「ダウンロードフォルダを開く」ボタン、Panel3の上には暗号化してiniファイルに保存する予定の「ID」入力用のEditその他のVCLコントロールを次のように配置する。

（２）VCLコントロールの表示／非表示を切り替え

ID（メールアドレス）や、自動的にクリックする座標値はいったん設定・保存してしまえば、通常の使用の際には必要ないので、普段は非表示に設定。つまり、□設定チェックボックス以外のVisibleプロパティはすべてFalseを指定する。で、設定を☑したときだけ、表示されるように設定。

procedure TForm1.chkSettingClick(Sender: TObject);
begin
  if chkSetting.Checked then
  begin
    LabelID.Visible:=True;
    btnCopy.Visible:=True;
    btnCopy.Enabled:=True;
    Edit1.Visible:=True;
    LabelX.Visible:=True;
    EditX.Visible:=True;
    LabelY.Visible:=True;
    EditY.Visible:=True;
    btnSave.Visible:=True;
    chkZahyo.Visible:=True;
    LabelXY.Visible:=True;
    LabelWaitTime.Visible:=True;
    cmbWaitTime.Visible:=True;
  end else begin
    LabelID.Visible:=False;
    btnCopy.Visible:=False;
    Edit1.Visible:=False;
    LabelX.Visible:=False;
    EditX.Visible:=False;
    LabelY.Visible:=False;
    EditY.Visible:=False;
    btnSave.Visible:=False;
    chkZahyo.Visible:=False;
    LabelXY.Visible:=False;
    LabelWaitTime.Visible:=False;
    cmbWaitTime.Visible:=False;
  end;
end;

（３）入力値の保存／読み込みと暗号化

各VCLコントロールに入力された値は、必要な個所は暗号化してiniファイルに保存する。

uses
  System.IniFiles;

procedure TForm1.btnSaveClick(Sender: TObject);
var
  strID:string;
  Ini:TIniFile;
begin

  //入力の有無をCheck
  if Edit1.Text='' then
  begin
    MessageDlg('IDとして利用するメールアドレスを入力してください', mtInformation, [mbOk] , 0);
    Edit1.SetFocus;
    Exit;
  end;

  if (EditX.Text='') or (EditY.Text='') then
  begin
    if EditX.Text='' then
    begin
      MessageDlg('自動クリックするＸ座標を入力してください', mtInformation, [mbOk] , 0);
      EditX.SetFocus;
    end;
    if EditY.Text='' then
    begin
      MessageDlg('自動クリックするＹ座標を入力してください', mtInformation, [mbOk] , 0);
      EditY.SetFocus;
    end;
    Exit;
  end;

  if cmbWaitTime.Text='' then
  begin
    MessageDlg('カーソル移動の待機時間をミリ秒単位で入力してください', mtInformation, [mbOk] , 0);
    cmbWaitTime.SetFocus;
    Exit;
  end;

  //暗号化
  strID:=EDText(Edit1.Text, IntToStr(HashOf('XXXXXXXX')), True);

  //iniファイルに保存
  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    //保存
    Ini.WriteString('Section', 'ID', strID);
    Ini.WriteString('Section', 'IchiX', EditX.Text);
    Ini.WriteString('Section', 'IchiY', EditY.Text);
    Ini.WriteString('Section', 'WaitTime', cmbWaitTime.Text);
    //Userに通知
    MessageDlg('現在の設定を保存しました！', mtInformation, [mbOk] , 0);

    if not btnCopy.Enabled then btnCopy.Enabled:=True;

  finally
    Ini.Free;
  end;

end;

コードの中で使用しているEDText関数はテキスト暗号化の関数。

  private
    { Private 宣言 }
    //HashNameMBCS(Create hashed values from a Unicode string)
    //MBCS:Multibyte Character Set=マルチバイト文字セット
    function HashOf(const key: string): cardinal;

    //テキスト暗号化/復号化
    Function EDText(KeyStr,PassW:string; EncOrDec:Boolean):string;
    //KeyStr:平文 or 暗号化文のいずれかを指定
    //PassW:パスワード
    //EncOrDec:True -> Encode / False -> Decode

  public
    { Public 宣言 }
  end;

function TForm1.HashOf(const key: string): cardinal;
var
  I: integer;
begin
  Result := 0;
  for I := 1 to length(key) do
  begin
    Result := (Result shl 5) or (Result shr 27);
    Result := Result xor Cardinal(key[I]);
  end;
end;

function TForm1.EDText(KeyStr, PassW: string; EncOrDec: Boolean): string;
var
  {暗号化用変数}
  Source, Dest, Password:TStringBuilder;
  lpSource, lpPass:Integer;
  PassValue, SourceValue, EDValue:Word;
  {共用変数}
  //乱数の種
  Seed1,Seed2,Seed3:integer;
  //実数の一様乱数
  RandNum:Double;
  //秘密鍵Seed
  Seed:string;
  {復号化用変数}
  DecSource:string;
begin
  //１．シード値を準備
  // (1)Passwordを整数へ変換→シード値１へ代入
  Password := TStringBuilder.Create;
  //Seed1を初期化
  //Seed1:=0;
  try
    Password.Append(PassW);
    PassValue := 0;
    for lpPass := 0 to Password.Length - 1 do
    begin
      //パスワード→整数
      PassValue := PassValue + Word(Password.Chars[lpPass]);
    end;
    Seed1:=PassValue;
  finally
    Password.Free;
  end;

  // (2)パスワード文字列の長さを取得→シード値２へ代入
  Seed2:= ElementToCharLen(PassW,Length(PassW));

  // (3)シード値１とシード値２の排他的論理和を計算して、シード値３へ代入
  Seed3 := Seed1 xor Seed2;

  //２．実数の一様乱数を計算
  //---------------------------------------------------------------------------
  // ０より大きく１より小さい実数の一様乱数を発生する関数
  // B.A.Wichmann and I.D.Hill, Applied Statistics, 31, 1982, p.188 に基づく
  // Seed1-3に入れる初期値（整数）は16bit長(maxint=32767)で十分
  // Seed1-3には1から30000までの任意の整数値を準備する(０ではいけない)
  //---------------------------------------------------------------------------

  //Seed1:=171*Seed1 mod 30269 と同値
  Seed1:=(Seed1 mod 177)*171-(Seed1 div 177)* 2;
  if Seed1<0 then Seed1:=Seed1+30269;
  //Seed2:=172*Seed1 mod 30307 と同値
  Seed2:=(Seed2 mod 176)*172-(Seed2 div 176)* 35;
  if Seed2<0 then Seed2:=Seed2+30307;
  //Seed1:=170*Seed1 mod 30323 と同値
  Seed3:=(Seed3 mod 178)*170-(Seed3 div 178)* 63;
  if Seed3<0 then Seed3:=Seed3+30323;
  //See1-3それぞれの乱数を0<RandNum<1となるように
  //計算結果が０より大きく、１未満の実数に直し、和の小数部分をとる
  RandNum:=(Seed1/30269.0) + (Seed2/30307.0) + (Seed3/30323.0);
  while RandNum>=1 do RandNum:=RandNum-1;

  //３．秘密鍵を生成

  //整数の一様乱数の上限値を決めて、整数の一様乱数を生成し、
  //これに上で計算した実数の一様乱数を加えて秘密鍵を生成する
  //Seedが秘密鍵（文字列として利用）となる
  Seed:= FloatToStr(RandNum + trunc((Seed1+Seed2+Seed3)*RandNum));

  //４．暗号化 / 復号化
  if (EncOrDec) then
  begin
    //暗号化（Encode）
    Source := TStringBuilder.Create;
    Dest := TStringBuilder.Create;
    Password := TStringBuilder.Create;
    try
      Source.Append(KeyStr);
      //秘密鍵をセット
      Password.Append(Seed);
      lpPass := 0;
      //テキストのエンコード
      for lpSource := 0 to Source.Length - 1 do
      begin
        //パスワード→整数
        if Password.Length = 0 then
          PassValue := 0
        else begin
          PassValue := Word(Password.Chars[lpPass]);
          Inc(lpPass);
          if lpPass >= Password.Length then lpPass := 0;
        end;
        //テキスト→整数
        SourceValue := Word(Source.Chars[lpSource]);
        //XOR演算
        EDValue := PassValue xor SourceValue;
        //16進数文字列に変換
        Dest.Append(IntToHex(EDValue, 4));
        //処理結果を返り値にセット
        Result:=Dest.ToString;
      end;
    finally
      Password.Free;
      Dest.Free;
      Source.Free;
    end;
  end else begin
    //復号化（Decode）
    DecSource:=keyStr;
    Dest := TStringBuilder.Create;
    Password := TStringBuilder.Create;
    try
      //暗号化テキストのデコード
      Dest.Clear;
      Password.Clear;
      //秘密鍵をセット
      Password.Append(Seed);
      lpPass := 0;
      for lpSource := 1 to Length(DecSource) div 4 do
      begin
        SourceValue := StrToInt('$' + Copy(DecSource, (lpSource - 1) * 4 + 1, 4));
        if Password.Length = 0 then
          PassValue := 0
        else
        begin
          PassValue := Word(Password.Chars[lpPass]);
          Inc(lpPass);
          if lpPass >= Password.Length then lpPass := 0;
        end;
        EDValue := SourceValue xor PassValue;
        Dest.Append(Char(EDValue));
      end;
      //処理結果を返り値にセット
      Result:=Dest.ToString;
    finally
      Password.Free;
      Dest.Free;
    end;
  end;
end;

サインイン時にIDとして入力するメールアドレスは暗号化されてiniファイルに保存され、FormCreate時にこれを復号して、Editコントロールに表示する。

procedure TForm1.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
  strID, strX, strY, strWaitTime: String;
  i:integer;
begin

  //Formを最大化して表示
  Form1.WindowState:=wsMaximized;

  //待ち時間の選択肢（100～3000ミリ秒を100ミリ秒単位で用意）
  for i := 1 to 30 do
  begin
    cmbWaitTime.Items.Add(IntToStr(i*100));
  end;

  //iniファイルの存在を確認
  if FileExists(ChangeFileExt(Application.ExeName, '.ini')) then
  begin
    //iniファイルからデータを読込み
    Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
    try
      strID:=Ini.ReadString('Section', 'ID', '');
      strX:=Ini.ReadString('Section', 'IchiX', '580');
      strY:=Ini.ReadString('Section', 'IchiY', '420');
      strWaitTime:=Ini.ReadString('Section', 'WaitTime', '500');
    finally
      Ini.Free;
    end;
    //復号して表示
    Edit1.Text:=EDText(strID, IntToStr(HashOf('XXXXXXXX')), False);
    EditX.Text:=strX;
    EditY.Text:=strY;
    cmbWaitTime.Text:=strWaitTime;
  end;

  //Navigate
  EdgeBrowser1.Navigate('https://onedrive.live.com/about/ja-jp/signin/');

end;

（４）カーソル位置の座標を取得

マウスのカーソルが現在置かれている位置のスクリーン座標を取得してLabelに表示。

procedure TForm1.chkZahyoClick(Sender: TObject);
begin
  if chkZahyo.Checked then
  begin
    //Enabled
    Timer1.Enabled:=True;
  end else begin
    //Enabled
    Timer1.Enabled:=False;
    LabelXY.Caption:='[X座標, Y座標]';
  end;
end;

Timer1のOnTimerプロパティをダブルクリックして作成されたTimer1Timer手続きに次のコードを記述。これでほぼリアルタイムにカーソルの位置座標を取得して表示できる。

procedure TForm1.Timer1Timer(Sender: TObject);
var
  lh_Handle:  HWND;
  lpt_Pos:    TPoint;
  lrc_Rect:   TRect;
  lrg_Region: HRGN;
  li_Ret:     Integer;
begin
  if chkZahyo.Checked then
  begin
    //マウスカーソル位置をスクリーン座標で取得
    GetCursorPos(lpt_Pos);
    //自身のウィンドウリージョンを調べる
    lh_Handle := Self.Handle;

    //ウィンドウリージョン取得のため空のリージョンを作っておく
    lrg_Region := CreateRectRgn(0,0,0,0);
    try
      //ウィンドウリージョン取得
      li_Ret := GetWindowRgn(lh_Handle, lrg_Region);
      if (li_Ret <> ERROR) then begin
        //ウィンドウのRectを取得
        GetWindowRect(lh_Handle, lrc_Rect);
        //スクリーン座標からウィンドウの左上を原点とした座標に変換
        lpt_Pos.X := lpt_Pos.X - lrc_Rect.Left;
        lpt_Pos.Y := lpt_Pos.Y - lrc_Rect.Top;
        //ウィンドウリージョン内にマウスカーソルがあるかテスト
        if (PtInRegion(lrg_Region, lpt_Pos.X, lpt_Pos.Y)) then begin
          LabelXY.Caption:=Format('OK %d (%d-%d)', [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end else begin
          LabelXY.Caption:=Format('NG %d (%d-%d)', [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end;
      end else begin
        LabelXY.Caption:=Format('[X:%d, Y:%d]', [lpt_Pos.X, lpt_Pos.Y]);
      end;
    finally
      DeleteObject(lrg_Region);
    end;
  end;
end;

（５）プログラムコードから指定位置をクリック

前回作成したプログラムでいちばん、悩んだのがここ。最初はサインイン画面のウィンドウハンドルを取得して文字列を送信しようと思ったんだけれど･･･これがうまくいかない。その詳細は前回の記事を参照してください。

サインイン

さんざん悩んで、ようやく思いついた方法がプログラムコードで画面上の任意の位置をクリックする方法。Formが完全に描画された段階で、指定位置のクリックと、その位置への文字列の入力を実行している。そのコードを再掲。

  private
    { Private 宣言 }

    //アドレス貼り付け実行の成否
    boolInput:boolean;

    fgWaitBreak : boolean;  //変数は「functionより先に定義」する

    //待ち関数  指定カウントが経過すれば True, 中断されたならば False
    function WaitTime(const t: integer): Boolean;

    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;


//待機関数
function TForm1.WaitTime(const t: integer): Boolean;
var
  Timeout: TDateTime;
begin
  //待ち関数  指定カウントが経過すれば True, 中断されたならば False
  fgWaitBreak := False;
  Timeout := Now + t/24/3600/1000;
  while (Now < Timeout)and not fgWaitBreak do begin
    Application.ProcessMessages;
    Sleep(1);
  end;
  Result := not fgWaitBreak;
end;


procedure TForm1.CMShowingChanged(var Msg: TMessage);
var
  dwFlags : DWORD;
  X,Y : Integer;
  LKeyByte : Byte;
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin

    Update; {完全に描画}

    if Edit1.Text='' then
    begin
      Edit1.SetFocus;
      Exit;
    end;

    if (EditX.Text='') or (EditY.Text='') then
    begin
      if EditX.Text='' then EditX.SetFocus;
      if EditY.Text='' then EditY.SetFocus;
      Exit;
    end;

    fgWaitBreak:=False;

    //さらに念のためちょっと待機
    WaitTime(StrToInt(cmbWaitTime.Text));

    dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;

    //クリック位置を取得
    X:=Trunc(StrToInt(EditX.Text)/Screen.Width*65537);
    Y:=Trunc(StrToInt(EditY.Text)/Screen.Height*65535);

    //移動
    Mouse_Event(dwFlags,X,Y,0,0);
    Application.ProcessMessages;

    //クリック
    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    Application.ProcessMessages;

    WaitTime(StrToInt(cmbWaitTime.Text));

    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    Application.ProcessMessages;
    Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);

    //文字列を送信
    boolInput:=False;
    try

      //クリップボードを初期化
      Clipboard.Clear;

      //文字列をクリップボードへ
      Clipboard.AsText:=Edit1.Text;
      
      //[Ctrl] + [V] のキー操作
      LKeyByte := Ord('V');
      keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
      keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   0, 0);
      keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   KEYEVENTF_KEYUP, 0);
      keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
      //操作に成功
      boolInput:=True;
    except
      //操作に失敗
      boolInput:=False;
    end;

    //貼り付け操作に成功した場合は入力ボタンを操作不可に設定
    if boolInput then btnCopy.Enabled:=False;

  end;

end;

{入力ボタンのClick手続きは、確認メッセージの表示以外は上のコードとほとんど同じ}

また、予期せぬ事故を防止するため、プログラムの終了時にはクリップボードを空に（初期化）する。

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //クリップボードを初期化
  Clipboard.Clear;
end;

（６）ダウンロードフォルダを開く

OneDriveからデータのダウンロードが無事終了すれば、次のようにダウンロードフォルダを開くリンク付きのWindowが表示されるから、特殊なフォルダである「ダウンロードフォルダを開く」ボタンは、別になくてもかまわない気もするけど。

もしかしたら任意のタイミングで、それを開きたい時があるかもしれない。エクスプローラーを開けばいいじゃないかという意見は、ここでは聞かなかったことに。

ダウンロードフォルダを開くプログラムコード。

uses
  Vcl.Clipbrd, System.IniFiles, System.UITypes,
  Winapi.ShlObj, Winapi.KnownFolders, Winapi.ShellAPI;

procedure TForm1.btnOpenDLFolderClick(Sender: TObject);
var
  FolderID:TGUID;
  FolderPath:PChar;
  D_FolderPath, ExeFileName:string;
  LhInst:Cardinal;
begin
  FolderID:=StringToGUID('{374DE290-123F-4565-9164-39C4925E467B}');
  if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
  begin
    D_FolderPath := FolderPath;
    //確認
    //ShowMessage(D_FolderPath);
    //ダウンロードフォルダを開く
    ExeFileName:= 'explorer.exe';
    LhInst:=ShellExecute(Handle, 'open', PChar(ExeFileName), PChar(D_FolderPath), nil, SW_SHOW);
    if LhInst <= 32 then
    begin
      MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
    end;
  end;
end;

（７）リソースにDLLを埋め込む

このプログラムの動作には「WebView2Loader.dll」が必須（WebView2Loader.dll は、アプリがデバイス上で WebView2 ランタイム (Microsoft Edge プレビュー チャネル) を見つけるのに役立つコンポーネントであるとのこと）。

WebView2 アプリを 1 つの実行可能ファイルとして配布する

https://learn.microsoft.com/ja-jp/microsoft-edge/webview2/how-to/static

このDLLがないと困るので、添付忘れを防止するため、リソースに埋め込んでおいて、プログラムの実行時にexeのある場所にその有無を確認し、なければリソースから生成するように設定。

で、FormCreate時に有無を確認、なければexeのある場所に生成。

procedure TForm1.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
  strID, strX, strY, strWaitTime: String;
  i:integer;
  dllFileName:string;
begin

  //リソースからDLLを（なければ）生成
  //rijnファイルの位置を指定
  dllFileName:=ExtractFilePath(Application.ExeName)+'WebView2Loader.dll';
  //rijnファイルの存在を確認
  if not FileExists(dllFilename) then
  begin
    //リソースを再生
    with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
    begin
      try
        SaveToFile(dllFileName);
      finally
        Free;
      end;
    end;
  end;

  ･･･

end;

（８）操作方法の案内

この他に、画面最下部に設置したStatusBarに次のような案内を表示できるようにした。

操作方法の案内の表示／非表示の切り替え。

procedure TForm1.chkInfoClick(Sender: TObject);
var
  strInfo:string;
  strWidth:integer;
begin
  if chkInfo.Checked then
  begin
    //表示する文字列
    strInfo:='ID（メールアドレス）が自動入力されないときは、Ctrl＋V で入力できます！';
    strWidth:=StatusBar1.Canvas.TextWidth(strInfo);
    btnOK.Visible:=True;
    with btnOK do
    begin
      Parent:=StatusBar1;
      Left:=strWidth-20;
      Top:=1;
    end;
    //StatusBar1の設定（重要：このプロパティがFalseだとStatusBarにテキストが表示されない）
    StatusBar1.SimplePanel:=True;
    //Info
    StatusBar1.SimpleText:=strInfo;
  end else begin
    StatusBar1.SimpleText:='';
    btnOK.Visible:=False;
  end;
end;

案内を「表示する」が選ばれていた場合はFormCreate時に案内表示を出すよう設定。

procedure TForm1.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
  strID, strX, strY, strWaitTime: String;
  i:integer;
  dllFileName:string;
  strWidth:Integer;
  strInfo:string;
  boolInfo:boolean;
begin

  if chkInfo.Checked then
  begin
    //表示する文字列
    strInfo:='ID（メールアドレス）が自動入力されないときは、Ctrl＋V で入力できます！';
    strWidth:=StatusBar1.Canvas.TextWidth(strInfo);
    with btnOK do
    begin
      Parent:=StatusBar1;
      Left:=strWidth-20;
      Top:=1;
    end;
    //StatusBar1の設定（重要：このプロパティがFalseだとStatusBarにテキストが表示されない）
    StatusBar1.SimplePanel:=True;
    //Info
    StatusBar1.SimpleText:=strInfo;
  end;

  ･･･

  //iniファイルの存在を確認
  if FileExists(ChangeFileExt(Application.ExeName, '.ini')) then
  begin
    //iniファイルからデータを読込み
    Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
    try
      strID:=Ini.ReadString('Section', 'ID', '');
      strX:=Ini.ReadString('Section', 'IchiX', '580');
      strY:=Ini.ReadString('Section', 'IchiY', '420');
      strWaitTime:=Ini.ReadString('Section', 'WaitTime', '500');
      boolInfo:=Ini.ReadBool('Section','Info',True);
    finally
      Ini.Free;
    end;
    //復号して表示
    Edit1.Text:=EDText(strID, IntToStr(HashOf('adminy')), False);
    EditX.Text:=strX;
    EditY.Text:=strY;
    cmbWaitTime.Text:=strWaitTime;
    chkInfo.Checked:=boolInfo;
  end;

  ･･･

end;

案内そのものを表示したくない場合は、ユーザーの自由意思でその設定も可能に。

procedure TForm1.btnSaveClick(Sender: TObject);
var
  strID:string;
  Ini:TIniFile;
begin

  //入力の有無をCheck
  ･･･

  //暗号化
  strID:=EDText(Edit1.Text, IntToStr(HashOf('adminy')), True);

  //iniファイルに保存
  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    //保存
    Ini.WriteString('Section', 'ID', strID);
    Ini.WriteString('Section', 'IchiX', EditX.Text);
    Ini.WriteString('Section', 'IchiY', EditY.Text);
    Ini.WriteString('Section', 'WaitTime', cmbWaitTime.Text);
    Ini.WriteBool('Section','Info',chkInfo.Checked);
    //Userに通知
    MessageDlg('現在の設定を保存しました！', mtInformation, [mbOk] , 0);

    if not btnCopy.Enabled then btnCopy.Enabled:=True;

  finally
    Ini.Free;
  end;

end;

３．まとめ

（１）TEdgeBrowserを使えばOneDriveのサインイン画面をエラーなしで表示できる。
（２）サインイン画面へのIDの入力はプログラムコードで実行可能。
（３）IDはクリップボードに送信しておき、Ctrl＋Vでも貼り付け可能に設定。

４．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

追記（20230827 OneDriveアプリからオンライン表示へ切り替え）

サインイン ４　アプリからオンラインのOneDriveを表示

以下、『いかに苦労してOneDriveにサインインするか』という、上記サインイン ４に辿り着くまでの、長いながいまわり道の記録です。なので、お読みいただく価値がないことを最初に申し添えます。m(__)m

OneDrive接続専用Browserを作る！

【今回の記事】

１．動機は同期
２．WebView4Delphiコンポーネントを使う
３．プログラムでクリックを実行
４．特殊なフォルダを表示する
５．まとめ
６．お願いとお断り

１．動機は同期

この春から勤務先が変わり、それに伴って職場のPC環境も大きく変化して、ファイルのやり取りにOneDriveを利用することが多くなった。今までは、Windows11のアプリとして設定されているOneDriveを常に起動しておいて、必要な時、タスクバーから呼び出して使っていたが、バックアップ的な意味合いで利用することが多く、ファイル交換用途での利用はそれほど多くなかった。

複数のPC間でのデータのやりとりにOneDriveを利用するしかない現在の環境では、今まであまり考えたことがなかった同期のタイミングが問題になってきた。特に、それが『今すぐ』別のPCで使いたいファイルの場合、こっちのPCからクラウドにデータをアップロードして、直ちに、あっちのPCでそのデータをダウンロードしたいのだけれど、アプリのOneDriveでそれを実現する方法がわからない。

Google先生に尋ねても、『コレだ！』という答えは見つからず･･･。
（OneDriveの正しい使い方を私が知らないだけなのかもしれませんが）

仕方がないからアプリではなく、WebブラウザからOneDriveにサインインして、別のPCですぐに使いたいファイル（やフォルダ）をアップロード。別PC側でも同様にしてWebブラウザからOneDriveにサインイン、目的のファイル（やフォルダ）をダウンロードしていたんだけど･･･。

いったん接続してしまえば、ほっといても特に問題はないし、最新の状態に表示を更新したければ F5キー を押すだけだから、いいっちゃいいんだけど･･･。

OneDriveへのサインイン時にメールアドレスを入力するのが、かなりめんどくさい。

特に急いでいる時に入力を間違えたりすると、余計、イライラして、精神的に非常によろしくない。メモ帳にID替わりのメールアドレスを入力、デスクトップに保存しておいて、それをコピペすればいいかと思ったのだけれど、それすら面倒に感じてしまう自分がいよいよ情けなくなった･･･。

魂が腐っている･･･

他に作りたいプログラムも特に今はないし、仕事もそんなに忙しくはないから、思い切ってOneDriveへデータを即送受信できる専用ブラウザを作ることにした。

仕様は単純明快。起動したらOneDriveのサインイン画面を表示、メールアドレスを自動入力、あとはEnterキーを叩くだけ。これさえ出来れば、仕事はかなり快適に。

Delphiと力を合わせれば、そんなの１日でできるー！（･･･と、いつも思う）
かくしてOneDrive接続専用Browser作りが日曜日の朝、スタートしたのでした。

２．WebView4Delphiコンポーネントを使う

すぐに思い出したのは、（いつか、いじってみたい）と思っていたWebView4Delphiコンポーネント。

何かでその存在を知り、ダウンロードして、ちょっと触れてみたのは･･･確か、去年のことだった･･･と思いながら、2022年の作業を記録したフォルダ内をさがすとやっぱりあったWebView4Delphiコンポーネント。さっそく、これを今年の作業フォルダへコピーする。試しにdemoフォルダ内のプログラムを動かしてみると、問題なく動く。去年、ダウンロードした際に、コンポーネントのインストールまで行っていたようだ。

WebView4Delphiは、GitHub の salvadordf / WebView4Delphi からダウンロードできる。

salvadordf / WebView4Delphi

https://github.com/salvadordf/WebView4Delphi

Aboutには次の記述があり、

WebView4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC for Windows.

https://github.com/salvadordf/WebView4Delphi

ライセンスはMITだから、利用にあたっては「著作権表示および許諾表示をソフトウェアのすべての複製または重要な部分に記載」すればOK！　面倒なことは一切ない。

MITライセンスの正しい著作権表示および許諾表示の入れ方を教えてくれるWebサイト様もある。なんと有難いことか。作成者の方に心から感謝。

40代からプログラミング！
MITライセンスとは？無料ツール・テンプレートの利用方法と注意点

https://biz.addisteria.com/mit-license-1/

さっそく、WebView4Delphi コンポーネントに添付されている

demos\Delphi_VCL\MiniBrowser

これをベースにして、OneDrive接続専用Browser作りを開始する。

まず、次のようにGUIを作成。メールアドレスの自動入力という「目的」に合わせてVCLコンポーネントを追加する。

「ダウンロードフォルダを開く」は、後で説明。実行時、その右側のチェックボックス「設定」をチェックすると「入力ボタン」より右側のコントロールが出現する。

で、FormCreate手続きに自分用のコードを追加。

implementation

{$R *.dfm}

uses
  uTextViewerForm,
  uWVCoreWebView2WebResourceResponseView, uWVCoreWebView2HttpResponseHeaders,
  uWVCoreWebView2HttpHeadersCollectionIterator,
  uWVCoreWebView2ProcessInfoCollection, uWVCoreWebView2ProcessInfo,
  uWVCoreWebView2Delegates,
  //以下を追加
  Vcl.Clipbrd,
  System.IniFiles, System.UITypes,
  Winapi.ShlObj, Winapi.KnownFolders,
  Winapi.ShellAPI;

procedure TMiniBrowserFrm.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
  strID, strX, strY: String;
begin
  FGetHeaders             := True;
  FHeaders                := TStringList.Create;
  FFileStream             := nil;
  FUserAuthFrm            := nil;
  FResourceContents       := nil;
  FBlockImages            := False;
  FDownloadIDGen          := 0;
  FDownloadOperation      := nil;
  WVBrowser1.DefaultURL   := URLCbx.Text;

  //Formを最大化して表示
  MiniBrowserFrm.WindowState:=wsMaximized;

  //iniファイルの存在を確認
  if FileExists(ChangeFileExt(Application.ExeName, '.ini')) then
  begin
    //iniファイルからデータを読込み
    Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
    try
      strID:=Ini.ReadString('Section', 'ID', '');
      strX:=Ini.ReadString('Section', 'IchiX', '580');
      strY:=Ini.ReadString('Section', 'IchiY', '420');
    finally
      Ini.Free;
    end;
    //復号して表示（実際のプログラムではメールアドレスは暗号化処理している）
    Edit1.Text:=strID;
    EditX.Text:=strX;
    EditY.Text:=strY;
  end;

end;

あと、EXE の実行には、EXE のあるフォルダ内 に WebView2Loader.dll が必要。今回作成するのは64 ビット版の EXE だから bin64 フォルダ内の 64 ビット用DLL を使用しなければならない。

実際の動作の様子。実行時画面では･･･

「設定」にチェックすると･･･

ここにiniファイルから読み取ったサインイン用のID（メールアドレス）と、プログラムからクリックするアドレス入力欄の座標を表示（入力）する。

画面解像度が異なるPCでは、当然、フォーカスを当てたいサインイン用のメールアドレスを入力するフレームの表示位置が異なるから、最初にその位置座標を調べる必要がある。座標Checkにチェックを入れるとマウスポインタの現在位置のスクリーン座標が画面右上にリアルタイムで表示される仕組みだ。

マウスポインタが現在ある位置の座標を取得して表示するコードは･･･

procedure TMiniBrowserFrm.Timer2Timer(Sender: TObject);
var
  lh_Handle:  HWND;
  lpt_Pos:    TPoint;
  lrc_Rect:   TRect;
  lrg_Region: HRGN;
  li_Ret:     Integer;
begin
  if chkZahyo.Checked then
  begin
    //マウスカーソル位置をスクリーン座標で取得
    GetCursorPos(lpt_Pos);
    //自身のウィンドウリージョンを調べる
    lh_Handle := Self.Handle;

    //ウィンドウリージョン取得のため空のリージョンを作っておく
    lrg_Region := CreateRectRgn(0,0,0,0);
    try
      //ウィンドウリージョン取得
      li_Ret := GetWindowRgn(lh_Handle, lrg_Region);
      if (li_Ret <> ERROR) then begin
        //ウィンドウのRectを取得
        GetWindowRect(lh_Handle, lrc_Rect);
        //スクリーン座標からウィンドウの左上を原点とした座標に変換
        lpt_Pos.X := lpt_Pos.X - lrc_Rect.Left;
        lpt_Pos.Y := lpt_Pos.Y - lrc_Rect.Top;
        //ウィンドウリージョン内にマウスカーソルがあるかテスト
        if (PtInRegion(lrg_Region, lpt_Pos.X, lpt_Pos.Y)) then begin
          LabelXY.Caption:=Format('OK %d (%d-%d)', 
            [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end else begin
          LabelXY.Caption:=Format('NG %d (%d-%d)', 
            [li_Ret, lpt_Pos.X, lpt_Pos.Y]);
        end;
      end else begin
        LabelXY.Caption:=Format('X:%d, Y:%d', [lpt_Pos.X, lpt_Pos.Y]);
      end;
    finally
      DeleteObject(lrg_Region);
    end;
  end;
end;

で、最適なクリックポイントのＸ座標とＹ座標を読み取り、Editに入力、保存ボタンをクリックでiniファイルに保存する。

クライアント座標でなく、スクリーン座標としたのは、話をカンタンにするため。だからFormCreate手続きでFormを最大化して表示するように設定している。こうすればどんな解像度のPCでも、画面左上からのスクリーン座標でメールアドレスを入力するフレームの位置が決定できると考えたのだ。

実は、最初は「他のアプリへ文字列を送信」する方法で、サインイン画面を狙い撃ちしようと思っていたのだが、ブラウザの入力欄は「ウィンドウではない」ようで、目印にするハンドルがなく、簡単には文字列を送信できないことがわかった。

朝５時くらいから作業を始めて、半日くらいイロイロ悩んだのだけれど、お昼過ぎにようやくサインインのフレームが表示されている位置をプログラムからクリックして、フォーカスを当て、さらにプログラムからCtrl＋V（貼り付け）の操作を行い、iniファイルからクリップボードに読み込んでおいたメールアドレスを流し込めばイイと気づく。

そこで大きく方針を転換。文字列を送信ではなく、サインインのフレームをクリックしてメールアドレスを貼り付ける方向でGUIも、プログラムも準備した。

さらに「保存」ボタンは、メールアドレスとPCごとに異なるサインインのフレームの座標をiniファイルに書き込んで記録するために設置。

これで OneDrive接続専用Browser のGUIは完成。あとはプログラムを書くだけに。

※ 実際のプログラムでは、iniファイルにメールアドレスを保存する際に、さらにひと手間かけて暗号化、iniファイルから読みだす際に復号している。

３．プログラムでクリックを実行

普段、僕がいちばんよく利用するWebブラウザはFirefoxだ。インターネット黎明期、そう誰もが Netscape Navigator を使っていた頃からのファンなのだ。

プログラムを何度も動かして動作確認しているうちに、あることに気づく。それは何かと言うと、OneDriveのサインイン画面を表示した時の挙動が、Firefoxと作成中のOneDrive接続専用Browserではちょっと違うのだ。

FirefoxでOneDriveのサインイン画面を表示した場合は、メールアドレスを入力するフレームにセットフォーカスされた状態でサインイン画面が表示されるのに対し、作成中のOneDrive接続専用Browserではそうならない。しかも、アドレス入力欄を１回クリックしただけではダメ（セットフォーカスされない）で、２回クリックしないと入力待機状態にならない（１回めのクリックで、一瞬セットフォーカスされたように見えるが、その後、キャレットが消失してしまい、点滅状態にならない）。

DelphiのIDEから、Ctrl＋F で「SetFocus」を検索キーワードにコード全体を確認しても、それは「見つからなかった」。なぜ、２回クリックしないと入力待機状態にならないのか、その原因はさっぱりわからない。

原因はわからなくても、とにかくそれが現実だから、Webにあった情報を頼りにプログラムからアドレス入力欄をクリックするコードを書いてみた。

動的にマウスをクリックするには？

https://www.petitmonte.com/bbs/answers?question_id=2014

予め、先に示したマウスカーソルの位置座標を調べるコードで、アドレス入力欄の座標を調査・記録しておいて、Formが完全に描画されたところでプログラムコードからアドレス入力欄をクリックする。

  private
    { Private 宣言 }
    //アドレス貼り付け実行の成否
    boolInput:boolean;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

procedure TMiniBrowserFrm.CMShowingChanged(var Msg: TMessage);
var
  dwFlags : DWORD;
  X,Y : Integer;
  //LKeyByte : Byte;
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    fgWaitBreak:=False;
    WaitTime(1000);
    //クリップボードを初期化
    Clipboard.Clear;
    //文字列をクリップボードに格納
    Clipboard.AsText:=Edit1.Text;

    dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;
    X:=Trunc(StrToInt(EditX.Text)/Screen.Width*65537);
    Y:=Trunc(StrToInt(EditY.Text)/Screen.Height*65535);

    //移動
    Mouse_Event(dwFlags,X,Y,0,0);
    Application.ProcessMessages;

    //クリック
    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    Application.ProcessMessages;

    WaitTime(300);

    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    Application.ProcessMessages;

    Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);

    // [Ctrl] + [V] のキー操作 -> btnCopyClick手続きで実行
    {
    LKeyByte := Ord('V');
    keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
    keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   0, 0);
    keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   KEYEVENTF_KEYUP, 0);
    keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
    }
    WaitTime(1500);
    btnCopyClick(nil);
    if boolInput then btnCopy.Enabled:=False;
  end;
end;

WaitTimeなる関数は、次のWebサイト様で紹介されていたものをそのまま使用。

待ち関数の必要性

https://gumina.sakura.ne.jp/CREATION/OLD/COLUMN/CD1MATI.htm

function TMiniBrowserFrm.WaitTime(const t: integer): Boolean;
var
  Timeout: TDateTime;
begin
  //待ち関数  指定カウントが経過すれば True, 中断されたならば False
  fgWaitBreak := False;
  Timeout := Now + t/24/3600/1000;
  while (Now < Timeout)and not fgWaitBreak do begin
    Application.ProcessMessages;
    Sleep(1);
  end;
  Result := not fgWaitBreak;
end;

WaitTime関数の引数の値を様々に変えて実行してみると、MyPCでは、上記の数値で確実にアドレス入力欄をプログラムコードからクリックすることに成功！

メールアドレスをCtrl＋Vする部分は、GUIの「入力」ボタンと共用だからボタンのClick手続き側に記述して呼び出す（実行する）ことにする。これだと都合４回、アドレス入力欄をクリックすることになるが、単にクリックするだけだから２回でも、４回でも大差ないだろう。むしろ、確実に動かすための保険だと考え、このままにする。

procedure TMiniBrowserFrm.btnCopyClick(Sender: TObject);
var
  dwFlags : DWORD;
  X,Y : Integer;
  LKeyByte : Byte;
begin

  boolInput:=False;

  try

    //クリップボードを初期化
    Clipboard.Clear;
    //文字列をクリップボードに格納
    Clipboard.AsText:=Edit1.Text;

    dwFlags:=MOUSEEVENTF_MOVE or MOUSEEVENTF_ABSOLUTE;
    X:=Trunc(StrToInt(EditX.Text)/Screen.Width*65537);
    Y:=Trunc(StrToInt(EditY.Text)/Screen.Height*65535);

    //移動
    Mouse_Event(dwFlags,X,Y,0,0);
    //クリック
    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    //Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
    Application.ProcessMessages;
    WaitTime(500);
    Mouse_Event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
    Mouse_Event(MOUSEEVENTF_LEFTUP,0,0,0,0);
    Application.ProcessMessages;

    // [Ctrl] + [V] のキー操作
    LKeyByte := Ord('V');
    keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
    keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   0, 0);
    keybd_event(LKeyByte,   MapVirtualKey(LKeyByte, 0),   KEYEVENTF_KEYUP, 0);
    keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);

    boolInput:=True;

  except

    boolInput:=False;

  end;

end;

動作確認すると、ごく、たまーにメールアドレスが自動入力されないこともあるが、９割方予期した通りに動作してくれる。メールアドレスが自動入力されない場合でも、クリップボードにデータは間違いなく読み込まれているから、手動でCtrl＋Vすればいいだけだ。

いちいち、メールアドレスを入力することに比べれば、Ctrl＋VしてEnterキーを押す方がずっとカンタンだ。イイ感じになってきた。

４．特殊なフォルダを表示する

実際にファイルをOneDriveへ、アップロードしたり、ダウンロードしたり、動作確認を行ってみると、任意のタイミングでダウンロードフォルダを開く機能が欲しくなった。なので、これをボタンクリックで実行できるようにする。

ダウンロードフォルダができたのはWindows Vista以降のようで、この特殊なフォルダへのPathを取得するには、SHGetKnownFolderPath 関数を使うらしい。コードはいつもお世話になるMr.XRAYさんのWebサイトの記事を参考にして書く。

460_特殊フォルダのフルパスを取得

http://mrxray.on.coocan.jp/Delphi/plSamples/460_SpecialFolderPath.htm#08

GUIDの一覧は、次のWebサイトにあった。こちらの情報でダウンロードフォルダのGUIDがわかった。

ファイル ダイアログ ボックスのカスタム プレイス用既知のフォルダー GUID

https://learn.microsoft.com/ja-jp/dotnet/desktop/winforms/controls/known-folder-guids-for-file-dialog-custom-places?view=netframeworkdesktop-4.8

ボタンクリックで、ダウンロードフォルダを開く手続きは次の通り。

procedure TMiniBrowserFrm.btnOpenDLFolderClick(Sender: TObject);
var
  FolderID:TGUID;
  FolderPath:PChar;
  D_FolderPath, ExeFileName:string;
  LhInst:Cardinal;
begin
  //ダウンロードフォルダのGUIDを指定
  FolderID:=StringToGUID('{374DE290-123F-4565-9164-39C4925E467B}');
  if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
  begin
    D_FolderPath := FolderPath;
    //ダウンロードフォルダを開く
    ExeFileName:= 'explorer.exe';
    LhInst:=ShellExecute(Handle, 'open', PChar(ExeFileName), 
      PChar(D_FolderPath), nil, SW_SHOW);
    if LhInst <= 32 then
    begin
      MessageBox(Handle, '起動に失敗しました．', '情報', MB_ICONINFORMATION);
    end;
  end;
end;

５．まとめ

WebView4Delphiコンポーネントのdemoにあるサンプル（MiniBrowser）に、以下の内容を追加したプログラムを使えばOneDrive自動サインインは可能。その手順は次の通り。

（１）プログラムコードでアドレス入力欄をクリックしてセットフォーカス。
（２）クリップボードに送ったメールアドレスを、プログラムコードでCtrl＋V。
（３）Enterキー押し下げでOneDriveへ接続。データは即送受信可能になる。

さらに、SHGetKnownFolderPath 関数でダウンロードフォルダへのPathを取得して、エクスプローラで表示すればより一層便利に使えそう。

６．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Googleカレンダーを利用して、三者面談の日程表を自動的に作成する方法を学んだ。

【Gooleカレンダーとフォーム】全自動・三者面談の日程調整をつくる

https://www.fy1203.com/2020/03/21/calendar-form/

やりたいこと、そのものスバリの情報に大感謝！
ただ、残念なことに一部、情報が古くなってしまっており、そこでちょっと試行錯誤があったので、最新の情報を含めるカタチで、作成方法をここにメモ。

【今回の記事】

１．専用カレンダーの作成
２．入力フォームの準備
３．スプレッドシートを準備する
４．スクリプトを用意する
５．トリガーを設定する
６．プレビューで動作確認
７．まとめ
８．お願いとお断り

１．専用カレンダーの作成

（１）Googleアカウントがなければ作成。

（２）Googleのトップページの右上のGoogleアプリから、「カレンダー」をクリック

（３）カレンダーが開くので、左下の他のカレンダーを追加「＋」をクリック

（４）「新しいカレンダーを作成」をクリック

（５）カレンダーの名前と説明を決めて、「カレンダーを作成」をクリック

２．入力フォームの準備

（１）次は入力フォームです。まず、フォルダを作成しておきます。

（２）Googleドライブの左上の「新規」をクリックして、サブメニューを表示します。

（３）「新しいフォルダ」をクリックして、

（４）フォルダに最適な名前を付けます。この場合、「三者面談」としました。

（５）そのフォルダに入り、「新規」→「Googleフォーム」と順にクリックします。

（６）新しいフォームの作成画面が開きます。

（７）このGoogleフォームで、入力フォームを作成します。タイトルと説明を入力し、画面中央右の設定ボタンをクリックします。

（８）私は、次のように設定してみました（誤りがあるかもしれません）。

（９）設定が終了したら、質問タブをクリック して、画面を切り替えます。

（10）1問目の出席番号は、「プルダウン」から選択するように設定しました。

（11）入力を「必須」にするため、状態を「ON」にします。

（12）質問を追加します。画面右上の 〇囲みの＋マークをクリック します。

（13）２つめの問は名前です。次のように「記述式」にして、「必須」は「ON」の状態にします。終わったら、右の 〇囲みの＋マークをクリック します。

（14）３つめの問は予約日です。次のように入力します（日付は適当です）。

（15）メニューから「年を含める」のチェックを外します（年を含めるをクリックすれば、チェックが外れます）。

（16）これで入力が「月、日」だけになりました。さらに･･･

（17）４つめの問は開始時間です。「時刻」にして、「必須」は「ON」の状態にします。

これで、フォームの作成は終了です。

３．スプレッドシートを準備する

（１）次に、回答を整理するスプレッドシートを用意します。画面上の「回答」→「スプレッドシートにリンク」をクリックします。

（２）下の画面が表示されるので、次のようにタイトルを入力して「作成」をクリック。

これで、スプレッドシートが作成されます。

４．スクリプトを用意する

（１）画面の表示が「スプレッドシートにリンク」から「スプレッドシートで表示」に変わっていることを確認して、「スプレッドシートで表示」をクリックします。

（２）新しいページにスプレッドシートが表示されます。ここに必要なスクリプトを追加します。

※ 追加するスクリプトは次のWebサイト様で紹介されているものです。

【Gooleカレンダーとフォーム】全自動・三者面談の日程調整をつくる

https://www.fy1203.com/2020/03/21/calendar-form/

（３）スプレッドシートの画面上から、「拡張機能」をクリックして、表示されるサブメニューにある「App Script」をクリックします。（2023年６月現在の操作方法です。ここが上記Webサイト様の記事と異なります。いつの間にか、現在の形式へと変更されたようです。）

（４）新しいページが開き、次の画面が表示されます。

（５）クッキーの使用を許可します。

（６）「無題のプロジェクト」をクリックして、プロジェクト名を「１年A組面談希望調査」に変更して、下の「名前の変更」をクリックします。

（７）次のようなスクリプトの入力画面が表示されます。

（８）次の引用リンク先のWebサイト様で紹介されているスクリプトを１行目から範囲選択して、クリップボードにコピーし、入力画面に（既存のテキスト全体を選択しておいて）上書きします（関数の名前がMyFunctionからsendToCalendarになり、引数（ひきすう）も「空」でなく「ｅ」になります）。

【Gooleカレンダーとフォーム】全自動・三者面談の日程調整をつくる

https://www.fy1203.com/2020/03/21/calendar-form/

（９）コピペしたスクリプトを３か所「確認」または「変更」します。

【その１】

・４行目のYear指定を確認してください。必要であれば、現在の西暦年に変更します。

【その２】

16行目「カレンダーID」を変更します。

最初のカレンダーの画面を開き、画面左の「１年A組三者面談」の右にある「…」をクリックします。

Googleのトップページの右上から、「カレンダー」をクリック。

画面の左下にある「１年A組三者面談」をポイントすると表示される縦の「･･･」をクリックします。

表示されるサブメニューから「設定と共有」をクリックします。

「カレンダーの設定」画面が表示されます。下へスクロールすると、かなり下の方にカレンダーIDがあります。これをコピーします。

コピーしたIDをスクリプトの16行目に貼り付けます。

※ 「＊＊＊カレンダーIDを入力＊＊＊」部分とカレンダーIDを入れ替えます。

【その３】

３１行目の面談時間を「確認」または「変更」します。

以上でスクリプトの確認と変更は完了です。

５．トリガーを設定する

（１）スクリプトが自動的に実行されるように設定します。画面右にある＜＞部分をポイントすると、時計のマークの「トリガー」が現れるので、この「トリガー」をクリックします。

（２）トリガー設定画面が開くので、画面右下にある「トリガーを追加」をクリックします。

（３）イベントの種類を「フォーム送信時」に設定して、「保存」をクリックします。

※ この画面で「実行する関数を選択」が空欄になっている場合は、スクリプトのコピペが１行目を含んだ形で（正しく）行われているかどうか、また、スクリプトが保存されているかどうか、確認してください。

（４）次のエラーメッセージが表示された場合は、ブラウザのポップアップブロック（別Windowを自動的に開かない設定がおそらくデフォルトになっている？）を、このトリガー設定ページからの保存操作であれば解除されるように設定してください（操作方法はブラウザにより異なります）。

（５）紐づけるアカウントをクリックします。

（６）My環境では、Googleからの確認画面が表示されました。画面左下の「Advanced（詳細？）」をクリックします。

（７）（必要であれば、画面を下にスクロールして）「unsafe：安全ではない」と表示されている「１年A組面談希望調査」へのリンクをクリックします。

（８）次の画面が表示されます。

Allow（許可）をクリックします。これで入力フォームからGoogleカレンダーへデータが送信されたときに、自動的にスクリプトが実行されるようになります。

６．プレビューで動作確認

（１）画面右上の「プレビュー（目のマーク）」をクリックします。

（２）入力フォームに必要事項を入力して、「送信」ボタンをクリックします。

（３）送信されたメールの内容を確認します。

（４）Googleカレンダーに予約状況が表示されます。

（５）カレンダーに予約状況が表示されない時は、トリガーの設定が正しく保存されているか、どうか、確認してください。（私が最初にテストした際は、Googleカレンダーに予約状況が表示されませんでした。ちょっと焦りましたが、手順を一つひとつ確認して行く中で、トリガーの設定が正しく保存されていなかったことに気づき、この部分の設定作業をやり直したところ、無事、予約状況がGoogleカレンダーに表示されるようになりました。）

７．まとめ

（１）Googleカレンダーを使えば、三者面談自動予約システムは作成可能。
（２）Webには多くの情報があるが、機能の更新が頻繁にあるので時々見直す必要あり？
（３）最終的な面談時刻の確認は、別の連絡手段で確実に行う必要がある。

８．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

「再編」

そこに、１台のNASがあった。

時とともに　アクセスする人も変わり
記録方法も　場所も　いつしか　ランダムに･･･

参照したい「データ」　それが「どこ」にあるのか
わかりづらくなってしまった NAS･･･

エントロピーは　必ず　増大するから
長期間に及ぶ運用の結果として 「生まれた」 この状況は
理論的には　正しい ･･･ のかもしれない･･･。

ただ･･･　あの日、確かに･･･

なんとか　出来ないのか？

叫ぶような　声を聞いた。
それは　僕に向けての　声ではなかったけれど･･･

僕は　応えようと　思った。
これまでに培ったネットワークドライブ接続に関する知識。

そのすべてを　賭けて。

【目次】

１．ネットワークドライブ
２．システムエラー1219
３．アカウントに読み書き権限を付与
４．まとめ
５．お願いとお断り

１．ネットワークドライブ

かつて、別セグメントにあるファイルサーバに接続して、その共有フォルダをネットワークドライブとして、マイコンピュータに表示するプログラムを書いたことがあった。

そうだ。あのセグメント越えのプログラムを書いたのは･･･　もう10年以上、前のことだ。

あの時は、ファイルサーバを別セグメントに用意する必要があったけれど。
今、共有フォルダを再構成したいNASは、みんながログオンするセグメント上にある･･･。
なんとか･･･しなければならない敷居は、10年前より、ずっと低い。

もちろん、自分的にいちばん、イイのは･･･　新しいファイルサーバを用意して、現在のファイル共有の仕組みそのものをイチから作り直すこと、なんだけれど。

でも、それは無理だ。今年度、そんな予算は１円だって計上されてない。
今の環境と機材の中で、なんとかするしか、ない。

今あるNASをなんとか創意工夫して、運用するしか、ないのだ。

（ 今のファイル共有を維持したまま、新しい共有環境を作るには、どうしたらいい？ ）

自問自答を繰り返す。
無理だという前提は一切排除する。
あきらめない限り･･･何とか出来る方法が、必ずあるはずだ。
僕は毎日、あらゆる意味で、いちばんイイ方法を考え続けた。

（ 再編する共有フォルダのみ　ネットワークドライブとして表示すれば いい ）

（ 再編に必要なフォルダは　予め用意して･･･ ）

（ そこへ必要なファイルだけを移動させるんだ･･･ ）

朝、出勤途中、クルマを運転しながら、そんな考えが浮かんだ。
ようやく答えに繋がるヒントが見えた･･･ 気がした。

職場に着いた僕は、NASを管理するDSMを起動してみた。前の職場では、自前でサーバ機を用意して、アクティブディレクトリを使ったファイル共有の仕組みを作っていたが、それがたまらなく懐かしくなる･･･。

おいおい　アクティブディレクトリ･･･　きみは嫌いだったんじゃ　ないか？

自分の気持ちの変化に驚きながら、管理画面を見ていて（ あれ？ ）って思った。

（ リサイクルフォルダがものすごい容量を喰ってる･･･ ）

･･･ってことは、このNAS自体のバックアップの仕組みがどうなっているのか、それはわからないけれど、とにかくNAS全体でゴミ箱の設定が有効になってるわけだ。よくよく見ると一般ユーザーはそこにアクセスできないけれど、管理者にはそれができるようだ･･･。もしかして、バックアップの代わりに、ゴミ箱を有効化してる･･･？

それなら、話は簡単だ。
バックアップ用の媒体を別に用意して、そちらに日々のバックアップをとり、リサイクルフォルダを使わない設定に変更すればいい。これでNASの空き容量を増やせるはずだ。

そうだ。どこかにバックアップさえ、きちんと作れたら･･･
ファイルサーバを新しく用意しなくても、なんとか、なるんじゃないか？

そう思った瞬間、この問題の完全な解決方法が「見えた」気がした。

リサイクルフォルダを使わない設定にすれば、今より確実に空き容量は増える。で、NASのルートに、これまで使われていない「共有」って名前のフォルダを新しく作り、その下に、クライアントPCのマイコンピュータにネットワークドライブとして表示する新しいフォルダ群を用意して、必要なフォルダとファイルだけ、そこに「コピーではなく、移動」すれば、現在のファイル共有環境を生かしたまま、新しいファイル共有環境を同じNASの中に再構成することが出来るんじゃないか･･･。

お金と手間をかければ、もっといい方法もあるのかもしれないが、それが無理な現状ではおそらく、これがベストに近い解決策なんじゃないか？　･･･そう思えてきた。

で、バックアップは･･･　どこへ　とればいい？

取り敢えず、僕の手元には、前任者から引き継いだ、用途を限定せずに利用できる空き容量１TBのSSDがある。これに最も重要なデータのバックアップをとろう。で、事務方の責任者に必要十分な容量のバックアップメディアがどうしても必要なことを説明して、理解が得られたら、速やかに可能な限り大容量のバックアップ用HDDを購入してもらおう。

それから、万一の火災等の事故への対応も考えなければならない。
バックアップのバックアップは、どこに、作ればいい？

僕は、先日、複合機のスキャナーでスキャンした画像データを出力する設定を行ったばかりの･･･ 別の部署にあるNASにかなりの空き容量があったことを思い出した。

新しく再編する共有フォルダだけをバックアップするなら、あのNASを利用すればなんとかなるんじゃないか？

これで、だいたいの見通しが立った。あとはやるだけだ。

まず、バックアップ（のバックアップ）用途に使いたいNASの保管場所を、安全な場所に変えなければならない。現在でも夜間はアラームのかかる部屋に、そのNASは設置されているのだが、これを24時間、施錠された部屋に移設することにした。

幸いにしてバックアップ（のバックアップ）用途に使いたいNASが設置されている部屋は、最初から情報処理用途に準備された部屋なので、床下がネットワークの配線に使える。

床の四角いカーペットを剥いで、その下の床板を外し、LEDライトを片手に、24時間施錠された小部屋までの経路を探ってみる。

床下に障害となるような構造物はない。なんとか、なりそうだ。竹製の１ｍ物差しを何本も用意して、床下に差し入れ、LANケーブルを物差しの先端に養生テープで固定して、鍵のかかる小部屋へ向けて１本、２本とそれを養生テープで繋ぎ、少しずつ、慎重にLANケーブルを送る。

無事、LANケーブルは小部屋へ到達。
なんで汗まみれになるのか、知らないが。

バックアップ用のNASのユーティリティの起動方法がわからないので、覚悟を決めて、NASの電源ボタンを長押し。するとWebの解説にあった通り、Beep音が鳴ってNASはシャットダウンされた。

このNASには、もう一つ、何か別用途でのNASが接続されていた。シャットダウン時、果たしてどうなるか心配したけれど、そちらも同時に電源が切れた。なんだか、わからないけれど、取り敢えず二つのNASの電源は連動しているようだ。

NASに繋がっている電源とLANケーブルを全て外し、二つのNASをこの上なく大切に抱えて、24時間施錠された小部屋へ移設する。

鍵のかかる小部屋の床には、幸いにして電源コンセントが用意されていた。部屋の状況から判断しておそらく、以前はここにサーバ機が置かれていたのだろう･･･。

雷対策が施された電源の延長コードをコンセントに差し込んで、これにNASの電源ケーブルを繋ぐ。

続けてLANケーブルも接続。
接続状態に問題がないことを何度も確認し、祈るような気持ちで、NASの電源スイッチをONにする。

何事もなかったかのように、２台のNASが無事、再起動した。
これでハードウェアの準備はOKだ。

次は、NASの共有フォルダをネットワークドライブとして各クライアントPCのマイコンピュータに表示する、オリジナルプログラムを用意しなくてはならない。

僕は以前にDelphiで書いたネットワークドライブ接続のプログラムをバックアップ用のHDDから探し出し、プロジェクトを My PC のデスクトップにコピーした。

Delphiを起動すると、十数年前に作った、懐かしいGUIが現れた。

現在の状況に合わせて、必要な部分を書き換える。
ユーザーが自分の自由意思で、メイン画面からスタートアップに登録できるようにする。
あと、IDとPasswordも暗号化してイニシャライズファイルに保存。プログラム起動時に自動的に読み込んで表示するように設定を変更。

このNASの共有フォルダをネットワークドライブとして表示するプログラムの「接続」ボタンにたどり着くためには、ユーザーは生体認証とPIN入力の２段階認証を潜り抜ける必要があるから、この設定で、セキュリティ的に問題はないはずだ。

このプログラムを書いた時は、別セグメントにあるファイルサーバに接続できるよう、確か、RouteADDコマンドを使ってクライアント機のルーティングテーブルを書き換えたんだ･･･。で、その際、設定の変更を残す（＝記録する）ｐオプションはわざと指定せずに、シャットダウンすれば自動的に設定が、ルーティングテーブルを書き換える前の状態に戻るようにしたんだ。

このRouteADDコマンドを実行するBATファイルを、プログラム内部で生成して動かすところがすごく難しかったんだ･･･。RunAsAdmin･･･　確か･･･夏に思い立って、プログラムが完成したのは秋が深まったころだった。

今回、接続したいNASは同じセグメント内にあるから、PCのルーティングテーブルを書き換える必要はない。NASの共有フォルダをクライアント機のマイコンピュータにネットワークドライブとして表示するだけだから、その手続きはより簡単に済む。

あの時、表示する共有フォルダは、「個人フォルダ」・「校内共有」・「校務分掌」・「教科」に設定した気がする。今回、個人フォルダはどうするか･･･？

NASの設定を調べてみるとラッキーなことに、新しくユーザーアカウントを作るとhomesフォルダにそのユーザー専用のホームフォルダが用意されることがわかった。試しに「test-u」というアカウントを作成してみると、homesフォルダに「test-uフォルダ」が確かに出来ている。これを「個人フォルダ」ネットワークドライブとして表示すればいい。

NASのルートには「共有」という名前のフォルダはなかったので、早速それを作成し、その下に「校内共有」・「校務分掌」・「教科」の各フォルダを準備する。あとは接続プログラム側で各共有フォルダへのPathを接続情報として指定すればOKのはずだ。

DSMで確認したら、NASのドメイン名は指定されていなかった。koumu.localとでも設定しようかと思ったが、現状の変更を最小限に留めておくことにし、やめておくことにした。

ネットワークドライブを設定して表示するプログラムは次の通り。

procedure TForm1.Button1Click(Sender: TObject); // ネットワークドライブの接続
var
  PW,ID:string;
  //iniファイル読込み
  Ini: TIniFile;
  strW,StrX,StrY,strZ:String;
  strDomainName:String;
  //ネットワークドライブ名変更
  X,D:Variant;
  InfoStr1,InfoStr2,InfoStr3:string;
  //スタートアップに登録
  MyObject : IUnknown;
  MySLink  : IShellLink; // ShlObj
  MyPFile  : IPersistFile; // ActiveX
  Directory : String;
  WFileName : WideString;

const
    MyRegFile : string = 'Software\Microsoft\Windows\CurrentVersion\Explorer';
    MyMessage : string = 'スタートアップに登録しますか？';
    MyFolders : string = 'Startup';

begin

  //接続先ドメイン名を取得
  //iniファイル読込み
  Ini:=TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    //実際にはマスターパスワードを暗号化文字列から復元している
    MasterPassW:='XXXXXXX';
    //テキスト暗号化設定情報を読込み
    strDomainName:=暗号化文字列から複合する関数(Ini.ReadString('セクション', 'DomainName', 'デフォルト値'),
      MasterPassW, False);
  finally
    Ini.Free;
  end;

  //【準備作業】Password,IDを確認して変数へ取得
  try
    //カーソルを待機状態に変更
    Screen.Cursor:=crHourGlass;

    //UserName(ID)確認
    if Edit1.Text='' then
    begin
      MessageDlg('IDが無効です！', mtInformation, [mbOk] , 0);
      Edit1.SetFocus;
      Exit;
    end else begin
      //有効なドメイン名がある場合
      //ID:=strDomainName+'\'+JTrim(Edit1.Text);
      //ドメイン名がない場合
      ID:=JTrim(Edit1.Text);
    end;

    //パスワードを確認
    if Edit2.Text='' then
    begin
      MessageDlg('パスワードが無効です！', mtInformation, [mbOk] , 0);
      Edit2.SetFocus;
      Exit;
    end else begin
      PW:=JTrim(Edit2.Text);
    end;
  finally
    Screen.Cursor:=crDefault;
  end;

  //【第１段階】ルーティング情報の設定を実行

  // 今回接続するNASは同じセグメントにあるので
  //ルーティングテーブルの書き換えは不要

  //【第２段階】ネットワークドライブを追加

  //カーソルを待機状態に変更
  Screen.Cursor:=crHourGlass;

  //ドライブ設定情報読込み
  //iniファイル読込み
  Ini:=TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    //マスターパスワード
    MasterPassW:='XXXXXXX';
    //ShowMessage(MasterPassW);
    //テキスト暗号化設定情報を読込み
    strW:=暗号化文字列から複合する関数(Ini.ReadString('セクション', 'W_Drive', 'デフォルト値'), MasterPassW, False)+JTrim(Edit1.Text);
    strX:=暗号化文字列から複合する関数(Ini.ReadString('セクション', 'X_Drive', 'デフォルト値'), MasterPassW, False);
    strY:=暗号化文字列から複合する関数(Ini.ReadString('セクション', 'Y_Drive', 'デフォルト値'), MasterPassW, False);

    if ComboBox1.Text<>'' then
    begin
      //ComboBox1が空欄でなければ教科のドライブにも接続
      strZ:=EDText(Ini.ReadString('セクション', 'Z_Drive', 'デフォルト値'),
        MasterPassW, False)+ComboBox1.Text;
    end else begin
      StrZ:='';
    end;
  finally
    Ini.Free;
  end;

  //ネットワークドライブを切断
  NetDel;

  //ネットワークドライブ接続確認用変数を初期化
  NetDrvError:=False;

  try

    //Userへの通知
    ProgressBar1.Visible:=True;
    if ComboBox1.Text<>'' then
    begin
      ProgressBar1.Max:=4;
    end else begin
      ProgressBar1.Max:=3;
    end;
    ProgressBar1.Position:=0;

    //ネットワークドライブ（個人フォルダ）を追加
    AddNetworkDrive('W:', strW, '', PW, ID);
    if not (NetDrvError) then
    begin
      //ネットワークドライブ名を変更
      X:=CreateOleObject('Shell.Application');
      D:=X.NameSpace('W:\');
      D.Items.Item.Name:='個人フォルダ';
      ProgressBar1.Position:=ProgressBar1.Position+1;
    end else begin
      NetDrvError:=False;
      MessageDlg('Error：個人フォルダに接続できません！', mtError, [mbOk] , 0);
      Exit;
    end;

    //ネットワークドライブ（校内共有）を追加
    AddNetworkDrive('X:', strX, '', PW, ID);
    if not (NetDrvError) then
    begin
      //ネットワークドライブ名を変更
      X:=CreateOleObject('Shell.Application');
      D:=X.NameSpace('X:\');
      D.Items.Item.Name:='校内共有';
      ProgressBar1.Position:=ProgressBar1.Position+1;
    end else begin
      NetDrvError:=False;
      MessageDlg('Error：校内共有に接続できません！', mtError, [mbOk] , 0);
      Exit;
    end;

    //ネットワークドライブ（校務分掌）を追加
    AddNetworkDrive('Y:', strY, '', PW, ID);
    if not (NetDrvError) then
    begin
      //ネットワークドライブ名を変更
      X:=CreateOleObject('Shell.Application');
      D:=X.NameSpace('Y:\');
      D.Items.Item.Name:='校務分掌';
      ProgressBar1.Position:=ProgressBar1.Position+1;
    end else begin
      NetDrvError:=False;
      MessageDlg('Error：校務分掌に接続できません！', mtError, [mbOk] , 0);
      Exit;
    end;

    //ネットワークドライブ（教科）を追加
    if ComboBox1.Text<>'' then
    begin
      AddNetworkDrive('Z:', strZ, '', PW, ID);
      if not (NetDrvError) then
      begin
        //ネットワークドライブ名を変更
        X:=CreateOleObject('Shell.Application');
        D:=X.NameSpace('Z:\');
        D.Items.Item.Name:=ComboBox1.Text;
        ProgressBar1.Position:=ProgressBar1.Position+1;
      end else begin
        NetDrvError:=False;
        MessageDlg('Error：'+ComboBox1.Text+
          'フォルダに接続できません！', mtError, [mbOk] , 0);
        Exit;
      end;
    end;

    if not (NetDrvError) then
    begin
      //接続ボタンを使用不可に設定
      Button1.Enabled:=False;
      //接続状態の表示を設定
      Label4.Caption:='状態：接続中';
      Label4.Transparent:=False;
      Label4.Color:=clLime;
    end;

  finally
    Screen.Cursor:=crDefault;
    ProgressBar1.Position:=0;
    ProgressBar1.Visible:=False;
  end;

  //【第３段階】最終処理

  //コンピュータを開く
  ShellExecute(Handle, 'Open','EXPLORER.EXE','::{20D04FE0-3AEA-1069-A2D8-08002B30309D}','',SW_SHOW);

  //タスクトレイへ常駐する手続きを呼び出し
  MovetoTasktray;

  //カーソルを元の状態に変更
  Screen.Cursor:=crDefault;

  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    //設定情報を初期化
    InfoStr1:='';
    InfoStr2:='';
    InfoStr3:='';
    //テキスト暗号化
    InfoStr1:=暗号化文字列を作成する関数(Edit1.Text,Unit1.MasterPassW, True);
    InfoStr2:=暗号化文字列を作成する関数(Edit2.Text,Unit1.MasterPassW, True);
    InfoStr3:=暗号化文字列を作成する関数(ComboBox1.Text,Unit1.MasterPassW, True);
    //ネットワークドライブ設定情報
    //iniファイルに保存
    Ini.WriteString('セクション', 'UserID', InfoStr1);
    Ini.WriteString('セクション', 'UserPW', InfoStr2);
    Ini.WriteString('セクション', 'UserSubject', InfoStr3);
  finally
    Ini.Free;
  end;

  //スタートアップに登録
  {
  if Application.MessageBox(PChar(MyMessage),'確認',
    MB_YesNo + MB_IconQuestion) = IdNo then exit; // Noなら何もしないで終わり
  }

  if chkStartup.Checked then
  begin
    //Yesなら
    MyObject := CreateComObject(CLSID_ShellLink);
    MySLink  := MyObject as IShellLink;
    MyPFile  := MyObject as IPersistFile;
    MySLink.SetPath(PChar(Application.ExeName));
    with TRegIniFile.Create(MyRegFile) do
    try
      Directory := ReadString('Shell Folders',MyFolders,'') + '\';
      WFileName := Directory + Application.Title + '.Lnk';
      MyPFile.Save(PWChar(WFileName),False);
    finally
      Free;
    end;
  end;

end;

ネットワークドライブの割り当て手続きは次の通り。

procedure AddNetworkDrive(Drive, UNC, Comment, Password, UserName: string);
var
  NetResource: TNetResource;
{$IFDEF UNICODE}
  user, pass: PWideChar;
{$ELSE}
  user, pass: PChar;
{$ENDIF}
begin
{$IFDEF UNICODE}
	with NetResource do
  begin
  	dwType := RESOURCETYPE_DISK;
    lpLocalName := PWideChar(Drive);
    lpRemoteName := PWideChar(UNC);
    lpComment := PWideChar(Comment);
    lpProvider := nil;
  end;
  if (Password = '') then
    pass := nil
  else
    pass := PWideChar(password);
  if (UserName = '') then
    user := nil
  else
    user := PWideChar(UserName);
{$ELSE}
	with NetResource do
  begin
  	dwType := RESOURCETYPE_DISK;
    lpLocalName := PChar(Drive);
    lpRemoteName := PChar(UNC);
    lpComment := PChar(Comment);
    lpProvider := nil;
  end;
  if (Password = '') then
    pass := nil
  else
    pass := PChar(password);
  if (UserName = '') then
    user := nil
  else
    user := PChar(UserName);
{$ENDIF}
  if (WNetAddConnection2(NetResource, pass, user, 0) <> NO_ERROR) then
  begin
    //エラー発生時の処理
  	NetErrorProc(GetLastError);
    NetDrvError:=True;
  end else begin
    //エラーが発生しなかった場合の処理
    NetDrvError:=False;
  end;
end;

ネットワークドライブの接続解除手続きは次の通り。

procedure RemoveNetworkDrive(Drive: string);
begin
  if (Drive = '') then exit;
{$IFDEF UNICODE}
	WNetCancelConnection2(PWideChar(Drive), 0, true);
{$ELSE}
	WNetCancelConnection2(PChar(Drive), 0, false);
{$ENDIF}
end;

ネットワークドライブを切断する手続きは次の通り。

procedure TForm1.NetDel;
begin
  //Network Driveを切断
  RemoveNetworkDrive('W:');
  RemoveNetworkDrive('X:');
  RemoveNetworkDrive('Y:');
  RemoveNetworkDrive('Z:');
end;

プログラムをコンパイルして出来たexeをクラウド経由で支給されたノートPCへ送った僕は、プログラムを起動して、必要事項を入力し、祈るような気持ちで「接続」ボタンをクリックした･･･。

２．システムエラー 1219

最初から上手く行くとは思っていなかったけど、やはりエラーは心に痛い。しかも、数字しか表示されてないから、接続プログラム内に僕が予め用意したエラーの通知文にはないエラーだ。

procedure NetErrorProc(err: DWORD);
var
  s: String;
begin
  case err of
    ERROR_ACCESS_DENIED:  s := ERR_ACCESS_DENIED;
    ERROR_ALREADY_ASSIGNED:  s := ERR_ALREADY_ASSIGNED;
    ERROR_BAD_DEV_TYPE:  s := ERR_BAD_DEV_TYPE;
    ERROR_BAD_NET_NAME:  s := ERR_BAD_NET_NAME;
    ERROR_BAD_PROFILE:  s := ERR_BAD_PROFILE;
    ERROR_BAD_PROVIDER:  s := ERR_BAD_PROVIDER;
    ERROR_BUSY:  s := ERR_BUSY;
    ERROR_CANCELLED:  s := ERR_CANCELLED;
    ERROR_CANNOT_OPEN_PROFILE:  s := ERR_CANNOT_OPEN_PROFILE;
    ERROR_DEVICE_ALREADY_REMEMBERED:  s := ERR_DEVICE_ALREADY_REMEMBERED;
    ERROR_EXTENDED_ERROR:  s := ERR_EXTENDED_ERROR;
    ERROR_INVALID_PASSWORD:  s := ERR_INVALID_PASSWORD;
    ERROR_NO_NET_OR_BAD_PATH:  s := ERR_NO_NET_OR_BAD_PATH;
    ERROR_NO_NETWORK:  s := ERR_NO_NETWORK;
    //次の行はエラーメッセージから調べて追加
    53:               s := ERROR_BAD_NETPATH;
    1200:             s := ERROR_BAD_DEVICE;
    2202:             s := NERR_BadUsername;
  else
    s := IntToStr(err);
  end;
  MessageDlg(s, mtError, [mbOk], 0);
end;

Google先生にお伺いをたてると･･･

「システム エラー 1219　同じユーザーによる、サーバーまたは共有リソースへの複数のユーザー名での複数の接続は許可されません。」とのこと。

なんのこっちゃ？ と思ったが、さらに調べてみると「Windows資格情報」が既に登録されているとこのエラーが発生するらしいことがわかった。そこで「コントロール パネル ⇨ ユーザー アカウント ⇨ 資格情報マネージャー」の順に辿って、Windows資格情報を確認するとNASのIPアドレスとともに、僕のIDとパスワードが登録されていた。いちばん最初にNASに接続した際に自動的に登録されたらしい。これを取り敢えず、削除してみる。

で、ID：test-uで再チャレンジするが「システムエラー1219」が再度表示され、NASの共有フォルダはネットワークドライブとして表示されない。

実在する一般ユーザーのアカウント設定を参照して作ったテスト用ユーザーだから、設定に間違いがあるとは思えないのだが･･･。

ふと、思い立って（＝揮発性メモリにWindows資格情報が残っているためかと考えた、ここでいったんPCを再起動すれば、古いWindows資格情報は消えるはず･･･）Myアカウントで試してみる。僕のアカウントは管理者用のアカウントで何でもできるから、テストには不向きと考え、敢えて使わなかったのだ。

Myアカウントを入力して、接続テストを実行。すると･･･

無事、NASの共有フォルダへの接続に成功！
期待通りにネットワークドライブとして表示できたが、空き容量表示の色が「赤」なのが痛々しい･･･。

３．アカウントに読み書き権限を付与

Myアカウントなら繋がることはわかったので、ひと安心したが、なぜ一般ユーザーアカウントで繋がらないのかがわからない。まさか、全ユーザーのアカウント設定を管理者に昇格させるわけにも行かず（入れないフォルダがあるわけではないので、それでも運用上は特に問題は起こらないと思うのだが）、何としてもその原因を確かめないといけない。

DSMを起動して、ユーザーを選択し、「編集」⇨「権限」でMyアカウントと一般ユーザーアカウントの違いを見比べてみる。違いは一目瞭然。Myアカウントには「homes」と「共有」に「読込み／書込み」があるが、test-uアカウントにはそれがない･･･。

これかー！！

DSM ⇨ コントロールパネル ⇨ グループ と辿って、何か適当なグループはないか検討してみると、職員全員と説明のあるグループを発見。さっそくこれを編集して、「homes」と「共有」に「読込み／書込み」権限を付与（設定）する。

続けて、test-uアカウントに「職員全部」が所属するグループを追加する。

これでtest-uアカウントは「homes」と「共有」各フォルダに対する読み書きが可能に。

今度は、test-uアカウントでも無事接続でき、NASの共有フォルダがネットワークドライブとして表示された。やった。目標を実現できた！

あとは、このプログラムを含むネットワーク環境改善案を全体に提案して共通理解を持ち、共有資産を再編すればいい。

クライアントPCの数は100に満たない。これくらいなら僕ひとりで接続プログラムの導入と設定は十分可能だ。

接続プログラムを動かして、ネットワークドライブが見えている状態であれば、Windows資格情報が消されていても、揮発性メモリには接続先のIPアドレスだけでなく、ユーザーIDとパスワードも書き込まれるらしく、クライアントPCのデスクトップ上にあるNASへのショートカットも機能することがわかった。

作業の途中、NASのルートはネットワークドライブに指定できない（何らかの共有フォルダを指定しなければならない）という事実を初めて知り「愕然」とする瞬間もあったが、ネットワークドライブ接続後にデスクトップにあるNASへのショートカットが機能すれば何の問題もない。共有資産の再編作業は滞りなく実行できるはずだ。

クライアントPC１機を複数人で運用するのであれば、Windows資格情報を残したままだと他の人が接続しようとした時に「システムエラー1219」が発生するのは間違いないが、現状一人一台の生体認証でログインするクライアントPCだから、マシンを割り当てられた職員以外の人の使用は考えにくく、Windows資格情報は消去せずにそのままにしておいても大丈夫かもしれない。

いずれにしても、明日以降、試験的に運用しながら、もし問題点があるようならそれを発見・改善し、組織全体がよりよくなれるよう、力を尽くそう。

この方法がいちばん良い方法であるとは思えないが、今の僕にできるベストであることは間違いない。ならば、自分にできるいちばんよいことをする。それをずっと繰り返すしか、ないじゃないか･･･。

４．まとめ

現在のファイル共有環境を生かしたまま、新しいファイル共有環境を再構成するには、現在のファイル共有システムの中に、新しい共有フォルダを準備してそこへ古い環境から必要なファイルだけを移動する方法がよいのではないか？ と今回の経験から思った。実際の運用は、これからだけれど･･･

５．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

ゼロ始まりに対応！

どんな理由があって、そうなったのか知りませんが、マークシート方式で行われる予定の大学入学共通テストサンプル問題、教科「情報Ⅰ」の解答の選択肢は、始まりが「１」ではなく、「０」からになってます･･･。

ディジタルのイメージから、「０」・「１」とつながる０始まりにしたのか？
それとも他に何か０から始めなければならない必然的な理由があるのか？
サンプル問題を作成した方に、その理由をぜひ伺ってみたい気もしますが･･･

今回は、My MarkSheet Reader を、解答の選択肢「０」始まりに対応させたというお話です。

【今回の記事】

１．なんで０始まりなの？
２．教科「情報」用マークシートを作成
３．ゼロ始まりに対応
４．まとめ
５．お願いとお断り

１．なんで０始まりなの？

大学入学共通テストの理科基礎科目は例外なく、解答の選択肢の始まりは「１」から。
物理も、化学も、生物も、地学も、全部、それが「１」になってるってのは、「選択肢の始まりは１から」って、誰もがそう感じるから･･･だと思うのですが。

教科「情報」では、なぜかそれが「０」からになってる･･･。

検索してみると、そのことに注意を促すWebサイトが複数見つかります。
例えば、選択肢の番号が「０」始まりであることに気付かず、「１２１」とマークしたつもりが実際には「０１０」だった。思い込みにはくれぐれも注意しましょう！･･･みたいな。

僕は、僕のマークシートリーダーをよくする云々ではなく、今回だけは、この無視できない現実にとにかく「対応する」ことにしました！

２．教科「情報」用マークシートを作成

まずはマークシートそのものを準備しなければいけません。これが理科の場合なら、選択肢の数は８個もあれば十分です。しかし、教科「情報」では、例えば著作権関係の内容を見てみると、著作者の権利として、氏名表示権、同一性保持権、複製権、上演権、演奏権、公衆送信権、口述権、展示権、頒布権、貸与権、翻訳権、翻案権の12の権利があることがわかります。これを解答の選択肢として準備する場合があり得ますから、選択肢の数は少なくても15程度、十分な余裕を持って設定した方がよさそうです。

幸いなことに僕のマークシートリーダーは、数学での利用を想定して選択肢数は最大16個まで対応できるように作成してあります。そこで、数学用のマークシートを改造して教科「情報」用のマークシートを作成することにしました。

まず、行番号の「アイウエオ･･･」を「１２３４５･･･」に書き換えます。

次に、マークを０始まりで15まで、16個用意します。
１行分作成したら、あとはひたすらコピペします。
これを３列分繰り返して、１列25問×３で75問に対応できるマークシートとしました。

列の行番号が半角のカタカナから、半角の数字２桁になったため、解答欄座標を取得するマーカー■■■（トリプルドット）の位置に関して若干の修正が必要でしたが、何とか思った通りの形に仕上げることができました。

出来れば、問題数は100問まで対応可能としたいところですが、用紙サイズの関係もあり、75問でよしとすることにしました。どうしても75問以上の設問が必要な場合は、数学用途に２枚１セットで採点できるようにプログラムを組んであるので、それを活用すればなんとかなります。まぁ･･･試験時間60分なら、最大75問に対応していればOKでしょう。

とりあえず、マークシートは完成です。ここまでは極めて順調に推移しました。次は、いよいよプログラムの改良です。

３．ゼロ始まりに対応

どのようにプログラムを改良しようかと考えた時、一瞬、教科「情報」専用のマークシートリーダーにしようか･･･と思ったのですが、やはり、そうではなく、１つのプログラムで様々な教科・科目に対応できる方が理想だと思い直し、選択肢の始まりは「０」とするか、「１」とするか、ユーザーが選べるようにプログラムを改良することにしました。

設定欄に、最初の選択肢の番号を指定するVCLコントロールを設置するスペースを何とか作成し、そこにComboBox１個とLabelを２つ貼って、上の図のように選択肢の始まりの番号を指定できるようにしました。もちろん、ここで指定した番号は必要であればイニシャライズファイルに保存して、次回起動時も有効化されるように設定。このComboBoxの名前は思いついたまま適当に「cmbOneZeroSelect」として、読み取りコードを次のように改良します。

  begin
    //StringGridに読み取り結果を表示
    //オリジナルのプログラムは１行で終わってた
    //StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
    //選択肢の０始まりに対応できるようコードを改良
    if cmbOneZeroSelect.Text='1' then
    begin
      StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
    end else begin
      if (strAnsList[intSG_k]='99') or (strAnsList[intSG_k]='999') then
      begin
        StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
      end else begin
        strAnsList[intSG_k]:=IntToStr(StrToInt(strAnsList[intSG_k])-1);
        StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
      end;
    end;
    ・・・
  end;

早速、実行してみました！

よかった☆　期待通りに動作してくれました！

１行16選択肢で、１列に25行、これが１枚に３列あるから、マークの数は合計1200個／枚あります。MyPC環境では、マークシート１枚について1200あるマークを約250ミリ秒で読み取ってますから･･･。１秒でほぼ４枚、１クラス40名分なら約10秒で読み取り完了です。

自分で言うのもなんですが、結構、高速に動作しているんじゃないか･･･と。

ただ、10万枚くらいは手作業で採点できそうな時間を開発に費やしてますが･･･。

４．まとめ

ようやく、大学入学共通テストの教科「情報」に対応したマークシートリーダーが出来ました。解答欄の選択肢の始まりが「０」か、「１」か、ただそれだけのことなのですが、両方にきちんと対応するのは、やっぱりそれなりに大変でした。

５．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。