Click here to Skip to main content
15,880,796 members
Please Sign up or sign in to vote.
1.00/5 (1 vote)
See more:
Delphi
unit Unit_hook;

interface

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

type

TCALLBACKPROC = function(strDataType:PWideChar; strDocument:PWideChar;strDriverName:PWideChar;strMachineName:PWideChar;strPrintername:PWideChar;
						strParameters:PWideChar;strPrintProcessor:PWideChar; JobId:Integer;PagesPrinted:Integer; Size:Integer; status:Integer; TotalPages:Integer;SizeHigh:LongInt; dmColor:ShortInt; dmPaperLength:ShortInt; dmPaperSize:ShortInt; dmPaperWidth:ShortInt):HRESULT stdcall;
type
  TSetCallbackFunc = procedure(_proc:TCALLBACKPROC) stdcall;
var
  fnSetCallback : TSetCallbackFunc;


type
  Tfrmhook = class(TForm)
    sg: TStringGrid;
    Panel1: TPanel;
    btLoad: TButton;
    btUnload: TButton;
    procedure btLoadClick(Sender: TObject);
    procedure btUnloadClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmhook: Tfrmhook;
  m_hDll: HMODULE;
  myString: String;

  mystrDataType:PChar;
  mystrDocument:PChar;
  mystrDriverName:PChar;
  mystrMachineName:PChar;
  mystrPrintername:PChar;
  mystrParameters:PChar;
  mystrPrintProcessor:PChar;
  myJobId:Integer;
  myPagesPrinted:Integer;
  mySize:Integer;
  mystatus:Integer;
  myTotalPages:Integer;
  mySizeHigh:LongInt;
  mydmColor:ShortInt;
  mydmPaperLength:ShortInt;
  mydmPaperSize:ShortInt;
  mydmPaperWidth:ShortInt;

implementation

{$R *.dfm}

function CallbackProc(strDataType:PWideChar; strDocument:PWideChar;strDriverName:PWideChar;strMachineName:PWideChar;strPrintername:PWideChar;strParameters:						PWideChar;strPrintProcessor:PWideChar; JobId:Integer;PagesPrinted:Integer; Size:Integer; status:Integer; TotalPages:Integer;
                     SizeHigh:LongInt; dmColor:ShortInt; dmPaperLength:ShortInt; dmPaperSize:ShortInt; dmPaperWidth:ShortInt):HRESULT stdcall;

var
i : integer;

begin
     MessageBox(0, 'cbk proc', 'cbk proc', MB_OK);
{
          myString :=    'DataType = ' + strDataType + #13#10 + 'Document = ' +strDocument+ #13#10 + 'DriverName = '+   strDriverName + #13#10 + 'MachineName = ' +   strMachineName
                          + #13#10 + 'Printername = ' +   strPrintername + #13#10 + 'Parameters = ' +   strParameters
                          + #13#10 + 'PrintProcessor = ' +   strPrintProcessor + #13#10 + 'JobId = ' +  IntToStr(JobId)
                          + #13#10 + 'PagesPrinted = ' +  IntToStr(PagesPrinted)+ #13#10 + 'Size = ' +  IntToStr(Size)
                          + #13#10 + 'status = ' +  IntToStr(status) + #13#10 + 'TotalPages = ' +  IntToStr(TotalPages)
                          + #13#10 + 'SizeHigh = ' +  IntToStr(SizeHigh) + #13#10 + 'dmColor = ' +  IntToStr(dmColor)
                          + #13#10 + 'dmPaperLength = ' +  IntToStr(dmPaperLength)+ #13#10 + 'dmPaperSize = ' +  IntToStr(dmPaperSize)
                          + #13#10 + 'dmPaperWidth = ' +  IntToStr(dmPaperWidth);
                          ;
}


         //MessageBoxA(0,PAnsiChar(myString), 'Print_info',MB_OK);


  with frmhook.sg do begin
          if Cells[1,1] <> '' then RowCount := RowCount + 1;
          i := 0;
          inc(i); Cells[i,RowCount-1] :=strDataType;
          inc(i); Cells[i,RowCount-1] :=strDocument;
          inc(i); Cells[i,RowCount-1] :=strDriverName;
          inc(i); Cells[i,RowCount-1] :=strMachineName;
          inc(i); Cells[i,RowCount-1] :=strPrintername;
          inc(i); Cells[i,RowCount-1] :=strParameters;
          inc(i); Cells[i,RowCount-1] :=strPrintProcessor;
          inc(i); Cells[i,RowCount-1] :=IntToStr(JobId);
          inc(i); Cells[i,RowCount-1] :=IntToStr(PagesPrinted);
          inc(i); Cells[i,RowCount-1] :=IntToStr(Size);
          inc(i); Cells[i,RowCount-1] :=IntToStr(status);
          inc(i); Cells[i,RowCount-1] :=IntToStr(TotalPages);
          inc(i); Cells[i,RowCount-1] :=IntToStr(SizeHigh);
          inc(i); Cells[i,RowCount-1] :=IntToStr(dmColor);
          inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperLength);
          inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperSize);
          inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperWidth);
  end;
    MessageBox(0, 'cbk proc', 'cbk proc', MB_OK);
end;


procedure Tfrmhook.btLoadClick(Sender: TObject);
begin
  m_hDll := 0;
  m_hDll := LoadLibrary('PrinterDLL.dll');
  if 0 = m_hDll
  then MessageBox(0, 'DLL Loading failed', 'DLL loading failed', MB_OK)
  else  fnSetCallback := GetProcAddress(m_hDll,'StartMonitoring_');



  fnSetCallback(CallbackProc);
  //Application.ProcessMessages;
end;

procedure Tfrmhook.btUnloadClick(Sender: TObject);
begin
    FreeLibrary(m_hDll);
end;

end.


I am loading a DLL where one thraed is running; Now after some time frame this thread is calling function "CallbackProc" through function pointer; On call it is setting some form field in GUI; Now when the callback function is called in Delphi, then the messagebox of aove code comeing correctly, but the GUI is "Not Responding" and form fields are not updated;
ANy clue why this is happening?

If any clarification required plz comment?
Any one give me the idea where I should declare the CallBackProc?

Thanks
Posted
Updated 24-Apr-13 9:06am
v3

1 solution

This is not a complete code, so I cannot take your application and debug it. But you can run it under the debugger and investigate the problem.

However, I can see at least one problem. If you method Callback is called from some non-UI thread, this is not good, because, in turn, this method try to use UI objects. All things like that should be done in the UI thread. You should delegate the code using UI object to be executed in your UI thread through the Synchronize method:
http://docwiki.embarcadero.com/CodeExamples/XE3/en/Synchronize_%28Delphi%29[^].

For more detailed on UI thread synchronization techniques, please see this article: http://sergworks.wordpress.com/2010/09/14/synchronization-in-delphi-tthread-class/[^].

—SA
 
Share this answer
 
v2
Comments
iDebD 23-Apr-13 1:52am    
I want to give you all codes and DLL file; How can I attach it?
Sergey Alexandrovich Kryukov 23-Apr-13 9:44am    
There is no a way...
And I won't try to use your DLL file anyway, sorry.
—SA

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900