unit wlu;
{$i define.pas}
interface
uses
  SysUtils, LogType, Dateu, Stru, Windows;
const
  LogName = 'WL.LG';
  WLVersion = '1.01';

const
  wrOK = 0;
  wr0 = 1000;
  wrInvalidParameter = wr0 + 1;
  wrBeginCommandRepeated = wr0 + 2;
  wrEndCommandRepeated = wr0 + 3;
  wrIsSuspended = wr0 + 4;
  wrIsResumed  = wr0 + 5;
  wrFirstCommandMustBeBegin = wr0 + 6;
  wrInvalidDateTime = wr0 + 7;
  wrMutexWaitTimeout = wr0 + 8;
  wrFailedCreateMutex = wr0 + 9;
  wrMutexWaitAbandoned = wr0 + 10;
  
function w(const s:shortstring):integer;export;

implementation
var
  WResult: integer;
{
function DTGetStr(dt: TDateTime; dt: integer): string;
begin
  case dt of
    dtDateTimeString: DateTimeToString(Result, 'yyyymmddhhmmss', dt);
    dtDateString: DateTimeToString(Result, 'yyyymmdd', dt);
  else
    raise Exception.Create('Invalid DTGetStr ' + IntToStr(dt));
end;

procedure DTSetStr(dt: TDateTime; dt: integer; const s:string);

  function cp(start, len: integer): word;
  var code:integer;
  begin
    val(copy(s, start, len), result, code);
  end;

begin
  case dt of
    dtDateTimeString: begin
      //YYYYMMDDHHMMSS
      //1   5 7 9 1113
      dt := EncodeDate(cp(1,4), cp(5, 2), cp(7, 2)) +
        EncodeTime(cp(9,2), cp(11,2), cp(13,2),0)
    end;
  else
    raise Exception.Crate('Invalid DTSetStr ' + IntToStr(dt));
end;
}

function GetStateName(c:char):string;
var s:string;
begin
  case c of
    'B': s := 'running';
    'E': s := 'stopped';
    'S': s := 'suspended';
    'R': s := 'resumed';
  else
    s := 'Unknown: ' + c;
  end;
  GetStateName := s;
end;

procedure wc(const astart:string);
var
  l:Longint;
  dt1,dt2,dt3:PDTO;
  line:string;
  running:boolean;
  f:text;
  days:string[10];
  hours:string[2];
  minutes:string[2];
  seconds:string[2];
  cur:char;
  datetime1:shortstring;{TDateTimeString}
  since:string[40];
  firstStart:boolean;
  p:integer;

  datetime3: shortstring;
  shouldBreak: boolean;

  procedure Start;
  begin
    DTSetStr(dt1, dtDateTimeString, copy(line, 2, 14));
    running := true;
    if firstStart then begin
      firstStart:= false;
      if datetime1 < DTGetStr(dt1, dtDateTimeString) then
        datetime1 := DTGetStr(dt1, dtDateTimeString);
    end;

    if (datetime3 <> '') then begin
      if DTGetStr(dt1, dtDateTimeString) > datetime3 then begin
        running := false;
        shouldBreak := true;
      end;
    end;

  end;

  procedure Stop;
  var
    i:longint;
  label ex;
  begin
    if running then begin
      if line <> '' then begin
        DTSetStr(dt2, dtDateTimeString, copy(line,2, 14));
      end else begin
        DTAssign(dt2, DTNow);
      end;

      if datetime3 <> '' then begin
        if DTGetStr(dt2, dtDateTimeString) > datetime3 then begin
          DTSetStr(dt2, dtDateTimeString, datetime3);
          shouldBreak := true;
        end;
      end;

      if datetime1 <> '' then begin
        if DTGetStr(dt2, dtDateTimeString) < datetime1 then
          goto ex;
        if datetime1 > DTGetStr(dt1, dtDateTimeString) then
          DTSetStr(dt1, dtDateTimeString, datetime1);
      end;
      i := DTGetInterval(dt1, dt2, tuSecond);
      if i > 0 then
        l := l + i;
    end;
  ex:
    running := false;
  end;

begin
  Assign(f, LogName);
  {$i-}
  reset(f);
  WResult := ioresult;
  if WResult <> 0 then begin
    Writeln('Can not open ' + LogName);
    exit;
  end;
  l := 0;
  dt1 := DTInit;
  dt2 := DTInit;
  dt3 := DTInit;
  running := false;
  datetime3 := '';
  datetime1 := copy(astart,2, length(astart){14});
  {v1.01}
  firstStart:= true;
  if (datetime1 = 'today') or (datetime1 = 'day') then begin
    datetime1 := DTGetStr(DTNow, dtDateString);
  end else if datetime1 = 'week' then begin
    DTAssign(dt1, DTNow);
    DTDo(dt1, dtGoToWeekStart, 0);
    datetime1 := DTGetStr(dt1, dtDateString);
    {logtype}
  end else if datetime1 = 'month' then begin
    DTAssign(dt1, DTNow);
    DTDo(dt1, dtGoToMonthStart, 0);
    datetime1 := DTGetStr(dt1, dtDateString);
  end else if datetime1 = 'year' then begin
    DTAssign(dt1, DTNow);
    DTDo(dt1, dtGoToYearStart, 0);
    datetime1 := DTGetStr(dt1, dtDateString);
  end else if (datetime1 <> '') then begin
    if datetime1[1] = 'f' then begin
      datetime1 := copy(datetime1, 2, length(datetime1));
      p := pos('t', datetime1);
      if p <> 0 then begin
        datetime3 := copy(datetime1, p + 1, length(datetime1));
        DTSetStr(dt3, dtDateTimeString, datetime3);
        datetime1 := copy(datetime1, 1, p - 1);
      end;
      DTSetStr(dt1, dtDateTimeString, datetime1);
    end;
  end;
  {/v1.01}
  cur := ' ';
  while not eof(f) do begin
    readln(f, line);
    shouldBreak := false;
    if (line <> '') and (line[1] <> ' ') then begin
      case line[1] of
        'B': Start;
        'S': Stop;
        'R': Start;
        'E': Stop;
      end;
      cur := line[1];
    end;
    if shouldBreak then
      break;
  end;
  line := '';
  Stop;
  if datetime1 <> '' then begin
    DTSetStr(dt1, dtDateTimeString, datetime1);
    since := '(since ' + DTGetStr(dt1, dtDatum) + ' ' + DTGetStr(dt1, dtCas)+ ')';
  end else begin
    since := '';
  end;

  DTDone(dt1);
  DTDone(dt2);
  DTDone(dt3);

  str(l div (24 * 3600), days);
  l := l mod (24 * 3600);
  str(l div 3600, hours);
  l := l mod 3600;
  str(l div 60, minutes);
  l := l mod 60;
  str(l, seconds);
  if days <> '0' then
    days := days + ' days'
  else
    days := '';
  Writeln('Whole time spent on the work ' + since + ': '+ days + ' ' +
    lzero(hours,2) + ':' + lzero(minutes,2) + ':' + lzero(seconds,2));
  Writeln('Current state: ' + cur + '=' + GetStateName(cur));
end;

procedure wr(const cm:string; const comment:string);
var
  f: text;
  dt:PDTO;
  line:string;
  ok:boolean;
  s:string;
label ex;
begin
  s := cm;
  AssignFile(f, LogName);  {errors getlasterror}
  {$I-}
  dt := nil;
  line := '';
  Reset(f);
  ok := false;
  WResult := ioresult;          {tfilerec}
  if WResult <> 0 then begin
    if WResult = 2 then begin
      rewrite(f);
      WResult := ioresult;
    end else if WResult = 103 then begin
      if TTextRec(f).Mode = fmInput then {some wierd windows error?}
        WResult := 0;
    end;
    if WResult <> 0 then begin
      writeln('Error opening ' + LogName);
      goto ex;
    end;
  end;
  if WResult = 0 then begin
    while not eof(f) do
      readln(f, line);
  end;
  if line <> '' then begin
    case line[1] of
      'B': if (s[1] <> 'E') and (s[1] <> 'S') then begin
        WResult := wrBeginCommandRepeated;
        writeln('Last log event was BEGIN, call WL with Errrrmmddhhmms parameter.');
        goto ex;
      end;
      'E': if (s[1] <> 'B') then begin
        WResult := wrEndCommandRepeated;
        writeln('Last log event was END, call WL with B parameter.');
        goto ex;
      end;
      'S': if (s[1] <> 'R') and (s[1] <> 'E') then begin
        WResult := wrIsSuspended;
        writeln('Last log event was SUSPEND, call WL with R or E parameter.');
        goto ex;
      end;
      'R': if (s[1] <> 'S') and (s[1] <> 'E') then begin
        WResult := wrIsResumed;
        writeln('Last log event was RESUME, call WL with E or S parameter.');
        goto ex;
      end;
    end;
  end else begin
    if s[1] <> 'B' then begin
      WResult := wrFirstCommandMustBeBegin;
      writeln('When creating log file only BEGIN parameter is allowed.');
      goto ex;
    end;
  end;
  close(f);
  append(f);
  dt := DTInit;
  if length(s) = 1 then begin
    DTAssign(dt, DTNow);
  end else begin
    DTSetStr(dt, dtDateTimeString, copy(s, 2, 14));{Xrrrrmmddhhmmss}
    if (DTGet(dt, dtIsValidDate) <> dtOK) or (DTGet(dt, dtIsValidTime) <> dtOK) then
    begin
      WResult := wrInvalidDateTime;
      writeln('Invalid date/time specified.');
      goto ex;
    end;
  end;
  s := s[1] + DTGetStr(dt, dtDateTimeString) + ' ' + comment;
  writeln(f, s);
  writeln(s + '    Written to ' + LogName);
  Writeln('Current state: ' + s[1] + '=' + GetStateName(s[1]));
  ok := true;
ex:
  if TTextRec(f).Mode <> fmClosed then
    close(f);
  if dt <> nil then
    DTDone(dt);
  if ok and (s[1] = 'E') then
    wc('');
end;


function w(const s:shortstring): integer;
var
{  ch:char;}
  st:string;
  comment: string;
  i:integer;
  mu:THandle;
  wo: integer;
begin
{  Result := -1;}
  mu := CreateMutex(nil, false, 'ulan_worklog_mutex');
  if mu = 0 then begin
    WResult := wrFailedCreateMutex;
    Result := WResult;
    exit;
  end;
  try
    wo := WaitForSingleObject(mu, 5000);
    if wo = WAIT_OBJECT_0 then begin
      WResult := 0;
      i := pos(' ', s);
      if i > 0 then begin
        st := copy(s, 1, i - 1);
        comment := copy(s, i + 1, length(s));
      end else begin
        st := s;
        comment := '';
      end;
      st[1] := upcase(st[1]);
      case st[1] of
        'B','E','S','R': wr(st, comment);
        'C': wc(st);
      else
        writeln('Invalid parameter');
        WResult := wrInvalidParameter;
      end;
    end else begin
      if wo = WAIT_TIMEOUT then begin
        WResult := wrMutexWaitTimeout;
      end else if wo = WAIT_ABANDONED then begin
        WResult := wrMutexWaitAbandoned;
      end;
    end;
    Result := WResult;
  finally
    if mu <> 0 then begin
      ReleaseMutex(mu);
      CloseHandle(mu);
    end;
  end;
end;

end.
