檔案內容中摘要的所有內容 |
缺席
|
adonis
高階會員 發表:140 回覆:258 積分:159 註冊:2002-04-15 發送簡訊給我 |
|
Mickey
版主 發表:77 回覆:1882 積分:1390 註冊:2002-12-11 發送簡訊給我 |
參考看看:
unit FileVersion; interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, Math; type { define a generic exception class for version info, and an exception to indicate that no version info is available. } EVerInfoError = class(Exception); ENoVerInfoError = class(Exception); eNoFixeVerInfo = class(Exception); //define enum type representing different types of version info TVerInfoType = (viCompanyName, viFileDescription, viFileVersion, viInternalName, viLegalCopyright, viLegalTrademarks, viOriginalFilename, viProductName, viProductVersion, viComments); const //define an array constant of strings representing the pre-defined version information keys VerNameArray: array[viCompanyName..viComments] of string[20] = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTrademarks', 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments'); type //Define the version info class TVerInfoRes = class(TComponent) private Handle : DWord; Size : Integer; RezBuffer : string; TransTable : PLongint; FixedFileInfoBuf : PVSFixedFileInfo; FFileFlags : TstringList; FFileName : string; procedure FillFixedFileInfoBuf; procedure FillFileVersionInfo; procedure FillFileMaskInfo; procedure SetFileName(aFileName:string); protected function GetFileVersion : string; function GetProductVersion: string; function GetFileOS : string; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; function GetPreDefKeystring(aVerKind: TVerInfoType): string; function GetUserDefKeystring(aKey: string): string; procedure ShowExample(l:Tstrings; sFileName: string);//可做為Example property FileName : string read FFileName write SetFileName; property FileVersion : string read GetFileVersion; property ProductVersion : string read GetProductVersion; property FileFlags : TstringList read FFileFlags; property FileOS : string read GetFileOS; end; const //strings that must be fed to VerQueryValue() function SFInfo = '\StringFileInfo\'; VerTranslation: PChar = '\VarFileInfo\Translation'; vFormatStr = '%s%.4x%.4x\%s%s'; var gPrjVerInfo : TVerInfoRes; function PrjVerInfo: TVerInfoRes; procedure SetFrmCaption(AForm:TForm); function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = True): string; implementation function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = True): string; var LPos: integer; begin LPos := Pos(ADelim, AInput); if LPos = 0 then begin Result := AInput; if ADelete then begin AInput := ''; {Do not Localize} end; end else begin Result := Copy(AInput, 1, LPos - 1); if ADelete then begin //slower Delete(AInput, 1, LPos Length(ADelim) - 1); AInput := Copy(AInput, LPos Length(ADelim), MaxInt); end; end; end; function CompareVersion(const Version1, Version2: string):integer; var v1,v2 : string; d1,d2 : word; begin v1 := Version1; v2 := Version2; repeat d1:=StrToIntDef(Fetch(v1,'.'),0); d2:=StrToIntDef(Fetch(v2,'.'),0); Result := CompareValue(d1,d2); until (Result<>0) or ((v1='') and (v2='')); end; procedure SetFrmCaption(AForm:TForm); begin AForm.Caption :=Format('%s - V%s',[AForm.Caption,PrjVerInfo.GetFileVersion]) ; end; function PrjVerInfo: TVerInfoRes; begin if gPrjVerInfo=nil then gPrjVerInfo := TVerInfoRes.Create(Application); gPrjVerInfo.FileName := paramstr(0); Result := gPrjVerInfo; end; {TVerInfoRes} constructor TVerInfoRes.Create(AOwner : TComponent); begin inherited Create(AOwner); FFileFlags := TstringList.Create; end; destructor TVerInfoRes.Destroy; begin FFileFlags.Free; inherited destroy; end; procedure TVerInfoRes.SetFileName(aFileName: string); begin FFileName := aFileName; FillFileVersionInfo; //Get the file version information FillFixedFileInfoBuf; //Get the fixed file info FillFileMaskInfo; //Get the file mask values end; procedure TVerInfoRes.FillFileVersionInfo; var SBSize: UInt; begin { Determine size of version information } Size := GetFileVersionInfoSize(PChar(FFileName), Handle); if Size <= 0 then { raise exception if size <= 0 } raise ENoVerInfoError.Create('No Version Info Available.'); //Set the length accordingly SetLength(RezBuffer, Size); //Fill the buffer with version information, raise exception on error if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then raise EVerInfoError.Create('Cannot obtain version info.'); //Get translation info, raise exception on error if not VerQueryValue(PChar(RezBuffer), VerTranslation, pointer(TransTable), SBSize) then raise EVerInfoError.Create('No language info.'); end; procedure TVerInfoRes.FillFixedFileInfoBuf; var Size: Uint; begin if VerQueryValue(PChar(RezBuffer), '\', pointer(FixedFileInfoBuf), Size) then begin if Size < SizeOf(TVSFixedFileInfo) then raise eNoFixeVerInfo.Create('No fixed file info'); end else raise eNoFixeVerInfo.Create('No fixed file info') end; procedure TVerInfoRes.FillFileMaskInfo; begin with FixedFileInfoBuf^ do begin if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0then FFileFlags.Add('Pre-release'); if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then FFileFlags.Add('Private build'); if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then FFileFlags.Add('Special build'); if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then FFileFlags.Add('Debug'); end; end; function TVerInfoRes.GetPreDefKeystring(aVerKind: TVerInfoType): string; var P: PChar; S: UInt; begin Result := Format(vFormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^), VerNameArray[aVerKind], #0]); //get and return version query info, return empty string on error if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then Result := StrPas(P) else Result := ''; end; function TVerInfoRes.GetUserDefKeystring(aKey: string): string; var P: Pchar; S: UInt; begin Result := Format(vFormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^), aKey, #0]); //get and return version query info, return empty string on error if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then Result := StrPas(P) else Result := ''; end; function Versionstring(Ms, Ls: Longint): string; begin Result := Format('%d.%d.%d.%d', [HIWord(Ms), LOWord(Ms), HIWord(Ls), LOWord(Ls)]); end; function TVerInfoRes.GetFileVersion: string; begin with FixedFileInfoBuf^ do Result := Versionstring(dwFileVersionMS, dwFileVersionLS); end; function TVerInfoRes.GetProductVersion: string; begin with FixedFileInfoBuf^ do Result := Versionstring(dwProductVersionMS, dwProductVersionLS); end; function TVerInfoRes.GetFileOS: string; begin with FixedFileInfoBuf^ do case dwFileOS of VOS_UNKNOWN: //Same as VOS__BASE Result := 'Unknown'; VOS_DOS: Result := 'Designed for MS-DOS'; VOS_OS216: Result := 'Designed for 16-bit OS/2'; VOS_OS232: Result := 'Designed for 32-bit OS/2'; VOS_NT: Result := 'Designed for Windows NT'; VOS__WINDOWS16: Result := 'Designed for 16-bit Windows'; VOS__PM16: Result := 'Designed for 16-bit PM'; VOS__PM32: Result := 'Designed for 32-bit PM'; VOS__WINDOWS32: Result := 'Designed for 32-bit Windows'; VOS_DOS_WINDOWS16: Result := 'Designed for 16-bit Windows, running on MS-DOS'; VOS_DOS_WINDOWS32: Result := 'Designed for Win32 API, running on MS-DOS'; VOS_OS216_PM16: Result := 'Designed for 16-bit PM, running on 16-bit OS/2'; VOS_OS232_PM32: Result := 'Designed for 32-bit PM, running on 32-bit OS/2'; VOS_NT_WINDOWS32: Result := 'Designed for Win32 API, running on Windows/NT'; else Result := 'Unknown'; end; end; function FileSizeByName(const AFilename: string): Int64; begin with TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone) do try Result := Size; finally Free; end; end; procedure TVerInfoRes.ShowExample(l: Tstrings; sFileName: string); var nFileSize: double; begin with l do begin l.BeginUpdate; //rovi910126: l.Clear; add('CompanyName : ' GetPreDefKeystring(viCompanyName)); add('FileVersion : ' FileVersion); add('ProductVersion : ' ProductVersion); add('FileDescription : ' GetPreDefKeystring(viFileDescription)); nFileSize := FileSizeByName(sFileName); if nFileSize<0.001 then add('File Size : 目前正在使用中') else add('File Size : ' FormatFloat('#,##0.', nFileSize/1000) ' K Bytes'); //rovi910225: File Size add('File Date : ' DateTimeToStr(FileDateToDateTime(FileAge(sFileName)))); add('FileOS : ' FileOS); add('InternalName : ' GetPreDefKeystring(viInternalName)); add('LegalCopyright : ' GetPreDefKeystring(viLegalCopyright)); add('LegalTrademarks : ' GetPreDefKeystring(viLegalTrademarks)); add('OriginalFilename: ' GetPreDefKeystring(viOriginalFilename)); add('ProductName : ' GetPreDefKeystring(viProductName)); add('Comments : ' GetPreDefKeystring(viComments)); l.EndUpdate; end; end; end. |
adonis
高階會員 發表:140 回覆:258 積分:159 註冊:2002-04-15 發送簡訊給我 |
|
Mickey
版主 發表:77 回覆:1882 積分:1390 註冊:2002-12-11 發送簡訊給我 |
|
adonis
高階會員 發表:140 回覆:258 積分:159 註冊:2002-04-15 發送簡訊給我 |
|
hagar
版主 發表:143 回覆:4056 積分:4445 註冊:2002-04-14 發送簡訊給我 |
如果是 show 出檔案內容的 Dialog 的話, 如下:
Procedure ShowFileProperties(Const filename: String); Var sei: TShellExecuteinfo; Begin FillChar(sei,sizeof(sei),0); sei.cbSize := sizeof(sei); sei.lpFile := Pchar(filename); sei.lpVerb := 'properties'; sei.fMask := SEE_MASK_INVOKEIDLIST; ShellExecuteEx(@sei); End;不是的話, 就莫宰羊了! -- 向 KTop 的弟兄們致敬! |
wameng
版主 發表:31 回覆:1336 積分:1188 註冊:2004-09-16 發送簡訊給我 |
|
adonis
高階會員 發表:140 回覆:258 積分:159 註冊:2002-04-15 發送簡訊給我 |
|
qoo1234
版主 發表:256 回覆:1167 積分:659 註冊:2003-02-24 發送簡訊給我 |
|
wameng
版主 發表:31 回覆:1336 積分:1188 註冊:2004-09-16 發送簡訊給我 |
雖然說來晚了一步!{給 qoo1234 版主搶先了...呵呵}
整理如下:
uses ActiveX,ComObj; function StgOpenStorageEx ( const pwcsName : POleStr; //Pointer to the path of the //file containing storage object grfMode : LongInt; //Specifies the access mode for the object stgfmt : DWORD; //Specifies the storage file format grfAttrs : DWORD; //Reserved; must be zero pStgOptions : Pointer; //Address of STGOPTIONS pointer reserved2 : Pointer; //Reserved; must be zero riid : PGUID; //Specifies the GUID of the interface pointer out stgOpen : //Address of an interface pointer IStorage ) : HResult; stdcall; external 'ole32.dll'; function GetFileSummaryInfo(const FileName: WideString): String; const FmtID_SummaryInformation: TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}'; FMTID_DocSummaryInformation : TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}'; FMTID_UserDefinedProperties : TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}'; IID_IPropertySetStorage : TGUID = '{0000013A-0000-0000-C000-000000000046}'; STGFMT_FILE = 3; //Indicates that the file must not be a compound file. //This element is only valid when using the StgCreateStorageEx //or StgOpenStorageEx functions to access the NTFS file system //implementation of the IPropertySetStorage interface. //Therefore, these functions return an error if the riid //parameter does not specify the IPropertySetStorage interface, //or if the specified file is not located on an NTFS file system volume. STGFMT_ANY = 4; //Indicates that the system will determine the file type and //use the appropriate structured storage or property set //implementation. //This value cannot be used with the StgCreateStorageEx function. // Summary Information PID_TITLE = 2; PID_SUBJECT = 3; PID_AUTHOR = 4; PID_KEYWORDS = 5; PID_COMMENTS = 6; PID_TEMPLATE = 7; PID_LASTAUTHOR = 8; PID_REVNUMBER = 9; PID_EDITTIME = 10; PID_LASTPRINTED = 11; PID_CREATE_DTM = 12; PID_LASTSAVE_DTM = 13; PID_PAGECOUNT = 14; PID_WORDCOUNT = 15; PID_CHARCOUNT = 16; PID_THUMBNAIL = 17; PID_APPNAME = 18; PID_SECURITY = 19; // Document Summary Information PID_CATEGORY = 2; PID_PRESFORMAT = 3; PID_BYTECOUNT = 4; PID_LINECOUNT = 5; PID_PARCOUNT = 6; PID_SLIDECOUNT = 7; PID_NOTECOUNT = 8; PID_HIDDENCOUNT = 9; PID_MMCLIPCOUNT = 10; PID_SCALE = 11; PID_HEADINGPAIR = 12; PID_DOCPARTS = 13; PID_MANAGER = 14; PID_COMPANY = 15; PID_LINKSDIRTY = 16; PID_CHARCOUNT2 = 17; var I: Integer; PropSetStg: IPropertySetStorage; PropSpec: array of TPropSpec; PropStg: IPropertyStorage; PropVariant: array of TPropVariant; Rslt: HResult; S: String; Stg: IStorage; PropEnum: IEnumSTATPROPSTG; HR : HResult; PropStat: STATPROPSTG; k : integer; function PropertyPIDToCaption(const ePID: Cardinal): string; begin case ePID of PID_TITLE: Result := 'Title'; PID_SUBJECT: Result := 'Subject'; PID_AUTHOR: Result := 'Author'; PID_KEYWORDS: Result := 'Keywords'; PID_COMMENTS: Result := 'Comments'; PID_TEMPLATE: Result := 'Template'; PID_LASTAUTHOR: Result := 'Last Saved By'; PID_REVNUMBER: Result := 'Revision Number'; PID_EDITTIME: Result := 'Total Editing Time'; PID_LASTPRINTED: Result := 'Last Printed'; PID_CREATE_DTM: Result := 'Create Time/Date'; PID_LASTSAVE_DTM: Result := 'Last Saved Time/Date'; PID_PAGECOUNT: Result := 'Number of Pages'; PID_WORDCOUNT: Result := 'Number of Words'; PID_CHARCOUNT: Result := 'Number of Characters'; PID_THUMBNAIL: Result := 'Thumbnail'; PID_APPNAME: Result := 'Creating Application'; PID_SECURITY: Result := 'Security'; else Result := '$' IntToHex(ePID, 8); end end; begin Result := ''; try if StgIsStorageFile(PWideChar(FileName))<>S_OK then Exit; OleCheck(StgOpenStorageEx(PWideChar(FileName), STGM_READ or STGM_SHARE_DENY_WRITE, STGFMT_FILE, 0, nil, nil, @IID_IPropertySetStorage, stg)); PropSetStg := Stg as IPropertySetStorage; OleCheck(PropSetStg.Open(FmtID_SummaryInformation, STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg)); OleCheck(PropStg.Enum(PropEnum)); I := 0; hr := PropEnum.Next(1, PropStat, nil); while hr = S_OK do begin inc(I); SetLength(PropSpec,I); PropSpec[i-1].ulKind := PRSPEC_PROPID; PropSpec[i-1].propid := PropStat.propid; hr := PropEnum.Next(1, PropStat, nil); end; SetLength(PropVariant,i); Rslt := PropStg.ReadMultiple(i, @PropSpec[0], @PropVariant[0]); if Rslt = S_FALSE then Exit; for k := 0 to i -1 do begin S := ''; if PropVariant[k].vt = VT_LPSTR then if Assigned(PropVariant[k].pszVal) then S := PropVariant[k].pszVal; S := Format(PropertyPIDToCaption(PropSpec[k].Propid) ' %s',[s]); if S <> '' then Result := Result S #13; end; finally end; end;紅色字是我自行添加的。 若為特定檔案,才讀取。 但仍有幾點我需要補充的。 1. 以上用法只適用於 Windows 2000 及使用 NTFS 檔案系統。 2. 如果您只需 Word 或Excel 摘要, 可以到此http://www.scalabium.com/download/smcmpnt.zip 下載元件。 相關資訊: http://users.iafrica.com/d/da/dart/zen/Source/ByLang/Delphi/DocFileUtils/TSummaryInformation/df__TSummaryInformation.html http://users.iafrica.com/d/da/dart/zen/Articles/DocFile/DocFile.html 發表人 - wameng 於 2004/11/30 11:00:49 |
mine
中階會員 發表:28 回覆:129 積分:56 註冊:2004-03-31 發送簡訊給我 |
hihi 各位版大 還有adonis大大好
先感謝各位大大又讓我多學了一招
qoo跟wameng版大所提供的資訊確實能得到右鍵summary所有的資訊內容!!
小小插花一下
wameng大大所修正的
try //if StgIsStorageFile(PWideChar(FileName))<>S_OK then Exit; ^^^^^^^^^加了這一行我反而得不到該檔案的資訊 於是我拿掉這一行改放在下面紅字的部份 OleCheck(StgOpenStorageEx(PWideChar(FileName), STGM_READ or STGM_SHARE_DENY_WRITE, STGFMT_FILE, 0, nil, nil, @IID_IPropertySetStorage, stg)); PropSetStg := Stg as IPropertySetStorage; OleCheck(PropSetStg.Open(FmtID_SummaryInformation, STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg)); OleCheck(PropStg.Enum(PropEnum)); I := 0; hr := PropEnum.Next(1, PropStat, nil); while hr = S_OK do begin inc(I); SetLength(PropSpec,I); PropSpec[i-1].ulKind := PRSPEC_PROPID; PropSpec[i-1].propid := PropStat.propid; hr := PropEnum.Next(1, PropStat, nil); end; SetLength(PropVariant,i); Rslt := PropStg.ReadMultiple(i, @PropSpec[0], @PropVariant[0]); if Rslt = S_FALSE then Exit; for k := 0 to i -1 do begin S := ''; if PropVariant[k].vt = VT_LPSTR then if Assigned(PropVariant[k].pszVal) then S := PropVariant[k].pszVal; S := Format(PropertyPIDToCaption(PropSpec[k].Propid) ' %s',[s]); if S <> '' then Result := Result S #13#10; // 讓資訊分列更清楚; end; // finally except Result:=''該檔案沒有summary資訊'; end; end; procedure TForm1.Button1Click(Sender: TObject); begin CheckBox1.Checked:=isNTFS('c:\11.txt');//利用原本的文章判斷是否為NTFS格式 memo1.text:=GetFileSummaryInfo(WideString('c:\11.txt')); end;有錯還請大大指正 搞不懂!搞不懂!永遠都搞不懂!! 發表人 - mine 於 2004/11/30 16:56:26 發表人 - mine 於 2004/11/30 17:03:53 |
adonis
高階會員 發表:140 回覆:258 積分:159 註冊:2002-04-15 發送簡訊給我 |
qoo1234, wameng, mine, 您們好 謝謝你們(以及其他熱心參與的前輩們)熱心的回應。 原本這個問題在八月份的時候沒有得到真正需求上的解惑,以致在那當時就結案了。沒想到前幾天 wameng 前輩的突然回應,讓原本以為無法處理的環結又再次燃起契機,真是著實從內心發出感謝,謝謝你們熱心的參與。 但 .. 令我頭痛的是只能指定一人得分 ..
最終還是決定給 wameng 前輩,因為是您讓這個沈寂下來的疑惑再次被打開。 謝謝。
------
我也在努力學習中,若有錯謬請見諒。 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |