function GetFileList(FDirectory, Filter: TFileName): TStringList;
var
ARec: TSearchRec;
Res: Integer;
begin
if FDirectory[Length(FDirectory)] <> '\' then
FDirectory := FDirectory + '\';
Result := TStringList.Create;
try
Res := FindFirst(FDirectory + Filter, faAnyFile, ARec);
while Res = 0 do
begin
if FileExists(FDirectory + ARec.Name) then
Result.Add(FDirectory + ARec.Name);
Res := FindNext(ARec);
end;
FindClose(ARec);
except
Result.Free;
end;
end;
Author
Target
Keywords
Description
Win32.hlp ;-)
D2/D3/(D4?)
System, Icons
Get file icon, small or big.
//(Any file) File associated icon:
function fileAssIcon(filename:string; getSmallIcon: Boolean):HIcon;
var
shfi: TShFileInfo;
begin
if getSmallIcon then begin
try
FillChar(shfi, SizeOf(TShFileInfo), 0);
ShGetFileInfo(PChar(Filename), 0, shfi, SizeOf(TShFileInfo),
SHGFI_ICON or SHGFI_SMALLICON);
result := shfi.hIcon;
except
result := 0;
end;
end else begin
try
FillChar(shfi, SizeOf(TShFileInfo), 0);
ShGetFileInfo(PChar(Filename), 0, shfi,
SizeOf(TShFileInfo), SHGFI_ICON);
result := shfi.hIcon;
except
result := 0;
end;
end;
end;
(*********
I added the Try/Except block becouse Windows
trhowed an excetion in my face in one specific
directory all the time when getting icons from
files from there. After the a newly installed
directory it has never happened again, and now
one I asked have never had that cind of problem,
so use it if you want, but just in case.....
**********)
//(Specified file, exe,dll,ico...) Get icon from file by index
function fileIcon(filename:string; Index: Integer; getSmallIcon:
Boolean):HIcon;
var
hLarge, hSmall: THandle;
begin
ExtractIconEx( PChar(filename), 0, hLarge, hSmall, Index);
if getSmallIcon then
result := hSmall
else
result := hLarge;
end;
Author
Target
Keywords
Description
Bernt Levinsson
D2/D3/D4
System, Explorer, Execute
Lazy function for execute explorer.
function execExplorer(OpenAtPath: string; OpenWithExplorer,
OpenAsRoot: Boolean): boolean;
var
s: string;
begin
if OpenWithExplorer then begin
if OpenAsRoot then
s := ' /e,/root,"' + OpenAtPath + '"'
else
s := ' /e,"' + OpenAtPath + '"';
end else
s := '"' + OpenAtPath + '"';
result :=
ShellExecute(Application.Handle,PChar('open'),
PChar('explorer.exe'),PChar(s),nil,SW_NORMAL) > 32;
end;
(**
Remember:
Explorer.exe does also take command argument "/SELECT
'Application.ExeName'", nice when "uninstall" your
app and auto select the exe after open the "Folder/Explorer".
**)
Author
Target
Keywords
Description
Artem A. Berman
Win32
String, Position, Pos
Finding position of substr from given position.
function PosFromPos(SubStr, MainStr: string; Posit: Integer): Integer;
begin
MainStr := Copy(MainStr, Posit, Length(MainStr));
Result := Pos(SubStr, MainStr);
end;
Author
Target
Keywords
Description
M Adler
D1/D2/D3/D4
Application,ExePath,Path
Returns the program path
function progfile(filename:String):string;
var
st:string;
begin
st:= application.ExeName;
result:= extractfilepath(st)+filename;
end;
Author
Target
Keywords
Description
Artem A. Berman
D1/D2/D3/D4
Application,ExePath,Path
Returns the program path
function GetPath: TFileName ;
begin
result:= ExtractFilePath(ParamStr(0));
end;
Author
Target
Keywords
Description
Peter Hellinger
D3/D4
MessageDlg, Sound
Get MessageDlg with Sound
function MsgDlg (const msg: string; atype: TMsgDlgType; abuttons:
TMsgDlgButtons; helpctx: Longint): Word;
// Acts like MessageDlg, but using System-Sound
var mb: CARDINAL;
begin
case AType of
mtWarning: mb:= MB_ICONEXCLAMATION;
mtError: mb:= MB_ICONHAND;
mtInformation: mb:= MB_ICONASTERISK;
mtConfirmation: mb:= MB_ICONQUESTION;
else mb:= $0FFFFFFFF;
end;
MessageBeep (mb);
MsgDlg:= MessageDlg (msg, atype, abuttons, helpctx);
end (*MsgDlg*);
Author
Target
Keywords
Description
Daniel Szasz, Jaques Burger
D4/D5
System, Date, Week, Day
Getting the week number
function GetWeekNumber(aDateTime : TDateTime) : Word;
var
Y,M,D : Word;
WD: Word;
StartDate: TDateTime;
begin
DecodeDate( aDateTime, Y, M, D);
WD := DayOfTheWeek(EnCodeDate( Y, 1, 1));
if WD <= 4 then
StartDate := EnCodeDate( Y, 1, 1) - WD
else
StartDate := EnCodeDate( Y, 1, 1) + (7 - WD) + 1;
Result:= Trunc( aDateTime - StartDate) DIV 7;
Result := Result + 1;
end;
Author
Target
Keywords
Description
Anton Mints (developer@geocities.com ! http://devshed.da.ru)
D5
System, Enum
Obtaining a string version of an enumerated type.
procedure GetEnumNameList(Pti: PTypeInfo; AList:
TStrings; X: Integer);
(**********************************************************
Will return in AList string version of an
enumerated type less the first X characters .
eg X = 4
and
type
eXORBuySell = (
XOR_BUY,
XOR_SELL
);
GetEnumNameList(TypeInfo(eXORBuySell), ComboBox1.Items, 4);
Now ComboBox1.Items[0] = 'BUY'
and ComboBox1.Items[1] = 'SELL'
************************************************************)
var
I: Integer;
begin
AList.Clear;
with GetTypeData(pti)^ do
for I := MinValue to MaxValue do
AList.Add(Copy(GetEnumName(pti, I), X + 1, 255));
end;
Author
Target
Keywords
Description
Marius le Roux
langbaba_le_roux@hotmail.com
D1/D2/D3/D4/D5
File, Path, Delete
Make sure given file path is ended with backslash ("\").
{ Make sure given file path is ended with backslash ("\") }
function CheckPath (Path: string): string;
begin
Path := trim (Path);
if Path <> '' then
if Path[length (Path)] <> '\' then
Path := Path + '\';
Result := Path;
end;
Author
Target
Keywords
Description
Marius le Roux
langbaba_le_roux@hotmail.com
D1/D2/D3/D4/D5
File, Path, Delete
Clears Directory: Removes all files and directories contained
{ Make sure given file path is ended with backslash ("\") }
{ Clears Directory: Removes all files and directories contained }
function ClearDir (Path: string): boolean;
var
Res: integer;
SRec: TSearchRec;
begin
Result := false;
try
Path := CheckPath (Path);
Res := FindFirst (Path + '*.*', faAnyFile, SRec);
while Res = 0 do begin
if (SRec.Attr = faDirectory) and (SRec.Name[1] <> '.')
then begin
ClearDir (Path + SRec.Name); { Clear before removing }
if not RemoveDir (pchar(Path + SRec.Name)) then
exit;
end
else
DeleteFile(Path + SRec.Name);
Res := FindNext(SRec);
end;
FindClose(SRec);
Result := true;
except
on e:Exception do
MessageDlg (e.Message, mtError, [mbOk], 0);
end;
end;
