Pointer & Co

[gibb]

hallo Zusammen,

Ich hab jetzt das hier in eine eigene unit ausgelagert:

Delphi-Quellcode:

unit ReadSpeedfanData;

interface
uses
  Windows,
  SysUtils,
  Classes,
  Forms,
  Controls,
  StdCtrls,
  Dialogs,
  messages;


type

  TResultIntRecord = Packed Record
    Unknown  : Array[0..5] of SmallInt;//unbekanntes Tag
    NumTemps : SmallInt; //Anzahl der Temperaturen
    NumFans  : SmallInt; //Anzahl der Lüfter
    NumVolts : SmallInt; //Anzahl der Spannungen
    Temps    : Array[0..63] of Integer; //Werte der Temperaturen
    Fans     : Array[0..63] of Integer; //Drehzahl der Lüfter
    Volts    : Array[0..63] of Integer; //Werte der Spannungen
  end;

  TResultStrRecord = Record
    NumTemps : SmallInt; //Anzahl der Temperaturen
    NumFans  : SmallInt; //Anzahl der Lüfter
    NumVolts : SmallInt; //Anzahl der Spannungen
    Temps    : TStringList; //Werte der Temperaturen
    Fans     : TStringList; //Drehzahl der Lüfter
    Volts    : TStringList; //Werte der Spannungen
  End;

  TReadSpeedfan = Class(TObject)
  Private
    FIntData : TResultIntRecord;
    FstrData: TResultStrRecord;
    Function UpdateData: Boolean;
  Public
    Function ReadSFData: Boolean;
    Function GetstrResult: TResultStrRecord;

  End;


implementation



Function TReadSpeedfan.ReadSFData: Boolean;
var
  hSFMemory: HWND;
  SfAreaPtr: Pointer ;
  MyResultRecord: TResultIntRecord;
begin
  hSFMemory := 0;
  SfAreaPtr := nil;
  try
    hSFMemory := OpenFileMapping(FILE_MAP_READ, False, 'SFSharedMemory_ALM');
    if HSFMemory <> 0 then begin
      SfAreaPtr := MapViewOfFile(hSFMemory, FILE_MAP_READ, 0, 0, 0);
      CopyMemory(Addr(MyResultRecord),SfAreaPtr,sizeof(MyResultRecord));
      FintData:= MyResultRecord;
      Result:=  True;
      If UpdateData = False then Result:= False;
    end else begin
      Result := False;
    end;
  finally
    UnmapViewOfFile(SfAreaPtr);
    CloseHandle(hSFMemory);
  end;
end;

Function TReadSpeedFan.UpdateData: Boolean;
var
  i: Integer;
  Temp : Single;
  PiAsStr: String;
Begin
  Try
    If not Assigned(FstrData.Temps) then
      FstrData.Temps:= TStringlist.Create;
    If not Assigned(FstrData.Fans) then
      FstrData.Fans:= TStringlist.Create;
    If not Assigned(FstrData.Volts) then
      FstrData.Volts:= TStringlist.Create;

    FstrData.Temps.Clear;
    FstrData.Fans.Clear;
    FstrData.Volts.Clear;

    For i:= 0 to FIntData.NumFans -1 do  begin
      FstrData.Fans.Add('Fan'+inttostr(i)+':'+IntTostr(FIntData.Fans[i]));
    end;
    For i:= 0 to FIntData.NumTemps -1 do  begin
      FstrData.Fans.Add('Temp'+inttostr(i)+':'+FormatFloat('###,##', fintData.Temps[i]/100));
    end;
    For i:= 0 to FIntData.NumVolts -1 do  begin
      FstrData.Fans.Add('Voltage'+inttostr(i)+':'+FormatFloat('###,##', fintData.Temps[i]/100));
    end;

    FstrData.NumTemps:= FIntData.NumTemps;
    FstrData.NumFans:= FIntData.NumFans;
    FstrData.NumVolts:= FIntData.NumVolts;

    Result:= True;
  except
    Result:= False;
  End;
End;

Function TReadSpeedfan.GetstrResult (): TResultStrRecord;
var
  MyResultRecord: TResultStrRecord;
  i: Integer;
begin
  Result := FstrData;
end;

end.

Und ruffe es aus dem Main auf:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  SpeedFanReader : TReadSpeedfan;
begin
  SpeedFanReader.Create;

  Speedfanreader.ReadSFData;

  SpeedFanReader.free;

 sleep(1);

end;

Sobald er aber die Funktion abschliessen möchte kommen exceptions. Ich nehme an das es irgendwie an dem Copymemory befehl und nicht freigegeben speicehr resp. bereits freigegeben Speicher liegt. Hat da jemand ne ahnung was genau das problem ist?

Gruss Sev