cmonitoring.~pas

来自「pipe类 pipe类 pipe类 pipe类 pipe类」· ~PAS 代码 · 共 542 行 · 第 1/2 页

unit CMonitoring;

uses
  {$ifdef OMCDrv}
    OMCDrv,
  {$endif}
  {$ifdef ATTDrv}
    ATTDrv,
  {$endif}

interface

const
   KnownWBSensorsID: set of byte = [$21, $80, $90, $30, $10, $11, $60, $88, $A1];
   KnownITESensorsID: set of byte = [$5, $12];

   SMB_DISABLE = 0;
   SMB_ENABLE = 1;
   SMB_IMPORT_DEVICES = 2;

type
  tBus = (bUnknown, bISA, bSMB, bUGURU);
  tsmbDevType = (SIO, Diode, VIDc, PLL, SPD);

  tChipProp = packed record
    VoltagesCount,
    Presets,
    TemperaturesCount,
    RPMsCount,
    PWMsCount: Byte;
  end;

  tChip = packed record
    //Common
    SensorNum: byte;
    NameStr, BusAccessStr: shortstring;
    ChipProp: tChipProp;
    Bus: tBus;
    smbDevType: tSMBDevType;
    //ISA specific
    isaBasePort: word;
    //SMBus specific
    smbHostNum, smbDevice: longword;
  end;

  tFANstatus = packed record
    Divisor, Count: byte;
    RPM: Word;
  end;

  tGetMethod = function(Index: byte; const Chip: tChip; var value: single): boolean;
  tGetVoltageMethod = function(Index: byte; const Chip: tChip; var value: single; preset: byte): boolean;
  tGetFanMethod = function(Index: byte; const Chip: tChip; var value: tFANstatus): boolean;

  tSetMethod = function(Index: byte; const Chip: tChip; const value: single): boolean;

  tProbeMethod = function(HostNum: Word; addr: Byte): Boolean;

  tChipMethod = packed record
    Chip: tChip;
    GetVoltageMethod: tGetVoltageMethod;
    SetVoltageMethod: tSetMethod;
    GetTemperatureMethod: tGetMethod;
    GetFanMethod: tGetFanMethod;
  end;

  iMonitoring = interface
  ['{A751951F-F142-41EB-9D40-3651802765E5}']
    function GetChipProp:tChipProp;
    function GetTemperature(index: word): single;
    function GetVoltage(index: word; preset: byte): single;
    function GetFan(index: word): tFANstatus;

    function GetChipCount: Byte;
    function GetCurrentChip: Byte;
    procedure SetCurrentChip(Number: byte);
    function GetNameStr: shortstring;
    function GetBusAccessStr: shortstring;
    procedure ExportSMBDevices;

    property ChipCount: byte read GetChipCount;
    property CurrentChip: byte read GetCurrentChip write SetCurrentChip;

    property ChipNameStr: shortstring read GetNameStr;
    property BusAccessStr: shortstring read GetBusAccessStr;

    property ChipProperties: tChipProp read GetChipProp;
    property Temperature[index: word]: single read GetTemperature;
    property Voltage[index: word; preset: byte]: single read GetVoltage;
    property Fan[index: word]:tFANstatus read GetFan;
  end;
  
  tMonitoring = class(TInterfacedObject, iMonitoring)
  private
    oHWIO: tOMCDrv;
    fMutexISA, fMutexSMB, fMutexUGURU: tHandle;

    fSMBusHostID: byte;

    fChipCount, fCurrentChip: byte;
    faChips: array of tChipMethod;

    procedure Detect(smbStat: Byte);
    procedure AddISAChip(isaSensorNum: byte; isaBasePort: word);
    procedure ISA_SensorsDetect;
    procedure AddSMBChip(smbSensorNum: byte; smbHostNum: LongWord; smbDevice: Byte);
    procedure SMB_DevicesDetect;
    procedure ImportSMBDevices;

    function GetChipCount: Byte;
    function GetCurrentChip: Byte;
    procedure SetCurrentChip(Number: byte);

    function GetChipProp:tChipProp;
    function GetTemperature(index: word): single;
    function GetVoltage(index: word; preset: byte): single;
    function GetFan(index: word): tFANstatus;

    function GetNameStr: shortstring;
    function GetBusAccessStr: shortstring;

// bus arbitration
    function WaitForBusReady(Bus: tBus = bUnknown): boolean;
    procedure SetBusReady(Bus: tBus = bUnknown);

  public
    constructor Create(smbStat: Byte = SMB_DISABLE);
    destructor Destroy; override;
    procedure ExportSMBDevices;

    property ChipCount: byte read fChipCount;
    property CurrentChip: byte read fCurrentChip write SetCurrentChip;

    property ChipNameStr: shortstring read GetNameStr;
    property BusAccessStr: shortstring read GetBusAccessStr;

    property ChipProperties: tChipProp read GetChipProp;
    property Temperature[index: word]: single read GetTemperature;
    property Voltage[index: word; preset: byte]: single read GetVoltage;
    property Fan[index: word]:tFANstatus read GetFan;
  end;

implementation

{$define OMCDrv}
//{$define ATTDrv}

uses
  SMBus,
  SysUtils, Windows
  {, Dialogs};

type

  tISA_Sensor = packed record
    Num: byte;
    //Sensor ID
    ID: Word;
    Name: ShortString;
    TM: tGetMethod;
    VM: tGetVoltageMethod;
    FM: tGetFanMethod;
    SM: tSetMethod;
    ChipProp: tChipProp;
    Bus: tBus;
    Detected: boolean;
  end;

  tSMB_Device = packed record
    Num: byte;
    //Sensor ID
    ID: Word;
    Name: ShortString;
    PM: tProbeMethod;
    TM: tGetMethod;
    VM: tGetVoltageMethod;
    FM: tGetFanMethod;
    SM: tSetMethod;
    ChipProp: tChipProp;
    Bus: tBus;
    DevRange: Set of Byte;
    smbDevType: tSMBDevType;
  end;

  tSensorProperties = packed record
    Num: byte;
    ID: Word;
    VoltagesCount,
    TemperaturesCount,
    RPMsCount,
    PWMsCount: byte;
  end;

const
  KnownISASensors = 16;
  KnownSMBDevices = 9;

{$I ISASensors.inc}
{$I SMBSensors.inc}
{$I uGuru.inc}

var
  ISABasePorts: array [0..1] of word = ($290, $EC00);

  ISA_Sensors: array [0..KnownISASensors - 1] of tISA_Sensor =
    (
     (num: 0; id: 0;   name: 'Unknown';            TM: nil;                        VM: nil;                        FM: nil; SM: nil;        ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 0; RPMsCount: 0; PWMsCount: 0); Bus: bUnknown; Detected: false),
     (num: 1; id: $21; name: 'Winbond W83627HF/F'; TM: StdWinbondGetTemperature;   VM: W83627HFGetVoltage;         FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 9; Presets: 9; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 2; id: $80; name: 'Winbond W83637HF';   TM: StdWinbondGetTemperature;   VM: W83637HF_W83782DGetVoltage; FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 9; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 3; id: $90; name: 'Winbond W83627THF';  TM: StdWinbondGetTemperature;   VM: W83627THFGetVoltage;        FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 9; Presets: 1; TemperaturesCount: 3; RPMsCount: 2; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 4; id: $30; name: 'Winbond W83782D';    TM: StdWinbondGetTemperature;   VM: W83637HF_W83782DGetVoltage; FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 9; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 5; id: $10; name: 'Winbond W83781D';    TM: StdWinbondGetTemperature;   VM: W83781DGetVoltage;          FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 7; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 6; id: $60; name: 'Winbond W83697HF';   TM: W83697HFGetTemperature;     VM: W83697HFGetVoltage;         FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 9; Presets: 1; TemperaturesCount: 2; RPMsCount: 2; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 7; id: $88; name: 'Winbond W83627EHF';  TM: StdWinbondGetTemperature;   VM: W83627EHFGetVoltage;        FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 10; Presets: 1; TemperaturesCount: 3; RPMsCount: 4; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 8; id: $A1; name: 'Winbond W83647HF';  TM: StdWinbondGetTemperature;   VM: W83627EHFGetVoltage;        FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 10; Presets: 1; TemperaturesCount: 3; RPMsCount: 4; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 9; id: $101; name: 'Unknown Winbond chip[Please report]';   TM: StdWinbondGetTemperature;   VM: StdGetVoltage; FM: StdWinbondGetFan; SM: nil; ChipProp: (VoltagesCount: 2; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),

     (num: 10; id: $5;  name: 'ITE IT8705F';        TM: StdITEGetTemperature;     VM: IT8705FGetVoltage; FM: StdITEGetFan; SM: nil; ChipProp: (VoltagesCount: 9; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 11; id: $12; name: 'ITE IT8712F';        TM: StdITEGetTemperature;     VM: IT8712FGetVoltage; FM: StdITEGetFan; SM: nil; ChipProp: (VoltagesCount: 9; Presets: 12; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 12; id: $102; name: 'Unknown ITE chip[Please report]';     TM: StdITEGetTemperature;     VM: StdGetVoltage; FM: StdITEGetFan; SM: nil; ChipProp: (VoltagesCount: 2; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),

     (num: 13; id: $11; name: 'Asus AS99127F';    TM: StdWinbondGetTemperature;   VM: W83781DGetVoltage;          FM: StdWinbondGetFan; SM: nil;        ChipProp: (VoltagesCount: 7; Presets: 1; TemperaturesCount: 3; RPMsCount: 3; PWMsCount: 0); Bus: bISA; Detected: false),

     (num: 14; id: $200; name: 'Unknown Fintek chip[Please report]';  TM: nil; VM: nil; FM: nil; SM: nil; ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 0; RPMsCount: 0; PWMsCount: 0); Bus: bISA; Detected: false),
     (num: 15; id: $201; name: 'Fintek F71872';  TM: F71872GetTemperature; VM: F71872GetVoltage; FM: nil; SM: nil; ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 3; RPMsCount: 0; PWMsCount: 0); Bus: bISA; Detected: false)
    );

  SMB_Devices: array [0..KnownSMBDevices - 1] of tSMB_Device =
  (
    (num: 0; id: LM75_ID;    name: 'LM75';           PM: LM75Probe;     TM: LM75GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 1; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$48..$4f]; smbDevType: Diode),
    (num: 1; id: ASB100_ID;  name: 'Asus ASB100';    PM: ASB100Probe;   TM: ASB100GetTemperature; VM: ASB100GetVoltage; FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 7; Presets: 1; TemperaturesCount: 2; RPMsCount: 3; PWMsCount: 0); Bus: bSMB; DevRange: [$2d];      smbDevType: SIO),
    (num: 2; id: ATXP1_ID;   name: 'Attansic ATXP1'; PM: ATXP1Probe;    TM: nil;                  VM: ATXP1GetVoltage;  FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 2; Presets: 1; TemperaturesCount: 0; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$37, $4e]; smbDevType: VIDc),
    (num: 3; id: LM90_ID;    name: 'LM90';           PM: LM90Probe;     TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c]; smbDevType: Diode),
    (num: 4; id: LM99_ID;    name: 'LM99';           PM: LM99Probe;     TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c, $4d]; smbDevType: Diode),
    (num: 5; id: LM86_ID;    name: 'LM86';           PM: LM86Probe;     TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c]; smbDevType: Diode),
    (num: 6; id: ADM1032_ID; name: 'ADM1032';        PM: ADM1032Probe;  TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c, $4d]; smbDevType: Diode),
    (num: 7; id: ADT7461_ID; name: 'ADT7461';        PM: ADT7461Probe;  TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c]; smbDevType: Diode),
    (num: 8; id: MAX6657_ID; name: 'MAX6657';        PM: MAX6657Probe;  TM: LM90GetTemperature;   VM: nil;              FM: nil;          SM: nil;    ChipProp: (VoltagesCount: 0; Presets: 0; TemperaturesCount: 2; RPMsCount: 0; PWMsCount: 0); Bus: bSMB; DevRange: [$4c]; smbDevType: Diode)
  );


procedure tMonitoring.AddISAChip(isaSensorNum: byte; isaBasePort: word);
begin
  inc(fChipCount);
  SetLength(faChips, fChipCount);
  with faChips[fChipCount - 1], ISA_Sensors[isaSensorNum] do
  begin
    Chip.SensorNum := isaSensorNum;
    Chip.isaBasePort := isaBasePort;
    Chip.Bus:=bISA;
    Chip.ChipProp.Presets:=ChipProp.Presets;
    Chip.ChipProp.VoltagesCount:=ChipProp.VoltagesCount;
    Chip.ChipProp.TemperaturesCount:=ChipProp.TemperaturesCount;
    Chip.ChipProp.RPMsCount:=ChipProp.RPMsCount;
    Chip.ChipProp.PWMsCount:=ChipProp.PWMsCount;
    if (id = $101) then Chip.NameStr:=format('Unknown Winbond chip[ID=%xh]', [GetWinbondChipID(isaBasePort)])
    else Chip.NameStr:=Name;
    Chip.BusAccessStr := 'ISA ' +  format('%xh',[isaBasePort]);
    GetTemperatureMethod := TM;
    GetVoltageMethod := VM;
    SetVoltageMethod := SM;
    GetFanMethod := FM;
  end;
end;

procedure tMonitoring.ISA_SensorsDetect;
  function GetISAChipIndex(ChipID: Word): Word;
  var i: integer;
  begin
    result := 0;
    if ChipID in [0, $FF] then exit;