qimport3common.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

        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;

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

{$IFNDEF VCL5}
function StringReplace(const S, OldPattern, NewPattern: AnsiString;
  Flags: TReplaceFlags): AnsiString;
var
  SearchStr, Patt, NewStr: AnsiString;
  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;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

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 := Pos('\',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;

{$IFDEF QI_UNICODE}
function QIAddQuote(const S, LeftQuote, RightQuote: WideString): WideString;
begin
  Result := LeftQuote + S + RightQuote;
end;

function QIRemoveQuote(const S, LeftQuote, RightQuote: WideString): WideString;
var
  l: Integer;
begin
  Result := S;
  l := Length(LeftQuote);
  if QICompareStr(Copy(Result, 1, l), LeftQuote) = 0 then
    QIDelete(Result, 1, l);
  l := Length(RightQuote);
  if QICompareStr(Copy(Result, Length(Result) - l + 1, l), RightQuote) = 0 then
    QIDelete(Result, Length(Result) - l + 1, l);
end;

function QIUpperFirst(const S: WideString): WideString;
begin
  if Length(S) <> 0 then
    Result := QIUpperCase(S[1]) + QILowerCase(Copy(S, 2, Length(S) - 1))
  else
    Result := S;
end;

function QIUpperFirstWord(const S: WideString): WideString;
var
  spaceFlag: Boolean;
  resultPtr: PWideChar;
begin
  Result := S;
  resultPtr := PWideChar(Result);
  spaceFlag := False;
  while lstrlenW(resultPtr) > 0 do
  begin
    if lstrlenW(resultPtr) = Length(Result) then
    begin
      if resultPtr^ <> ' ' then
        CharUpperBuffW(resultPtr, 1)
      else
        spaceFlag := True;
    end
    else begin
      if resultPtr^ = ' ' then
        spaceFlag := True
      else if spaceFlag then
      begin
        CharUpperBuffW(resultPtr, 1);
        spaceFlag := False;
      end;
    end;
    Inc(resultPtr);
  end;
end;
{$ELSE}
function QIAddQuote(const S, LeftQuote, RightQuote: AnsiString): AnsiString;
begin
  Result := LeftQuote + S + RightQuote;
end;

function QIRemoveQuote(const S, LeftQuote, RightQuote: AnsiString): AnsiString;
var
  l: Integer;
begin
  Result := S;
  l := Length(LeftQuote);
  if AnsiCompareStr(Copy(Result, 1, l), LeftQuote) = 0 then
    Delete(Result, 1, l);
  l := Length(RightQuote);
  if AnsiCompareStr(Copy(Result, Length(Result) - l + 1, l), RightQuote) = 0 then
    Delete(Result, Length(Result) - l + 1, l);
end;

function QIUpperFirst(const S: AnsiString): AnsiString;
begin
  if Length(S) <> 0 then
    Result := AnsiUpperCase(S[1]) + AnsiLowerCase(Copy(S, 2, Length(S) - 1))
  else
    Result := S;
end;

function QIUpperFirstWord(const S: AnsiString): AnsiString;
var
  spaceFlag: Boolean;
  resultPtr: PChar;
begin
  Result := S;
  resultPtr := PChar(Result);
  spaceFlag := False;
  while lstrlen(resultPtr) > 0 do
  begin
    if lstrlen(resultPtr) = Length(Result) then
    begin
      if resultPtr^ <> ' ' then
         CharUpperBuff(resultPtr, 1)
      else
        spaceFlag := True;
    end
    else begin
      if resultPtr^ = ' ' then
        spaceFlag := True
      else if spaceFlag then
      begin
        CharUpperBuff(resultPtr, 1);
        spaceFlag := False;
      end;
    end;
    Inc(resultPtr);
  end;
end;
{$ENDIF}

function GetFieldDataType(const Value: string): TFieldType;

  function IsInteger: boolean;                          
  begin
    Result := True;
    try
      StrToInt(Value);
    except
      Result := False;
    end;
  end;

  function IsFloat: boolean;
  begin
    Result := True;
    try
      StrToFloat(Value);
    except
      Result := False;
    end;
  end;

  function IsTime: boolean;
  begin
    Result := True;
    try
      StrToTime(Value);
    except
      Result := False;
    end;
  end;

  function IsDate: boolean;
  begin
    Result := True;
    try
      StrToDate(Value);
    except
      Result := False;
    end;
  end;

  function IsDateTime: boolean;
  begin
    Result := True;
    try
      StrToDateTime(Value);
    except
      Result := False;
    end;
  end;

begin
  Result := ftUnknown;
  if Value <> '' then
  begin
    if Length(Value) < 255 then
    begin
      if (AnsiLowerCase(Value) = 'true') or (AnsiLowerCase(Value) = 'false') then
        Result := ftBoolean
      else if IsInteger then
        Result := ftInteger
      else if IsFloat then
        Result := ftFloat
      else if IsTime then
        Result := ftTime
      else if IsDate then
        Result := ftDate
      else if IsDateTime then
        Result := ftDateTime
      else
        Result := ftString;
    end else
      Result := ftMemo;
  end;
end;

initialization
  GetMonthDayNames;

end.