paslib.pas

在工作中积累的一些函数

                    Inc(tail);

                    if tail = nil then
                    begin
                            //strnset(buffer, '#0', BUFFER_SIZE);

                            //strcpy(buffer, head);
                            if buffer = nil then
                                    Strings.Add('')
                            else    Strings.Add(buffer);
                    end;
            end;

            buffer := nil;
    }
end;

procedure ArrayToStrings(const Arr: array of string; Strings: TStrings);
var
    I               : Longint;
begin
    Strings.Clear;
    for I := Low(Arr) to High(Arr) do
        Strings.Add(Arr[i]);
end;

function spMakeSectionStr(const S: string): string;
begin
    Result := '[' + S + ']';
end;

function spGetQNumSectNo(const S: string): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(S) do
        if S[I] = '-' then
        begin
            Result := Copy(S, 1, I - 1);
            break;
        end;
end;

function ExtractNum(const ANum: string): string;
var
    I               : Longint;
    HeadNum         : string;
    Num             : string;
begin
    HeadNum := '';
    Num := '';
    for I := 1 to Length(ANum) do
    begin
        if not spIsDigit(ANum[I]) then
            HeadNum := HeadNum + ANum[I]
        else
        begin
            Num := Copy(ANUm, I, Length(ANum) + 1);
            break;
        end;
    end;
    Result := ANum;
    if HeadNum = '估' then Result := 'D' + Num;
    if HeadNum = '常补' then Result := 'CZ' + Num;

end;

function spTrimInTernalnullityChar(const S: string): string;
var
    I               : Longint;
begin
    Result := '';
    for I := 1 to Length(S) do
        if (S[I] <> #13) and (S[I] <> ',') then
            Result := Result + S[I];
end;

function spReplaceItemName(var S: string; const A, B: string): Boolean;
var
    I, J            : Longint;
    V               : string;
    Name            : string;
    nB, Ne          : Longint;
begin
    Result := False;
    V := UpperCase(Copy(A, 1, 1));
    Name := S;
    if Pos('→', S) > 0 then
        Name := Copy(S, 1, Pos('→', S));
    I := Pos(V, Name);
    J := I;
    if I > 0 then
    begin
        I := I + 1;
        while I <= length(S) do
        begin
            if (spIsDigit(S[I]) or (s[I] = '.')) then
                V := V + S[I]
            else
            begin
                if I = J + 1 then
                    Result := False
                else
                    Result := True;
                break;
            end;
            I := I + 1;
        end;
        if Result then
            S := stringReplace(S, V, B, [rfIgnoreCase]);
    end
    else
    begin
        nB := -1;
        Ne := -1;
        nB := Pos('{', s);
        nE := Pos('}', S);
        if (nB > 0) and (nE > 0) and (nE > nB) then
        begin
            S := Copy(S, 1, nB) + B + copy(S, ne, maxint);
            Result := True;
        end
        else
            Result := False;
    end;
end;

function SpReplaceItemNamex(var S: string; const A: string): boolean;
var
    nB, nE          : longint;
    V               : string;
    RD              : string;
begin
    Result := False;
    if A = '' then exit;
    V := trim(s);
    if Pos('K', A) <> 1 then exit;
    Rd := Copy(A, 3, Length(A) - 3);
    nB := -1;
    nE := -1;
    nB := Pos('{', S);
    nE := Pos('}', S);
    if (NB > 0) and (nE > 0) and (nE > nB) then
    begin
        S := Copy(V, 1, nB) + Rd + Copy(V, ne, maxint);
        Result := True;
    end;
end;

function GetBData(const V: string): string;
var
    A, B            : string;
begin
    Result := '';
    if pos('T', V) = 1 then
    begin
        spGetReplaceData(v, A, B);
        Result := B;
    end
    else
        if Pos('K', V) = 1 then
    begin
        Result := Copy(V, 3, length(V) - 3);
    end;

end;

function SpPbNameReplace(var s: string; const A, B: string): Boolean;
var
    I, J            : Longint;
    AKey1, Akey2, Akey3: string;
    V               : string;
    Aname           : string;
    nB, nE          : longint;
    RepD            : string;
    strings         : TStrings;
    BData           : string;
begin
    Result := False;
    if A = '' then exit;
    if Pos('T', A) = 1 then
    begin
        spGetReplaceData(A, Akey1, Akey2);
        //
        nB := -1;
        Ne := -1;
        nB := Pos('{', s);
        nE := Pos('}', S);
        Bdata := GetBData(B);
        if (nB > 0) and (nE > 0) and (nE > nB) and (Bdata <> '') then
        begin
            RepD := copy(s, nB + 1, ne - nB - 1);
            strings := TStringList.Create;
            spExtractTextByToken(RepD, ';', strings);
            for I := 0 to Strings.Count - 1 do
            begin
                if Strings[I] = Bdata then
                begin
                    Strings[I] := Akey2;
                    break;
                end;
            end;
            Akey3 := '';
            for I := 0 to Strings.Count - 1 do
            begin
                if Akey3 <> '' then
                    Akey3 := Akey3 + ';';
                Akey3 := Akey3 + Strings[I];
            end;
            strings.Clear;
            S := Copy(S, 1, nB) + Akey3 + copy(S, ne, maxint);
            Result := True;
        end
        else
            Result := False;
        //
        if not Result then
        begin
            V := UpperCase(Copy(Akey1, 1, 1));
            AName := S;
            I := Pos(V, AName);
            J := I;
            if I > 0 then
            begin
                I := I + 1;
                while I <= length(S) do
                begin
                    if (spIsDigit(S[I]) or (s[I] = '.')) then
                        V := V + S[I]
                    else
                    begin
                        if I = J + 1 then
                            Result := False
                        else
                            Result := True;
                        break;
                    end;
                    I := I + 1;
                end;
                if Result then
                    S := stringReplace(S, V, Akey2, [rfIgnoreCase]);
            end;
        end;

    end
    else
    begin

        Akey2 := Copy(A, 3, Length(A) - 3);
        AName := S;
        nB := -1;
        nE := -1;
        nB := Pos('{', S);
        nE := Pos('}', S);
        Bdata := GetBData(B);
        if (NB > 0) and (nE > 0) and (nE > nB) and (Bdata <> '') then
        begin
            RepD := copy(s, nB + 1, ne - nB - 1);
            strings := TStringList.Create;
            spExtractTextByToken(RepD, ';', strings);
            for I := 0 to Strings.Count - 1 do
            begin
                if Strings[I] = Bdata then
                begin
                    Strings[I] := Akey2;
                    break;
                end;
            end;
            Akey2 := '';
            for I := 0 to Strings.Count - 1 do
            begin
                if Akey2 <> '' then
                    Akey2 := Akey2 + ';';
                Akey2 := Akey2 + Strings[I];
            end;
            strings.Clear;

            S := Copy(AName, 1, nB) + Akey2 + Copy(AName, ne, maxint);
            Result := True;
        end;

    end;
end;

procedure spGetReplaceData(const S: string; var A, B: string);
var
    V               : string;
begin
    A := '';
    B := '';
    V := spCopyInsideTokens(s, '(', ')');
    A := SpStrName(V, ',');
    B := SpStrValue(V, ',');
end;

function IsReplaceKey(const S: string): Boolean;
begin
    Result := False;
    if S <> '' then
        if Pos('T', S) = 1 then
            Result := True;


end;

procedure TrimCnvHisThV(var cnvhis: string; const AText: string; const AoldText: string);
var
    Comps           : string;
    NewText         : string;
begin
    if Pos('替换为', AText) = 0 then
    begin
        if cnvHis <> '' then cnvhis := cnvhis + ';';
        cnvhis := cnvhis + Atext;
        exit;
    end;
    NewText := Copy(AText, Pos('替换为', AText), maxint);

    if Pos(AoldText, cnvhis) = 0 then
    begin
        if cnvHis <> '' then cnvhis := cnvhis + ';';
        cnvhis := cnvhis + Atext;
        exit;
    end;
    Comps := StringReplace(cnvhis, AoldText, newText, [rfIgnoreCase]);
    if Pos(AoldText, Comps) = 0 then
        cnvhis := Comps
    else
    begin
        if cnvHis <> '' then cnvhis := cnvhis + ';';
        cnvhis := cnvhis + Atext;
    end;



end;

procedure spDeleteCnvhis(var cnvhis: string; const AText: string);
begin
    cnvhis := stringReplace(cnvhis, ';' + Atext, '', [rfIgnoreCase]);
    cnvhis := stringReplace(cnvhis, Atext + ';', '', [rfIgnoreCase]);
    cnvhis := stringReplace(cnvhis, Atext, '', [rfIgnoreCase]);
end;

procedure spTrimCnvHis(var cnvHis: string; const AText: string);
begin
    if AText = '' then exit;
    if cnvHis <> '' then cnvHis := cnvHis + ';';
    cnvHis := cnvHis + Atext;
end;    
function IsJssFh(const V:char): boolean;
begin
    Result := False;
    if V in ['+','-','*' ,'/','{','<','>'] then
    Result := True;
    //,/,(,{,[,<,]
end;

function IsJssDate(const V:char ): Boolean;
begin
    Result := False;
    if V in ['0','1','2','3','4','5','6','7','8','9','0','.'] then
    Result := True;
end;
end.