全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1326
推到 Plurk!
推到 Facebook!

Unicode 檔名搜尋+可開啟 Unicode 檔名的 FileStream

 
ttol
一般會員


發表:1
回覆:3
積分:0
註冊:2004-05-04

發送簡訊給我
#1 引用回覆 回覆 發表時間:2004-08-08 15:38:11 IP:211.76.xxx.xxx 未訂閱
Unicode 檔名搜尋 + 可開啟 Unicode 檔名的 FileStream    檔名搜尋於 Win 98,ME 會自動切換為 Ansi 檔名搜尋 使用方法同 TSearchRec,FindFirst,FindNext,FindClose    MyFileStream 先試著以 AnsiString 檔名開啟, 無法開啟時, 則改用 WideSting 檔名開啟 使用方法同 TFileStream    有問題歡迎提出討論    
unit UnitSystem;
interface
uses  Windows, Classes,SysUtils,StrUtils,Types;
type
 SetSearchType = set of (SearchByAnsi,SearchByWide);      TMySearchRec = record
    SearchType:SetSearchType;
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: WideString;
    ExcludeAttr: Integer;
    FindHandle: THandle  platform;
    FindDataA: TWin32FindData  platform;
    FindDataW: TWin32FindDataW  platform;
  end;    procedure MyFindClose(var F: TMySearchRec);
function MyFindNext(var F: TMySearchRec): Integer;
function MyFindFirst(const Path: WideString; Attr: Integer;var  F: TMySearchRec): Integer;
function MyFindMatchingFile(var F: TMySearchRec): Integer;    type TMyFileStream = Class(TFileStream)
    Public
    constructor Create(const FileName: WideString; Mode: Word); overload;
end;    function FileOpenW(const FileName: WideString; Mode: LongWord): Integer;
////////////////////////////////////////////////////////////////////////////////////    implementation    uses RTLConsts;    //////////////////////////////////////////////////////////////////////
// Unicode FileName Search
function MyFindMatchingFile(var F: TMySearchRec): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    if SearchType=[SearchByAnsi] then
    begin
        while FindDataA.dwFileAttributes and ExcludeAttr <> 0 do
          if not FindNextFile(FindHandle, FindDataA) then
          begin
            Result := GetLastError;
            Exit;
          end;
        FileTimeToLocalFileTime(FindDataA.ftLastWriteTime, LocalFileTime);
        FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,LongRec(Time).Lo);
        Size := FindDataA.nFileSizeLow;
        Attr := FindDataA.dwFileAttributes;
        Name := FindDataA.cFileName;
    end else begin
        while FindDataW.dwFileAttributes and ExcludeAttr <> 0 do
          if not FindNextFileW(FindHandle, FindDataW) then
          begin
            Result := GetLastError;
            Exit;
          end;
        FileTimeToLocalFileTime(FindDataW.ftLastWriteTime, LocalFileTime);
        FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,LongRec(Time).Lo);
        Size := FindDataW.nFileSizeLow;
        Attr := FindDataW.dwFileAttributes;
        Name := FindDataW.cFileName;
    end;
  end;
  Result := 0;
end;    function MyFindFirst(const Path: WideString; Attr: Integer;
  var  F: TMySearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
    F.SearchType := [SearchByWide];
    F.ExcludeAttr := not Attr and faSpecial;
    F.FindHandle := FindFirstFileW(PWChar(Path), F.FindDataW);
    if F.FindHandle <> INVALID_HANDLE_VALUE then
    begin
        Result := MyFindMatchingFile(F);
        if Result <> 0 then MyFindClose(F);
    end else begin
        F.SearchType := [SearchByAnsi];
        F.ExcludeAttr := not Attr and faSpecial;
        F.FindHandle := FindFirstFile(PChar(String(Path)), F.FindDataA);
        if F.FindHandle <> INVALID_HANDLE_VALUE then
        begin
            Result := MyFindMatchingFile(F);
            if Result <> 0 then MyFindClose(F);
        end else begin
            Result := GetLastError;
        end;
    end;    end;    function MyFindNext(var F: TMySearchRec): Integer;
begin
  if F.SearchType = [SearchByAnsi] then
  begin
    if FindNextFile(F.FindHandle, F.FindDataA) then
    Result := MyFindMatchingFile(F) else
    Result := GetLastError;
  end else begin
      if FindNextFileW(F.FindHandle, F.FindDataW) then
        Result := MyFindMatchingFile(F) else
        Result := GetLastError;
  end;
end;    procedure MyFindClose(var F: TMySearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;
////////////////////////////////////////
// my FileStream
constructor TMyFileStream.Create(const FileName: WideString; Mode: Word);
var fh:Integer;
begin
  if Mode = fmCreate then
  begin
    fh:=CreateFile(PChar(String(FileName)), GENERIC_READ or GENERIC_WRITE,
            0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    if fh<0 then
    begin
        fh:=CreateFileW(PWChar(FileName), GENERIC_READ or GENERIC_WRITE,
            0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    end;        inherited Create(fh);
    if FHandle < 0 then
      raise EFCreateError.CreateResFmt(@SFCreateError, [FileName]);
  end
  else
  begin
    fh:=FileOpen(FileName, Mode);
    if fh<0 then
    begin
        fh:=FileOpenW(FileName, Mode);
    end;
    inherited Create(fh);
    if FHandle < 0 then
      raise EFOpenError.CreateResFmt(@SFOpenError, [FileName]);
  end;    end;    function FileOpenW(const FileName: WideString; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := -1;
  if ((Mode and 3) <= fmOpenReadWrite) and
    (((Mode and $F0) shr 4) <= fmShareDenyNone) then
    Result := Integer(CreateFileW(PWChar(FileName), AccessMode[Mode and 3],
      ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;
系統時間:2024-07-01 21:02:42
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!