unit BCUtils;
interface
uses
Windows, Classes, SysUtils, ShlObj,
ActiveX, WindowsVersionInfo, TLHelp32,
StrUtils;
function GetSpecialBrowserFolder(ID: Integer):
String;
function ReverseStringByPair(AText:
String; APairSize: Integer):
String;
function RemoveBaseDir(Path, BaseDir:
String):
String;
function GoOneDirUp(Path:
String):
String;
function GetDirectorySize(Path:
String):Int64;
function GetFileSize(FileName:
String):Integer;
function ExtractFileNameFromShellString(Value:
String):
String;
procedure DeleteEmptyDirectories(Path:
String);
function GetShellFolder(CSIDL: integer):
string;
function HexStrToString(
const value:
string):
string;
function EncodeURL(
URL:
String):
String;
function DecodeURL(
URL:
String):
String;
function ExpandFileNameEx(Base, FileName:
String):
String;
function ExcludeBeginningPathDelimiter(Path:
String):
String;
function FileTimeStringsToDateTime(Low, High:
String):TDateTime;
function FileTimeToDateTime(FileTime:TFileTime):TDateTime;
function DateTimeToFileTime(Value: TDateTime):TFileTime;
function GethIcon(FileName:
String; icoSize: Cardinal; icoIndex: integer = 0): Cardinal;
function GetVersion(FileName:
string):
String;
function ProgIDExists(
const ProgID:WideString):Boolean;
function KillProcess(
const ExeName:
String):Boolean;
function processExists(exeFileName:
string): Boolean;
function GetCurrentUserName:
string;
procedure FindAllFiles(FileList: TStrings; RootFolder:
string; Mask:
string ='
*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
function Like(
const AString, APattern:
String): Boolean;
const
{ Avant Browser }
FID_AVANT_PROFILES = 1;
{ Google Chrome }
FID_GOOGLE_CHROME = 11;
FID_GOOGLE_CHROME_APP = 12;
{ Application Files (.exe, ...) }
FID_GOOGLE_CHROME_USERDATA = 13;
{ Profiles }
FID_GOOGLE_CHROME_PLUGINS = 14;
{ Microsoft Internet Explorer }
FID_IE_COOKIES = 21;
FID_IE_FAVORITES = 22;
FID_IE_CACHE = 23;
FID_IE_HISTORY = 24;
FID_IE_QUICKLAUNCH = 25;
{ Links in Windows TaskBar }
FID_IE_DHTMLBEHAVIORS = 26;
{ UserData directory }
FID_IE_DHTMLBEHAVIORS_LOW = 27;
{ " - WinVista, IE without admin rights}
FID_IE_COOKIES_LOW = 28;
{ Mozilla Firefox }
FID_MOZILLA_FF_PROFILES = 31;
{ Flock }
FID_FLOCK_PROFILES = 41;
{ Mozilla Seamonkey/Suite }
FID_MOZILLA_PROFILES = 51;
FID_MOZILLA_EXTENSIONS = 52;
{ Opera }
FID_OPERA_PROFILE = 61;
FID_OPERA_PROFILE_FEEDS = 62;
FID_OPERA_PROFILE_WIDGETS = 63;
FID_OPERA_PROFILE_CACHE = 64;
FID_OPERA_PROFILE_IMAGES = 65;
FID_OPERA_MAIL = 66;
{ K-Meleon }
FID_KMELEON_PROFILES = 71;
{ Flash }
FID_FLASH_SHAREDOBJECTS = 81;
{ Netscape }
FID_NETSCAPE_PROFILES = 91;
{ Safari }
FID_APPLE_SAFARI = 101;
{ Beonex Communicator }
FID_BEONEX_PROFILES = 111;
CSIDL_PROGRAM_FILES = $0026;
{C:\Program Files\}
CSIDL_WINDOWS = $0024;
{C:\Windows\}
implementation
{ utility methods }
function GetSpecialBrowserFolder(ID: Integer):
String;
var
WinVer: TWindowsVersionInfo;
begin
case ID
of
{ Avant Browser }
FID_AVANT_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Avant Profiles\';
{ Google Chrome }
FID_GOOGLE_CHROME: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Google\Chrome\';
FID_GOOGLE_CHROME_APP: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Google\Chrome\Application\';
FID_GOOGLE_CHROME_USERDATA: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Google\Chrome\User Data\';
FID_GOOGLE_CHROME_PLUGINS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Google\Chrome\Plugins\';
{ Microsoft Internet Explorer }
FID_IE_COOKIES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_COOKIES));
FID_IE_FAVORITES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_FAVORITES));
FID_IE_CACHE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_INTERNET_CACHE));
FID_IE_HISTORY: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_HISTORY));
FID_IE_QUICKLAUNCH: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Microsoft\Internet Explorer\Quick Launch\';
FID_IE_DHTMLBEHAVIORS:
begin
WinVer := TWindowsVersionInfo.Create(
nil);
if WinVer.MajorVersion = 5
then
Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_PROFILE)) + '
UserData\'
else
Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Microsoft\Internet Explorer\UserData\';
WinVer.Free;
end;
FID_IE_DHTMLBEHAVIORS_LOW: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Microsoft\Internet Explorer\UserData\Low\';
FID_IE_COOKIES_LOW: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_COOKIES)) + '
Low\';
{ Mozilla Firefox }
FID_MOZILLA_FF_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Mozilla\Firefox\Profiles\';
{ Flock }
FID_FLOCK_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Mozilla\Flock\Profiles\';
{ Mozilla Seamonkey/Suite }
FID_MOZILLA_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Mozilla\Profiles\';
FID_MOZILLA_EXTENSIONS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Mozilla\Extensions\';
{ Opera }
FID_OPERA_PROFILE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Opera\Opera\profile\';
FID_OPERA_PROFILE_FEEDS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Opera\Opera\profile\webfeeds\';
FID_OPERA_PROFILE_WIDGETS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Opera\Opera\profile\widgets';
FID_OPERA_PROFILE_CACHE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Opera\Opera\profile\cache4\';
FID_OPERA_PROFILE_IMAGES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Opera\Opera\profile\images\';
FID_OPERA_MAIL: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + '
Opera\Opera\mail\';
{ K-Meleon }
FID_KMELEON_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
K-Meleon\';
{ Flash }
FID_FLASH_SHAREDOBJECTS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA) + '
Macromedia\Flash Player\#SharedObjects\');
{ Netscape }
FID_NETSCAPE_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Netscape\Profiles\';
{ Safari }
FID_APPLE_SAFARI: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Apple Computer\Safari\';
{ Beonex Communicator }
FID_BEONEX_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + '
Beonex\Profiles\';
else
Result := IncludeTrailingPathDelimiter(GetShellFolder(ID));
end;
if not DirectoryExists(Result)
then
Result := '
';
end;
function ReverseStringByPair(AText:
String; APairSize: Integer):
String;
var
i, x, CharIndex: Integer;
begin
CharIndex := 1;
Result := '
';
for i := Length(AText)
div APairSize
downto 1
do
begin
for x := 1
to APairSize
do
Result := Result + AText[CharIndex + x];
CharIndex := CharIndex + APairSize;
end;
end;
function RemoveBaseDir(Path, BaseDir:
String):
String;
begin
Result := StringReplace(Path, BaseDir, '
', [rfIgnoreCase]);
if Result[1] = PathDelim
then
Result := Copy(Result, 2, Length(Result) - 1);
end;
function GoOneDirUp(Path:
String):
String;
begin
Result := ExcludeTrailingPathDelimiter(Path);
Result := ExtractFilePath(Result);
end;
function GetDirectorySize(Path:
String):Int64;
var
Files: TStrings;
i: Integer;
begin
Files := TStringList.Create;
FindAllFiles(Files, Path, '
*', True, False, True);
Result := 0;
for i := 0
to Files.Count -1
do
Result := Result + GetFileSize(Files[i]);
Files.Free;
end;
function GetFileSize(FileName:
String):Integer;
var
FileHandle: THandle;
begin
FileHandle := CreateFile(PChar(FileName), GENERIC_READ, 0,
nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := Windows.GetFileSize(FileHandle,
nil);
if Result < 0
then
Result := 0;
CloseHandle(FileHandle);
end;
function ExtractFileNameFromShellString(Value:
String):
String;
begin
Result := Value;
if not FileExists(Result)
then
begin
Result := Copy(Result, pos('
"', Result) + 1, posEx('
"', Result, pos('
"', Result) + 1) - 2);
if not FileExists(Result)
then
Result := '
';
end;
end;
procedure DeleteEmptyDirectories(Path:
String);
var
iFolder, iFile: Integer;
Folders, Files: TStrings;
begin
Folders := TStringList.Create;
FindAllFiles(Folders, Path, '
*', False, True, True);
for iFolder := Folders.Count -1
downto 0
do
begin
Files := TStringList.Create;
FindAllFiles(Files, Folders[iFolder], '
*', True, True, True);
for iFile := Files.Count -1
downto 0
do
begin
if DirectoryExists(Files[iFile])
then
DeleteEmptyDirectories(Path);
end;
if Files.Count > 0
then
RemoveDir(Folders[iFolder]);
Files.Free;
end;
Folders.Free;
end;
function HexStrToString(
const value:
string):
string;
begin
SetLength(Result, Length(value)
div 2);
if Length(value) > 0
then
HexToBin(PChar(value), PChar(Result), Length(value));
end;
function EncodeURL(
URL:
String):
String;
begin
Result :=
URL;
Result := StringReplace(Result, '
', '
%20', [rfReplaceAll]);
Result := StringReplace(Result, '
!', '
%21', [rfReplaceAll]);
Result := StringReplace(Result, '
"', '
%22', [rfReplaceAll]);
Result := StringReplace(Result, '
$', '
%24', [rfReplaceAll]);
Result := StringReplace(Result, '
''
', '
%27', [rfReplaceAll]);
Result := StringReplace(Result, '
(', '
%28', [rfReplaceAll]);
Result := StringReplace(Result, '
)', '
%29', [rfReplaceAll]);
Result := StringReplace(Result, '
*', '
%2A', [rfReplaceAll]);
Result := StringReplace(Result, '
+', '
%2B', [rfReplaceAll]);
Result := StringReplace(Result, '
;', '
%3B', [rfReplaceAll]);
Result := StringReplace(Result, '
<', '
%3C', [rfReplaceAll]);
Result := StringReplace(Result, '
>', '
%3E', [rfReplaceAll]);
Result := StringReplace(Result, '
@', '
%40', [rfReplaceAll]);
Result := StringReplace(Result, '
[', '
%5B', [rfReplaceAll]);
Result := StringReplace(Result, '
]', '
%5D', [rfReplaceAll]);
Result := StringReplace(Result, '
^', '
%5E', [rfReplaceAll]);
Result := StringReplace(Result, '
{', '
%7B', [rfReplaceAll]);
Result := StringReplace(Result, '
|', '
%7C', [rfReplaceAll]);
Result := StringReplace(Result, '
}', '
%7D', [rfReplaceAll]);
end;
function DecodeURL(
URL:
String):
String;
var
temp:
String;
EOS: Boolean;
//end of string ;-)
begin
EOS := False;
temp :=
URL;
while not EOS
do
begin
Result := Result + Copy(temp, 1, pos('
%', temp) - 1);
Result := Result + HexStrToString(Copy(temp, pos('
%', temp) + 1, 2));
Delete(temp, 1, pos('
%', temp) + 2);
if pos('
%', temp) = 0
then
begin
Result := Result + temp;
EOS := True;
end;
end;
end;
function ExpandFileNameEx(Base, FileName:
String):
String;
begin
Result := IncludeTrailingPathDelimiter(Base) +
ExcludeBeginningPathDelimiter(FileName);
end;
function ExcludeBeginningPathDelimiter(Path:
String):
String;
var
AllRemoved: Boolean;
begin
Result := Path;
AllRemoved := False;
while not AllRemoved
do
begin
if (Result[1] = '
\')
or (Result[1] = '
/')
then
Delete(Result, 1, 1)
else
AllRemoved := True;
end;
end;
function FileTimeStringsToDateTime(Low, High:
String):TDateTime;
var
ft: TFileTime;
begin
ft.dwLowDateTime := StrToInt64(Low);
ft.dwHighDateTime := StrToInt64(High);
Result := FileTimeToDateTime(ft);
end;
function FileTimeToDateTime(FileTime: TFileTime):TDateTime;
var
LocalTime: TFileTime;
SystemTime: TSystemTime;
begin
Result := EncodeDate(1900,1,1);
if FileTimeToLocalFileTime(FileTime, LocalTime)
then
if FileTimeToSystemTime(LocalTime, SystemTime)
then
Result := SystemTimeToDateTime(SystemTime);
end;
function DateTimeToFileTime(Value: TDateTime):TFileTime;
var
SystemTime: TSystemTime;
begin
DateTimeToSystemTime(Value, SystemTime);
SystemTimeToFileTime(systemtime, Result);
end;
{ ThirdParty routines }
function GethIcon(FileName:
String; icoSize: Cardinal; icoIndex: integer = 0): Cardinal;
var DeskTopISF: IShellFolder; IExIcon: IExtractIcon; PathPidl: PItemIDList; hIconL, hIconS: HIcon;
begin
Result := 0;
if SHGetDesktopFolder(DeskTopISF) <> NOERROR
then Exit;
PathPidl :=
nil;
if DeskTopISF.GetUIObjectOf(0, 1, PathPidl, IID_IExtractIconA,
nil, IExIcon) <> NOERROR
then Exit;
if (IExIcon.Extract(PChar(FileName), icoIndex, hIconL, hIconS,
icoSize
or (16
shl 16)) = NOERROR)
and (hIconL <> 0)
then Result := hIconL;
DestroyIcon(hIconS);
end;
{ unknown author}
function processExists(exeFileName:
string): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := False;
while Integer(ContinueLoop) <> 0
do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName)))
then
begin
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
{ unknown author}
function KillProcess(
const ExeName:
String):Boolean;
var
Process: TProcessEntry32;
h: THandle;
begin
Result := False;
Process.dwSize := SizeOf(Process);
h := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
if Process32First(h, Process)
then
repeat
if AnsiLowerCase(Process.szExeFile) = AnsiLowerCase(ExeName)
then Result := TerminateProcess(OpenProcess(Process_Terminate, False, Process.th32ProcessID), 0);
until (
not Process32Next(h, Process))
or Result;
finally
CloseHandle(h);
end;
end;
{ unknown author}
{$WARNINGS OFF}
function GetVersion(FileName:
string):
String;
var
VerInfoSize, VerValueSize, Dummy: DWord;
VerInfo : Pointer;
VerValue : PVSFixedFileInfo;
Major, Minor, Release, Build: DWORD;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
if VerInfoSize <> 0
then
begin
GetMem(VerInfo, VerInfoSize);
try
GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, VerInfo);
if VerInfo <>
nil then
begin
if VerQueryValue(VerInfo, '
\', Pointer(VerValue), VerValueSize)
then
begin
with VerValue^
do
begin
Major := dwFileVersionMS
shr 16;
Minor := dwFileVersionMS
and $FFFF;
Release := dwFileVersionLS
shr 16;
Build := dwFileVersionLS
and $FFFF;
end;
end;
end;
finally
FreeMem(VerInfo, VerInfoSize);
end;
end;
Result := Format('
%d.%d.%d.%d', [major, Minor, Release, Build]);
end;
{ Manuel Faux }
{$WARNINGS ON}
function ProgIDExists(
const ProgID:WideString):Boolean;
var
tmp : TGUID;
begin
Result := Succeeded(CLSIDFromProgID(PWideChar(ProgID), tmp));
end;
{ Michael Puff }
function GetCurrentUserName:
string;
const
cnMaxUserNameLen = 254;
var
sUserName:
string;
dwUserNameLen: DWORD;
begin
dwUserNameLen := cnMaxUserNameLen - 1;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen);
SetLength(sUserName, dwUserNameLen);
Result := sUserName;
end;
{ unknown author }
procedure FindAllFiles(FileList: TStrings; RootFolder:
string; Mask:
string ='
*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder:
String);
var LSearchRec: TSearchRec;
begin
if FindFirst(AParentFolder + '
*', faAnyFile, LSearchRec) = 0
then
begin
repeat
if (LSearchRec.
Name <> '
.')
and (LSearchRec.
Name <> '
..')
then
begin
if LSearchRec.Attr
and faDirectory = faDirectory
then
begin
if AddFolderNames
and
(IgnoreMaskAtFolderNames
or Like(AnsiLowerCase(LSearchRec.
Name), Mask))
then
FileList.AddObject(AParentFolder + LSearchRec.
Name, TObject(True));
if Recurse
then
LFindAllFiles(AParentFolder + LSearchRec.
Name + '
\');
end
else if Like(AnsiLowerCase(LSearchRec.
Name), Mask)
then
FileList.AddObject(AParentFolder + LSearchRec.
Name, TObject(False));
end;
until FindNext(LSearchRec) <> 0;
FindClose(LSearchRec);
end;
end;
begin
Mask := AnsiLowerCase(Mask);
LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;
{Michael Puff & SirThornberry}
function GetShellFolder(CSIDL: integer):
string;
var
pidl : PItemIdList;
FolderPath :
string;
SystemFolder : Integer;
Malloc : IMalloc;
begin
Malloc :=
nil;
FolderPath := '
';
SHGetMalloc(Malloc);
if Malloc =
nil then
begin
Result := FolderPath;
Exit;
end;
try
SystemFolder := CSIDL;
if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl))
then
begin
SetLength(FolderPath, max_path);
if SHGetPathFromIDList(pidl, PChar(FolderPath))
then
begin
SetLength(FolderPath, length(PChar(FolderPath)));
end;
end;
Result := IncludeTrailingPathDelimiter(FolderPath);
finally
Malloc.Free(pidl);
end;
end;
{ Michael Puff }
function Like(
const AString, APattern:
String): Boolean;
var
StringPtr, PatternPtr: PChar;
StringRes, PatternRes: PChar;
begin
Result:=false;
StringPtr:=PChar(AString);
PatternPtr:=PChar(APattern);
StringRes:=nil;
PatternRes:=nil;
repeat
repeat // ohne vorangegangenes "*"
case PatternPtr^
of
#0:
begin
Result:=StringPtr^=#0;
if Result
or (StringRes=nil)
or (PatternRes=nil)
then
Exit;
StringPtr:=StringRes;
PatternPtr:=PatternRes;
Break;
end;
'
*':
begin
inc(PatternPtr);
PatternRes:=PatternPtr;
Break;
end;
'
?':
begin
if StringPtr^=#0
then
Exit;
inc(StringPtr);
inc(PatternPtr);
end;
else begin
if StringPtr^=#0
then
Exit;
if StringPtr^<>PatternPtr^
then begin
if (StringRes=nil)
or (PatternRes=nil)
then
Exit;
StringPtr:=StringRes;
PatternPtr:=PatternRes;
Break;
end
else begin
inc(StringPtr);
inc(PatternPtr);
end;
end;
end;
until false;
repeat // mit vorangegangenem "*"
case PatternPtr^
of
#0:
begin
Result:=true;
Exit;
end;
'
*':
begin
inc(PatternPtr);
PatternRes:=PatternPtr;
end;
'
?':
begin
if StringPtr^=#0
then
Exit;
inc(StringPtr);
inc(PatternPtr);
end;
else begin
repeat
if StringPtr^=#0
then
Exit;
if StringPtr^=PatternPtr^
then
Break;
inc(StringPtr);
until false;
inc(StringPtr);
StringRes:=StringPtr;
inc(PatternPtr);
Break;
end;
end;
until false;
until false;
end;
{Michael Winter}
end.