xtstrings.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xTStrings;

interface

uses Windows, Sysutils, Classes, FileCtrl;

//------------------------------------------------------------------//
procedure FreeStringsObjects(oStr: TStrings);

//------------------------------------------------------------------//
function  CompositeStrings(oStr: TStrings; const Delimiter: string): string;
function  IndexOfStrings(oStr: TStrings; S: string; StartIndex: Integer = 0; bForward: Boolean = True): Integer;
procedure SplitToStrings(const s,substr:String ; var oStr:TStringList);


//------------------------------------------------------------------//
function  SafeLoadStrings(oStr: TStrings; const sFilePath: string): Boolean;
function  SafeSaveStrings(oStr: TStrings; const sFilePath: string): Boolean;

//------------------------------------------------------------------//
function  FileLoadStrings(const sFilePath: String): String;
procedure FileSaveStrings(const sFilePath,s: String);


implementation

//------------------------------------------------------------------//
//释放TStrings所持有的对象。
procedure FreeStringsObjects(oStr: TStrings);
var
  I: Integer;
begin
  for I := 0 to oStr.count - 1 do
    if assigned(oStr.objects[I]) then
    begin
      Dispose(pointer(oStr.objects[I]));
      oStr.objects[I] := nil;
    end;
end;

//------------------------------------------------------------------//
//将TStrings的每个项目文字接续起来，两两以Delimiter间隔
function CompositeStrings(oStr: TStrings; const Delimiter: string): string;
var
  I: Integer;
begin
  Result := '';
  
  with oStr do
  begin
    for I := 0 to Count - 2 do
      Result := Result + Strings[I] + Delimiter;
    if Count > 0 then
      Result := Result + Strings[Count - 1];
  end;
end;

//------------------------------------------------------------------//
//寻访TStrings每个项目，只要项目文字与字符串s相同(不分大小写，不论长度)，即返回该项目编号
function IndexOfStrings(oStr: TStrings; S: string; StartIndex: Integer = 0; bForward: Boolean = True): Integer;
begin
  with oStr do
  begin
    if bForward then
    begin
      for Result := StartIndex to Count - 1 do
        if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
    end else
    begin
      for Result := StartIndex downto 0 do
        if AnsiCompareText(S, Copy(Strings[Result], 1, Length(S))) = 0 then Exit;
    end;
  end;
  
  Result := -1;
end;

//------------------------------------------------------------------//
//分割一个字符串，分割符substr，分割后的字符串分组放入TStringList中。
procedure SplitToStrings(const s,substr:String ; var oStr:TStringList);
var
    t:string;
    i:integer;
begin
    oStr.Clear;
    t:=s;
    i:=pos(substr,t);
    while i<>0 do
    begin
       oStr.Add(copy(t,0,i-1));
       delete(t,1,i);
       i:=pos(substr,t);
    end;
    oStr.Add(t);
end;

//------------------------------------------------------------------//
//强制加载TStrings，在仍有可能成功的情况下，不实现目标函数就不返回。
function SafeLoadStrings(oStr: TStrings; const sFilePath: string): Boolean;
begin
  Result := False;
  repeat
    try
      if not FileExists(sFilePath) then Exit;
      oStr.LoadFromFile(sFilePath);
      Result := True;
      Break;
    except
      Sleep(500);
    end;
  until False;
end;

//------------------------------------------------------------------//
//强制存储TStrings，在仍有可能成功的情况下，不实现目标函数就不返回。
function SafeSaveStrings(oStr: TStrings; const sFilePath: string): Boolean;
begin
  Result := False;
  ForceDirectories(ExtractFilePath(sFilePath));
  repeat
    try
      oStr.SaveToFile(sFilePath);
      Result := True;      
      Break;
    except
      Sleep(500);
    end;
  until False;
end;

//------------------------------------------------------------------//
//从指定文件读入字符串。
function FileLoadStrings(const sFilePath: String): String;
var
  aStr : TStrings;
begin
  Result:='';
  aStr:=TStringList.Create;
  try
    aStr.LoadFromFile(sFilePath);
    Result:=aStr.Text;
  finally
    aStr.Free;
  end;
end;

//------------------------------------------------------------------//
//将字符串写入指定文件。
procedure FileSaveStrings(const sFilePath,s: String);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(sFilePath, fmCreate);
  try
    Stream.WriteBuffer(Pointer(s)^,Length(s));
  finally
    Stream.Free;
  end;
end;

end.