mysqlstrutils.pas

MYSQL 连接控件 MYSQL 连接控件

    	Delete(InStr, 1, nPos + Length(Delim)-1);
    Inc(nCount);
    if InStr = '' then exit
  end;

	nPos := Pos(Delim, InStr);
  if nPos = 0 then GetWord := InStr
  else if nPos = 1 then exit
  else GetWord := Copy(InStr, 1, nPos - 1)
end;

function GetStrWord(pnIndex: Integer;InStr, Delim: ansistring): ansistring;
begin
	Result := GetWord(InStr,Delim,pnIndex);
end;

type
  TDateOrder = (doMDY, doDMY, doYMD);

function GetDateOrder(const DateFormat: string): TDateOrder;
var
  I: Integer;
begin
  Result := doMDY;
  I := 1;
  while I <= Length(DateFormat) do
  begin
    case Chr(Ord(DateFormat[I]) and $DF) of
      'E': Result := doYMD;
      'Y': Result := doYMD;
      'M': Result := doMDY;
      'D': Result := doDMY;
    else
      Inc(I);
      Continue;
    end;
    Exit;
  end;
  Result := doMDY;
end;

function MySQLStrToDate(S: shortstring): TDateTime;
var
  N1,N2,N3,R: string;
begin
  N1 := WordInStr(1,S,'-/\.: '); if length(N1)=0 then N1 := '0000'; //yyyy
  N2 := WordInStr(2,S,'-/\.: '); if length(N2)=0 then N2 := '00';// mm
  N3 := WordInStr(3,S,'-/\.: '); if length(N3)=0 then N3 := '00';// ss
  case GetDateOrder(ShortDateFormat) of
    doMDY: R := N2+DateSeparator+N3+DateSeparator+N1;
    doDMY: R := N3+DateSeparator+N2+DateSeparator+N1;
    doYMD: R := N1+DateSeparator+N2+DateSeparator+N3;
  end;
  try
     Result := StrToDate(R);
  except
     Result := 0;
  end;
end;

function MySQLStrToTime(S: shortstring): TDateTime;
var
  N1,N2,N3,R: string;
begin
  N1 := WordInStr(1,S,'-/\.: '); if length(N1)=0 then N1 := '00';//hh
  N2 := WordInStr(2,S,'-/\.: '); if length(N2)=0 then N2 := '00';//mm
  N3 := WordInStr(3,S,'-/\.: '); if length(N3)=0 then N3 := '00';//ss
  R := N1+TimeSeparator+N2+TimeSeparator+N3;
  try
     Result := StrToTime(R);
  except
     Result := 0;
  end;
end;

function MySQLStrToDateTime(S: shortstring): TDateTime;
var
  dtDate,
  dtTime: TDateTime;
begin
  dtDate := MySQLStrToDate(WordInStr(1,S,' '));
  dtTime := MySQLStrToTime(WordInStr(2,S,' '));
  Result := dtDate+dtTime;
end;

function MySQLTimeStampToDateTime(S: shortstring): TDateTime;
var
  dtDate,
  dtTime: TDateTime;
begin
  dtDate := MySQLTimeStampToDate(S);
  dtTime := MySQLTimeStampToTime(S);
  Result := dtDate+dtTime;
end;

function MySQLTimeStampToDate(S: shortstring): TDateTime;
var
  N1,N2,N3,R: string;
begin
  N1 := Copy(S, 1, 4); if length(N1)=0 then N1 := '0000'; //yyyy
  N2 := Copy(S, 5, 2); if length(N2)=0 then N2 := '00';// mm
  N3 := Copy(S, 7, 2); if length(N3)=0 then N3 := '00';// dd
  case GetDateOrder(ShortDateFormat) of
    doMDY: R := N2+DateSeparator+N3+DateSeparator+N1;
    doDMY: R := N3+DateSeparator+N2+DateSeparator+N1;
    doYMD: R := N1+DateSeparator+N2+DateSeparator+N3;
  end;
  try
     Result := StrToDate(R);
  except
     Result := 0;
  end;
end;

function MySQLTimeStampToTime(S: shortstring): TDateTime;
var
  N1,N2,N3,R: string;
begin
  N1 := Copy(S, 9, 2); if length(N1)=0 then N1 := '00';//hh
  N2 := Copy(S, 11, 2); if length(N2)=0 then N2 := '00';//mm
  N3 := Copy(S, 13, 2); if length(N3)=0 then N3 := '00';//ss
  R := N1+TimeSeparator+N2+TimeSeparator+N3;
  try
     Result := StrToTime(R);
  except
     Result := 0;
  end;
end;

function MySQLDateStrToTimeStamp(S: shortstring): TTimeStamp;
var
  N1,N2,N3: integer;
begin
  N1 := StrToIntDef(WordInStr(1,S,'-/\.: '),0);  	if N1=0 then N1:=1;//yyyy
  N2 := StrToIntDef(WordInStr(2,S,'-/\.: '),0); 	if N2=0 then N2:=1;// mm
  N3 := StrToIntDef(WordInStr(3,S,'-/\.: '),0); 	if N3=0 then N3:=1;// dd
  try
     Result.Date := DateTimeToTimeStamp(EncodeDate(N1,N2,N3)).Date;
  except
     Result.Date := 1;
     Result.Time := 0;
  end;
end;

function MySQLTimeStrToTimeStamp(S: shortstring): TTimeStamp;
var
  N1,N2,N3: integer;
begin
  N1 := StrToIntDef(WordInStr(1,S,'-/\.: '),0); //hh
  N2 := StrToIntDef(WordInStr(2,S,'-/\.: '),0); //mm
  N3 := StrToIntDef(WordInStr(3,S,'-/\.: '),0); //ss
  try
     Result.Time := DateTimeToTimeStamp(EncodeTime(N1,N2,N3,0)).Time;
  except
     Result.Date := 1;
     Result.Time := 0;
  end;
end;

function MySQLDateTimeStrToTimeStamp(S: shortstring): TTimeStamp;
begin
  Result.Date := MySQLDateStrToTimeStamp(WordInStr(1,S,' ')).Date;
  Result.Time := MySQLTimeStrToTimeStamp(WordInStr(2,S,' ')).Time;
end;

function MySQLTimeStampStrToTimeStamp(S: shortstring): TTimeStamp;
var
  N1,N2,N3: integer;
  M1,M2,M3: integer;
begin
  N1 := StrToIntDef(Copy(S, 1, 4),0); if (N1<1) or (N1>9999) then N1 := 1;//yyyy
  N2 := StrToIntDef(Copy(S, 5, 2),0); if not N2 in [1..12] then N2 := 1;// mm
  N3 := StrToIntDef(Copy(S, 7, 2),0); if not N3 in [1..31] then N3 := 1;// dd
	if N1=0 then N1:=1; if N2=0 then N2:=1; if N3=0 then N3:=1;
  M1 := StrToIntDef(Copy(S, 9, 2),0); if not M1 in [0..23] then M1 := 0;//hh
  M2 := StrToIntDef(Copy(S, 11, 2),0); if not M2 in [0..59] then M2 := 0; //mm
  M3 := StrToIntDef(Copy(S, 13, 2),0); if not M3 in [0..59] then M3 := 0;//ss
	if M1>23 then M1:=0; if M2>59 then M2:=0; if M3>59 then M3:=0;
  try
     Result.Date := DateTimeToTimeStamp(EncodeDate(N1,N2,N3)).Date;
     Result.Time := DateTimeToTimeStamp(EncodeTime(M1,M2,M3,0)).Time;
  except
     Result.Date := 1;
     Result.Time := 0
  end;
end;

function MySQLStrToFloat(S: string): Extended;
var
	SaveDecSep: Char;
begin
	SaveDecSep := DecimalSeparator;
  DecimalSeparator := '.';
  try
		Result := StrToFloat(S);
  finally
  	DecimalSeparator := SaveDecSep
  end;
end;

function MySQLFloatToStr(S: Double): string;
var
	SaveDecSep: Char;
begin
	SaveDecSep := DecimalSeparator;
  DecimalSeparator := '.';
  try
		Result := FloatToStr(S);
  finally
  	DecimalSeparator := SaveDecSep
  end;
end;

function GetPrefixWord(pnIndex: Integer;InStr, Delim: ansistring): ansistring;
var
	nPos, nCount: Integer;
  RS: string;
begin
	Result := '';
  if Length(InStr) = 0 then exit;
  if Length(Delim) = 0 then exit;

	if (pnIndex > 1) and (Pos(Delim, InStr) = 0) then
  begin
  	Result := InStr;
  	exit;
  end;

  nCount := 0;
  RS := '';
  while nCount < pnIndex do
  begin
  	nPos := Pos(Delim, InStr);
     if nPos = 0 then
     begin
     	Result := RS+InStr;
     	exit;
     end
     else
     begin
     	RS := RS + Copy(InStr, 1, nPos+length(Delim)-1);
     	Delete(InStr, 1, nPos + Length(Delim)-1);
     end;
     Inc(nCount);
     if InStr = '' then
     begin
     	Result := Copy(RS,1,length(RS)-length(Delim));
     	exit;
     end;
  end;
  Result := Copy(RS,1,length(RS)-length(Delim));
end;

function IsValidInt(const Value: string): Boolean;
const
  Numeric = ['0'..'9', '-', '+'];
var
  I: Integer;
begin
  Result := False;
  if Length(Value) = 0 then exit;
  for I := 1 to Length(Value) do if not (Value[I] in Numeric) then Exit;
  Result := True;
end;

function IsValidFloat(const Value: string): Boolean;
const
  Numeric = ['0'..'9', '.', '-', '+'];
var
  I: Integer;
begin
  Result := False;
  if Length(Value) = 0 then exit;
  for I := 1 to Length(Value) do if not (Value[I] in Numeric) then Exit;
  Result := True;
end;

function WriteIniString(const Props, Section, Item, Value: String): string;
var
	Ini,Sec: TStringList;
  i,j: integer;
begin
	Ini := TStringList.Create;
	Sec := TStringList.Create;
  try
  	// Get ini
     Ini.Text := Props;
     // Parse into Tree stringlist
     j := -1;
     for i := 0 to Ini.Count-1 do begin
     	if (length(Ini[i])>0) and not(Ini[i][1]=';') then begin
     		if Ini[i][1]='[' then j := Sec.AddObject(Ini[i],TStringList.Create)
        	else if j>-1 then TStringList(Sec.Objects[j]).Add(Ini[i]);
        end;
     end;
     // Do Operation
     i := Sec.IndexOf('['+Section+']');
		if i<0 then i := Sec.AddObject('['+Section+']',TStringList.Create);
     j := TStringList(Sec.Objects[i]).IndexOfName(Item);
     if j<0 then TStringList(Sec.Objects[i]).Add(Item+'='+Value)
     else TStringList(Sec.Objects[i]).Values[Item] := Value;
     // Parse back to single ini
     Ini.Clear;
     for i := 0 to Sec.Count-1 do begin
			Ini.Add(Sec[i]);
        for j := 0 to TStringList(Sec.Objects[i]).Count-1 do Ini.Add(TStringList(Sec.Objects[i])[j]);
     end;
     Result := Ini.Text;
  finally
  	Ini.Free;
     while Sec.Count>0 do begin
     	TStringList(Sec.Objects[0]).Free;
        Sec.Delete(0);
     end;
  	Sec.Free;
  end;
end;

function ReadIniString(const Props, Section, Item,Default: String): string;
var
	Ini,Sec: TStringList;
  i,j: integer;
begin
	Ini := TStringList.Create;
	Sec := TStringList.Create;
  try
  	// Get ini
     Ini.Text := Props;
     // Parse into Tree stringlist
     j := -1;
     for i := 0 to Ini.Count-1 do begin
     	if (length(Ini[i])>0) and not(Ini[i][1]=';') then begin
        	if (Ini[i][1]='[') then j := Sec.AddObject(Ini[i],TStringList.Create);
        	if j>-1 then TStringList(Sec.Objects[j]).Add(Ini[i]);
        end;
     end;
     // Do Operation
     i := Sec.IndexOf('['+Section+']');
		if i<0 then begin
     	Result := Default;
     	exit;
     end;
     j := TStringList(Sec.Objects[i]).IndexOfName(Item);
     if j<0 then Result := Default
     else Result := TStringList(Sec.Objects[i]).Values[Item];
  finally
  	Ini.Free;
     while Sec.Count>0 do begin
     	TStringList(Sec.Objects[0]).Free;
        Sec.Delete(0);
     end;
  	Sec.Free;
  end;
end;

function ReadIniSection(const Props, Section, Default: string): string;
var
	Ini,Sec: TStringList;
  i,j: integer;
begin
	Ini := TStringList.Create;
	Sec := TStringList.Create;
  try
  	// Get ini
     Ini.Text := Props;
     // Parse into Tree stringlist
     j := -1;
     for i := 0 to Ini.Count-1 do begin
     	if (length(Ini[i])>0) and not(Ini[i][1]=';') then begin
        	if (Ini[i][1]='[') then j := Sec.AddObject(Ini[i],TStringList.Create)
           else if j>-1 then TStringList(Sec.Objects[j]).Add(Ini[i]);
        end;
     end;
     // Do Operation
     i := Sec.IndexOf('['+Section+']');
		if i<0 then begin
     	Result := Default;
     	exit;
     end;
     Result := TStringList(Sec.Objects[i]).Text;
  finally
  	Ini.Free;
     while Sec.Count>0 do begin
     	TStringList(Sec.Objects[0]).Free;
        Sec.Delete(0);
     end;
  	Sec.Free;
  end;
end;

function EraseIniSection(const Props, Section: String): string;
var
	Ini,Sec: TStringList;
  i,j: integer;
begin
	Ini := TStringList.Create;
	Sec := TStringList.Create;
  try
  	// Get ini
     Ini.Text := Props;
     // Parse into Tree stringlist
     j := -1;
     for i := 0 to Ini.Count-1 do begin
     	if (length(Ini[i])>0) and not(Ini[i][1]=';') then begin
        	if (Ini[i][1]='[') then j := Sec.AddObject(Ini[i],TStringList.Create);
        	if j>-1 then TStringList(Sec.Objects[j]).Add(Ini[i]);
        end;
     end;
     // Do Operation
     i := Sec.IndexOf('['+Section+']');
		if i<0 then exit
     else begin
     	TStringList(Sec.Objects[i]).Free;
        Sec.Delete(i);
     end;
     // Parse back to single ini
     Ini.Clear;
     for i := 0 to Sec.Count-1 do begin
			Ini.Add(Sec[i]);
        for j := 0 to TStringList(Sec.Objects[i]).Count-1 do Ini.Add(TStringList(Sec.Objects[i])[j]);
     end;
     Result := Ini.Text;
  finally
  	Ini.Free;
     while Sec.Count>0 do begin
     	TStringList(Sec.Objects[0]).Free;
        Sec.Delete(0);
     end;
  	Sec.Free;
  end;
end;

function WriteIniInteger(const Props, Section, Item: string; Value: integer): string;
begin
	Result := WriteIniString(Props,Section,Item,IntToStr(Value));
end;

function ReadIniInteger(const Props, Section, Item: string; Default: integer): integer;
begin
	Result := StrToIntDef(ReadIniString(Props,Section,Item,IntToStr(Default)),Default);
end;

function WriteIniBoolean(const Props, Section, Item: string; Value: boolean): string;
begin
	Result := WriteIniString(Props,Section,Item,IFStr(Value,'True','False'));
end;

function ReadIniBoolean(const Props, Section, Item: string; Default: boolean): boolean;
begin
	Result := SameText('True',ReadIniString(Props,Section,Item,IFStr(Default,'True','False')));
end;

function WriteIniDateTime(const Props, Section, Item: string; Value: TDateTime): string;
begin
	Result := WriteIniFloat(Props,Section,Item,Value);
end;

function ReadIniDateTime(const Props, Section, Item: string; Default: TDateTime): TDateTime;
begin
	Result := ReadIniFloat(Props,Section,Item,Default);
end;

function WriteIniFloat(const Props, Section, Item: string; Value: extended): string;
begin
	Result := WriteIniString(Props,Section,Item,FloatToStr(Value));
end;

function ReadIniFloat(const Props, Section, Item: string; Default: extended): extended;
begin
	Result := StrToFloat(ReadIniString(Props,Section,Item,FloatToStr(Default)));
end;



end.