Delphi常用函数库

unit SkyPublic;

 

interface

 

uses

  Windows,SysUtils,Classes,Controls,Dialogs,ShellApi,Menus,StdCtrls,

  registry,Forms,Graphics,Math,DateUtils;

 

type

  TQuarter = 1..4;

 

  TChinaNumFormat = (cnfBig,cnfSmall,cnfArab);

 

  TChinaBigFormat = (cbfFull,cbfBlank);

 

  TNumChar=‘0‘..‘9‘;

 

  TStringArray = array of string;

 

  TCharSet = set of Char;

 

  TFontRecord = record

    CharSet:Byte;

    Color:Integer;

    Name:string;

    Size:Integer;

    Style:Byte;

    PixelsPerInch:Integer;

    Pitch:0..2;

    Height:Integer;

  end;

 

const

  CR = #13;

  LF = #10;

  NumCharSet=[‘0‘..‘9‘];

  NameCharSet = [‘A‘..‘Z‘,‘a‘..‘z‘,‘0‘..‘9‘,‘_‘];

 

var

  MimaFileName:string;

  PositionMima:array [0..2] of Integer = (91,92,93);

 

{*****************************类操作******************************}

{显示类及其继承信息函数}

function ShowClassName(Obj:TObject):string;

procedure GetClassInfos(Obj:TComponent;StrList:TStringList);

procedure SaveClassInfos(Obj:TComponent;FileName:string);

 

{*****************************文件操作******************************}

{建文件夹}

function CreateDirs(APath:string):Boolean;

{拷贝}

function FileCopy(From, Dest: string;S:Integer=0;Dialog:Boolean=True):Boolean;

{移动}

procedure FileMove(From, Dest: string);

{删除}

procedure FileDelete(ADirName: string);

{更名}

function FileRename(From, Dest: string):Boolean;

 

{***************************控件操作********************************}

{TStrings，在Combobox中添加或者删除一个字符串}

procedure StringsOperation(ComboBox:TComboBox;IsAdd:Boolean;No:string=‘‘);

 

{***************************日期操作********************************}

{返回头尾日期}

procedure GetHeadTailDate(const SelfDate:TDate;var HeadDate,TailDate:TDate);overload;

procedure GetHeadTailDate(const Year,Month:Integer;var HeadDate,TailDate:TDate);overload;

{返回一月有多少天}

function ReturnHowDay(const AYear,AMonth:word):Word;

{返回季度头尾日期}

procedure GetQuarter(AYear:Word;AQuarter:TQuarter;var HeadDate,TailDate:TDate);overload;

procedure GetQuarter(SelfDate:TDate;var HeadDate,TailDate:TDate);overload;

procedure GetAccYearMonth(ADate:TDateTime;var Y,M:Word);

 

{**************************字符串操作*******************************}

{**************************string Function*******************************}

{得到1个字符在字符串中的个数}

function GetCharNum(const Ch:Char; const Str: string):Integer;

{Ini字符串和String字符串互相转换}

function IniStrToStr(const Str: string): string;

function StrToIniStr(const Str: string): string;

{给字符串加一个‘\‘}

function AddBackSlash(const S: string): string;

{减少字符串的长度}

procedure DecStrLen(var S: string; DecBy: Integer);

{返回有回车换行的字符串Position位置所在的字符串}

function GetCurLine(const S: string; Position: Integer): string;

{返回给定字符串的内存分配大小}

function GetStrAllocSize(const S: string): Longint;

{ 得到字符串的基准数 }

function GetStrRefCount(const S: string): Longint;

{清除A中指定的字符}

function KillChars(const S: string; A: array of Char; CaseSensitive: Boolean):string;

{ 返回子字符串在字符串中最后一个位置 }

function LastPos(const SubStr, S: string): Integer;

{ 设置字符串的实际长度 }

procedure RealizeLength(var S: string);

{ 移去字符串末尾的‘\‘}

function RemoveBackSlash(const S: string): string;

{移去字符串空格}

function RemoveSpaces(const S: string): string;

{字符串取反}

function ReverseStr(const S: string): string;

{除去前后回车}

function TrimEnterLeft(S:string):string;

function TrimEnterRight(S:string):string;

function TrimEnter(S:string):string;

{******************************PChar Function***************************}

procedure StrGetCurLine(StartPos, CurPos: PChar; TotalLen: integer;

  var LineStart: PChar; var LineLen: integer);

{ 返回最后一个指定字符串及其以后的字符 }

function StrLastPos(Str1, Str2: PChar): PChar;

{截取第一个指定字符串及其以后的字符,大小写不敏感}

function StrIPos(Str1, Str2: PChar): PChar;

{截取第一个指定字符及其以后的字符,大小写不敏感}

function StrIScan(Str: PChar; Chr: Char): PChar;

{ 字符串取反 }

procedure StrReverse(P: PChar);

 

{返回中文大写数字}

function GetChinaNum(Num:TNumChar;ChinaNumFormat:TChinaNumFormat=cnfBig):string;

{将数字变成中文大写}

function FloatToChinaBig(Num:Double;ChinaBigFormat:TChinaBigFormat=cbfFull;Blanks:Byte=0):string;

function FloatToChnStr(Value: Real; ClearZero: Boolean; full:Boolean=False): String;

{将数字变成英文}

function FloatToEnglish(Num:Double):string;

{日期用英文}

function DateToEng(ADate:TDate;th:Boolean=False):string;

{取得SQL日期字符串等}

function DateToSQLDateStr(ADate:TDateTime):string;

function StrToSQLDateStr(Str:string):string;

function TimeToSQLTimeStr(ATime:TDateTime):string;

function StrToSQLTimeStr(Str:string):string;

function DateTimeToSQLDateTimeStr(ADateTime:TDateTime):string;

function StrToSQLDateTimeStr(Str:string):string;

{返回有逗号的金额字符串}

function FloatToMoneyStr(Num:Double;const HasSymbol:Boolean=False):string;

{Bool与字符串的转换}

function StrToBool(const Str:string):Boolean;

function BoolToStr(const Bool:Boolean):string;

{判断是否日期等}

function IsDate(const CheckString:string):Boolean;

function IsDateTime(const CheckString:string):Boolean;

function IsTime(const CheckString:string):Boolean;

function IsInteger(const CheckString:string):Boolean;

function IsFloat(const CheckString:string):Boolean;

{多字符串ShowMessage}

procedure ShowMessages(const Strings:array of string);

{新名称}

function NameToNewName(const Str:string):string;

{FloatTo%百分比}

function FloatToRate(Num:Double;Pos:Word):string;

{字体存贮}

procedure FontRecordToFont(FontRecord:TFontRecord;Font:TFont);

function FontToFontRecord(Font:TFont):TFontRecord;

function FontStylesToInt(FontStyles:TFontStyles):Byte;

function IntToFontStyles(FontInteger:Byte):TFontStyles;

 

{****************************数学*********************************}

{n次方}

function Power(X,Y:Extended):Extended;

{N的阶层}

function Order(N: Word): Extended;//（用Pascal写的N的阶层）

{得到小数点位数}

function GetFloatPointNum(Fl:Double):Integer;

{小数点位数，四舍五入法}

function FloatToNewFloat(AValue:Double):Double;

function FloatToNewFloatN(AValue:Double;N:Word=4):Double;

 

{******************************系统操作*******************************}

{关闭计算机}

function WinExit (iFlags: integer) : Boolean;

{防止开启多个应用程序}

procedure PreventMany(Name:string);

{得到应用程序的路径}

function GetApplicationDir(AppName:string):string;

{加到启动}

function RegAddToRun(Name,Value:string):Boolean;

procedure DeleteOneItem(Name:string);

{得到Delphi路径}

function GetDelphiDir:string;

{得到系统路径}

function GetSystemDir:string;

{得到windows路径}

function GetWindowsDir:string;

{得到计算机名}

function GetComputerNameD:string;

{设置计算机名}

function SetComputerNameD(Name:string):Boolean;

{执行一个文件}

function ExecuteFile(const FileName, Params, DefaultDir: string;

  ShowCmd: Integer): THandle;

 

implementation

 

{显示类及其继承信息函数}

function ShowClassName(Obj:TObject):string;

var

  Str:string;

  K:TClass;

begin

  K:=Obj.ClassType;

  while not K.ClassNameIs(‘TObject‘) do

  begin

    Str:=K.ClassParent.ClassName+‘——>‘+Str;

    K:=K.ClassParent;

  end;

  Result:=Str+Obj.ClassName;

end;

 

procedure GetClassInfos(Obj:TComponent;StrList:TStringList);

var

  i:Integer;

  S:string;

begin

  StrList.Clear;

  for I:=0 to Obj.ComponentCount-1 do

  begin

    S:=‘类名：‘+Obj.Components.ClassName+‘ ‘+‘名称：‘+Obj.Components.Name;

    StrList.Add(S);

  end;

end;

 

procedure SaveClassInfos(Obj:TComponent;FileName:string);

var

  i:Integer;

  S:string;

  StrList:TStringList;

begin

  StrList:=TStringList.Create;

  try

    for I:=0 to Obj.ComponentCount-1 do

    begin

      S:=‘类名：‘+Obj.Components.ClassName+‘ ‘+‘名称：‘+Obj.Components.Name;

      StrList.Add(S);

    end;

    StrList.SaveToFile(FileName);

  finally

    StrList.Free;

  end;

end;

 

{建文件夹}

function  CreateDirs(APath:string):Boolean;

var

  CurrentPath:string;

  UsePath:string;

begin

  CurrentPath:=GetCurrentDir;

  UsePath:=Trim(APath);

  if Pos(‘\‘,UsePath)=1 then

  begin

    UsePath:=Copy(CurrentPath,1,2)+UsePath;

  end

  else if Pos(‘:‘,UsePath)<>2 then UsePath:=CurrentPath+‘\‘+UsePath;

  Result:=ForceDirectories(UsePath);

end;

 

{拷贝}{0:如果有同文件名则改名。1：如果同文件名则覆盖。}

function FileCopy(From, Dest: string;S:Integer=0;Dialog:Boolean=True):Boolean;

var

  T: TSHFileOpStruct;

  FromDir:PChar;

  ToDir:PChar;

begin

  GetMem(FromDir,Length(From)+2);

  try

    GetMem(ToDir,Length(Dest)+2);

    try

      FillChar(FromDir^,Length(From)+2,0);

      FillChar(ToDir^,Length(Dest)+2,0);

 

      StrCopy(FromDir,PChar(From));

      StrCopy(ToDir,PChar(Dest));

 

      with T do

      begin

        Wnd    :=0;

        wFunc  :=FO_COPY;

        pFrom  :=FromDir;

        pTo    :=ToDir;

        if S=0 then

          fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION

        else fFlags :=FOF_NOCONFIRMATION;

        if not Dialog then

          fFlags:=fFlags or FOF_SILENT;

        fAnyOperationsAborted:=False;

        hNameMappings:=nil;

        lpszProgressTitle:=nil;

        if SHFileOperation(T)=0 then

          Result:=True

        else Result:=False;

      end;

    finally

      FreeMem(ToDir,Length(Dest)+2);

    end;

  finally

    FreeMem(FromDir,Length(From)+2);

  end;

end;

 

{移动}

procedure FileMove(From, Dest: string);

var

  T: TSHFileOpStruct;

  FromDir:PChar;

  ToDir:PChar;

begin

  GetMem(FromDir,Length(From)+2);

  try

    GetMem(ToDir,Length(Dest)+2);

    try

      FillChar(FromDir^,Length(From)+2,0);

      FillChar(ToDir^,Length(Dest)+2,0);

 

      StrCopy(FromDir,PChar(From));

      StrCopy(ToDir,PChar(Dest));

 

      with T do

      begin

        Wnd    :=0;

        wFunc  :=FO_MOVE;

        pFrom  :=FromDir;

        pTo    :=ToDir;

        fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

        fAnyOperationsAborted:=False;

        hNameMappings:=nil;

        lpszProgressTitle:=nil;

        if SHFileOperation(T)<>0 then

          raise Exception.Create(‘移动文件操作不成功！‘);

      end;

    finally

      FreeMem(ToDir,Length(Dest)+2);

    end;

  finally

    FreeMem(FromDir,Length(From)+2);

  end;

end;

 

{删除}

procedure FileDelete(ADirName: string);

var

  SHFileOpStruct:TSHFileOpStruct;

  DirName:PChar;

begin

  Getmem(DirName,Length(ADirName)+2);

  try

    FillChar(Dirname^,Length(ADirName)+2,0);

    StrCopy(DirName,PChar(ADirName));

 

    with SHFileOpStruct do

    begin

      Wnd:=0;

      wFunc:=FO_DELETE;

      pFrom:=DirName;

      pTo:=nil;

      fFlags :=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

 

      fAnyOperationsAborted:=False;

      hNameMappings:=nil;

      lpszProgressTitle:=nil;

    end;

 

    if SHfileOperation(SHFileOpStruct)<>0 then

      raise Exception.Create(‘删除文件操作不成功！‘);

  finally

    FreeMem(DirName,Length(ADirName)+2);

  end;

end;

 

{更名}

function FileRename(From, Dest: string):Boolean;

//var

//  T: TSHFileOpStruct;

//  FromDir:PChar;

//  ToDir:PChar;

//  FromDirectory,DestDirectory:string;

begin

  Dest:=ExtractFileName(Dest);

  Result:=RenameFile(From,Dest);

end;

 

{得到应用程序的路径}

function GetApplicationDir(AppName:string):string;

var

  AppPath:string;

  reg:TRegistry;

  Name:string;

  ExtName:string;

begin

  ExtName:=Copy(AppName,Length(AppName)-3,4);

  if ExtName[1]<>‘.‘ then AppName:=AppName+‘.exe‘;

  Name:=‘Software\Microsoft\Windows\CurrentVersion\App Paths\‘+AppName;

  reg:=TRegistry.Create;

  try

    reg.RootKey:=HKEY_LOCAL_MACHINE;

    reg.OpenKey(Name,False);

    AppPath:=reg.ReadString(‘path‘);

    AppPath:=AddBackSlash(AppPath);

    reg.CloseKey;

  finally

    reg.Free;

  end;

  Result:=AppPath;

end;

 

{加到启动}

function RegAddToRun(Name,Value:string):Boolean;

var

  Reg:TRegistry;

  Values:string;

begin

  Result:=False;

  Reg:=TRegistry.Create;

  try

    Reg.RootKey:=HKEY_LOCAL_MACHINE;

    Reg.OpenKey(‘software\microsoft\windows\currentversion\run\‘,False);

    Values:=Reg.ReadString(Name);

    if Values<>Value then

    begin

      Reg.WriteString(Name,Value);

      Result:=True;

    end;

  finally

    Reg.Free;

  end;

end;

procedure DeleteOneItem(Name:string);

var

  Reg:TRegistry;

begin

  Reg:=TRegistry.Create;

  try

    Reg.RootKey:=HKEY_LOCAL_MACHINE;

    Reg.OpenKey(‘software\microsoft\windows\currentversion\run\‘,False);

    if Reg.ValueExists(Name) then

      Reg.DeleteValue(Name)

  finally

    Reg.Free;

  end;

end;

 

{得到delphi路径}

function GetDelphiDir:string;

begin

  Result:=GetApplicationDir(‘Delphi32.exe‘);

end;

 

{得到系统路径}

function GetSystemDir:string;

var

  Buffer: array[0..MAX_PATH - 1] of Char;

begin

  SetString(Result, Buffer, GetSystemDirectory(Buffer,SizeOf(Buffer)));

end;

 

{得到windows路径}

function GetWindowsDir:string;

var

  Buffer: array[0..MAX_PATH - 1] of Char;

begin

  SetString(Result, Buffer, GetWindowsDirectory(Buffer,SizeOf(Buffer)));

end;

 

{得到计算机名}

function GetComputerNameD:string;

var

  Buffer: array[0..MAX_COMPUTERNAME_LENGTH] of Char;

  BSize:Cardinal;

begin

  BSize:=SizeOf(Buffer);

  if  GetComputerName(Buffer,BSize) then

  begin

    Result:=Buffer;

  end

  else Result:=‘‘;

end;

 

{设置计算机名}

function SetComputerNameD(Name:string):Boolean;

begin

  if Length(Name)>MAX_COMPUTERNAME_LENGTH then

  Name:=Copy(Name,1,MAX_COMPUTERNAME_LENGTH);

  Result:=False;

  if SetComputerName(PChar(Name)) then

    Result:=True;

end;

 

function ExecuteFile(const FileName, Params, DefaultDir: string;

  ShowCmd: Integer): THandle;

var

  zFileName, zParams, zDir: array[0..120] of Char;

begin

  Result := ShellExecute(Application.MainForm.Handle, nil,

    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),

    StrPCopy(zDir, DefaultDir), ShowCmd);

end;

 

{返回头尾日期}

procedure GetHeadTailDate(const SelfDate:TDate;var HeadDate,TailDate:TDate);overload;

const

  AHeadDay=1;

var

  AYear,AMonth,ATailDay,ASelfDay:Word;

begin

  DecodeDate(SelfDate,AYear,AMonth,ASelfDay);

  ATailDay:=ReturnHowDay(AYear,AMonth);

  HeadDate:=EncodeDate(AYear,AMonth,AHeadDay);

  TailDate:=EncodeDate(AYear,AMonth,ATailDay);

end;

 

procedure GetHeadTailDate(const Year,Month:Integer;var HeadDate,TailDate:TDate);overload;

const

  HeadDay=1;

var

  TailDay:Word;

begin

  TailDay:=ReturnHowDay(Year,Month);

  HeadDate:=EncodeDate(Year,Month,HeadDay);

  TailDate:=EncodeDate(Year,Month,TailDay);

end;

 

{返回一月有多少天}

function ReturnHowDay(const AYear,AMonth:word):Word;

begin

  case AMonth of

    1,3,5,7,8,10,12:Result:=31;

    4,6,9,11:Result:=30;

    2:begin

      if IsLeapYear(AYear) then

        Result:=29

      else Result:=28;

    end;

    else Result:=0;

  end;

end;

 

{返回季度头尾日期}

procedure GetQuarter(AYear:Word;AQuarter:TQuarter;var HeadDate,TailDate:TDate);overload;

var

  AHeadDate,ATailDate:TDate;

  HeadMonth,TailMonth:Word;

begin

  HeadMonth:=1;

  TailMonth:=1;

  case AQuarter of

    1:begin

        HeadMonth:=1;

        TailMonth:=3;

    end;

    2:begin

        HeadMonth:=4;

        TailMonth:=6;

    end;

    3:begin

        HeadMonth:=7;

        TailMonth:=9;

    end;

    4:begin

        HeadMonth:=10;

        TailMonth:=12;

    end;

  end;

  GetHeadTailDate(AYear,HeadMonth,AHeadDate,ATailDate);

  HeadDate:=AHeadDate;

  GetHeadTailDate(AYear,TailMonth,AHeadDate,ATailDate);

  TailDate:=ATailDate;

end;

 

procedure GetQuarter(SelfDate:TDate;var HeadDate,TailDate:TDate);overload;

var

  AYear,AMonth,ADay:Word;

  AQuarter:TQuarter;

begin

  AQuarter:=1;

  DecodeDate(SelfDate,AYear,AMonth,ADay);

  case AMonth of

    1..3:AQuarter:=1;

    4..6:AQuarter:=2;

    7..9:AQuarter:=3;

    10..12:AQuarter:=4;

  end;

  GetQuarter(AYear,AQuarter,HeadDate,TailDate);

end;

 

procedure GetAccYearMonth(ADate:TDateTime;var Y,M:Word);

var

  D:Word;

begin

  DecodeDate(ADate,Y,M,D);

  if M=1 then

  begin

    Y:=Y-1;

    M:=12;

  end

  else begin

    M:=M-1;

  end;

end;

 

{  *** Pascal string functions *** }

function GetCharNum(const Ch:Char; const Str: string):Integer;

var

  S:PChar;

begin

  S:=PChar(Str);

  Result:=0;

  while S^<>#0 do

  begin

    if S^=Ch then

    Inc(Result);

    Inc(S);

  end;

end;

 

function IniStrToStr(const Str: string): string;

var

  Buffer: array[0..4095] of Char;

  B, S: PChar;

begin

  if Length(Str) > SizeOf(Buffer) then

    raise Exception.Create(‘String to read from an INI file‘);

  S := PChar(Str);

  B := Buffer;

  while S^ <> #0 do

    if (S[0] = ‘\‘) and (S[1] = ‘n‘) then

    begin

  B^ := #13;

  Inc(B);

  B^ := #10;

  Inc(B);

  Inc(S);

  Inc(S);

    end

    else

    begin

  B^ := S^;

  Inc(B);

  Inc(S);

    end;

  B^ := #0;

  Result := Buffer;

end;

 

function StrToIniStr(const Str: string): string;

var

  Buffer: array[0..4095] of Char;

  B, S: PChar;

begin

  if Length(Str) > SizeOf(Buffer) then

    raise Exception.Create(‘String to large to save in INI file‘);

  S := PChar(Str);

  B := Buffer;

  while S^ <> #0 do

    case S^ of

      #13, #10:

        begin

          if (S^ = #13) and (S[1] = #10) then Inc(S)

          else if (S^ = #10) and (S[1] = #13) then Inc(S);

          B^ := ‘\‘;

          Inc(B);

          B^ := ‘n‘;

          Inc(B);

          Inc(S);

        end;

    else

      B^ := S^;

      Inc(B);

      Inc(S);

    end;

  B^ := #0;

  Result := Buffer;

end;

 

function AddBackSlash(const S: string): string;

begin

  Result := S;

  if S<>‘‘ then

  begin

    if Result[Length(Result)] <> ‘\‘ then  // if last char isn‘t a backslash...

      Result := Result + ‘\‘;              // make it so

  end;

end;

 

procedure DecStrLen(var S: string; DecBy: Integer);

begin

  SetLength(S, Length(S) - DecBy);       // decrement string length by DecBy

end;

 

function GetCurLine(const S: string; Position: Integer): string;

var

  ResP: PChar;

  ResLen: integer;

begin

  StrGetCurLine(PChar(S), PChar(Longint(S) + Position - 1), Length(S), ResP,

    ResLen);

  SetString(Result, ResP, ResLen);

end;

 

function GetStrAllocSize(const S: string): Longint;

var

  P: ^Longint;

begin

  P := Pointer(S);                        // pointer to string structure

  dec(P, 3);                              // 12-byte negative offset

  Result := P^ and not $80000000 shr 1;   // ignore bits 0 and 31

end;

 

function GetStrRefCount(const S: string): Longint;

var

  P: ^Longint;

begin

  P := Pointer(S);                        // pointer to string structure

  dec(P, 2);                              // 8-byte negative offset

  Result := P^;

end;

 

function KillChars(const S: string; A: array of Char; CaseSensitive: Boolean):

  string;

var

  CharSet: TCharSet;

  i, count: integer;

begin

  CharSet := [];                         // empty character set

  for i := Low(A) to High(A) do begin

    Include(CharSet, A);              // fill set with array items

    if not CaseSensitive then begin      // if not case sensitive, then also

      if A in [‘A‘..‘Z‘] then

        Include(CharSet, Chr(Ord(A) + 32))  // include lower cased or

      else if A in [‘a‘..‘z‘] then

        Include(CharSet, Chr(Ord(A) - 32))  // include upper cased character

    end;

  end;

  SetLength(Result, Length(S));          // set length to prevent realloc

  count := 0;

  for i := 1 to Length(S) do begin       // iterate over string S

    if not (S in CharSet) then begin  // add good chars to Result

      Result[count + 1] := S;

      inc(Count);                        // keep track of num chars copies

    end;

  end;

  SetLength(Result, count);              // set length to num chars copied

end;

 

function LastPos(const SubStr, S: string): Integer;

var

  FoundStr: PChar;

begin

  Result := 0;

  FoundStr := StrLastPos(PChar(S), PChar(SubStr));

  if FoundStr <> nil then

    Result := (Cardinal(Length(S)) - StrLen(FoundStr)) + 1;

end;

 

procedure RealizeLength(var S: string);

begin

  SetLength(S, StrLen(PChar(S)));

end;

 

function RemoveBackSlash(const S: string): string;

begin

  Result := S;

  if Result[Length(Result)] = ‘\‘ then   // if last character is a backslash...

    DecStrLen(Result, 1);                // decrement string length

end;

 

function RemoveSpaces(const S: string): string;

begin

  Result := KillChars(S, [‘ ‘], True);

end;

 

function ReverseStr(const S: string): string;

begin

  Result := S;

  StrReverse(PChar(Result));

end;

 

{除去前后回车}

function TrimEnterLeft(S:string):string;

begin

  S:=ReverseStr(S);

  S:=TrimEnterRight(S);

  S:=ReverseStr(S);

  Result:=S;

end;

 

function TrimEnterRight(S:string):string;

begin

  while ((Length(S)>1)and((S[Length(S)]=#10)and(S[Length(S)-1]=#13)))or

   ((Length(S)>1)and((S[Length(S)]=#13)and(S[Length(S)-1]=#10))) do

  begin

    S:=Copy(S,1,Length(S)-2);

  end;

  Result:=S;

end;

 

function TrimEnter(S:string):string;

begin

  S:=TrimE