| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

сканирование дисков [D7, XP]

Страницы:   < 1 2 >

Chort ©   (2006-08-07 13:11:00) 

Здравствуйте! Возможно ли сделать сканирование дисков на наличие .exe файлов и запись результата в разные поля? Если возможно, то каким образом?Спасибо!

---

Chort   (2006-08-11 15:13:00) [1]

Все, спасибо.Разобрался!

---

Пусик   (2006-08-09 10:28:00) [2]

> Chort ©   (09.08.06 10:19) [21]
> Что это все притихли?


А чтобы ты немного своей головой подумал сначала.

---

Chort   (2006-08-09 10:19:00) [3]

Что это все притихли?

---

Мефисто   (2006-08-07 23:20:00) [4]

Да никто тебя не пинает, просто вечер (для некоторых и заполночь) мноогих на подвиги уже не тянет. Кури до завтра :)

---

Chort   (2006-08-07 23:16:00) [5]

Значит нужно писать
procedure TInfoForm.SpeedButton1Click(Sender: TObject);
var
pRec: PVerInfoRec;
begin
if not OpenDialog3.Execute then Exit;
a := TVerInfoRes.Create(OpenDialog3.FileName);
try
if MatchesMask(SR.Name,aMask) then
begin
  New(pRec);
  pRec^.CompanyName :=DBEDIT1.Text ;
  pRec^.FileDescription :=DBEDIT2.Text ;
  pRec^.InternalName:=DBEDIT3.Text ;
....
  pRec^.Comments := DBEDIT10.Text ;
  aListFile.AddObject(tPath+SR.Name,pRec);

end;

Dispose(PVerInfoRec(aListFile[i]));
end;
Господа, будьте благодушными с новичками
'Конференция для начинающих, а также для тех, кому сложно объяснить чего он хочет. Просьба к участникам быть взаимовежливыми, профессионалам отдельная просьба - быть снисходительными. '
Вспомните себя в молодости

---

Chort   (2006-08-07 22:50:00) [6]

Ну напали все сразу!

---

Шпиён   (2006-08-07 22:03:00) [7]

> Мефисто   (07.08.06 21:27) [16]


> Он может это не осилисть, придется опять разжевывать  ;)
>
> http://www.delphimaster.ru/cgi-bin/forum.pl?id=1154029431&n=18

Судя по приведенному коду, придётся еще в той ветке... дожёвывать пост [69]....
ps Сегодня уже времени и вдохновения нет... и челюсть искусственная не смазана -)

---

Мефисто   (2006-08-07 21:27:00) [8]

Пусик  ©   (07.08.06 21:14) [15]

Пусик, не так быстро :)
Он может это не осилисть, придется опять разжевывать  ;)

http://www.delphimaster.ru/cgi-bin/forum.pl?id=1154029431&n=18

---

Пусик   (2006-08-07 21:14:00) [9]

> Chort ©   (07.08.06 20:38) [14]

Вместо этого:
DBEDIT1.Text := A.GetPreDefKeyString(viCompanyName);
 DBEDIT2.Text := A.GetPreDefKeyString(viFileDescription);
 DBEDIT3.Text := A.GetPreDefKeyString(viFileVersion);
 DBEDIT4.Text := A.GetPreDefKeyString(viInternalName);
 DBEDIT5.Text := A.GetPreDefKeyString(viLegalCopyright);
 DBEDIT6.Text := A.GetPreDefKeyString(viLegalTrademarks);
 DBEDIT7.Text := A.GetPreDefKeyString(viOriginalFilename);
 DBEDIT8.Text := A.GetPreDefKeyString(viProductName);
 DBEDIT9.Text := A.GetPreDefKeyString(viProductVersion);
  DBEDIT10.Text := A.GetPreDefKeyString(viComments);
  DBEDIT11.Text:=ExtractFilePath(OpenDialog3.FileName);
  DBEDIT12.Text:=OpenDialog3.FileName;
DBEDIT13.Text:=ExtractFileName(OpenDialog3.FileName);

type
 PVerInfoRec=^TVerInfoRec;
 TVerInfoRec=record
   CompanyName,
   FileDescription,
   ...
   Comments
 end;

При поиске файлов :

var
 pRec: PVerInfoRec;
begin
...

 if MatchesMask(SR.Name,aMask) then
 begin
   New(pRec);
   pRec^.CompanyName :=...
   pRec^.FileDescription :=...
   ...
   pRec^.Comments := ...
   aListFile.AddObject(tPath+SR.Name,pRec);

 end;

После этого вся информация об исполнимом файле у тебя будет храниться вместе с полным путем о нем.

И, конечно, надо при уничтожении или очистке aListFile позаботиться об освобождении памяти из-под pRec:

Dispose(PVerInfoRec(aListFile[i]));

---

Chort   (2006-08-07 20:38:00) [10]

В  проге я вызываю
procedure TInfoForm.SpeedButton1Click(Sender: TObject);
var
a : TVerInfoRes;
begin
if not OpenDialog3.Execute then Exit;
a := TVerInfoRes.Create(OpenDialog3.FileName);
try
  DBEDIT1.Text := A.GetPreDefKeyString(viCompanyName);
  DBEDIT2.Text := A.GetPreDefKeyString(viFileDescription);
  DBEDIT3.Text := A.GetPreDefKeyString(viFileVersion);
  DBEDIT4.Text := A.GetPreDefKeyString(viInternalName);
  DBEDIT5.Text := A.GetPreDefKeyString(viLegalCopyright);
  DBEDIT6.Text := A.GetPreDefKeyString(viLegalTrademarks);
  DBEDIT7.Text := A.GetPreDefKeyString(viOriginalFilename);
  DBEDIT8.Text := A.GetPreDefKeyString(viProductName);
  DBEDIT9.Text := A.GetPreDefKeyString(viProductVersion);
   DBEDIT10.Text := A.GetPreDefKeyString(viComments);
   DBEDIT11.Text:=ExtractFilePath(OpenDialog3.FileName);
   DBEDIT12.Text:=OpenDialog3.FileName;
DBEDIT13.Text:=ExtractFileName(OpenDialog3.FileName);
finally
  a.Free;
end;
end;
Тобешь, Диалогом указываю файл .exe и она с помощью unit Info(если можно так сказать), собирает инфу с этого файла и забивает DB поля - Edit.
DBEdit подключены к моей базе и так сохраняется инфа.
Так вот повторюсь, увязывается ли это?

---

Chort   (2006-08-07 20:37:00) [11]

Ну вот чтоб было немного понятнее
Есть у меня модуль
unit Info;

interface
uses SysUtils, WinTypes, Dialogs, Classes;
type
{ define a generic exception class for version info, and an exception
  to indicate that no version info is available. }
EVerInfoError   = class(Exception);
ENoVerInfoError = class(Exception);
eNoFixeVerInfo  = class(Exception);

// define enum type representing different types of version info
TVerInfoType =
  (viCompanyName,
   viFileDescription,
   viFileVersion,
   viInternalName,
   viLegalCopyright,
   viLegalTrademarks,
   viOriginalFilename,
   viProductName,
   viProductVersion,
   viComments,
   LangID,
   CharSetID);

const

// define an array constant of strings representing the pre-defined
// version information keys.
VerNameArray: array[viCompanyName..CharSetID] of String[20] =
('CompanyName',
 'FileDescription',
 'FileVersion',
 'InternalName',
 'LegalCopyright',
 'LegalTrademarks',
 'OriginalFilename',
 'ProductName',
 'ProductVersion',
 'Comments',
 'LangID',
 'CharSetID');

type

// Define the version info class
TVerInfoRes = class
private

  Handle            : DWord;
  Size              : Integer;
  RezBuffer         : String;
  TransTable        : PLongint;
  FixedFileInfoBuf  : PVSFixedFileInfo;
  FFileFlags        : TStringList;
  FFileName         : String;
  procedure FillFixedFileInfoBuf;
  procedure FillFileVersionInfo;
  procedure FillFileMaskInfo;
protected
  function GetFileVersion   : String;
  function GetProductVersion: String;
  function GetFileOS        : String;
public
  constructor Create(AFileName: String);
  destructor Destroy; override;
  function GetPreDefKeyString(AVerKind: TVerInfoType): String;
  function GetUserDefKeyString(AKey: String): String;
  property FileVersion    : String read GetFileVersion;
  property ProductVersion : String read GetProductVersion;
  property FileFlags      : TStringList read FFileFlags;
  property FileOS         : String read GetFileOS;
end;

implementation

uses Windows, MainUnit;

const
// strings that must be fed to VerQueryValue() function
SFInfo                = '\StringFileInfo\';
VerTranslation: PChar = '\VarFileInfo\Translation';
FormatStr             = '%s%.4x%.4x\%s%s';

constructor TVerInfoRes.Create(AFileName: String);
begin
FFileName := aFileName;
FFileFlags := TStringList.Create;
// Get the file version information
FillFileVersionInfo;
//Get the fixed file info
FillFixedFileInfoBuf;
// Get the file mask values
FillFileMaskInfo;
end;

destructor TVerInfoRes.Destroy;
begin
FFileFlags.Free;
end;

procedure TVerInfoRes.FillFileVersionInfo;
var
SBSize: UInt;
begin
// Determine size of version information
Size := GetFileVersionInfoSize(PChar(FFileName), Handle);
if Size <= 0 then         { raise exception if size <= 0 }
  raise ENoVerInfoError.Create('No Version Info Available.');

// Set the length accordingly
SetLength(RezBuffer, Size);
// Fill the buffer with version information, raise exception on error
if not GetFileVersionInfo(PChar(FFileName), Handle, Size, PChar(RezBuffer)) then
  raise EVerInfoError.Create('Cannot obtain version info.');

// Get translation info, raise exception on error
if not VerQueryValue(PChar(RezBuffer), VerTranslation,  pointer(TransTable),
SBSize) then
  raise EVerInfoError.Create('No language info.');
end;

procedure TVerInfoRes.FillFixedFileInfoBuf;
var
Size: Cardinal;
begin
if VerQueryValue(PChar(RezBuffer), '\', Pointer(FixedFileInfoBuf), Size) then begin
   if Size < SizeOf(TVSFixedFileInfo) then
      raise eNoFixeVerInfo.Create('No fixed file info');
end
else
  raise eNoFixeVerInfo.Create('No fixed file info')
end;

procedure TVerInfoRes.FillFileMaskInfo;
begin
with FixedFileInfoBuf^ do begin
  if (dwFileFlagsMask and dwFileFlags and VS_FF_PRERELEASE) <> 0then
    FFileFlags.Add('Pre-release');
  if (dwFileFlagsMask and dwFileFlags and VS_FF_PRIVATEBUILD) <> 0 then
    FFileFlags.Add('Private build');
  if (dwFileFlagsMask and dwFileFlags and VS_FF_SPECIALBUILD) <> 0 then
    FFileFlags.Add('Special build');
  if (dwFileFlagsMask and dwFileFlags and VS_FF_DEBUG) <> 0 then
    FFileFlags.Add('Debug');
end;
end;

function TVerInfoRes.GetPreDefKeyString(AVerKind: TVerInfoType): String;
var
P: PChar;
S: UInt;
begin

Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
  VerNameArray[aVerKind], #0]);
// get and return version query info, return empty string on error
if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  Result := StrPas(P)
else
  Result := '';
end;

function TVerInfoRes.GetUserDefKeyString(AKey: String): String;
var
P: Pchar;
S: UInt;
begin
Result := Format(FormatStr, [SfInfo, LoWord(TransTable^),HiWord(TransTable^),
  aKey, #0]);
// get and return version query info, return empty string on error
if VerQueryValue(PChar(RezBuffer), @Result[1], Pointer(P), S) then
  Result := StrPas(P)
else
  Result := '';
end;

function VersionString(Ms, Ls: Longint): String;
begin
Result := Format('%d.%d.%d.%d', [HIWORD(Ms), LOWORD(Ms),
   HIWORD(Ls), LOWORD(Ls)]);
end;

function TVerInfoRes.GetFileVersion: String;
begin
with FixedFileInfoBuf^ do
  Result := VersionString(dwFileVersionMS, dwFileVersionLS);
end;

function TVerInfoRes.GetProductVersion: String;
begin
with FixedFileInfoBuf^ do
  Result := VersionString(dwProductVersionMS, dwProductVersionLS);
end;

function TVerInfoRes.GetFileOS: String;
begin
with FixedFileInfoBuf^ do
  case dwFileOS of
    VOS_UNKNOWN:  // Same as VOS__BASE
      Result := 'Unknown';
    VOS_DOS:
      Result := 'Designed for MS-DOS';
    VOS_OS216:
      Result := 'Designed for 16-bit OS/2';
    VOS_OS232:
      Result := 'Designed for 32-bit OS/2';
    VOS_NT:
      Result := 'Designed for Windows NT';

    VOS__WINDOWS16:
      Result := 'Designed for 16-bit Windows';
    VOS__PM16:
      Result := 'Designed for 16-bit PM';
    VOS__PM32:
      Result := 'Designed for 32-bit PM';
    VOS__WINDOWS32:
      Result := 'Designed for 32-bit Windows';

    VOS_DOS_WINDOWS16:
      Result := 'Designed for 16-bit Windows, running on MS-DOS';
    VOS_DOS_WINDOWS32:
      Result := 'Designed for Win32 API, running on MS-DOS';
    VOS_OS216_PM16:
      Result := 'Designed for 16-bit PM, running on 16-bit OS/2';
    VOS_OS232_PM32:
      Result := 'Designed for 32-bit PM, running on 32-bit OS/2';
    VOS_NT_WINDOWS32:
      Result := 'Designed for Win32 API, running on Windows/NT';
  else
    Result := 'Unknown';
  end;
end;
end.

---

Пусик   (2006-08-07 20:12:00) [12]

> Chort ©   (07.08.06 19:57) [11]



> Так вот можно ли чтоб это совместилось, или это только мечты?


Почему же нет?
У TStringList, например, есть свойство Objects, туда по мере добавления путей к файлам можешь добавлять и нужную тебе информацию;

Например, вместо List.Add(FilePath), можно сразу использовать List.AddObject(FilePath,<Ссылка на данные>);

---

Chort   (2006-08-07 19:57:00) [13]

to Пусик
Главное то, что я это пытался сделать и раньше, но GetFiles не инициализировалось. Потом смотрю в Вашу помощь и вижу нечто подобное(у меня было так)
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
GetFiles('d:\','*.exe',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;
Значит взял я все сделанное и удалил. Записал все зановово с нового проекта, и о чудо, работает!

Возник у меня на ходу такой вопрос
Смогу ли я управлять этими данными названий .exe файлов,
А точнее у меня есть процедура, с помощью которой ВЫ ,извиняюсь, "тыкаете" нужный Вам .exe файл и снего считывается всякая инфа и заносится в базу. Т.е. сканирование- взятие инфы- занесение в базу. Так вот можно ли чтоб это совместилось, или это только мечты?

---

Пусик   (2006-08-07 19:10:00) [14]

> Chort ©   (07.08.06 19:07) [9]


Те изменения, что ты внес в функцию, снова испортили логику.
Не надо этого делать.

Вызов:

GetFiles('c:\','*.exe',Memo.Lines);

---

Chort   (2006-08-07 19:07:00) [15]

Может кто подскажет? Признаюсь, я не силен в этом деле.

---

Chort   (2006-08-07 18:01:00) [16]

Дело с MatchesMaskне имел не разу.
Короче говоря получаутся такое
procedure GetFiles(const aPath,aMask: String; aListFile: TStrings;const aExcludeAttr: Integer=0);
var
SR: TSearchRec;
tPath: String;
begin
{$WARN SYMBOL_PLATFORM OFF}
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+'*.exe',faAnyFile,SR)=0 then
begin
  try
    repeat
      if (SR.Name='.') or (SR.Name='..') then Continue;
      if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
      if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
      if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
    until FindNext(SR)<>0;
  finally
    Sysutils.FindClose(SR);
  end;
end;
{$WARN SYMBOL_PLATFORM ON}
end;

А для вызова, затрудняюсь.

---

Пусик   (2006-08-07 17:03:00) [17]

> begin...end ©   (07.08.06 17:01) [6]
> > Пусик ©   (07.08.06 16:53) [5]> var aListFile: TStringsvar
> -- лишнее.


Угу.

---

begin...end   (2006-08-07 17:01:00) [18]

> Пусик ©   (07.08.06 16:53) [5]
> var aListFile: TStrings

var -- лишнее.

---

Пусик   (2006-08-07 16:53:00) [19]

procedure GetFiles(const aPath,aMask: String;var aListFile: TStrings;const aExcludeAttr: Integer=0);
var
 SR: TSearchRec;
 tPath: String;
begin
{$WARN SYMBOL_PLATFORM OFF}
 tPath := IncludeTrailingBackSlash(aPath);
 if FindFirst(tPath+'*.*',faAnyFile,SR)=0 then
 begin
   try
     repeat
       if (SR.Name='.') or (SR.Name='..') then Continue;
       if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
       if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
       if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
     until FindNext(SR)<>0;
   finally
     Sysutils.FindClose(SR);
   end;
 end;
{$WARN SYMBOL_PLATFORM ON}
end;

---

Chort   (2006-08-07 15:53:00) [20]

Погоди, где то я слышал про такое , но не помню точно.

...
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls,Masks;

....
procedure TForm1.Button1Click(Sender: TObject);

begin
 Matchesmask('D:','*.exe');

 end;
это не оно.не помню :)

---

Страницы:   < 1 2 >

Наверх