mysqlstrutils.pas

MYSQL 连接控件 MYSQL 连接控件

//	Author:			Jacques Venter, [e-mail]
//	Copyright:		1999,2000,2001,2002,2003,2004 SciBit - Scientific Bitware (Pty) Ltd
//	Version:			2004.1.1.0
//	History:       Utility functions
//						2000.0.1.1
//							First release
//
//   Licensing
//
//       Copyright (c) 1998-2004 SciBit - Scientific Bitware (Pty) Ltd
//       ALL RIGHTS RESERVED
//
//  The entire contents of this file is protected by South African and
//  International Copyright Laws. Unauthorized reproduction,
//  reverse-engineering, and distribution of all or any portion of
//  the code contained in this file is strictly prohibited and may
//  result in severe civil and criminal penalties and will be
//  prosecuted to the maximum extent possible under the law.
//
//  RESTRICTIONS
//
//  THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES
//  (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE
//  SECRETS OF SCIBIT (Pty) Ltd. THE REGISTERED DEVELOPER IS
//  LICENSED TO DISTRIBUTE THE SOURCECODE AND ALL
//  ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.
//
//  THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED
//  FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE
//  COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE
//  AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT
//  AND PERMISSION FROM SciBit - Scientific Bitware (Pty) Ltd
//
//  CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON
//  ADDITIONAL RESTRICTIONS.
//
//*******************************************************************
unit MySQLStrUtils;
interface
{$I product.inc}
uses Classes, SysUtils;

type
  TSBStringList = class(TStringList)
  private
    FStringDel: string;
  protected
    function GetTextStr: string; override;
    procedure SetTextStr(const Value: string); override;
  public
    constructor Create;
    property StringDel: string read FStringDel write FStringDel;
  end;

//Convert comma delimited text string ignoring spaces as delimeter
function IFStr(const Condition: boolean; const T,F:string): string;
function SBCommaText(Value: string): TStringList;

function PreStrClean(StrIn,DS: ansistring): ansistring;
function PostStrClean(StrIn,DS: ansistring): ansistring;
function PrePostStrClean(StrIn,DS: ansistring): ansistring;
function InStrClean(StrIn,DS: ansistring): ansistring;

function WordInStr(Number: byte; StrIn, CS: ansistring): ansistring;
{ Number-n'th word you want in the string StrIn with deliminators CS }
{ Ex: WordInStr(2,'23/7/96 17:35:26',' ')='17:35:26' }
{ Ex: WordInStr(6,'23/7/96 17:35:26',' /:')='26' }
{ Ex: WordInStr(3,WordInStr(2,'23/7/96 17:35:26',' '),':')='26' }
{ Ex: WordInStr(3,'23/7/96 17:35:26',' ')='' }
function FieldInStr(Number: byte; StrIn, CS, DS: ansistring): ansistring;
procedure ChangeWordInStr(Number: byte; var StrIn: string;NewValue,CS: string);
function OneStr(StrIn,DS: string): string;
function ReplaceSubStr(InStr, SearchStr, ReplaceStr: ansistring): ansistring;

// Date/Time routines
function FloatToTime(dt: Double): Double;
function StrFloatToTime(s: shortstring): Double;
function StrFloatToDate(s: shortstring): Double;
function StrFloatToDateTime(s: shortstring): Double;
function StrToDateTimeFmt(s: shortstring): Double;

// MySQL Date/Time
function MySQLStrToDate(S: shortstring): TDateTime;
function MySQLStrToTime(S: shortstring): TDateTime;
function MySQLStrToDateTime(S: shortstring): TDateTime;
function MySQLTimeStampToDateTime(S: shortstring): TDateTime;
function MySQLTimeStampToDate(S: shortstring): TDateTime;
function MySQLTimeStampToTime(S: shortstring): TDateTime;
function MySQLStrToFloat(S: string): Extended;
function MySQLFloatToStr(S: Double): string;

//MySQL Date/Time field to Delphi TimeStamp convertion
function MySQLDateStrToTimeStamp(S: shortstring): TTimeStamp;
function MySQLTimeStrToTimeStamp(S: shortstring): TTimeStamp;
function MySQLDateTimeStrToTimeStamp(S: shortstring): TTimeStamp;

//MySQL TimeStamp field to Delphi TimeStamp convertion
function MySQLTimeStampStrToTimeStamp(S: shortstring): TTimeStamp;

function GetWord(InStr, Delim: ansistring; pnIndex: Integer): ansistring;
function GetStrWord(pnIndex: Integer;InStr, Delim: ansistring): ansistring;
function GetPrefixWord(pnIndex: Integer;InStr, Delim: ansistring): ansistring;
function ZeroFilled(V: string; L: integer): string;

function IsValidInt(const Value: string): Boolean;
function IsValidFloat(const Value: string): Boolean;
function CountSubStr(InStr, SearchStr: ansistring): integer;

// IniStrings
function WriteIniString(const Props, Section, Item, Value: string): string;
function ReadIniString(const Props, Section, Item, Default: string): string;
function ReadIniSection(const Props, Section, Default: string): string;
function EraseIniSection(const Props, Section: String): string;

	function WriteIniInteger(const Props, Section, Item: string; Value: integer): string;
	function ReadIniInteger(const Props, Section, Item: string; Default: integer): integer;
	function WriteIniBoolean(const Props, Section, Item: string; Value: boolean): string;
	function ReadIniBoolean(const Props, Section, Item: string; Default: boolean): boolean;
	function WriteIniDateTime(const Props, Section, Item: string; Value: TDateTime): string;
	function ReadIniDateTime(const Props, Section, Item: string; Default: TDateTime): TDateTime;
	function WriteIniFloat(const Props, Section, Item: string; Value: extended): string;
	function ReadIniFloat(const Props, Section, Item: string; Default: extended): extended;

implementation
uses
  SysConst;

constructor TSBStringList.Create;
begin
  inherited;
  FStringDel := #13#10;
end;

function TSBStringList.GetTextStr: string;
var
  I, L, Size, Count: Integer;
  P: PChar;
  S: string;
begin
  Count := GetCount;
  Size := 0;
  for I := 0 to Count - 1 do Inc(Size, Length(Get(I)+FStringDel){ + 2});
  SetString(Result, nil, Size);
  P := Pointer(Result);
  for I := 0 to Count - 1 do
  begin
    S := Get(I)+FStringDel;
    L := Length(S);
    if L <> 0 then
    begin
      System.Move(Pointer(S)^, P^, L);
      Inc(P, L);
    end;
  end;
end;

procedure TSBStringList.SetTextStr(const Value: string);
var
  P, Start: PChar;
  Del,
  S: string;
begin
  BeginUpdate;
  try
    Clear;
    Del := #0+FStringDel;
    P := Pointer(Value);
    if P <> nil then
      while P^ <> #0 do
      begin
        Start := P;
        while pos(P^,Del)=0 do Inc(P);
        SetString(S, Start, P - Start);
        Add(S);
        while pos(P^,FStringDel)>0 do Inc(P);
      end;
  finally
    EndUpdate;
  end;
end;

function IFStr(const Condition: boolean; const T,F:string): string;
begin
	if Condition then Result := T
  else Result := F;
end;

function ZeroFilled(V: string; L: integer): string;
var
  T: string;
begin
  T := StringOfChar('0', L);
  if length(V)>=L then
     Insert(V,T,1)
  else
     Insert(V,T,L-length(V)+1);
  SetLength(T,L);
  Result := T;
end;

function SBCommaText(Value: string): TStringList;
var
  P, P1: PChar;
  S: string;
begin
  Result := TStringList.Create;
  P := PChar(Value);
  while P^ in [#1..' '] do P := PChar(Integer(P)+1);
  while P^ <> #0 do
  begin
    if P^ = '"' then
      S := AnsiExtractQuotedStr(P, '"')
    else
    begin
      P1 := P;
      while (P^ >= ' ') and (P^ <> ',') do P := PChar(Integer(P)+1);
      SetString(S, P1, P - P1);
    end;
    Result.Add(S);
    while P^ in [#1..' '] do P := PChar(Integer(P)+1);
    if P^ = ',' then
      repeat
        P := PChar(Integer(P)+1);
      until not (P^ in [#1..' ']);
  end;
end;

function PreStrClean(StrIn,DS: ansistring): ansistring;
var
	TempStr: ansistring;
begin
  TempStr := StrIn;
  if (length(DS)>0) and (length(TempStr)>0) then
    while (length(TempStr)>0) and (pos(TempStr[1],DS)>0) do
       TempStr := copy(TempStr,2,length(TempStr)-1);
  PreStrClean := TempStr;
end;

function PostStrClean(StrIn,DS: ansistring): ansistring;
var
	TempStr: ansistring;
begin
  TempStr := StrIn;
  if (length(DS)>0) and (length(TempStr)>0) then
    while (length(TempStr)>0) and (pos(TempStr[length(TempStr)],DS)>0) do
       TempStr := copy(TempStr,1,length(TempStr)-1);
  PostStrClean := TempStr;
end;

function PrePostStrClean(StrIn,DS: ansistring): ansistring;
begin
	PrePostStrClean := PostStrClean(PreStrClean(StrIn,DS),DS);
end;

function InStrClean;
var
	i: integer;
  Tmp: ansistring;
begin
	Tmp := '';
	if length(StrIn)>0 then
  begin
  	Tmp := '';
     for i := 1 to length(StrIn) do
     	if pos(StrIn[i],DS)=0 then
     		Tmp := Tmp + StrIn[i];
  end;
  InStrClean := Tmp;
end;

function FieldInStr(Number: byte; StrIn, CS, DS: ansistring): ansistring;
var
         i,
         k       : integer;
         TempStr : ansistring;
begin
         TempStr := StrIn;
         if Number>1 then
            for i := 0 to (Number-2) do
            begin
              k := pos(CS,TempStr);
              if k>0 then
                 TempStr := copy(TempStr,k+1,length(TempStr)-k);
            end;
         k := pos(CS,TempStr);
         if k>0 then
            TempStr := copy(TempStr,1,k-1);
         if length(DS)>0 then
         	TempStr := PrePostStrClean(TempStr,DS);
         FieldInStr := TempStr;
end;

function PosWordInStr(var Number: integer; StrIn,CS: ansistring): ansistring;
var
         i,
         k       : integer;
         TempStr : ansistring;
begin
         PosWordInStr := '';
         TempStr := '';
         k := 0;
         for i := 1 to length(StrIn) do
              if pos(StrIn[i],CS)>0 then
                   begin
                   if (Length(TempStr)>0) and (k=Number) then
                        begin
                        PosWordInStr := TempStr;
                        Number := i;
                        Exit
                        end
                   else
                        TempStr := ''
                   end
              else
                   begin
                   if Length(TempStr)=0 then
                        Inc(k);
                   TempStr := TempStr + StrIn[i]
                   end;
         if (Length(TempStr)>0) and (k=Number) then
         begin
              PosWordInStr := TempStr;
              Number := length(StrIn);
         end;
end;

function WordInStr(Number: byte; StrIn,CS: ansistring): ansistring;
var
         i,
         k       : integer;
         TempStr : ansistring;
begin
         WordInStr := '';
         TempStr := '';
         k := 0;
         for i := 1 to length(StrIn) do
              if pos(StrIn[i],CS)>0 then
                   begin
                   if (Length(TempStr)>0) and (k=Number) then
                        begin
                        WordInStr := TempStr;
                        Exit
                        end
                   else
                        TempStr := ''
                   end
              else
                   begin
                   if Length(TempStr)=0 then
                        Inc(k);
                   TempStr := TempStr + StrIn[i]
                   end;
         if (Length(TempStr)>0) and (k=Number) then
              WordInStr := TempStr
end;

procedure ChangeWordInStr(Number: byte; var StrIn: string;NewValue,CS: string);
var
  Str: string;
  i: integer;
begin
	i := Number;
	Str := PosWordInStr(i, StrIn, CS);
  Delete(StrIn,i,length(Str));
  Insert(NewValue,StrIn,i);
end;

// #0
// #9 Tab
// #10 NewLine
// #13 Return
// #34 "
// #39 '

function OneStr(StrIn,DS: string): string;
var
	P: string;
  i,j,k: integer;
begin
	P := StrIn;
  j := length(DS);
	if j>0 then
  begin
  	for i := 1 to j do
     begin
     	k := pos(DS[i],P);
     	while (k>0) do
        begin
        	P[k] := chr(32);			// Make character space
{        	System.Delete(P,k,1); } // Delete character
     		k := pos(DS[i],P);
        end;
     end;
  end;
  Result := P;
end;

function ReplaceSubStr(InStr, SearchStr, ReplaceStr: ansistring): ansistring;
var
	i,
  n,
  PosInStr: integer;
  TempStr : ansistring;
begin
	if InStr = '' then exit;
	TempStr := InStr;
	n := length(TempStr);
  i := 1;
  while i <= n do
  begin
  	if TempStr = '' then break;
  	PosInStr := Pos(TempStr[i], SearchStr);
  	if PosInStr > 0 then
     begin
     	Delete(TempStr, i, 1);
        Insert(ReplaceStr, TempStr, i);
        Dec(i)
     end;
  	Inc(i)
  end;
  ReplaceSubStr := TempStr
end;

function CountSubStr(InStr, SearchStr: ansistring): integer;
var
	i: integer;
begin
  Result := 0;
	if InStr = '' then exit;
  i := pos(UpperCase(SearchStr),UpperCase(InStr));
  while i>0 do begin
  	inc(Result);
     delete(InStr,i,length(SearchStr));
     i := pos(UpperCase(SearchStr),UpperCase(InStr));
  end;
end;

function FloatToTime(dt: Double): Double;
begin
	FloatToTime := dt - Trunc(dt)
end;

function StrFloatToTime(s: shortstring): Double;
begin
	StrFloatToTime := FloatToTime(StrToFloat(s))
end;

function StrFloatToDate(s: shortstring): Double;
begin
	StrFloatToDate := Trunc(StrToFloat(s))
end;

function StrFloatToDateTime(s: shortstring): Double;
begin
	StrFloatToDateTime := StrToFloat(s)
end;

function StrToDateTimeFmt(s: shortstring): Double;
begin
	StrToDateTimeFmt := StrToDateTime(Copy(s,6,2) + '/' + Copy(s,9,2) + '/' + Copy(s,1,4) + ' ' + Copy(s, 12, 8));
end;

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

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

  nCount := 1;
  while nCount < pnIndex do begin
  	nPos := Pos(Delim, InStr);
    if nPos = 0 then exit
    else