在delphi中如何读取文件的系统信息 就是反建点击文件(word,tzt等)后点击属性上的那些信息如标题啊主题啊,作者之类的并把他写入数据库急用谢谢了 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 要使用动态图标,首先要解决的是如何获得显示文本和与其相关联的图标句柄。该图标通过文件关联由系统注册表决定,并且在Windows编程中同一文件(或子目录,或文件夹)在桌面上也可能有两种显示结果,这就是DOS文件名与显示名(Display Name)。如果我们的应用程序不需要有像Windows资源浏览器那样的效果,则可以使用FindFirst()和FindNext()二个函数以及FindClose()过程来获得DOS文件名,否则我们就应当使用WindowsAPI来获得显示名。在获得文件名的同时可通过使用ShellAPI.pas中的SHGetFileInfo()函数来获得其图标句柄HICON,说明如下: function SHGetFileInfo(pszPath: PAnsiChar; dwFileAttributes: DWORD;var psfi: TSHFileInfo; cbFileInfo,uFlags: UINT): DWORDl; pszPath 参数:指定的文件名。当uFlags的取值中不包含 SHGFI_PIDL时,可直接指定;否则pszPath要通过计算获得,不能直接指定; dwFileAttributes参数:文件属性,仅当uFlags的取值中包含SHGFI_USEFILEATTRIBUTES时有效,一般不用此参数; psfi 参数:返回获得的文件信息,是一个记录类型,有以下字段: hIcon: HICON; //文件的图标句柄 iIcon: Integer; //图标的系统索引号 dwAttributes: DWORD; //文件的属性值 szDisplayName: array [0..MAX_PATH-1] of AnsiChar; //文件的显示名 szTypeName: array [0..79] of AnsiChar; //文件的类型名 cbFileInfo 参数:psfi的比特值; uFlags 参数:指明需要返回的文件信息标识符,常用的有以下常数: SHGFI_ICON; //获得图标 SHGFI_DISPLAYNAME; //获得显示名 SHGFI_TYPENAME; //获得类型名 SHGFI_ATTRIBUTES;//获得属性 SHGFI_LARGEICON; //获得大图标 SHGFI_SMALLICON; //获得小图标 SHGFI_PIDL;// pszPath是一个标识符 函数SHGetFileInfo()的返回值也随uFlags的取值变化而有所不同。通过调用SHGetFileInfo()可以由psfi参数得到文件的图标句柄,但要注意在uFlags参数中不使用SHGFI_PIDL时,SHGetFileInfo()不能获得"我的电脑"等虚似文件夹的信息。看看这个或许对你有帮助! typeTFileInfo = packed recordCommpanyName: string;FileDescription: string;FileVersion: string;InternalName: string;LegalCopyright: string;LegalTrades: string;OriginalFileName: string;ProductName: string;ProductVersion: string;SpecialBuild: string;PrivateBuild: string;Comments: string;VsFixedFileInfo: VS_FIXEDFILEINFO;UserDefineValue: string;end;function GetFileVersionInfomation(const FileName: string; var info: TFileInfo; UserDefine: string =''):boolean;constSFInfo = '\StringFileInfo\';varVersionInfo: Pointer;InfoSize: DWORD;InfoPointer: Pointer;Translation: Pointer;VersionValue: string;unused: DWORD;beginunused := 0;Result := False;InfoSize := GetFileVersionInfoSize(pchar(FileName), unused);if InfoSize 〉 0 thenbeginGetMem(VersionInfo, InfoSize);Result := GetFileVersionInfo(pchar(FileName), 0, InfoSize, VersionInfo);if Result thenbeginVerQueryValue(VersionInfo, '\VarFileInfo\Translation', Translation, InfoSize);VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) +IntToHex(HiWord(Longint(Translation^)), 4) + '\';VerQueryValue(VersionInfo, pchar(VersionValue + 'CompanyName'), InfoPointer, InfoSize);info.CommpanyName := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'FileDescription'), InfoPointer, InfoSize);info.FileDescription := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'FileVersion'), InfoPointer, InfoSize);info.FileVersion := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'InternalName'), InfoPointer, InfoSize);info.InternalName := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalCopyright'), InfoPointer, InfoSize);info.LegalCopyright := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalTrades'), InfoPointer, InfoSize);info.LegalTrades := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'OriginalFileName'), InfoPointer, InfoSize);info.OriginalFileName := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductName'), InfoPointer, InfoSize);info.ProductName := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductVersion'), InfoPointer, InfoSize);info.ProductVersion := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'SpecialBuild'), InfoPointer, InfoSize);info.SpecialBuild := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'PrivateBuild'), InfoPointer, InfoSize);info.PrivateBuild := string(pchar(InfoPointer));VerQueryValue(VersionInfo, pchar(VersionValue + 'Comments'), InfoPointer, InfoSize);info.Comments := string(pchar(InfoPointer));if VerQueryValue(VersionInfo, '\', InfoPointer, InfoSize) theninfo.VsFixedFileInfo := TVSFixedFileInfo(InfoPointer^);if UserDefine 〈〉 '' thenbeginif VerQueryValue(VersionInfo, pchar(VersionValue + UserDefine), InfoPointer, InfoSize) theninfo.UserDefineValue := string(pchar(InfoPointer));end;end;FreeMem(VersionInfo);end;end;调用演示:procedure TForm1.Button1Click(Sender: TObject);varinfo: TFileInfo;beginif OpenDialog1.Execute thenbeginif GetFileVersionInfomation(opendialog1.FileName, info,'WOW Version') thenbeginListbox1.Items.Add(OpenDialog1.FileName);ListBox1.Items.Add('Comments:' + info.Comments);ListBox1.Items.Add('CommpanyName:' + info.CommpanyName);ListBox1.Items.Add('FileDescription:' + info.FileDescription);ListBox1.Items.Add('FileVersion:' + info.FileVersion);ListBox1.Items.Add('InternalName:' + info.InternalName);ListBox1.Items.Add('LegalCopyright:' + info.LegalCopyright);ListBox1.Items.Add('LegalTrades:' + info.LegalTrades);ListBox1.Items.Add('OriginalFileName:' + info.OriginalFileName);ListBox1.Items.Add('ProductName:' + info.ProductName);ListBox1.Items.Add('ProductVersion:' + info.ProductVersion);ListBox1.Items.Add('UserDefineValue:' + info.UserDefineValue);if boolean(info.VsFixedFileInfo.dwFileFlags and vs_FF_Debug) thenlistbox1.Items.Add('Debug:True')elseListBox1.Items.Add('Debug:False');ListBox1.Items.Add('');end;end;end; 又找了一个不过我试了一下,没成功,你试试. http://www.yesky.com/SoftChannel/72342371928440832/20031111/1743541.shtml看看这个 这个是显属性的,我也不知道怎么提取信息出来:uses ShellApi;...function ShowFileProperties(FileName: String; Wnd: HWND): Boolean;var sfi: TSHELLEXECUTEINFO;begin with sfi do begin cbSize := SizeOf(sfi); lpFile := PAnsiChar(FileName); Wnd := Wnd; fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI; lpVerb := PAnsiChar('properties'); lpIDList := nil; lpDirectory := nil; nShow := 0; hInstApp := 0; lpParameters := nil; dwHotKey := 0; hIcon := 0; hkeyClass := 0; hProcess := 0; lpClass := nil; end; Result := ShellExecuteEX(@sfi);end;procedure TForm1.Button1Click(Sender: TObject);begin ShowFileProperties('d:\store.xls', Handle);end; 在WINDOWS单元中_WIN32_FIND_DATAA 是这样定义的:_WIN32_FIND_DATAA = record dwFileAttributes: DWORD; ftCreationTime: TFileTime; ftLastAccessTime: TFileTime; ftLastWriteTime: TFileTime; nFileSizeHigh: DWORD; nFileSizeLow: DWORD; dwReserved0: DWORD; dwReserved1: DWORD; cFileName: array[0..MAX_PATH - 1] of AnsiChar; cAlternateFileName: array[0..13] of AnsiChar; end;var FindFileData: _WIN32_FIND_DATAA;begin if FindFirstFile(文件路径,FindFileData)<>INVALID_HANDLE_VALUE then begin ...... end; 请问如何防止程序多个运行 如何缩放位图? rave报表,在打印的时候会显示一个对话框,如何汉化它? 在delphi中如何列出系统服务及其状态 记录换行符/回车的问题!!! 这个程序怎么写: TIDHttp控件在那里有?我看帮助里有但控件页上没有? 关于日期的问题 用ADOquery來更新后台數據庫的問題 如何在BDE中配置sql server6.5下的数据库(我用的DELPHI3.0) 各位大家有没有用ADO替换BDE的方法? 关于日期的问题
function SHGetFileInfo(pszPath: PAnsiChar; dwFileAttributes: DWORD;var psfi: TSHFileInfo; cbFileInfo,uFlags: UINT): DWORDl;
pszPath 参数:指定的文件名。当uFlags的取值中不包含 SHGFI_PIDL时,可直接指定;否则pszPath要通过计算获得,不能直接指定;
dwFileAttributes参数:文件属性,仅当uFlags的取值中包含SHGFI_USEFILEATTRIBUTES时有效,一般不用此参数;
psfi 参数:返回获得的文件信息,是一个记录类型,有以下字段:
hIcon: HICON; //文件的图标句柄
iIcon: Integer; //图标的系统索引号
dwAttributes: DWORD; //文件的属性值
szDisplayName: array [0..MAX_PATH-1] of AnsiChar; //文件的显示名
szTypeName: array [0..79] of AnsiChar; //文件的类型名
cbFileInfo 参数:psfi的比特值;
uFlags 参数:指明需要返回的文件信息标识符,常用的有以下常数:
SHGFI_ICON; //获得图标
SHGFI_DISPLAYNAME; //获得显示名
SHGFI_TYPENAME; //获得类型名
SHGFI_ATTRIBUTES;//获得属性
SHGFI_LARGEICON; //获得大图标
SHGFI_SMALLICON; //获得小图标
SHGFI_PIDL;// pszPath是一个标识符
函数SHGetFileInfo()的返回值也随uFlags的取值变化而有所不同。通过调用SHGetFileInfo()可以由psfi参数得到文件的图标句柄,但要注意在uFlags参数中不使用SHGFI_PIDL时,SHGetFileInfo()不能获得"我的电脑"等虚似文件夹的信息。看看这个或许对你有帮助!
TFileInfo = packed record
CommpanyName: string;
FileDescription: string;
FileVersion: string;
InternalName: string;
LegalCopyright: string;
LegalTrades: string;
OriginalFileName: string;
ProductName: string;
ProductVersion: string;
SpecialBuild: string;
PrivateBuild: string;
Comments: string;
VsFixedFileInfo: VS_FIXEDFILEINFO;
UserDefineValue: string;
end;function GetFileVersionInfomation(const FileName: string; var info: TFileInfo; UserDefine: string =
''):
boolean;
const
SFInfo = '\StringFileInfo\';
var
VersionInfo: Pointer;
InfoSize: DWORD;
InfoPointer: Pointer;
Translation: Pointer;
VersionValue: string;
unused: DWORD;
begin
unused := 0;
Result := False;
InfoSize := GetFileVersionInfoSize(pchar(FileName), unused);
if InfoSize 〉 0 then
begin
GetMem(VersionInfo, InfoSize);
Result := GetFileVersionInfo(pchar(FileName), 0, InfoSize, VersionInfo);
if Result then
begin
VerQueryValue(VersionInfo, '\VarFileInfo\Translation', Translation, InfoSize);
VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) +
IntToHex(HiWord(Longint(Translation^)), 4) + '\';
VerQueryValue(VersionInfo, pchar(VersionValue + 'CompanyName'), InfoPointer, InfoSize);
info.CommpanyName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileDescription'), InfoPointer, InfoSize);
info.FileDescription := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'FileVersion'), InfoPointer, InfoSize);
info.FileVersion := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'InternalName'), InfoPointer, InfoSize);
info.InternalName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalCopyright'), InfoPointer, InfoSize);
info.LegalCopyright := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'LegalTrades'), InfoPointer, InfoSize);
info.LegalTrades := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'OriginalFileName'), InfoPointer, InfoSize);
info.OriginalFileName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductName'), InfoPointer, InfoSize);
info.ProductName := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'ProductVersion'), InfoPointer, InfoSize);
info.ProductVersion := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'SpecialBuild'), InfoPointer, InfoSize);
info.SpecialBuild := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'PrivateBuild'), InfoPointer, InfoSize);
info.PrivateBuild := string(pchar(InfoPointer));
VerQueryValue(VersionInfo, pchar(VersionValue + 'Comments'), InfoPointer, InfoSize);
info.Comments := string(pchar(InfoPointer));
if VerQueryValue(VersionInfo, '\', InfoPointer, InfoSize) then
info.VsFixedFileInfo := TVSFixedFileInfo(InfoPointer^);
if UserDefine 〈〉 '' then
begin
if VerQueryValue(VersionInfo, pchar(VersionValue + UserDefine), InfoPointer, InfoSize) then
info.UserDefineValue := string(pchar(InfoPointer));
end;
end;
FreeMem(VersionInfo);
end;
end;调用演示:procedure TForm1.Button1Click(Sender: TObject);
var
info: TFileInfo;
begin
if OpenDialog1.Execute then
begin
if GetFileVersionInfomation(opendialog1.FileName, info,'WOW Version') then
begin
Listbox1.Items.Add(OpenDialog1.FileName);
ListBox1.Items.Add('Comments:' + info.Comments);
ListBox1.Items.Add('CommpanyName:' + info.CommpanyName);
ListBox1.Items.Add('FileDescription:' + info.FileDescription);
ListBox1.Items.Add('FileVersion:' + info.FileVersion);
ListBox1.Items.Add('InternalName:' + info.InternalName);
ListBox1.Items.Add('LegalCopyright:' + info.LegalCopyright);
ListBox1.Items.Add('LegalTrades:' + info.LegalTrades);
ListBox1.Items.Add('OriginalFileName:' + info.OriginalFileName);
ListBox1.Items.Add('ProductName:' + info.ProductName);
ListBox1.Items.Add('ProductVersion:' + info.ProductVersion);
ListBox1.Items.Add('UserDefineValue:' + info.UserDefineValue);
if boolean(info.VsFixedFileInfo.dwFileFlags and vs_FF_Debug) then
listbox1.Items.Add('Debug:True')
else
ListBox1.Items.Add('Debug:False');
ListBox1.Items.Add('');
end;
end;
end;
又找了一个不过我试了一下,没成功,你试试.
看看这个
uses ShellApi;
...
function ShowFileProperties(FileName: String; Wnd: HWND): Boolean;
var
sfi: TSHELLEXECUTEINFO;
begin
with sfi do
begin
cbSize := SizeOf(sfi);
lpFile := PAnsiChar(FileName);
Wnd := Wnd;
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
lpVerb := PAnsiChar('properties');
lpIDList := nil;
lpDirectory := nil;
nShow := 0;
hInstApp := 0;
lpParameters := nil;
dwHotKey := 0;
hIcon := 0;
hkeyClass := 0;
hProcess := 0;
lpClass := nil;
end;
Result := ShellExecuteEX(@sfi);
end;procedure TForm1.Button1Click(Sender: TObject);
begin
ShowFileProperties('d:\store.xls', Handle);
end;
_WIN32_FIND_DATAA = record
dwFileAttributes: DWORD;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: DWORD;
nFileSizeLow: DWORD;
dwReserved0: DWORD;
dwReserved1: DWORD;
cFileName: array[0..MAX_PATH - 1] of AnsiChar;
cAlternateFileName: array[0..13] of AnsiChar;
end;
var
FindFileData: _WIN32_FIND_DATAA;
begin
if FindFirstFile(文件路径,FindFileData)<>INVALID_HANDLE_VALUE then
begin
......
end;