Thema: Delphi Pointer & Co

Einzelnen Beitrag anzeigen

gibb

Registriert seit: 12. Sep 2007
Ort: Bern
178 Beiträge
 
Delphi 2006 Architect
 
#4

Re: Pointer & Co

  Alt 3. Mär 2010, 15:50
Hi und danke für die Antworten.

Also ich kenne den Record nicht unter VB daher nehm ich an das es sich darum handelt, leider scheine ich da auch nicht mit auf einen grünen Zweig zu kommen

Da es sich noch um ein test programm handelt mache ich mir noch keine weiteren Units.

Delphi-Quellcode:
   
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
   PSFRawMemMap = Record
   public
     Unknown: Integer; //'unbekanntes Tag
     NumTemps:Integer; //'Anzahl der Temperaturen
     NumFans: Integer; //'Anzahl der Lüfter
     NumVolts: Integer;// 'Anzahl der Spannungen
     Temps: Integer; //'Werte der Temperaturen
     Fans: Integer; //'Drehzahl der Lüfter
     Volts: Integer; //'Werte der Spannungen'
   end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure GetTemps();
    function FindWindowEx2(hParent: HWND; ChildClassName: string; ChildNr: Word): HWND ;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetTemps();
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hSFMemory: HWND;
  SfAreaPtr: Pointer ;
  MyResultRecord: PSFRawMemMap;
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,1000);
      memo1.Text := IntToStr(MyResultRecord.Fans);
    end;
  finally
    UnmapViewOfFile(SfAreaPtr);
    CloseHandle(hSFMemory);
  end;
end;

function TForm1.FindWindowEx2(hParent: HWND; ChildClassName: string; ChildNr: Word): HWND;
var
  i: Word;
  hChild: HWND;
begin
  hChild := 0;
  Result := 0;
  Dec(ChildNr);
  for i := 0 to ChildNr do
  begin
    hChild := FindWindowEx(hParent, hChild, PChar(ChildClassName), nil);
    if hChild = 0 then
      Break;
    Result := hChild;
  end;
end;

procedure TForm1.GetTemps();
var
  wndMain, wndChild: HWND;
  Text: PAnsiChar;
  MaxLength: Integer;

begin
  wndMain := FindWindow('TForm1','SpeedFan 4.40');
  if wndMain <> 0 then
  begin
    wndChild := FindWindowEx(wndMain, 0, 'TPageControl', nil);
    wndChild := FindWindowEx(wndChild, 0, 'TTabSheet', nil);
    wndChild := FindWindowEx2(wndChild,'TJvPanel', 3);
    MaxLength:= 1000;
    getWindowText(wndMain,Text,MaxLength);
    Memo1.Text:=Text;
  end;
end;


end.
Tja das klapt so jedenfalls auch nicht.

Das Zweite beispiel gibt auch nur KrimsKrams aus was aber anhand der ersten aussage kein Wunder ist

Danke jedenfalls euch beiden

Gruss Gibb
  Mit Zitat antworten Zitat