uappstringutilts.pas

从文本文件象Oracle数据库导入数据

    sTempSub := ASrcStr;
  end
  else
  begin
    sTemp := UpperCase(sStr2);
    sTempSub := UpperCase(ASrcStr);
  end;
  //查找第一个
  iPos := Pos(sTempSub, sTemp);
  iCount := 0;
  while iPos > 0 do
  begin
    //替换
    sStr1 := sStr1 + Copy(sStr2, 1, iPos - 1) + ADestStr;
    Delete(sStr2, 1, iPos + Length(ASrcStr) - 1);
    iCount := iCount + 1;
    if iCount = ACount then
      Break;
    if ASensitive then
    begin
      sTemp := sStr2;
    end
    else
    begin
      sTemp := UpperCase(sStr2);
    end;
    //查找下一个
    iPos := Pos(sTempSub, sTemp);
  end;
  //返回
  Result := sStr1 + sStr2;
end;

function GetCodeFromString_Bracket(AString: string; ADefault: string=''): string;
var
  strTemp: string;
begin
  strTemp := Copy(AString, Pos('(', AString) + 1,
                   Pos(')', AString) - Pos('(', AString) -1);
  if strTemp = '' then
    strTemp := ADefault;
  Result := strTemp;
end;

function GetCodeFromTreeNode(ANode: TTreeNode; ADefault: string): string;
begin
  if ANode = nil then
    Result := ''
  else
    Result := GetCodeFromString_Bracket(ANode.Text, ADefault);
end;

function GetCodeFromString_Dot(AString: string; ADefault: string=''): string;
var
  strTemp: string;
begin
  strTemp := Copy(AString, 1, Pos('.', AString) - 1);
  if strTemp = '' then
    strTemp := ADefault;
  Result := strTemp;
end;

function GetCodeFromComboItem(AComboBox: TComboBox; ADefault: string): string;
var
  sItemStr: string;
begin
  if AComboBox.ItemIndex < 0 then
    sItemStr := ''
  else
    sItemStr := AComboBox.Items[AComboBox.ItemIndex];
  Result :=  GetCodeFromString_Dot(sItemStr, ADefault);
end;

function IsKeyAlpha(Key: Word; Shift: TShiftState): Boolean;
begin
  Result := (Key >= Ord('A')) and (key <= Ord('Z'));
end;

function IsKeyNumberic(Key: Word; Shift: TShiftState): Boolean;
begin
  if (Key >= Ord('0')) and (key <= Ord('9')) then Result := True
  else if (Key >= VK_NUMPAD0) and (key <= VK_NUMPAD9) then Result := not (ssShift in shift)
  else Result := False;
end;

function FillString(ASrcStr: string; AAddStr: string; AWholeLength: Integer;
         AFillMode: TFillStringMode; AForceLength: Boolean=True): string;
var
  rStr: string;
begin
  rStr := ASrcStr;
  while Length(rStr) < AWholeLength do
  begin
    case AFillMode of
      fsmRight: rStr := rStr + AAddStr;
      fsmBoth: rStr := AAddStr + rStr + AAddStr;
      fsmLeft: rStr := AAddStr + rStr;
    end;
  end;
  if AForceLength then
  begin
    case AFillMode of
      fsmBoth: Result := Copy(rStr, Length(rStr) div 2  - AWholeLength div 2, AWholeLength);
      fsmLeft: Result := Copy(rStr, 1, AWholeLength);
      fsmRight: Result := Copy(rStr, Length(rStr) - AWholeLength + 1 ,AWholeLength);
    end;
  end
  else
    Result := rStr;
end;

function InsertEnter(sStr: WideString; iCharNumPerLine: Integer): string;
var
  CurPos: Integer;
  TempStr: WideString;
  TempChar, TempNextChar: WideChar;
  CharNum: Integer;
  ShortCharNum: Integer;
  I: Integer;
  TmpChar: WideChar;
  TStr: WideString;
begin
  if iCharNumPerLine <= 0 then Exit;
  TempStr := '';
  CharNum := 0;
  ShortCharNum := 0;
  CurPos := 1;
  while CurPos <= Length(sStr) do
  begin
    TempChar := sStr[CurPos];
    if CurPos < Length(sStr) then TempNextChar := sStr[CurPos + 1]
    else TempNextChar := #0;
    if ((Ord(TempChar) >= 48) and (Ord(TempChar) <= 57))
       or (Ord(TempChar) = 46) then    //=====================数字和小数点
    begin
      I := CurPos + 1;
      TStr := Copy(sStr, CurPos, 1);
      TmpChar := sStr[I];
      while (I <= Length(sStr))    //讲相邻的所有数字合并成一个表示数字的串
            and (((Ord(TmpChar) >= 48) and (Ord(TmpChar) <= 57))
                or (Ord(TmpChar) = 46)) do
      begin
        TStr := TStr + Copy(sStr, I, 1);
        I := I + 1;
        TmpChar := sStr[I];
      end;
      if (CharNum + Length(TStr) div 2) < iCharNumPerLine then //**数字较短，不用换行
      begin
        TempStr := TempStr + TStr;
        CharNum := CharNum + Length(TStr) div 2;
        ShortCharNum := ShortCharNum + Length(TStr) mod 2;
        if ShortCharNum = 2 then
        begin
          CharNum := CharNum + 1;
          if CharNum = iCharNumPerLine then TempStr := TempStr + #13;
          ShortCharNum := 0;
        end;
      end
      else if (Length(TStr) div 2) > iCharNumPerLine then    //**数字很长，需要换行（数字自身超过一行）
      begin
        I := 1;
        while I <= Length(TStr) do
        begin
          TempStr := TempStr + #13 + Copy(TStr, I, iCharNumPerLine * 2);
          I := I + iCharNumPerLine * 2;
          CharNum := CharNum + iCharNumPerLine;
        end;
        CharNum := CharNum mod iCharNumPerLine + 1;
        ShortCharNum := Length(TStr) mod 2;
      end
      else                                           //**数字较长，换行
      begin
        TempStr := TempStr + #13 + TStr;
        CharNum :=Length(TStr) div 2;
        ShortCharNum := Length(TStr) mod 2;
      end;
      CurPos := CurPos + Length(TStr);
    end
    else           //==================除了数字和小数点以外的字符
    begin
      TempStr := TempStr + Copy(sStr, CurPos, 1);
      if Ord(TempChar) < 256 then  //------小字符
      begin
        ShortCharNum := ShortCharNum + 1;
        if ShortCharNum = 2 then
        begin
          ShortCharNum := 0;
          CharNum := CharNum + 1;
        end;
      end
      else CharNum := CharNum + 1;  //------宽字符
      if ((CharNum = iCharNumPerLine - 1) and (ShortCharNum = 1) and (Ord(TempNextChar) > 255))
         or (CharNum = iCharNumPerLine) then
      begin
        TempStr := TempStr + #13;
        CharNum := 0;
        ShortCharNum := 0;
      end;
      CurPos := CurPos + 1;
    end;
  end;
  Result := TempStr;
end;

procedure SplitStringToList(AStr, ASeperator: string; AList: TStrings; AClear: Boolean);
var
  I, J: Integer;
  iCurPos, iSepPos, iStrLength, iSepLength: Integer;
  sSubStr: string;
  bIsSame: Boolean;
begin
  if AList = nil then
    AList := TStringList.Create;
  if AClear then
    AList.Clear;
  iStrLength := Length(AStr);
  iSepLength := Length(ASeperator);
  if iStrLength = 0 then
    Exit;
  if iSepLength = 0 then
  begin
    AList.Append(AStr);
    Exit;
  end;
  iCurPos := 1;
  iSepPos := 0;
  I := 1;
  while I <= iStrLength do
  begin
    bIsSame := True;
    for J := 1 to iSepLength do
    begin
      if AStr[I + J - 1] <> ASeperator[J] then
      begin
        bIsSame := False;
        I := I + 1;
        Break;
      end;
    end;
    if bIsSame then
    begin
      iSepPos := I;
      sSubStr := Copy(AStr, iCurPos, iSepPos - iCurPos);
      AList.Append(sSubStr);
      I := I + iSepLength;
      iCurPos := I;
    end;
  end;
  sSubStr := Copy(AStr, iSepPos + iSepLength, iStrLength - iSepPos);
  AList.Append(sSubStr);
end;

function ContractListToString(AList: TStrings; ASeprator: string): string;
var
  I: Integer;
  sResultStr: string;
begin
  if AList.Count > 0 then
    sResultStr := AList[0]
  else
    sResultStr := '';
  for I := 1 to AList.Count - 1 do
  begin
    sResultStr := sResultStr + ASeprator + AList[I];
  end;
  Result := sResultStr;
end;

procedure AssignStringList(const ASrcStrList: TStringList; var ADestStrList: TStringList);
var
  I: Integer;
begin
  if not Assigned(ADestStrList) then
    ADestStrList := TStringList.Create;
  ADestStrList.Clear;
  for I := 0 to ASrcStrList.Count - 1 do
  begin
    ADestStrList.Append(ASrcStrList[I]);
  end;
end;

end.