Получение данных из quik через "экспорт в системы тех.анализа..."

{$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.