На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> утечка памяти
    Ребята добрый день.
    Скачал пример из интернета.. но увы имею утечку памяти примерно в 40 байт за цикл в этой строчке кода
    ExpandedWrap disabled
      while Enumerator.Next(1, System, j) = S_OK do


    Посоветуйте как избавиться от утечки памяти.
    что только не пробывал. даже отдельный поток с освобождением памяти по завершению

    Скаченный пример:
    ExpandedWrap disabled
      unit Unit1;
      interface
      uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls;
      type
      TForm1 = class(TForm)
      lst1: TListBox;
      btn1: TButton;
      procedure btn1Click(Sender: TObject);
      private
      { Private declarations }
      public
      { Public declarations }
      end;
      var
      Form1: TForm1;
      implementation
      {$R *.dfm}
      uses ActiveX, ComObj;
      procedure TForm1.btn1Click(Sender: TObject);
      Var Enumerator: IEnumVariant;
      WbemLocator, WbemServices, WbemObjectSet: Variant;
      Properties: IEnumVariant;
      Property_, System: OleVariant;
      j: LongWord;
      sProperty: string;
      VID,PID,Serial: ShortString;
      begin
      lst1.Clear;
      WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
      WbemServices := WbemLocator.ConnectServer;
      WbemObjectSet := WbemServices.InstancesOf('Win32_usbhub');
      Enumerator := IEnumVariant(TVarData(WbemObjectSet._NewEnum).VDispatch);
      try
      while Enumerator.Next(1, System, j) = S_OK do
      try
      try
      if (System.Caption <> 'Запоминающее устройство для USB') then Continue;
      except end;
      Properties := IEnumVariant(TVarData(System.Properties_._NewEnum).VDispatch);
      while Properties.Next(1, Property_, j) = S_OK do
      begin
      sProperty := VarToStr(Property_.Value);
      if (Property_.Name = 'DeviceID') then
      begin
      VID := Copy(sProperty, Pos('VID_',sProperty)+4,4);
      PID := Copy(sProperty, Pos('PID_',sProperty)+4,4);
      Serial := Copy(sProperty, Pos('PID_',sProperty)+9,Length(sProperty)-Pos('PID_',sProperty)+10);
      if ((Pos('\',Serial) > 0)) then
      Begin
      Serial := Copy(Serial,Pos('\',Serial)+1,Length(Serial)-Pos('\',Serial));
      end;
      lst1.Items.Add('VID: '+ VID + ' PID: ' + PID + ' SERIAL: ' + Serial);
      end;
      end;
      except end;
      except end;
      end;
      end.
    Сообщение отредактировано: Emmys -
      Читал статью. подкоректрировал код но не помогло
      https://www.gunsmoker.ru/2011/05/9.html

      ExpandedWrap disabled
        procedure list;
         
        //обновляем список значений переменных в самом списке  VariableList
        Var Enumerator: IEnumVariant;
        WbemObjectSet: Variant;
        Properties: IEnumVariant;
        Property_, System: OleVariant;
        j: LongWord;
        sProperty: string;
        VID,PID,Serial: ShortString;
         WbemLocator, WbemServices: Variant;
        begin
        form1.lsttmp.Clear;
         
        WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        WbemServices := WbemLocator.ConnectServer;
        WbemObjectSet := WbemServices.InstancesOf('Win32_usbhub');
        Enumerator := IEnumVariant(TVarData(WbemObjectSet._NewEnum).VDispatch);
         
         
         
          while Enumerator.Next(1, System, j) = S_OK do begin
         
         
         
              if (System.Caption ='Запоминающее устройство для USB') then begin
         
         
         
         
              Properties := IEnumVariant(TVarData(System.Properties_._NewEnum).VDispatch);
         
              VariantClear(System);
         
         
                  while Properties.Next(1, Property_, j) = S_OK do        begin
                  sProperty := VarToStr(Property_.Value);
                        if (Property_.Name = 'DeviceID') then
                    begin
                 VID := Copy(sProperty, Pos('VID_',sProperty)+4,4);
                 PID := Copy(sProperty, Pos('PID_',sProperty)+4,4);
                 Serial := Copy(sProperty, Pos('PID_',sProperty)+9,Length(sProperty)-Pos('PID_',sProperty)+10);
                  if ((Pos('\',Serial) > 0)) then
               Begin
                Serial := Copy(Serial,Pos('\',Serial)+1,Length(Serial)-Pos('\',Serial));
               end;
                form1.lsttmp.Add('VID='+VID+'PID='+PID+'Serial='+Serial);
         
         
         
                    end;
         
         
                 end;
         
         
         
         
         
              end;
         
         
         
         
         
         
           VariantInit(System);
           VariantClear(System);
            VariantInit(Property_);
             VariantClear(Property_);
          end;
         
         
         
         
         
         
         VariantClear(Property_);
         VariantClear(System);
         
         
         WbemObjectSet := Unassigned;
         WbemLocator := Unassigned;
         WbemServices := Unassigned;
         Property_:=Unassigned;
         System :=Unassigned;
         
         
         
         
         
         
         
        end;


      Добавлено
      ответ таков. нужно сначала очистить. а потом еще и иницилизировать

      Добавлено
      ExpandedWrap disabled
        procedure list;
         
        //обновляем список значений переменных в самом списке  VariableList
        Var Enumerator: IEnumVariant;
        WbemObjectSet: Variant;
        Properties: IEnumVariant;
        Property_: OleVariant;
         
         
        j: LongWord;
        sProperty: string;
        VID,PID,Serial: ShortString;
         WbemLocator, WbemServices: Variant;
        begin
        form1.lsttmp.Clear;
         
        WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        WbemServices := WbemLocator.ConnectServer;
        WbemObjectSet := WbemServices.InstancesOf('Win32_usbhub');
        Enumerator := IEnumVariant(TVarData(WbemObjectSet._NewEnum).VDispatch);
         
         
            VariantInit(form1.tmpOut);
           VariantInit(Property_);
          VariantClear(form1.tmpOut);
          VariantClear(Property_);
          while Enumerator.Next(1, form1.tmpOut, j) = S_OK do begin
         
         
         
              if (form1.tmpOut.Caption ='Запоминающее устройство для USB') then begin
         
         
         
         
              Properties := IEnumVariant(TVarData(form1.tmpOut.Properties_._NewEnum).VDispatch);
         
         
         
         
                  while Properties.Next(1, Property_, j) = S_OK do        begin
                  sProperty := VarToStr(Property_.Value);
                        if (Property_.Name = 'DeviceID') then
                    begin
                 VID := Copy(sProperty, Pos('VID_',sProperty)+4,4);
                 PID := Copy(sProperty, Pos('PID_',sProperty)+4,4);
                 Serial := Copy(sProperty, Pos('PID_',sProperty)+9,Length(sProperty)-Pos('PID_',sProperty)+10);
                  if ((Pos('\',Serial) > 0)) then
               Begin
                Serial := Copy(Serial,Pos('\',Serial)+1,Length(Serial)-Pos('\',Serial));
               end;
                form1.lsttmp.Add('VID='+VID+'PID='+PID+'Serial='+Serial);
         
         
         
                    end;
         
                   VariantClear(Property_);
                   VariantInit(Property_);
         
                 end;
         
         
         
         
         
              end;
         
         
         
         
         
         
         
          VariantClear(form1.tmpOut);
           VariantInit(form1.tmpOut);
         
          end;
         
         
         
          VariantInit(form1.tmpOut);
          VariantInit(Property_);
         
         
         
         WbemObjectSet := Unassigned;
         WbemLocator := Unassigned;
         WbemServices := Unassigned;
         
         
         
         
         
         
         
        end;
      Сообщение отредактировано: Emmys -
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0318 ]   [ 17 queries used ]   [ Generated: 19.04.24, 13:21 GMT ]