ホーム >プログラム >Delphiソースコード一覧 >lib >myWStrings.pas
unit myWStrings;
//{$DEFINE DEBUG}
//{$DEFINE MYLIB}


interface
uses
  Windows,
  Classes;


const
  CP_SHIFTJIS = 932;
  CP_JIS      = 50220; //半角カナは全角に変換される。
//  CP_JIS      = 50221; //半角カナOK。
//  CP_JIS      = 50222; //漢字SI/SO
//  CP_EUC      = 51932; //MultiByteToWideCharとWideCharToMultiByteではエラーになる。
  CP_EUC      = 20932; //変わりにこちらを使うとOK。

type
  TMyCharCode = (
    cdAuto,      //自動判定
    cdSJis,      //Shift_JIS
    cdUnicodeLE, //UTF-16 LE (リトルエンディアン) BOMあり
    cdUTF_16LE,  //UTF-16 LE (リトルエンディアン) BOMなし
    cdUnicodeBE, //UTF-16 BE (ビッグエンディアン) BOMあり
    cdUTF_16BE,  //UTF-16 BE (ビッグエンディアン) BOMなし
    cdUTF_8,     //UTF-8  BOMあり
    cdUTF_8N,    //UTF-8  BOMなし
    cdUTF_7,     //UTF-7
    cdJIS,       //JIS
    cdEUC,       //EUC-JP
    cdBINDUMP    //バイナリダンプ
  );

function gfnsCharCodeToDescription(cdCode : TMyCharCode) : WideString;
function gfnsCharCodeToText       (cdCode : TMyCharCode) : WideString;
function gfnCodePageToCharCode(iCodePage : Integer) : TMyCharCode;

type
  TMyNewLine = (
    nlCRLF, //CR + LF
    nlCR,   //CR
    nlLF    //LF
  );

function gfnsNewLineGet(nlLineFeed : TMyNewLine) : WideString;
function gfnsNewLineToDescription(nlLineFeed : TMyNewLine) : WideString;


//------------------------------------------------------------------------------
//UTF-16LE⇔UTF-7
function gfnsWideToUtf7(sSrc : WideString) : AnsiString;
function gfnsUtf7ToWide(sSrc : AnsiString) : WideString;

//UTF-16LE⇔UTF-8
function gfnsWideToUtf8(sSrc : WideString) : AnsiString;
function gfnsUtf8ToWide(sSrc : AnsiString) : WideString;

function gfnsJisToWide(sSrc : AnsiString) : WideString;
function gfnsWideToJis(sSrc : WideString) : AnsiString;

function gfnsEucToWide(sSrc : AnsiString) : WideString;
function gfnsWideToEuc(sSrc : WideString) : AnsiString;

//Unicode→Shift_JIS
function gfnsWideToAnsi(sSrc : WideString) : AnsiString;

//AnsiString⇔WideString
function gfnsWideToAnsiEx(sSrc : WideString) : AnsiString;
function gfnsAnsiToWideEx(sSrc : AnsiString) : WideString;

//ウムラウトのようなUnicodeを含んでいるか
function gfnbIsUnicode(sSrc: WideString): Boolean;

function gfniCodePageGet(pBuff: PAnsiChar; iCount: Integer): Integer;
function gfnCharCodeGet(pBuff: PAnsiChar; iCount: Integer): TMyCharCode;


//------------------------------------------------------------------------------
//ファイルとのやり取り
function gfnsFileReadText(sFile : WideString)                                         : WideString; overload;
function gfnsFileReadText(sFile : WideString; var cdCode : TMyCharCode)               : WideString; overload;
function gfnsFileReadText(sFile : WideString; var cdCode : TMyCharCode; iByte: DWORD) : WideString; overload;
function gfnbFileWriteText(sFile, sText : WideString)                             : Boolean; overload;
function gfnbFileWriteText(sFile, sText : WideString; const cdCode : TMyCharCode) : Boolean; overload;


//------------------------------------------------------------------------------
{TMyWStrings}
{TStringsでWideStringを持つために。
2011-11-10:
 RawStringsプロパティ追加。
 RawStringsをTMyFileStringsなどの引数に指定してCreateすることでTMyFileStringsの
 メソッドや関数を適用できるようにするため。
 AnsiStringsやAnsiExStringsはコピーされたものなのでF_slListには影響が及ばないの
 でこのような場合にはNGであったため。
2011-06-20:
 function TMyWStrings.GetTextStr: WideString;
 改行コード付加の条件式を(i < li_Count)としていたのでエラーが出ていたのを修正。
2011-04-21:
 このユニットだけで完結するように汎用ルーチンを取り込み。
 WideString関係の汎用ルーチンをmyString.pasから移動。
2008-07-09:
 WideToAnsiとAnsiToWideを抽象メソッドから仮想メソッドに変更。
 TMyWStringsでCreateしても問題ないように。
}

type
  TMyWStrings = class;

  //カスタムソート用下請け関数の型定義
  TMyWStringsSortCompare = function(slList: TMyWStrings; iIndex1, iIndex2: Integer): Integer;
  TMyWStringsOnAdd       = procedure(Sender: TObject; iCount: Integer; iLength: Int64) of object;

  TMyWStrings = class(TObject)
  private
    F_slList,
    F_slOut          : TStrings;
    F_bListFree      : Boolean;      //F_slListをFreeするか
    F_bCaseSensitive : Boolean;      //比較に大文字小文字を区別するか
    F_bSorted        : Boolean;
    F_iSortDepth     : Int64;
    F_sProgressMsg   : WideString;
    F_Duplicates     : TDuplicates;
    F_sDelimiter     : WideString//TextEx用区切り文字
    F_sQuoteChar     : WideString;
    F_cdCharCode     : TMyCharCode;
    F_nlNewLine      : TMyNewLine;
    F_bObjectsFree   : Boolean;     //ClearやDeleteでObjectsをFreeするか
    F_OnAdd          : TMyWStringsOnAdd;
    FOnChange        : TNotifyEvent;

    function  F_GetName  (iIndex: Integer): WideString;
    procedure F_SetSorted(bValue: Boolean);
    function  F_GetValue (sName:  WideString): WideString;
    procedure F_SetValue (sName,  sValue: WideString);
    function  F_GetAnsiStrings: TStrings;
    function  F_GetUtf7Strings: TStrings;
    function  F_GetUtf8Strings: TStrings;
    function  F_GetWideToAnsiExStrings: TStrings;
  protected
    function  WideToAnsi(sStr: WideString): AnsiString; virtual;// abstract;
    function  AnsiToWide(sStr: AnsiString): WideString; virtual;// abstract;
    function  Get(iIndex: Integer): WideString; virtual;
    procedure Put(iIndex: Integer; sStr: WideString); virtual;
    function  GetCommaText: WideString;
    function  GetDelimitedText: WideString;
    function  GetObject(Index: Integer): TObject; virtual;
    procedure PutObject(Index: Integer; AObject: TObject); virtual;
    function  GetTextStr: WideString; virtual;
    procedure SetTextStr(sText: WideString); virtual;
    function  GetTextStrEx: WideString; virtual;
    procedure SetTextStrEx(sText: WideString); virtual;
    procedure SortDupDelete; virtual;
    function  GetCount: Integer;
    function  GetCapacity: Integer; virtual;
    procedure SetCapacity(NewCapacity: Integer); virtual;
    property  ProgressMessage : WideString read F_sProgressMsg;
  public
    constructor Create; overload; virtual;
    constructor Create(AList: TStrings); overload; virtual;
    destructor  Destroy; override;
    function  Add(sStr: WideString): Integer; virtual;
    procedure AddFile(sFile: WideString);   overload; virtual;
    procedure AddFile(slList: TMyWStrings); overload; virtual;
    function  AddObject(S: WideString; AObject: TObject): Integer; virtual;
    function  AddName(sName, sValue: WideString): Integer; virtual;
    procedure AddStrings(slList: TStrings);    overload; virtual;
    procedure AddStrings(slList: TMyWStrings); overload; virtual;
    procedure AddStrings(iCount: Integer);     overload; virtual;
    procedure AddText(sText: Widestring); virtual;
    procedure Append(sStr: WideString); virtual;
    procedure Assign(slList: TStrings); overload; virtual;
    procedure Assign(slList: TMyWStrings); overload; virtual;
    procedure Attach(slList: TStrings); virtual;
    procedure BeginUpdate; virtual;
    procedure Clear; virtual;
    procedure CustomSort(fniCompare: TMyWStringsSortCompare); virtual;
    procedure Delete(iIndex: Integer); virtual;
    procedure Detach; virtual;
    procedure EndUpdate; virtual;
    function  Equals(slList: TMyWStrings): Boolean; reintroduce;
    procedure Exchange(iIndex1, iIndex2: Integer); virtual;
    procedure FileInsertionSort; overload;
    procedure FileInsertionSort(bUnique: Boolean); overload;
    procedure FileSort;                         overload; virtual;
    procedure FileSort(bUnique: Boolean);       overload; virtual;
    procedure FileSort(iStart, iEnd : Integer); overload; virtual;
    function  Find(sStr: WideString; var iIndex: Integer): Boolean; virtual;
    function  IndexOf(sStr: WideString): Integer; overload;
    function  IndexOf(sStr: WideString; iIndex: Integer): Integer; overload;
    function  IndexOfName(sName: WideString): Integer; overload;
    function  IndexOfName(sName: WideString; iIndex: Integer): Integer; overload;
    function  InHeadStringOf(sStr: WideString): Integer; overload; virtual;
    function  InHeadStringOf(sStr: WideString; iIndex: Integer): Integer; overload; virtual;
    procedure Insert(iIndex: Integer; sStr: WideString); virtual;
    procedure InsertionSort(const bUnique: Boolean); overload; virtual;
    procedure InsertionSort(fniCompare: TMyWStringsSortCompare); overload;
    procedure InsertionSort(fniCompare: TMyWStringsSortCompare; const bUnique: Boolean); overload; virtual;
    procedure InsertObject(Index: Integer; S: WideString; AObject: TObject); virtual;
    procedure InsertStrings(iIndex: Integer; slList: TStrings); overload; virtual;
    procedure InsertStrings(iIndex: Integer; slList: TMyWStrings); overload; virtual;
    function  InStringOf(sStr: WideString): Integer; overload; virtual;
    function  InStringOf(sStr: WideString; iIndex: Integer): Integer; overload; virtual;
    procedure LoadFromFile(sFile: WideString); overload; virtual;
    procedure LoadFromFile(sFile: WideString; var cdCode: TMyCharCode); overload; virtual;
    procedure LoadFromFile(sFile: WideString; var cdCode: TMyCharCode; iByte: DWORD); overload; virtual;

    procedure MergeSort(iStart, iEnd : Integer; fniCompare : TMyWStringsSortCompare); overload; virtual;
    procedure MergeSort(iStart, iEnd : Integer);                                      overload; virtual;
    procedure MergeSort(fniCompare : TMyWStringsSortCompare; bUnique : Boolean);      overload; virtual;
    procedure MergeSort(fniCompare : TMyWStringsSortCompare);                         overload; virtual;
    procedure MergeSort;                                                              overload; virtual;

    procedure Move(iCurrentIndex, iNewIndex: Integer); virtual;
    procedure QuickSort(fniCompare: TMyWStringsSortCompare); overload; virtual;
    procedure QuickSort(fniCompare: TMyWStringsSortCompare; bUnique: Boolean); overload; virtual;
    procedure Reverse; virtual;
    function  SaveToFile(sFile: WideString; cdCode: TMyCharCode; nlNewLine: TMyNewLine): Boolean; overload; virtual;
    function  SaveToFile(sFile: WideString; cdCode: TMyCharCode): Boolean; overload; virtual;
    function  SaveToFile(sFile: WideString): Boolean; overload; virtual;
    procedure Sort; virtual;

    property CaseSensitive: Boolean     read F_bCaseSensitive  write F_bCaseSensitive;
    property Capacity:      Integer     read GetCapacity       write SetCapacity;
    property CharCode:      TMyCharCode read F_cdCharCode      write F_cdCharCode;
    property CommaText:     WideString  read GetCommaText;
    property Count:         Integer     read GetCount;
    property Delimiter:     WideString  read F_sDelimiter      write F_sDelimiter;
    property DelimitedText: WideString  read GetDelimitedText;
    property Duplicates:    TDuplicates read F_Duplicates      write F_Duplicates;
    property NewLine:       TMyNewLine  read F_nlNewLine       write F_nlNewLine;
    property ObjectsFree:   Boolean     read F_bObjectsFree    write F_bObjectsFree;
    property QuoteChar:     WideString  read F_sQuoteChar      write F_sQuoteChar;
    property Sorted:        Boolean     read F_bSorted         write F_SetSorted;
    property Text:          WideString  read GetTextStr        write SetTextStr;
    property TextEx:        WideString  read GetTextStrEx      write SetTextStrEx;
    property AnsiStrings:   TStrings    read F_GetAnsiStrings;         //gfnsWideToAnsi
    property AnsiExStrings: TStrings    read F_GetWideToAnsiExStrings; //gfnsWideToAnsiEx
    property Utf7Strings:   TStrings    read F_GetUtf7Strings;         //gfnsWideToUtf7
    property Utf8Strings:   TStrings    read F_GetUtf8Strings;         //gfnsWideToUtf8
    property RawStrings:    TStrings    read F_slList;
    property Names  [iIndex: Integer]:   WideString read F_GetName;
    property Objects[iIndex: Integer]:   TObject    read GetObject  write PutObject;
    property Strings[iIndex: Integer]:   WideString read Get        write Put; default;
    property Values [sName: WideString]: WideString read F_GetValue write F_SetValue;

    property OnAdd    : TMyWStringsOnAdd read F_OnAdd   write F_OnAdd;
    property OnChange : TNotifyEvent     read FOnChange write FOnChange;
  end;

//------------------------------------------------------------------------------
{TMyWStringList}
//WideStringをUTF-7に変換してリストに持つ
type
  TMyWStringList = class(TMyWStrings)
  protected
    function WideToAnsi(sStr: WideString): AnsiString; override;
    function AnsiToWide(sStr: AnsiString): WideString; override;
  end;


//------------------------------------------------------------------------------
{TMyUStringList}
//WideStringを直接リストに持つ
type
  TMyUStringList = class(TMyWStrings)
  protected
    function WideToAnsi(sStr: WideString): AnsiString; override;
    function AnsiToWide(sStr: AnsiString): WideString; override;
  end;


//------------------------------------------------------------------------------
{TMyWideStringList}
//WideStringをオリジナル変換関数で変換してリストに持つ
//TMyWStringsと同じ
type
  TMyWideStringList = class(TMyWStrings);


//==============================================================================
implementation
uses
{$IFDEF DEBUG}
  myDebug,
  myTag,
{$ENDIF}
  Forms,
{$IFDEF MYLIB}
  myFile,
  myIniFile,
  myList,
  myMessageBox,
  myNum,
  myString,
  myWindow,
{$ENDIF}
  ActiveX,
  PsApi,
  ShellApi,
  SysUtils;


function _fniSortFuncFileList(slList: TMyWStrings; iIndex1, iIndex2: Integer): Integer; forward;


{$IFNDEF MYLIB}
//汎用ルーチン ----------------------------------------------------------------
//myNum.pas --------------------------------------------------------------------
//数値
function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer;
begin
  if (iMin = iMax) then begin
    Result := iMin;
  end else begin
    if (iNum < iMin) then begin
      Result := iMin;
    end else if (iNum > iMax) then begin
      Result := iMax;
    end else begin
      Result := iNum;
    end;
  end;
end;

function gfniMin(iNum: array of Integer): Integer;
{2007-12-16:
引数の中の最小値を返す
}

var
  i: Integer;
begin
  Result := iNum[0];
  for i := 1 to High(iNum) do begin
    if (iNum[i] < Result) then Result := iNum[i];
  end;
end;


//myFile.pas -------------------------------------------------------------------
//ファイル
function gfnsFileMainGet(sFile: WideString): WideString;
{2007-08-05,10-26:
ファイル名のうちパスと拡張子を除いた部分を返す
メインファイル名の拡張子のないもの
\ と . はつかない

2007-10-26:ピリオドつきの主ファイル名の処理がうまくいっていなかったのを修正
  lb_Extを判定に追加
}

var
  i: Integer;
  lb_Ext: Boolean;  //2007-10-26
begin
  Result := '';
  lb_Ext := True;
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
      //\と/と:が出てきた時点でファイル名の終了なのでループを抜ける
      Break;
    end else if (sFile[i] = '.') and (lb_Ext) then begin//2007-10-26
      //拡張子であったので今までのをチャラにする
      Result := '';
      lb_Ext := False;
    end else begin
      Result := sFile[i] + Result;
    end;
  end;
end;

procedure gpcFileDirNameDiv(sFile: WideString; out sPath, sName: WideString);
//sPathにパスをsNameにファイル名をセットして返す
//末尾の \ は"返らない"
var
  i, li_Pos, li_Start: Integer;
begin
  li_Pos   := -1;
  li_Start := 0;
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') then begin
      li_Pos   := i - 1;
      li_Start := i + 1;
      Break;
    end else if (sFile[i] = ':') then begin
      li_Pos   := i;
      li_Start := i + 1;
      Break;
    end;
  end;
  sPath := Copy(sFile, 1, li_Pos);
  sName := Copy(sFile, li_Start, Length(sFile));
end;

function gfniFileSizeGet(sFile: WideString): Int64;
//sWFileのサイズをByte単位で返す
var
  lh_File: Cardinal;
  lr_Info: TWin32FindDataW;
begin
  Result := 0;
  lh_File := FindFirstFileW(PWideChar(sFile), lr_Info);
  try
    if (lh_File <> INVALID_HANDLE_VALUE) then begin
      repeat
        if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin
          Result := lr_Info.nFileSizeHigh * (Int64(MAXDWORD) + 1) + lr_Info.nFileSizeLow;
          Break;
        end;
      until not(FindNextFileW(lh_File, lr_Info));
    end;
  finally
    Windows.FindClose(lh_File);
  end;
end;

function gfnsExeNameGet(sStr: WideString): WideString; overload;
var
  li_Count: Integer;
  lpp_Arg, lpp_Param: PPWideChar;
begin
  Result := '';
  if (sStr <> '') then begin
    lpp_Param := CommandLineToArgvW(PWideChar(sStr), li_Count);
    try
      lpp_Arg := lpp_Param;
      Result  := WideString(lpp_Arg^); //実行ファイル名
    finally
      LocalFree(Cardinal(lpp_Param));
    end;
  end;
end;
function gfnsExeNameGet: WideString; overload;
{2007-09-24,2009-09-23:
WideString対応の実行プログラム名を返す。

2009-09-23:
 コマンドラインを分解して取得するのではなくApplicationのウィンドウハンドルから
 取得するように変更。
 コマンドプロンプトから実行させるとパスがつかないことがあることへの対処。
}

  function lfni_ProcessIDGet(hHandle: HWND): DWORD;
  begin
    GetWindowThreadProcessId(hHandle, @Result);
  end;
  function lfns_ExeNameGet(hHandle: HWND): WideString;
  //ウィンドウハンドルからexeファイル名を返す
  //http://m--takahashi.com/bbs/pastlog/02500/02414.html
  //http://www.geocities.jp/fjtkt/problems/2003_0004.html
  var
    lh_Process: THandle;
    ls_PWExe:   PWideChar;
  begin
    Result := '';
    lh_Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, lfni_ProcessIDGet(hHandle));
    try
      ls_PWExe := AllocMem((MAX_PATH + 1) * 2);
      try
        //プロセスハンドルを渡すだけで実行ファイル名を得られた。インスタンスハンドルはいらないようだ。
        if (GetModuleFileNameExW(lh_Process, 0, ls_PWExe, MAX_PATH) <> 0) then begin
          Result := WideString(ls_PWExe);
        end;
      finally
        FreeMem(ls_PWExe);
      end;
    finally
      CloseHandle(lh_Process);
    end;
  end;
var
  lh_Handle: HWND;
begin
  lh_Handle := Application.Handle;
  if (lh_Handle <> 0) then begin
    Result := lfns_ExeNameGet(lh_Handle);
  end;
  if (Result = '') then begin
    Result := gfnsExeNameGet(GetCommandLineW);
  end;
end;
//ファイルバージョン
type
  TMyFileVersionInfo = record
    Comments,                 // コメント
    CompanyName,              // 会社名
    FileDescription,          // 説明
    FileVersion,              // ファイルバージョン
    InternalName,             // 内部名
    LegalCopyright,           // 著作権
    LegalTrademarks,          // 商標
    OriginalFilename,         // 正式ファイル名
    PrivateBuild,             // プライベートビルド情報
    ProductName,              // 製品名
    ProductVersion,           // 製品バージョン
    SpecialBuild: WideString; // スペシャルビルド情報
  end;

function gfnrFileVersionInfoGet(sFile: WideString): TMyFileVersionInfo;
{2007-06-09:
ファイルのバージョン情報を返す

http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=13#0226.txt
}

type
   TLangAndCodePage = record
     iLanguage: WORD;
     iCodePage: WORD;
   end;
   PLangAndCodePage = ^TLangAndCodePage;
var
  li_Size,
  li_Reserved,
  li_Len      : DWORD;
  lp_Buff,
//  lp_Locale,
  lp_Dat      : Pointer;
//  li_Hi,
//  li_Lo       : Integer;
  lp_LangPage : PLangAndCodePage;
  ls_FileInfo : WideString;
begin
  // 必要なバッファのサイズを取得
  li_Size := GetFileVersionInfoSizeW(PWideChar(sFile), li_Reserved);
  if (li_Size > 0) then begin
    //メモリ確保
    lp_Buff := AllocMem((li_Size +1) * 2);
    try
      if (GetFileVersionInfoW(PWideChar(sFile), 0, li_Size, lp_Buff)) then begin
        //変数情報ブロック内の変換テーブルを指定
//        if (VerQueryValueW(lp_Buff, '\VarFileInfo\Translation', lp_Locale, li_Len) and (li_Len > 0)) then begin
//          gpcInt32ToHiLo(Integer(lp_Locale^), li_Hi, li_Lo);
//          ls_FileInfo := WideFormat('\StringFileInfo\%.4x%.4x\', [li_Lo, li_Hi]);
        if (VerQueryValueW(lp_Buff, '\VarFileInfo\Translation', Pointer(lp_LangPage), li_Len) and (li_Len > 0)) then begin
          ls_FileInfo := WideString(Format('\StringFileInfo\%.4x%.4x\', [lp_LangPage^.iLanguage, lp_LangPage^.iCodePage]));

          //コメント
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'Comments'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.Comments := WideString(PWideChar(lp_Dat));
          end;
          //会社名
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'CompanyName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.CompanyName := WideString(PWideChar(lp_Dat));
          end;
          //説明
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileDescription'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.FileDescription := WideString(PWideChar(lp_Dat));
          end;
          //ファイルバージョン
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.FileVersion := WideString(PWideChar(lp_Dat));
          end;
          //内部名
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'InternalName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.InternalName := WideString(PWideChar(lp_Dat));
          end;
          //著作権
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'LegalCopyright'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.LegalCopyright := WideString(PWideChar(lp_Dat));
          end;
          //商標
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'LegalTrademarks'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.LegalTrademarks := WideString(PWideChar(lp_Dat));
          end;
          //正式ファイル名
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'OriginalFilename'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.OriginalFilename := WideString(PWideChar(lp_Dat));
          end;
          //プライベートビルド情報
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'PrivateBuild'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.PrivateBuild := WideString(PWideChar(lp_Dat));
          end;
          //製品名
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'ProductName'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.ProductName := WideString(PWideChar(lp_Dat));
          end;
          //製品バージョン
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'ProductVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.ProductVersion := WideString(PWideChar(lp_Dat));
          end;
          //スペシャルビルド情報
          if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'SpecialBuild'), lp_Dat, li_Len) and (li_Len > 0)) then begin
            Result.SpecialBuild := WideString(PWideChar(lp_Dat));
          end;
        end;
      end;
    finally
      // 解放
      FreeMem(lp_Buff);
    end;
  end;
end;
function gfnsProductNameGet: WideString;
//自アプリの製品名。
var
  lr_Info: TMyFileVersionInfo;
begin
  lr_Info := gfnrFileVersionInfoGet(gfnsExeNameGet);
  Result  := lr_Info.ProductName;
  if (Result = '') then begin
    //製品名が指定されていなければ主ファイル名を返す。
    Result := gfnsFileMainGet(gfnsExeNameGet);
  end;
end;


//myString.pas -----------------------------------------------------------------
//StringReplace のUnicode対応版的。
function gfnsStrReplace(sSrc, sOld, sNew: WideString; const bCaseSensitive: Boolean): WideString; overload;
{2008-12-07,2011-11-21:
StringReplaceのUnicode対応版。
bCaseSensitiveは大文字小文字の区別をするかしないか。
Trueで区別する。
}

var
  li_Pos      : Integer;
  li_SrcIndex : Integer;
  li_ResIndex : Integer;
  ls_CmpSrc   : WideString;
  ls_CmpOld   : WideString;
  lp_Src      : PWideChar;
  lp_CmpSrc   : PWideChar;
  li_SrcLen   : Integer;
  li_OldLen   : Integer;
  li_NewLen   : Integer;
  li_Count    : Integer;
  li_Indexs   : array of Integer;
  li_Len      : Integer;
  i : Integer;
begin
  if (sSrc = '')
  or (sOld = '')
  then
  begin
    Result := sSrc;
Exit;
  end;

  if not(bCaseSensitive) then
  begin
    ls_CmpOld := WideUpperCase(sOld);
    ls_CmpSrc := WideUpperCase(sSrc);
  end else
  begin
    ls_CmpOld := sOld;
    ls_CmpSrc := sSrc;
  end;

  li_SrcLen   := Length(sSrc);
  li_OldLen   := Length(sOld);
  SetLength(li_Indexs, li_SrcLen +1); //最大
  li_Indexs[0] := 0;
  li_Count     := 0;
  li_SrcIndex  := 0;
  repeat
    lp_CmpSrc := @PWideChar(ls_CmpSrc)[li_SrcIndex];
    li_Pos := Pos(ls_CmpOld, WideString(lp_CmpSrc));
    if (li_Pos > 0) then
    begin
      //置換対象文字列があった。
      li_Indexs[li_Count +1] := li_SrcIndex + li_Pos -1;
      Inc(li_Count);
      li_SrcIndex := li_SrcIndex + li_Pos + li_OldLen -1;
    end;
  until (li_Pos = 0);

  if (li_Count <= 0) then
  begin
    Result := sSrc;
  end else
  begin
    li_NewLen := Length(sNew);
    li_Len    := Length(sSrc) + (li_NewLen - li_OldLen) * li_Count;
    if (li_Len <= 0) then
    begin
      Result := '';
Exit;
    end;
    SetLength(Result, li_Len);
    li_ResIndex := 1; //ResultはWideStringなので0ではなく1
    lp_Src := @PWideChar(sSrc)[0];
    for i := 1 to li_Count do
    begin
      li_Len := li_Indexs[i] - li_Indexs[i-1];
      if (i = 1) then
      begin
        Inc(li_Len);
      end;
      lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, li_Len);
      Inc(li_ResIndex, li_Len -1);
      if (li_NewLen > 0) then
      begin
        lstrcpynW(PWideChar(@Result[li_ResIndex]), PWideChar(sNew), li_NewLen +1);
        Inc(li_ResIndex, li_NewLen);
      end;
      lp_Src := @PWideChar(sSrc)[li_Indexs[i] +1];
    end;
    //残りをコピー
    lstrcpynW(PWideChar(@Result[li_ResIndex]), lp_Src, li_SrcLen - li_Indexs[li_Count]);
    //実装が正しければ必要のない処理。
//    Result := WideString(PWideChar(Result));
  end;
end;
function gfnsStrReplace(sSrc, sOld, sNew: WideString): WideString; overload;
{2008-12-07:
StringReplaceのUnicode対応版。
大文字小文字の区別あり。
}

begin
  Result := gfnsStrReplace(sSrc, sOld, sNew, True);
end;

function gfnsWStrBCopy(pStr: PAnsiChar; iIndex, iCount: DWORD; cdCode: TMyCharCode): WideString;
{2008-05-08,2009-10-07,2011-07-09:
pStrのiIndexバイト目からiCountバイトの文字列をコピーしてWideStringにして返す
iIndexは0ベース。
pStrがUTF-16であった場合返る文字数はiCountの半分になる(iIndex、iCountともバイトで
あることに注意)。2で割り切れない半端は切り捨てる。
pStrのiIndex番目からがBOMであった場合、iCountはBOMも含めたバイト数なので返る文字
数は更に1減ることになる。

2011-07-09:
 UTF-16LEをCopyを使ったものからlstrcpynWを使ったものに書き換え。
 Copyを使ったものだとCPUウィンドウが立ち上がってしまうことがあるため。
2009-10-07:
 UTF-16BEのエンディアンの入れ替えをLCMapStringWを使ったものに書き換え。
 その他をCopyを使ったものに書き換え。
}

var
  li_Len : Integer;
begin
  Result := '';

  if  (pStr[iIndex]    = #$EF)
  and (pStr[iIndex +1] = #$BB)
  and (pStr[iIndex +2] = #$BF)
  then
  begin
    //UTF-8 BOMあり
    cdCode := cdUTF_8;
    Inc(iIndex, 3);
    Dec(iCount, 3);
  end else
  if  (pStr[iIndex]    = #$FF)
  and (pStr[iIndex +1] = #$FE)
  then
  begin
    //UTF-16 BOMありのリトルエンディアン
    cdCode := cdUnicodeLE;
    Inc(iIndex, 2);
    Dec(iCount, 2);
  end else
  if  (pStr[iIndex]    = #$FE)
  and (pStr[iIndex +1] = #$FF)
  then
  begin
    //UTF-16 BOMありのビッグエンディアン
    cdCode := cdUnicodeBE;
    Inc(iIndex, 2);
    Dec(iCount, 2);
  end;

  if (cdCode = cdUTF_16BE) or (cdCode = cdUnicodeBE) then
  begin
    //UTF-16 ビッグエンディアン
    li_Len := Trunc(iCount / 2);
    SetLength(Result, li_Len);
    LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, @pStr[iIndex], li_Len, PWideChar(Result), li_Len);
  end else
  begin
    if (cdCode = cdSJis) then
    begin
      //Shift-JIS
      Result := Copy(AnsiString(@pStr[iIndex]), 1, iCount);
    end else if (cdCode = cdUTF_7) then
    begin
      //UTF-7
      Result := gfnsUTF7ToWide(Copy(AnsiString(@pStr[iIndex]), 1, iCount));
    end else if (cdCode = cdUTF_8) or (cdCode = cdUTF_8N) then
    begin
      //UTF-8
      Result := gfnsUTF8ToWide(Copy(AnsiString(@pStr[iIndex]), 1, iCount));
    end else if (cdCode = cdUnicodeLE) or (cdCode = cdUTF_16LE) then
    begin
      //UTF-16 リトルエンディアン
      li_Len := Trunc(iCount / 2);
      SetLength(Result, li_Len);
      lstrcpynW(PWideChar(Result), @pStr[iIndex], li_Len +1);
    end;
  end;
  //2011-09-14:後ろに#0がついてしまう場合へ対処。
  Result := WideString(PWideChar(Result));
end;

function gfnsPCharToBinDump(pStr: PAnsiChar; iCount: Integer): AnsiString;
{2010-10-05:
pStrを16進ダンプして返す
}

const
  lcs_NOTCHAR  = '.';
  lci_DUMP     = 16;
  lci_DUMPHEX  = lci_DUMP * 3 +2;
  lci_COLUMN   = lci_DUMPHEX +1 + lci_DUMP +1; //間の#$9と改行の#$Dでそれぞれ+1
var
  i, k, li_Count, li_Mod, li_Index, li_ResultLen: Integer;
  ls_Dump, ls_Ansi: AnsiString;
  ls_Char: AnsiChar;
  li_Byte: Byte;
begin
//  Result := '';

  li_Count := iCount div lci_DUMP;
  li_Mod   := iCount mod lci_DUMP;
  SetLength(ls_Ansi, lci_DUMP);
  SetLength(ls_Dump, lci_DUMPHEX);
  if (li_Mod > 0) then begin
    li_ResultLen := (li_Count +1) * lci_COLUMN +1; //半端のライン分でli_Count +1
  end else begin
    li_ResultLen := li_Count * lci_COLUMN;
    Dec(li_Count);
  end;
  SetLength(Result,   li_ResultLen);
  FillChar(Result[1], li_ResultLen, 0);

  for i := 0 to li_Count do begin
{
    if (li_Mod = 0) and (i = li_Count) then begin
  Break;
    end;
}

    FillChar(ls_Ansi[1], lci_DUMP,    $20);
    FillChar(ls_Dump[1], lci_DUMPHEX, $20);
    li_Index := 1;
    for k := 0 to lci_DUMP -1 do begin
      if (i = li_Count) and (k >= li_Mod) then begin
        ls_Dump[li_Index] := ' ';
    Break;
      end;

      ls_Char := pStr[lci_DUMP * i + k];
      li_Byte := Ord(ls_Char);
      case li_Byte of
        0..$1F, $7F, $FD..$FF: begin
          ls_Ansi[k +1] := lcs_NOTCHAR;
        end;
        else begin
          if ((IsDBCSLeadByte(li_Byte)) and (k = lci_DUMP -1))
          or ((li_Byte = $A0) and (k > 0) and not(IsDBCSLeadByte(Ord(pStr[lci_DUMP * i + k -1]))))
          then begin
            ls_Ansi[k +1] := lcs_NOTCHAR;
          end else begin
            ls_Ansi[k +1] := ls_Char;
          end;
        end;
      end;
      if (k = 8) then begin
        ls_Dump[li_Index]    := '-';
        ls_Dump[li_Index +1] := ' ';
        Inc(li_Index, 2);
      end;
      StrFmt(@ls_Dump[li_Index], '%.2x ', [li_Byte]);
      Inc(li_Index, 3);
    end;
    Application.ProcessMessages;
    ls_Dump[lci_DUMPHEX] := ' ';
//    Result := Result + Format('%-*s'#9'%s'#$C, [lci_DUMPHEX, ls_Dump, ls_Str]);
//myDebug.gpcDebug([li_Line, ls_Dump, ls_Ascii]);
    StrFmt(@Result[i * lci_COLUMN +1], '%-*s'#9'%s'#$D, [lci_DUMPHEX, ls_Dump, ls_Ansi]);
  end;
end;


//myWindow.pas -----------------------------------------------------------------
(*
function gfnsOsNameGet: WideString;
{2007-12-13:
OSが'2000', 'XP', 'Vista'のいずれであるかを返す
}

var
  lr_Info: TOSVersionInfo;
begin
  Result := 'Unknown';
  FillChar(lr_Info, SizeOf(lr_Info), 0);
  lr_Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);;
  if (GetVersionEx(lr_Info)) then begin
    with lr_Info do begin
      if (dwPlatformId = VER_PLATFORM_WIN32_NT) then begin
        //NT系
        if (dwMajorVersion = 7) then begin
          Result := '7';
        end else if (dwMajorVersion = 6) then begin
          Result := 'Vista';
        end else if (dwMajorVersion = 5) then begin
          if (dwMinorVersion = 0) then begin
            Result := '2000';
          end else begin
            Result := 'XP';
          end;
        end else if (dwMajorVersion = 4) then begin
          Result := 'NT4';
        end;
      end else if (dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) then begin
        //9x系
        if (dwMinorVersion = 9) then begin
          Result := 'me';
        end else if (dwMinorVersion = 1) then begin
          Result := '98';
        end else if (dwMinorVersion = 0) then begin
          Result := '95';
        end;
      end else if (dwPlatformId = VER_PLATFORM_WIN32s) then begin
        //Windows 3.1上のWin32s
        Result := 'Win32s';
      end;
    end;
  end;
end;
*)


//myMessageBox -----------------------------------------------------------------
function gfniMessageBox(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer;
{2007-10-06,2009-09-25,27:
Unicode対応のMessageBox。
2009-09-27:
  Application.MainForm.Handleはメインウィンドウが表示された後でないとアクセス違反
  となるので、その場合はApplication.Handleにするように変更。
2009-09-25:
 MB_SETFOREGROUNDはタスクバーがフラッシュしてしまうのでSetWindowPosを利用して前
 面に表示させるように変更。
}

var
  lh_Window: HWND;
begin
  try
    lh_Window := Screen.ActiveForm.Handle;
  except
    lh_Window := Application.Handle;
  end;

  SetWindowPos(lh_Window, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

  //iStyleに0を指定した場合はMB_OKを指定したのと同じ
  Result := MessageBoxW(Application.Handle, PWideChar(sWMsg), PWideChar(sWTitle), iStyle or MB_APPLMODAL or MB_SETFOREGROUND);
end;
procedure gpcShowMessage(const sWMsg: WideString);
{2007-10-06:
ShowMessageのUnicode版。
}

begin
  gfniMessageBox(sWMsg, gfnsProductNameGet, MB_OK);
end;


//myList.pas -------------------------------------------------------------------
//比較
function gfniStringCompareText(sSrc1, sSrc2: WideString): Integer;
//sSrc1とsSrc2を単語ソートではなく文字列ソートで比較して返す
//大文字と小文字は区別しない
begin
  Result := CompareStringW(LOCALE_USER_DEFAULT,
                           NORM_IGNORECASE or SORT_STRINGSORT or NORM_IGNORENONSPACE,
                           PWideChar(sSrc1), -1,
                           PWideChar(sSrc2), -1) - 2;
end;


//ファイルソート用の比較関数
function gfniCompareFileName(sStr1, sStr2: WideString): Integer;
  procedure lpc_StrNumDiv(sSrc: WideString; out sHeadStr, sNum, sEndStr: WideString);
  //sSrcを文字列と数値に分解する。
  var
    i, k, li_Len: Integer;
    lb_Num: Boolean;
  begin
    sHeadStr := sSrc;
    sNum     := '';
    sEndStr  := '';
    lb_Num   := False;

    li_Len := Length(sSrc);
    for i := 1 to li_Len do begin
      if (sSrc[i] in [WideChar('0')..WideChar('9')]) then begin
        sHeadStr := Copy(sSrc, 1, i -1);
        for k := i+1 to li_Len do begin
          if not(sSrc[k] in [WideChar('0')..WideChar('9')]) then begin
            sNum    := Copy(sSrc, i, k - i);
            sEndStr := Copy(sSrc, k, MAXINT);
            lb_Num  := True;  //最後まで数値文字の場合この中に入ってこないことへの対策。
            Break;
          end;
        end;
        if not(lb_Num) then begin
          sNum := Copy(sSrc, i, MAXINT);
        end;
        Break;
      end;
    end;
  end;

  function lfni_CompareFile(sStr1, sStr2: WideString): Integer;
  var
    ls_Head1, ls_Num1, ls_End1,
    ls_Head2, ls_Num2, ls_End2: WideString;
    li_Re: Integer;
    li_Num1, li_Num2: Int64;
  begin
    if (sStr1 = '') and (sStr2 = '') then begin
      Result := 0;
    end else if (sStr2 = '') then begin
      Result := 1;
    end else if (sStr1 = '') then begin
      Result := -1;
    end else begin
      Result := WideCompareText(sStr1, sStr2);
      if (Result = 0) then begin
        //sStr1とsStr2は同じ並び順。
        if (WideUpperCase(sStr1) <> WideUpperCase(sStr2)) then begin
          //比較した場合は同じだが文字列としては同じではない場合への対処。
          //「が」とUnicodeの「か゛」の合成文字など。
          if (Length(sStr1) > Length(sStr2)) then begin
            //「が」より「か゛」の合成文字を前に持っていくため(簡単に済ませている)
            Result := -1;
          end else begin
            Result := 1;
          end;
        end;
      end else begin
        //sStr1とsStr2は違う並び順。
        //数値の比較でエラーになった時のために退避しておく。
        li_Re := Result;

        //文字列と数値文字列に分解'abc_12-A'->'abc_', '12, '-A'。
        lpc_StrNumDiv(sStr1, ls_Head1, ls_Num1, ls_End1);
        lpc_StrNumDiv(sStr2, ls_Head2, ls_Num2, ls_End2);

        //数値文字列以前の文字列で比較。
        if ((ls_Head1 = '') and (ls_Head2 <> ''))
        or ((ls_Head2 = '') and (ls_Head1 <> ''))
        then begin
          //どちらかが空文字だった。
          //'[.txt'と'1.txt'だと'[.txt'の方が先に並べられることへの対応。
        end else begin
          Result := gfniStringCompareText(ls_Head1, ls_Head2);
          if (Result = 0) then begin
            //数値文字列以前は同じだった
            if (WideUpperCase(ls_Head1) <> (WideUpperCase(ls_Head2))) then begin
              //比較した場合は同じだが文字列としては同じではない場合への対処。
              //「が」とUnicodeの「か゛」の合成文字など。
              if (Length(ls_Head1) > Length(ls_Head2)) then begin
                //「が」より「か゛」の合成文字を前に持っていくため(簡単に済ませている)
                Result := -1;
              end else begin
                Result := 1;
              end;
            end else begin
              //数値以前の文字列が同じだったので数値文字列で比較。
              if (ls_Num1 = '') and (ls_Num2 = '') then begin
                Result := 0;
              end else if (ls_Num2 = '') then begin
                Result := 1;
              end else if (ls_Num1 = '') then begin
                Result := -1;
              end else begin
                try
                  li_Num1 := StrToInt64(ls_Num1);
                  li_Num2 := StrToInt64(ls_Num2);
                  if (li_Num1 = li_Num2) then begin
                    Result := 0;
                  end else if (li_Num1 > li_Num2) then begin
                    Result := 1;
                  end else if (li_Num1 < li_Num2) then begin
                    Result := -1;
                  end;
                  if (Result = 0) then begin
                    Result := lfni_CompareFile(ls_End1, ls_End2);
                  end;
                except
                  //エラーが起きたら数値の比較は無効にしてしまう。
                  Result := li_Re;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
var
  ls_Path1, ls_Name1,
  ls_Path2, ls_Name2: WideString;
begin
  if (sStr1 = sStr2) then begin
    Result := 0;
    Exit;
  end;

  gpcFileDirNameDiv(sStr1, ls_Path1, ls_Name1);
  gpcFileDirNameDiv(sStr2, ls_Path2, ls_Name2);
  //まずフォルダーだけで比較
  Result := lfni_CompareFile(ls_Path1, ls_Path2);
  if (Result = 0) then begin
    //フォルダーが同じならファイル名で比較
    Result := lfni_CompareFile(ls_Name1, ls_Name2);
  end;
end;

function gfnbIsIncludeList(sValue: WideString; slList: TStrings): Boolean;
//slList中にsValueがあればTrueを返す
//大文字小文字の違いは無視
var
  i: Integer;
begin
  Result := False;
  for i := 0 to slList.Count -1 do begin
    if (WideCompareText(sValue, slList[i]) = 0) then begin
      Result := True;
      Break;
    end;
  end;
end;

//Name=Value形式のデータ
function gfnsIniNameGet(const sItem: WideString): WideString; overload;
var
  li_Pos: Integer;
begin
  if (sItem <> '') then begin
    li_Pos := Pos('=', sItem);
    if (li_Pos <= 1) then begin
      Result := '';
    end else begin
      Result := Trim(Copy(sItem, 1, li_Pos - 1));
    end;
  end else begin
    Result := '';
  end;
end;

function gfnsIniValueGet(sItem: WideString): WideString;
var
  li_Pos: Integer;
begin
  if (sItem <> '') then begin
    li_Pos := Pos('=', sItem);
    if (li_Pos = 0) then begin
      Result := sItem;
    end else begin
      Result := Copy(sItem, li_Pos + 1, MaxInt);
    end;
  end else begin
    Result := '';
  end;
end;
{$ENDIF}


//==============================================================================
function gfnsCharCodeToDescription(cdCode: TMyCharCode): WideString;
{2009-07-30:
文字コードをあらわす文字列を返す。
}

begin
  case cdCode of
    cdSJis:      Result := 'Shift_JIS';
    cdUnicodeLE: Result := 'UTF-16 LE(リトルエンディアン)BOMあり';
    cdUTF_16LE:  Result := 'UTF-16 LE(リトルエンディアン)BOMなし';
    cdUnicodeBE: Result := 'UTF-16 BE(ビッグエンディアン)BOMあり';
    cdUTF_16BE:  Result := 'UTF-16 BE(ビッグエンディアン)BOMなし';
    cdUTF_8:     Result := 'UTF-8 BOMあり';
    cdUTF_8N:    Result := 'UTF-8 BOMなし';
    cdUTF_7:     Result := 'UTF-7';
    cdJIS:       Result := 'JIS';
    cdEUC:       Result := 'EUC-JP';
    cdBINDUMP:   Result := 'バイナリダンプ';
    cdAuto:      Result := '自動判定';
    else         Result := '';
  end;
end;

function gfnsCharCodeToText(cdCode: TMyCharCode): WideString;
begin
  case cdCode of
    cdSJis
    :begin
      Result := 'Shift_JIS';
    end;
    cdUnicodeLE,
    cdUTF_16LE,
    cdUnicodeBE,
    cdUTF_16BE
    :begin
      Result := 'UTF-16';
    end;
    cdUTF_8,
    cdUTF_8N
    :begin
      Result := 'UTF-8';
    end;
    cdUTF_7
    :begin
      Result := 'UTF-7';
    end;
    cdJIS
    :begin
      Result := 'JIS';
    end;
    cdEUC
    :begin
      Result := 'EUC-JP';
    end;
    cdBINDUMP
    :begin
      Result := 'バイナリダンプ';
    end;
    else
    begin
      Result := 'Shift_JIS';
    end;
  end;
end;

function gfnCodePageToCharCode(iCodePage: Integer): TMyCharCode;
{2010-10-02:
コードページからそれに対応する文字コードを返す
}

begin
  case iCodePage of
    -1:    Result := cdBINDUMP;   //バイナリ
    932:   Result := cdSJis;      //日本語 (シフト JIS) shift_jis
    1200:  Result := cdUTF_16LE;  //Unicode utf-16
    1201:  Result := cdUTF_16BE;  //Unicode (Big-Endian) unicodeFFFE
    10001: Result := cdSJis;      //日本語 (Mac) x-mac-japanese
    20127: Result := cdSJis;      //US-ASCII us-ascii
    20932: Result := cdEUC;       //日本語 (JIS 0208-1990 および 0212-1990) EUC-JP
    50220: Result := cdJIS;       //日本語 (JIS) iso-2022-jp
    50221: Result := cdJIS;       //日本語 (JIS 1 バイト カタカナ可) csISO2022JP
    50222: Result := cdJIS;       //日本語 (JIS 1 バイト カタカナ可 - SO/SI) iso-2022-jp
    50225: Result := cdJIS;       //韓国語 (ISO) iso-2022-kr
    50227: Result := cdJIS;       //簡体字中国語 (ISO-2022) x-cp50227
    51932: Result := cdEUC;       //日本語 (EUC) euc-jp
    51936: Result := cdEUC;       //簡体字中国語 (EUC) EUC-CN
    51949: Result := cdEUC;       //韓国語 (EUC) euc-kr
    65000: Result := cdUTF_7;
    65001: Result := cdUTF_8N;
    else   Result := cdSJis;
  end;
end;


function gfnsNewLineGet(nlLineFeed: TMyNewLine): WideString;
begin
  case nlLineFeed of
    nlCR: Result := WideString(#$D);
    nlLF: Result := WideString(#$A);
    else  Result := WideString(#$D#$A);
  end;
end;

function gfnsNewLineToDescription(nlLineFeed: TMyNewLine): WideString;
begin
  case nlLineFeed of
    nlCR: Result := 'CR';
    nlLF: Result := 'LF';
    else  Result := 'CR+LF';
  end;
end;


//------------------------------------------------------------------------------
//Unicode文字列
//UTF-16LE⇔UTF-7
function gfnsWideToUtf7(sSrc: WideString): AnsiString;
//WideStringをUTF-7にエンコードして返す
var
  li_Len:  Integer;
  lp_Buff: PAnsiChar;
begin
  //WC_COMPOSITECHECKはNG
  li_Len  := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, nil, 0, nil, nil);
  lp_Buff := AllocMem(li_Len + 1);
  try
    WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil);
    Result := AnsiString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;
function gfnsUtf7ToWide(sSrc: AnsiString): WideString;
//UTF-7でエンコードされている文字列をWideStringにして返す
var
  li_Len:  Integer;
  lp_Buff: PWideChar;
begin
  li_Len  := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, nil, 0);
  lp_Buff := AllocMem((li_Len + 1) * 2);
  try
    MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
    Result := WideString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

//UTF-16LE⇔UTF-8
function gfnsWideToUTF8(sSrc: WideString): AnsiString;
{2008-06-06:
WideStringをUTF-8にエンコードして返す。
UTF8Encodeの方が速い。が、UTF8Encodeはサロゲートペアに対応していない。
}

var
  li_Len:  Integer;
  lp_Buff: PAnsiChar;
begin
  li_Len  := WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, nil, 0, nil, nil);
  lp_Buff := AllocMem(li_Len + 1);
  try
    WideCharToMultiByte(CP_UTF8, 0, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil);
    Result := UTF8String(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

function gfnsUTF8ToWide(sSrc: AnsiString): WideString;
{2008-06-06:
UTF-8でエンコードされている文字列をWideStringにして返す。
UTF8Decodeの方が速い。が、UTF8Decodeはサロゲートペアに対応していない。

}

var
  li_Len:  Integer;
  lp_Buff: PWideChar;
begin
  li_Len  := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, nil, 0);
  lp_Buff := AllocMem((li_Len + 1) * 2);
  try
    MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
    Result := WideString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

function gfnsJisToWide(sSrc: AnsiString): WideString;
var
  li_Len:  Integer;
  lp_Buff: PWideChar;
begin
  li_Len  := MultiByteToWideChar(CP_JIS, 0, PAnsiChar(sSrc), -1, nil, 0);
  lp_Buff := AllocMem((li_Len + 1) * 2);
  try
    MultiByteToWideChar(CP_JIS, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
    Result := WideString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;
function gfnsWideToJis(sSrc: WideString): AnsiString;
var
  li_Src  : Integer;
  li_Len  : Integer;
  lp_Buff : PAnsiChar;
begin
  //http://www.gesource.jp/weblog/?p=738
  //http://ht-deko.minim.ne.jp/ft0909.html#090927
  li_Src  := Length(sSrc);
  li_Len  := (li_Src * 5) + 4 - (li_Src div 2);
  lp_Buff := AllocMem(li_Len + 1);
  try
    WideCharToMultiByte(CP_JIS, 0, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil);
    Result := AnsiString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

function gfnsEucToWide(sSrc: AnsiString): WideString;
var
  li_Len:  Integer;
  lp_Buff: PWideChar;
begin
  li_Len  := MultiByteToWideChar(CP_EUC, 0, PAnsiChar(sSrc), -1, nil, 0);
  lp_Buff := AllocMem((li_Len + 1) * 2);
  try
    MultiByteToWideChar(CP_EUC, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
    Result := WideString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;
function gfnsWideToEuc(sSrc: WideString): AnsiString;
var
  li_Len:  Integer;
  lp_Buff: PAnsiChar;
begin
  li_Len  := WideCharToMultiByte(CP_EUC, WC_COMPOSITECHECK, PWideChar(sSrc), -1, nil, 0, nil, nil);
  lp_Buff := AllocMem(li_Len + 1);
  try
    WideCharToMultiByte(CP_EUC, WC_COMPOSITECHECK, PWideChar(sSrc), -1, lp_Buff, li_Len +1, nil, nil);
    Result := AnsiString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

function gfnsWideToAnsi(sSrc: WideString): AnsiString;
//合成文字をきちんとあつかってAnsiStringに変換。
//例)「か゛」→「が」みたいな感じで。
const
  lcs_DEF = '';
var
  li_Len:  Integer;
  lp_Buff: PAnsiChar;
begin
  //WC_COMPOSITECHECKが肝
  li_Len  := WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, nil, 0, nil, nil);
  Inc(li_Len);
  lp_Buff := AllocMem(li_Len);
  try
    WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK{ or WC_SEPCHARS}, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil);
    Result := AnsiString(lp_Buff);
  finally
    FreeMem(lp_Buff);
  end;
end;

//AnsiStringとWideStringとの可逆変換関数。
const
  l_csDEFAULT_CHAR = #1;
  l_csPREFIX_CHAR  = '$';
const
  WC_NO_BEST_FIT_CHARS = $00000400;

function gfnsWideToAnsiEx(sSrc: WideString): AnsiString;
{2007-07-27,08-28,10-22,11-05,12-05,12-18,2008-02-12,19,03-07,04-13,06-02,2011-03-31,8-28:
ウムラウトなどのUnicodeな文字だけを$+16進に変換して返す。

http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP:直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。

2011-08-28:IsDBCSLeadByteの判定をif判定のelseの中に入れた。またApplication.ProcessMessagesを遅くなるのでコメントアウト
2011-03-31:SetLengthであらかじめ必要なバイト数を確保して書き込んでゆくやり方に変えた。10倍速くなった。それでもUTF-7利用の方が2倍速い。
2010-06-06:プリフィクスを%から$に変更。
2008-04-13:WC_COMPOSITECHECKをコメントアウトUnicodeの3099(「゛」のような文字)があるとおかしなことになってしまうことが判明したので。
2008-03-07:%を%%ではなく%0025に変換するように変更。
2008-02-19:%は2バイト文字の第一バイトにも第二バイトにも現れないのでAnsiPosでなくPosに変更。
2008-02-12:ウムラウトのようなUnicode文字かプリフィクスがあるか判定し、なければ変換ぜずsSrcをそのまま返すように変更。
2007-12-18:WideCharToMultiByteは終わりの#0も含めた必要なバッファ数を返すことから終わりの#0まで返していた不具合を修正。
2007-12-05:repeatを使ったものに書き換え。
2007-11-05:プリフィクスの扱いの間違いを修正。
2007-10-22:1バイトのウムラウトのような文字だけでなく2バイトの(中国語のような)文字にも対応できるように変更。
2007-08-28:プリフィクス文字がsSrc中にあった場合の処理を追加。
}

var
  i        : Integer;
  li_Pos   : Integer;
  li_Len   : Integer;
  li_Count : Integer;
  li_Index : Integer;
  ls_Char  : AnsiChar;
  lb_Bool  : LongBool;
  lp_Buff  : PAnsiChar;
begin
  Result := '';
  if (sSrc <> '') then
  begin
    //WC_COMPOSITECHECKは指定してはいけない。
    li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
    if  (lb_Bool = False)
    and (Pos(l_csPREFIX_CHAR, sSrc) = 0)
    then
    begin
      //ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし。
      //'$'は2バイト文字の第一バイトにも第二バイトにも現れないのでPosでよい。
      Result := sSrc;
    end else
    begin
      lp_Buff := AllocMem(li_Len + 1);
      try
        li_Len := WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, lp_Buff, li_Len, l_csDEFAULT_CHAR, @lb_Bool);
        if (li_Len > 0) then
        begin
          //まず必要なバイト数を求める
          li_Count := li_Len; //必要なバイト数
          i := 0;
          Dec(li_Len);
          //forで回すよりこっちの方が速い。
          repeat
            ls_Char := lp_Buff[i];
            if (ls_Char = l_csDEFAULT_CHAR)
            or (ls_Char = l_csPREFIX_CHAR)
            then
            begin
              //#1→'$xxxx' xxxx は元の文字の4桁の16進値
              //$→ '$0024'
              Inc(li_Count, 4);
            end;
            Inc(i);
          until (i >= li_Len);  //untilは条件がTrueで終了。
          SetLength(Result, li_Count);

          i        := 0; //lp_Buffのインデックス
          li_Pos   := 1; //sSrc   のインデックス
          li_Index := 1; //Result のインデックス
          repeat
            ls_Char := lp_Buff[i];
            if (ls_Char = l_csDEFAULT_CHAR)
            or (ls_Char = l_csPREFIX_CHAR)
            then
            begin
              //#1→'$xxxx' xxxx は元の文字の4桁の16進値
              //$→ '$0024'
              Result[li_Index] := l_csPREFIX_CHAR;
              Inc(li_Index);
              StrFmt(@Result[li_Index], '%0.4x', [Ord(sSrc[li_Pos])]);
              Inc(li_Index, 4);
            end else
            begin
              Result[li_Index] := ls_Char;
              Inc(li_Index);
              //2011-08-28:位置を変更
              //この判定はないといけない。
//              if (IsDBCSLeadByte(Byte(ls_Char))) then begin
              //こっちの方が10%程度速い
              case ls_Char of
                #$81..#$9F,
                #$E0..#$EF
                :begin
                  //2バイト文字の先頭バイトなのでもう1バイトスキップ。
                  Inc(i);
                  Result[li_Index] := lp_Buff[i];
                  Inc(li_Index);
                end;
              end;
            end;

            Inc(i);
            Inc(li_Pos);
            //2011-08-28:遅くなるのでコメントアウト
//            Application.ProcessMessages; 遅くなる
          until (i >= li_Len);  //untilは条件がTrueで終了。
          SetLength(Result, li_Index -1);
        end;
      finally
        FreeMem(lp_Buff);
      end;
    end;
  end;
end;

function gfnsAnsiToWideEx(sSrc: AnsiString): WideString;
{2007-07-27,10-22,11-05,12-05,2008-02-12,19,03-07,16,05-30,2010-06-02,2011-03-31:
gfnsWideToStrExの逆。

2011-03-31:Resultに逐次上書きしてゆき最後にSetLengthする方式に変更。30倍ほど速くなった。それでもUTF-7利用のほうが30%程度高速。
2010-06-06:プリフィクスを%から$に変更。
2008-05-30:速度向上のため書き換え。200倍くらいの差が出た…。
2008-03-16:プリフィクスに続く四文字が数値変換できない場合はプリフクスも含めてそのままにするよう変更。
2008-03-07:%を%%ではなく%0025に変換するようにgfnsWideToStrExを変えたのでそれに対応。
2008-02-19:%は2バイト文字の第一バイトにも第二バイトにも現れないのでAnsiPosでなくPosに変更。
2008-02-12:プリフィクスがあるか判定し、なければ変換ぜずsSrcをそのまま返すように変更。
2007-12-05:repeatを使ったものに書き換え。
2007-11-05:プリフィクスの扱いの間違いを修正。
2007-10-22:1バイトのウムラウトのような文字だけでなく2バイトの(中国語のような)文字にも対応。
}

var
  ls_Code  : array[0..4] of WideChar;
  ls_Char  : WideChar;
  li_Read  : Integer;
  li_Write : Integer;
  li_Pos   : Integer;
  li_Len   : Integer;
begin
  Result := '';
  if (sSrc <> '') then
  begin
    Result := WideString(sSrc);
    li_Pos := Pos(l_csPREFIX_CHAR, Result);
    //プリフィクス文字($)がなければ独自変換する必要はない。
    if (li_Pos > 0) then
    begin
      ls_Code[0] := '$';
      li_Len     := Length(Result);
      li_Read    := li_Pos;         //読み込む位置
      li_Write   := li_Read;        //書き込む位置
      repeat
        if (Result[li_Read] = l_csPREFIX_CHAR) then
        begin
          try
            //'$'に続く(はずの)4文字の数値をUnicode文字に変換。
            Move(Result[li_Read +1], ls_Code[1], 4 * SizeOf(WideChar));
            ls_Char          := WideChar(StrToInt(ls_Code));
            Result[li_Write] := ls_Char;
            Inc(li_Read, 5);
            Inc(li_Write);
          except
            //イレギュラー
            //イレギュラー時はそのままにする。
            Result[li_Write] := Result[li_Read];
            Inc(li_Read);
            Inc(li_Write);
          end;
        end else
        begin
          Result[li_Write] := Result[li_Read];
          Inc(li_Read);
          Inc(li_Write);
        end;
        //Application.ProcessMessages;
      until (li_Read > li_Len);  //untilは条件がTrueで終了。
      SetLength(Result, li_Write -1);
    end;
  end;
end;

function gfnbIsUnicode(sSrc: WideString): Boolean;
//sSrcにウムラウトのようなUnicode文字があればTrueを返す
var
  lb_Bool: LongBool;
begin
  WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, PWideChar(sSrc), -1, nil, 0, nil, @lb_Bool);
  Result := lb_Bool;
end;


//------------------------------------------------------------------------------
//文字コードの自動判定
//http://mrxray.on.coocan.jp/Delphi/plSamples/886_ChangeCodePage.htm
//http://www.delphikingdom.com/asp/answer.asp?IDAnswer=16895
const
  IID_IMultiLanguage2  : TGUID = '{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}';
  CLASS_CMultiLanguage : TGUID = '{275C23E2-3747-11D0-9FEA-00AA003F8646}';

type
  tagMIMECPINFO = packed record
    dwFlags             : LongWord;
    uiCodePage          : SYSUINT;
    uiFamilyCodePage    : SYSUINT;
    wszDescription      : array[0..63] of Word;
    wszWebCharset       : array[0..49] of Word;
    wszHeaderCharset    : array[0..49] of Word;
    wszBodyCharset      : array[0..49] of Word;
    wszFixedWidthFont   : array[0..31] of Word;
    wszProportionalFont : array[0..31] of Word;
    bGDICharset         : Byte;
  end;

  tagMIMECSETINFO = packed record
    uiCodePage         : SYSUINT;
    uiInternetEncoding : SYSUINT;
    wszCharset         : array[0..49] of Word;
  end;

  tagRFC1766INFO = packed record
    lcid          : LongWord;
    wszRfc1766    : array[0..5]  of Word;
    wszLocaleName : array[0..31] of Word;
  end;

  tagDetectEncodingInfo = packed record
    nLangID     : SYSUINT;
    nCodePage   : SYSUINT;
    nDocPercent : SYSINT;
    nConfidence : SYSINT;
  end;

  tagSCRIPTINFO = packed record
    ScriptId            : Byte;
    uiCodePage          : SYSUINT;
    wszDescription      : array[0..47] of Word;
    wszFixedWidthFont   : array[0..31] of Word;
    wszProportionalFont : array[0..31] of Word;
  end;

  __MIDL_IWinTypes_0009 = record
    case Integer of
      0 : (hInproc : Integer);
      1 : (hRemote : Integer);
  end;

  _RemotableHandle = packed record
    fContext : Integer;
    u        : __MIDL_IWinTypes_0009;
  end;

// Constants for enum tagMIMECONTF
//type
  tagMIMECONTF = TOleEnum;

// *********************************************************************//
// Interface: IEnumCodePage
// Flags:    (0)
// GUID:      {275C23E3-3747-11D0-9FEA-00AA003F8646}
// *********************************************************************//
  IEnumCodePage = interface(IUnknown)
    ['{275C23E3-3747-11D0-9FEA-00AA003F8646}']
    function Clone(out ppEnum: IEnumCodePage): HResult; stdcall;
    function Next(celt: LongWord; out rgelt: tagMIMECPINFO; out pceltFetched: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IEnumRfc1766
// Flags:    (0)
// GUID:      {3DC39D1D-C030-11D0-B81B-00C04FC9B31F}
// *********************************************************************//
  IEnumRfc1766 = interface(IUnknown)
    ['{3DC39D1D-C030-11D0-B81B-00C04FC9B31F}']
    function Clone(out ppEnum: IEnumRfc1766): HResult; stdcall;
    function Next(celt: LongWord; out rgelt: tagRFC1766INFO; out pceltFetched: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IMLangConvertCharset
// Flags:    (0)
// GUID:      {D66D6F98-CDAA-11D0-B822-00C04FC9B31F}
// *********************************************************************//
  IMLangConvertCharset = interface(IUnknown)
    ['{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}']
    function Initialize(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT; dwProperty: LongWord): HResult; stdcall;
    function GetSourceCodePage(out puiSrcCodePage: SYSUINT): HResult; stdcall;
    function GetDestinationCodePage(out puiDstCodePage: SYSUINT): HResult; stdcall;
    function GetProperty(out pdwProperty: LongWord): HResult; stdcall;
//*****
//    function DoConversion(var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
//                          var pcDstSize: SYSUINT): HResult; stdcall;
    function DoConversion(
        pSrcStr       : PAnsiChar;
        var pcSrcSize : SYSUINT;
        pDstStr       : PAnsiChar;
        var pcDstSize : SYSUINT
    ) : HResult; stdcall;
    function DoConversionToUnicode(var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
                                  var pDstStr: Word; var pcDstSize: SYSUINT): HResult; stdcall;
    function DoConversionFromUnicode(var pSrcStr: Word; var pcSrcSize: SYSUINT;
                                    var pDstStr: Shortint; var pcDstSize: SYSUINT): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IEnumScript
// Flags:    (0)
// GUID:      {AE5F1430-388B-11D2-8380-00C04F8F5DA1}
// *********************************************************************//
  IEnumScript = interface(IUnknown)
    ['{AE5F1430-388B-11D2-8380-00C04F8F5DA1}']
    function Clone(out ppEnum: IEnumScript): HResult; stdcall;
    function Next(celt: LongWord; out rgelt: tagSCRIPTINFO; out pceltFetched: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
  end;

// *********************************************************************//
// Interface: IMultiLanguage2
// Flags:    (0)
// GUID:      {DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}
// *********************************************************************//
  IMultiLanguage2 = interface(IUnknown)
    ['{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}']
    function GetNumberOfCodePageInfo(out pcCodePage: SYSUINT): HResult; stdcall;
    function GetCodePageInfo(uiCodePage: SYSUINT; LangId: Word; out pCodePageInfo: tagMIMECPINFO): HResult; stdcall;
    function GetFamilyCodePage(uiCodePage: SYSUINT; out puiFamilyCodePage: SYSUINT): HResult; stdcall;
    function EnumCodePages(grfFlags: LongWord; LangId: Word; out ppEnumCodePage: IEnumCodePage): HResult; stdcall;
    function GetCharsetInfo(const Charset: WideString; out pCharsetInfo: tagMIMECSETINFO): HResult; stdcall;
    function IsConvertible(dwSrcEncoding: LongWord; dwDstEncoding: LongWord): HResult; stdcall;
//*****
//    function ConvertString(var pdwMode: LongWord; dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
//                          var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
//                          var pcDstSize: SYSUINT): HResult; stdcall;
    function ConvertString(
        var pdwMode   : LongWord;
        dwSrcEncoding : LongWord;
        dwDstEncoding : LongWord;
        var pSrcStr   : Byte;
        var pcSrcSize : SYSUINT;
        var pDstStr   : Byte;
        var pcDstSize : SYSUINT
    ) : HResult; stdcall;
//*****
//    function ConvertStringToUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
//                                    var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
//                                    var pDstStr: Word; var pcDstSize: SYSUINT): HResult; stdcall;
    function ConvertStringToUnicode(
        var pdwMode   : DWORD;
        dwEncoding    : DWORD;
        pSrcStr       : PAnsiChar;
        var pcSrcSize : SYSUINT;
        pDstStr       : PWideChar;
        var pcDstSize : SYSUINT
    ) : HResult; stdcall;
//*****
//    function ConvertStringFromUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
//                                      var pSrcStr: Word; var pcSrcSize: SYSUINT;
//                                      var pDstStr: Shortint; var pcDstSize: SYSUINT): HResult; stdcall;
    function ConvertStringFromUnicode(
        var pdwMode   : DWORD;
        dwEncoding    : DWORD;
        pSrcStr       : PWideChar;
        var pcSrcSize : SYSUINT;
        pDstStr       : PAnsiChar;
        var pcDstSize : SYSUINT
    ) : HResult; stdcall;
    function ConvertStringReset: HResult; stdcall;
    function GetRfc1766FromLcid(locale: LongWord; out pbstrRfc1766: WideString): HResult; stdcall;
    function GetLcidFromRfc1766(out plocale: LongWord; const bstrRfc1766: WideString): HResult; stdcall;
    function EnumRfc1766(LangId: Word; out ppEnumRfc1766: IEnumRfc1766): HResult; stdcall;
    function GetRfc1766Info(locale: LongWord; LangId: Word; out pRfc1766Info: tagRFC1766INFO): HResult; stdcall;
    function CreateConvertCharset(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT;
                                  dwProperty: LongWord;
                                  out ppMLangConvertCharset: IMLangConvertCharset): HResult; stdcall;
    function ConvertStringInIStream(var pdwMode: LongWord; dwFlag: LongWord; var lpFallBack: Word;
                                    dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
                                    const pstmIn: ISequentialStream;
                                    const pstmOut: ISequentialStream): HResult; stdcall;
    function ConvertStringToUnicodeEx(var pdwMode: LongWord; dwEncoding: LongWord;
                                      var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
                                      var pDstStr: Word; var pcDstSize: SYSUINT; dwFlag: LongWord;
                                      var lpFallBack: Word): HResult; stdcall;
    function ConvertStringFromUnicodeEx(var pdwMode: LongWord; dwEncoding: LongWord;
                                        var pSrcStr: Word; var pcSrcSize: SYSUINT;
                                        var pDstStr: Shortint; var pcDstSize: SYSUINT;
                                        dwFlag: LongWord; var lpFallBack: Word): HResult; stdcall;
    function DetectCodepageInIStream(dwFlag: LongWord; dwPrefWinCodePage: LongWord;
                                    const pstmIn: ISequentialStream;
                                    var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
//*****
//    function DetectInputCodepage(dwFlag: LongWord; dwPrefWinCodePage: LongWord;
//                                var pSrcStr: Shortint; var pcSrcSize: SYSINT;
//                                var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
    function DetectInputCodepage(
        dwFlag            : DWORD;
        dwPrefWinCodePage : DWORD;
        pSrcStr           : PAnsiChar;
        var pcSrcSize     : SYSINT;
        var lpEncoding    : tagDetectEncodingInfo;
        var pnScores      : SYSINT
    ) : HResult; stdcall;
    function ValidateCodePage(uiCodePage: SYSUINT; var hwnd: _RemotableHandle): HResult; stdcall;
    function GetCodePageDescription(uiCodePage: SYSUINT; lcid: LongWord; lpWideCharStr: PWideChar;
                                    cchWideChar: SYSINT): HResult; stdcall;
    function IsCodePageInstallable(uiCodePage: SYSUINT): HResult; stdcall;
    function SetMimeDBSource(dwSource: tagMIMECONTF): HResult; stdcall;
    function GetNumberOfScripts(out pnScripts: SYSUINT): HResult; stdcall;
    function EnumScripts(dwFlags: LongWord; LangId: Word; out ppEnumScript: IEnumScript): HResult; stdcall;
    function ValidateCodePageEx(uiCodePage: SYSUINT; var hwnd: _RemotableHandle;
                                dwfIODControl: LongWord): HResult; stdcall;
  end;


function gfniCodePageGet(pBuff: PAnsiChar; iCount: Integer): Integer;
{2010-10-02:
文字コードを判定してコードページを返す。
BOMなしのUTF-16は正しく判定できず1252が返る。
}

const
  CP_SHIFT_JIS    = 932;  //Shift-JIS
  CP_UTF_16LE     = 1200; //UTF-16リトルエンディアン
  CP_UTF_16BE     = 1201; //UTF-16ビッグエンディアン
  CP_WINDOWS_1252 = 1252;

  function _CheckEndian(sStr: WideString): Boolean;
  var
    i : Integer;
    li_Kana : Integer;
    li_Len  : Integer;
  begin
    li_Len := Length(sStr);
    if (li_Len = 0)
    then begin
      Result := True;
  Exit;
    end;

    li_Kana := 0;
    for i := 1 to li_Len
    do begin
      case Ord(sStr[i]) of
        $0020..$007E, //半角英数記号
        $3041..$3093, //'ぁ'..'ん', ひらがな
        $30A1..$30F6  //'ァ'..'ヶ'  カタカナ
        :begin
          Inc(li_Kana);
        end;
      end;
    end;

    Result := (li_Kana / li_Len * 100 > 1);
  end;

  function _CheckUTF16(pBuff: PAnsiChar; iCount: Integer): Integer;
  var
    i : Integer;
    lb_U16  : Boolean;
    lb_1st  : Boolean;
    lb_SJis : Boolean;
    ls_Code : AnsiChar;
    ls_Str  : WideString;
  begin
    lb_U16  := False;
    lb_1st  := False;
    lb_SJis := True;
    for i := 0 to iCount-1 do
    begin
      ls_Code := pBuff[i];
      case (ls_Code) of
        #0
        :begin
          lb_U16  := True;
          lb_1st  := False;
          lb_SJis := False; //#0があったのでShift_JISではない。
        end;

        #$81..#$9F,
        #$E0..#$EF
        :begin
          //Shift_JISの漢字の第1バイトの範囲。但し第2バイトの範囲でもある
          if (lb_1st) then
          begin
            lb_1st := False;
          end else
          begin
            lb_1st := True;
          end;
        end;
        else
        begin
          case ls_Code of
            #$80,
            #$A0,
            #$F0..#$FC
            :begin
              //Shift_JISの漢字の第2バイトで第1バイトの次に来るべき範囲。
              //lb_1stがTrueでなければShift_JISとしては不正。
              if not(lb_1st) then
              begin
                lb_SJis := False;
              end;
            end;
            #$1..#$3F
            :begin
              //Shift_JISの範囲内だが漢字の第1バイトにも第2バイトにも含まれない範囲。
              //lb_1stがTrueの時にここに来たら不正。
              if (lb_1st) then
              begin
                lb_SJis := False;
              end;
            end;
            #$7F,
            #$FD..#$FF
            :begin
              //Shift_JISの範囲外。
              lb_SJis := False;
            end;
          end;
          lb_1st := False;
        end;
      end;
    end;

    if (lb_U16 and not(lb_SJis)) then
    begin
      //リトルエンディアンでテスト
      ls_Str := gfnsWStrBCopy(pBuff, 0, iCount, cdUTF_16LE);
      if (_CheckEndian(ls_Str)) then
      begin
        Result := CP_UTF_16LE;
  Exit;
      end else
      begin
        //ビッグエンディアンでテスト
        ls_Str := gfnsWStrBCopy(pBuff, 0, iCount, cdUTF_16BE);
        if (_CheckEndian(ls_Str)) then
        begin
          Result := CP_UTF_16BE;
  Exit;
        end else
        begin
          Result := -1;
  Exit;
        end;
      end;
    end else
    if not(lb_SJis) then
    begin
      Result := -1;
    end else
    begin
      Result := CP_SHIFT_JIS;
    end;
  end;
var
  F_iMultiLanguage : IMultiLanguage2;
  l_Encoding       : tagDetectEncodingInfo;
  li_Source        : SYSINT;
begin
  Result := CP_WINDOWS_1252;

  //指定されたCLSID関連付けクラスの1つの未初期化オブジェクトを作成
  if (Succeeded(CoCreateInstance(
    CLASS_CMultiLanguage, //オブジェクトのCLSID
    nil,                  //複数オブジェクトの一部の時はIUnknownインターフェイスのポインタ
    CLSCTX_INPROC_SERVER, //管理コードを実行するコンテキスト
    IID_IMultiLanguage2,  //取得するIID
    F_iMultiLanguage      //生成オブジェクトの変数アドレス
  )))
  then begin
    li_Source := 1;
    try
      if (Succeeded(F_iMultiLanguage.DetectInputCodepage(0, 0, pBuff, iCount, l_Encoding, li_Source))) then
      begin
        Result := l_Encoding.nCodePage;
      end;
    finally
      F_iMultiLanguage := nil;
    end;

    if (Result = CP_WINDOWS_1252) then
    begin
      //BOMなしのUnicodeは1252が返ってきてしまうようなので更にチェックが必要
      Result := _CheckUTF16(pBuff, iCount);
    end;
  end;
end;

function gfnCharCodeGet(pBuff: PAnsiChar; iCount: Integer): TMyCharCode;
(*
  function _CheckEndian(sStr: WideString): Boolean;
  var
    i : Integer;
    li_Kana : Integer;
    li_Len  : Integer;
  begin
    li_Len := Length(sStr);
    if (li_Len = 0)
    then begin
      Result := True;
  Exit;
    end;

    li_Kana := 0;
    for i := 1 to li_Len
    do begin
      case Ord(sStr[i]) of
        $0020..$007E, //半角英数記号
        $3041..$3093, //'ぁ'..'ん', ひらがな
        $30A1..$30F6  //'ァ'..'ヶ'  カタカナ
        :begin
          Inc(li_Kana);
        end;
      end;
    end;

    Result := (li_Kana / li_Len * 100 > 1);
  end;

  function _CheckUTF16(pBuff: PAnsiChar; iCount: Integer): TMyCharCode;
  var
    i : Integer;
    lb_U16  : Boolean;
    lb_1st  : Boolean;
    lb_SJis : Boolean;
    ls_Code : AnsiChar;
    ls_Str  : WideString;
  begin
    lb_U16  := False;
    lb_1st  := False;
    lb_SJis := True;
    for i := 0 to iCount-1 do
    begin
      ls_Code := pBuff[i];
      case (ls_Code) of
        #0
        :begin
          lb_U16  := True;
          lb_1st  := False;
          lb_SJis := False; //#0があったのでShift_JISではない。
        end;

        #$81..#$9F,
        #$E0..#$EF
        :begin
          //Shift_JISの漢字の第1バイトの範囲。但し第2バイトの範囲でもある
          if (lb_1st) then
          begin
            lb_1st := False;
          end else
          begin
            lb_1st := True;
          end;
        end;
        else
        begin
          case ls_Code of
            #$80,
            #$A0,
            #$F0..#$FC
            :begin
              //Shift_JISの漢字の第2バイトで第1バイトの次に来るべき範囲。
              //lb_1stがTrueでなければShift_JISとしては不正。
              if not(lb_1st) then
              begin
                lb_SJis := False;
              end;
            end;
            #$1..#$3F
            :begin
              //Shift_JISの範囲内だが漢字の第1バイトにも第2バイトにも含まれない範囲。
              //lb_1stがTrueの時にここに来たら不正。
              if (lb_1st) then
              begin
                lb_SJis := False;
              end;
            end;
            #$7F,
            #$FD..#$FF
            :begin
              //Shift_JISの範囲外。
              lb_SJis := False;
            end;
          end;
          lb_1st := False;
        end;
      end;
    end;

    if (lb_U16 and not(lb_SJis)) then
    begin
      //リトルエンディアンでテスト
      ls_Str := gfnsWStrBCopy(pBuff, 0, iCount, cdUTF_16LE);
      if (_CheckEndian(ls_Str)) then
      begin
        Result := cdUTF_16LE;
  Exit;
      end else
      begin
        //ビッグエンディアンでテスト
        ls_Str := gfnsWStrBCopy(pBuff, 0, iCount, cdUTF_16BE);
        if (_CheckEndian(ls_Str)) then
        begin
          Result := cdUTF_16BE;
  Exit;
        end else
        begin
          Result := cdBINDUMP;
  Exit;
        end;
      end;
    end else
    if not(lb_SJis) then
    begin
      Result := cdBINDUMP;
    end else
    begin
      Result := cdSJis;
    end;
  end;
*)

begin
  if  (iCount >= 3)
  and (pBuff[0] = #$EF)
  and (pBuff[1] = #$BB)
  and (pBuff[2] = #$BF)
  then begin
    //UTF-8 BOMあり
    Result := cdUTF_8;
  end else
  if  (iCount >= 2)
  and (pBuff[0] = #$FF)
  and (pBuff[1] = #$FE)
  then begin
    //UTF-16 BOMありのリトルエンディアン
    Result := cdUnicodeLE;
  end else
  if  (iCount >= 2)
  and (pBuff[0] = #$FE)
  and (pBuff[1] = #$FF)
  then begin
    //UTF-16 BOMありのビッグエンディアン
    Result := cdUnicodeBE;
  end else
  begin
    Result := gfnCodePageToCharCode(gfniCodePageGet(pBuff, iCount));
{
    if (Result = cdSJis)
    then begin
      //BOMなしのUTF-16はgfniCodePageGetでは正しく判定できないので改めてチェックする
      Result := _CheckUTF16(pBuff, iCount);
    end;
}

  end;
end;


//------------------------------------------------------------------------------
//ファイルとのやり取り
function gfnsFileReadText(sFile: WideString): WideString;
{,2010-10-26:
2010-10-26:文字コードのデフォルトを自動判定にした。
}

var
  lcd_Code: TMyCharCode;
begin
  //2010-10-26:文字コードのデフォルトは自動判定。
  lcd_Code := cdAuto;
  Result := gfnsFileReadText(sFile, lcd_Code);
end;

function gfnsFileReadText(sFile: WideString; var cdCode: TMyCharCode): WideString;
begin
  Result := gfnsFileReadText(sFile, cdCode, gfniFileSizeGet(sFile));
end;
function gfnsFileReadText(sFile: WideString; var cdCode: TMyCharCode; iByte: DWORD): WideString; overload;
{2008-05-23,29,2009-01-05,2010-10-03:
Unicode対応テキストファイル読み込み。
cdCodeにはBOMがない時に適用する文字コードを指定する。

cdAnsi     : Shift_JIS
cdUTF_16LE : UTF-16LE
cdUTF_16BE : UTF-16BE
cdUTF_8N   : BOMなしのUTF-8
cdUTF_7    : UTF-7
cdJIS      : JIS
cdEUC      : EUC
cdBINDUMP  : バイナリダンプ
cdAuto     : 自動判定
※sFileの先頭がBOMであるかcdCodeがcdAutoであればcdCodeの値は変更後の文字コードに
 変更される。

2010-10-03:
 JISとEUCを追加。
 cdCodeがcdAutoのとき文字コードの自動判定を行うように変更。
2009-01-05:
  sFileのサイズが0であったときFreeMemでエラーになっていた不具合を修正。
2008-05-29:
  UTF-8に対応。
  http://ja.wikipedia.org/wiki/UTF-8
  gfniFileReadで2バイト余計にAllocMemでメモリ確保するようにしたことによる簡素化。
}

var
  lh_Handle : THandle;
  lp_Buff   : PAnsiChar;
  lp_Endian : PWideChar;
  ls_Text   : AnsiString;
  li_Aiu    : Integer;
  li_Len    : Integer;
  lb_Flag   : Boolean;
  li_Size   : DWORD;
  li_Start  : DWORD;
  li_Count  : DWORD;
begin
  li_Size := iByte;
  if (li_Size = 0)
  then begin
    Result := '';
Exit;
  end;

  lp_Buff := AllocMem(li_Size +2);  //WideString(lp_Buff)としても問題ないように
  try
    li_Aiu := 0;
    repeat
      lh_Handle := CreateFileW(
        PWideChar(sFile),       //ファイル名
        GENERIC_READ,           //アクセスモード
           FILE_SHARE_READ      //共有モード
        or FILE_SHARE_WRITE
        ,
        nil,                    //セキュリティ
        OPEN_EXISTING,          //作成方法
        FILE_ATTRIBUTE_NORMAL,  //ファイル属性
        0                       //テンプレート
      );
      lb_Flag := ReadFile(lh_Handle, lp_Buff^, li_Size, li_Count, nil);
      CloseHandle(lh_Handle);

      if not(lb_Flag)
      then begin
        Sleep(200);
        Inc(li_Aiu);
        if (li_Aiu > 3)
        then begin
    Break; //3回を超えたらループを抜ける
        end;
        Application.ProcessMessages;
      end;
    until (lb_Flag);

    if not(lb_Flag)
    then begin
      Beep;
//      gpcShowMessage('開けませんでした');
    end;

    if (li_Count <= 0)
    then begin
      Result := '';
    end
    else
    begin
      li_Start := 0;

      case cdCode of
        cdAuto..cdBINDUMP
        :begin
          //何もしない
        end;
        else
        begin
          //範囲外なら自動判定にしてしまう
          cdCode := cdAuto;
        end;
      end;

      if (cdCode = cdAuto)
      then begin
        //自動判定
        if  (li_Count >= 3)
        and (lp_Buff[0] = #$EF)
        and (lp_Buff[1] = #$BB)
        and (lp_Buff[2] = #$BF)
        then begin
          //UTF-8 BOMあり
          cdCode := cdUTF_8;
          Inc(li_Start, 3);
        end
        else
        if  (li_Count >= 2)
        and (lp_Buff[0] = #$FF)
        and (lp_Buff[1] = #$FE)
        then begin
          //UTF-16 BOMありのリトルエンディアン
          cdCode := cdUnicodeLE;
          Inc(li_Start, 2);
        end else
        if  (li_Count >= 2)
        and (lp_Buff[0] = #$FE)
        and (lp_Buff[1] = #$FF)
        then begin
          //UTF-16 BOMありのビッグエンディアン
          cdCode := cdUnicodeBE;
          Inc(li_Start, 2);
        end
        else
        begin
          cdCode := gfnCharCodeGet(lp_Buff, gfniMin([li_Count, 1024]));
        end;
      end;

      if (cdCode = cdBINDUMP)
      then begin
        Result := gfnsPCharToBinDump(lp_Buff, li_Count);
      end
      else
      if (cdCode = cdUTF_8) or (cdCode = cdUTF_8N)
      then begin
        //2008-05-29
        //UTF-8
        //Del6のUtf8Decodeはサロゲートペア非対応
//        Result := Utf8Decode(AnsiString(PAnsiChar(@lp_Buff[li_Start])));
        //2010-10-01
        Result := gfnsUtf8ToWide(AnsiString(PAnsiChar(@lp_Buff[li_Start])));
      end
      else
      if (cdCode = cdUnicodeLE)
      or (cdCode = cdUnicodeBE)
      or (cdCode = cdUTF_16LE)
      or (cdCode = cdUTF_16BE)
      then begin
        //UTF-16
        //gfniFileReadでlp_Buffを2バイト余計にAllocMemでメモリ確保しているのでWideStringでキャストOK
        Result := WideString(PWideChar(@lp_Buff[li_Start]));
        if (cdCode = cdUTF_16BE) or (cdCode = cdUnicodeBE)
        then begin
          //エンディアン入れ替え
          li_Len := LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(Result), -1, nil, 0);
          lp_Endian := AllocMem((li_Len +1) * 2);
          try
            LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(Result), -1, lp_Endian, li_Len);
            Result := WideString(lp_Endian);
          finally
            FreeMem(lp_Endian);
          end;
        end;
      end
      else
      begin
        //Shift_JIS、UTF-7、JIS、EUC
        //gfniFileReadでlp_Buffを2バイト余計にAllocMemでメモリ確保しているのでAnsiStringでキャストOK
//ResultをgfnsEucToWideの引数に渡すと文字化けするのでそれへの対処。
//        Result := AnsiString(lp_Buff);
        ls_Text := AnsiString(lp_Buff);
        if (cdCode = cdUTF_7) then
        begin
          //UTF-7
          Result := gfnsUtf7ToWide(ls_Text);
        end else
        if (cdCode = cdJIS) then
        begin
          Result := gfnsJisToWide(ls_Text);
        end else
        if (cdCode = cdEUC) then
        begin
          Result := gfnsEucToWide(ls_Text);
        end else
        begin
          if (cdCode <> cdSJIS) then
          begin
            cdCode := cdSJis;
          end;
          Result := ls_Text;
        end;
      end;
    end;
  finally
    FreeMem(lp_Buff);
  end;
end;

function gfnbFileWriteText(sFile, sText: WideString): Boolean;
{2008-05-24,2009-02-01:
Unicode対応のファイル書き込み。

2009-02-01:cdAnsiからcdAutoに変更。
}

begin
  Result := gfnbFileWriteText(sFile, sText, cdAuto);
end;
function gfnbFileWriteText(sFile, sText: WideString; const cdCode: TMyCharCode): Boolean;
{2008-05-24,29,12-19,2009-02-01,2010-10-03:
Unicode対応のファイル書き込み。
文字コードcdCodeの指定により
・Shift_JIS
・UTF-16 BOMありのリトルエンディアン
・UTF-16 BOMありのビッグエンディアン
・UTF-16LE
・UTF-16BE
・UTF-8  (BOMあり)
・UTF-8N (BOMなし)
・UTF-7
・JIS
・EUC
に対応。さらに、cdCodeがcdAutoでsTextにUnicode文字があればUTF-8で、なければShift_JISで保存。

2010-10-03:
 JISとEUCに対応。
2009-02-01:
  cdCodeにcdAutoを追加。
2008-12-19:
  UTF-8でなぜかLength(ls_Str) -1としていた間違いを修正。なんなんだこの-1は、、?
  恐らくUtf8Encodeの後ろに#0がついてしまうことへの対症療法だったのだと思われ。
2008-05-29:
  UTF-8対応
  文字コード指定でUTF-16LE,UTF-16BE,UTF-8Nの書き込みもできるようにした
}

var
  lh_Handle:  THandle;
  lp_Buff:    PWideChar;
  lp_Byte:    PAnsiChar;
  li_Len:     Integer;
  li_Count:   DWORD;
  ls_Str:     AnsiString;
  li_ErrMode: UINT;
begin
  Result := True;

  lh_Handle := CreateFileW(
      PWideChar(sFile),      //ファイル名
      GENERIC_WRITE,         //アクセスモード
      0,                     //共有モード
      nil,                   //セキュリティ
      CREATE_ALWAYS,         //作成方法
      FILE_ATTRIBUTE_NORMAL, //ファイル属性
      0                      //テンプレート
  );

//  lh_Handle := gfnhFileWriteOpen(sFile);

  if (lh_Handle <> INVALID_HANDLE_VALUE) then begin
    try
      try
        li_ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        if (cdCode = cdUTF_8)
        or (cdCode = cdUTF_8N)
        or ((cdCode = cdAuto) and gfnbIsUnicode(sText))  //自動判別で、sTextにUnicode文字があればUtf-8で書き込み
        then begin
          //UTF-8
          ls_Str := gfnsWideToUTF8(sText);
          if  (Length(ls_Str) >= 3)
          and (ls_Str[1] = #$EF)
          and (ls_Str[2] = #$BB)
          and (ls_Str[3] = #$BF)
          then begin
            //BOMがついているなら後の処理がやりやすいように取り除く。
            ls_Str := Copy(ls_Str, 4, MAXINT);
          end;

          if (cdCode = cdUTF_8N) then begin
            //BOMなし
            WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
          end else begin
            //BOMあり
            WriteFile(lh_Handle, #$EF#$BB#$BF, 3, li_Count, nil);
            WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
          end;
        end else if (cdCode = cdUTF_7) then begin
          //UTF-7
          ls_Str := gfnsWideToUtf7(sText);
          WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
        end else
        if (cdCode = cdUnicodeLE)
        or (cdCode = cdUnicodeBE)
        or (cdCode = cdUTF_16LE)
        or (cdCode = cdUTF_16BE)
        then begin
          //UTF-16
          lp_Byte := PAnsiChar(PWideChar(sText));

          if  (Length(sText) >= 1) //#$FF#$FEで1文字相当の長さ。
          and (lp_Byte[0] = #$FF)
          and (lp_Byte[1] = #$FE)
          then begin
            //BOMがついているなら後の処理がやりやすいように取り除く。
            sText := Copy(sText, 2, MAXINT);
          end;

          li_Len := Length(sText) * 2;
          if (cdCode = cdUnicodeBE) or (cdCode = cdUTF_16BE) then begin
            //ビッグエンディアン
            if (cdCode = cdUnicodeBE) then begin
              //UTF-16 BOMありのビッグエンディアン。
              WriteFile(lh_Handle, #$FE#$FF, 2, li_Count, nil);
            end;
            lp_Buff := AllocMem(li_Len +2);
            try
              LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(sText), -1, lp_Buff, li_Len);
              WriteFile(lh_Handle, lp_Buff^, DWORD(li_Len), li_Count, nil);
            finally
              FreeMem(lp_Buff);
            end;
          end else if (cdCode = cdUnicodeLE) or (cdCode = cdUTF_16LE) then begin
            //リトルエンディアン。
            if (cdCode = cdUnicodeLE) then begin
              //UTF-16 BOMありのリトルエンディアン。
              WriteFile(lh_Handle, #$FF#$FE, 2, li_Count, nil);
            end;
            WriteFile(lh_Handle, PAnsiChar(PWideChar(sText))^, DWORD(li_Len), li_Count, nil);
          end;
        end else if (cdCode = cdJIS) then begin
          //JIS
          ls_Str := gfnsWideToJis(sText);
          WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
        end else if (cdCode = cdEUC) then begin
          //EUC
          ls_Str := gfnsWideToEuc(sText);
          WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
        end else begin
          //Shift_JIS
          ls_Str := gfnsWideToAnsi(sText);  //AnsiString(sText)では合成文字を正しく変換しない場合あり
          WriteFile(lh_Handle, PAnsiChar(ls_Str)^, Length(ls_Str), li_Count, nil);
        end;
        SetErrorMode(li_ErrMode);
      except
        Result := False;
      end;
    finally
      CloseHandle(lh_Handle);
    end;
  end else begin
    Result := False;
  end;
end;


//==============================================================================
{MyWStrings}
constructor TMyWStrings.Create;
begin
  Create(nil);
  //↓を呼んでいる
end;

constructor TMyWStrings.Create(AList: TStrings);
begin
  inherited Create;

  if (AList = nil) then
  begin
    if not(Assigned(F_slList)) then
    begin
      F_slList    := TStringList.Create;
      F_bListFree := True;  //F_slListはFreeしなければならない
    end;
  end else
  begin
    F_slList    := AList;
    F_bListFree := False;    //F_slListはFreeしてはいけない
  end;
  F_slOut := TStringList.Create;

  F_bCaseSensitive := False;
  if (AList <> nil) and (AList is TStringList) then
  begin
    {TStringList等CaseSensitiveのあるものはCreateの後に改めてセットしないといけない}
    F_bCaseSensitive := TStringList(AList).CaseSensitive;
  end;

  F_cdCharCode   := cdAuto; //自動判定
  F_nlNewLine    := nlCRLF; //CR+LF
  F_bObjectsFree := False;

  F_Duplicates   := dupIgnore;

  F_sDelimiter   := ',';
  F_sQuoteChar   := '"';

  F_OnAdd := nil;
end;

destructor TMyWStrings.Destroy;
begin
  if (F_bListFree) then begin
    //2011-07-10:TMyMediaStringsにTMyTagオブジェクトを持つことによりClearを呼ばな
    //いとメモリーリークするようになったのでClearが必須になった。
    Clear;

    F_slList.Free;
    F_slList := nil;
  end;
  F_slOut.Free;
  F_slOut := nil;

  inherited Destroy;
end;

//外部のリストに付け替える
procedure TMyWStrings.Attach(slList: TStrings);
begin
  if (F_bListFree) and (slList <> nil) then begin
    //内部リストを開放
    Clear;
    F_slList.Free;
    F_slList    := nil;
    F_bListFree := False;
  end;

  if (slList <> nil) then begin
    //付け替え。
    F_slList := slList;
  end else begin
    if (F_bListFree) then begin
      //引数がnilなら既存の内部リストをそのまま利用
      F_slList.Clear;
    end else begin
      F_slList    := TStringList.Create;
      F_bListFree := True;  //F_slListはFreeしなければならない
    end;
  end;
end;

//外部リスト解除。外部リストの開放はしない。
procedure TMyWStrings.Detach;
begin
  if not(F_bListFree) then begin
    //外部リストであった。
    if not(Assigned(F_slList)) then begin 
      //内部リストを作成。
      F_slList    := TStringList.Create;
      F_bListFree := True;  //F_slListはFreeしなければならない
    end else begin
      //内部リストが作成されている(ここにくることはないはず)
      //クリアする。
      Clear;
    end;
  end else begin
    //リストは外部リストではなかった。
    //クリアはする。
    Clear;
  end;
end;

function TMyWStrings.WideToAnsi(sStr: WideString): AnsiString;
begin
  Result := gfnsWideToAnsiEx(sStr);
end;

function TMyWStrings.AnsiToWide(sStr: AnsiString): WideString;
begin
  Result := gfnsAnsiToWideEx(sStr);
end;

function TMyWStrings.Get(iIndex: Integer): WideString;
begin
  if (iIndex >= 0) and (iIndex < F_slList.Count) then begin
    Result := AnsiToWide(F_slList[iIndex]);
  end else begin
    Result := '';
  end;
end;

procedure TMyWStrings.Put(iIndex: Integer; sStr: WideString);
begin
  if (iIndex >= 0) and (iIndex < F_slList.Count) then
  begin
    F_slList[iIndex] := WideToAnsi(sStr);
  end;
end;

procedure TMyWStrings.SetTextStr(sText: WideString);
{2008-06-06,2009-07-15:
2009-07-15:テキストを追加できるように本体の処理をAddTextへ分割移動。
2008-06-06:一度にまとめて変換していたのをインデックスごとに変換するように変更。
           データにもよるだろうけれど、4倍速くなった。
}

begin
  Clear;
  AddText(sText);
end;

procedure TMyWStrings.AddText(sText: WideString);
{2008-06-06,2009-07-15,2010-10-26,2011-06-11,20:

2011-10-06:sTextの最後が改行であったら1行足していた処理を削除。
 s-padでソート機能を実装したら余計な空行ができてしまっていたため。
2011-06-20:↓を改善。
2011-06-11:末尾が改行であった時にSelf.Add('')としたらエラーが出ることが判明。
           暫定でコメントアウト。
2010-10-26:空行の時の処理をF_slList.AddとしていたのをSelf.Addに修正。
2009-07-15:テキストを追加できるように本体の処理をSetTextStrから分割移動。
2008-06-06:一度にまとめて変換していたのをインデックスごとに変換するように変更。
           データにもよるだろうけれど、4倍速くなった。
}

var
  li_Len   : Integer;
  li_Count : Integer;
  lp_Pos   : PWideChar;
  lp_Start : PWideChar;
  lp_Item  : PWideChar;
  lb_Cr    : Boolean;
  lb_Lf    : Boolean;
begin
  lb_Cr := False;
  lb_Lf := False;

  BeginUpdate;
  try
    lp_Pos := PWideChar(sText);
    while (lp_Pos[0] <> #0) do begin
      lp_Start   := lp_Pos;
      li_Len     := 0;

      //1行に必要な文字数を算出
      while (lp_Pos^ <> #0)    //終了文字でなく
        and (lp_Pos^ <> #$D)  //改行でなければ
        and (lp_Pos^ <> #$A)  //同上
      do begin
        Inc(li_Len);
        Inc(lp_Pos);
      end;

      if (li_Len > 0) then begin
        Inc(li_Len);
        lp_Item := AllocMem(li_Len * 2);
        try
          lstrcpynW(lp_Item, lp_Start, li_Len);
          li_Count := Add(WideString(lp_Item));
//myDebug.gpcDebug(Self.Text);
          if (@F_OnAdd <> nil) then begin
            F_OnAdd(Self, li_Count, li_Len);
          end;
        finally
          FreeMem(lp_Item);
        end;
      end else begin
        //2010-10-26:F_slList.Addから変更。
        //myWMPlayerのTMyWMPlaylistで拡張子を制限している場合にF_slList.Addだと引っかからないのでNG
        Self.Add('');
      end;
      if (lp_Pos^ = #$D) then begin
        lb_Cr := True;
        Inc(lp_Pos);
      end;
      if (lp_Pos^ = #$A) then begin
        lb_Lf := True;
        Inc(lp_Pos);
      end;
    end;
  finally
    EndUpdate;
  end;

  if (lb_Cr and not(lb_Lf)) then begin
    //CRのみ
    F_nlNewLine := nlCR;
  end else
  if (not(lb_Cr) and lb_Lf) then begin
    //LFのみ
    F_nlNewLine := nlLF;
  end else begin
    //CRとLFが混在していた場合もCR+LFとみなす。
    F_nlNewLine := nlCRLF;
  end;
end;

procedure TMyWStrings.AddFile(sFile: WideString);
//ファイルから追加
var
  lcd_Code: TMyCharCode;
begin
  lcd_Code := cdAuto;
  AddText(gfnsFileReadText(sFile, lcd_Code));
end;

procedure TMyWStrings.AddFile(slList: TMyWStrings);
var
  i: Integer;
begin
  for i := 0 to slList.Count -1 do begin
    AddFile(slList[i]);
  end;
end;

function TMyWStrings.GetTextStr: WideString;
{
2011-06-20:改行コード付加の条件式を(i < li_Count)としていたのでエラーが出ていたのを修正。
 2011-05-16の修正で起きるようになった致命的なバグ。
2011-05-16:末尾が改行コードでないテキストに改行コードを付加していたのを付加しないように変更。
2009-02-01:SetLength(Result, li_Len+1)としていたため終わりに余計な#0がくっついていたのを修正。
2008-06-06:一度にまとめて変換していたのをインデックスごとに変換するように変更。
}

var
  i          : Integer;
  li_Len     : Integer;
  li_NewLine : Integer;
  li_Count   : Integer;
  lp_Pos     : PWideChar;
  ls_Str     : WideString;
  ls_NewLine : WideString;
begin
  Result := '';

  ls_NewLine := gfnsNewLineGet(F_nlNewLine);
  li_NewLine := Length(ls_NewLine);

  li_Len   := 0;
  li_Count := GetCount;
  for i := 0 to li_Count-1 do begin
    Inc(li_Len, Length(Get(i)) + li_NewLine);  //li_NewLineは改行コードの長さ
  end;
//  Dec(li_Len, li_NewLine); //最後の行の改行分を削除
  SetLength(Result, li_Len);

  lp_Pos := PWideChar(Result);
  for i := 0 to li_Count-1 do begin
    ls_Str := Get(i);
    li_Len := Length(ls_Str);
    if (li_Len <> 0) then begin
      //lstrcpynWは終端のNULL分も含めての文字数を指定するのでli_Lenに+1する
      lstrcpynW(lp_Pos, PWideChar(ls_Str), li_Len +1);
      Inc(lp_Pos, li_Len);
    end;
    //2011-06-20:条件式を(i < li_Count)としていたのでエラーが出ていた
//    if (i < li_Count-1) then begin
      lstrcpyW(lp_Pos, PWideChar(ls_NewLine));
      Inc(lp_Pos, li_NewLine);
//    end;
//    Application.ProcessMessages;
  end;
end;

function TMyWStrings.GetTextStrEx: WideString;
//区切りを改行ではなくF_sDelimiterにしたテキストを返す。
var
  i, li_Len, li_Delimitor: Integer;
  li_Count : Integer;
  lp_Pos   : PWideChar;
  ls_Str   : WideString;
begin
  Result       := '';
  li_Delimitor := Length(F_sDelimiter);
  li_Len       := 0;
  li_Count     := GetCount;
  for i := 0 to li_Count -1 do begin
    Inc(li_Len, Length(Get(i)) + li_Delimitor);  //li_Delimitorは区切り文字の長さ
  end;
  Dec(li_Len, li_Delimitor); //最後の行の区切り分を削除
  SetLength(Result, li_Len);

  lp_Pos := PWideChar(Result);
  for i := 0 to li_Count -1 do begin
    ls_Str := Get(i);
    li_Len := Length(ls_Str);
    if (li_Len <> 0) then begin
      //lstrcpynWは終端のNULL分も含めての文字数を指定するのでli_Lenに+1する
      lstrcpynW(lp_Pos, PWideChar(ls_Str), li_Len +1);
      Inc(lp_Pos, li_Len);
    end;
    if (i < li_Count -1) then begin
      lstrcpynW(lp_Pos, PWideChar(F_sDelimiter), li_Delimitor +1);
      Inc(lp_Pos, li_Delimitor);
    end;
    Application.ProcessMessages;
  end;
end;

procedure TMyWStrings.SetTextStrEx(sText: WideString);
var
  li_Len  : Integer;
  li_Pos  : Integer;
  li_Cr   : Integer;
  lp_Pos  : PWideChar;
  lp_Item : PWideChar;
begin
  BeginUpdate;
  try
    Clear;
    if (sText = '') then Abort;

    li_Cr  := Length(F_sDelimiter);
    li_Len := Length(sText);
    lp_Pos := PWideChar(sText);
    repeat
      li_Pos := Pos(F_sDelimiter, WideString(lp_Pos));
      if (li_Pos > 0) then begin
        lp_Item := AllocMem((li_Pos+1) * 2);
        try
          lstrcpynW(lp_Item, lp_Pos, li_Pos);
          Add(WideString(lp_Item));
        finally
          FreeMem(lp_Item);
        end;
        Inc(lp_Pos, (li_Pos + li_Cr -1));
        Dec(li_Len, (li_Pos + li_Cr -1));
      end else begin
        if (li_Len = 0) then begin
          Add('');
        end else begin
          lp_Item := AllocMem((li_Len+1) * 2);
          try
            lstrcpynW(lp_Item, lp_Pos, li_Len+1);
            Add(WideString(lp_Item));
          finally
            FreeMem(lp_Item);
          end;
//          Add(Copy(WideString(lp_Pos), 1, li_Len));
        end;
        Break;
      end;
      Application.ProcessMessages;
    until (li_Len <= 0);
  finally
    EndUpdate;
  end;
end;

function TMyWStrings.GetCommaText: WideString;
//文字列にスペース、カンマ、引用符がある場合には文字列は二重引用符で囲まれる。
//更に二重引用符には二重引用符が連続して付けらる。
const
  lcs_DELIMITER = ',';
  lcs_QUOTECHAR = '"';
var
  ls_Quote,
  ls_Delim : WideString;
begin
  ls_Quote     := F_sQuoteChar;
  ls_Delim     := F_sDelimiter;
  F_sQuoteChar := '"';
  F_sDelimiter := ',';
  Result       := GetDelimitedText;
  F_sQuoteChar := ls_Quote;
  F_sDelimiter := ls_Delim;
end;

function TMyWStrings.GetDelimitedText: WideString;
const
  lci_CTRLCHAR = Ord(WideChar(' '));
var
  ls_Str,
  ls_Item : WideString;
  i, k,
  li_DPos,
  li_QPos  : Integer;
  lb_Quote : Boolean;
begin
  if (GetCount = 1) and (Get(0) = '') then begin
    Result := F_sQuoteChar + F_sQuoteChar
  end else begin
    for i := 0 to GetCount-1 do begin
      ls_Str := Get(i);

      //制御コードorスペースがあるか
      lb_Quote := False;
      for k := 1 to Length(ls_Str) do begin
        if (Ord(ls_Str[k]) <= lci_CTRLCHAR) then begin
          lb_Quote := True;
      Break;
        end;
      end;

      if not(lb_Quote) then begin
        //区切り(F_sDelimiter)があるか
        li_DPos  := Pos(F_sDelimiter, ls_Str);
        lb_Quote := (li_DPos > 0);
      end;
      //引用符(F_sQuoteChar)があるか
      li_QPos := Pos(F_sQuoteChar, ls_Str);
      if (li_QPos > 0) then begin
        lb_Quote := True;
        ls_Str   := gfnsStrReplace(ls_Str, F_sQuoteChar, F_sQuoteChar + F_sQuoteChar);
      end;

      if (lb_Quote) then begin
        ls_Item := F_sQuoteChar + ls_Str + F_sQuoteChar;
      end else begin
        ls_Item := ls_Str;
      end;

      if (i = 0) then begin
        Result := ls_Item;
      end else begin
        Result := Result + F_sDelimiter + ls_Item;
      end;
    end;
  end;
end;


function TMyWStrings.GetObject(Index: Integer): TObject;
begin
  if (Index < 0) or (GetCount <= Index) then begin
    Result := nil;
  end else begin
    Result := F_slList.Objects[Index];
  end;
end;

procedure TMyWStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if (0 <= Index) and (Index < GetCount) then begin
//Exchangeなどで入れ替える場合にFreeされると困るのでNG
//    if (F_slList.Objects[Index] <> nil) then begin
//NG!      F_slList.Objects[Index].Free;
//    end;
    F_slList.Objects[Index] := AObject;
  end;
end;

function TMyWStrings.GetCount: Integer;
begin
  try
    Result := F_slList.Count;
  except
    //エラーに対応(手抜き)
    Result := 0;
  end;
end;

function TMyWStrings.GetCapacity: Integer;
begin
  Result := F_slList.Capacity;
end;

procedure TMyWStrings.SetCapacity(NewCapacity: Integer);
begin
  F_slList.Capacity := NewCapacity;
end;

procedure TMyWStrings.Clear;
{,2011-07-08:
TMyFileStringsでリストの取得中にオブジェクトにファイル情報を持たせられるようにし
た結果Clearでオブジェクトを解放しないとならないことになったので対応。
ただし勝手に解放されると困ることもあるのでObjectsFreeで明示しないと解放しない。
}

var
  i: Integer;
  l_Object : TObject;
begin

  if (F_bObjectsFree) then begin
    for i := GetCount-1 downto 0 do begin
      l_Object := F_slList.Objects[i];
      if (l_Object <> nil) then begin
        F_slList.Objects[i] := nil;
        l_Object.Free;
      end;
    end;
  end;

  F_slList.Clear;
end;

procedure TMyWStrings.Assign(slList: TStrings);
begin
  if (GetCount > 0) then begin
    Clear;
  end;
  F_slList.Assign(slList);
end;
procedure TMyWStrings.Assign(slList: TMyWStrings);
begin
  if (GetCount > 0) then begin
    Clear;
  end;
  AddStrings(slList);
end;

//一気追加
procedure TMyWStrings.AddStrings(slList: TStrings);
begin
  F_slList.Capacity := F_slList.Count + slList.Count + 100; //ちょっと多めに
  F_slList.AddStrings(slList);
end;

procedure TMyWStrings.AddStrings(slList: TMyWStrings);
var
  i: Integer;
begin
  BeginUpdate;
  try
    F_slList.Capacity := F_slList.Count + slList.Count + 100; //ちょっと多めに
    for i := 0 to slList.Count-1 do begin
      Add(slList[i]);
    end;
  finally
    EndUpdate;
  end;
end;

procedure TMyWStrings.AddStrings(iCount: Integer);
//空白行追加
var
  i: Integer;
begin
  BeginUpdate;
  try
    F_slList.Capacity := F_slList.Count + iCount + 100; //ちょっと多めに
    for i := 1 to iCount do begin
      Add('');
    end;
  finally
    EndUpdate;
  end;
end;


//一気挿入 
procedure TMyWStrings.InsertStrings(iIndex: Integer; slList: TStrings);
var
  i: Integer;
begin
  iIndex := gfniNumLimit(iIndex, 0, GetCount);
  for i := slList.Count - 1 downto 0 do begin
    F_slList.Insert(iIndex, slList[i]);
  end;
end;
procedure TMyWStrings.InsertStrings(iIndex: Integer; slList: TMyWStrings);
var
  i: Integer;
begin
  iIndex := gfniNumLimit(iIndex, 0, GetCount);
  BeginUpdate;
  try
    for i := slList.Count-1 downto 0 do begin
      Insert(iIndex, slList[i]);
    end;
  finally
    EndUpdate;
  end;
end;

function TMyWStrings.Add(sStr: WideString): Integer;
begin
  //TMyFileStringsから呼ばれる関係でAddObjectを呼ばないといけない
  Result := AddObject(sStr, nil);
end;

function TMyWStrings.AddObject(S: WideString; AObject: TObject): Integer;
begin
  InsertObject(GetCount, S, AObject);
  Result := GetCount -1;
end;

function TMyWStrings.AddName(sName, sValue: WideString): Integer;
begin
  Result := Add(WideFormat('%s=%s', [sName, sValue]));
end;

procedure TMyWStrings.Append(sStr: WideString);
//Addより多少効率は良い
begin
  InsertObject(GetCount, sStr, nil);
end;

procedure TMyWStrings.Insert(iIndex: Integer; sStr: WideString);
begin
  InsertObject(iIndex, sStr, nil);
end;

procedure TMyWStrings.InsertObject(Index: Integer; S: WideString; AObject: TObject);
var
  li_Index: Integer;
begin
  //最終的に追加処理はここにくる
  if  (F_bSorted)
  and (F_Duplicates <> dupAccept)
  then
  begin
    if (Find(S, li_Index)) then begin
      if (F_Duplicates = dupError) then begin
        //エラーメッセージを出す。
        //メッセージを出すだけで例外は投げないので注意。
        gpcShowMessage('文字列リストは重複を許しません');
      end;
Exit;
    end;
  end else
  begin
    li_Index := gfniNumLimit(Index, 0, GetCount);  //範囲内に収めてエラーを防ぐ
  end;

  try
    F_slList.InsertObject(li_Index, WideToAnsi(S), AObject);
    if (@FOnChange <> nil) then
    begin
      FOnChange(Self);
    end;
  except
    on EOutOfMemory do
    begin
      gpcShowMessage('データが大きすぎて操作が完了できませんでした');
    end else
    begin
      gpcShowMessage('操作が完了できませんでした');
    end;
  end;
end;

procedure TMyWStrings.Delete(iIndex: Integer);
{,2011-07-08:
TMyFileStringsでリストの取得中にオブジェクトにファイル情報を持たせられるようにし
た結果Deleteでオブジェクトを解放しないとならないことになったので対応。
ただし勝手に解放されると困ることもあるのでObjectsFreeで明示しないと解放しない。
}

var
  l_Object : TObject;
begin
  //範囲チェック
  if (iIndex >= 0) and (iIndex < F_slList.Count) then begin
    if (F_bObjectsFree) then begin
      l_Object := F_slList.Objects[iIndex];
      if (l_Object <> nil) then begin
        F_slList.Objects[iIndex] := nil;
        l_Object.Free;
      end;
    end;
    F_slList.Delete(iIndex);

    if (@FOnChange <> nil) then
    begin
      FOnChange(Self);
    end;
  end;
end;

function TMyWStrings.Find(sStr: WideString; var iIndex: Integer): Boolean;
var
  i, li_Cmp: Integer;
begin
  Result := False;
  iIndex := -1;
  for i := 0 to GetCount-1 do begin
    if (F_bCaseSensitive) then begin
      //大文字小文字の区別あり
      li_Cmp := WideCompareStr(Get(i), sStr);
    end else begin
      //大文字小文字の区別無し
      li_Cmp := WideCompareText(Get(i), sStr);
    end;

    if (li_Cmp = 0) then begin
      Result := True;
      iIndex := i;
Exit;
    end else if (li_Cmp > 0) then begin
      iIndex := i;
Exit;
    end;
  end;
end;

function TMyWStrings.IndexOf(sStr: WideString): Integer;
begin
  Result := Self.IndexOf(sStr, 0);
end;
function TMyWStrings.IndexOf(sStr: WideString; iIndex: Integer): Integer;
//IndexOfの開始インデックス指定版
begin
  if (iIndex < 0) then iIndex := 0;
  for Result := iIndex to F_slList.Count - 1 do begin
    if (F_bCaseSensitive) then begin
      //大文字小文字の区別あり
      if (WideCompareStr(Get(Result), sStr) = 0) then Exit;
    end else begin
      //大文字小文字の区別無し
      if (WideCompareText(Get(Result), sStr) = 0) then Exit;
    end;
  end;
  Result := -1;
end;

function TMyWStrings.InStringOf(sStr: WideString): Integer;
//sStrを含む最初の行を返す。
begin
  Result := InStringOf(sStr, 0);
end;

function TMyWStrings.InStringOf(sStr: WideString; iIndex: Integer): Integer;
//iIndex行以降でsStrを含む最初の行を返す。
begin
  if (iIndex < 0) then iIndex := 0;
  if not(F_bCaseSensitive) then sStr := WideUpperCase(sStr);
  for Result := iIndex to GetCount -1 do begin
    if (F_bCaseSensitive) then begin
      //大文字小文字の区別あり
      if (Pos(sStr, Get(Result)) > 0) then Exit;
    end else begin
      //大文字小文字の区別無し
      if (Pos(sStr, WideUpperCase(Get(Result))) > 0) then Exit;
    end;
  end;
  Result := -1;
end;

function TMyWStrings.InHeadStringOf(sStr: WideString): Integer;
//sStrが行頭に現れる最初の行を返す。
begin
  Result := InHeadStringOf(sStr, 0);
end;
function TMyWStrings.InHeadStringOf(sStr: WideString; iIndex: Integer): Integer;
//iIndex行以降でsStrが行頭に現れる最初の行を返す。
begin
  if (iIndex < 0) then iIndex := 0;
  if not(F_bCaseSensitive) then sStr := WideUpperCase(sStr);
  for Result := iIndex to GetCount -1 do begin
    if (F_bCaseSensitive) then begin
      //大文字小文字の区別あり
      if (Pos(sStr, Get(Result)) = 1) then Exit;
    end else begin
      //大文字小文字の区別無し
      if (Pos(sStr, WideUpperCase(Get(Result))) = 1) then Exit;
    end;
  end;
  Result := -1;
end;

function TMyWStrings.IndexOfName(sName: WideString): Integer;
begin
  Result := Self.IndexOfName(sName, 0);
end;
function TMyWStrings.IndexOfName(sName: WideString; iIndex: Integer): Integer;
var
  ls_Name: WideString;
begin
  if (iIndex < 0) then iIndex := 0;
  for Result := iIndex to F_slList.Count - 1 do begin
    ls_Name := F_GetName(Result);
{
    if (F_bCaseSensitive) then begin
      if (WideCompareStr(sName, ls_Name) = 0) then begin
Exit;
      end;
    end else begin
      if (WideCompareText(sName, ls_Name) = 0) then begin
Exit;
      end;
    end;
}

    if (WideCompareText(sName, ls_Name) = 0) then begin
Exit;
    end;
  end;
  Result := -1;
end;

function TMyWStrings.F_GetName(iIndex: Integer): WideString;
begin
  Result := gfnsIniNameGet(F_slList[iIndex]);
end;

function TMyWStrings.F_GetValue(sName: WideString): WideString;
var
  li_Index: Integer;
begin
  li_Index := IndexOfName(sName);
  if (li_Index >= 0) then begin
    Result := gfnsIniValueGet(F_slList[li_Index]);
  end else begin
    Result := '';
  end;
end;

procedure TMyWStrings.F_SetValue(sName, sValue: WideString);
{
TStringsのSetValueと違いsValueに空文字を許す。
つまり'Name='の行の存在を許すということ。
}

var
  li_Index: Integer;
  ls_Item: WideString;
begin
  li_Index := IndexOfName(sName);
  ls_Item  := WideFormat('%s=%s', [Trim(sName), sValue]);
  if (li_Index >= 0) then begin
    Put(li_Index, ls_Item);
  end else begin
    Add(ls_Item);
  end;
end;


//AnsiString
function TMyWStrings.F_GetAnsiStrings: TStrings;
var
  i: Integer;
begin
  F_slOut.Clear;
  for i := 0 to GetCount -1 do begin
    F_slOut.Add(gfnsWideToAnsi(Get(i)));
  end;
  Result := F_slOut;
end;
//UTF7
function TMyWStrings.F_GetUtf7Strings: TStrings;
var
  i: Integer;
begin
  F_slOut.Clear;
  for i := 0 to GetCount -1 do begin
    F_slOut.Add(gfnsWideToUtf7(Get(i)));
  end;
  Result := F_slOut;
end;
//UTF8
function TMyWStrings.F_GetUtf8Strings: TStrings;
var
  i: Integer;
begin
  F_slOut.Clear;
  for i := 0 to GetCount -1 do begin
//    F_slOut.Add(gfnsWideToUtf8(Get(i)));
    F_slOut.Add(Utf8Encode(Get(i)));
  end;
  Result := F_slOut;
end;
//独自関数。
function TMyWStrings.F_GetWideToAnsiExStrings: TStrings;
var
  i: Integer;
begin
  F_slOut.Clear;
  for i := 0 to GetCount -1 do begin
    F_slOut.Add(gfnsWideToAnsiEx(Get(i)));
  end;
  Result := F_slOut;
end;

function TMyWStrings.Equals(slList: TMyWStrings): Boolean;
{2008-06-01:
F_slListとslListの内容が同じならTrueを返す。
大文字と小文字の区別はCaseSensitiveの値による。
}

var
  li_Comp, i: Integer;
begin
  if (F_slList.Count <> slList.Count) then begin
    Result := False;
  end else begin
    Result := True;
    for i := 0 to F_slList.Count - 1 do begin
      if (F_bCaseSensitive) then begin
        li_Comp := WideCompareStr(Get(i), slList[i]);
      end else begin
        li_Comp := WideCompareText(Get(i), slList[i]);
      end;
      if (li_Comp <> 0) then begin
        Result := False;
        Break;
      end;
    end;
  end;
end;

procedure TMyWStrings.Exchange(iIndex1, iIndex2: Integer);
begin
  F_slList.Exchange(iIndex1, iIndex2);

  if (@FOnChange <> nil) then
  begin
    FOnChange(Self);
  end;
end;

procedure TMyWStrings.Move(iCurrentIndex, iNewIndex: Integer);
begin
  F_slList.Move(iCurrentIndex, iNewIndex);

  if (@FOnChange <> nil) then
  begin
    FOnChange(Self);
  end;
end;

procedure TMyWStrings.Reverse;
//リストの並びを反転
var
  i: Integer;
//  lsl_List: TStrings;
begin
  if (GetCount = 0) then begin
Exit;
  end;
 
  for i := 0 to Trunc((F_slList.Count - 1) / 2) do begin
    Exchange(i, F_slList.Count - 1 - i);
  end;
{
  //Exchageを使うよりもTStringListを使ったほうが速い。
  //が、Exchangeを使う方が下位クラスで都合が良い。
  //具体的にはmyWMPlayer.pasのTMyCustomWMPListなど。
  lsl_List := TStringList.Create;
  try
    for i := GetCount -1 downto 0 do begin
      lsl_List.Add(F_slList[i]);
    end;
    Assign(lsl_List);
  finally
    lsl_List.Free;
  end;
}

end;

procedure TMyWStrings.SortDupDelete;
//ソート済みリストの重複削除
//ソート済みでないと意味がない
var
  i, li_Comp: Integer;
begin
  for i := F_slList.Count-1 downto 1 do
  begin  //downto 0 ではないことに注意
    if (F_bCaseSensitive) then
    begin
      li_Comp := WideCompareStr (Get(i), Get(i-1));
    end else
    begin
      li_Comp := WideCompareText(Get(i), Get(i-1));
    end;

    if (li_Comp = 0) then
    begin
      F_slList.Delete(i);
    end;
  end;
end;

//------------------------------------------------------------------------------
//ソート
function lfni_SortFunc(slList: TMyWStrings; iIndex1, iIndex2: Integer): Integer;
begin
  if (slList.CaseSensitive) then
  begin
    //大文字と小文字を区別する
    Result := WideCompareStr(slList[iIndex1], slList[iIndex2]);
  end else
  begin
    //大文字と小文字を区別しない
    Result := WideCompareText(slList[iIndex1], slList[iIndex2]);
  end;
end;

procedure TMyWStrings.Sort;
begin
  CustomSort(lfni_SortFunc);
end;

procedure TMyWStrings.CustomSort(fniCompare: TMyWStringsSortCompare);
//カスタムソート
begin
//2011-03-31:クイックソートからマージソートへ変更。
//  QuickSort(fniCompare);
  MergeSort(fniCompare);
end;

//クイックソート
procedure TMyWStrings.QuickSort(fniCompare: TMyWStringsSortCompare);
begin
//  QuickSort(fniCompare, (Sorted and (Duplicates = dupIgnore));
  QuickSort(fniCompare, False);
end;

procedure TMyWStrings.QuickSort(fniCompare: TMyWStringsSortCompare; bUnique: Boolean);
{2008-04-14,06-03:
QuickSort
TStringListのQuickSortをコピー
2008-06-03:リストが1つ以下の時処理を行わないように変更。
}

  procedure lpc_QSort(slList: TMyWStrings; L, R: Integer; SCompare: TMyWStringsSortCompare);
  var
    I, J, P: Integer;
  begin
    repeat
      I := L;
      J := R;
      P := (L + R) shr 1;
      repeat
        while (SCompare(slList, I, P) < 0) do Inc(I);
        while (SCompare(slList, J, P) > 0) do Dec(J);
        if (I <= J) then begin
          slList.Exchange(I, J);
          if (P = I) then begin
            P := J
          end else if (P = J) then begin
            P := I;
          end;
          Inc(I);
          Dec(J);
        end;
        Application.ProcessMessages;
      until (I > J);
      if L < J then lpc_QSort(slList, L, J, SCompare);
      L := I;
    until (I >= R);
  end;
begin
  if (F_slList.Count >= 2) then begin
    F_slList.BeginUpdate;
    try
      lpc_QSort(Self, 0, F_slList.Count - 1, fniCompare);
    finally
      F_slList.EndUpdate;
    end;
  end;
  //重複削除
  if (bUnique) then begin
    SortDupDelete;
  end;
end;

//マージソート
procedure TMyWStrings.MergeSort(fniCompare: TMyWStringsSortCompare; bUnique: Boolean);
begin
  F_slList.BeginUpdate;
  try
    MergeSort(fniCompare);
    //重複削除
    if (bUnique) then begin
      SortDupDelete;
    end;
  finally
    F_slList.EndUpdate;
  end;
end;

(*
procedure TMyWStrings.MergeSort(fniCompare: TMyWStringsSortCompare);
  procedure lpc_MergeSort(slList: TMyWStrings; iIndex, iCount: Integer; fniCompare: TMyWStringsSortCompare); overload;
  //iIndexはソートを開始するインデックス行。
  //iCountはソートするリストの数。
  var
    i, k: Integer;
    li_Index1, li_Index2, li_Count1, li_Count2: Integer;
    lsl_Buff: TMyWStrings;
  begin
    if (iCount <= 1) then Exit;

    li_Count1 := iCount div 2;       //前半のリストの数
    li_Count2 := iCount - li_Count1; //後半のリストの数
    li_Index1 := iIndex;             //前半のリストの頭のインデックス
    li_Index2 := iIndex + li_Count1; //後半のリストの頭のインデックス

    lpc_MergeSort(slList, li_Index1, li_Count1, fniCompare); //前半をソート
    lpc_MergeSort(slList, li_Index2, li_Count2, fniCompare); //後半をソート

    //ソートされた前半と後半をマージ
    i := 0;
    k := 0;
    lsl_Buff := TMyWStrings.Create;
    try
      while (i < li_Count1) and (k < li_Count2) do begin
        //↓の比較関数を書き換えるだけで色々応用がきく
        if (fniCompare(slList, li_Index1 + i, li_Index2 + k) > 0) then begin
          lsl_Buff.AddObject(slList[li_Index2 + k], slList.Objects[li_Index2 + k]);
          Inc(k);
        end else begin
          lsl_Buff.AddObject(slList[li_Index1 + i], slList.Objects[li_Index1 + i]);
          Inc(i);
        end;
      end;

      if (i = li_Count1) then begin
        while (k < li_Count2) do begin
          lsl_Buff.AddObject(slList[li_Index2 + k], slList.Objects[li_Index2 + k]);
          Inc(k);
        end
      end else begin
        while (i < li_Count1) do begin
          lsl_Buff.AddObject(slList[li_Index1 + i], slList.Objects[li_Index1 + i]);
          Inc(i);
        end;
      end;

      for i := 0 to iCount -1 do begin
        slList[iIndex + i] := lsl_Buff[i];
        slList.Objects[iIndex + i] := lsl_Buff.Objects[i];
      end;
    finally
      lsl_Buff.Free;
    end;
  end;
begin
  if (F_slList.Count >= 2) then begin
    F_slList.BeginUpdate;
    try
      lpc_MergeSort(Self, 0, F_slList.Count, fniCompare);
    finally
      F_slList.EndUpdate;
    end;
  end;
end;
*)

procedure TMyWStrings.MergeSort(iStart, iEnd : Integer; fniCompare: TMyWStringsSortCompare);
//インデックスの配列を使った更にもうちょっとだけ速いマージソートの部分ソート対応版。
//iStartとiEndは部分ソートの0ベースの開始インデックスと終了インデックス。
  procedure lpc_MergeSort(AList: TMyWStrings; var Index: array of Integer; fniCompare: TMyWStringsSortCompare);
  //http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/merge-sort.html
  var
    i, k: Integer;
    li_Count, li_Count1, li_Count2: Integer;
    l_Index1, l_Index2: array of Integer;
  begin
    Inc(F_iSortDepth);
    F_sProgressMsg := WideFormat('リストのソート中 [%d]', [F_iSortDepth]);

    li_Count := Length(Index);
    if (li_Count > 1) then begin
      li_Count1 := li_Count div 2;
      li_Count2 := li_Count - li_Count1;
      SetLength(l_Index1, li_Count1);     //前半のインデックス
      SetLength(l_Index2, li_Count2);     //後半のインデックス
      for i := 0 to li_Count1-1 do begin  //前半のインデックスをコピー
        l_Index1[i] := Index[i];
      end;
      for i := 0 to li_Count2-1 do begin  //後半のインデックスをコピー
        l_Index2[i] := Index[li_Count1+i];
      end;

      lpc_MergeSort(AList, l_Index1, fniCompare); //この中で順番が変わっている
      lpc_MergeSort(AList, l_Index2, fniCompare); //この中で順番が変わっている

      i := 0;
      k := 0;
      while (i < li_Count1) or (k < li_Count2) do begin
        if (i >= li_Count1)
        or ((k < li_Count2) and (fniCompare(AList, l_Index1[i], l_Index2[k]) > 0)) then begin
          Index[i+k] := l_Index2[k];
          Inc(k);
        end else begin
          Index[i+k] := l_Index1[i];
          Inc(i);
        end;
      end;
    end;
  end;
var
  i        : Integer;
  l_Index  : array of Integer;
  lsl_List : TMyWStrings;
begin
  SetLength(l_Index, iEnd - iStart +1);
  for i := 0 to High(l_Index) do begin
    l_Index[i] := iStart +i;
  end;

  F_sProgressMsg := '';

  F_iSortDepth := 0;
//  FbSortTurn  := False;
  //この中で並べ替えられるのはリスト本体ではなくインデックスのリスト(l_Index)の方
  lpc_MergeSort(Self, l_Index, fniCompare);

  lsl_List := TMyWStrings.Create;
  try
{
    //iStartまでをコピー
    for i := 0 to iStart -1 do begin
      lsl_List.AddObject(Self.Strings[i], Self.Objects[i]);
    end;

    for i := 0 to High(l_Index) do begin
      //並べ替えられたインデックスを基にバッファへリストを書き出す
      lsl_List.AddObject(Self.Strings[l_Index[i]], Self.Objects[l_Index[i]]);
    end;

    //iEndからをコピー
    for i := iEnd +1 to GetCount -1 do begin
      lsl_List.AddObject(Self.Strings[i], Self.Objects[i]);
    end;

    //バッファに書き出した整列済みのリストを書き戻す
    Self.Assign(lsl_List);
}

    for i := 0 to High(l_Index) do begin
      //並べ替えられたインデックスを基にバッファへリストを書き出す
      lsl_List.AddObject(Self.Strings[l_Index[i]], Self.Objects[l_Index[i]]);
    end;
    //バッファに書き出した整列済みのリストを書き戻す
    for i := 0 to High(l_Index) do begin
      Self.Strings[i + iStart] := lsl_List.Strings[i];
      Self.Objects[i + iStart] := lsl_List.Objects[i];
    end;
  finally
    lsl_List.Free;
  end;
end;

procedure TMyWStrings.MergeSort(iStart, iEnd : Integer);
begin
  MergeSort(iStart, iEnd, lfni_SortFunc);
end;

procedure TMyWStrings.MergeSort(fniCompare: TMyWStringsSortCompare);
//インデックスの配列を使った更にもうちょっとだけ速いマージソート
{
  procedure lpc_MergeSort(AList: TMyWStrings; var Index: array of Integer; fniCompare: TMyWStringsSortCompare);
  //http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/merge-sort.html
  var
    i, k: Integer;
    li_Count, li_Count1, li_Count2: Integer;
    l_Index1, l_Index2: array of Integer;
  begin
    li_Count := Length(Index);
    if (li_Count > 1) then begin
      li_Count1 := li_Count div 2;
      li_Count2 := li_Count - li_Count1;
      SetLength(l_Index1, li_Count1);     //前半のインデックス
      SetLength(l_Index2, li_Count2);     //後半のインデックス
      for i := 0 to li_Count1-1 do begin  //前半のインデックスをコピー
        l_Index1[i] := Index[i];
      end;
      for i := 0 to li_Count2-1 do begin  //後半のインデックスをコピー
        l_Index2[i] := Index[li_Count1+i];
      end;

      lpc_MergeSort(AList, l_Index1, fniCompare); //この中で順番が変わっている
      lpc_MergeSort(AList, l_Index2, fniCompare); //この中で順番が変わっている

      i := 0;
      k := 0;
      while (i < li_Count1) or (k < li_Count2) do begin
        if (i >= li_Count1)
        or ((k < li_Count2) and (fniCompare(AList, l_Index1[i], l_Index2[k]) > 0)) then begin
          Index[i+k] := l_Index2[k];
          Inc(k);
        end else begin
          Index[i+k] := l_Index1[i];
          Inc(i);
        end;
      end;
    end;
  end;
var
  i        : Integer;
  l_Index  : array of Integer;
  lsl_List : TMyWStrings;
}

begin
  MergeSort(0, GetCount-1, fniCompare);
{
Exit;

  SetLength(l_Index, Self.GetCount);
  for i := 0 to High(l_Index) do begin
    l_Index[i] := i;
  end;

  //この中で並べ替えられるのはリスト本体ではなくインデックスのリスト(l_Index)の方
  lpc_MergeSort(Self, l_Index, fniCompare);

  lsl_List := TMyWStrings.Create;
  try
    for i := 0 to High(l_Index) do begin
      //並べ替えられたインデックスを基にバッファへリストを書き出す
      lsl_List.AddObject(Self.Strings[l_Index[i]], Self.Objects[l_Index[i]]);
    end;
    //バッファに書き出した整列済みのリストを書き戻す
    Self.Assign(lsl_List);
  finally
    lsl_List.Free;
  end;
}

end;
procedure TMyWStrings.MergeSort;
begin
  MergeSort(0, GetCount-1, lfni_SortFunc);
end;


//挿入ソート
procedure TMyWStrings.InsertionSort(const bUnique: Boolean);
begin
  InsertionSort(lfni_SortFunc, bUnique);
end;
procedure TMyWStrings.InsertionSort(fniCompare: TMyWStringsSortCompare);
{2008-06-01:
}

begin
//  InsertionSort(fniCompare, (Sorted and (Duplicates = dupIgnore));
  InsertionSort(fniCompare, False);
end;
procedure TMyWStrings.InsertionSort(fniCompare: TMyWStringsSortCompare; const bUnique: Boolean);
{2008-02-12,06-01:
挿入ソート
http://ja.wikipedia.org/wiki/挿入ソート
bUniqueがTrueなら同じデータを許可しない(重複行は削除)
以外に速い…
ほぼ整列されているリストならクイックソートより速い

2008-06-01:TMyWStrings用に一部書き換え
}

var
  i, k, li_Comp: Integer;
begin
  //一個っきゃデータがない時はソートする必要はないので2以上
  if (F_slList.Count >= 2) then begin
    F_slList.BeginUpdate;
    try
      i := 1;
      repeat
        for k := i downto 1 do begin
          //前の行と比べている
          li_Comp := fniCompare(Self, k-1, k);
          if (li_Comp < 0) then begin
            //前の方が小さい→ループを一段抜ける
            Break;
          end else if (li_Comp > 0) then begin
            //前の方が大きい→入れ替え
            Exchange(k-1, k);
          end else if (bUnique) then begin
            //同じ→同じデータを許さないなら削除
            Delete(k);
            Dec(i);
            Break;
          end;
          Application.ProcessMessages;
        end;
        Inc(i);
      until (i > F_slList.Count-1);
    finally
      F_slList.EndUpdate;
    end;
  end;
end;

function _fniSortFuncFileList(slList: TMyWStrings; iIndex1, iIndex2: Integer): Integer;
{2007-09-18:
CustomSort用下請け関数
http://www.geocities.jp/fjtkt/program/2004_0001.html
ファイルのリストを取得してTStringListのSortを行うとファイルとサブフォルダが混在し
てしまうのでサブディレクトリは後ろにまとめてソートしたい場合にこの関数をCustomSort
に渡して使う
例)
//-------------
Stay In Loveサブディレクトリがファイルの途中にきてしまう
e:\mp3\MySharona.mp3
e:\mp3\StayInLove\CouldItBeI'mInLove.mp3
e:\mp3\TakeAChanceOnMe.mp3
          ↓
e:\mp3\MySharona.mp3
e:\mp3\TakeAChanceOnMe.mp3
e:\mp3\StayInLove\CouldItBeI'mInLove.mp3
//-------------
サブディレクトリを頭にもっていくのは面倒なので後ろへ
}

begin
  Result := gfniCompareFileName(slList[iIndex1], slList[iIndex2]);
end;


procedure TMyWStrings.FileSort;
begin
//  FileSort(Sorted and (Duplicates = dupIgnore));
  FileSort(False);
end;
procedure TMyWStrings.FileSort(bUnique: Boolean);
//重複削除オプションあり
begin
  MergeSort(_fniSortFuncFileList, True);
//  QuickSort(_fniSortFuncFileList);
//  if (bUnique) then begin
//    SortDupDelete;
//  end;
end;

procedure TMyWStrings.FileSort(iStart, iEnd : Integer);
begin
  MergeSort(iStart, iEnd, _fniSortFuncFileList);
end;


procedure TMyWStrings.FileInsertionSort;
//挿入ソート
begin
  InsertionSort(_fniSortFuncFileList, False);
end;
procedure TMyWStrings.FileInsertionSort(bUnique: Boolean);
//挿入ソート・重複削除オプションあり
begin
  InsertionSort(_fniSortFuncFileList, bUnique);
end;

procedure TMyWStrings.F_SetSorted(bValue: Boolean);
begin
  F_bSorted := bValue;
  if (F_bSorted) then begin
    MergeSort;
    if (Duplicates <> dupAccept) then begin
      //重複行を許可しないならば重複を削除
      SortDupDelete;
    end;
  end;
end;


//LoadFromFile SaveToFile ------------------------------------------------------
procedure TMyWStrings.LoadFromFile(sFile: WideString);
{2008-06-01:
}

begin
//  F_cdCharCode := cdAuto;
  LoadFromFile(sFile, F_cdCharCode);
end;

procedure TMyWStrings.LoadFromFile(sFile: WideString; var cdCode: TMyCharCode);
var
  ls_Text: WideString;
begin
  ls_Text := gfnsFileReadText(sFile, cdCode);
  SetTextStr(ls_Text);
end;

procedure TMyWStrings.LoadFromFile(sFile: WideString; var cdCode: TMyCharCode; iByte: DWORD);
begin
  SetTextStr(gfnsFileReadText(sFile, cdCode, iByte));
end;

function TMyWStrings.SaveToFile(sFile: WideString): Boolean;
//デフォルトはUnicode文字があればUTF-8、なければShift_JIS
begin
//  SaveToFile(sFile, cdAuto);
  Result := SaveToFile(sFile, F_cdCharCode);
end;

function TMyWStrings.SaveToFile(sFile: WideString; cdCode: TMyCharCode; nlNewLine: TMyNewLine): Boolean;
begin
  F_nlNewLine := nlNewLine;
  Result := SaveToFile(sFile, cdCode);
end;

function TMyWStrings.SaveToFile(sFile: WideString; cdCode: TMyCharCode): Boolean;
begin
  Result := gfnbFileWriteText(sFile, GetTextStr, cdCode);
end;

procedure TMyWStrings.BeginUpdate;
begin
  F_slList.BeginUpdate;
end;

procedure TMyWStrings.EndUpdate;
begin
  F_slList.EndUpdate;
end;


//------------------------------------------------------------------------------
{TMyWStringList}
function TMyWStringList.WideToAnsi(sStr: WideString): AnsiString;
begin
  Result := gfnsWideToUtf7(sStr);
end;

function TMyWStringList.AnsiToWide(sStr: AnsiString): WideString;
begin
  Result := gfnsUtf7ToWide(sStr);
end;


//------------------------------------------------------------------------------
{TMyUStringList}
function TMyUStringList.WideToAnsi(sStr: WideString): AnsiString;
var
  li_Len: Integer;
begin
  li_Len := Length(sStr) + 1;
  SetLength(Result, li_Len * 2);
  lstrcpynw(PWideChar(PAnsiChar(Result)), PWideChar(sStr), li_Len);
end;

function TMyUStringList.AnsiToWide(sStr: AnsiString): WideString;
var
  lp_Src:  PAnsiChar;
  lp_Wide: PWideChar absolute lp_Src;
begin
  lp_Src := PAnsiChar(sStr);
  Result := WideString(lp_Wide);
end;


end.