Thema: Delphi Memory Information?

Einzelnen Beitrag anzeigen

Razor
(Gast)

n/a Beiträge
 
#23

Re: Memory Information?

  Alt 6. Aug 2007, 11:36
Gotcha,make sure you test this Muetze1

Delphi-Quellcode:
unit PCI;

interface

uses OMCDrv, CmnTnC, hPCI;

type
  DWord = LongWord;

  tPCIDevices = record
    DevRegs: tDevRegs;
    ClassDescr, DeviceDescr: string[80];
    DeviceDump: array[0..$FF] of byte;
    Detected: boolean;
  end;

type
  cPCIInfo = class
  private
    DatFileName: string;

    procedure GetClassDescr;
    procedure GetDeviceDescr;

    function GetFileFromResource: string;
    function ReadFromDatFile(Section, Ident, DefValue: string): string;
  public
    PCIDevices: array of tPCIDevices;
    DevCount: byte;
    Scanned: boolean;
    NorthBridge, SouthBridge: tPCIDevices;

    procedure ScanPCIBus;

    constructor Create;
    destructor Destroy;
  end;

function GetPciInfoInstance(): cPCIInfo;

implementation

uses SysUtils, Classes, Windows, Dialogs;

var
  this_: cPCIInfo;

function GetPciInfoInstance(): cPCIInfo;
begin
  if (not Assigned(this_)) then this_ := cPCIInfo.Create;
  result := this_;
end;

{$I DevClass.inc}
{$R PCIInfoData.res}

constructor cPCIInfo.Create;
begin
  inherited Create;
  Scanned := false;
  ScanPCIBus;
end;

procedure cPCIInfo.ScanPCIBus;
var
  dwBus, dwDev, dwFunc: byte;
  pdata: DWord;
  bdata, DevInd, i: byte;
begin
  if not GetInstance.isLoad then exit;
  DevCount:=0;
  SetLength(PCIDevices,DevCount);
  for dwBus:=0 to 255 do
    for dwDev:=0 to 31 do
      begin
        if not GetInstance.IPCIIORef.ProbeDevice(dwBus, dwDev) then continue;
        for dwFunc:=0 to 7 do
          begin
            GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, 0, pdata);
            if pdata=$FFFFFFFF then continue;
            if dwFunc=0 then DevInd:=DevCount;
            GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, 8, pdata);
            if DevInd>=1 then
              begin
                pdata:=(pdata shr 8);
                if pdata=PCIDevices[DevInd].DevRegs.ClassCode then continue;
              end;
            inc(DevCount);
            SetLength(PCIDevices,DevCount);

            PCIDevices[DevCount-1].DevRegs.dwBus:=dwBus;
            PCIDevices[DevCount-1].DevRegs.dwDev:=dwDev;
            PCIDevices[DevCount-1].DevRegs.dwFunc:=dwFunc;

            GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, 0, pdata);
            PCIDevices[DevCount-1].DevRegs.VendorID:=Word(pdata);
            PCIDevices[DevCount-1].DevRegs.DeviceID:=Word(pdata shr 16);

            GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, 8, pdata);
            PCIDevices[DevCount-1].DevRegs.RID := Byte(pdata);
            PCIDevices[DevCount-1].DevRegs.ClassCode:=pdata shr 8;

            GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, $2C, pdata);
            PCIDevices[DevCount-1].DevRegs.SVID := Word(pdata);
            PCIDevices[DevCount-1].DevRegs.SID := Word(pdata shr 16);
            
            for i:=0 to $FF do
              begin
                GetInstance.IPCIIORef.GetPCIRByte(dwBus, dwDev, dwFunc, i, bdata);
                PCIDevices[DevCount-1].DeviceDump[i]:=bdata;
              end;
          end;
      end;
  GetClassDescr;
  DatFileName:=GetFileFromResource;
  GetDeviceDescr;
  Scanned := true;
end;

procedure cPCIInfo.GetClassDescr;
var
  i, j: byte;
begin
  for i:=Low(PCIDevices) to High(PCIDevices) do
    begin
      for j:=Low(fDevClassTable) to High (fDevClassTable) do
        begin
          if PCIDevices[i].DevRegs.ClassCode = fDevClassTable[j].DevClass then
            begin
              PCIDevices[i].ClassDescr:=fDevClassTable[j].ClassDescr;
              break;
            end;
        end;
    end;
end;

procedure cPCIInfo.GetDeviceDescr;
  function IntToHexForm(val: integer; index: byte): string;
  var
    i: byte;
  begin
    result:=(format('%x',[val]));
    for i:=1 to index-Length(result) do
      insert('0', result, 0);
  end;
var
  i, j: byte;
  ident: string;
begin
  for i:=Low(PCIDevices) to High(PCIDevices) do
    begin
      ident:=IntToHexForm(PCIDevices[i].DevRegs.VendorID, 4)+IntToHexForm(PCIDevices[i].DevRegs.DeviceID, 4);
      case PCIDevices[i].DevRegs.ClassCode of
        $060000: begin
          PCIDevices[i].DeviceDescr:=ReadFromDatFile('NorthBridge', ident, 'Unknown device');
          if NorthBridge.Detected then continue;
          NorthBridge.DevRegs.VendorID:=PCIDevices[i].DevRegs.VendorID;
          NorthBridge.DevRegs.DeviceID:=PCIDevices[i].DevRegs.DeviceID;
          NorthBridge.DevRegs.ClassCode:=PCIDevices[i].DevRegs.ClassCode;
          NorthBridge.DevRegs.dwBus:=PCIDevices[i].DevRegs.dwBus;
          NorthBridge.DevRegs.dwDev:=PCIDevices[i].DevRegs.dwDev;
          NorthBridge.DevRegs.dwFunc:=PCIDevices[i].DevRegs.dwFunc;
          NorthBridge.DeviceDescr:=PCIDevices[i].DeviceDescr;
          NorthBridge.Detected:=true;
        end;
        $060100, $060200: begin
          PCIDevices[i].DeviceDescr:=ReadFromDatFile('SouthBridge', ident, 'Unknown device');
          if SouthBridge.Detected then continue;
          SouthBridge.DevRegs.VendorID:=PCIDevices[i].DevRegs.VendorID;
          SouthBridge.DevRegs.DeviceID:=PCIDevices[i].DevRegs.DeviceID;
          SouthBridge.DevRegs.ClassCode:=PCIDevices[i].DevRegs.ClassCode;
          SouthBridge.DevRegs.dwBus:=PCIDevices[i].DevRegs.dwBus;
          SouthBridge.DevRegs.dwDev:=PCIDevices[i].DevRegs.dwDev;
          SouthBridge.DevRegs.dwFunc:=PCIDevices[i].DevRegs.dwFunc;
          SouthBridge.DeviceDescr:=PCIDevices[i].DeviceDescr;
          SouthBridge.Detected:=true;
        end;
      end;
    end;
end;

function cPCIInfo.GetFileFromResource: string;
var
  TR:TResourceStream;
  lpBuffer: array[0..255] of Char;
begin
  GetWindowsDirectory(lpBuffer, 255);
  result:=StrPas(lpBuffer)+'\PCIinfo.dat';
  try
    DeleteFile(PAnsiChar(result));
  except
  end;
  if FileExists(result) then exit;
  TR:=TResourceStream.Create(0, 'PCIINFODATA', RT_RCDATA);
  TR.SaveToFile(result);
  TR.Free;
end;

function cPCIInfo.ReadFromDatFile(Section, Ident, DefValue: string): string;
var
  DatFile: TextFile;
  TmpStr, TmpStr2: string;
  i: DWord;
begin
  try
  //ShowMessage(Ident); //debug message
  AssignFile(DatFile, DatFileName);
  Reset(DatFile);
  result:=DefValue;
  //Finding proper section
  while not eof(DatFile) do
    begin
      readln(DatFile, TmpStr);
      if TmpStr<>'then
      if TmpStr[1]='[then
        begin
          Delete(TmpStr, 1, 1); Delete(TmpStr, length(TmpStr), 1);
          if TmpStr=Section then
            begin
              while not eof(DatFile) do
                begin
                  readln(DatFile, TmpStr);
                  if TmpStr<>'then
                  if TmpStr[1]<>';then
                    begin
                      if TmpStr[1]='[then exit;
                      TmpStr2:=Copy(TmpStr, 1, 8);
                      if TmpStr2=Ident then
                                         begin
                                           result:=Copy(TmpStr, 10, length(TmpStr)-10+1);
                                           exit;
                                         end;
                    end;
                end;
            end;
        end;
    end;
  CloseFile(DatFile);
  except
    result:=DefValue;
  end;
end;

destructor cPCIInfo.Destroy;
begin
  DevCount:=0;
  SetLength(PCIDevices,DevCount);
  try
    DeleteFile(PAnsiChar(DatFileName));
  except
  end;
  inherited Destroy;
end;

initialization
  this_ := nil;

finalization
  if (Assigned(this_)) then this_.Destroy;

end.
  Mit Zitat antworten Zitat