Programlama yapalım ve Öğrenelim.

neoturk: ...Ensure that a path name ends with a delimiter '' ?...

{

For People (as I am) who can't manage with all of this function names and

forget some "jewels".

You should sometimes "rename" such procedures if it helps you to remember.

}

{

Die Unit Sysutils verbirgt einige Funktionen, die oft in Vergessenheit

geraten.

Kapselt die Funktion aus "Sysutils" in einer Funktion mit einem

"ansprechenden" Namen.

}

{ IncludeTrailingBackslash }

// Adds '' to the end of a string if it is not already there.

// Die Funktion gibt einen Pfadnamen mit dem abschließenden Zeichen '' zurück.

function CheckPfadEnd(const P: string): string;

begin

Result := IncludeTrailingBackslash(P);

end;

{ ExcludeTrailingBackslash }

// Removes one '' from the end of a string if it is there.

// Die Funktion gibt einen Pfadnamen ohne das abschließende Zeichen zurück.

MyDir := ExcludeTrailingBackslash('c:Windows');

// ---> MyDir = c:Windows

Delphi - .....................................

neoturk: ...Ensure that a path name ends with a delimiter '' ?...

{

For People (as I am) who can't manage with all of this function names and

forget some "jewels".

You should sometimes "rename" such procedures if it helps you to remember.

}

{

Die Unit Sysutils verbirgt einige Funktionen, die oft in Vergessenheit

geraten.

Kapselt die Funktion aus "Sysutils" in einer Funktion mit einem

"ansprechenden" Namen.

}

{ IncludeTrailingBackslash }

// Adds '' to the end of a string if it is not already there.

// Die Funktion gibt einen Pfadnamen mit dem abschließenden Zeichen '' zurück.

function CheckPfadEnd(const P: string): string;

begin

Result := IncludeTrailingBackslash(P);

end;

{ ExcludeTrailingBackslash }

// Removes one '' from the end of a string if it is there.

// Die Funktion gibt einen Pfadnamen ohne das abschließende Zeichen zurück.

MyDir := ExcludeTrailingBackslash('c:Windows');

// ---> MyDir = c:Windows

Delphi - .....................................

neoturk: ...Replace text in a text file ?...

procedure FileReplaceString(const FileName, searchstring, replacestring: string);

var

fs: TFileStream;

S: string;

begin

fs := TFileStream.Create(FileName, fmOpenread or fmShareDenyNone);

try

SetLength(S, fs.Size);

fs.ReadBuffer(S[1], fs.Size);

finally

fs.Free;

end;

S := StringReplace(S, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase]);

fs := TFileStream.Create(FileName, fmCreate);

try

fs.WriteBuffer(S[1], Length(S));

finally

fs.Free;

end;

Delphi - .....................................

neoturk: ...Replace text in a text file ?...

procedure FileReplaceString(const FileName, searchstring, replacestring: string);

var

fs: TFileStream;

S: string;

begin

fs := TFileStream.Create(FileName, fmOpenread or fmShareDenyNone);

try

SetLength(S, fs.Size);

fs.ReadBuffer(S[1], fs.Size);

finally

fs.Free;

end;

S := StringReplace(S, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase]);

fs := TFileStream.Create(FileName, fmCreate);

try

fs.WriteBuffer(S[1], Length(S));

finally

fs.Free;

end;

Delphi - .....................................

neoturk: ...Retrieve version information for a specified file ?...

uses

ShellApi;

type

TFileVersionInfo = record

FileType,

CompanyName,

FileDescription,

FileVersion,

InternalName,

LegalCopyRight,

LegalTradeMarks,

OriginalFileName,

ProductName,

ProductVersion,

Comments,

SpecialBuildStr,

PrivateBuildStr,

FileFunction: string;

DebugBuild,

PreRelease,

SpecialBuild,

PrivateBuild,

Patched,

InfoInferred: Boolean;

end;

function FileVersionInfo(const sAppNamePath: TFileName): TFileVersionInfo;

var

rSHFI: TSHFileInfo;

iRet: Integer;

VerSize: Integer;

VerBuf: PChar;

VerBufValue: Pointer;

VerHandle: Cardinal;

VerBufLen: Cardinal;

VerKey: string;

FixedFileInfo: PVSFixedFileInfo;

// dwFileType, dwFileSubtype

function GetFileSubType(FixedFileInfo: PVSFixedFileInfo): string;

begin

case FixedFileInfo.dwFileType of

VFT_UNKNOWN: Result := 'Unknown';

VFT_APP: Result := 'Application';

VFT_DLL: Result := 'DLL';

VFT_STATIC_LIB: Result := 'Static-link Library';

VFT_DRV:

case

FixedFileInfo.dwFileSubtype of

VFT2_UNKNOWN: Result := 'Unknown Driver';

VFT2_DRV_COMM: Result := 'Communications Driver';

VFT2_DRV_PRINTER: Result := 'Printer Driver';

VFT2_DRV_KEYBOARD: Result := 'Keyboard Driver';

VFT2_DRV_LANGUAGE: Result := 'Language Driver';

VFT2_DRV_DISPLAY: Result := 'Display Driver';

VFT2_DRV_MOUSE: Result := 'Mouse Driver';

VFT2_DRV_NETWORK: Result := 'Network Driver';

VFT2_DRV_SYSTEM: Result := 'System Driver';

VFT2_DRV_INSTALLABLE: Result := 'InstallableDriver';

VFT2_DRV_SOUND: Result := 'Sound Driver';

end;

VFT_FONT:

case FixedFileInfo.dwFileSubtype of

VFT2_UNKNOWN: Result := 'Unknown Font';

VFT2_FONT_RASTER: Result := 'Raster Font';

VFT2_FONT_VECTOR: Result := 'Vector Font';

VFT2_FONT_TRUETYPE: Result := 'Truetype Font';

else;

end;

VFT_VXD: Result := 'Virtual Defice Identifier = ' +

IntToHex(FixedFileInfo.dwFileSubtype, 8);

end;

function HasdwFileFlags(FixedFileInfo: PVSFixedFileInfo; Flag: Word): Boolean;

begin

Result := (FixedFileInfo.dwFileFlagsMask and

FixedFileInfo.dwFileFlags and

Flag) = Flag;

end;

function GetFixedFileInfo: PVSFixedFileInfo;

begin

if not VerQueryValue(VerBuf, '', Pointer(Result), VerBufLen) then

Result := nil

end;

function GetInfo(const aKey: string): string;

begin

Result := '';

VerKey := Format('StringFileInfo%.4x%.4x%s',

[LoWord(Integer(VerBufValue^)),

HiWord(Integer(VerBufValue^)), aKey]);

if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then

Result := StrPas(VerBufValue);

end;

function QueryValue(const aValue: string): string;

begin

Result := '';

// obtain version information about the specified file

if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and

// return selected version information

VerQueryValue(VerBuf, 'VarFileInfoTranslation', VerBufValue, VerBufLen) then

Result := GetInfo(aValue);

end;

begin

// Initialize the Result

with Result do

begin

FileType := '';

CompanyName := '';

FileDescription := '';

FileVersion := '';

InternalName := '';

LegalCopyRight := '';

LegalTradeMarks := '';

OriginalFileName := '';

ProductName := '';

ProductVersion := '';

Comments := '';

SpecialBuildStr := '';

PrivateBuildStr := '';

FileFunction := '';

DebugBuild := False;

Patched := False;

PreRelease := False;

SpecialBuild := False;

PrivateBuild := False;

InfoInferred := False;

end;

// Get the file type

if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),

SHGFI_TYPENAME) <> 0 then

begin

Result.FileType := rSHFI.szTypeName;

end;

iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), SHGFI_EXETYPE);

if iRet <> 0 then

begin

// determine whether the OS can obtain version information

VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);

if VerSize > 0 then

begin

VerBuf := AllocMem(VerSize);

try

with Result do

begin

CompanyName := QueryValue('CompanyName');

FileDescription := QueryValue('FileDescription');

FileVersion := QueryValue('FileVersion');

InternalName := QueryValue('InternalName');

LegalCopyRight := QueryValue('LegalCopyRight');

LegalTradeMarks := QueryValue('LegalTradeMarks');

OriginalFileName := QueryValue('OriginalFileName');

ProductName := QueryValue('ProductName');

ProductVersion := QueryValue('ProductVersion');

Comments := QueryValue('Comments');

SpecialBuildStr := QueryValue('SpecialBuild');

PrivateBuildStr := QueryValue('PrivateBuild');

// Fill the VS_FIXEDFILEINFO structure

FixedFileInfo := GetFixedFileInfo;

DebugBuild := HasdwFileFlags(FixedFileInfo, VS_FF_DEBUG);

PreRelease := HasdwFileFlags(FixedFileInfo, VS_FF_PRERELEASE);

PrivateBuild := HasdwFileFlags(FixedFileInfo, VS_FF_PRIVATEBUILD);

SpecialBuild := HasdwFileFlags(FixedFileInfo, VS_FF_SPECIALBUILD);

Patched := HasdwFileFlags(FixedFileInfo, VS_FF_PATCHED);

InfoInferred := HasdwFileFlags(FixedFileInfo, VS_FF_INFOINFERRED);

FileFunction := GetFileSubType(FixedFileInfo);

end;

finally

FreeMem(VerBuf, VerSize);

end

end;

end

end;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);

var

FvI: TFileVersionInfo;

const

Tabulator: array[0..0] of Integer = (70);

BoolValues: array[Boolean] of string = ('No', 'Yes');

begin

FvI := FileVersionInfo('C:FileName.exe');

ListBox1.TabWidth := 1;

SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator));

with FvI, ListBox1.Items do

begin

Add('FileType:'#9 + FileType);

Add('CompanyName:'#9 + CompanyName);

Add('FileDescription:'#9 + FileDescription); // siehe Eigenschaftsdialog des Explorers

Add('FileVersion:'#9 + FileVersion);

Add('InternalName:'#9 + InternalName);

Add('LegalCopyRight:'#9 + LegalCopyRight);

Add('LegalTradeMarks:'#9 + LegalTradeMarks);

Add('OriginalFileName:'#9 + OriginalFileName);

Add('ProductName:'#9 + ProductName);

Add('ProductVersion:'#9 + ProductVersion);

Add('SpecialBuildStr:'#9 + SpecialBuildStr);

Add('PrivateBuildStr:'#9 + PrivateBuildStr);

Add('FileFunction:'#9 + FileFunction);

Add('DebugBuild:'#9 + BoolValues[DebugBuild]);

Add('PreRelease:'#9 + BoolValues[PreRelease]);

Add('PrivateBuild:'#9 + BoolValues[PrivateBuild]);

Add('SpecialBuild:'#9 + BoolValues[SpecialBuild]);

end;

Delphi - .....................................

neoturk: ...Retrieve version information for a specified file ?...

uses

ShellApi;

type

TFileVersionInfo = record

FileType,

CompanyName,

FileDescription,

FileVersion,

InternalName,

LegalCopyRight,

LegalTradeMarks,

OriginalFileName,

ProductName,

ProductVersion,

Comments,

SpecialBuildStr,

PrivateBuildStr,

FileFunction: string;

DebugBuild,

PreRelease,

SpecialBuild,

PrivateBuild,

Patched,

InfoInferred: Boolean;

end;

function FileVersionInfo(const sAppNamePath: TFileName): TFileVersionInfo;

var

rSHFI: TSHFileInfo;

iRet: Integer;

VerSize: Integer;

VerBuf: PChar;

VerBufValue: Pointer;

VerHandle: Cardinal;

VerBufLen: Cardinal;

VerKey: string;

FixedFileInfo: PVSFixedFileInfo;

// dwFileType, dwFileSubtype

function GetFileSubType(FixedFileInfo: PVSFixedFileInfo): string;

begin

case FixedFileInfo.dwFileType of

VFT_UNKNOWN: Result := 'Unknown';

VFT_APP: Result := 'Application';

VFT_DLL: Result := 'DLL';

VFT_STATIC_LIB: Result := 'Static-link Library';

VFT_DRV:

case

FixedFileInfo.dwFileSubtype of

VFT2_UNKNOWN: Result := 'Unknown Driver';

VFT2_DRV_COMM: Result := 'Communications Driver';

VFT2_DRV_PRINTER: Result := 'Printer Driver';

VFT2_DRV_KEYBOARD: Result := 'Keyboard Driver';

VFT2_DRV_LANGUAGE: Result := 'Language Driver';

VFT2_DRV_DISPLAY: Result := 'Display Driver';

VFT2_DRV_MOUSE: Result := 'Mouse Driver';

VFT2_DRV_NETWORK: Result := 'Network Driver';

VFT2_DRV_SYSTEM: Result := 'System Driver';

VFT2_DRV_INSTALLABLE: Result := 'InstallableDriver';

VFT2_DRV_SOUND: Result := 'Sound Driver';

end;

VFT_FONT:

case FixedFileInfo.dwFileSubtype of

VFT2_UNKNOWN: Result := 'Unknown Font';

VFT2_FONT_RASTER: Result := 'Raster Font';

VFT2_FONT_VECTOR: Result := 'Vector Font';

VFT2_FONT_TRUETYPE: Result := 'Truetype Font';

else;

end;

VFT_VXD: Result := 'Virtual Defice Identifier = ' +

IntToHex(FixedFileInfo.dwFileSubtype, 8);

end;

function HasdwFileFlags(FixedFileInfo: PVSFixedFileInfo; Flag: Word): Boolean;

begin

Result := (FixedFileInfo.dwFileFlagsMask and

FixedFileInfo.dwFileFlags and

Flag) = Flag;

end;

function GetFixedFileInfo: PVSFixedFileInfo;

begin

if not VerQueryValue(VerBuf, '', Pointer(Result), VerBufLen) then

Result := nil

end;

function GetInfo(const aKey: string): string;

begin

Result := '';

VerKey := Format('StringFileInfo%.4x%.4x%s',

[LoWord(Integer(VerBufValue^)),

HiWord(Integer(VerBufValue^)), aKey]);

if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then

Result := StrPas(VerBufValue);

end;

function QueryValue(const aValue: string): string;

begin

Result := '';

// obtain version information about the specified file

if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and

// return selected version information

VerQueryValue(VerBuf, 'VarFileInfoTranslation', VerBufValue, VerBufLen) then

Result := GetInfo(aValue);

end;

begin

// Initialize the Result

with Result do

begin

FileType := '';

CompanyName := '';

FileDescription := '';

FileVersion := '';

InternalName := '';

LegalCopyRight := '';

LegalTradeMarks := '';

OriginalFileName := '';

ProductName := '';

ProductVersion := '';

Comments := '';

SpecialBuildStr := '';

PrivateBuildStr := '';

FileFunction := '';

DebugBuild := False;

Patched := False;

PreRelease := False;

SpecialBuild := False;

PrivateBuild := False;

InfoInferred := False;

end;

// Get the file type

if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),

SHGFI_TYPENAME) <> 0 then

begin

Result.FileType := rSHFI.szTypeName;

end;

iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), SHGFI_EXETYPE);

if iRet <> 0 then

begin

// determine whether the OS can obtain version information

VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);

if VerSize > 0 then

begin

VerBuf := AllocMem(VerSize);

try

with Result do

begin

CompanyName := QueryValue('CompanyName');

FileDescription := QueryValue('FileDescription');

FileVersion := QueryValue('FileVersion');

InternalName := QueryValue('InternalName');

LegalCopyRight := QueryValue('LegalCopyRight');

LegalTradeMarks := QueryValue('LegalTradeMarks');

OriginalFileName := QueryValue('OriginalFileName');

ProductName := QueryValue('ProductName');

ProductVersion := QueryValue('ProductVersion');

Comments := QueryValue('Comments');

SpecialBuildStr := QueryValue('SpecialBuild');

PrivateBuildStr := QueryValue('PrivateBuild');

// Fill the VS_FIXEDFILEINFO structure

FixedFileInfo := GetFixedFileInfo;

DebugBuild := HasdwFileFlags(FixedFileInfo, VS_FF_DEBUG);

PreRelease := HasdwFileFlags(FixedFileInfo, VS_FF_PRERELEASE);

PrivateBuild := HasdwFileFlags(FixedFileInfo, VS_FF_PRIVATEBUILD);

SpecialBuild := HasdwFileFlags(FixedFileInfo, VS_FF_SPECIALBUILD);

Patched := HasdwFileFlags(FixedFileInfo, VS_FF_PATCHED);

InfoInferred := HasdwFileFlags(FixedFileInfo, VS_FF_INFOINFERRED);

FileFunction := GetFileSubType(FixedFileInfo);

end;

finally

FreeMem(VerBuf, VerSize);

end

end;

end

end;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);

var

FvI: TFileVersionInfo;

const

Tabulator: array[0..0] of Integer = (70);

BoolValues: array[Boolean] of string = ('No', 'Yes');

begin

FvI := FileVersionInfo('C:FileName.exe');

ListBox1.TabWidth := 1;

SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator));

with FvI, ListBox1.Items do

begin

Add('FileType:'#9 + FileType);

Add('CompanyName:'#9 + CompanyName);

Add('FileDescription:'#9 + FileDescription); // siehe Eigenschaftsdialog des Explorers

Add('FileVersion:'#9 + FileVersion);

Add('InternalName:'#9 + InternalName);

Add('LegalCopyRight:'#9 + LegalCopyRight);

Add('LegalTradeMarks:'#9 + LegalTradeMarks);

Add('OriginalFileName:'#9 + OriginalFileName);

Add('ProductName:'#9 + ProductName);

Add('ProductVersion:'#9 + ProductVersion);

Add('SpecialBuildStr:'#9 + SpecialBuildStr);

Add('PrivateBuildStr:'#9 + PrivateBuildStr);

Add('FileFunction:'#9 + FileFunction);

Add('DebugBuild:'#9 + BoolValues[DebugBuild]);

Add('PreRelease:'#9 + BoolValues[PreRelease]);

Add('PrivateBuild:'#9 + BoolValues[PrivateBuild]);

Add('SpecialBuild:'#9 + BoolValues[SpecialBuild]);

end;

Delphi - .....................................

neoturk: ...Search a directory tree for a specified file ?...

uses

ImageHlp;

function SearchForFile(const ARootPath: string;

const AFileName: string;

var APathFound: string): Boolean;

var

Found: array[0..500] of Char;

begin

FillChar(Found, SizeOf(Found), #00);

Result := (SearchTreeForFile(PChar(ARootPath), PChar(AFileName), Found) = True);

APathFound := ExtractFilePath(Found);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

APathFound: string;

begin

if SearchForFile('C:WINDOWS', 'winhlp32.exe', APathFound) then

ShowMessage('winhlp32.exe found in: ' + APathFound);

end;

Delphi - .....................................

neoturk: ...Search a directory tree for a specified file ?...

uses

ImageHlp;

function SearchForFile(const ARootPath: string;

const AFileName: string;

var APathFound: string): Boolean;

var

Found: array[0..500] of Char;

begin

FillChar(Found, SizeOf(Found), #00);

Result := (SearchTreeForFile(PChar(ARootPath), PChar(AFileName), Found) = True);

APathFound := ExtractFilePath(Found);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

APathFound: string;

begin

if SearchForFile('C:WINDOWS', 'winhlp32.exe', APathFound) then

ShowMessage('winhlp32.exe found in: ' + APathFound);

end;