Оба проекта собираются fpc и работают, только для первого нужно взять модуль masks из дельфи или лазаруса, так как в дистрибутив fpc он не входит.
{$APPTYPE CONSOLE}
uses Windows, Classes, SysUtils, Masks;
const pipes_prefix = '\\.\pipe\';
type tPipeList = class(tStringList)
private
FNotify : THandle;
FMask : string;
public
constructor Create;
destructor Destroy; override;
procedure RefreshDirectoryList;
function WaitForChanges(aTimeOut: longint): boolean;
procedure AfterAddObject(const aobject: string); virtual;
procedure BeforeDeleteObject(const aobject: string); virtual;
property Mask: string read FMask write FMask;
end;
var FPipes : tPipeList;
FExit : boolean = false;
function CtrlHandler(CtrlType: Longint): bool; stdcall;
begin FExit:= true; result:= true; end;
{ tPipeList }
constructor tPipeList.Create;
begin
inherited Create;
Sorted:= true;
FNotify:= FindFirstChangeNotification(pipes_prefix, false, FILE_NOTIFY_CHANGE_FILE_NAME);
end;
destructor tPipeList.Destroy;
begin
if (FNotify <> INVALID_HANDLE_VALUE) then FindCloseChangeNotification(FNotify);
inherited destroy;
end;
procedure tPipeList.RefreshDirectoryList;
const seq : longint = 0;
var idx : longint;
sr : tSearchRec;
begin
inc(seq);
try
if findfirst(format('%s*', [pipes_prefix]), faAnyFile, sr) = 0 then
repeat
if MatchesMask(sr.name, FMask) then begin
idx:= IndexOf(sr.name);
if (idx < 0) then begin
AddObject(sr.name, pointer(seq));
AfterAddObject(sr.name);
end else Objects[idx]:= pointer(seq);
end;
until (findnext(sr) <> 0);
finally findclose(sr); end;
for idx:= count - 1 downto 0 do
if (Objects[idx] <> pointer(seq)) then begin
BeforeDeleteObject(Strings[idx]);
delete(idx);
end;
end;
function tPipeList.WaitForChanges(aTimeOut: longint): boolean;
begin
result:= (FNotify <> INVALID_HANDLE_VALUE) and (WaitForSingleObject(FNotify, aTimeOut) = WAIT_OBJECT_0);
if result then FindNextChangeNotification(FNotify);
end;
procedure tPipeList.AfterAddObject(const aobject: string);
begin
writeln(formatdatetime('HH:NN:SS.ZZZ', now), ' ADD: ', aobject);
end;
procedure tPipeList.BeforeDeleteObject(const aobject: string);
begin
writeln(formatdatetime('HH:NN:SS.ZZZ', now), ' DEL: ', aobject);
end;
begin
SetConsoleCtrlHandler(@CtrlHandler, true);
writeln('Start export to wealthlab from QUIK or press Ctrl-C to exit...');
FPipes:= tPipeList.Create;
FPipes.Mask:= 'QUIK_*';
FPipes.RefreshDirectoryList;
while not FExit do begin
if FPipes.WaitForChanges(1000) then begin
FPipes.RefreshDirectoryList;
end;
end;
FreeAndNil(FPipes);
readln;
end.
{$APPTYPE CONSOLE}
uses Windows, SysUtils;
var fh : longint;
buf : array[0..1024] of ansichar;
function SafeReadPipe(fh: longint; buf: pAnsiChar; toread: longint): boolean;
var idx : longint;
read : DWORD;
begin
idx:= 0;
if assigned(buf) then
while (toread > 0) and ReadFile(fh, buf[idx], toread, read, nil) do begin
dec(toread, read);
inc(idx, read);
end;
result:= (toread = 0);
end;
function SafeReadHeader(fh: longint; var id: word): boolean;
var tmp: word;
begin
if SafeReadPipe(fh, @tmp, 2) and (tmp = 1) then result:= SafeReadPipe(fh, @id, 2) else result:= false;
end;
var id, tmp : word;
tmp_i : longint;
tmp_d : double;
tmp_i64 : int64;
strbuf : ansistring;
st : TSystemTime;
begin
fillchar(buf, sizeof(buf), 0);
strbuf:= format('\\.\pipe\QUIK_%s_%s', [paramstr(1), paramstr(2)]);
if not fileexists(strbuf) then begin
writeln('WARNING (pipe not found): ', strbuf);
writeln('usage: logpipedata.exe <TICKER> <TIMEFRAME>'#$0d#$0a'example: logpipedata.exe LKOH TICKS'#$0d#$0a);
end;
WaitNamedPipe(PAnsiChar(strbuf), 1000);
fh:= longint(CreateFile(PAnsiChar(strbuf),
GENERIC_READ,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
0,
0));
if (fh <> -1) then begin
while SafeReadPipe(fh, @id, 2) do begin
case id of
1 : SafeReadPipe(fh, @tmp, 2);
2 : if SafeReadPipe(fh, @tmp, 2) then begin
setlength(strbuf, tmp);
SafeReadPipe(fh, @strbuf[1], tmp);
writeln('instrument: ', strbuf);
end;
6, 7, 9 : SafeReadPipe(fh, @tmp_i, 4);
8 : begin
SafeReadPipe(fh, @tmp_i64, 8);
FileTimeToSystemTime(tFileTime(tmp_i64), st);
write(formatdatetime('DD-MM-YYYY HH:NN:SS ', SystemTimeToDateTime(st)));
// open
SafeReadPipe(fh, @tmp_d, 8);
write(tmp_d:10:6, ' ');
// high
SafeReadPipe(fh, @tmp_d, 8);
write(tmp_d:10:6, ' ');
// low
SafeReadPipe(fh, @tmp_d, 8);
write(tmp_d:10:6, ' ');
// close
SafeReadPipe(fh, @tmp_d, 8);
write(tmp_d:10:6, ' ');
// volume
SafeReadPipe(fh, @tmp_d, 8);
writeln(tmp_d:10:6, ' ');
end;
end;
end;
CloseHandle(fh);
end else writeln('ERROR Opening: ', strbuf, ' error: ', GetLastError);
end.
