「このコマンドを実行するのに十分な記憶域がありません」エラーについて (ID:33938)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

IEオープン/クローズに伴うメモリ使用量モニターテスト方法

IE7はシングルタブにしたり、その他にも設定が必要となりますのでIE6でテストしてください。

手順
1 TButton:2個、TLabel:1個をForm上に配置
2 Unit1.pasを丸ごと以下のソースコードに変更
3 Button1、Button2のOnClickイベントを関連づけてコンパイル
4 適当なサイズのテキストファイルの名称を拡張子の変更も含めて'テスト.html'としてアプリケーションと同じフォルダ階層に置く
5 テスト.htmlをまず一つ開いておく
6 テストプログラム起動
7 Button1クリックでテスト開始(1回目は少し時間がかかるようです。)
8 Button2クリックで終了し、その時点でIE6のメモリ使用量をモニターした'log.txt'が開きます。

※ 実行時にIE6のオープン/クローズを見たい方は 'objIE.Visible:=False;'の部分をTrueにしてください。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ComObj,TlHelp32,PSAPI,ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    TryCount:Integer;
    BaseDirectory:String;
    forAbort:Boolean;

procedure SaveLog(sIEMem:String);
    procedure SaveIEMemory;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveLog(sIEMem:String);
var
  s,TxtInFile:String;
  slTxtIn:TStringList;
begin
    TxtInFile:=BaseDirectory+'log.txt';
    slTxtIn:=TStringList.Create;
    if FileExists(TxtInFile) then begin
        slTxtIn.LoadFromFile(TxtInFile);
        slTxtIn.Insert(0,'');
    end;
    s:=Format('%3S回目 %10S',[IntToStr(TryCount),sIEMem]);
    slTxtIn.Insert(0,s);
    slTxtIn.SaveToFile(TxtInFile);
    slTxtIn.Free;
end;

procedure TForm1.SaveIEMemory;
var
  ProcessID:DWORD;
  ListHandle,hProcess:THandle;
  sExeName:String;
  Flag:Boolean;
  Pr:TProcessEntry32;
  MemInfo:TProcessMemoryCounters;

function UnitConv(MemIn:Cardinal):String;
  var
    Mem:Double;
  begin
      Mem:=MemIn;
      if MemIn<1024 then begin
          Result:=FormatFloat('#,##0 B',Mem);
      end else begin
          Mem:=Mem/1024;

if Mem<1024 then begin
              Result:=FormatFloat('#,##0 KB',Mem);
          end else begin
              Mem:=Mem/1024;
              Result:=FormatFloat('#,##0.00 MB',Mem);
          end;
      end;
  end;
begin
    ListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
    if ListHandle<>-1 then begin
        try
            Pr.dwSize:=sizeof(TProcessEntry32);
            Flag:=Process32First(ListHandle,Pr);
            while Flag do begin
                sExeName:=ExtractFileName(Pr.szExeFile);

try
                    if UpperCase(sExeName)<>'IEXPLORE.EXE' then Continue;

ProcessID:=Pr.th32ProcessID;

FillChar(MemInfo,SizeOf(MemInfo),0);

hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
                    try
                        if hProcess>0 then begin
                            MemInfo.cb:=SizeOf(MemInfo);
                            if GetProcessMemoryInfo(hProcess,@MemInfo,SizeOf(MemInfo)) then begin
                                SaveLog(UnitConv(MemInfo.WorkingSetSize));
                                Break;
                            end;
                        end;
                    finally
                        CloseHandle(hProcess);
                    end;
                finally
                    Flag:=Process32Next(ListHandle,Pr);
                end;
            end;
        finally
            CloseHandle( ListHandle);
        end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i:Integer;
  sURL,sFileName:String;
  objIE:Variant;
begin
    forAbort:=False;

//テストアプリディレクトリー情報
    BaseDirectory:=ExtractFilePath(Application.ExeName);

sURL:=BaseDirectory+'テスト.html';

TryCount:=1;
    for i:=0 to 1000 do begin
        Application.ProcessMessages;

Label1.Caption:=IntToStr(TryCount)+'回目試行中';

//ESCキーで中断
        if GetAsyncKeyState(VK_ESCAPE)<>0 then Break;

//ボタンによる中断
        if forAbort then Break;

//IE操作オブジェクト作成
        objIE:=Createoleobject('InternetExplorer.Application');
        objIE.Visible:=False;

try
            objIE.Navigate(sURL);

while objIE.busy do Application.ProcessMessages;
            while objIE.readyState<>4 do Application.ProcessMessages;

finally
            objIE.Quit;
            objIE:=Unassigned;
            Sleep(500);
        end;

if TryCount=1 then SaveIEMemory;
        if (TryCount mod 5)=0 then SaveIEMemory;

Inc(TryCount);
    end;
    Label1.Caption:=IntToStr(TryCount)+'回目終了';

sFileName:=BaseDirectory+'log.txt';
    ShellExecute(Handle,'open',PChar(sFileName),'',PChar(ExtractFilePath(Application.ExeName)),SW_SHOW);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    forAbort:=True;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る