Author Topic: Another Delphi Sample  (Read 1914 times)

Admin

  • Administrator
  • Jr. Member
  • *****
  • Posts: 49
    • View Profile
Another Delphi Sample
« on: June 26, 2011, 15:14:42 »
This Delphi sample code was provided recently:

unit utlberkWDog;

{
Developed by Tisfoon.com

May be used freely.
}

interface

uses Windows;

type
  WD_HANDLE  = Pointer;
  PWD_HANDLE = ^WD_HANDLE;


function berkWDogDriverExists : Boolean;
function berkWDogBoardExists  : Boolean;
function berkWDogTickle(var aTemp : Double) : Boolean;
function berkWDogEnable : Boolean;
function berkWDogDisable : Boolean;

implementation

type
  TWD_Open = function (aHandle : PWD_HANDLE): LongWord; stdcall; //cdecl;
  TWD_GetTempTickle = function (aHandle : WD_HANDLE; aTempW : PLongInt; aTempF : PLongWord; aCnt : PLongWord): LongWord; stdcall; //cdecl;
  TWD_EnableDisable = function (aHandle : WD_HANDLE; aState : LongWord) : LongWord; stdcall;

var
  FLib           : THandle = 0;

  FCheckedDriver : Boolean = False;
  FCheckedBoard  : Boolean = False;

  FDriverExists  : Boolean = False;
  FBoardExists   : Boolean = False;

  FProc_WD_Open            : TWD_Open = nil;
  FProc_WD_GetTempTickle   : TWD_GetTempTickle = nil;
  FProc_WD_EnableDisable   : TWD_EnableDisable = nil;

  FDeviceHandle  : WD_HANDLE;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function berkWDogDriverExists : Boolean;
begin
if not FCheckedDriver then
  begin
  FCheckedDriver := True;
  FLib := LoadLibrary('WDog_Univrsl.dll');
  if FLib <> 0 then
    begin
    FDriverExists := True;

    FProc_WD_Open := GetProcAddress(FLib, 'WD_Open');
    FProc_WD_GetTempTickle := GetProcAddress(FLib, 'WD_GetTempTickle');
    FProc_WD_EnableDisable := GetProcAddress(FLib, 'WD_EnableDisable');

    //FreeLibrary(FLib);  //Isn't this needed when calling procs?  YES
    end;
  end;

Result := FDriverExists;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function berkWDogBoardExists  : Boolean;
var aStat : LongWord;
begin
if not FCheckedDriver then
  berkWDogDriverExists;

if FDriverExists and (not FCheckedBoard) then
  begin
  FCheckedBoard := True;

  if Assigned(FProc_WD_Open) then
    begin
    aStat := FProc_WD_Open(@FDeviceHandle);

    if aStat = ERROR_SUCCESS then
      begin
      FBoardExists := True;
      berkWDogEnable;   //enable the Watchdog 
      end;
    end;
  end;

Result := FBoardExists;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function berkWDogTickle(var aTemp : Double) : Boolean;
var aTempW : LongInt;  aTempF, aCnt : LongWord; aStat : LongWord;
begin
Result := False;

if not FBoardExists then
  berkWDogBoardExists;

if FBoardExists then
  if Assigned(FProc_WD_GetTempTickle) then
    begin
    aStat := FProc_WD_GetTempTickle(FDeviceHandle, @aTempW, @aTempF, @aCnt);
    if aStat = ERROR_SUCCESS then
      begin
      aTemp := aTempW;
      Result := True;
      end;
    end;

end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function berkWDogEnable : Boolean;
var aStat : LongWord;
begin
Result := False;

if not FBoardExists then
  berkWDogBoardExists;

if FBoardExists then
  if Assigned(FProc_WD_EnableDisable) then
    begin
    aStat := FProc_WD_EnableDisable(FDeviceHandle, $2);
    if aStat = ERROR_SUCCESS then
      Result := True;
    end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
function berkWDogDisable : Boolean;
var aStat : LongWord;
begin
Result := False;

if not FBoardExists then
  berkWDogBoardExists;

if FBoardExists then
  if Assigned(FProc_WD_EnableDisable) then
    begin
    aStat := FProc_WD_EnableDisable(FDeviceHandle, $1);
    if aStat = ERROR_SUCCESS then
      Result := True;
    end;
end;


initialization

//release the library
finalization
if FLib <> 0 then
  FreeLibrary(FLib);

end.