dxstring.pas

Well known and usefull component for delphi 7

begin
   Result:='';
   for i:=((Length(s)div 4)-1)downto 0 do
      Result:=DecodeUnit(Copy(s,i*4+1,4))+Result;
end;

function StringToBase64(const S1:string):string;
const
   Table:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

var
   I,K,L:Integer;
   S:string;

begin
   L:=Length(S1);
   if L mod 3<>0 then Inc(L,3);
   SetLength(S,(L div 3)*4);
   FillChar2(S[1],Length(S),'=');
   I:=0;
   K:=1;
   while I<Length(S1) do begin
      S[K]:=Table[1+(Ord(S1[I+1])shr 2)];
      S[K+1]:=Table[1+(((Ord(S1[I+1])and $03)shl 4)or(Ord(S1[I+2])shr 4))];
      if I+1>=Length(S1) then Break;
      S[K+2]:=Table[1+(((Ord(S1[I+2])and $0F)shl 2)or(Ord(S1[I+3])shr 6))];
      if I+2>=Length(S1) then Break;
      S[K+3]:=Table[1+(Ord(S1[I+3])and $3F)];
      Inc(I,3);
      Inc(K,4);
   end;
   Result:=S;
end;

function StringToBase36(const S1:string):string; //715
Var
   Cnt:Integer;
   Ws:String;
   R:Integer;
   X:Integer;

begin
   Cnt:=1;
   R:=0;
   Ws:=DXString.UpperCase(S1);
   While (Ws<>'') do Begin
      X:=Length(Ws);
      R:=R+((CharPos(Ws[X],'123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'))*Cnt);
      Cnt:=Cnt*36;
      Delete(Ws,X,1);
   End;
   Result:=IntegerToString(R);
End;

function FixDottedIP(const S:string):string;
var
   n:Cardinal;

begin
   Result:='.'+S;
   n:=QuickPos('.0',Result);
   while n>0 do begin
      Delete(Result,n+1,1);
      n:=QuickPos('.0',Result);
   end;
   n:=QuickPos('..',Result);
   while N>0 do begin
      Insert('0',Result,n+1);
      n:=QuickPos('..',Result);
   end;
   if Result[Length(Result)]='.' then Result:=Result+'0';
   Delete(Result,1,1);
end;

function IPStringFormated(S:string):string;
var
   n1,n2,n3,n4:Integer;

begin
   N1:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N2:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N3:=StrToInt(Copy(S,1,CharPos('.',S)-1));
   Delete(S,1,CharPos('.',S));
   N4:=StringToInteger(S);
   Result:=IPAddressFormatted(N1,N2,N3,N4);
end;

function IPAddressFormatted(const I1,I2,I3,I4:Integer):string;
begin
   Result:=IntegerToString(I4);
   while Length(Result)<3 do
      Result:='0'+Result;
   Result:=IntegerToString(I3)+'.'+Result;
   while Length(Result)<7 do
      Result:='0'+Result;
   Result:=IntegerToString(I2)+'.'+Result;
   while Length(Result)<11 do
      Result:='0'+Result;
   Result:=IntegerToString(I1)+'.'+Result;
   while Length(Result)<15 do
      Result:='0'+Result;
end;

function EscapeDecode(const S:string):string;
var
   ch:Char;
   val:string;
   I:Integer;

begin
   Result:=S;
   I:=CharPos('%',Result);
   while I>0 do begin
      Val:={'$'+}Copy(Result,I+1,2); // july 29
// commented out code Oct 9th 2003      
//      if isNumericString(Val) then Begin
         try
            Ch:=Char(StrToInt('$'+Val)); // july 29
         except
//            Ch:='a';
            ch:=#32;
         end;
//      end
//      else ch:=#32;
      Result:=Copy(Result,1,I-1)+Ch+Copy(Result,I+3,Length(Result));
      I:=CharPos('%',Result);
   end;
   I:=CharPos('+',Result);
   while I>0 do begin
      Result:=Copy(Result,1,I-1)+#32+Copy(Result,I+1,Length(Result));
      I:=CharPos('+',Result);
   end;
end;

function EscapeEncode(const S:string):string;
var
   Loop:Integer;
   MaxLoop:Integer;

begin
   Result:='';
   MaxLoop:=Length(S);
   for Loop:=1 to MaxLoop do
      if S[Loop]in ['0'..'9','.','-'] then
         Result:=Result+S[Loop]
      else
         if S[Loop]=#32 then
            Result:=Result+'+'
         else
            if (S[Loop]<#21)or
               (S[Loop]>#127) then
               Result:=Result+'%'+IntToHex(Ord(S[Loop]),2)
            else
               Result:=Result+S[Loop]
end;

function EncodeDomain(S:string):string;
var
   Dot:Integer;

begin
   Result:='';
   while (S<>'') do begin
      Dot:=CharPos('.',S);
      case Dot of
         0:begin
               Result:=Result+Chr(Length(S))+S;
               S:='';
            end;
      else begin
            Result:=Result+Chr(Dot-1)+Copy(S,1,Dot-1);
            Delete(S,1,Dot);
         end;
      end;
   end;
   Result:=Result+#0;
end;

function EncodeAddress(S:string):string;
var
   Dot:Integer;

begin
   Result:='';
   while (S<>'') do begin
      Dot:=Pos('.',S);
      case Dot of
         0:begin
               Result:=Result+Chr(Length(S))+S;
               S:='';
            end;
      else begin
            Result:=Result+Chr(Dot-1)+Copy(S,1,Dot-1);
            Delete(S,1,Dot);
         end;
      end;
   end;
   Result:=Result+#7'in-addr'#4'arpa'#0;
end;

function DecodeDomain(S:string):string;
var
   L:Integer;

begin
   Result:='';
   while Length(S)>0 do begin
      L:=Ord(S[1]);
      if L>Length(S) then begin
         Result:='';
         Exit;
      end;
      Result:=Result+Copy(S,2,L)+'.';
      Delete(S,1,L+1);
   end;
   if Copy(Result,Length(Result),1)='.' then Delete(Result,Length(Result),1);
end;

function GetActualEmailAddress(Parm,Command:string):string;
var
   Colon,Quote:Integer;

begin
   // posibilities are:
   // [cmd]:<mailadrress>
   // [cmd] :<mailadrress>
   // [cmd]: <mailadrress>
   // [cmd] : <mailadrress>
   // [cmd] <mailadrress>
   // [cmd]<mailadrress>
   // you can also have "firstname lastname" in there also
   Quote:=CharPos('"',Parm);
   if Quote>0 then begin
      if CharPos('>',Parm)>Quote then begin
         Delete(Parm,1,Quote);
         Delete(Parm,1,CharPos('"',Parm));
      end
      else begin
         Colon:=PosLastChar('"',Parm);
         Delete(Parm,Quote,Colon-Pred(Quote));
      end;
   end;
   // check if space, if so let remove everything before
   Trim(Parm);
   // ok now possibilities are:
   // [cmd]:<mailadrress>
   // :<mailadrress>
   // : <mailadrress>
   // [cmd]<mailadrress>
   Colon:=CharPos(':',Parm);
   // check if colon, if so let remove everything before
   if Colon>0 then
      Delete(Parm,1,Colon);
   // ok now possibilities are:
   //  <mailadrress>
   // [cmd]<mailadrress>
   // now let check if we have a command
   if lowercase(copy(parm,1,length(command)))=lowercase(command) then
      delete(Parm,1,length(command));
   // we trim to make sure we dont have any space left in there
   Parm:=Trim(Parm);
   // and return the result with no brackets
   Result:=NoAngleBrackets(Parm);
end;

///////////////////////////////////////////////////////////////////////////////
// Date and/or Time Routines
///////////////////////////////////////////////////////////////////////////////

function DayOfTheYear(const DT:TDateTime):Integer;
var
   J,Y:Word;

begin
   DecodeDate(DT,Y,J,J);
   Result:=Trunc(DT)-Trunc(EncodeDate(Y,1,1))+1;
end;


function DaysLeftThisYear(const DT:TDateTime):Integer;
var
   J,Y:Word;

begin
   DecodeDate(DT,Y,J,J);
   case IsLeapYear(Y) of
      True:Result:=366-DayOfTheYear(DT);
      False:Result:=365-DayOfTheYear(DT);
   end;
end;

function DaysThisMonth(const DT:TDateTime):Integer;
var
   J,M,Y:Word;

begin
   DecodeDate(DT,Y,M,J);
   case M of
      2:
         if IsLeapYear(Y) then
            Result:=29
         else
            Result:=28;
      4,6,9,11:Result:=30;
   else
      Result:=31;
   end;
end;

function DaysLeftThisMonth(const DT:TDateTime):Integer;
var
   J,M,Y:Word;

begin
   DecodeDate(DT,Y,M,J);
   case M of
      2:
         if IsLeapYear(Y) then
            Result:=29
         else
            Result:=28;
      4,6,9,11:Result:=30;
   else
      Result:=31;
   end;
   Result:=Result-J;
end;

function IsTimeAM(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)<0.5;
end;

function IsTimePM(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)>0.5;
end;

function IsTimeNoon(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)=0.5;
end;

function IsTimeMidnight(const DT:TDateTime):Boolean;
begin
   Result:=Frac(DT)=0.0;
end;

function DateTimeToGMT(const DT:TDateTime):TDateTime;
begin
   Result:=DT+LocalTimeZoneBias/1440;
end;

function DateTimeToLocal(const DT:TDateTime):TDateTime;
begin
   Result:=DT-LocalTimeZoneBias/1440;
end;

function IsLeapYear(const Year:Word):Boolean;
begin
   Result:=((Year and 3)=0)and((Year mod 100>0)or(Year mod 400=0));
end;

function _LocalTimeZoneBias:Integer;
{$IFDEF LINUX}
var
   TV:TTimeval;
   TZ:TTimezone;

begin
   gettimeofday(TV,TZ);
   Result:=TZ.tz_minuteswest;
end;
{$ELSE}
var
   TimeZoneInformation:TTimeZoneInformation;
   Bias:Longint;

   begin
      case GetTimeZoneInformation(TimeZoneInformation) of
         1:Bias:=TimeZoneInformation.Bias+TimeZoneInformation.StandardBias;
         2:Bias:=TimeZoneInformation.Bias+(TimeZoneInformation.DaylightBias);
      else
         Bias:=TimeZoneInformation.Bias;
      end;
      Result:=(Bias div 60)*100;
   end;
{$ENDIF}

function LocalTimeZoneBias:Integer;
Begin
   Result:=GlobalLocalTimeZoneBias;
End;

function TimeZone:string;
{$IFDEF LINUX}
begin
   Result:=ShortTimeZone;
end;
{$ELSE}
var
   lpTimeZoneInfo:TTimeZoneInformation;

   begin
      Result:='';
      if GetTimeZoneInformation(lpTimeZoneInfo)=1 then
{$IFDEF VER90}
         Result:=WideCharToString({@} Pointer(lpTimeZoneInfo.StandardName))
{$ELSE}
         Result:=lpTimeZoneInfo.StandardName
{$ENDIF}
      else
         if GetTimeZoneInformation(lpTimeZoneInfo)=2 then
{$IFDEF VER90}
            Result:=WideCharToString({@} Pointer(lpTimeZoneInfo.DaylightName));
{$ELSE}
      Result:=lpTimeZoneInfo.DaylightName;
{$ENDIF}
   end;
{$ENDIF}

function ShortTimeZone:string;
{$IFDEF LINUX}
var
   T:TTime_T;
   UT:TUnixTime;
begin
   __time(@T);
   localtime_r(@T,UT);
   Result:=PChar(UT.__tm_zone);
end;
{$ELSE}
var
   TPos:Integer;

   begin
      Result:=TimeZone;
      TPos:=1;
      while TPos<=Length(Result) do
         if not(Result[TPos]in ['A'..'Z']) then
            Delete(Result,TPos,1)
         else
            Inc(TPos);
   end;
{$ENDIF}

function TimeZoneBias:string;
begin
   Result:=IntegerToString(LocalTimeZoneBIA