I want to add version informations (for a specific language) to another exes that does not have such informations (at all).
I tried with BeginUpdateResource/UpdateResource/EndUpdateResource but all I succedeed is to create "Version >> 1 >> Unknown string", not "Version >> 1 >> CompanyName/VersionNumber/Description..." and their values.
I searched on Google and here but I couldn't find something useful. Only incomplete code which I didn't know how to finish.
Thank you.
Edit:
Here is the code that I use now:
procedure SetExeInfo(const ExeName, ResName, ResValue: string);
var
ResourceHandle: THandle;
DataLength: DWord;
Data: array of Char;
Ok: Boolean;
i: Integer;
begin
ResourceHandle := BeginUpdateResource(pChar(ExeName), False);
if (ResourceHandle <> 0) then
begin
DataLength := 8;
SetLength(Data, 8);
for i := 0 to 7 do
Data[i] := 'z';
Ok := True;
if (not UpdateResource(ResourceHandle, RT_VERSION, pChar(#49#0), LANG_SYSTEM_DEFAULT {MakeLangID(LANG_NEUTRAL, SUBLANG_NEUTRAL)}, Data, DataLength)) then
Ok := False;
if (not EndUpdateResource(ResourceHandle, False)) then
Ok := False;
if (Ok) then
ShowMessage('Update of resources successful!')
else
ShowMessage('Update of resources failed!');
end;
end;
Last edit:
I haven't specified in my question that I can't transfer the informations from another exe because I haven't seen the point to do this, since I haven't said specifically that I take the version info from another exe. Looks I was wrong, sorry.
Here is some working code to add or replace the version numbers:
type
VERSIONHEADER = packed record
wLength: word;
wValueLength: word;
wType: word;
Key: array[0..16] of WideChar; // 'VS_VERSION_INFO'
Version: VS_FIXEDFILEINFO;
end;
(...)
var ToolPath: TFileName; // = exe containing a reference version resource
ExeFullPath: TFileName; // = destination exe
Maj, Min: cardinal; // expected UPDATED Version number
VersionHandle, VersionRes: THandle;
VersionSize: DWORD;
Version: array of AnsiChar;
Ver: ^VERSIONHEADER;
(...)
VersionSize := GetFileVersionInfoSize(pointer(ToolPath),VersionHandle);
if (VersionSize<>0) and (Maj<>0) then
begin
SetLength(Version,VersionSize);
Ver := pointer(Version);
GetFileVersionInfo(pointer(ToolPath),0,VersionSize,Ver);
if Ver^.Version.dwSignature=$feef04bd then
begin
Ver^.Version.dwFileVersionMS := MAKELONG(Min,Maj);
Ver^.Version.dwProductVersionMS := Ver^.Version.dwFileVersionMS;
VersionRes := BeginUpdateResource(Pointer(ExeFullPath),False);
UpdateResource(VersionRes,RT_VERSION,MAKEINTRESOURCE(VS_VERSION_INFO),
1033,Ver,VersionSize);
EndUpdateResource(VersionRes,false);
end;
end;
It will add or update the numeric version numbers of an existing executable (ExeFullPath), replacing it with a supplied executable resource (ToolPath - may be paramstr(0) to copy some existing generic version information, or even ExeFullPath to update the version numbers).
RT_VERSION resource is not just eight bytes long. It's VERSIONINFO instead, with fixed size and variable strings. See VERSIONINFO resource - MSDN for details.
CodeProject has some sample code for you: Updating version information at run-time.
Related
So i have a 'downloads' folder where i put everything i download in my day by day work. You know we always automate everything, so I'm trying to build a simply app to run everyday to delete files older than 30 days, as i have to do this manually from time to time to avoid the folder become too big.
Here is my code :
function TForm1.deleteOldDownloads: boolean;
var
f: string;
i, d: Integer;
var
sl: tstringlist;
begin
try
FileListBox1.Directory := '\\psf\home\downloads';
FileListBox1.refresh;
sl := tstringlist.create;
for i := 0 to FileListBox1.items.count - 1 do
begin
f := FileListBox1.Directory + '\' + FileListBox1.items[i];
if fileexists(f) then
d := daysbetween(FileAge(f), now)
else
d := 0;
if d > 30 then // problem is here, d is always a big number, not the actually age of file
sl.Add(f);
end;
if sl.count > 0 then
begin
for i := 0 to sl.count do
begin
f := sl[i];
deletefile(f);
end;
end;
sl.Free;
except
on e: Exception do
begin
end;
end;
Problem is "d" variable is returning very big numbers like 1397401677, even if the file has only 1 day.
The only detail here is i run Windows in a Parallels virtual machine and the "\psf\home\downloads" folder is on Mac, but i can access this folderl normally using Windows Explorer, so for Delphi is like a regular local folder.
What am i missing ?
Did you read the documentation for FileAge? The first day in programming school, you are taught "When you start using a new function or API, you begin by reading its documentation." In this case, the function's documentation says
The [one-argument] overloaded version of FileAge is deprecated.
So you are using a function you shouldn't be using.
Still, this function should probably still work.
But what do you expect it to return? Well, obviously the thing that the docs say it should return:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime function.
But when you use this in DaysBetween, you assume it already is a TDateTime!
Why is FileAge returning unexpected values?
It isn't. It is probably returning exactly the thing its documentation says it should return.
You are using the older version of FileAge() that returns a timestamp in DOS numeric format, but you are treating it as a TDateTime, which it is not. As the FileAge documentation says:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime() function.
So, do what the documentation says to do, eg:
var
age: Integer;
age := FileAge(f);
if age <> -1 then
d := DaysBetween(FileDateToDateTime(age), Now)
Otherwise, use the newer version of FileAge() that outputs a TDateTime to begin with, eg:
var
dt: TDateTime;
if FileAge(f, dt) then
d := DaysBetween(dt, Now)
This is NOT a direct answer to your question, but I cannot post it as a comment.
So, the thing is, you should never delete user files directly. What if you make a mistake? What if the user of your program makes a mistake?
Always delete files to Recycle Bin:
{--------------------------------------------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
Old name: Trashafile
Note related to UNC: The function won't move a file to the RecycleBin if the file is UNC. MAYBE it was moved to the remote's computer RecycleBin
--------------------------------------------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0); { ATENTION! This last #0 is MANDATORY. See this for details: http://stackoverflow.com/questions/6332259/i-cannot-delete-files-to-recycle-bin - Although this member is declared as a single null-terminated string, it is actually a buffer that can hold multiple null-delimited file names. Each file name is terminated by a single NULL character. The last file name is terminated with a double NULL character ("\0\0") to indicate the end of the buffer }
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
//DEBUG ONLY if Result<> 0 then Mesaj('last error: ' + IntToStr(Result)+ CRLF+ 'last error message: '+ SysErrorMessage(Result));
//if fos.fAnyOperationsAborted = True then Result:= -1;
end;
Also, you don't need that obsolete control to get the files in a folder. You can use this:
{ FIND FILES }
function ListFilesOf(CONST aFolder, FileType: string; CONST ReturnFullPath, DigSubdirectories: Boolean): TStringList;
{ If DigSubdirectories is false, it will return only the top level files,
else it will return also the files in subdirectories of subdirectories.
If FullPath is true the returned files will have full path.
FileType can be something like '*.*' or '*.exe;*.bin'
Will show also the Hidden/System files.
Source Marco Cantu Delphi 2010 HandBook
// Works with UNC paths}
VAR
i: Integer;
s: string;
SubFolders, filesList: TStringDynArray;
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
procedure ListFiles(CONST aFolder: string);
VAR strFile: string;
begin
Predicate:=
function(const Path: string; const SearchRec: TSearchRec): Boolean
VAR Mask: string;
begin
for Mask in MaskArray DO
if System.Masks.MatchesMask(SearchRec.Name, Mask)
then EXIT(TRUE);
EXIT(FALSE);
end;
// Long paths will raise an EPathTooLongexception exception, so we simply don't process those folders
if Length(aFolder) > MAXPATH
then exit;
filesList:= TDirectory.GetFiles (aFolder, Predicate);
for strFile in filesList DO
if strFile<> '' { Bug somewhere here: it returns two empty entries ('') here. Maybe the root folder? }
then Result.Add(strFile);
end;
begin
{ I need this in order to prevent the EPathTooLongexception (reported by some users) }
if aFolder.Length >= MAXPATH then
begin
MesajError('Path is longer than '+ IntToStr(MAXPATH)+ ' characters!');
EXIT(NIL);
end;
if NOT System.IOUtils.TDirectory.Exists (aFolder)
then RAISE exception.Create('Folder does not exist! '+ CRLF+ aFolder);
Result:= TStringList.Create;
{ Split FileType in subcomponents }
MaskArray:= System.StrUtils.SplitString(FileType, ';');
{ Search the parent folder }
ListFiles(aFolder);
{ Search in all subfolders }
if DigSubdirectories then
begin
SubFolders:= TDirectory.GetDirectories(aFolder, TSearchOption.soAllDirectories, NIL);
for s in SubFolders DO
begin
if ccIO.DirectoryExists(s) { This solves the problem caused by broken 'Symbolic Link' folders }
then ListFiles(s);
end;
end;
{ Remove full path }
if NOT ReturnFullPath then
for i:= 0 to Result.Count-1 DO
Result[i]:= TPath.GetFileName(Result[i]);
end;
The code above is from: https://github.com/GodModeUser/Delphi-LightSaber
I'm trying to read a .MEM file using Delphi. It's a FoxPro Memory Variable Files. I've tried to read using TFileStream and load into TStringList. But, it only returns the first word.
F := TFileStream.Create(sFile, fmOpenRead);
L := TStringList.Create;
try
F.Position := 0;
L.LoadFromStream(F);
ShowMessage(L.Text);
finally
F.Free;
L.Free;
end;
The reason is because I want to migrate some useful .MEM values from an old program to my new program. Thanks for any help.
If it's a one-time affair and you have access to a VFP installation - i.e. the IDE, not only the runtime - then David Heffernan's suggestion is certainly the most sensible way. In this case you can load and inspect the .MEM via
release all extended && to clear away all existing memvars
restore from foo && assuming the file in question is named FOO.MEM
activate window Locals && inspect the variables...
list memory to foo && or list them to FOO.TXT
modify file foo.txt
However, LIST MEMORY (and DISPLAY MEMORY) also include all the system variables - the things that start with an underscore - which would need to be parsed off.
If it's an ongoing affair - repeated imports necessary - and you know which variables you need then there are two fairly clean and easy ways.
The first is only valid if a VFP IDE is installed on the computer on which the Delphi program is to be run. In this case you can instantiate VFP from Delphi (leave it invisible), have it read the .MEM and then query individual variables:
procedure fetch_variables_from_MEM (mem_filename: string; var_list: CFoos);
var
fox: Variant;
foo: CFoo;
begin
fox := CreateOleObject('VisualFoxpro.Application.9');
try
fox.DoCmd('release all extended');
fox.DoCmd('restore from ' + mem_filename);
for foo in var_list do
foo.Value := fox.Eval('m.' + foo.Name);
finally
fox.Quit; // AutoQuit not supported
end;
end;
I glossed over some details, like that CoInitialize() needs to be called on the thread somewhere before calling this, and I assumed suitable definitions for the variable list (a list/collection of hypothetical CFoo objects), but the sketched outline works - even in 64-bit Delphi.
The advantage is that things like datetime values arrive as TDateTime by virtue of the COM infrastructure and the use of variants.
The second easy way is applicable if an IDE is not available on the machine where the Delphi program is to be used but you have access to an IDE somewhere, so that you can build a small COM server:
define class FoxWrapper as custom olepublic
function Eval (cExpression as string) as variant
return evaluate(m.cExpression)
procedure DoCmd (cCommand as string)
&cCommand
enddefine
This can then be used instead of "VisualFoxPro.Application.9" in the example above. Note: for 64-bit Delphi you need to build this as an out-of-process server (i.e. an EXE). Also, this may run afoul of the VFP licence conditions.
For accessing the data directly, here's some quick & dirty Delphi code that I modelled after some FoxPro stuff that I coded eons ago and updated for VFP9. This is proof-of-principle code with simplified array handling and other compromises for the sake of exposition; it lacks all the production-quality noise necessitated by Delphi's half-assed language definition and its quarter-assed runtime.
type
TMEMVarHeader = packed record
var_name: array [0..10] of AnsiChar;
mem_type: AnsiChar; // 0ACDHLNOQYacdhlnoqy
big_size: UInt32; // only if mem_type == 'H'
width : Byte; // special meaning if mem_type == 'H'
decimals: Byte;
padding : array [0..13] of Byte; // 0 0 0 0 0 0 0 3 0 0 0 0 0 0
end;
SizeOf_TMEMVarHeader_eq_32 = true .. SizeOf(TMEMVarHeader) = 32;
TMEMVarInfo = record
header: TMEMVarHeader;
null_t: AnsiChar;
name : AnsiString;
value : Variant;
function ReadFromStream (stream: TStream): Boolean; // false if EOF
end;
function TMEMVarInfo.ReadFromStream (stream: TStream): Boolean;
const
DELPHI_EPOCH = 2415019.0;
var
header_bytes_read: Integer;
name_length: UInt16;
text_length: UInt32;
array_dim_1: UInt16;
array_dim_2: UInt16;
d: TDate; // 64-bit double
l: Boolean;
n: Double; // 64-bit double
q: array of Byte;
c: AnsiString;
t: TDateTime; // 64-bit double
y: Int64;
binary: Boolean;
i: Cardinal;
a: array of Variant;
v: TMEMVarInfo;
begin
name := ''; value := Unassigned;
header_bytes_read := stream.Read(header, SizeOf(header));
if header_bytes_read <> Sizeof(header) then begin
if not ((header_bytes_read = 1) and (header.var_name[0] = #26)) then
raise Exception.Create('unexpected MEM file format (problem reading header)');
result := false; // EOF
EXIT;
end;
result := true;
// variable name
if header.var_name[0] = #0 then begin // long variable name
assert(header.mem_type = LoCase(header.mem_type));
stream.ReadBuffer(name_length, Sizeof(name_length));
SetLength(name, name_length);
stream.ReadBuffer(name[1], name_length);
end else begin
assert(header.mem_type = UpCase(header.mem_type));
name := header.var_name;
end;
// variable value
case UpCase(header.mem_type) of
'A':
begin
stream.ReadBuffer(array_dim_1, SizeOf(array_dim_1));
stream.ReadBuffer(array_dim_2, SizeOf(array_dim_2));
if array_dim_2 = 0 then // it's a vector, not an array
array_dim_2 := 1;
SetLength(a, array_dim_1 * array_dim_2);
for i := 0 to array_dim_1 * array_dim_2 - 1 do begin
if not v.ReadFromStream(stream) then
raise Exception.Create('error reading array element');
a[i] := v.value;
end;
value := a;
end;
'0': begin stream.ReadBuffer(null_t, 1); value := Null; end;
'C', 'H', 'Q':
begin
if UpCase(header.mem_type) = 'H' then begin // length > 254
binary := header.width <> 0;
text_length := header.big_size;
end else begin
binary := UpCase(header.mem_type) = 'Q';
text_length := header.width;
end;
if binary then begin
SetLength(q, text_length); stream.ReadBuffer(q[0], text_length); value := q;
end else begin
SetLength(c, text_length); stream.ReadBuffer(c[1], text_length); value := c;
end;
end;
'D': begin stream.ReadBuffer(d, Sizeof(d)); if d > 0 then d := d - DELPHI_EPOCH; VarCast(value, d, varDate); end;
'L': begin stream.ReadBuffer(l, Sizeof(l)); value := l; end;
'N': begin stream.ReadBuffer(n, Sizeof(n)); value := n; end;
'T': begin stream.ReadBuffer(t, Sizeof(t)); if t > 0 then t := t - DELPHI_EPOCH; value := t; end;
'Y': begin stream.ReadBuffer(y, Sizeof(y)); VarCast(value, y / 10000.0, varCurrency); end;
else
raise Exception.Create('unexpected type ''' + header.mem_type + ''' in MEM file');
end;
end;
For reading a .MEM, create a TFileStream and a TMEMVarInfo variable, then read variables one by one until var_info.ReadFromStream(stream) returns false.
Note: the byte at offset 19h (shown as 3 in the structure comment) is a code page identifier. The values are the same as those found in .DBF headers, i.e. 1 for DOS 437, 3 for Windows 1252 and so on. However, even though VFP stores these identifiers when writing a .MEM, all the newer versions of VFP that I tested completely ignore these code page marks when loading a .MEM. A self-written importer could put the code page marks to good use, though.
Reading the binary .mem files is not the correct way to proceed. The correct solution is to get VFP to export the data. It knows how to read it. Get VFP to export to a known format, and read that. This is the standard approach to data migration.
I am trying to use the system.filesize function to get the size of a file in delphi, it works ok for files < 4GB but fails for files > 4GB.
so i implemented my own that opens the required file as a filestream and gets the streamsize which works perfectly.
Here is a Snippet
function GiveMeSize(PathtoFile : string): int64;
var
stream : TFileStream;
size : int64;
begin
try
stream := TFileStream.Create(PathtoFile, fmOpenReadWrite or fmShareDenyNone);
size := stream.size;
except
showmessage('Unable to get FileSize');
end
finally
stream.free;
end;
but the problem with my above function is that it opens the file which incurs some overhead when processing a large number of files.
is there any function that can get filesize of files > 4GB without opening the file first?
I have tried some functions online but they tend to report wrong file size for files greater than 4GB.
Delphi Version : XE5
Thanks.
System.FileSize is a Pascal I/O function that operates on Pascal File variables. If you want to get the size of a file specified by path, then System.FileSize is simply wrong function to use.
What's more, you quite likely don't want to open the file just to obtain its size. I obtain the file size like this:
function FileSize(const FileName: string): Int64;
var
AttributeData: TWin32FileAttributeData;
begin
if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #AttributeData) then
begin
Int64Rec(Result).Lo := AttributeData.nFileSizeLow;
Int64Rec(Result).Hi := AttributeData.nFileSizeHigh;
end
else
Result := -1;
end;
Googling for the keywords "delphi get file size int64" gives you plenty of examples
I use this:
function GetSizeOfFile(const Filename: string): Int64;
var
sr : TSearchRec;
begin
if FindFirst(fileName, faAnyFile, sr ) <> 0 then
Exit(-1);
try
result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + Int64(sr.FindData.nFileSizeLow);
finally
System.SysUtils.FindClose(sr) ;
end;
end;
You can avoid bit-shifting by assigning into a variant record which I think makes the code below more efficient.
function GetSizeOfFile(const Filename: string): Int64;
type
TSizeType = (stDWORD, stInt64);
var
sizerec: packed record
case TSizeType of
stDWORD: (SizeLow: LongWord; SizeHigh: LongWord);
stInt64: (Size: Int64);
end;
sr : TSearchRec;
begin
if FindFirst(fileName, faAnyFile, sr ) <> 0 then
begin
Result := -1;
Exit;
end;
try
sizerec.SizeLow := sr.FindData.nFileSizeLow;
sizerec.SizeHigh := sr.FindData.nFileSizeHigh;
Result := sizerec.Size;
finally
SysUtils.FindClose(sr) ;
end;
end;
I could've just used "case Boolean of" but like to use the power of Pascal to make the code more descriptive.
I have some files in a directory. I try get these files with FindFirst and FindNext but I can't get same order on Windows 7.
C:\Test
SampleFile.0.png
SampleFile.1.png
SampleFile.2.png
SampleFile.3.png
SampleFile.4.png
SampleFile.5.png
SampleFile.6.png
SampleFile.7.png
SampleFile.8.png
SampleFile.9.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.20.png
SampleFile.21.png
SampleFile.22.png
When I try using my code I've got
SampleFile.0.png
SampleFile.1.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.2.png
SampleFile.20.png
SampleFile.21.png
.
.
.
How can I get file list on correct rank order?
Procedure Test;
var
sr : TSearchRec;
i : integer;
ListFiles : TStringList;
begin
ListFiles := TStringList.Create;
i := FindFirst('c:\test\*.png', faDirectory, sr);
while i = 0 do begin
ListFiles.Add(ExtractFileName(sr.FindData.cFileName));
i := FindNext(sr);
end;
FindClose(sr);
end;
Note : Result is still wrong, if I can use ListFiles.Sorted = True
I think I've a solution, created a function.
function SortFilesByName(List: TStringList; Index1, Index2: Integer): integer;
var
FileName1, FileName2: String;
i, FileNumber1, FileNumber2: Integer;
begin
FileName1 := ChangeFileExt(ExtractFileName(List[Index1]), '');
FileName2 := ChangeFileExt(ExtractFileName(List[Index2]), '');
i := POS('.', FileName1)+1;
FileNumber1 := StrToInt(Copy(FileName1, i, MaxInt));
i := POS('.', FileName2)+1;
FileNumber2 := StrToInt(Copy(FileName2, i, MaxInt));
Result := (FileNumber1 - FileNumber2);
end;
I've added another line
ListFiles.CustomSort(SortFilesByName); //(ListFiles,1,2):integer);
before
FindClose(sr);
As jachguate said, the sorting is done by Explorer.exe, not the filesystem. FindFirst/FindNext does not guarantee any specific sorting, including plain ASCII based, so you shouldn't rely on it. You don't, however, need to re-implement the numeric sort in Delphi. Windows exposes the one it uses as StrCmpLogicalW, which is in shlwapi.dll. The import looks like this:
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
external 'shlwapi.dll'
It is possible to disable that behavior in Windows. If you want to follow the order that Windows uses, you need to call SHRestricted with the REST_NOSTRCMPLOGICAL value. If it returns true you should use AnsiCompareStr instead.
const
// Use default CompareString instead of StrCmpLogical
REST_NOSTRCMPLOGICAL = $4000007E;
function SHRestricted(rest: DWORD): LongBool; stdcall; external 'shell32.dll';
So your final sort function should be something like this:
function CompareFilenames(const AFilename1, AFilename2: string): Integer;
begin
if SHRestricted(REST_NOSTRCMPLOGICAL) then
Result := AnsiCompareStr(AFilename1, AFilename2)
else
Result := StrCmpLogicalW(PWideChar(AFilename1), PWideChar(AFilename2));
end;
You can cache the result of the SHRestricted call, but if you do you need to watch for the WM_SETTINGSCHANGE broadcast message and re-read it when you get one.
The different orders you see in the windows explorer is implemented in explorer.exe and not in the file system.
The Numerical sort order is a new feature in windows 7, so if you sort by name and you have a bunch of files with a prefix followed by numbers, the explorer "identifies" that pattern and doesn't present a list sorted by name in the traditional way, but sorted by prefix and then by number (as if the string were a Integer number).
If you want to do the same in Delphi, you can do it by adding all the file names returned by FindFirst/FindNext to a TSlist and then sort the string list using this compare function:
var
FileNames: TList<string>;
begin
FileNames := TList<string>.Create;
try
SearchForFiles(FileNames); //here you add all the file names
//sort file names a la windows 7 explorer
FileNames.Sort(System.Generics.Defaults.TComparer<string>.Construct(
function (const s1, s2: string): Integer
procedure ProcessPrefix(const fn: string; var prefix, number: string);
var
I: Integer;
begin
for I := length(fn) downto 1 do
if not TCharacter.IsDigit(fn[I]) then
begin
Prefix := Copy(fn, 1, I);
number := Copy(fn, I+1, MaxInt);
Break;
end;
end;
var
prefix1, prefix2: string;
number1, number2: string;
fn1, fn2: string;
begin
//compare filenames a la windows 7 explorer
fn1 := TPath.GetFileNameWithoutExtension(s1);
fn2 := TPath.GetFileNameWithoutExtension(s2);
ProcessPrefix(fn1, prefix1, number1);
ProcessPrefix(fn2, prefix2, number2);
if (Number1 <> '') and (Number2 <> '') then
begin
Result := CompareText(prefix1, prefix2);
if Result = 0 then
Result := CompareValue(StrToInt(number1), StrToInt(Number2));
end
else
Result := CompareText(s1, s2);
end
));
UseYourSortedFileNames(FileNames);
finally
FileNames.Free;
end;
end;
By "rank", you mean sort order.
The files are sorting in the proper order (based on the ASCII value of the characters). 2 comes after 19 because the comparison is only made up to the same number of characters in both names, and '2' comes after 1.
If you want them to sort properly as numbers, you need to left-pad the numbers with zeros so they're all the same width (eg., instead of SampleFile.2.png, use SampleFile.02.png). This will cause '02' to come before 19 so they sort correctly numerically.
You can fix the numbering issue by using something like:
PngFileName := Format('SampleFile.%.2d.png', [Counter]);
We want a program of ours in D7 to know if it was run via a ShellExecute command from one of our apps, or directly started by the user.
Is there a reliable way for a Delphi 7 program to determine the name of the program that ran it?
We of course could have our parent program use a command line argument or other flag, but we'd prefer the above approach.
TIA
There's no way to do what you want, I'm afraid. The application isn't told whether it's being run pro grammatically via ShellExecute (or CreateProcess), via a command line, a shortcut, or a double-click in Explorer.
Raymond Chen did an article a while back on this very topic, if I remember correctly; I'll see if I can find it and update my answer here.
Based on another answer and some code on Torry.net, I came to this function to get the parent process id. It seems to return a relevant number on Windows 7, and the windows functions it uses should be available at least since Win 2000.
uses Tlhelp32;
function GetProcessInfo(ProcessId: Cardinal; out ParentProcessId: Cardinal; out ExeFileName: string): Boolean;
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
try
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
repeat
if ProcInfo.th32ProcessID = ProcessId then
begin
ExeFileName := string(ProcInfo.szExeFile);
ParentProcessId := ProcInfo.th32ParentProcessID;
Result := True;
Exit;
end;
until not Process32Next(hSnapShot, ProcInfo);
finally
CloseHandle(hSnapShot);
end;
Result := False;
end;
procedure Test;
var
ProcessId, ParentProcessId, Dummy: Cardinal;
FileName: string;
begin
ProcessId := GetCurrentProcessId();
// Get info for current process
if GetProcessInfo(ProcessId, ParentProcessId, FileName) then
// Get info for parent process
if GetProcessInfo(ParentProcessId, Dummy, FileName) then
// Show it.
ShowMessage(IntToStr(ParentProcessId) + FileName);
end;
A word of caution! The parent process may no longer exist. Even worse, it's ID may have been recycled, causing this function to give you a different process than you asked for.
The simple answer is "No".
A more complex answer is "Not as easily as simply passing a command line param would be".
:)
What you need to do is identify the parent process of your process. Obtaining this is possible but not straightforward. Details of how to go about it can be obtained in this CodeProject article.
The biggest problem is that there is not strict hierarchical relationship between processes in Windows and PID (Process ID's) may be re-used. The PID you identify as your "parent" may not be your parent at all. If the parent process has subsequently terminated then it's PID may be re-used which could lead to some seemingly perplexing results ("My process was started by calc.exe? How is that possible?").
Trying to find bullet, water and idiot proof mechanisms to protect against the possible ways such a process might fail will be significantly more effort than simply devising and implementing a command line based convention between your launcher applications and the launchee by which the latter may identify the former.
A command line parameter is one such option but could be "spoofed" (if someone figures out what you are passing on the command line and for some reason could derive some value or benefit from mimicking this themselves).
Depending on how reliable and tamper proof you need the mechanism to be, this could still be enough however.
I've found getpids which does it using NtQueryInformationProcess to not only to obtain the parent process ID but also compare the process creation times - if the reported parent process was created after the child it means the reported parent ID has already been recycled.
Here is my Delphi unit I wrote to test it:
unit ProcInfo;
interface
uses
Windows, SysUtils;
function GetParentProcessId(ProcessID: DWORD; out ProcessImageFileName: string): DWORD; overload;
implementation
uses
PsApi;
var
hNtDll: THandle;
NtQueryInformationProcess: function(ProcessHandle: THandle; ProcessInformationClass: DWORD;
ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall;
const
UnicodeStringBufferLength = 1025;
type
PPEB = Pointer; // PEB from winternl.h not needed here
PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;
PROCESS_BASIC_INFORMATION = record
Reserved1: Pointer; // exit status
PebBaseAddress: PPEB;
Reserved2: array[0..1] of Pointer; // affinity mask, base priority
UniqueProcessId: ULONG_PTR;
Reserved3: Pointer; // parent process ID
end;
PProcessBasicInformation = ^TProcessBasicInformation;
TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
PKernelUserTimes = ^TKernelUserTimes;
TKernelUserTimes = record
CreateTime: LONGLONG;
ExitTime: LONGLONG;
KernelTime: LONGLONG;
UserTime: LONGLONG;
end;
PUNICODE_STRING = ^UNICODE_STRING;
UNICODE_STRING = record
Length: USHORT;
MaximumLength: USHORT;
PBuffer: PChar;
Buffer: array[0..UnicodeStringBufferLength - 1] of Char;
end;
PUnicodeString = ^TUnicodeString;
TUnicodeString = UNICODE_STRING;
function GetProcessCreateTime(hProcess: THandle): LONGLONG;
var
ProcessTimes: TKernelUserTimes;
begin
Result := 0;
FillChar(ProcessTimes, SizeOf(ProcessTimes), 0);
if NtQueryInformationProcess(hProcess, 4, #ProcessTimes, SizeOf(ProcessTimes), nil) <> 0 then
Exit;
Result := ProcessTimes.CreateTime;
end;
function GetProcessParentId(hProcess: THandle): DWORD;
var
ProcessInfo: TProcessBasicInformation;
begin
Result := 0;
FillChar(ProcessInfo, SizeOf(ProcessInfo), 0);
if NtQueryInformationProcess(hProcess, 0, #ProcessInfo, SizeOf(ProcessInfo), nil) <> 0 then
Exit;
Result := DWORD(ProcessInfo.Reserved3);
end;
function GetProcessImageFileName(hProcess: THandle): string;
var
ImageFileName: TUnicodeString;
begin
Result := '';
FillChar(ImageFileName, SizeOf(ImageFileName), 0);
ImageFileName.Length := 0;
ImageFileName.MaximumLength := UnicodeStringBufferLength * SizeOf(Char);
ImageFileName.PBuffer := #ImageFileName.Buffer[0];
if NtQueryInformationProcess(hProcess, 27, #ImageFileName, SizeOf(ImageFileName), nil) <> 0 then
Exit;
SetString(Result, ImageFileName.PBuffer, ImageFileName.Length);
end;
function GetParentProcessId(ProcessId: DWORD; out ProcessImageFileName: string): DWORD;
var
hProcess, hParentProcess: THandle;
ProcessCreated, ParentCreated: LONGLONG;
begin
Result := 0;
ProcessImageFileName := '';
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
if hProcess = 0 then
RaiseLastOSError;
try
Result := GetProcessParentId(hProcess);
if Result = 0 then
Exit;
ProcessCreated := GetProcessCreateTime(hProcess);
finally
CloseHandle(hProcess);
end;
hParentProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, Result);
if hParentProcess = 0 then
RaiseLastOSError;
try
ParentCreated := GetProcessCreateTime(hParentProcess);
if ParentCreated > ProcessCreated then
begin
Result := 0;
Exit;
end;
ProcessImageFileName := GetProcessImageFileName(hParentProcess);
finally
CloseHandle(hParentProcess);
end;
end;
initialization
hNtDll := GetModuleHandle('ntdll.dll');
if hNtDll <> 0 then
NTQueryInformationProcess := GetProcAddress(hNtDll, 'NtQueryInformationProcess');
end.
When I run the code from the IDE, I get the following results:
parent ID: 5140, parent image file name:
"\Device\HarddiskVolume1\Program Files\Embarcadero\RAD
Studio\8.0\bin\bds.exe"
so you may need to find a way to translate that into a "normal" path, e.g. "C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe".