qimport2common.pas

Delphi Advanced Import Component_v2.48.With Full Source.

              if st.wYear = 0 then Exit;
            end;
            st.wYear := 2000 + st.wYear;
            if (Length(ADateTimeStr) < Length(subStr)) or
              (Length(AFormatStr) < 1) then Exit;
            Delete(ADateTimeStr, 1, Length(subStr));
            Delete(AFormatStr, 1, 1);
          end
          else
            Exit;
        end;
      end;
    end
    else if fChar = 'M' then
    begin
      i := Pos('MMMM', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        for j := 1 to 12 do
        begin
          if Pos(UpperCase(DefLongMonthNames[j]), UpperCase(ADateTimeStr)) > 0 then
          begin
            st.wMonth := j;
            if (Length(ADateTimeStr) < Length(DefLongMonthNames[j])) or
              (Length(AFormatStr) < 4) then Exit;
            Delete(ADateTimeStr, 1, Length(DefLongMonthNames[j]));
            Delete(AFormatStr, 1, 4);
            Break
          end
          else if j = 12 then
            Exit;
        end;
      end
      else begin
        i := Pos('MMM', AFormatStr);
        if (i > 0) and (i < Length(ADateTimeStr)) then
        begin
          for j := 1 to 12 do
          begin
            if Pos(UpperCase(DefShortMonthNames[j]), UpperCase(ADateTimeStr)) > 0 then
            begin
              st.wMonth := j;
              if (Length(ADateTimeStr) < Length(DefShortMonthNames[j])) or
                (Length(AFormatStr) < 3) then Exit;
              Delete(ADateTimeStr, 1, Length(DefShortMonthNames[j]));
              Delete(AFormatStr, 1, 3);
              Break
            end
            else if j = 12 then
              Exit;
          end;
        end
        else begin
          i := Pos('MM', AFormatStr);
          if (i > 0) and (i < Length(ADateTimeStr)) then
          begin
            subStr := Copy(ADateTimeStr, i, 2);
            st.wMonth := StrToIntDef(subStr, 0);
            if st.wMonth = 0 then
            begin
              subStr := NormalizeSubString(subStr);
              st.wMonth := StrToIntDef(subStr, 0);
              if st.wMonth = 0 then Exit;
            end;
            if (Length(ADateTimeStr) < Length(subStr)) or
              (Length(AFormatStr) < 2) then Exit;
            Delete(ADateTimeStr, 1, Length(subStr));
            Delete(AFormatStr, 1, 2)
          end
          else begin
            i := Pos('M', AFormatStr);
            if (i > 0) and (i <= Length(ADateTimeStr)) then
            begin
              subStr := Copy(ADateTimeStr, i, 1);
              st.wMonth := StrToIntDef(subStr, 0);
              if st.wMonth = 0 then
              begin
                subStr := NormalizeSubString(subStr);
                st.wMonth := StrToIntDef(subStr, 0);
                if st.wMonth = 0 then Exit;
              end;
              if (Length(ADateTimeStr) < Length(subStr)) or
                (Length(AFormatStr) < 1) then Exit;
              Delete(ADateTimeStr, 1, Length(subStr));
              Delete(AFormatStr, 1, 1)
            end
            else
              Exit;
          end;
        end;
      end;
    end
    else if fChar = 'D' then
    begin
      i := Pos('DD', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        subStr := Copy(ADateTimeStr, i, 2);
        st.wDay := StrToIntDef(subStr, 0);
        if st.wDay = 0 then
        begin
          subStr := NormalizeSubString(subStr);
          st.wDay := StrToIntDef(subStr, 0);
          if st.wDay = 0 then Exit;
        end;
        if (Length(ADateTimeStr) < Length(subStr)) or
          (Length(AFormatStr) < 2) then Exit;
        Delete(ADateTimeStr, 1, Length(subStr));
        Delete(AFormatStr, 1, 2);
      end
      else begin
        i := Pos('D', AFormatStr);
        if (i > 0) and (i <= Length(ADateTimeStr)) then
        begin
          subStr := Copy(ADateTimeStr, i, 1);
          st.wDay := StrToIntDef(subStr, 0);
          if st.wDay = 0 then
          begin
            subStr := NormalizeSubString(subStr);
            st.wDay := StrToIntDef(subStr, 0);
            if st.wDay = 0 then Exit;
          end;
          if (Length(ADateTimeStr) < Length(subStr)) or
            (Length(AFormatStr) < 1) then Exit;
          Delete(ADateTimeStr, 1, Length(subStr));
          Delete(AFormatStr, 1, 1);
        end
        else
          Exit;
      end;
    end
    else if fChar = 'H' then
    begin
      i := Pos('HH', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        subStr := Copy(ADateTimeStr, i, 2);
        st.wHour := StrToIntDef(subStr, 0);
        if st.wHour = 0 then
        begin
          subStr := NormalizeSubString(subStr);
          st.wHour := StrToIntDef(subStr, 0);
          if st.wHour = 0 then Exit;
        end;
        if (Length(ADateTimeStr) < Length(subStr)) or
          (Length(AFormatStr) < 2) then Exit;
        Delete(ADateTimeStr, 1, Length(subStr));
        Delete(AFormatStr, 1, 2);
      end
      else begin
        i := Pos('H', AFormatStr);
        if (i > 0) and (i <= Length(ADateTimeStr)) then
        begin
          subStr := Copy(ADateTimeStr, i, 1);
          st.wHour := StrToIntDef(subStr, 0);
          if st.wHour = 0 then
          begin
            subStr := NormalizeSubString(subStr);
            st.wHour := StrToIntDef(subStr, 0);
            if st.wHour = 0 then Exit;
          end;
          if (Length(ADateTimeStr) < Length(subStr)) or
            (Length(AFormatStr) < 1) then Exit;
          Delete(ADateTimeStr, 1, Length(subStr));
          Delete(AFormatStr, 1, 1);
        end
        else
          Exit;
      end;
    end
    else if fChar = 'N' then
    begin
      i := Pos('NN', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        subStr := Copy(ADateTimeStr, i, 2);
        st.wMinute := StrToIntDef(subStr, 0);
        if st.wMinute = 0 then
        begin
          subStr := NormalizeSubString(subStr);
          st.wMinute := StrToIntDef(subStr, 0);
          if st.wMinute = 0 then Exit;
        end;
        if (Length(ADateTimeStr) < Length(subStr)) or
          (Length(AFormatStr) < 2) then Exit;
        Delete(ADateTimeStr, 1, Length(subStr));
        Delete(AFormatStr, 1, 2);
      end
      else begin
        i := Pos('N', AFormatStr);
        if (i > 0) and (i <= Length(ADateTimeStr)) then
        begin
          subStr := Copy(ADateTimeStr, i, 1);
          st.wMinute := StrToIntDef(subStr, 0);
          if st.wMinute = 0 then
          begin
            subStr := NormalizeSubString(subStr);
            st.wMinute := StrToIntDef(subStr, 0);
            if st.wMinute = 0 then Exit;
          end;
          if (Length(ADateTimeStr) < Length(subStr)) or
            (Length(AFormatStr) < 1) then Exit;
          Delete(ADateTimeStr, 1, Length(subStr));
          Delete(AFormatStr, 1, 1);
        end
        else
          Exit;
      end;
    end
    else if fChar = 'S' then
    begin
      i := Pos('SS', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        subStr := Copy(ADateTimeStr, i, 2);
        st.wSecond := StrToIntDef(subStr, 0);
        if st.wSecond = 0 then
        begin
          subStr := NormalizeSubString(subStr);
          st.wSecond := StrToIntDef(subStr, 0);
          if st.wSecond = 0 then Exit;
        end;
        if (Length(ADateTimeStr) < Length(subStr)) or
          (Length(AFormatStr) < 2) then Exit;
        Delete(ADateTimeStr, 1, Length(subStr));
        Delete(AFormatStr, 1, 2);
      end
      else begin
        i := Pos('S', AFormatStr);
        if (i > 0) and (i <= Length(ADateTimeStr)) then
        begin
          subStr := Copy(ADateTimeStr, i, 1);
          st.wSecond := StrToIntDef(subStr, 0);
          if st.wSecond = 0 then
          begin
            subStr := NormalizeSubString(subStr);
            st.wSecond := StrToIntDef(subStr, 0);
            if st.wSecond = 0 then Exit;
          end;
          if (Length(ADateTimeStr) < Length(subStr)) or
            (Length(AFormatStr) < 1) then Exit;
          Delete(ADateTimeStr, 1, Length(subStr));
          Delete(AFormatStr, 1, 1);
        end
        else
          Exit;
      end;
    end
    else if fChar = 'A' then
    begin
      i := Pos('AP', AFormatStr);
      if (i > 0) and (i < Length(ADateTimeStr)) then
      begin
        subStr := Copy(ADateTimeStr, i, 2);
        if (subStr[1] = 'P') or (subStr[1] = 'p') then
        begin
          if st.wHour < 12 then
            st.wHour := st.wHour + 12;
        end
        else if st.wHour = 12 then
          st.wHour := 0;
        if (Length(ADateTimeStr) < Length(subStr)) or
          (Length(AFormatStr) < 2) then Exit;
        Delete(ADateTimeStr, 1, Length(subStr));
        Delete(AFormatStr, 1, 2);
      end
      else
        Exit;
    end
    else begin
      if (Length(ADateTimeStr) < 1) or
        (Length(AFormatStr) < 1) then Exit;
      if AFormatStr[1] <> ADateTimeStr[1] then Exit;
      Delete(ADateTimeStr, 1, 1);
      Delete(AFormatStr, 1, 1);
    end;
  end;

  try
    Result := SystemTimeToDateTime(st);
  except
    Result := 0;
  end;
end;
{$ENDIF}

function TryStrToDateTime(const Str: string; var DateTime: TDateTime): Boolean;
var
  DT: TDateTime;
begin
  Result := True;
  DateTime := 0;
  try
    DT := StrToDateTime(Str);
  except
{$IFDEF WIN32}
    DT := FormatStrToDateTime(Str, ShortDateFormat);
    if DT = 0 then
{$ENDIF}
    try
      DT := StrToFloat(Str);
    except
      Result := False;
    end;
  end;
  if Result then
    DateTime := DT;
end;

{$IFNDEF VCL5}
function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;
{$ENDIF}

function DirExists(const Directory: string): Boolean;
{$IFDEF LINUX}
var
  st: TStatBuf;
begin
  if stat(PChar(Directory), st) = 0 then
    Result := S_ISDIR(st.st_mode)
  else
    Result := False;
end;
{$ENDIF}
{$IFDEF WIN32}
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF}

procedure CutFirstDirectory(var S: string);
var
  Root: Boolean;
  P: Integer;
begin
  if S = '\' then
    S := ''
  else
  begin
    if S[1] = '\' then
    begin
      Root := True;
      Delete(S, 1, 1);
    end
    else
      Root := False;
    if S[1] = '.' then
      Delete(S, 1, 4);
    P := AnsiPos('\',S);
    if P <> 0 then
    begin
      Delete(S, 1, P);
      S := '...\' + S;
    end
    else
      S := '';
    if Root then
      S := '\' + S;
  end;
end;

function MinimizeName(const Filename: string; Canvas: TCanvas;
  MaxLen: Integer): string;
var
  Drive: string;
  Dir: string;
  Name: string;
begin
  Result := FileName;
  Dir := ExtractFilePath(Result);
  Name := ExtractFileName(Result);

  if (Length(Dir) >= 2) and (Dir[2] = ':') then
  begin
    Drive := Copy(Dir, 1, 2);
    Delete(Dir, 1, 2);
  end
  else
    Drive := '';
  while ((Dir <> '') or (Drive <> '')) and (Canvas.TextWidth(Result) > MaxLen) do
  begin
    if Dir = '\...\' then
    begin
      Drive := '';
      Dir := '...\';
    end
    else if Dir = '' then
      Drive := ''
    else
      CutFirstDirectory(Dir);
    Result := Drive + Dir + Name;
  end;
end;

initialization
  GetMonthDayNames;

end.