お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"Re:フロッピーのフォーマット" 
この発言は
#00558　十兵衛          さんのフロッピーのフォーマット
に対するコメントです



　　かなり前に十兵衛 さんにご紹介いただき、ぼくなりに手を加えたものです。
　使い方や考え方も同じです。
　　ただ、NT4.0と９５OSR2での動作確認を行い、NT4.0ではリムーバブルディスク
  のフォーマットも確認しています。ありがとうございました。

 
unit UFormat;
interface
uses
        Classes, Windows, SysUtils, Forms, ShellApi, Dialogs;
//指定ドライブをフォーマットする
function FormatCom(Const ADrive: string;//ドライブを指定する
                   Const AShow: Boolean //プロンプトを表示するかしないか
                   ): Boolean;    //成功or失敗

function IsFDCheck(Const aDrive: Char):  Boolean;

implementation

const
        aMAX_PATH = MAX_PATH - 1;
        //キー入力データファイルの定義
        KeyBuf = #13+#13+'N'+#13;
        //新しいディスクをドライブに...→Enter(実行)
        //ボリュームラベルを...→Enter（空白で作成）
        //別のディスクを...→'N'+Enter（フォーマットしない）

//ボリューム名の取得
function GetVolumeName(Const aDrive: Char ): String;
var
        RootPath: String;//ルートディリクトリ名を保持
        VolName: Array[0..255] of Char;//ボリューム名を保持
        SerialNumBer: DWord;//シリアル番号を保持
        MaxClength: DWord; //ファイル構成要素をあらわす名前の最大サイズ
        FileSysFlag: DWord;//ファイルシステムを受け取るバッファ
        FileSysName: Array[0..20] of Char;//ファイルシステム名の最大サイズ
        volSuccess: Boolean;// GetVolumeInformationの返り値の保持
begin
        RootPath := aDrive + ':\';
        volSuccess := GetVolumeInformation(PChar(RootPath), VolName, 255,
              @SerialNumBer, MaxClength,FileSysFlag, FileSysName, 255);
        // エラーコードのクリア
        SetLastError(NO_ERROR);
        if volSuccess then
                Result := VolName
        Else
                Result := 'ERROR';
end;

//ドライブ文字列の判定
function IsDriveChar(const Str: string): Char;
var
        S: String;
begin
        Result := #0;
        S := UpperCase(Copy(Str, 1, 1));
        if S[1] in ['A'..'Z'] then
                Result := S[1];
end;

//ボリューム名の書き込み
function VolumeLabelWrite(Const aDrive: Char; Const VolName: string):
  Boolean;
var
        RootPath: String;//ルートディリクトリ名を保持
Begin
        RootPath := aDrive + ':\';
        Result := SetVolumeLabel(PChar(RootPath), PChar(VolName));
        //ボリューム名を書き込む
End;

//システムのバージョンを取得
Function GetOSVersion: DWord;
var
        Verinfo: TOSVersionInfo;
begin
        //TOSVersionInfo 構造体のサイズメンバをセット
        Verinfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
        //システムのバージョンを取得
        GetVersionEx(Verinfo);
        Result := Verinfo.dwPlatformID;
end;

//Windowsのシステムフォルダ名の取得
function GetDosCommand_Exe(Const VER: DWord): string;
var
        Buf: Array[0..aMAX_PATH] of Char;
begin

        if VER = VER_PLATFORM_WIN32_NT then
        begin     //NTなら....
                GetSystemDirectory(Buf, aMAX_PATH);
                Result := Buf + '\CMD.EXE';
        end else
        begin     //NTでないなら....
                GetWindowsDirectory(Buf, aMAX_PATH);
                Result := Buf + '\COMMAND.COM';
        end;
end;

//Windowsのシステムフォルダ名の取得
function GetDosCommand_Fs(Const VER: DWord): string;
begin

        if VER = VER_PLATFORM_WIN32_NT then
        begin     //NTなら....
                Result := ': /FS:FAT ';
        end else
        begin     //NTでないなら....
                Result := ': ';
        end;
end;

//環境変数Tempフォルダの取得
function GetTempPathName: String;
var
        Temp: array [0..aMAX_PATH] of Char;
begin
        GetTempPath(aMAX_PATH, @Temp);
        Result := String(Temp);
end;

//TempFileNameの取得
function GetMyTempFileName: String;
begin
        Result := ChangeFileExt( ExtractFileName(Paramstr(0)), '.$$$' );
end;

//コマンドラインの取得
function GetComLineStr(Const Str1, Str2, Str3: string; Const IsFormat:
  Boolean): String;
begin
       if IsFormat then //フォーマットされている場合はクイックフォーマット
       Begin
        Result := Format('%s /c Format %s /Q < %s', [Str1, Str2, Str3]);
       End
        Else
           Result := Format('%s /c Format %s < %s', [Str1, Str2, Str3]);
   //Result := Format('%s /c Format %s: /FS:FAT /Q < %s', [Str1,Str2,
  Str3]);

   //Com.exe /c Format A: < テキストファイル
end;

//リムーバブルドライブの判定
function IsDriveRemovable(Const aDrive: Char): Boolean;
begin
        Result := False;
        if GetDriveType(PChar(ADrive + ':\')) = DRIVE_REMOVABLE then
                Result := True;
end;

//一時的な作業ファイルの作成(アプリケーション名で作成)
procedure MakeTempFile(Const fName: string);
var
        F: TextFile;
begin
        AssignFile(F, fName);     { 入力ファイルを接続 }
        try
                Rewrite(F);
                Write(F, KeyBuf);
        finally
                CloseFile(F);
        end;
end;

function IsDriveReady(aDrive: Char): Boolean;
var
        ErrorMode : Word;
begin
        if aDrive in ['a'..'z'] then dec(aDrive, $20);
        if not (aDrive in ['A'..'Z']) then
                raise EConvertError.Create('無効なドライブです');
        ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        try
                if DiskSize(Ord(aDrive) - $40) = -1 then
                        Result := False
                else
                        Result := True;
        finally
                SetErrorMode(ErrorMode);
        end;
end;

//ダミーFileNameの取得
function GetDmyFileName: String;
begin
        Result := ChangeFileExt( ExtractFileName(Paramstr(0)), '.Dmy' );
end;

//ディスクの挿入、書き込み、フォーマット検査
function IsFDCheck(Const aDrive: Char):  Boolean;
var
//OFStruct: TOFStruct;
   Rc, Error: HFILE;
   DefErr : DWord;
   Sa: TSecurityAttributes;
   DummyFile: string; //ダミーファイル名を保持
begin
   DummyFile := aDrive + ':\' + GetDmyFileName;
   DefErr := SetErrorMode(SEM_FAILCRITICALERRORS); //エラー処理を止める
   Sa.nLength := SizeOf(TSecurityAttributes);
   Sa.lpSecurityDescriptor := Nil;
   Sa.bInheritHandle := True;
   Rc := CreateFile(PChar(DummyFile), GENERIC_WRITE, 0, @Sa,
                  CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

   SetErrorMode(DefErr); // エラー処理を復帰
   Error := GetLastError;
   if Error <> 0 then
   begin
//Result := False;
     case Error of
       19: Raise Exception.Create('ディスクがプロテクトされています
  ');
       21: Raise Exception.Create('ディスクが挿入されていません');
     else Begin
       //Raise Exception.Create('ディスクが正しくフォーマットされて
  いない
       可能性があります (' + IntToStr(Error) + ' )');
       //ShowMessage('ディスクが正しくフォーマットされていない可能
  性があ
       ります (' + IntToStr(Error) + ' )');
                Result := False; //フォーマットされていない
         End;
     end;
   end
        else begin
                CloseHandle(Rc);
                DeleteFile(DummyFile);
                Result := True; //フォーマットされている
        end;
end;

//指定ドライブをフォーマットする
function FormatCom(const ADrive: string; const AShow:Boolean):Boolean;
var
        dChar: Char;
        fSuccess: Boolean;  //CreateProccessが成功したかどうか
        si: TSTARTUPINFO;
        pi: TPROCESSINFORMATION;
        OS_VERSION: DWord;
        DosCommand_Exe,
        DosCommand_Fs,
        ComLineStr,
        TempFileName: string;//作業ファイルの保持
begin
        Result := False;
        dChar := IsDriveChar(ADrive);//ドライブ文字を保持
   //リムーバブルドライブの判定
        if not IsDriveRemovable(dChar) then Exit;

        //TSTARTUPINFOの初期化
        FillChar(si,SizeOf(si),0);
        si.cb := SizeOf(TSTARTUPINFO);
        si.dwFlags := STARTF_USESHOWWINDOW;
        if AShow then
                si.wShowWindow := SW_SHOW
        else
                si.wShowWindow := SW_HIDE;

        //一時的な作業ファイルの作成(アプリケーション名で作成)
        TempFileName := GetTempPathName + GetMyTempFileName;
        MakeTempFile(TempFileName);

        OS_VERSION := GetOSVersion; //OSのバージョン取得

        //コマンドラインの作成
        DosCommand_Exe := GetDosCommand_Exe(OS_VERSION);
        DosCommand_Fs := dChar + GetDosCommand_Fs(OS_VERSION);
        ComLineStr := GetComLineStr(DosCommand_Exe,
                DosCommand_Fs, TempFileName,
                IsFDCheck(dChar));//フロッピィがフォーマットされているか
//   ShowMessage(ComLineStr);
        fSuccess := CreateProcess(nil, PChar(ComLineStr), nil, nil, True,
  0,                             nil, nil, si, pi);
        if not fSuccess then
        Begin
                //作成したTempファイルを削除
                DeleteFile(TempFileName);
                Exit;     //失敗したらExit
        End;

        while WaitForSingleObject(pi.hProcess,0) = WAIT_TIMEOUT do
                Application.ProcessMessages; //終了するまで待つ
                //作成したTempファイルを削除
        DeleteFile(TempFileName);
        //コンソールの破棄
        if Boolean(pi.hThread) then CloseHandle(pi.hThread);
        if Boolean(pi.hProcess) then CloseHandle(pi.hProcess);

        Result := True;
end;
end.
///////////////End of File
 　   By かぼちゃの馬車  [ http://hm.aitai.ne.jp/~t_kondo/ ]

Original document by かぼちゃの馬車  氏 ID:(MXF01374)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum