Unicode 檔名搜尋+可開啟 Unicode 檔名的 FileStream |
|
ttol
一般會員 ![]() ![]() 發表:1 回覆:3 積分:0 註冊:2004-05-04 發送簡訊給我 |
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; |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |