unit Unit1MergeMe;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, system.IOUtils, StdCtrls ;
type
TFormFIND =
class(TForm)
ListBoxtmp: TListBox;
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
OpenDialog1: TOpenDialog;
Button2: TButton;
OpenDialog2: TOpenDialog;
Button3: TButton;
// gtPDFDocument1: TgtPDFDocument;
// gtPDFDocumentCOVER: TgtPDFDocument;
ListBoxEnd: TListBox;
SaveDialog1: TSaveDialog;
Memo1: TMemo;
CheckBox1: TCheckBox;
//gtPDFDocument2: TgtPDFDocument;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
procedure MakeFileList(listboxtmp: Tlistbox; teil:
array of string; Verzeichnis:
string);
procedure FindAllFiles(
const FileList: tstrings;RootFolder:
string; Maske:
array of string; Recurse: Boolean = False);
function GetTempDirectory:
String;
PROCEDURE GetComponentCaptions(frm:TForm; FN:
string);
public
{ Public-Deklarationen }
end;
var
FormFIND: TFormFIND;
mypath:
string;
implementation
{$R *.dfm}
procedure TFormFIND.Button1Click(Sender: TObject);
begin
if opendialog1.Execute
then
begin
edit1.Text:= Opendialog1.FileName;
end;
end;
procedure TFormFIND.Button2Click(Sender: TObject);
begin
if opendialog2.execute
then
begin
makefilelist(listboxtmp,['
*.dfm'],extractfilepath(opendialog2.filename));
end;
end;
function filenameconform(fn:
string):
string;
begin
fn:=stringreplace(fn,'
','
_',[rfReplaceall]);
fn:=stringreplace(fn,'
.','
_',[rfReplaceall]);
fn:=stringreplace(fn,'
:','
_',[rfReplaceall]);
result:=fn;
end;
procedure TFormFIND.Button3Click(Sender: TObject);
var
i: Integer;
mymergedfn:
string;
begin
listboxend.Clear;
mymergedfn:=filenameconform(datetimetostr(now));
savedialog1.filename:=format('
%sGREPFORM.pas',[mypath]);
if Savedialog1.execute
then
begin
for i := 0
to listboxtmp.Count-1
do
begin
mypath:=extractfilepath(listboxtmp.Items[i]);
GetComponentCaptions(listboxtmp.Items[i],savedialog1.filename);
end;
end;
end;
PROCEDURE formfind.GetComponentCaptions(frm:TForm; FN:
string);
VAR
texts: TStringList;
comp: TComponent;
capt:
String;
i: Integer;
BEGIN
texts := TStringList.Create;
TRY
WITH texts
DO BEGIN
Duplicates := dupIgnore;
Sorted := True;
FOR i:=0
TO frm.ComponentCount-1
DO BEGIN
comp := frm.Components[i];
capt := comp.Caption;
IF (comp.
Name <> '
')
AND
(capt <> '
')
THEN Add(comp.
Name+'
='+capt)
END;
SaveToFile(FN)
END;
FINALLY
texts.Free
END
END;
function TFormFIND.GetTempDirectory:
String;
var
tempFolder:
array[0..MAX_PATH]
of Char;
begin
//GetTempPath(MAX_PATH, @tempFolder);
//result := StrPas(tempFolder);
result:=TPath.GetTempPath;
end;
procedure TFormFIND.FindAllFiles(
const FileList: tstrings;RootFolder:
string; Maske:
array of string; Recurse: Boolean = False);
var
SR: TSearchRec;
i : integer;
begin
//RootFolder := IncludeTrailingPathDelimiter(RootFolder);
if Recurse
then
if FindFirst(RootFolder + '
*.*', faAnyFile, SR) = 0
then
try
repeat
if SR.Attr
and faDirectory = faDirectory
then
// --> ein Verzeichnis wurde gefunden
// der Verzeichnisname steht in SR.Name
// der vollständige Verzeichnisname (inkl. darüberliegender Pfade) ist
// RootFolder + SR.Name
if (SR.
Name <> '
.')
and (SR.
Name <> '
..')
then
FindAllFiles(FileList, RootFolder + SR.
Name, Maske, Recurse);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
i := 0;
repeat
begin
if FindFirst(RootFolder + Maske[i], faAnyFile, SR) = 0
then
try
repeat
if SR.Attr
and faDirectory <> faDirectory
then
begin
// --> eine Datei wurde gefunden
// der Dateiname steht in SR.Name
// der vollständige Dateiname (inkl. Pfadangabe) ist
// RootFolder + SR.Name
FileList.Add(RootFolder + SR.
Name);
end;
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
i := i + 1;
end
until
i = high(maske) + 1;
end;
function ReportTime(
const Name:
string;
const FileTime: TFileTime):
string;
var
SystemTime, LocalTime: TSystemTime;
begin
if not FileTimeToSystemTime(FileTime, SystemTime)
then
RaiseLastOSError;
if not SystemTimeToTzSpecificLocalTime(
nil, SystemTime, LocalTime)
then
RaiseLastOSError;
result:=Name + '
: ' + DateTimeToStr(SystemTimeToDateTime(LocalTime));
end;
procedure GetBuildInfo(
var V1, V2, V3, V4: word);
var
VerInfoSize, VerValueSize, Dummy: DWORD;
VerInfo: Pointer;
VerValue: PVSFixedFileInfo;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
if VerInfoSize > 0
then
begin
GetMem(VerInfo, VerInfoSize);
try
if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo)
then
begin
VerQueryValue(VerInfo, '
\', Pointer(VerValue), VerValueSize);
with VerValue^
do
begin
V1 := dwFileVersionMS
shr 16;
V2 := dwFileVersionMS
and $FFFF;
V3 := dwFileVersionLS
shr 16;
V4 := dwFileVersionLS
and $FFFF;
end;
end;
finally
FreeMem(VerInfo, VerInfoSize);
end;
end;
end;
function GetBuildInfoAsString:
string;
var
V1, V2, V3, V4: word;
begin
GetBuildInfo(V1, V2, V3, V4);
Result := IntToStr(V1) + '
.' + IntToStr(V2) + '
.' +
IntToStr(V3) + '
.' + IntToStr(V4);
end;
procedure TFormFIND.FormCreate(Sender: TObject);
var
targetinfo:
string;
fad: TWin32FileAttributeData;
begin
if not GetFileAttributesEx(PChar(Application.ExeName), GetFileExInfoStandard, @fad)
then
RaiseLastOSError;
//ReportTime('Created', fad.ftCreationTime);
//ReportTime('Modified', fad.ftLastWriteTime);
//ReportTime('Accessed', fad.ftLastAccessTime);
{$IFDEF WIN64}
targetinfo:='
(x64 Architecture)';
{$ELSE}
targetinfo:='
Architecture: 32bit';
{$ENDIF}
targetinfo := targetinfo + format('
%s : %s',
[ReportTime('
Created', fad.ftCreationTime),
ReportTime('
Modified', fad.ftLastWriteTime)]) ;
FormFIND.Caption := FormFIND.Caption+'
- Build: ' + GetBuildInfoAsString + targetinfo;
end;
procedure TFormFIND.MakeFileList(listboxtmp: tlistbox; teil:
array of string; Verzeichnis:
string);
var
Files: TStrings;
i: integer;
begin
Files := TStringList.Create;
try
// procedure FindAllFiles(const FileList: tstrings;RootFolder: string; Maske: array of string; Recurse: Boolean = True);
FindAllFiles(files, Verzeichnis, teil, false);
for i := Files.Count -1
downto 0
do
begin
ListBOxtmp.Items.Add(widestring(Files[i]));
//DeleteFile(Files[i]);
end;
finally
Files.Free;
end;
end;
end.