1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
| type
TDLLFunctionEventType = (etStart, etProgress, etEnd, etError);
TDLLFunctionEvent = procedure(EventNum: TDLLFunctionEventType; EventData: Pointer; CallBackContext: Pointer); stdcall;
PDLLFunctionEventProgressData = ^TDLLFunctionEventProgressData;
TDLLFunctionEventProgressData = record
Iteration: Cardinal;
DataSent: Cardinal;
DataReceived: Cardinal;
end;
procedure DLLFunction(Param: TParam; CallBackProc: TDLLFunctionEvent = nil; CallBackContext: Pointer = nil); stdcall;
begin
TThreadDLLFunction.Create(Param, CallBackProc, CallBackContext);
end;
constructor TThreadDLLFunction.Create(AParam: TParam; ACallBackProc: TDLLFunctionEvent; ACallBackContext: Pointer);
begin
inherited Create(false);
FreeOnTerminate := true;
FParam := AParam;
FCallBackProc := ACallBackProc;
FCallBackContext := ACallBackContext;
end;
procedure TThreadDLLFunction.Execute();
var
Progression: TDLLFunctionEventProgressData;
RobotWorking: Boolean;
ResIO : Cardinal;
DataDuRobot: Pointer;
RobotError : Cardinal;
begin
if Assigned(FCallBackProc) then
FCallBackProc(etStart, nil, FCallBackContext);
Progression.Iteration := 0;
Progression.DataSent := 0;
Progression.DataReceived := 0;
RobotWorking := RobotInit();
while RobotWorking do
begin
Inc(Progression.Iteration);
ResIO := ParleAuRobot(BlaBlaBla ...);
if (ResIO > 0)
begin
Inc(Progression.DataSent, ResIO);
if Assigned(FCallBackProc) then
FCallBackProc(etProgress, @Progression, FCallBackContext);
ResIO := RobotRepondMoi(DataDuRobot);
if (ResIO > 0)
begin
RobotWork := AnalyseReponseDuRobot(DataDuRobot);
Inc(Progression.DataReceived, ResIO);
if Assigned(FCallBackProc) then
FCallBackProc(etProgress, @Progression, FCallBackContext);
end
else
begin
RobotWork := false;
if Assigned(FCallBackProc) then
begin
RobotError := GetLastRobotError();
FCallBackProc(etError, @RobotError, FCallBackContext);
end;
end;
end
else
begin
RobotWork := false;
if Assigned(FCallBackProc) then
begin
RobotError := GetLastRobotError();
FCallBackProc(etError, @RobotError, FCallBackContext);
end;
end;
end;
RobotFinalize();
if Assigned(FCallBackProc) then
FCallBackProc(etEnd, nil, FCallBackContext);
end; |
Partager