Форум: "Начинающим";
Текущий архив: 2006.09.03;
Скачать: [xml.tar.bz2];

Вниз

сканирование дисков   Найти похожие ветки 

← →
Chort ©   (2006-08-07 13:11) [0]

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

---

← →
MBo ©   (2006-08-07 13:20) [1]

http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=1015254946&n=19

---

← →
Chort ©   (2006-08-07 15:07) [2]

Меня наверно от жары плющит, но не выполняется скан на .exe
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   ListBox1: TListBox;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = "" then Mask := "*.*";
 if StartDir[Length(StartDir)] <> "\" then StartDir := StartDir + "\";
  if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
    begin
      repeat
         Application.ProcessMessages;
             if (SearchRec.Attr and faDirectory) <> faDirectory then
                   List.Add(StartDir + SearchRec.Name)
                   else if
                   (SearchRec.Name <> "..") and (SearchRec.Name <> ".exe") then
                   begin        List.Add(StartDir + SearchRec.Name + "\");
                     ScanDir(StartDir + SearchRec.Name + "\",Mask,List);
                        end;    until FindNext(SearchRec) <> 0;
                         FindClose(SearchRec);
                          end;
                          end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir("d:","*.exe",ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;
end.
В чем ошибка?

---

← →
Пусик ©   (2006-08-07 15:16) [3]

> В чем ошибка?


В том, что у тебя проверяются также и каталоги на соответствие маске.
Используй для поиска маску "*.*" и функцию MatсhesMask.

---

← →
Chort ©   (2006-08-07 15:53) [4]

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

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

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

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

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

---

← →
Пусик ©   (2006-08-07 16:53) [5]

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;

---

← →
begin...end ©   (2006-08-07 17:01) [6]

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

var -- лишнее.

---

← →
Пусик ©   (2006-08-07 17:03) [7]

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


Угу.

---

← →
Chort ©   (2006-08-07 18:01) [8]

Дело с 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;

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

---

← →
Chort ©   (2006-08-07 19:07) [9]

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

---

← →
Пусик ©   (2006-08-07 19:10) [10]

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


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

Вызов:

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

---

← →
Chort ©   (2006-08-07 19:57) [11]

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 20:12) [12]

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



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


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

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

---

← →
Chort ©   (2006-08-07 20:37) [13]

Ну вот чтоб было немного понятнее
Есть у меня модуль
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.

---

← →
Chort ©   (2006-08-07 20:38) [14]

В  проге я вызываю
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 подключены к моей базе и так сохраняется инфа.
Так вот повторюсь, увязывается ли это?

---

← →
Пусик ©   (2006-08-07 21:14) [15]

> 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]));

---

← →
Мефисто   (2006-08-07 21:27) [16]

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

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

http://delphimaster.net/view/2-1154029431/

---

← →
Шпиён   (2006-08-07 22:03) [17]

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


> Он может это не осилисть, придется опять разжевывать  ;)
>
> http://delphimaster.net/view/2-1154029431/

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

---

← →
Chort ©   (2006-08-07 22:50) [18]

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

---

← →
Chort ©   (2006-08-07 23:16) [19]

Значит нужно писать
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;
Господа, будьте благодушными с новичками
"Конференция для начинающих, а также для тех, кому сложно объяснить чего он хочет. Просьба к участникам быть взаимовежливыми, профессионалам отдельная просьба - быть снисходительными. "
Вспомните себя в молодости

---

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

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

---

← →
Chort ©   (2006-08-09 10:19) [21]

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

---

← →
Пусик ©   (2006-08-09 10:28) [22]

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


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

---

← →
Chort ©   (2006-08-11 15:13) [23]

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

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.09.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.58 MB
Время: 0.043 c