unit wlu;
{$i define.pas}
interface
uses
  SysUtils, Classes, DateUtils, UtlType, WinUtl, PropUtl, IniFiles, Windows;
const
  LogName = 'WL.LG';
  WLVersion = '1.02';

  {ini}
  LogDir: shortstring = '';
  
  {/ini}

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;

function GetLogName: string;
begin
  if LogDir <> '' then begin
    Result := IncludeTrailingPathDelimiter(LogDir) + LogName;
  end else begin
    Result := LogName;
  end;
end;

procedure wc(const astart:string; acomment: string);
var
  total, l: Longint;
  dt1, dt2, dt3: TDateTime;
  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;

  dta: TDateTimeArray;

  isInProject: boolean;
  projects: TStringList;

  procedure Resume;
  begin
    if (not isInProject) then
      exit;
    DateTimeSetStr(dt1, dtDateTimeString, copy(line, 2, 14));
    running := true;
    if firstStart then begin
      firstStart:= false;
      if datetime1 < DateTimeGetStr(dt1, dtDateTimeString) then
        datetime1 := DateTimeGetStr(dt1, dtDateTimeString);
    end;

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

  procedure Start;
  var
    i: integer;
    pr: string;
  begin
    if acomment <> '' then begin
      isInProject := false;
      for i := 0 to projects.Count - 1 do begin
        pr := projects[i];
        if pos(pr, copy(line, 17, length(line))) = 1 then begin
          isInProject := true;
          break;
        end;
      end;
      if not isInProject then begin
        running := false;
        exit;
      end;
    end else begin
      isInProject := true;
    end;
    Resume;
  end;

  procedure Suspend;
  var
    i: longint;
  label
    ex;
  begin
    if running then begin
      if line <> '' then begin
        DateTimeSetStr(dt2, dtDateTimeString, copy(line,2, 14));
      end else begin
        dt2 := Now;
      end;

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

      if datetime1 <> '' then begin
        if DateTimeGetStr(dt2, dtDateTimeString) < datetime1 then
          goto ex;
        if datetime1 > DateTimeGetStr(dt1, dtDateTimeString) then
          DateTimeSetStr(dt1, dtDateTimeString, datetime1);
      end;
      i := round((dt2 - dt1) * SecsPerDay); //DTGetInterval(dt1, dt2, tuSecond);
      if i > 0 then
        l := l + i;
    end;
  ex:
    running := false;
  end;

  procedure Stop;
  begin
    Suspend;
    isInProject := false;
  end;

begin
  AssignFile(f, GetLogName);
  {$i-}
  Reset(f);
  WResult := ioresult;
  if WResult <> 0 then begin
    Writeln('Can not open ' + GetLogName);
    exit;
  end;
  acomment := trim(acomment);
  projects := TStringList.Create;
  try
    //winutl
    ParseLine([';'], acomment, projects);

    total := 0;
    l := 0;
    dt1 := 0;
    dt2 := 0;
    dt3 := 0;
    running := false;
    datetime3 := '';
    datetime1 := copy(astart,2, length(astart){14});
    {v1.01}
    firstStart:= true;
    if (datetime1 = 'today') or (datetime1 = 'day') then begin
      datetime1 := DateTimeGetStr(Now, dtDateString);
    end else if datetime1 = 'week' then begin
      dt1 := StartOfTheWeek(Now);
      datetime1 := DateTimeGetStr(dt1, dtDateString);
      {logtype}
    end else if datetime1 = 'month' then begin
      dt1 := StartOfTheMonth(Now);
      datetime1 := DateTimeGetStr(dt1, dtDateString);
    end else if datetime1 = 'year' then begin
      dt1 := StartOfTheYear(Now);
      datetime1 := DateTimeGetStr(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));
          DateTimeSetStr(dt3, dtDateTimeString, datetime3);
          datetime1 := copy(datetime1, 1, p - 1);
        end;
        DateTimeSetStr(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': Suspend;
          'R': Resume;
          'E': Stop;
        end;
        cur := line[1];
      end;
      if shouldBreak then
        break;
    end;


    line := '';
    Stop;
    if datetime1 <> '' then begin
      DateTimeSetStr(dt1, dtDateTimeString, datetime1);
      since := '(since ' + DateTimeGetStr(dt1, dtDatum) + ' ' + DateTimeGetStr(dt1, dtCas)+ ')';
    end else begin
      since := '';
    end;

    total := l;
    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) + ' (' + trim(RealToString(total / 3600, 6, 1)) + ' hours)');
    Writeln('Current state: ' + cur + '=' + GetStateName(cur));

  finally
    projects.Free;
  end;
end;

procedure wr(const cm:string; const comment:string);
var
  f: text;
  dt: TDateTime;
  line:string;
  ok:boolean;
  s:string;
label ex;
begin
  s := cm;
  AssignFile(f, GetLogName);  {errors getlasterror}
  {$I-}
  dt := 0;
  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 ' + GetLogName);
      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 := 0;
  if length(s) = 1 then begin
    dt := Now;
  end else begin
    try
      DateTimeSetStr(dt, dtDateTimeString, copy(s, 2, 14));{Xrrrrmmddhhmmss}
    except
      WResult := wrInvalidDateTime;
      writeln('Invalid date/time specified.');
    end;
  end;
  if WResult <> 0 then
    goto ex;
  s := s[1] + DateTimeGetStr(dt, dtDateTimeString) + ' ' + comment;
  writeln(f, s);
  writeln(s + '    Written to ' + GetLogName);
  Writeln('Current state: ' + s[1] + '=' + GetStateName(s[1]));
  ok := true;
ex:
  if TTextRec(f).Mode <> fmClosed then
    close(f);
  if ok and (s[1] = 'E') then
    wc('', '');
end;

procedure ReadWriteConfig(what: TReadWrite);
var
  f: TIniFile;
  fn: string;
begin
  fn := FindIniFile;
  f := TIniFile.Create(fn);
  try
    ConfigReadWriteValue(f, what, 'Env', 'LogDir' , @LogDir, ptString);
  finally
    f.Free;
  end;
end;


function w(const s:shortstring): integer;
var
{  ch:char;}
  st:string;
  comment: string;
  i:integer;
  mu:THandle;
  wo: integer;
begin
{  Result := -1;}
  ReadWriteConfig(rwRead);
  try
    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, comment);
        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;
  finally
    ReadWriteConfig(rwWrite);
  end;
end;

end.
