Консультации Портала - Консультация #181625

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 181625

26.12.2010, 14:40

54.69 руб.

0 6 2

Компьютеры Программирование

Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос:
Имеется програмка (Скачать здесь), которая получает список установленных программ из ветви реестра
(SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\)
Подскажите пожалуйста как сделать запись строк из listview в txt следущего вида:

Name:
Adobe Flash Media Server 4
Publisher:
Adobe Systems Incorporated
Version:
4.1.2345
Size:
10Mb
Date:
20101107
Uninstall:
C:\Program Files\Adobe\Flash Media Server 4\unins000.exe
**************
Name:
Adobe Flash Media Server 4
Publisher:
.......
.......

Обсуждение

давно

Евгений/Genia007/

Профессионал
153662
1070

26.12.2010, 16:47

общий

В listview нет строк с информацией о дате и размере файла, да и в указанной ветки реестра тоже, их нужно искать отдельно. А без этой информации получается просто:

Код:

procedure TfrmMain.Button1Click(Sender: TObject);
var
  f: Textfile;
  i: integer;
begin
  AssignFile(f,'proba.txt');   
  Rewrite(f);
  for i:= 0 to uList.Items.Count - 1 do
    begin
      Try
      Writeln(f, 'Name:');
      Writeln(f, uList.Items[i].Caption);
      Writeln(f, 'Publisher:');
      Writeln(f, uList.Items[i].SubItems[1]);
      Writeln(f, 'Version:');
      Writeln(f, uList.Items[i].SubItems[0]);

      Writeln(f, 'Uninstall:');
      Writeln(f, uList.Items[i].SubItems[2]);
      Writeln(f, '**************');
      Writeln(f, ' ');
      Except;
      end;
    end;
  CloseFile(f);
end;

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

26.12.2010, 19:17

общий

Большое спасибо

С датой проблем не возникло, значение "InstallDate" в той же ветви...
А вот вывести ключ "EstimatedSize" из этой ветви не смог, есть проблема и как я понимаю не удастся потому-что значение имеет тип числовой, и его надо перевести в строковый, а как я не знаю

Буду очень благодарен если сможете помочь

Измененная версия: скачать

давно

Евгений/Genia007/

Профессионал
153662
1070

26.12.2010, 20:09

общий

Цитата: 261988

С датой проблем не возникло, значение "InstallDate" в той же ветви...
А вот вывести ключ "EstimatedSize" из этой ветви не смог, есть проблема и как я понимаю не удастся потому-что значение имеет тип числовой, и его надо перевести в строковый, а как я не знаю

У меня этих значений почти нет в указанной ветки, поэтому я и написал про это в предыдущем посте. Прочитать числовой параметр из реестра не проблема вот так i:= theRegistry.ReadInteger('');

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

26.12.2010, 21:04

общий

Вот исправил Ваш исходник

Код:

procedure TfrmMain.btnRefreshClick(Sender: TObject);
var
  theRegistry: TRegistry;
  uEntries: TStrings;
  index: Integer;
  item: TListItem;
  str: integer;
begin
  uList.Clear;
  uEntries := TStringList.Create;
  theRegistry := TRegistry.Create;
  theRegistry.RootKey := HKEY_LOCAL_MACHINE;
  theRegistry.OpenKey(UNINSTALLROOT, False);
  theRegistry.GetKeyNames(uEntries);
  theRegistry.CloseKey;

  for index := 0 to uEntries.Count -1 do begin
    theRegistry.OpenKey(UNINSTALLROOT + uEntries[index], False);
    if theRegistry.ValueExists('DisplayName') then begin
      item := uList.items.add;
      item.Caption := theRegistry.ReadString('DisplayName');
      if theRegistry.ValueExists('DisplayVersion') then
        item.SubItems.Add(theRegistry.ReadString('DisplayVersion')) else
        item.SubItems.Add('null');
      if theRegistry.ValueExists('Publisher') then
        item.SubItems.Add(theRegistry.ReadString('Publisher')) else
        item.SubItems.Add('null');
      if theRegistry.ValueExists('UninstallString') then
        item.SubItems.Add(theRegistry.ReadString('UninstallString')) else
        if theRegistry.ValueExists('QuietUninstallString') then
          item.SubItems.Add(theRegistry.ReadString('QuietUninstallString')) else
          item.SubItems.Add('null');
          if theRegistry.ValueExists('InstallDate') then
            item.SubItems.Add(theRegistry.ReadString('InstallDate')) else
            item.SubItems.Add('null');
            if theRegistry.ValueExists('EstimatedSize') then
              item.SubItems.Add(IntToStr(theRegistry.ReadInteger('EstimatedSize'))) else
              item.SubItems.Add('null');
    end;
    theRegistry.CloseKey;
  end;

  FreeAndNil(theRegistry);
  FreeAndNil(uEntries);
  StatusBar.SimpleText := Format('%d Application(s)', [uList.Items.Count]);
end;

procedure TfrmMain.FormActivate(Sender: TObject);
var
  f: Textfile;
  i: integer;
  j: Real;
  str: string;
begin
  AssignFile(f,'proba.txt');
  Rewrite(f);
  for i:= 0 to uList.Items.Count - 1 do
    begin
      Writeln(f, 'Name:');
      Writeln(f, uList.Items[i].Caption);
      Writeln(f, 'Publisher:');
      Writeln(f, uList.Items[i].SubItems[1]);
      Writeln(f, 'Version:');
      Writeln(f, uList.Items[i].SubItems[0]);
      Writeln(f, 'Size:');
      if uList.Items[i].SubItems[4] <> 'null' then
        begin
          j:= StrToInt(uList.Items[i].SubItems[4]);
          str:= FloatToStrF((j / 1024), ffNumber, 5, 2) + ' Mb';
          Writeln(f, str);
        end
      else
        Writeln(f, 'null');
      Writeln(f, 'Date:');
      Writeln(f, uList.Items[i].SubItems[3]);
      Writeln(f, 'Uninstall:');
      Writeln(f, uList.Items[i].SubItems[2]);
      Writeln(f, '**************');
      Writeln(f, ' ');
    end;
  CloseFile(f);
end;

Прикрепленные файлы:

1920727c077a1e49a550dd63d21e3f63.zip

скачать (259.00 кБ)

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

27.12.2010, 09:08

общий

это ответ

Здравствуйте, Лукин Андрей!

Прилагаю в Приложении процедуру записывающую 1 строку из ListBox в текстовый файл
При необходимости можно переделать саму процедуру для записи всех строк.

Единственное, что необходимо Вам будет сделать написать рекурсивную ф-ю для подсчета занимаемого места на диске.

Если возникнут вопросы, пишите, спрашивайте. Буду рад помочь.

Приложение:
procedure TfrmMain.WriteListRecordToFile(ListIndex: Integer; FileName: String);
Var
OutFile: TextFile;
FSett: TFormatSettings;
begin
AssignFile(OutFile, FileName);
if Not FileExists(FileName) // Если файл не существует
then Rewrite(OutFile) // создаем его
else Append(OutFile); // иначе открываем файл для записи в режиме добавления строк
try
WriteLN(OutFile, 'Name:'); // записываем заголовок
WriteLN(OutFile, Self.uList.Items.Item[ListIndex].Caption); // Записываем имя программы
WriteLN(OutFile, 'Publisher:'); // записываем заголовок
WriteLN(OutFile, Self.uList.Items.Item[ListIndex].SubItems.Strings[1]); // Записываем публишера
WriteLN(OutFile, 'Version:'); // записываем заголовок
WriteLN(OutFile, Self.uList.Items.Item[ListIndex].SubItems.Strings[0]); // Записываем версию
WriteLN(OutFile, 'Size:'); // записываем заголовок
WriteLN(OutFile, {Здесь нужна рекурсивная ф-я подсчитывающая размер занимаемый программой});
WriteLN(OutFile, 'Date:'); // записываем заголовок
FSett.ShortDateFormat:='YYYYMMDD';
WriteLN(OutFile, DateToStr(Date, FSett)); // Записываем текущую дату
WriteLN(OutFile, 'UnInstall:'); // записываем заголовок
WriteLN(OutFile, Self.uList.Items.Item[ListIndex].SubItems.Strings[2]); // Записываем версию
WriteLN(OutFile, '*******************************************');
finally
CloseFile(OutFile);
end;
end;

давно

Евгений/Genia007/

Профессионал
153662
1070

27.12.2010, 10:28

общий

это ответ

Здравствуйте, Лукин Андрей!
Вот исправил Ваш исходник

Код:

procedure TfrmMain.btnRefreshClick(Sender: TObject);
var
  theRegistry: TRegistry;
  uEntries: TStrings;
  index: Integer;
  item: TListItem;
  str: integer;
begin
  uList.Clear;
  uEntries := TStringList.Create;
  theRegistry := TRegistry.Create;
  theRegistry.RootKey := HKEY_LOCAL_MACHINE;
  theRegistry.OpenKey(UNINSTALLROOT, False);
  theRegistry.GetKeyNames(uEntries);
  theRegistry.CloseKey;

  for index := 0 to uEntries.Count -1 do begin
    theRegistry.OpenKey(UNINSTALLROOT + uEntries[index], False);
    if theRegistry.ValueExists('DisplayName') then begin
      item := uList.items.add;
      item.Caption := theRegistry.ReadString('DisplayName');
      if theRegistry.ValueExists('DisplayVersion') then
        item.SubItems.Add(theRegistry.ReadString('DisplayVersion')) else
        item.SubItems.Add('null');
      if theRegistry.ValueExists('Publisher') then
        item.SubItems.Add(theRegistry.ReadString('Publisher')) else
        item.SubItems.Add('null');
      if theRegistry.ValueExists('UninstallString') then
        item.SubItems.Add(theRegistry.ReadString('UninstallString')) else
        if theRegistry.ValueExists('QuietUninstallString') then
          item.SubItems.Add(theRegistry.ReadString('QuietUninstallString')) else
          item.SubItems.Add('null');
          if theRegistry.ValueExists('InstallDate') then
            item.SubItems.Add(theRegistry.ReadString('InstallDate')) else
            item.SubItems.Add('null');
            if theRegistry.ValueExists('EstimatedSize') then
              item.SubItems.Add(IntToStr(theRegistry.ReadInteger('EstimatedSize'))) else
              item.SubItems.Add('null');
    end;
    theRegistry.CloseKey;
  end;

  FreeAndNil(theRegistry);
  FreeAndNil(uEntries);
  StatusBar.SimpleText := Format('%d Application(s)', [uList.Items.Count]);
end;

procedure TfrmMain.FormActivate(Sender: TObject);
var
  f: Textfile;
  i: integer;
  j: Real;
  str: string;
begin
  AssignFile(f,'proba.txt');
  Rewrite(f);
  for i:= 0 to uList.Items.Count - 1 do
    begin
      Writeln(f, 'Name:');
      Writeln(f, uList.Items[i].Caption);
      Writeln(f, 'Publisher:');
      Writeln(f, uList.Items[i].SubItems[1]);
      Writeln(f, 'Version:');
      Writeln(f, uList.Items[i].SubItems[0]);
      Writeln(f, 'Size:');
      if uList.Items[i].SubItems[4] <> 'null' then
        begin
          j:= StrToInt(uList.Items[i].SubItems[4]);
          str:= FloatToStrF((j / 1024), ffNumber, 5, 2) + ' Mb';
          Writeln(f, str);
        end
      else
        Writeln(f, 'null');
      Writeln(f, 'Date:');
      Writeln(f, uList.Items[i].SubItems[3]);
      Writeln(f, 'Uninstall:');
      Writeln(f, uList.Items[i].SubItems[2]);
      Writeln(f, '**************');
      Writeln(f, ' ');
    end;
  CloseFile(f);
end;

Прикрепленные файлы:

181625-265123.zip

скачать (259.00 кБ)

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.