svn/view/NIcoVitanD_setting.pas

unit NIcoVitanD_setting;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, StdCtrls, ExtCtrls,
  ShlObj,
  Filectrl,
  RegularExpressions;

type
  TSettingForm = class(TForm)
    CommentLogLE: TLabeledEdit;
    GroupBox1: TGroupBox;
    SettingFileLE: TLabeledEdit;
    CommentLogDefaultBtn: TButton;
    SettingFilesDefaultBtn: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormDblClick(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure CommentLogDefaultBtnClick(Sender: TObject);
    function  GetSpecialFolder(CSIDL: Integer): String;
    procedure FormCreate(Sender: TObject);
    procedure SettingFilesDefaultBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CommentLogLEClick(Sender: TObject);
    function  SaveFolderValidate(SFvalidate:String):String;
    function  IsWritableFolder(aPath: string): Boolean;
  private
    { Private éž }
  public
    { Public éž }
  end;

const
  AppliName = 'NicoVitanD';
  MakerName = 'arigayas';

var
  SettingForm: TSettingForm;
  FilePath: string;
  SettingFilePath , CommentLogPath: string;

implementation

{$R *.dfm}

procedure TSettingForm.CommentLogDefaultBtnClick(Sender: TObject);
begin
  CommentLogLE.Text  := GetSpecialFolder(CSIDL_APPDATA) + '\' +MakerName + '\' + AppliName + '\CommentLog';
end;

procedure TSettingForm.CommentLogLEClick(Sender: TObject);
var
  SelectFolder :string; //tH_ĚpXđi[ˇéĎ
  SelectFolderResult :string;
  SpDir :string;
begin
//  SpDir := '::' + GUIDToString(CLSID_MyComputer);         // }CRs[^đJAShlObj K{
  if SelectDirectory('RenĆRgđŰśˇétH_ĚIđ',SpDir,SelectFolder) then
     SelectFolderResult := SaveFolderValidate(SelectFolder);
    if SelectFolderResult = 'OK' then
      begin
        CommentLogLE.Text := SelectFolder + '\CommentLog\';
        CommentLogPath    := SelectFolder + '\CommentLog\';

        SettingFileLE.Text := SelectFolder;
        SettingFilePath    := SelectFolder;
      ShowMessage(SelectFolder);
      end
    else
      begin
        if not(SelectFolderResult = '') then
          MessageDlg( SelectFolderResult , mtInformation, [mbOk], 0); // G[
      end;
end;

procedure TSettingForm.FormClick(Sender: TObject);
begin
 SettingForm.Caption:='_uNbNĹÂśÜˇ';
// GroupBox1.Enabled := not GroupBox1.Enabled;
end;

procedure TSettingForm.FormCreate(Sender: TObject);
var
  Ini : TIniFile;
begin
  Ini := TInifile.Create(ChangeFileExt( Application.ExeName, '.ini'));   //init@CĚśÝđ`FbNˇé
//  AppliName := ExtractFileName( ChangeFileExt( Application.ExeName, ''));

  try
    SettingFilePath := Ini.ReadString('Path', 'SettingFile', SettingFilePath);
    CommentLogPath  := Ini.ReadString('Path', 'CommentLog', CommentLogPath);
  finally
    Ini.Free;
  end;

  //  [U[˛ĆÉA[~O (ÚŽ) ˇéę
  //  [user profile]\Application data
  FilePath := GetSpecialFolder(CSIDL_APPDATA) + '\' + MakerName + '\' + AppliName;

  if SettingFilePath ='' then
    begin
      SettingFileLE.Text := FilePath;
    end
  else
    begin
      SettingFileLE.Text := SettingFilePath;
    end;

  if CommentLogPath ='' then
    begin
      CommentLogLE.Text  := FilePath + '\CommentLog\';
    end
  else
    CommentLogLE.Text  := CommentLogPath;

end;

procedure TSettingForm.FormDblClick(Sender: TObject);
begin
  Close;
end;

procedure TSettingForm.FormDestroy(Sender: TObject);
var
  Ini : TIniFile;
begin
  // wčtH_ŞśÝľÄ˘éŠmF
  // tH_pXđĎÉi[
  SettingFilePath := SettingFileLE.Text;

  CommentLogPath := CommentLogLE.Text;

  //@NicoVitanD Ě{ĚĚĘuđinit@CÉL^
  Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

  try
    Ini.WriteString('Path', 'CommentLog', CommentLogPath);
    Ini.WriteString('Path', 'SettingFile', SettingFilePath);
  finally
    Ini.Free;
  end;
end;

// http://shusakuorz.wordpress.com/2011/08/05/pXĚćžapplication-dataŇ/
function TSettingForm.GetSpecialFolder(CSIDL: Integer): String;
var
  Path: array[0..MAX_PATH] of Char;
  Pidl: PItemIDList;
begin
  SHGetSpecialFolderLocation(Application.Handle, CSIDL, Pidl);
  SHGetPathFromIDList(Pidl, Path);
  Result := Path;
end;


function TSettingForm.SaveFolderValidate(SFvalidate: String): String;
var
  DriveName,DriveType : string;
  Avail, Total, Free: Int64;
  r: Byte;
const
  Limit = 100000000; // 100MB
begin
  if TRegEx.IsMatch(SFvalidate, '^file:') then
    begin
      Result:='tH_[ÉÍ "file:" ĹnÜétH_[đÝčoÜšńI';
    end
  else
    DriveName := ExtractFileDrive(SFvalidate);
    //   óŤeĘ`FbN
    GetDiskFreeSpaceEx( PWideChar( WideString(DriveName) ), Avail, Total, @Free );
    if Avail < Limit then
      Result:='óŤeĘŞŤčÜšńBNeed: 100MB'
    else
      // { DONE : őwhCuđÖ~ˇé }
      begin
        r := GetDriveType(PChar(DriveName));
          case r of
            DRIVE_NO_ROOT_DIR: DriveType := 'No Root';     //  No Root
            DRIVE_REMOVABLE:   DriveType := 'Removable';   // veXg
            DRIVE_FIXED:       DriveType := 'HDD';
            DRIVE_REMOTE:      DriveType := 'Network';
            DRIVE_CDROM:       DriveType := 'őwhCuÍŔSĚ˝ßŰśtH_ĆľÄgŚÜšńB';
            DRIVE_RAMDISK:     DriveType := 'RamDisk';
            else               DriveType := 'hCuĚíŢđťĘĹŤÜšńĹľ˝BŔSĚ˝ßŰśtH_ĆľÄgŚÜšńB';     //  Unknown
          end;
        if (r = 3) or (r = 4) or (r = 6) then
           // ŤÝtH_ŠÂ\Š`FbN
          if IsWritableFolder(SFvalidate) = false then
            Result:='t@CđŰśĹŤČ˘tH_ĹˇBÄxtH_đIńĹžł˘B'
          else
            Result:='OK'
        else
          Result := DriveType;
      end;
end;

// Thanks Mr.DEKO
// http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+201303/13030017.txt
function TSettingForm.IsWritableFolder(aPath: string): Boolean;
var
  hFile: THandle;
  dFileName: String;
begin
  result := False;
  if not SysUtils.DirectoryExists(aPath) then
    Exit;
  dFileName := IncludeTrailingPathDelimiter(aPath) + 'writablecheck.temporary';
  UniqueString(dFileName);
  hFile := CreateFile(PChar(dFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
             FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0);
  result := (hFile <> INVALID_HANDLE_VALUE);
  if result then
    CloseHandle(hFile);
end;


procedure TSettingForm.SettingFilesDefaultBtnClick(Sender: TObject);
begin
  SettingFileLE.Text := GetSpecialFolder(CSIDL_APPDATA) + '\' + MakerName + '\' + AppliName ;
end;


end.