Во-первых, под консольным драйвером системы CRW-DAQ здесь понимается консольное приложение, построенное по определенным правилам, которое предназначено для работы в составе измерительной системы под управлением CRW-DAQ. В общем-то это почти обычное консольное приложение, которое может быть запущено из командной строки и может работать автономно, в консольном окне, получая команды с клавиатуры и выводя сообщения на экран. Однако при работе под управлением CRW-DAQ консольные драйверы могут запускаться и без окна (как скрытые процессы), а ввод-вывод может переназначаться в анонимный канал связи, через который консольный драйвер, выступающий в качестве СЕРВЕРА, обменивается с программой Daq Pascal, которая выступает как КЛИЕНТ.
Задачей консольных драйверов является обычно обслуживание какого-то устройства, выполнение служебных функций в фоновом режиме и т.д. При этом клиентская часть под CRW-DAQ управляет запуском и завершением консольных драйверов, их конфигурированием и т.д.
Например, в виде консольного драйвера реализованы:
Мотивацией для создания систем с участием консольных драйверов является следующее:
Поскольку в рамках системы CRW-DAQ запуск подчиненных процессов всегда выполняется из той или иной программы Daq Pascal, клиент в принципе всегда имеется, даже если он не подключился по каналу связи (например, если консольный драйвер не должен обмениваться данными с клиентом). Так или иначе, при построении консольных драйверов лучше соблюдать определенные правила, чтобы подключение по каналу было возможным хотя бы в будущем.
В частности, консольный драйвер обязан быть многопоточным, чтобы канальный ввод-вывод не препятствовал работе программы. Дело в том, что канал ввода практически все время заблокирован в ожидании ввода поступающих данных. В однопоточном приложении это привело бы к тому, что сервер "просыпается" только когда его "потревожит" клиент, подав что-нибудь на вход. На практике же обычно сервер и клиент равноправны в смысле активности, то есть как сервер, так и клиент могут выполнять передачу данных в любой момент времени. Для этого сервер должен содержать минимум три потока - для ввода, для вывода и для обработки поступающих данных (обычно это основной поток). Выделение ввода-вывода в отдельные потоки "развязывает" руки потоку обработки данных, который теперь не блокируется при отсутствии данных в консоли ввода или при переполнении канала вывода.
К счастью, создание многопоточного консольного сервера не потребует больших усилий, если использовать "канонические" библиотеки и шаблоны, в которых уже почти все сделано. Собственно, задача консольного ввода-вывода проста и может быть решена раз и навсегда. Вам остается написать обработку данных, происходящую в основном потоке. Таким образом, библиотека спасает от многопоточного программирования, обеспечивая в то же время необходимую многопоточность. Например, шаблоны "Daq-Dpr\program DEMO_Server", "Daq-Pas\program DEMO_Client". позволяют с нуля получить прототип клиента и сервера, из которого в течение короткого времени можно построить работающую систему на основе технологии клиент-сервер.
Рассмотрим "канонический" консольный сервер. Для простоты протокол обмена содержит одну команду @Exit=n, которая приводит к завершению работы программы с кодом n. Однако это полнофункциональный консольный сервер, в него легко добавить любые другие функции.
Сначала посмотрим текст сервера:
program DEMO_Server;
{$APPTYPE CONSOLE} // ! Declare application type as CONSOLE.
{$I _sysdef} // ! By CRW conventions, include _SYSDEF,
uses // ! ShareMem must to be FIRST USES UNIT,
ShareMem, // ! borlndmm.dll should present in path.
SysUtils,Windows,Math,Classes,Forms,
_alloc,_str,_mime,_rtc,_fio,_fifo,_ascio,_polling,_task;
//
// General variables and constants
//
const
Terminated : Boolean = false; // Program should be terminated
//
// Request: @exit
// Request: @exit=n
// Reply: @exit=n
// Comment: Terminate program with exit code n.
//
procedure DoExit(const cmnd,args:LongString);
begin
Terminated:=true;
System.ExitCode:=StrToIntDef(args,0);
StdOut.Put:=Format('%s=%d',[cmnd,System.ExitCode]);
end;
//
// This callback handles unrecognized commands.
//
procedure DoSpecificCommands(const args:LongString);
begin
if Length(args)>0 then
StdOut.Put:=Format('Could not recognize "%s"',[args]);
end;
//
// Application specific initialization.
//
procedure SpecificInitialization;
begin
//
// Register user commands coming from StdIn.
//
StdIn.SpecHandler:=DoSpecificCommands;
StdIn.AddCommand('@Exit',DoExit);
end;
//
// Application specific finalization.
//
procedure SpecificFinalization;
begin
end;
//
// Application specific polling.
//
procedure SpecificPolling;
begin
end;
//
// Main program
//
begin
try
try
SpecificInitialization;
while not Terminated do begin
while StdIn.Count>0 do StdIn.Process(StdIn.Get);
SpecificPolling;
Sleep(1);
end;
finally
SpecificFinalization;
end;
except
on E:Exception do StdOut.Put:=E.Message;
end;
Sleep(100);
end.
Теперь примечания:
StdOut.Put:='Data String';Объект StdOut обеспечивает потокобезопасный вывод данных в консоль вывода. Вас не должно смущать, что используется присвоение: операция присвоения у StdOut "перегружена". Реально данные ставятся в очередь и записываются в консоль вывода в отдельном потоке.
if StdIn.Count>0 then Data:=StdIn.Get;Объект StdIn обеспечивает потокобезопасный ввод данных из консоли вывода. Обычно даже об этом не приходится заботится, все уже сделано в цикле опроса (см. далее).
try
SpecificInitialization;
while not Terminated do begin
while StdIn.Count>0 do StdIn.Process(StdIn.Get);
SpecificPolling;
Sleep(1);
end;
finally
SpecificFinalization;
end;
в основной программе будет практически неизменным.Для обработки команды типа @Command=Data, например, @Exit, надо написать процедуру
procedure DoExit(const cmnd,args:LongString);которая принимает два параметра - команду cmnd и список аргументов args (то есть то, что следует за знаком =). Например, при сообщении @Exit=1 процедура будет вызвана как DoExit('@Exit','1'). Потом команда регистрируется вызовом StdIn.AddCommand('@Exit',DoExit).
Если сообщение содержит неизвестную команду или если не имеет формата команды (не начинается с @), вызывается обработчик StdIn.SpecHandler. Для этого надо создать процедуру
procedure DoSpecificCommands(const args:LongString)а затем зарегистрировать ее вызовом StdIn.SpecHandler:=DoSpecificCommands. При этом все сообщения, не распознанные как зарегитрированные команды, будут переданы для обработки в эту процедуру без каких-либо изменений. И уж тогда делайте с ними что хотите.
Рассмотрим "канонический" консольный клиент. Для простоты протокол обмена содержит команды @Exit, @Start, @Stop. Однако это полнофункциональный консольный клиент, в него легко добавить любые другие функции.
Сначала посмотрим текст клиента:
program DEMO_Client;
const
MaxLeng = 1024; { max. length of I/O string }
SendTimeOut = 100; { timeout on message send,ms }
TimerPeriod = 1000; { poll period to restart }
borlndmm_dll = 'borlndmm.dll'; { needed dll library }
dfTrouble = 1; { DebugFlags - Trouble }
dfSuccess = 2; { DebugFlags - Success }
dfViewInp = 4; { DebugFlags - ViewInp }
dfViewOut = 8; { DebugFlags - ViewOut }
var
b : Boolean; { Temporary variable }
Ok : Boolean; { Is initialization Ok ? }
errors : Integer; { Error count }
errorcode : Integer; { Error code for this device }
errorterm : Integer; { Error code for host death }
erroriobug : Integer; { Error code for DEMO errors }
fixmaxavail : Integer; { String manager leak test }
DebugFlags : Integer; { see dfXXX constants }
StdIn_Line : String; { Temporary variable }
winConsole : String; { Console window name }
DEMO : record
Server : String; { DEMO server path }
Timer : Integer; { Timer to check DEMO task }
Buff : String; { DEMO task input buffer }
Line : String; { Temporary variable }
Tid : Integer; { DEMO task identifier }
IPipeSize : Integer; { StdInPipeSize }
OPipeSize : Integer; { StdOutPipeSize }
end;
{
Report on host terminated.
}
procedure HostTerm(msg:String);
var b:boolean;
begin
if iand(DebugFlags,dfTrouble)>0 then
if Length(msg)>0 then writeln(devname+' ! '+msg);
if runcount=1 then errors:=errors+1 else b:=fixerror(errorterm);
end;
{
Report on trouble.
}
procedure Trouble(msg:String);
var b:boolean;
begin
if iand(DebugFlags,dfTrouble)>0 then
if Length(msg)>0 then writeln(devname+' ! '+msg);
if runcount=1 then errors:=errors+1 else b:=fixerror(errorcode);
end;
{
Report on success.
}
procedure Success(msg:String);
begin
if iand(DebugFlags,dfSuccess)>0 then
if Length(msg)>0 then writeln(devname+' : '+msg);
end;
{
Report on data input.
}
procedure ViewInp(msg:String);
begin
if iand(DebugFlags,dfViewInp)>0 then
if Length(msg)>0 then writeln(devname+' > '+msg);
end;
{
Report on data output.
}
procedure ViewOut(msg:String);
begin
if iand(DebugFlags,dfViewOut)>0 then
if Length(msg)>0 then writeln(devname+' < '+msg);
end;
{
Check I/O status.
}
function IoError:boolean;
begin
IoError:=false;
if ioresult<>0 then begin
Trouble('I/O error.');
IoError:=true;
end;
end;
{
Read string line from standard input.
}
function StdIn_Readln(var s:string):boolean;
begin
StdIn_Readln:=false;
if not IoError then
if not eof then begin
readln(s);
if not IoError then StdIn_Readln:=true;
end;
end;
{
Read line from DEMO task stdout pipe with CR terminator and LF ignore.
}
function DEMO_Readln(var s:String):boolean;
var p,q:integer;
begin
s:='';
DEMO_Readln:=false;
if task_pid(DEMO.Tid)<>0 then begin
if Length(DEMO.Buff)0 then begin
DEMO_Readln:=true;
if p>1 then s:=Copy(DEMO.Buff,1,p-1);
if Length(s)>0 then begin
q:=Pos(chr(10),s);
if q>0 then s:=Copy(s,q+1,MaxLeng);
end;
DEMO.Buff:=Copy(DEMO.Buff,p+1,MaxLeng);
if Length(DEMO.Buff)>0 then
if DEMO.Buff[1]=chr(10) then DEMO.Buff:=Copy(DEMO.Buff,2,MaxLeng);
end else begin
if Length(DEMO.Buff)=MaxLeng then begin
Trouble('Received line is too long!');
DEMO.Buff:='';
end;
end;
end;
end;
{
Clear DEMO table.
}
procedure DEMO_Clear(ForceFree:boolean);
var i,j:integer;
begin
if ForceFree then begin
if DEMO.Timer<>0 then b:=tm_free(DEMO.Timer);
end;
DEMO.Tid:=0;
DEMO.Buff:='';
DEMO.Line:='';
DEMO.Timer:=0;
DEMO.Server:='';
end;
{
Initialize DEMO table.
}
procedure DEMO_Init;
begin
{---Clear DEMO---}
DEMO_Clear(false);
{---Read FIFO size---}
DEMO.IPipeSize:=val(ReadIni('StdInPipe'));
DEMO.OPipeSize:=val(ReadIni('StdOutPipe'));
if (DEMO.IPipeSize<=0) or (DEMO.IPipeSize>64*1024) then DEMO.IPipeSize:=64;
if (DEMO.OPipeSize<=0) or (DEMO.OPipeSize>64*1024) then DEMO.OPipeSize:=64;
DEMO.IPipeSize:=DEMO.IPipeSize*1024;
DEMO.OPipeSize:=DEMO.OPipeSize*1024;
{---Find DEMO server executable---}
DEMO.Server:=DaqFileRef(ReadIni('DEMO_EXE_PATH'),'.EXE');
if FileExists(DEMO.Server)
then Success('DEMO_EXE_PATH='+DEMO.Server)
else Trouble('Could not find DEMO_EXE_PATH: '+DEMO.Server);
{---Check borlndmm.dll presence---}
if not FileExists(AddBackSlash(ExtractFilePath(DEMO.Server))+borlndmm_dll)
then b:=FileCopy(AddBackSlash(ParamStr('HomeDir'))+borlndmm_dll+' '+
AddBackSlash(ExtractFilePath(DEMO.Server))+borlndmm_dll);
if not FileExists(AddBackSlash(ExtractFilePath(DEMO.Server))+borlndmm_dll)
then Trouble('Could not find '+borlndmm_dll);
{---Initialize timer---}
DEMO.Timer:=tm_new;
if not tm_addint(DEMO.Timer,TimerPeriod) then Trouble('tm_addint fails.');
if not tm_start(DEMO.Timer) then Trouble('tm_start fails.');
end;
{
Send message to DEMO task.
Wait for some time if transmitter FIFO is over.
}
procedure DEMO_Send(msg:string);
var ms:real;
begin
if DEMO.Tid<>0 then
if Length(msg)>0 then begin
if task_txspace(DEMO.Tid)0 then begin
ViewOut(s);
if s[1]='@' then begin
p:=pos('=',s);
if p>0 then begin
cmnd:=Copy(s,1,p-1);
args:=Copy(s,p+1,Length(s)-p);
end else begin
cmnd:=s;
args:='';
end;
wc:=wordcount(args);
{---@exit=n statement---}
if IsSameText(cmnd,'@exit') then begin
Success('Exit with code '+Trim(args));
end;
end;
end;
buff:='';
cmnd:='';
args:='';
end;
{
Stop DEMO server task if one started.
}
procedure DEMO_Stop;
var b:Boolean;
begin
if DEMO.Tid>0 then begin
if task_wait(DEMO.Tid,0) then begin
Success('DEMO.EXE termination will take some time.');
Success('You should wait about 5 sec...');
DEMO_Send('@stop');
DEMO_Send('@exit');
b:=task_wait(DEMO.tid,500);
if task_wait(DEMO.Tid,0) then b:=task_kill(DEMO.Tid,0,1,0);
if task_rxcount(DEMO.Tid)>0 then
while DEMO_Readln(DEMO.Line) do DEMO_Process(DEMO.Line);
Success('DEMO Server exit code = '+str(task_result(DEMO.Tid)));
end;
b:=task_free(DEMO.Tid);
end;
DEMO.Tid:=0;
DEMO.Buff:='';
DEMO.Line:='';
end;
{
Finalize DEMO table.
}
procedure DEMO_Free;
begin
DEMO_Stop;
DEMO_Clear(true);
end;
{
Start DEMO server if one not started.
}
procedure DEMO_Start;
var i,j:Integer; b:Boolean;
begin
if DEMO.Tid=0 then begin
{
Initialize separate user task, run it invisible...
}
DEMO.Tid:=task_init(DEMO.Server);
if pos('?',task_ctrl(DEMO.Tid,'HomeDir='+ExtractFilePath(DEMO.Server))
+task_ctrl(DEMO.Tid,'StdInPipeSize='+str(DEMO.IPipeSize))
+task_ctrl(DEMO.Tid,'StdOutPipeSize='+str(DEMO.OPipeSize))
+task_ctrl(DEMO.Tid,'Display=0')
)>0
then begin
Trouble('User task setup error!');
DEMO_Stop;
end;
{
Run task if one was created...
}
if DEMO.Tid>0 then
if task_run(DEMO.Tid) then begin
Success('TaskId = '+str(DEMO.Tid));
Success('TaskPid = '+str(task_pid(DEMO.Tid)));
Success('TaskRef = '+str(task_ref(DEMO.Tid)));
Success('CmdLine = '+task_ctrl(DEMO.Tid,'CmdLine'));
Success('HomeDir = '+task_ctrl(DEMO.Tid,'HomeDir'));
Success('PipeIn = '+task_ctrl(DEMO.Tid,'StdInPipeSize'));
Success('PipeOut = '+task_ctrl(DEMO.Tid,'StdOutPipeSize'));
Success('Display = '+task_ctrl(DEMO.Tid,'Display'));
end else begin
Trouble('Could not start DEMO Server!');
DEMO_Stop;
end;
{
Is it Ok with user task? Send preset parameters.
}
if DEMO.Tid>0 then
if task_wait(DEMO.Tid,0) then begin
DEMO_Send('@start');
end else b:=fixerror(errorcode);
end;
end;
{
DEMO polling.
}
procedure DEMO_Poll;
begin
{ DEMO timer actions... }
if tm_event(DEMO.Timer) then begin
DEMO_Send('@memory');
DEMO_Send('@errors=0');
end;
end;
{
Analyse data coming from standard input.
}
procedure StdIn_Process(s:string);
begin
if Length(s)>0 then DEMO_Send(s);
end;
{
Clear all strings
}
procedure ClearStrings;
begin
StdIn_Line:='';
winConsole:='';
DEMO_Clear(false);
if runcount=1 then fixmaxavail:=maxavail;
if isinf(runcount) then
if maxavail<>fixmaxavail then Trouble('String Manager Leak = '+str(fixmaxavail-maxavail));
end;
{
Initialize and check tag
}
procedure InitTag(var tag:integer; name:string; typ:integer);
begin
tag:=findtag(name);
if (typ>0) and (typetag(tag)<>typ) then errors:=errors+1;
end;
begin
{
Initialization actions on Start...
}
if runcount=1 then begin
{
Initialize errors...
}
errors:=0;
errorcode:=registererr(devname);
errorterm:=registererr(devname+': terminated.');
erroriobug:=registererr(devname+': I/O error.');
{
Clear and initialize variables...
}
ClearStrings;
DebugFlags:=val(ReadIni('DebugFlags'));
{
Open console window...
}
if val(ReadIni('OpenConsole'))>0 then begin
winConsole:=ParamStr('Console '+devname);
b:=winshow(winConsole);
b:=windraw(winConsole+'|top=317|left=167|Width=600|Height=317');
b:=winselect(winConsole);
if val(ReadIni('OpenConsole'))>1 then b:=winhide(winConsole);
end;
{
Initialize DEMO server...
}
Success('DEMO server initialization:');
DEMO_Init;
{
Is it Ok?
}
if errors=0 then Success('Start Ok.') else Trouble('Start Fails.');
if errors<>0 then b:=fixerror(errorcode);
Ok:=(errors=0);
end else
{
Finalization actions on Stop...
}
if isinf(runcount) then begin
DEMO_Free;
ClearStrings;
Success('Stop.');
end else
{
Actions on Poll
}
if Ok then begin
{
Check standard I/O errors...
}
if ioresult<>0 then b:=fixerror(errorcode);
{
Process standard input...
}
while StdIn_Readln(StdIn_Line) do StdIn_Process(StdIn_Line);
{
If DEMO server is not still running,
try to start DEMO server periodically.
}
if DEMO.Tid=0 then
if tm_event(DEMO.Timer) then DEMO_Start;
{
Communicate with DEMO server if one still running...
}
if DEMO.Tid>0 then
if task_wait(DEMO.Tid,0) then begin
{
If has data coming from Task StdOut, analyse it...
}
if task_rxcount(DEMO.Tid)>0 then
while DEMO_Readln(DEMO.Line) do DEMO_Process(DEMO.Line);
{
DEMO polling.
}
DEMO_Poll;
end else begin
HostTerm('DEMO terminated, exit code = '+str(task_result(DEMO.Tid)));
DEMO_Stop;
end;
end;
end.
Теперь примечания:
[DeviceList]
&DEMO = device software program
[&DEMO]
Comment = Demo program
InquiryPeriod = 10
DevicePolling = 10, tpNormal
ProgramSource = .\DEMO_Client.pas
DEMO_EXE_PATH = .\DEMO_Server.exe
OpenConsole = 1
DebugFlags = 11
StdInPipe = 128
StdOutPipe = 128
...etc
[]