Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Комментарий к файлу

Ego © (2004-11-25 19:29:00)
У меня такой вопрос: как программно прочитать комментарии к файлу( те, которые появляются, когда на файле задерживаешь курсор мыши )?

TankMan (2004-11-25 22:58:00) [1]
//.....

function TFIleInfo.isSpecialBuild : boolean;
begin
result := FALSE;
if GetFileVersion( fFileName ) then
result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
VS_FF_SPECIALBUILD) <> 0
end;

function TFileInfo.OS : string;
begin
if GetFileVersion( fFileName ) then
case fVerBlk.dwFileOS of
VOS_DOS_WINDOWS16 : result := 'MS-DOS or 16 bit Windows';
VOS_DOS_WINDOWS32 : result := '32 bit Windows';
VOS_OS216_PM16 : result := '16 bit OS/2';
VOS_OS232_PM32 : result := '32 bit OS/2';
VOS_NT_WINDOWS32 : result := 'Win32 or Windows NT';
else
result := 'Unknown OS';
end
else
result := '';
end;

function TFileInfo.FileType : string;
var
S: string;
begin
S := '';
if GetFileVersion( fFileName ) then
begin
case fVerBlk.dwFileType of
VFT_APP : S := 'Application';
VFT_DLL : S := 'Dynamic Link Library (DLL)';
VFT_DRV :
begin
S := 'Device Driver - ';
case fVerBlk.dwFileSubtype of
VFT2_DRV_PRINTER : S := S + 'Printer';
VFT2_DRV_KEYBOARD : S := S + 'Keyboard';
VFT2_DRV_LANGUAGE : S := S + 'Language';
VFT2_DRV_DISPLAY : S := S + 'Display';
VFT2_DRV_MOUSE : S := S + 'Mouse';
VFT2_DRV_NETWORK : S := S + 'Network';
VFT2_DRV_SYSTEM : S := S + 'System';
VFT2_DRV_INSTALLABLE : S := S + 'Installable';
VFT2_DRV_SOUND : S := S + 'Sound';
else
S := S + 'Unknown';
end;
end;
VFT_FONT :
begin
S := 'Font File - ';
case fVerBlk.dwFileSubType of
VFT2_FONT_RASTER : S := S + 'Raster';
VFT2_FONT_VECTOR : S := S + 'Vector';
VFT2_FONT_TRUETYPE : S := S + 'TrueType';
else
S := S + 'Unknown';
end;
end;
VFT_VXD : S := 'Virtual Device';
VFT_STATIC_LIB : S := 'Static Link Library';
else
S := 'Unknown File Type';
end;
end;
Result := S;
end;

function TFileInfo.Path : string;
begin
result := ExtractFilePath( fFileName );
end;

function TFileInfo.FileName : string;
begin
result := ExtractFileName( fFileName );
end;

function TFileInfo.name : string;
begin
if Pos( FileExt, FileName ) > 0 then
result := Copy( FileName, 0, pos( FileExt, FileName )-1 )
else
result := FileName;
end;

function TFileInfo.DosFileName : string;
begin
result := StrPas( f.FindData.cAlternateFileName )
end;

function TFileInfo.FileExt : string;
begin
result := ExtractFileExt( fFileName );
end;

function TFileInfo.isDirectory : boolean;
begin
result := f.Attr and faDirectory = faDirectory;
end;

function TFileInfo.isHidden : boolean;
begin
result := f.Attr and faHidden = faHidden;
end;

function TFileInfo.isSystemFile : boolean;
begin
result := f.Attr and faSysFile = faSysFile;
end;

function TFileInfo.isVolumeId : boolean;
begin
result := f.Attr and faVolumeId = faVolumeId;
end;

function TFileInfo.isArchive : boolean;
begin
result := f.Attr and faArchive = faArchive;
end;

function TFileInfo.FileSize : longint;
begin
result := f.Size;
end;

function TFileInfo.CreationTime : TDateTime;
var
LTime: TFileTime;
Systemtime: TSystemtime;
begin
FileTimeToLocalFileTime( f.FindData.ftCreationTime, LTime);
FileTimeToSystemTime( LTime, SystemTime );
result := SystemTimeToDateTime( SystemTime);
end;

function TFileInfo.LastAccessed : TDateTime;
var
LTime : TFileTime;
Systemtime : TSystemtime;
begin
FileTimeToLocalFileTime( f.FindData.ftLastAccessTime, LTime);
FileTimeToSystemTime( LTime, SystemTime );
result := SystemTimeToDateTime( SystemTime);
end;

function TFileInfo.LastWritten : TDateTime;
var
LTime : TFileTime;
Systemtime : TSystemtime;
begin
FileTimeToLocalFileTime( f.FindData.ftLastWriteTime, LTime);
FileTimeToSystemTime( LTime, SystemTime );
result := SystemTimeToDateTime( SystemTime);
end;

function TFileInfo.Execute : integer;
begin
result := shellapi.ShellExecute( Application.Handle, 'open',
pChar( fFileName ), '', pChar(Path), SW_SHOWDEFAULT );
case result of
0 :
raise Exception.Create( 'Недостаточно памяти или ресурсов.' );
ERROR_FILE_NOT_FOUND :
raise Exception.Create( 'Указанный файл не найден.' );
ERROR_PATH_NOT_FOUND :
raise Exception.Create( 'Указанный путь не найден.' );
ERROR_BAD_FORMAT :
raise Exception.Create( 'Ошибка файла .EXE (не -Win32 .EXE или ошибка ' + 'в .EXE).' );
SE_ERR_ACCESSDENIED :
raise Exception.Create( 'Доступ к файлу запрещён.' );
SE_ERR_ASSOCINCOMPLETE :
raise Exception.Create( 'The filename association is incomplete or invalid.' );
SE_ERR_DDEBUSY :
raise Exception.Create( 'Транзакция DDE не может быть завершена, потому что ' +
'другая транзакция DDE находится в процессе выполнения.' );
SE_ERR_DDEFAIL :
raise Exception.Create( 'Ошибка транзакции DDE.' );
SE_ERR_DDETIMEOUT :
raise Exception.Create( 'DDE транзакция не может быть завершина из-за тайм-аута.' );
SE_ERR_DLLNOTFOUND :
raise Exception.Create( 'Указанная dynamic-link library не найдена.' );
SE_ERR_NOASSOC :
raise Exception.Create( 'Не найдено приложение связанной с данным расширением файла.' );
SE_ERR_OOM :
raise Exception.Create( 'Недостаточно памяти для завершения операции.' );
SE_ERR_SHARE :
raise Exception.Create( 'Файл используется другим приложением.' );
else
end;
end;

end.

TankMan (2004-11-25 22:57:00) [2]
Вот взял с delphi world... Автор: Brian Pedersen
Сам мучался - искал :)
Возьми кусок какой нужен...
Вообще GetFileVersion мне хватило :)

unit FileInfo;

interface

uses
forms, shellapi, windows, sysutils;

type
EFileInfo = exception;
TLangInfoBuffer = array [1..4] of SmallInt;
TFileInfo = class
private
f : TSearchRec;
fVerBlk : TVSFixedFileInfo;
fFileName : string;
function GetFileVersion( AFileName : string ) : boolean;
public
constructor Create( AFileName : string ); // Создаём объект
destructor Destroy; override;
function Execute : integer; // Открывает файл в программе, связанной с ним
function VersionString : string; // Версия файла. Строка пустая, если строка не найдена
function OS : string; // Операционная система
function Path : string; // Путь файла
function FileName : string; // Имя файла
function name : string; // Имя файла без расширения
function DosFileName : string; // Имя файла в DOS
function FileExt : string; // Расширение файла
function FileType : string; // Тип файла
function FileSize : longint; // Размер файла
function isDebugBuild : boolean; // True если флаг отладки (debug build) установлен
function isPreRelease : boolean; // True если флаг prerelease установлен
function isPrivateBuild : boolean; // True если флаг private установлен
function isSpecialBuild : boolean; // True если флаг special build установлен
function isDirectory : boolean; // True если файл является директорией
function isHidden : boolean; // True если файл является скрытым (hidden)
function isSystemFile : boolean; // True если файл является системным
function isVolumeId : boolean; // True если файл является меткой тома
function isArchive : boolean; // True если файл является архивом
function CreationTime : TDateTime; // Время создания файла
function LastAccessed : TDateTime; // Время последнего доступа к файлу
function LastWritten : TDateTime; // Время последней записи в файл
end;

implementation

constructor TFileInfo.Create(AFileName: string);
var
ret: integer;
begin
inherited Create;
fFileName := AFileName;
ret := FindFirst( AFileName, faReadOnly + faHidden+ faSysFile +
faVolumeID + faDirectory + faArchive + faAnyFile, f );
if ret <> 0 then
SysUtils.RaiseLastWin32Error;
end;

destructor TFileInfo.Destroy;
begin
FindClose( f );
end;

function TFileInfo.GetFileVersion(AFileName: string): boolean;
var
InfoSize, puLen: DWord;
Pt, InfoPtr: Pointer;
begin
InfoSize := GetFileVersionInfoSize( PChar(AFileName), puLen );
fillchar( fVerBlk, sizeof(TVSFixedFileInfo), 0);
if InfoSize > 0 then
begin
GetMem(Pt,InfoSize);
GetFileVersionInfo( PChar(AFileName), 0, InfoSize, Pt);
VerQueryValue(Pt,'\',InfoPtr,puLen);
move(InfoPtr^, fVerBlk, sizeof(TVSFixedFileInfo) );
FreeMem(Pt);
result := true;
end
else
result := false;
end;

function TFileInfo.VersionString: string;
begin
if GetFileVersion( fFileName ) then
result := Format('%u.%u.%u.%u',
[HiWord(fVerBlk.dwProductVersionMS),
LoWord(fVerBlk.dwProductVersionMS),
HiWord(fVerBlk.dwProductVersionLS),
LoWord(fVerBlk.dwProductVersionLS)])
else
result := '';
end;

function TFileInfo.isDebugBuild : boolean;
begin
result := FALSE;
if GetFileVersion( fFileName ) then
result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
VS_FF_DEBUG) <> 0
end;

function TFIleInfo.isPreRelease : boolean;
begin
result := FALSE;
if GetFileVersion( fFileName ) then
result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
VS_FF_PRERELEASE) <> 0
end;

function TFIleInfo.isPrivateBuild : boolean;
begin
result := FALSE;
if GetFileVersion( fFileName ) then
result := (fVerBlk.dwFileFlagsMask and fVerBlk.dwFileFlags and
VS_FF_PRIVATEBUILD) <> 0
end;
....

Poirot (2004-11-25 20:25:00) [3]
Это расгирениее оболочки. Т.ен. это оболочка генерирует сама. на основе выбранного файла. СМ IQueryInfo для больше понятности:)

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »