delphi程序问题

Posted 2023-04-23

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, DB, ADODB, Grids, DBGrids;

type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
DBText1: TDBText;
DBText2: TDBText;
Timer1: TTimer;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Button2: TButton;
ADOTable1: TADOTable;
DataSource1: TDataSource;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Private declarations
public
Public declarations
end;

var
Form1: TForm1;

implementation
const zhu1:string='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False';
$R *.dfm

procedure TForm1.Button1Click(Sender: TObject);
begin

timer1.Enabled :=not timer1.Enabled;
if button1.Caption='开始' then button1.Caption:='停止'
else button1.Caption:='开始';

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if not adotable1.Eof then adotable1.Next
else adotable1.First;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
adotable1.ConnectionString:=zhu1+format(zhu1,[getcurrentdir]);
adotable1.TableName:='stu';
adotable1.Active :=true ;
end;

end.

为什么我点button2就提示我 Microsoft Jet 数据库引擎打不开文件（我数据库的地址）。他已被其他用户用独占方式打开，或没有查看数据权限。
PS：我数据库和程序文件放在同一文件夹
请帮忙修改下程序，万分感谢。

procedure TForm1.Button2Click(Sender: TObject);
begin
adotable1.Active :=False ; //这样试试呢。
adotable1.ConnectionString:=zhu1+format(zhu1,[getcurrentdir]);
adotable1.TableName:='stu';
adotable1.Active :=true ;
end;

end. 参考技术A 数据库 只能在一个程序里打开一次 否则很容易用冲突的 取回数据立即关闭数据库 参考技术B 可能是你已经以用独占方式打开了Access了，把它关掉，再打开这个程序就行了

如何获取 Delphi 程序使用的内存

【中文标题】如何获取 Delphi 程序使用的内存

【英文标题】：How to get the Memory Used by a Delphi Program

【发布时间】：2010-10-01 01:29:51

【问题描述】：

我知道如何使用 GlobalMemoryStatusEx 获取系统内存使用情况，但这告诉我整个操作系统正在使用什么。

我真的希望我的程序报告它单独分配和使用了多少内存。

在我的 Delphi 2009 程序中是否有任何方法可以调用 Windows 函数或某些 FastMM 函数来找出仅由我的程序分配的内存？

---

重新审视我的问题，我现在已将我接受的答案更改为 @apenwarr 的 GetMemoryManagerState 答案。它产生的结果与我过去使用的 GetHeapStatus 函数（现已弃用）相同，而 GetProcessMemoryInfo.WorkingSetSize 给出了非常不同的结果。

【参考方案1】：

您可以从 Delphi 运行时中获取有用的内存使用信息，而无需使用任何直接的 Win32 调用：

unit X;

uses  FastMM4; //include this or method will return 0.
....

function GetMemoryUsed: UInt64;
var
  st: TMemoryManagerState;
  sb: TSmallBlockTypeState;
begin
  GetMemoryManagerState(st);
  result :=  st.TotalAllocatedMediumBlockSize
           + st.TotalAllocatedLargeBlockSize;
  for sb in st.SmallBlockTypeStates do begin
    result := result + sb.UseableBlockSize * sb.AllocatedBlockCount;
  end;
end;

这种方法的最佳之处在于它被严格跟踪：当您分配内存时，它会上升，而当您释放内存时，它会立即下降相同的数量。我在运行每个单元测试之前和之后都使用它，所以我可以判断哪个测试正在泄漏内存（例如）。

【讨论】：

此方法在使用FastMM4或delphi 2006+时有效，但如果你没有使用FastMM4，你应该考虑开始使用它！

这可能是我在 *** 上见过的最好和最有用的答案。我希望我能投票 100 次。

除上述之外，此方法显示应用程序分配的内存量，而不是它使用的内存量（如由 3rd 方 dll、ocx/ COM 等）为此，如果将 MemCounters.PagefileUsage 也添加到结果中，下面 Jim McKeeth 给出了一个更可靠的解决方案。

小备注：您必须在您正在实施的单元中使用（=在使用部分中设置它）FastMM4。仅在项目单元中添加 FastMM4 是不够的。

@rvheddeg 非常重要的“小评论”。如果你不这样做，它只会返回 0。它拯救了我的一天，谢谢。

【参考方案2】：

From an old blog post of mine.

想知道您的程序使用了多少内存？这个 Delphi 函数可以解决问题。

uses psAPI;

...

function CurrentProcessMemory: Cardinal;
var
  MemCounters: TProcessMemoryCounters;
begin
  MemCounters.cb := SizeOf(MemCounters);
  if GetProcessMemoryInfo(GetCurrentProcess,
      @MemCounters,
      SizeOf(MemCounters)) then
    Result := MemCounters.WorkingSetSize
  else
    RaiseLastOSError;
end;

不知道我从哪里得到了这个基础知识，但我添加了一些更好的错误处理并使它成为一个函数。 WorkingSetSize 是当前使用的内存量。您可以使用类似的代码来获取当前进程（或任何进程）的其他值。您需要在您的使用声明中包含 psAPI。

PROCESS_MEMORY_COUNTERS 记录包括：

PageFaultCount PeakWorkingSetSize 工作集大小 QuotaPeakPagedPoolUsage QuotaPagedPoolUsage QuotaPeakNonPagedPoolUsage QuotaNonPagedPoolUsage 页面文件使用情况 页面文件使用峰值

您可以在任务管理器或进程资源管理器中找到所有这些值。

【讨论】：

此函数的输出数不断增长，显示已使用 7000064 字节 RAM，但任务管理器显示该进程正在使用 1972 kb 的 RAM。顺便说一句，您博客的链接已失效。

【参考方案3】：

当您从 SourceForge 下载完整的 FastMM4 包时，您可以查看一个示例，了解如何将 FastMM 与演示随附的 UsageTrackerDemo 项目一起使用。

【参考方案4】：

我写了这个小函数来返回当前进程（app）的内存使用情况：

function ProcessMemory: longint;
var
  pmc: PPROCESS_MEMORY_COUNTERS;
  cb: Integer;
begin
  // Get the used memory for the current process
  cb := SizeOf(TProcessMemoryCounters);
  GetMem(pmc, cb);
  pmc^.cb := cb;
  if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
     Result:= Longint(pmc^.WorkingSetSize);

  FreeMem(pmc);
end;

【讨论】：

为什么要使用 GetMem？只需在此处声明一个 TProcessmemoryCounters 变量，而不是使用动态变量。

这就是答案，经过 Rob 的优化。

这取决于您认为的内存使用情况。此代码为您提供工作集大小，并且是任务管理器所说的内存使用情况。但这远远不是一个进程正在使用的内存量。它是当前在 RAM 中而不是页面文件中的部分。

【参考方案5】：

GantC++ 代码转换为 Delphi 中的控制台应用程序：

    program MemoryProcessCMD;

    * Based in Gant(https://***.com/users/12460/gant) code*


    $APPTYPE CONSOLE
    $R *.res

    uses
      System.SysUtils,
      psapi,
      Windows;

    procedure PrintMemoryInfo(processID: DWORD);
    var
      hProcess: THandle;
      pmc: PROCESS_MEMORY_COUNTERS;
      total: DWORD;

    begin

      // Print the process identifier.
      Writeln(format('Process ID: %d', [processID]));

      // Print information about the memory usage of the process.
      hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE,
        processID);

      if (hProcess = 0) then
      begin
        exit;
      end;

      if (GetProcessMemoryInfo(hProcess, @pmc, SizeOf(pmc))) then
      begin
        Writeln(format(#09'PageFaultCount: 0x%.8X', [pmc.PageFaultCount]));
        Writeln(format(#09'PeakWorkingSetSize: 0x%.8X', [pmc.PeakWorkingSetSize]));
        Writeln(format(#09'WorkingSetSize: 0x%.8X', [pmc.WorkingSetSize]));
        Writeln(format(#09'QuotaPeakPagedPoolUsage: 0x%.8X',
          [pmc.QuotaPeakPagedPoolUsage]));
        Writeln(format(#09'QuotaPagedPoolUsage: 0x%.8X',
          [pmc.QuotaPagedPoolUsage]));
        Writeln(format(#09'QuotaPeakNonPagedPoolUsage: 0x%.8X',
          [pmc.QuotaPeakNonPagedPoolUsage]));
        Writeln(format(#09'QuotaNonPagedPoolUsage: 0x%.8X',
          [pmc.QuotaNonPagedPoolUsage]));
        Writeln(format(#09'PagefileUsage: 0x%.8X', [pmc.PagefileUsage]));
        Writeln(format(#09'PeakPagefileUsage: 0x%.8X', [pmc.PeakPagefileUsage]));
        Writeln(format(#09'PagefileUsage: 0x%.8X', [pmc.PagefileUsage]));
      end;

      CloseHandle(hProcess);
    end;

    var
      aProcesses: array [0 .. 1024] of DWORD;
      cbNeeded, cProcesses: DWORD;
      i: Integer;

    begin
      try
        // Get the list of process identifiers.
        if (not EnumProcesses(@aProcesses, SizeOf(aProcesses), &cbNeeded)) then
          halt(1);

        // Calculate how many process identifiers were returned.
        cProcesses := cbNeeded div SizeOf(DWORD);

        // Print the memory usage for each process
        for i := 0 to cProcesses - 1 do
        begin
          PrintMemoryInfo(aProcesses[i]);
        end;
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;

    end.

【参考方案6】：

对于 Win32 API 方式，您需要 GetProcessMemoryInfo 函数。这是来自MSDN page 的示例，但代码使用 C++。我认为您也可以将其转换为 Delphi。您正在查找的内容可能称为“工作集大小”。

#include <windows.h>
#include <stdio.h>
#include <psapi.h>

void PrintMemoryInfo( DWORD processID )

    HANDLE hProcess;
    PROCESS_MEMORY_COUNTERS pmc;

    // Print the process identifier.

    printf( "\nProcess ID: %u\n", processID );

    // Print information about the memory usage of the process.

    hProcess = OpenProcess(  PROCESS_QUERY_INFORMATION |
                                    PROCESS_VM_READ,
                                    FALSE, processID );
    if (NULL == hProcess)
        return;

    if ( GetProcessMemoryInfo( hProcess, &pmc, sizeof(pmc)) )
    
        printf( "\tPageFaultCount: 0x%08X\n", pmc.PageFaultCount );
        printf( "\tPeakWorkingSetSize: 0x%08X\n", 
                  pmc.PeakWorkingSetSize );
        printf( "\tWorkingSetSize: 0x%08X\n", pmc.WorkingSetSize );
        printf( "\tQuotaPeakPagedPoolUsage: 0x%08X\n", 
                  pmc.QuotaPeakPagedPoolUsage );
        printf( "\tQuotaPagedPoolUsage: 0x%08X\n", 
                  pmc.QuotaPagedPoolUsage );
        printf( "\tQuotaPeakNonPagedPoolUsage: 0x%08X\n", 
                  pmc.QuotaPeakNonPagedPoolUsage );
        printf( "\tQuotaNonPagedPoolUsage: 0x%08X\n", 
                  pmc.QuotaNonPagedPoolUsage );
        printf( "\tPagefileUsage: 0x%08X\n", pmc.PagefileUsage ); 
        printf( "\tPeakPagefileUsage: 0x%08X\n", 
                  pmc.PeakPagefileUsage );
    

    CloseHandle( hProcess );


int main( )

    // Get the list of process identifiers.

    DWORD aProcesses[1024], cbNeeded, cProcesses;
    unsigned int i;

    if ( !EnumProcesses( aProcesses, sizeof(aProcesses), &cbNeeded ) )
        return 1;

    // Calculate how many process identifiers were returned.

    cProcesses = cbNeeded / sizeof(DWORD);

    // Print the memory usage for each process

    for ( i = 0; i < cProcesses; i++ )
        PrintMemoryInfo( aProcesses[i] );

    return 0;

【讨论】：

感谢您启动它。答案正确，但语言错误且过于复杂。